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

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