Télécharger artref.eso

Retour à la liste

Numérotation des lignes :

  1. C ARTREF SOURCE CHAT 05/01/12 21:25:24 5004
  2. SUBROUTINE ARTREF(X,ITYP,IART)
  3. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  4. C
  5. C RECHERCHE IART NUMERO DE L ARETE OU SE TROUVE LE POINT DE
  6. C COORDONNEES X DANS L'ELEMENT DE REFERENCE
  7. C
  8. C ITYP TYPE DE L ELEMENT (3D )
  9. C
  10. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  11. IMPLICIT INTEGER(I-N)
  12. IMPLICIT REAL*8 (A-H,O-Z)
  13. DIMENSION X(*)
  14. EPS=1.D-15
  15. IART=0
  16. IF(ITYP.EQ.14)THEN
  17. C L ELEMENT DE REFERENCE EST UN CUBE
  18. IF(ABS(1.D0-X(3)).LT.EPS)THEN
  19. IF(ABS(1.D0-X(1)).LT.EPS)THEN
  20. IART=3
  21. X(3)=1.D0
  22. X(1)=1.D0
  23. ELSEIF(ABS(1.D0+X(1)).LT.EPS)THEN
  24. IART=4
  25. X(3)=1.D0
  26. X(1)=-1.D0
  27. ELSEIF(ABS(1.D0-X(2)).LT.EPS)THEN
  28. IART=7
  29. X(3)=1.D0
  30. X(2)=1.D0
  31. ELSEIF(ABS(1.D0+X(2)).LT.EPS)THEN
  32. IART=8
  33. X(3)=1.D0
  34. X(2)=-1.D0
  35. ELSE
  36. RETURN
  37. ENDIF
  38. ELSEIF(ABS(1.D0+X(3)).LT.EPS)THEN
  39. IF(ABS(1.D0-X(1)).LT.EPS)THEN
  40. IART=2
  41. X(3)=-1.D0
  42. X(1)=1.D0
  43. ELSEIF(ABS(1.D0+X(1)).LT.EPS)THEN
  44. IART=1
  45. X(3)=-1.D0
  46. X(1)=-1.D0
  47. ELSEIF(ABS(1.D0-X(2)).LT.EPS)THEN
  48. IART=6
  49. X(3)=-1.D0
  50. X(2)=1.D0
  51. ELSEIF(ABS(1.D0+X(2)).LT.EPS)THEN
  52. IART=5
  53. X(3)=-1.D0
  54. X(2)=-1.D0
  55. ELSE
  56. RETURN
  57. ENDIF
  58. ELSEIF(ABS(1.D0-X(1)).LT.EPS)THEN
  59. IF(ABS(1.D0-X(2)).LT.EPS)THEN
  60. IART=11
  61. X(1)=1.D0
  62. X(2)=1.D0
  63. ELSEIF(ABS(1.D0+X(2)).LT.EPS)THEN
  64. IART=10
  65. X(1)=1.D0
  66. X(2)=-1.D0
  67. ELSE
  68. RETURN
  69. ENDIF
  70. ELSEIF(ABS(1.D0+X(1)).LT.EPS)THEN
  71. IF(ABS(1.D0-X(2)).LT.EPS)THEN
  72. IART=12
  73. X(1)=-1.D0
  74. X(2)=1.D0
  75. ELSEIF(ABS(1.D0+X(2)).LT.EPS)THEN
  76. IART=9
  77. X(1)=-1.D0
  78. X(2)=-1.D0
  79. ELSE
  80. RETURN
  81. ENDIF
  82. ENDIF
  83. ELSEIF(ITYP.EQ.16)THEN
  84. C L ELEMENT DE REFERENCE EST UN PRISME
  85. IF(ABS(1.D0-X(3)).LT.EPS)THEN
  86. IF(ABS(X(1)).LT.EPS)THEN
  87. IART=2
  88. X(3)=1.D0
  89. X(1)=0.D0
  90. ELSEIF(ABS(X(2)).LT.EPS)THEN
  91. IART=4
  92. X(3)=1.D0
  93. X(2)=0.D0
  94. ELSEIF(ABS(1.D0-X(1)-X(2)).LT.EPS)THEN
  95. IART=6
  96. X(3)=1.D0
  97. X(2)=1.D0-X(1)
  98. ELSE
  99. RETURN
  100. ENDIF
  101. ELSEIF(ABS(1.D0+X(3)).LT.EPS)THEN
  102. IF(ABS(X(1)).LT.EPS)THEN
  103. IART=1
  104. X(3)=-1.D0
  105. X(1)=0.D0
  106. ELSEIF(ABS(X(2)).LT.EPS)THEN
  107. IART=3
  108. X(3)=-1.D0
  109. X(2)=0.D0
  110. ELSEIF(ABS(1.D0-X(1)-X(2)).LT.EPS)THEN
  111. IART=5
  112. X(3)=-1.D0
  113. X(2)=1.D0-X(1)
  114. ELSE
  115. RETURN
  116. ENDIF
  117. ELSEIF(ABS(X(2)).LT.EPS)THEN
  118. IF(ABS(X(1)).LT.EPS)THEN
  119. IART=7
  120. X(2)=0.D0
  121. X(1)=0.D0
  122. ELSEIF(ABS(1.D0-X(1)).LT.EPS)THEN
  123. IART=8
  124. X(1)=1.D0
  125. X(2)=0.D0
  126. ELSE
  127. RETURN
  128. ENDIF
  129. ELSEIF(ABS(1.D0-X(2)).LT.EPS)THEN
  130. IF(ABS(X(1)).LT.EPS)THEN
  131. IART=9
  132. X(2)=1.D0
  133. X(1)=0.D0
  134. ELSE
  135. RETURN
  136. ENDIF
  137. ENDIF
  138. ELSEIF(ITYP.EQ.23)THEN
  139. C L ELEMENT DE REFERENCE EST TETRAEDRE
  140. IF(ABS(X(3)).LT.EPS)THEN
  141. IF(ABS(X(1)).LT.EPS)THEN
  142. IART=2
  143. X(3)=0.D0
  144. X(1)=0.D0
  145. ELSEIF(ABS(X(2)).LT.EPS)THEN
  146. IART=1
  147. X(3)=0.D0
  148. X(2)=0.D0
  149. ELSEIF(ABS(1.D0-X(1)-X(2)).LT.EPS)THEN
  150. IART=4
  151. X(3)=0.D0
  152. X(2)=1.D0-X(1)
  153. ELSE
  154. RETURN
  155. ENDIF
  156. ELSEIF(ABS(X(2)).LT.EPS)THEN
  157. IF(ABS(X(1)).LT.EPS)THEN
  158. IART=3
  159. X(2)=0.D0
  160. X(1)=0.D0
  161. ELSEIF(ABS(1.D0-X(1)-X(3)).LT.EPS)THEN
  162. IART=6
  163. X(2)=0.D0
  164. X(3)=1.D0-X(1)
  165. ELSE
  166. RETURN
  167. ENDIF
  168. ELSEIF(ABS(X(1)).LT.EPS)THEN
  169. IF(ABS(1.D0-X(2)-X(3)).LT.EPS)THEN
  170. IART=5
  171. X(1)=0.D0
  172. X(3)=1.D0-X(2)
  173. ELSE
  174. RETURN
  175. ENDIF
  176. ENDIF
  177. ELSE
  178. CALL ERREUR(16)
  179. ENDIF
  180. RETURN
  181. END
  182.  
  183.  
  184.  

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