Télécharger kdom9.eso

Retour à la liste

Numérotation des lignes :

  1. C KDOM9 SOURCE KK2000 14/04/10 21:15:15 8032
  2. SUBROUTINE KDOM9(NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10,
  3. & NN11,NN12,NN13,NN14,NN15,NN16,NN17,NN18,NN19,NN20,
  4. & NN21,NN22,NN23,NN24,NN25,NN26,NN27)
  5. C
  6. C************************************************************************
  7. C
  8. C PROJET : CASTEM 2000
  9. C
  10. C NOM : KDOM9
  11. C
  12. C DESCRIPTION : This subroutine check whether NN27 is inside of
  13. C the CU27
  14. C
  15. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  16. C
  17. C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/LTMF
  18. C
  19. C************************************************************************
  20. C
  21. C
  22.  
  23. IMPLICIT INTEGER(I-N)
  24. IMPLICIT REAL*8(A-H,O-Z)
  25.  
  26. INTEGER NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10,
  27. & NN11,NN12,NN13,NN14,NN15,NN16,NN17,NN18,NN19,NN20,
  28. & NN21,NN22,NN23,NN24,NN25,NN26,NN27, I1, IPCEN, IPL, IPR
  29. REAL*8 DX0,DY0,DZ0,DX1,DY1,DZ1,NORX1,NORY1,NORZ1,PSCA0,PSCA1
  30. C
  31. -INC CCOPTIO
  32. -INC SMCOORD
  33. C
  34. C**** First triangle
  35. C
  36. IPCEN=NN1
  37. IPR=NN25
  38. IPL=NN7
  39. DX0=XCOOR((IPR-1)*(IDIM+1)+1)-
  40. & XCOOR((IPCEN-1)*(IDIM+1)+1)
  41. DY0=XCOOR((IPR-1)*(IDIM+1)+2)-
  42. & XCOOR((IPCEN-1)*(IDIM+1)+2)
  43. DZ0=XCOOR((IPR-1)*(IDIM+1)+3)-
  44. & XCOOR((IPCEN-1)*(IDIM+1)+3)
  45. DX1=XCOOR((IPL-1)*(IDIM+1)+1)-
  46. & XCOOR((IPCEN-1)*(IDIM+1)+1)
  47. DY1=XCOOR((IPL-1)*(IDIM+1)+2)-
  48. & XCOOR((IPCEN-1)*(IDIM+1)+2)
  49. DZ1=XCOOR((IPL-1)*(IDIM+1)+3)-
  50. & XCOOR((IPCEN-1)*(IDIM+1)+3)
  51. NORX1=(DY0*DZ1-DY1*DZ0)
  52. NORY1=(DZ0*DX1-DZ1*DX0)
  53. NORZ1=(DX0*DY1-DX1*DY0)
  54. C
  55. C The scalar product between this normal and
  56. C CENTRE-IPCEN
  57. C
  58. DX1=XCOOR((IPCEN-1)*(IDIM+1)+1)-
  59. & XCOOR((NN27-1)*(IDIM+1)+1)
  60. DY1=XCOOR((IPCEN-1)*(IDIM+1)+2)-
  61. & XCOOR((NN27-1)*(IDIM+1)+2)
  62. DZ1=XCOOR((IPCEN-1)*(IDIM+1)+3)-
  63. & XCOOR((NN27-1)*(IDIM+1)+3)
  64. PSCA0=DX1*NORX1+DY1*NORY1+DZ1*NORZ1
  65. C
  66. C The other triangles
  67. C
  68. DO I1=1,23
  69. IF(I1.EQ.1)THEN
  70. IPCEN=NN3
  71. IPR=NN25
  72. IPL=NN1
  73. ELSEIF(I1.EQ.2)THEN
  74. IPCEN=NN5
  75. IPR=NN25
  76. IPL=NN3
  77. ELSEIF(I1.EQ.3)THEN
  78. IPCEN=NN7
  79. IPR=NN25
  80. IPL=NN5
  81. ELSEIF(I1.EQ.4)THEN
  82. IPCEN=NN13
  83. IPR=NN26
  84. IPL=NN15
  85. ELSEIF(I1.EQ.5)THEN
  86. IPCEN=NN19
  87. IPR=NN26
  88. IPL=NN13
  89. ELSEIF(I1.EQ.6)THEN
  90. IPCEN=NN17
  91. IPR=NN26
  92. IPL=NN19
  93. ELSEIF(I1.EQ.7)THEN
  94. IPCEN=NN15
  95. IPR=NN26
  96. IPL=NN17
  97. ELSEIF(I1.EQ.8)THEN
  98. IPCEN=NN1
  99. IPR=NN21
  100. IPL=NN3
  101. ELSEIF(I1.EQ.9)THEN
  102. IPCEN=NN13
  103. IPR=NN21
  104. IPL=NN1
  105. ELSEIF(I1.EQ.10)THEN
  106. IPCEN=NN15
  107. IPR=NN21
  108. IPL=NN13
  109. ELSEIF(I1.EQ.11)THEN
  110. IPCEN=NN3
  111. IPR=NN21
  112. IPL=NN15
  113. ELSEIF(I1.EQ.12)THEN
  114. IPCEN=NN3
  115. IPR=NN22
  116. IPL=NN5
  117. ELSEIF(I1.EQ.13)THEN
  118. IPCEN=NN15
  119. IPR=NN22
  120. IPL=NN3
  121. ELSEIF(I1.EQ.14)THEN
  122. IPCEN=NN17
  123. IPR=NN22
  124. IPL=NN15
  125. ELSEIF(I1.EQ.15)THEN
  126. IPCEN=NN5
  127. IPR=NN22
  128. IPL=NN17
  129. ELSEIF(I1.EQ.16)THEN
  130. IPCEN=NN7
  131. IPR=NN23
  132. IPL=NN19
  133. ELSEIF(I1.EQ.17)THEN
  134. IPCEN=NN5
  135. IPR=NN23
  136. IPL=NN7
  137. ELSEIF(I1.EQ.18)THEN
  138. IPCEN=NN17
  139. IPR=NN23
  140. IPL=NN5
  141. ELSEIF(I1.EQ.19)THEN
  142. IPCEN=NN19
  143. IPR=NN23
  144. IPL=NN17
  145. ELSEIF(I1.EQ.20)THEN
  146. IPCEN=NN1
  147. IPR=NN24
  148. IPL=NN13
  149. ELSEIF(I1.EQ.21)THEN
  150. IPCEN=NN7
  151. IPR=NN24
  152. IPL=NN1
  153. ELSEIF(I1.EQ.22)THEN
  154. IPCEN=NN19
  155. IPR=NN24
  156. IPL=NN7
  157. ELSEIF(I1.EQ.23)THEN
  158. IPCEN=NN13
  159. IPR=NN24
  160. IPL=NN19
  161. ENDIF
  162. DX0=XCOOR((IPR-1)*(IDIM+1)+1)-
  163. & XCOOR((IPCEN-1)*(IDIM+1)+1)
  164. DY0=XCOOR((IPR-1)*(IDIM+1)+2)-
  165. & XCOOR((IPCEN-1)*(IDIM+1)+2)
  166. DZ0=XCOOR((IPR-1)*(IDIM+1)+3)-
  167. & XCOOR((IPCEN-1)*(IDIM+1)+3)
  168. DX1=XCOOR((IPL-1)*(IDIM+1)+1)-
  169. & XCOOR((IPCEN-1)*(IDIM+1)+1)
  170. DY1=XCOOR((IPL-1)*(IDIM+1)+2)-
  171. & XCOOR((IPCEN-1)*(IDIM+1)+2)
  172. DZ1=XCOOR((IPL-1)*(IDIM+1)+3)-
  173. & XCOOR((IPCEN-1)*(IDIM+1)+3)
  174. NORX1=(DY0*DZ1-DY1*DZ0)
  175. NORY1=(DZ0*DX1-DZ1*DX0)
  176. NORZ1=(DX0*DY1-DX1*DY0)
  177. C
  178. C The scalar product between this normal and
  179. C CENTRE-IPCEN
  180. C
  181. DX1=XCOOR((IPCEN-1)*(IDIM+1)+1)-
  182. & XCOOR((NN27-1)*(IDIM+1)+1)
  183. DY1=XCOOR((IPCEN-1)*(IDIM+1)+2)-
  184. & XCOOR((NN27-1)*(IDIM+1)+2)
  185. DZ1=XCOOR((IPCEN-1)*(IDIM+1)+3)-
  186. & XCOOR((NN27-1)*(IDIM+1)+3)
  187. PSCA1=DX1*NORX1+DY1*NORY1+DZ1*NORZ1
  188. IF((PSCA1*PSCA0) .LT.0)THEN
  189. C
  190. WRITE(IOIMP,*) 'CU27'
  191. C
  192. C Erreur -107 0
  193. C Liste des noeuds de l'élément :
  194. C
  195. WRITE(IOIMP,*) 'Subroutine kdom9.eso'
  196. CALL ERREUR(-107)
  197. WRITE(IOIMP,*) NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10
  198. WRITE(IOIMP,*) NN11,NN12,NN13,NN14,NN15,NN16,NN17,NN18,NN19
  199. $ ,NN20
  200. WRITE(IOIMP,*) NN21,NN22,NN23,NN24,NN25,NN26,NN27
  201. C
  202. C Erreur 845 2
  203. C Maillage donné incorrect ?!!!
  204. C
  205. CALL ERREUR(845)
  206. C
  207. GOTO 9999
  208. ENDIF
  209. ENDDO
  210. C
  211. 9999 RETURN
  212. END
  213.  
  214.  
  215.  
  216.  

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