Télécharger fermel.eso

Retour à la liste

Numérotation des lignes :

  1. C FERMEL SOURCE BP208322 16/11/18 21:17:12 9177
  2. C FERMEL SOURCE KK2000 98/12/22 21:15:01 3392
  3. SUBROUTINE FERMEL(MAILLA,IDECAL,NUMMAT,IEQUIV,IPTMIN)
  4.  
  5. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  6. C
  7. C But : Sortie vers FER (ASCII) d'un maillage
  8. C (MELEME) élémentaire
  9. C
  10. C Paramètres : MAILLA - pointeur vers le MELEME (entrée)
  11. C IDECAL - décalage des numéros d'éléments (entrée & sortie)
  12. C NUMMAT - numéro du matériau du maillage (entrée)
  13. C#MC 03/12/98
  14. C# NUMMAT n'est plus utilise, il est dans la plupart des cas redondant avec
  15. C# le type de l'element. On prefere sortir le numero de la couleur (+1 pour
  16. C# ne pas commencer a 0)
  17. C
  18. C IEQUIV - segment décrivant la conversion des numéros des noeuds
  19. C IPTMIN - numéro du premier noeud dans IEQUIV
  20. C
  21. C Auteur : Michel Bulik
  22. C Adaptation : Gregory Turbelin
  23. C Novembre 2002
  24. C
  25. C Appelé par : SORFER
  26. C
  27. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  28.  
  29. -INC CCOPTIO
  30. -INC CCGEOME
  31. -INC SMELEME
  32.  
  33. C ... Dans cette subroutine je ne touche pas à IEQUIV, on
  34. C s'en occupe dans LIRAVS ...
  35. SEGMENT IEQUIV
  36. INTEGER LEQUIV(IECART)
  37. END SEGMENT
  38.  
  39. C ... Tableaux de conversion de connectivités (IC<nom_élément>) ...
  40. DIMENSION ICPOI1( 1)
  41. DIMENSION ICSEG2( 2)
  42. DIMENSION ICSEG3( 3)
  43. DIMENSION ICTRI3( 3)
  44. DIMENSION ICTRI6( 6)
  45. DIMENSION ICTRI62( 6)
  46. DIMENSION ICQUA4( 4)
  47. DIMENSION ICQUA8( 8)
  48. DIMENSION ICCUB8( 8)
  49. DIMENSION ICCU20(20)
  50. DIMENSION ICPRI6( 6)
  51. DIMENSION ICPR15(15)
  52. DIMENSION ICTET4( 4)
  53. DIMENSION ICTE10(10)
  54. DIMENSION ICPYR5( 5)
  55. DIMENSION ICPY13(13)
  56.  
  57. DATA ICPOI1 / 1/
  58. DATA ICSEG2 / 1, 2/
  59. DATA ICSEG3 / 1, 2, 3/
  60. DATA ICTRI3 / 1, 2, 3/
  61. DATA ICTRI6 / 1, 2, 3, 4, 5, 6/
  62. DATA ICQUA4 / 1, 2, 3, 4/
  63. DATA ICQUA8 / 1, 2, 3, 4, 5, 6, 7, 8/
  64. DATA ICCUB8 / 1, 2, 3, 4, 5, 6, 7, 8/
  65. DATA ICCU20 / 1, 3, 5, 7,13,15,17,19, 2, 4,
  66. & 6, 8,14,16,18,20, 9,10,11,12/
  67. DATA ICPRI6 / 1, 2, 3, 4, 5, 6/
  68. DATA ICPR15 / 1, 3, 5,10,12,14, 2, 4, 6,11,
  69. & 13,15, 8, 7, 9/
  70. DATA ICTET4 / 1, 2, 3, 4/
  71. DATA ICTE10 / 1, 5, 7, 9, 2, 3, 4, 6, 8,10/
  72. DATA ICPYR5 / 5, 1, 2, 3, 4/
  73. DATA ICPY13 /13, 1, 3, 5, 7, 9,10,11,12, 2,
  74. & 4, 6, 8/
  75.  
  76. MELEME=MAILLA
  77. SEGACT MELEME
  78. NBELEM=NUM(/2)
  79. NBNN=NUM(/1)
  80. IF(NBELEM.EQ.0) RETURN
  81.  
  82. IF(ITYPEL.EQ.1) THEN
  83. DO 3030 J=1,NBELEM
  84. WRITE(IOPER,5001) IDECAL+J,ICOLOR(J)+1,ICOLOR(J)+1,
  85. & LEQUIV(NUM(1,J)-IPTMIN+1)
  86. 3030 CONTINUE
  87. ELSE IF(ITYPEL.EQ.2) THEN
  88. DO 3040 J=1,NBELEM
  89. WRITE(IOPER,5002) IDECAL+J,ICOLOR(J)+1,ICOLOR(J)+1,
  90. & (LEQUIV(NUM(ICSEG2(K),J)-IPTMIN+1),K=1,NBNN)
  91. 3040 CONTINUE
  92. ELSE IF (ITYPEL.EQ.3) THEN
  93. DO 3050 J=1,NBELEM
  94. WRITE(IOPER,5003) IDECAL+J,ICOLOR(J)+1,ICOLOR(J)+1,
  95. & (LEQUIV(NUM(ICSEG3(K),J)-IPTMIN+1),K=1,NBNN)
  96. 3050 CONTINUE
  97.  
  98. ELSE IF (ITYPEL.EQ.4) THEN
  99. DO 3060 J=1,NBELEM
  100. IF(IDIM.EQ.2) THEN
  101. WRITE(IOPER,5004) IDECAL+J,ICOLOR(J)+1,ICOLOR(J)+1,
  102. & (LEQUIV(NUM(ICTRI3(K),J)-IPTMIN+1),K=1,NBNN)
  103. ELSE
  104. WRITE(IOPER,5304) IDECAL+J,ICOLOR(J)+1,ICOLOR(J)+1,
  105. & (LEQUIV(NUM(ICTRI3(K),J)-IPTMIN+1),K=1,NBNN)
  106. ENDIF
  107. 3060 CONTINUE
  108. ELSE IF (ITYPEL.EQ.6) THEN
  109. DO 3070 J=1,NBELEM
  110. IF(IDIM.EQ.2) THEN
  111. WRITE(IOPER,5006) IDECAL+J,ICOLOR(J)+1,ICOLOR(J)+1,
  112. & (LEQUIV(NUM(ICTRI6(K),J)-IPTMIN+1),K=1,NBNN)
  113. ELSE
  114. WRITE(IOPER,5306) IDECAL+J,ICOLOR(J)+1,ICOLOR(J)+1,
  115. & (LEQUIV(NUM(ICTRI6(K),J)-IPTMIN+1),K=1,NBNN)
  116. ENDIF
  117. 3070 CONTINUE
  118. ELSE IF (ITYPEL.EQ.8) THEN
  119. DO 3080 J=1,NBELEM
  120. IF(IDIM.EQ.2) THEN
  121. WRITE(IOPER,5008) IDECAL+J,ICOLOR(J)+1,ICOLOR(J)+1,
  122. & (LEQUIV(NUM(ICQUA4(K),J)-IPTMIN+1),K=1,NBNN)
  123. ELSE
  124. WRITE(IOPER,5308) IDECAL+J,ICOLOR(J)+1,ICOLOR(J)+1,
  125. & (LEQUIV(NUM(ICQUA4(K),J)-IPTMIN+1),K=1,NBNN)
  126. ENDIF
  127. 3080 CONTINUE
  128. ELSE IF (ITYPEL.EQ.10) THEN
  129. DO 3090 J=1,NBELEM
  130. IF(IDIM.EQ.2) THEN
  131. WRITE(IOPER,5010) IDECAL+J,ICOLOR(J)+1,ICOLOR(J)+1,
  132. & (LEQUIV(NUM(ICQUA8(K),J)-IPTMIN+1),K=1,NBNN)
  133. ELSE
  134. WRITE(IOPER,5310) IDECAL+J,ICOLOR(J)+1,ICOLOR(J)+1,
  135. & (LEQUIV(NUM(ICQUA8(K),J)-IPTMIN+1),K=1,NBNN)
  136. ENDIF
  137. 3090 CONTINUE
  138. ELSE IF (ITYPEL.EQ.14) THEN
  139. DO 3100 J=1,NBELEM
  140. WRITE(IOPER,5014) IDECAL+J,ICOLOR(J)+1,ICOLOR(J)+1,
  141. & (LEQUIV(NUM(ICCUB8(K),J)-IPTMIN+1),K=1,NBNN)
  142. 3100 CONTINUE
  143. ELSE IF (ITYPEL.EQ.15) THEN
  144. GOTO 9997
  145. c DO 3110 J=1,NBELEM
  146. c WRITE(IOPER,5015) IDECAL+J,ICOLOR(J)+1,ICOLOR(J)+1,
  147. c & (LEQUIV(NUM(ICCU20(K),J)-IPTMIN+1),K=1,NBNN)
  148. c 3110 CONTINUE
  149.  
  150. ELSE IF (ITYPEL.EQ.16) THEN
  151. GOTO 9997
  152. c DO 3120 J=1,NBELEM
  153. c WRITE(IOPER,5016) IDECAL+J,ICOLOR(J)+1,ICOLOR(J)+1,
  154. c & (LEQUIV(NUM(ICPRI6(K),J)-IPTMIN+1),K=1,NBNN)
  155. c 3120 CONTINUE
  156. ELSE IF (ITYPEL.EQ.17) THEN
  157. GOTO 9997
  158. c DO 3130 J=1,NBELEM
  159. c WRITE(IOPER,5017) IDECAL+J,ICOLOR(J)+1,ICOLOR(J)+1,
  160. c & (LEQUIV(NUM(ICPR15(K),J)-IPTMIN+1),K=1,NBNN)
  161. c 3130 CONTINUE
  162. ELSE IF (ITYPEL.EQ.23) THEN
  163. GOTO 9997
  164. c DO 3140 J=1,NBELEM
  165. c WRITE(IOPER,5023) IDECAL+J,ICOLOR(J)+1,ICOLOR(J)+1,
  166. c & (LEQUIV(NUM(ICTET4(K),J)-IPTMIN+1),K=1,NBNN)
  167. c 3140 CONTINUE
  168. ELSE IF (ITYPEL.EQ.24) THEN
  169. GOTO 9997
  170. c DO 3150 J=1,NBELEM
  171. c WRITE(IOPER,5024) IDECAL+J,ICOLOR(J)+1,ICOLOR(J)+1,
  172. c & (LEQUIV(NUM(ICTE10(K),J)-IPTMIN+1),K=1,NBNN)
  173. c 3150 CONTINUE
  174. ELSE IF (ITYPEL.EQ.25) THEN
  175. GOTO 9997
  176. c DO 3160 J=1,NBELEM
  177. c WRITE(IOPER,5025) IDECAL+J,ICOLOR(J)+1,ICOLOR(J)+1,
  178. c & (LEQUIV(NUM(ICPYR5(K),J)-IPTMIN+1),K=1,NBNN)
  179. c 3160 CONTINUE
  180. ELSE IF (ITYPEL.EQ.26) THEN
  181. GOTO 9997
  182. c DO 3170 J=1,NBELEM
  183. c WRITE(IOPER,5026) IDECAL+J,ICOLOR(J)+1,ICOLOR(J)+1,
  184. c & (LEQUIV(NUM(ICPY13(K),J)-IPTMIN+1),K=1,NBNN)
  185. c 3170 CONTINUE
  186. ELSE
  187. MOTERR(1:4)=NOMS(ITYPEL)
  188. CALL ERREUR(701)
  189. ENDIF
  190. C ... Dans le cas d'un ITYPEL inconnu j'incrémente quand même IDECAL,
  191. C ceci laissera un "trou" dans le fichier AVS et permettra (je
  192. C l'espère) trouver l'erreur plus facilement ...
  193. IDECAL=IDECAL+NBELEM
  194.  
  195. SEGDES MELEME
  196.  
  197. RETURN
  198. C ... Format 50?? correspond à 5000+ITYPEL ...
  199. C ... Format 53?? correspond à la verion 3D ...
  200.  
  201. 5001 FORMAT(I6,' 1',' 99',I3,I3,1I6)
  202. 5002 FORMAT(I6,' 2',' 22',I3,I3,2I6)
  203. 5003 FORMAT(I6,' 3',' 23',I3,I3,3I6)
  204. 5004 FORMAT(I6,' 3',' 23',I3,I3,3I6)
  205. 5304 FORMAT(I6,' 3',' 43',I3,I3,3I6)
  206. 5006 FORMAT(I6,' 6',' 26',I3,I3,6I6)
  207. 5306 FORMAT(I6,' 6',' 46',I3,I3,6I6)
  208. 5008 FORMAT(I6,' 4',' 24',I3,I3,4I6)
  209. 5308 FORMAT(I6,' 4',' 44',I3,I3,4I6)
  210. 5010 FORMAT(I6,' 8',' 28',I3,I3,8I6)
  211. 5310 FORMAT(I6,' 8',' 48',I3,I3,8I6)
  212. 5014 FORMAT(I6,' 8',' 38',I3,I3,8I6)
  213. 5015 FORMAT(I6,' 20',' 320',I3,I3,20I6)
  214. 5023 FORMAT(I6,' 4',' 34',I3,I3,4I6)
  215. 5024 FORMAT(I6,' 10',' 310',I3,I3,10I6)
  216.  
  217. 5016 FORMAT(I6,' 6',' prism',I3,I3,6I6)
  218. 5017 FORMAT(I6,' 15',' prism',I3,I3,15I6)
  219. 5025 FORMAT(I6,' 5',' pyr',I3,I3,5I6)
  220. 5026 FORMAT(I6,' 13',' pyr',I3,I3,13I6)
  221.  
  222.  
  223. *
  224. * Error handling
  225. *
  226. 9997 CONTINUE
  227. WRITE(IOIMP,*) 'Le support géométrique contient'
  228. WRITE(IOIMP,*) 'des types d''éléments non testés'
  229. C WRITE(IOIMP,*) 'Les types déléments supportés sont:'
  230. GOTO 9999
  231.  
  232. 9999 CONTINUE
  233. WRITE(IOIMP,*) 'An error was detected in subroutine fermel'
  234. C Erreur détectée au cours du processus
  235. CALL ERREUR(223)
  236. RETURN
  237. *
  238. * End of subroutine FERMEL
  239. *
  240. END
  241.  
  242.  
  243.  
  244.  
  245.  

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