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

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