Télécharger j3copl.eso

Retour à la liste

Numérotation des lignes :

  1. C J3COPL SOURCE CHAT 05/01/13 00:46:07 5004
  2. SUBROUTINE J3COPL(WWORK1,WWORK2,LPLAN,TOL)
  3. C----------------------------------------------------
  4. C LES FACES WWORK1 ET WWORK2 SONT-ELLES COPLANAIRES?
  5. C SI OUI, ON EN MET UNE DANS LE REPERE DE L'AUTRE
  6. C
  7. C PP 9/97
  8. C Pierre Pegon/JRC Ispra
  9. C----------------------------------------------------
  10. IMPLICIT INTEGER(I-N)
  11. IMPLICIT REAL*8(A-H,O-Z)
  12. C
  13. -INC PPARAM
  14. -INC CCOPTIO
  15. C
  16. SEGMENT WWORK
  17. REAL*8 PORIG(3),VNORM(3),VI(3),VJ(3)
  18. INTEGER FWORK
  19. INTEGER TWORK(NTROU)
  20. ENDSEGMENT
  21. POINTEUR WWORK1.WWORK,WWORK2.WWORK
  22. C
  23. SEGMENT WORK
  24. REAL*8 XYC(2,NPTO)
  25. INTEGER IST(3,NPTO)
  26. REAL*8 DENS(NPTO)
  27. INTEGER JUN
  28. ENDSEGMENT
  29. LOGICAL LPLAN
  30. C
  31. C ON VERIFIE QUE LES NORMALES SONT COPLANAIRES
  32. C
  33. XPMIX=(WWORK1.VNORM(2)*WWORK2.VNORM(3)
  34. > -WWORK1.VNORM(3)*WWORK2.VNORM(2))**2
  35. > +(WWORK1.VNORM(3)*WWORK2.VNORM(1)
  36. > -WWORK1.VNORM(1)*WWORK2.VNORM(3))**2
  37. > +(WWORK1.VNORM(1)*WWORK2.VNORM(2)
  38. > -WWORK1.VNORM(2)*WWORK2.VNORM(1))**2
  39. XPMIX=SQRT(XPMIX)
  40. LPLAN=XPMIX.LT.TOL
  41. IF(.NOT.LPLAN)RETURN
  42. C
  43. C ON VERIFIE QUE L'ORIGINE DU SECOND PLAN EST SUR LE PREMIER
  44. C
  45. XDIST=WWORK1.VNORM(1)*(WWORK2.PORIG(1)-WWORK1.PORIG(1))
  46. > +WWORK1.VNORM(2)*(WWORK2.PORIG(2)-WWORK1.PORIG(2))
  47. > +WWORK1.VNORM(3)*(WWORK2.PORIG(3)-WWORK1.PORIG(3))
  48. LPLAN=ABS(XDIST).LT.TOL
  49. IF(.NOT.LPLAN)RETURN
  50. C
  51. C ON CHANGE LE HEADER DE WWORK2 AINSI QUE LE SYSTEME DE COORDONNEES
  52. C
  53. XSCAL=WWORK1.VNORM(1)*WWORK2.VNORM(1)
  54. > +WWORK1.VNORM(2)*WWORK2.VNORM(2)
  55. > +WWORK1.VNORM(3)*WWORK2.VNORM(3)
  56. ISI=INT(SIGN(1.D0,XSCAL))
  57. C
  58. X12=(WWORK2.PORIG(1)-WWORK1.PORIG(1))*WWORK1.VI(1)
  59. > +(WWORK2.PORIG(2)-WWORK1.PORIG(2))*WWORK1.VI(2)
  60. > +(WWORK2.PORIG(3)-WWORK1.PORIG(3))*WWORK1.VI(3)
  61. Y12=(WWORK2.PORIG(1)-WWORK1.PORIG(1))*WWORK1.VJ(1)
  62. > +(WWORK2.PORIG(2)-WWORK1.PORIG(2))*WWORK1.VJ(2)
  63. > +(WWORK2.PORIG(3)-WWORK1.PORIG(3))*WWORK1.VJ(3)
  64. C
  65. A=WWORK2.VI(1)*WWORK1.VI(1)+WWORK2.VI(2)*WWORK1.VI(2)
  66. > +WWORK2.VI(3)*WWORK1.VI(3)
  67. B=WWORK2.VI(1)*WWORK1.VJ(1)+WWORK2.VI(2)*WWORK1.VJ(2)
  68. > +WWORK2.VI(3)*WWORK1.VJ(3)
  69. C
  70. DO IE1=1,3
  71. WWORK2.PORIG(IE1)=WWORK1.PORIG(IE1)
  72. WWORK2.VNORM(IE1)=WWORK1.VNORM(IE1)
  73. WWORK2.VI(IE1)=WWORK1.VI(IE1)
  74. WWORK2.VJ(IE1)=WWORK1.VJ(IE1)
  75. ENDDO
  76. C
  77. WWORK=WWORK2
  78. DO IE1=1,1+TWORK(/1)
  79. IF(IE1.EQ.1)THEN
  80. WORK=FWORK
  81. ELSE
  82. WORK=TWORK(IE1-1)
  83. ENDIF
  84. NPTO=DENS(/1)
  85. DO IE2=1,NPTO
  86. X1=X12+XYC(1,IE2)*A-ISI*XYC(2,IE2)*B
  87. Y1=Y12+XYC(1,IE2)*B+ISI*XYC(2,IE2)*A
  88. XYC(1,IE2)=X1
  89. XYC(2,IE2)=Y1
  90. ENDDO
  91. IF(ISI.EQ.-1)CALL J3ORIE(1,XYC,DENS,NPTO,1,TOL,IRET)
  92. ENDDO
  93. C
  94. RETURN
  95. END
  96.  
  97.  
  98.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales