Télécharger avsmel.eso

Retour à la liste

Numérotation des lignes :

  1. C AVSMEL SOURCE BP208322 16/11/18 21:15:13 9177
  2.  
  3. SUBROUTINE AVSMEL(MAILLA,IDECAL,NUMMAT,IEQUIV,IPTMIN)
  4.  
  5. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  6. C
  7. C But : Sortie vers AVS (UCD 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# FA7902 corrections tableau conversion elements PR15 TE10
  14. C#MC 03/12/98
  15. C# NUMMAT n'est plus utilise, il est dans la plupart des cas redondant avec
  16. C# le type de l'element. On prefere sortir le numero de la couleur (+1 pour
  17. C# ne pas commencer a 0)
  18. C
  19. C IEQUIV - segment décrivant la conversion des numéros des noeuds
  20. C IPTMIN - numéro du premier noeud dans IEQUIV
  21. C
  22. C Auteur : Michel Bulik
  23. C Novembre 1994
  24. C
  25. C Appelé par : SORAVS
  26. C
  27. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  28.  
  29. IMPLICIT INTEGER(I-N)
  30. IMPLICIT REAL*8(A-H,O-Z)
  31.  
  32. -INC CCOPTIO
  33. -INC CCGEOME
  34.  
  35. -INC SMELEME
  36.  
  37. C ... Dans cette subroutine je ne touche pas à IEQUIV, on
  38. C s'en occupe dans LIRAVS ...
  39. SEGMENT IEQUIV
  40. INTEGER LEQUIV(IECART)
  41. END SEGMENT
  42.  
  43. C ... Tableaux de conversion de connectivités (IC<nom_élément>) ...
  44. C* DIMENSION ICPOI1( 1)
  45. DIMENSION ICSEG2( 2)
  46. DIMENSION ICSEG3( 3)
  47. DIMENSION ICTRI3( 3)
  48. DIMENSION ICTRI6( 6)
  49. DIMENSION ICQUA4( 4)
  50. DIMENSION ICQUA8( 8)
  51. DIMENSION ICCUB8( 8)
  52. DIMENSION ICCU20(20)
  53. DIMENSION ICPRI6( 6)
  54. DIMENSION ICPR15(15)
  55. DIMENSION ICTET4( 4)
  56. DIMENSION ICTE10(10)
  57. DIMENSION ICPYR5( 5)
  58. DIMENSION ICPY13(13)
  59.  
  60. C* DATA ICPOI1 / 1/
  61. DATA ICSEG2 / 1, 2/
  62. DATA ICSEG3 / 1, 3, 2/
  63. DATA ICTRI3 / 1, 2, 3/
  64. DATA ICTRI6 / 1, 3, 5, 2, 4, 6/
  65. DATA ICQUA4 / 1, 2, 3, 4/
  66. DATA ICQUA8 / 1, 3, 5, 7, 2, 4, 6, 8/
  67. DATA ICCUB8 / 1, 2, 3, 4, 5, 6, 7, 8/
  68. DATA ICCU20 / 1, 3, 5, 7,13,15,17,19, 2, 4,
  69. & 6, 8,14,16,18,20, 9,10,11,12/
  70. DATA ICPRI6 / 1, 2, 3, 4, 5, 6/
  71. DATA ICPR15 / 1, 3, 5,10,12,14, 2, 4, 6,11,
  72. & 13,15, 7, 8, 9/
  73. DATA ICTET4 / 1, 2, 3, 4/
  74. DATA ICTE10 / 1, 3, 5,10, 2, 6, 7, 4, 9, 8/
  75. DATA ICPYR5 / 5, 1, 2, 3, 4/
  76. DATA ICPY13 /13, 1, 3, 5, 7, 9,10,11,12, 2,
  77. & 4, 6, 8/
  78.  
  79. MELEME=MAILLA
  80. SEGACT MELEME
  81. NBELEM=NUM(/2)
  82. IF(NBELEM.EQ.0) GOTO 9000
  83. NBNN=NUM(/1)
  84.  
  85. IF(ITYPEL.EQ.1) THEN
  86. DO 3030 J=1,NBELEM
  87. WRITE(IOPER,5001) IDECAL+J,ICOLOR(J)+1,
  88. & LEQUIV(NUM(1,J)-IPTMIN+1)
  89. C* & LEQUIV(NUM(ICPOI1(1),J)-IPTMIN+1)
  90. 3030 CONTINUE
  91. ELSE IF(ITYPEL.EQ.2) THEN
  92. DO 3040 J=1,NBELEM
  93. WRITE(IOPER,5002) IDECAL+J,ICOLOR(J)+1,
  94. & (LEQUIV(NUM(ICSEG2(K),J)-IPTMIN+1),K=1,NBNN)
  95. 3040 CONTINUE
  96. ELSE IF (ITYPEL.EQ.3) THEN
  97. DO 3050 J=1,NBELEM
  98. WRITE(IOPER,5003) IDECAL+J,ICOLOR(J)+1,
  99. & (LEQUIV(NUM(ICSEG3(K),J)-IPTMIN+1),K=1,NBNN)
  100. 3050 CONTINUE
  101. ELSE IF (ITYPEL.EQ.4) THEN
  102. DO 3060 J=1,NBELEM
  103. WRITE(IOPER,5004) IDECAL+J,ICOLOR(J)+1,
  104. & (LEQUIV(NUM(ICTRI3(K),J)-IPTMIN+1),K=1,NBNN)
  105. 3060 CONTINUE
  106. ELSE IF (ITYPEL.EQ.6) THEN
  107. DO 3070 J=1,NBELEM
  108. WRITE(IOPER,5006) IDECAL+J,ICOLOR(J)+1,
  109. & (LEQUIV(NUM(ICTRI6(K),J)-IPTMIN+1),K=1,NBNN)
  110. 3070 CONTINUE
  111. ELSE IF (ITYPEL.EQ.8) THEN
  112. DO 3080 J=1,NBELEM
  113. WRITE(IOPER,5008) IDECAL+J,ICOLOR(J)+1,
  114. & (LEQUIV(NUM(ICQUA4(K),J)-IPTMIN+1),K=1,NBNN)
  115. 3080 CONTINUE
  116. ELSE IF (ITYPEL.EQ.10) THEN
  117. DO 3090 J=1,NBELEM
  118. WRITE(IOPER,5010) IDECAL+J,ICOLOR(J)+1,
  119. & (LEQUIV(NUM(ICQUA8(K),J)-IPTMIN+1),K=1,NBNN)
  120. 3090 CONTINUE
  121. ELSE IF (ITYPEL.EQ.14) THEN
  122. DO 3100 J=1,NBELEM
  123. WRITE(IOPER,5014) IDECAL+J,ICOLOR(J)+1,
  124. & (LEQUIV(NUM(ICCUB8(K),J)-IPTMIN+1),K=1,NBNN)
  125. 3100 CONTINUE
  126. ELSE IF (ITYPEL.EQ.15) THEN
  127. DO 3110 J=1,NBELEM
  128. WRITE(IOPER,5015) IDECAL+J,ICOLOR(J)+1,
  129. & (LEQUIV(NUM(ICCU20(K),J)-IPTMIN+1),K=1,NBNN)
  130. 3110 CONTINUE
  131. ELSE IF (ITYPEL.EQ.16) THEN
  132. DO 3120 J=1,NBELEM
  133. WRITE(IOPER,5016) IDECAL+J,ICOLOR(J)+1,
  134. & (LEQUIV(NUM(ICPRI6(K),J)-IPTMIN+1),K=1,NBNN)
  135. 3120 CONTINUE
  136. ELSE IF (ITYPEL.EQ.17) THEN
  137. DO 3130 J=1,NBELEM
  138. WRITE(IOPER,5017) IDECAL+J,ICOLOR(J)+1,
  139. & (LEQUIV(NUM(ICPR15(K),J)-IPTMIN+1),K=1,NBNN)
  140. 3130 CONTINUE
  141. ELSE IF (ITYPEL.EQ.23) THEN
  142. DO 3140 J=1,NBELEM
  143. WRITE(IOPER,5023) IDECAL+J,ICOLOR(J)+1,
  144. & (LEQUIV(NUM(ICTET4(K),J)-IPTMIN+1),K=1,NBNN)
  145. 3140 CONTINUE
  146. ELSE IF (ITYPEL.EQ.24) THEN
  147. DO 3150 J=1,NBELEM
  148. WRITE(IOPER,5024) IDECAL+J,ICOLOR(J)+1,
  149. & (LEQUIV(NUM(ICTE10(K),J)-IPTMIN+1),K=1,NBNN)
  150. 3150 CONTINUE
  151. ELSE IF (ITYPEL.EQ.25) THEN
  152. DO 3160 J=1,NBELEM
  153. WRITE(IOPER,5025) IDECAL+J,ICOLOR(J)+1,
  154. & (LEQUIV(NUM(ICPYR5(K),J)-IPTMIN+1),K=1,NBNN)
  155. 3160 CONTINUE
  156. ELSE IF (ITYPEL.EQ.26) THEN
  157. DO 3170 J=1,NBELEM
  158. WRITE(IOPER,5026) IDECAL+J,ICOLOR(J)+1,
  159. & (LEQUIV(NUM(ICPY13(K),J)-IPTMIN+1),K=1,NBNN)
  160. 3170 CONTINUE
  161. ELSE
  162. MOTERR(1:4)=NOMS(ITYPEL)
  163. CALL ERREUR(701)
  164. ENDIF
  165.  
  166. 9000 CONTINUE
  167. C ... Dans le cas d'un ITYPEL inconnu j'incrémente quand même IDECAL,
  168. C ceci laissera un "trou" dans le fichier AVS et permettra (je
  169. C l'espère) trouver l'erreur plus facilement ...
  170. IDECAL=IDECAL+NBELEM
  171.  
  172. SEGDES MELEME
  173.  
  174. RETURN
  175. C ... Format 50?? correspond à 5000+ITYPEL ...
  176. 5001 FORMAT(I11,I3,' pt',1I11)
  177. 5002 FORMAT(I11,I3,' line',2I11)
  178. 5003 FORMAT(I11,I3,' line',3I11)
  179. 5004 FORMAT(I11,I3,' tri',3I11)
  180. 5006 FORMAT(I11,I3,' tri',6I11)
  181. 5008 FORMAT(I11,I3,' quad',4I11)
  182. 5010 FORMAT(I11,I3,' quad',8I11)
  183. 5014 FORMAT(I11,I3,' hex',8I11)
  184. 5015 FORMAT(I11,I3,' hex',20I11)
  185. 5016 FORMAT(I11,I3,' prism',6I11)
  186. 5017 FORMAT(I11,I3,' prism',15I11)
  187. 5023 FORMAT(I11,I3,' tet',4I11)
  188. 5024 FORMAT(I11,I3,' tet',10I11)
  189. 5025 FORMAT(I11,I3,' pyr',5I11)
  190. 5026 FORMAT(I11,I3,' pyr',13I11)
  191.  
  192. END
  193.  
  194.  
  195.  
  196.  
  197.  

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