Télécharger factra.eso

Retour à la liste

Numérotation des lignes :

  1. C FACTRA SOURCE CHAT 05/01/12 23:56:02 5004
  2. SUBROUTINE FACTRA(NDIM,ITYG,XDEP2,XARI2,IZSH,IFACE,XINT,XN,NBFAC)
  3. *************************************************************************
  4. *** SP 'FACTRA' : par convection ou diffusion explicite (où traj=droite),
  5. *** donne n° faces traversees, pts intersections associés, normales du
  6. *** repere local à la face associées.
  7. ***
  8. *** APPELES 1 = aucun
  9. *** APPELES 2 = 'FACTR1', 'FACTR2'
  10. ***
  11. *** E = 'NDIM' dimension de l'espace
  12. *** 'ITYG' entier caracterisant la geometrie de l'element
  13. *** 'XDEP2' coordonnees reelles de depart de la particule
  14. *** 'XARI2' coordonnees reelles d'arrivee de la particule
  15. *** 'IZSH' segment content coords reelles des noeuds de l'elemt considere
  16. ***
  17. *** S = 'IFACE' n° des faces traversees par particule
  18. *** 'XINT' pts intersection trajectoire particule-faces traversees
  19. *** 'XN' vecteurs unitaires normaux aux faces traversees
  20. *** 'NBFAC' nbre de faces de l'element considere traversees par particule
  21. ***
  22. *** Auteur Cyril Nou
  23. *************************************************************************
  24.  
  25. IMPLICIT INTEGER(I-N)
  26. IMPLICIT REAL*8 (A-H,O-Z)
  27. SEGMENT IZSH
  28. REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9)
  29. ENDSEGMENT
  30. DIMENSION XDEP2(3),XARI2(3),IFACE(6),XINT(3,6),XN(3,6)
  31. DIMENSION XN1(3),XN2(3),XN3(3),XINTER(3)
  32. DIMENSION PT1(3),PT2(3),PT3(3),PT4(3)
  33. DIMENSION ITRIAN(4),ICARRE(5),ICUBE(4,6),IPRISM(4,5),ITETRA(4,4)
  34. *** donnees ordonnées specifiquement pour chaque type d'element afin de
  35. *** parcourir les faces dans l'ordre croissant dans les diverses boucles
  36. DATA ITRIAN/1,2,3,1/
  37. DATA ICARRE/1,2,3,4,1/
  38. DATA ICUBE/1,2,3,4, 5,6,7,8, 1,2,6,5, 2,3,7,6, 3,4,8,7, 1,4,8,5/
  39. DATA IPRISM/1,2,3,3, 4,5,6,6, 1,2,5,4, 2,3,6,5, 1,3,6,4/
  40. DATA ITETRA/1,2,4,4, 1,2,3,3, 2,3,4,4, 1,3,4,4/
  41. *** initialisation des arguments de sortie à 0
  42. DO 10 I=1,6
  43. IFACE(I)=0
  44. DO 20 J=1,NDIM
  45. XINT(J,I)=0.D0
  46. XN(J,I)=0.D0
  47. 20 CONTINUE
  48. 10 CONTINUE
  49. NBFAC=0
  50.  
  51. *** cas TRI3 (triangles), boucle sur les différentes faces
  52. IF (ITYG.EQ.4) THEN
  53. DO 30 I=1,3
  54. *** recuperation des pts definissant la face
  55. DO 35 J=1,NDIM
  56. PT1(J)=XYZL(J,ITRIAN(I))
  57. PT2(J)=XYZL(J,ITRIAN(I+1))
  58. 35 CONTINUE
  59. *** recherche des normales et du pt d'intersection
  60. CALL FACTR1(NDIM,PT1,PT2,PT3,XDEP2,XARI2,XN1,XN2,XN3
  61. $ ,XINTER,ITEST)
  62. *** 'ITEST'=1 s'il y a intersection avec plan associé à la face
  63. IF (ITEST.EQ.1) CALL FACTR2(NDIM,ITYG,PT1,PT2,PT3,PT4
  64. $ ,XDEP2,XARI2,XN1,XN2,XN3,XINTER,ITEST)
  65. *** 'ITEST'=1 s'il y a intersection avec la face
  66. IF (ITEST.EQ.1) THEN
  67. *** recuperation des infos de la face effectivement traversée
  68. NBFAC=NBFAC+1
  69. IFACE(NBFAC)=I
  70. DO 40 K=1,NDIM
  71. XINT(K,NBFAC)=XINTER(K)
  72. XN(K,NBFAC)=XN1(K)
  73. 40 CONTINUE
  74. ENDIF
  75. 30 CONTINUE
  76. *** cas QUA4 (quadrangles)
  77. ELSEIF (ITYG.EQ.8) THEN
  78. DO 50 I=1,4
  79. DO 55 J=1,NDIM
  80. PT1(J)=XYZL(J,ICARRE(I))
  81. PT2(J)=XYZL(J,ICARRE(I+1))
  82. 55 CONTINUE
  83. CALL FACTR1(NDIM,PT1,PT2,PT3,XDEP2,XARI2,XN1,XN2,XN3
  84. $ ,XINTER,ITEST)
  85. IF (ITEST.EQ.1) CALL FACTR2(NDIM,ITYG,PT1,PT2,PT3,PT4
  86. $ ,XDEP2,XARI2,XN1,XN2,XN3,XINTER,ITEST)
  87. IF (ITEST.EQ.1) THEN
  88. NBFAC=NBFAC+1
  89. IFACE(NBFAC)=I
  90. DO 60 K=1,NDIM
  91. XINT(K,NBFAC)=XINTER(K)
  92. XN(K,NBFAC)=XN1(K)
  93. 60 CONTINUE
  94. ENDIF
  95. 50 CONTINUE
  96. *** cas CUB8 (cubes)
  97. ELSEIF (ITYG.EQ.14) THEN
  98. DO 70 I=1,6
  99. DO 75 J=1,NDIM
  100. PT1(J)=XYZL(J,ICUBE(1,I))
  101. PT2(J)=XYZL(J,ICUBE(2,I))
  102. PT3(J)=XYZL(J,ICUBE(3,I))
  103. PT4(J)=XYZL(J,ICUBE(4,I))
  104. 75 CONTINUE
  105. CALL FACTR1(NDIM,PT1,PT2,PT3,XDEP2,XARI2,XN1,XN2,XN3
  106. $ ,XINTER,ITEST)
  107. IF (ITEST.EQ.1) CALL FACTR2(NDIM,ITYG,PT1,PT2,PT3,PT4
  108. $ ,XDEP2,XARI2,XN1,XN2,XN3,XINTER,ITEST)
  109. IF (ITEST.EQ.1) THEN
  110. NBFAC=NBFAC+1
  111. IFACE(NBFAC)=I
  112. DO 80 K=1,NDIM
  113. XINT(K,NBFAC)=XINTER(K)
  114. XN(K,NBFAC)=XN1(K)
  115. 80 CONTINUE
  116. ENDIF
  117. 70 CONTINUE
  118. *** cas PRI6 (prismes)
  119. ELSEIF (ITYG.EQ.16) THEN
  120. DO 90 I=1,5
  121. DO 95 J=1,NDIM
  122. PT1(J)=XYZL(J,IPRISM(1,I))
  123. PT2(J)=XYZL(J,IPRISM(2,I))
  124. PT3(J)=XYZL(J,IPRISM(3,I))
  125. PT4(J)=XYZL(J,IPRISM(4,I))
  126. 95 CONTINUE
  127. CALL FACTR1(NDIM,PT1,PT2,PT3,XDEP2,XARI2,XN1,XN2,XN3
  128. $ ,XINTER,ITEST)
  129. IF (ITEST.EQ.1) CALL FACTR2(NDIM,ITYG,PT1,PT2,PT3,PT4
  130. $ ,XDEP2,XARI2,XN1,XN2,XN3,XINTER,ITEST)
  131. IF (ITEST.EQ.1) THEN
  132. NBFAC=NBFAC+1
  133. IFACE(NBFAC)=I
  134. DO 100 K=1,NDIM
  135. XINT(K,NBFAC)=XINTER(K)
  136. XN(K,NBFAC)=XN1(K)
  137. 100 CONTINUE
  138. ENDIF
  139. 90 CONTINUE
  140. *** cas TET4 (tetraedres)
  141. ELSEIF (ITYG.EQ.23) THEN
  142. DO 110 I=1,4
  143. DO 115 J=1,NDIM
  144. PT1(J)=XYZL(J,ITETRA(1,I))
  145. PT2(J)=XYZL(J,ITETRA(2,I))
  146. PT3(J)=XYZL(J,ITETRA(3,I))
  147. PT4(J)=XYZL(J,ITETRA(4,I))
  148. 115 CONTINUE
  149. CALL FACTR1(NDIM,PT1,PT2,PT3,XDEP2,XARI2,XN1,XN2,XN3
  150. $ ,XINTER,ITEST)
  151. IF (ITEST.EQ.1) CALL FACTR2(NDIM,ITYG,PT1,PT2,PT3,PT4
  152. $ ,XDEP2,XARI2,XN1,XN2,XN3,XINTER,ITEST)
  153. IF (ITEST.EQ.1) THEN
  154. NBFAC=1
  155. IFACE(NBFAC)=I
  156. DO 120 K=1,NDIM
  157. XINT(K,NBFAC)=XINTER(K)
  158. XN(K,NBFAC)=XN1(K)
  159. 120 CONTINUE
  160. ENDIF
  161. 110 CONTINUE
  162. ENDIF
  163. RETURN
  164. END
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  

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