Télécharger testfa.eso

Retour à la liste

Numérotation des lignes :

  1. C TESTFA SOURCE CHAT 05/01/13 03:36:24 5004
  2. SUBROUTINE TESTFA(EPSILO,NDIM,ITYG
  3. $ ,XREEL,IZSH,JFACE,PT1,PT2,PT3,PT4)
  4.  
  5. *************************************************************************
  6. *** SP 'TESTFA' : permet de tester % element considéré appartenance pt à
  7. *** l'une des faces associées, renvoie alors n° local face ou se trouve pt.
  8. ***
  9. *** APPELES 1 = aucun
  10. *** APPELES 2 = 'LIEUP2'
  11. ***
  12. *** E = 'EPSILO' marge relative acceptée position pt % element
  13. *** 'NDIM' dimension de l'espace
  14. *** 'ITYG' entier caracterisant la geometrie de l'element
  15. *** 'XREEL' coordonnees reelles du pt considéré
  16. *** 'IZSH' segment content coords reelles des noeuds de l'elemt considere
  17. ***
  18. *** S = 'JFACE' n° local face ou se trouve particule, -1 sinon
  19. *** 'PT1', 'PT2', 'PT3', 'PT4' noeuds appartenant à la face
  20. ***
  21. *** Rq : developpee seulement pour ITYPEL = 4,8,14,16 et 23
  22. ***
  23. ***
  24. *** Auteur Cyril Nou
  25. *************************************************************************
  26.  
  27. IMPLICIT INTEGER(I-N)
  28. IMPLICIT REAL*8 (A-H,O-Z)
  29. SEGMENT IZSH
  30. REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9)
  31. ENDSEGMENT
  32. DIMENSION XREEL(3)
  33. DIMENSION PT1(3),PT2(3),PT3(3),PT4(3)
  34. DIMENSION ITRIAN(5),ICARRE(6),ICUBE(4,6),IPRISM(4,5),ITETRA(4,4)
  35. *** donnees ordonnées specifiquement pour chaque type d'element afin de
  36. *** parcourir les faces dans l'ordre croissant dans les diverses boucles
  37. DATA ITRIAN/1,2,3,1,2/
  38. DATA ICARRE/1,2,3,4,1,2/
  39. DATA ICUBE/1,2,3,5, 5,6,7,1, 1,2,6,3, 2,3,7,1, 3,4,8,1, 1,4,8,2/
  40. DATA IPRISM/1,2,3,4, 4,5,6,1, 1,2,5,3, 2,3,6,1, 1,3,6,2/
  41. DATA ITETRA/1,2,4,3, 1,2,3,4, 2,3,4,1, 1,3,4,2/
  42. *** on postule initialement non appartenance à face
  43. JFACE=-1
  44.  
  45. *** cas TRI3 (triangles), boucle sur les différentes faces
  46. IF (ITYG.EQ.4) THEN
  47. DO 10 I=1,3
  48. *** recuperation des pts definissant la face
  49. DO 20 J=1,NDIM
  50. PT1(J)=XYZL(J,ITRIAN(I))
  51. PT2(J)=XYZL(J,ITRIAN(I+1))
  52. PT3(J)=XYZL(J,ITRIAN(I+2))
  53. 20 CONTINUE
  54. CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  55. *** 'TEST'=0. si appartenance à face considérée
  56. IF (ABS(TEST).LE.EPSILO) THEN
  57. JFACE=I
  58. RETURN
  59. ENDIF
  60. 10 CONTINUE
  61. *** cas QUA4 (quadrangles)
  62. ELSEIF (ITYG.EQ.8) THEN
  63. DO 30 I=1,4
  64. DO 40 J=1,NDIM
  65. PT1(J)=XYZL(J,ICARRE(I))
  66. PT2(J)=XYZL(J,ICARRE(I+1))
  67. PT3(J)=XYZL(J,ICARRE(I+2))
  68. 40 CONTINUE
  69. CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  70. IF (ABS(TEST).LE.EPSILO) THEN
  71. JFACE=I
  72. RETURN
  73. ENDIF
  74. 30 CONTINUE
  75. *** cas CUB8 (cubes)
  76. ELSEIF (ITYG.EQ.14) THEN
  77. DO 50 I=1,6
  78. DO 60 J=1,NDIM
  79. PT1(J)=XYZL(J,ICUBE(1,I))
  80. PT2(J)=XYZL(J,ICUBE(2,I))
  81. PT3(J)=XYZL(J,ICUBE(3,I))
  82. PT4(J)=XYZL(J,ICUBE(4,I))
  83. 60 CONTINUE
  84. CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  85. IF (ABS(TEST).LE.EPSILO) THEN
  86. JFACE=I
  87. RETURN
  88. ENDIF
  89. 50 CONTINUE
  90. *** cas PRI6 (prismes)
  91. ELSEIF (ITYG.EQ.16) THEN
  92. DO 70 I=1,5
  93. DO 80 J=1,NDIM
  94. PT1(J)=XYZL(J,IPRISM(1,I))
  95. PT2(J)=XYZL(J,IPRISM(2,I))
  96. PT3(J)=XYZL(J,IPRISM(3,I))
  97. PT4(J)=XYZL(J,IPRISM(4,I))
  98. 80 CONTINUE
  99. CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  100. IF (ABS(TEST).LE.EPSILO) THEN
  101. JFACE=I
  102. RETURN
  103. ENDIF
  104. 70 CONTINUE
  105. *** cas TET4 (tetraedres)
  106. ELSEIF (ITYG.EQ.23) THEN
  107. DO 90 I=1,4
  108. DO 100 J=1,NDIM
  109. PT1(J)=XYZL(J,ITETRA(1,I))
  110. PT2(J)=XYZL(J,ITETRA(2,I))
  111. PT3(J)=XYZL(J,ITETRA(3,I))
  112. PT4(J)=XYZL(J,ITETRA(4,I))
  113. 100 CONTINUE
  114. CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  115. IF (ABS(TEST).LE.EPSILO) THEN
  116. JFACE=I
  117. RETURN
  118. ENDIF
  119. 90 CONTINUE
  120. ENDIF
  121.  
  122. RETURN
  123. END
  124.  
  125.  
  126.  
  127.  

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