Télécharger j3load.eso

Retour à la liste

Numérotation des lignes :

  1. C J3LOAD SOURCE CHAT 05/01/13 00:46:59 5004
  2. SUBROUTINE J3LOAD(NUM,WWORK,NPTO,TOL,IRET)
  3. C----------------------------------------------------
  4. C TRANSFERT DES FACE 3D EN FACE 2D
  5. C
  6. C PP 9/97
  7. C Pierre Pegon/JRC Ispra
  8. C----------------------------------------------------
  9. IMPLICIT INTEGER(I-N)
  10. IMPLICIT REAL*8(A-H,O-Z)
  11. DIMENSION NUM(2,NPTO),P1(3)
  12. C
  13. -INC CCOPTIO
  14. -INC SMCOORD
  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. 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. C
  29. IRET=0
  30. IF(NPTO.LE.2)THEN
  31. WRITE(IOIMP,*)'J3LOAD: nb de point d"une face insuffisant'
  32. IRET=IRET+1
  33. RETURN
  34. ENDIF
  35. WORK=FWORK
  36. C
  37. C LE PREMIER POINT DU CONTOURS DEFINIT L'ORIGINE
  38. C
  39. NUME=NUM(1,1)
  40. IREF=(NUME-1)*(IDIM+1)
  41. DO IE1=1,3
  42. PORIG(IE1)=XCOOR(IREF+IE1)
  43. ENDDO
  44. XYC(1,1)=0.D0
  45. XYC(2,1)=0.D0
  46. DENS(1)=XCOOR(IREF+4)
  47. C
  48. C AVEC LE SECOND POINT, ON DEFINIT LE PREMIER VECTEUR
  49. C
  50. NUME=NUM(1,2)
  51. IREF=(NUME-1)*(IDIM+1)
  52. DO IE1=1,3
  53. P1(IE1)=XCOOR(IREF+IE1)
  54. VI(IE1)=P1(IE1)-PORIG(IE1)
  55. ENDDO
  56. XNORM=SQRT(VI(1)**2+VI(2)**2+VI(3)**2)
  57. IF(XNORM.LT.TOL)THEN
  58. WRITE(IOIMP,*)'J3LOAD: 2 point d"une face sont trop proches'
  59. IRET=IRET+1
  60. RETURN
  61. ENDIF
  62. DO IE1=1,3
  63. VI(IE1)=VI(IE1)/XNORM
  64. ENDDO
  65. XYC(1,2)=XNORM
  66. XYC(2,2)=0.D0
  67. DENS(2)=XCOOR(IREF+4)
  68. C
  69. C AVEC LE POINT SUIVANT, OU UN AUTRE POINT, ON DEFINIT LE VECTEUR
  70. C NORMAL PUIS LE SECOND VECTEUR
  71. C WARNING: LA + GD COMPOSANTE DE VNOR EST TJ POSITIVE!
  72. C
  73. DO IE1=3,NPTO
  74. NUME=NUM(1,IE1)
  75. IREF=(NUME-1)*(IDIM+1)
  76. DO IE2=1,3
  77. VJ(IE2)=XCOOR(IREF+IE2)-P1(IE2)
  78. P1(IE2)=XCOOR(IREF+IE2)
  79. ENDDO
  80. XNORM=SQRT(VJ(1)**2+VJ(2)**2+VJ(3)**2)
  81. IF(XNORM.LT.TOL)THEN
  82. WRITE(IOIMP,*)'J3LOAD: 2 point d"une face sont trop proches'
  83. IRET=IRET+1
  84. RETURN
  85. ENDIF
  86. DO IE2=1,3
  87. VJ(IE2)=VJ(IE2)/XNORM
  88. ENDDO
  89. VNORM(1)=VI(2)*VJ(3)-VI(3)*VJ(2)
  90. VNORM(2)=VI(3)*VJ(1)-VI(1)*VJ(3)
  91. VNORM(3)=VI(1)*VJ(2)-VI(2)*VJ(1)
  92. XNORM=SQRT(VNORM(1)**2+VNORM(2)**2+VNORM(3)**2)
  93. IF(XNORM.GT.100*TOL)THEN
  94. XCMAX=VNORM(1)
  95. DO IE2=2,3
  96. IF(ABS(VNORM(IE2)).GT.ABS(XCMAX))THEN
  97. XCMAX=VNORM(IE2)
  98. ENDIF
  99. ENDDO
  100. XNORM=SIGN(1.D0,XCMAX)*XNORM
  101. DO IE2=1,3
  102. VNORM(IE2)=VNORM(IE2)/XNORM
  103. ENDDO
  104. VJ(1)=VNORM(2)*VI(3)-VNORM(3)*VI(2)
  105. VJ(2)=VNORM(3)*VI(1)-VNORM(1)*VI(3)
  106. VJ(3)=VNORM(1)*VI(2)-VNORM(2)*VI(1)
  107. GOTO 1
  108. ENDIF
  109. ENDDO
  110. WRITE(IOIMP,*)'J3LOAD: On ne reussit pas a definir le 2nd vecteur'
  111. IRET=IRET+1
  112. RETURN
  113. C
  114. C ON BOUCLE SUR LES POINTS ET ON LES PROJETTE SUR LE PLAN
  115. C ON TESTE LA DISTANCE DU POINT AU PLAN
  116. C
  117. 1 CONTINUE
  118. DO IE1=3,NPTO
  119. NUME=NUM(1,IE1)
  120. IREF=(NUME-1)*(IDIM+1)
  121. DO IE2=1,3
  122. P1(IE2)=XCOOR(IREF+IE2)
  123. ENDDO
  124. XDIST=(P1(1)-PORIG(1))*VNORM(1)+(P1(2)-PORIG(2))*VNORM(2)
  125. > +(P1(3)-PORIG(3))*VNORM(3)
  126. IF(ABS(XDIST).GT.TOL)THEN
  127. WRITE(IOIMP,*)'J3LOAD: 1 point d"une face est hors plan'
  128. IRET=IRET+1
  129. RETURN
  130. ENDIF
  131. XYC(1,IE1)=(P1(1)-PORIG(1))*VI(1)+(P1(2)-PORIG(2))*VI(2)
  132. > +(P1(3)-PORIG(3))*VI(3)
  133. XYC(2,IE1)=(P1(1)-PORIG(1))*VJ(1)+(P1(2)-PORIG(2))*VJ(2)
  134. > +(P1(3)-PORIG(3))*VJ(3)
  135. DENS(IE1)=XCOOR(IREF+4)
  136. ENDDO
  137. C
  138. JUN=0
  139. C
  140. RETURN
  141. END
  142.  
  143.  
  144.  

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