Télécharger lieupt.eso

Retour à la liste

Numérotation des lignes :

  1. C LIEUPT SOURCE CHAT 05/01/13 01:17:33 5004
  2. SUBROUTINE LIEUPT(EPSILO,NDIM,ITYG,XREEL,IZSH,JTEST)
  3.  
  4. ****************************************************************************
  5. *** SP 'LIEUPT' : permet de determiner si pt considere est à l'interieur
  6. *** ou à l'exterieur de l'element considere à epsilon pres
  7. ***
  8. *** APPELES 1 = aucun
  9. *** APPELES 2 = 'LIEUP2'
  10. ***
  11. *** E = 'EPSILO' marge relative acceptée position pt % element
  12. *** 'NDIM' dimension de l'espace
  13. *** 'ITYG' entier caracterisant la geometrie de l'element considere
  14. *** 'XREEL' pt considere en coordonnees reelles
  15. *** 'IZSH' segment content coord reelles noeuds, fcts forme et base
  16. ***
  17. *** S = 'JTEST' vaut 1 si pt à l'interieur de l'elemt a epsilon pres, 0 sinon
  18. ***
  19. *** Auteur Cyril Nou
  20. ****************************************************************************
  21.  
  22. IMPLICIT INTEGER(I-N)
  23. IMPLICIT REAL*8 (A-H,O-Z)
  24. SEGMENT IZSH
  25. REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9)
  26. ENDSEGMENT
  27. DIMENSION PT1(3),PT2(3),PT3(3),PT4(3),XREEL(3)
  28. DIMENSION ITRIAN(5),ICARRE(6),ICUBE(4,6),IPRISM(4,5),ITETRA(4,4)
  29. *** donnees ordonnées specifiquement pour chaque type d'element afin de
  30. *** parcourir les faces dans l'ordre croissant dans les diverses boucles
  31. DATA ITRIAN/1,2,3,1,2/
  32. DATA ICARRE/1,2,3,4,1,2/
  33. 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/
  34. DATA IPRISM/1,2,3,4, 4,5,6,1, 1,2,5,3, 2,3,6,1, 1,3,6,2/
  35. DATA ITETRA/1,2,4,3, 1,2,3,4, 2,3,4,1, 1,3,4,2/
  36. *** on postule initialement 'XREEL' appartient à element
  37. JTEST=1
  38.  
  39. **************
  40. *** CAS 2D ***
  41. **************
  42.  
  43. *** cas TRI3 (triangles), boucle sur les différentes faces
  44. IF (ITYG.EQ.4) THEN
  45. DO 10 I=1,3
  46. *** recuperation des pts definissant la face + l'origine
  47. DO 20 J=1,NDIM
  48. PT1(J)=XYZL(J,ITRIAN(I))
  49. PT2(J)=XYZL(J,ITRIAN(I+1))
  50. PT3(J)=XYZL(J,ITRIAN(I+2))
  51. 20 CONTINUE
  52. *** teste la position de 'XREEL' par rapport à la face
  53. CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  54. *** si 'XREEL' est du mauvais cote de la face
  55. IF (TEST.LT.(-EPSILO)) THEN
  56. *** 'JTEST'=0 car 'XREEL' est hors du TRI3
  57. JTEST=0
  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 (TEST.LT.(-EPSILO)) THEN
  71. JTEST=0
  72. RETURN
  73. ENDIF
  74. 30 CONTINUE
  75.  
  76. **************
  77. *** CAS 3D ***
  78. **************
  79.  
  80. *** cas CUB8 (cubes)
  81. ELSEIF (ITYG.EQ.14) THEN
  82. DO 50 I=1,6
  83. DO 60 J=1,NDIM
  84. PT1(J)=XYZL(J,ICUBE(1,I))
  85. PT2(J)=XYZL(J,ICUBE(2,I))
  86. PT3(J)=XYZL(J,ICUBE(3,I))
  87. PT4(J)=XYZL(J,ICUBE(4,I))
  88. 60 CONTINUE
  89. CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  90. IF (TEST.LT.(-EPSILO)) THEN
  91. JTEST=0
  92. RETURN
  93. ENDIF
  94. 50 CONTINUE
  95. *** cas PRI6 (prismes)
  96. ELSEIF (ITYG.EQ.16) THEN
  97. DO 70 I=1,5
  98. DO 80 J=1,NDIM
  99. PT1(J)=XYZL(J,IPRISM(1,I))
  100. PT2(J)=XYZL(J,IPRISM(2,I))
  101. PT3(J)=XYZL(J,IPRISM(3,I))
  102. PT4(J)=XYZL(J,IPRISM(4,I))
  103. 80 CONTINUE
  104. CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  105. IF (TEST.LT.(-EPSILO)) THEN
  106. JTEST=0
  107. RETURN
  108. ENDIF
  109. 70 CONTINUE
  110. *** cas TET4 (tetraedres)
  111. ELSEIF (ITYG.EQ.23) THEN
  112. DO 90 I=1,4
  113. DO 100 J=1,NDIM
  114. PT1(J)=XYZL(J,ITETRA(1,I))
  115. PT2(J)=XYZL(J,ITETRA(2,I))
  116. PT3(J)=XYZL(J,ITETRA(3,I))
  117. PT4(J)=XYZL(J,ITETRA(4,I))
  118. 100 CONTINUE
  119. CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST)
  120. IF (TEST.LT.(-EPSILO)) THEN
  121. JTEST=0
  122. RETURN
  123. ENDIF
  124. 90 CONTINUE
  125. ENDIF
  126. RETURN
  127. END
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  

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