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 CCOPTIO
  14. C
  15. SEGMENT WWORK
  16. REAL*8 PORIG(3),VNORM(3),VI(3),VJ(3)
  17. INTEGER FWORK
  18. INTEGER TWORK(NTROU)
  19. ENDSEGMENT
  20. POINTEUR WWORK1.WWORK,WWORK2.WWORK
  21. C
  22. SEGMENT WORK
  23. REAL*8 XYC(2,NPTO)
  24. INTEGER IST(3,NPTO)
  25. REAL*8 DENS(NPTO)
  26. INTEGER JUN
  27. ENDSEGMENT
  28. LOGICAL LPLAN
  29. C
  30. C ON VERIFIE QUE LES NORMALES SONT COPLANAIRES
  31. C
  32. XPMIX=(WWORK1.VNORM(2)*WWORK2.VNORM(3)
  33. > -WWORK1.VNORM(3)*WWORK2.VNORM(2))**2
  34. > +(WWORK1.VNORM(3)*WWORK2.VNORM(1)
  35. > -WWORK1.VNORM(1)*WWORK2.VNORM(3))**2
  36. > +(WWORK1.VNORM(1)*WWORK2.VNORM(2)
  37. > -WWORK1.VNORM(2)*WWORK2.VNORM(1))**2
  38. XPMIX=SQRT(XPMIX)
  39. LPLAN=XPMIX.LT.TOL
  40. IF(.NOT.LPLAN)RETURN
  41. C
  42. C ON VERIFIE QUE L'ORIGINE DU SECOND PLAN EST SUR LE PREMIER
  43. C
  44. XDIST=WWORK1.VNORM(1)*(WWORK2.PORIG(1)-WWORK1.PORIG(1))
  45. > +WWORK1.VNORM(2)*(WWORK2.PORIG(2)-WWORK1.PORIG(2))
  46. > +WWORK1.VNORM(3)*(WWORK2.PORIG(3)-WWORK1.PORIG(3))
  47. LPLAN=ABS(XDIST).LT.TOL
  48. IF(.NOT.LPLAN)RETURN
  49. C
  50. C ON CHANGE LE HEADER DE WWORK2 AINSI QUE LE SYSTEME DE COORDONNEES
  51. C
  52. XSCAL=WWORK1.VNORM(1)*WWORK2.VNORM(1)
  53. > +WWORK1.VNORM(2)*WWORK2.VNORM(2)
  54. > +WWORK1.VNORM(3)*WWORK2.VNORM(3)
  55. ISI=INT(SIGN(1.D0,XSCAL))
  56. C
  57. X12=(WWORK2.PORIG(1)-WWORK1.PORIG(1))*WWORK1.VI(1)
  58. > +(WWORK2.PORIG(2)-WWORK1.PORIG(2))*WWORK1.VI(2)
  59. > +(WWORK2.PORIG(3)-WWORK1.PORIG(3))*WWORK1.VI(3)
  60. Y12=(WWORK2.PORIG(1)-WWORK1.PORIG(1))*WWORK1.VJ(1)
  61. > +(WWORK2.PORIG(2)-WWORK1.PORIG(2))*WWORK1.VJ(2)
  62. > +(WWORK2.PORIG(3)-WWORK1.PORIG(3))*WWORK1.VJ(3)
  63. C
  64. A=WWORK2.VI(1)*WWORK1.VI(1)+WWORK2.VI(2)*WWORK1.VI(2)
  65. > +WWORK2.VI(3)*WWORK1.VI(3)
  66. B=WWORK2.VI(1)*WWORK1.VJ(1)+WWORK2.VI(2)*WWORK1.VJ(2)
  67. > +WWORK2.VI(3)*WWORK1.VJ(3)
  68. C
  69. DO IE1=1,3
  70. WWORK2.PORIG(IE1)=WWORK1.PORIG(IE1)
  71. WWORK2.VNORM(IE1)=WWORK1.VNORM(IE1)
  72. WWORK2.VI(IE1)=WWORK1.VI(IE1)
  73. WWORK2.VJ(IE1)=WWORK1.VJ(IE1)
  74. ENDDO
  75. C
  76. WWORK=WWORK2
  77. DO IE1=1,1+TWORK(/1)
  78. IF(IE1.EQ.1)THEN
  79. WORK=FWORK
  80. ELSE
  81. WORK=TWORK(IE1-1)
  82. ENDIF
  83. NPTO=DENS(/1)
  84. DO IE2=1,NPTO
  85. X1=X12+XYC(1,IE2)*A-ISI*XYC(2,IE2)*B
  86. Y1=Y12+XYC(1,IE2)*B+ISI*XYC(2,IE2)*A
  87. XYC(1,IE2)=X1
  88. XYC(2,IE2)=Y1
  89. ENDDO
  90. IF(ISI.EQ.-1)CALL J3ORIE(1,XYC,DENS,NPTO,1,TOL,IRET)
  91. ENDDO
  92. C
  93. RETURN
  94. END
  95.  
  96.  
  97.  

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