1 : C AVSMEL SOURCE FANDEUR 14/01/08 21:15:03 7902 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) ... 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) 162 : CALL ERREUR(701) 163 : ENDIF 164 : 165 : 9000 CONTINUE 166 : C ... Dans le cas d'un ITYPEL inconnu j'incrémente quand même IDECAL, 167 : C ceci laissera un "trou" dans le fichier AVS et permettra (je 168 : C l'espère) trouver l'erreur plus facilement ... 169 : IDECAL=IDECAL+NBELEM 170 : 171 : SEGDES MELEME 172 : 173 : RETURN 174 : C ... Format 50?? correspond à 5000+ITYPEL ... 175 : 5001 FORMAT(I11,I3,' pt',1I11) 176 : 5002 FORMAT(I11,I3,' line',2I11) 177 : 5003 FORMAT(I11,I3,' line',3I11) 178 : 5004 FORMAT(I11,I3,' tri',3I11) 179 : 5006 FORMAT(I11,I3,' tri',6I11) 180 : 5008 FORMAT(I11,I3,' quad',4I11) 181 : 5010 FORMAT(I11,I3,' quad',8I11) 182 : 5014 FORMAT(I11,I3,' hex',8I11) 183 : 5015 FORMAT(I11,I3,' hex',20I11) 184 : 5016 FORMAT(I11,I3,' prism',6I11) 185 : 5017 FORMAT(I11,I3,' prism',15I11) 186 : 5023 FORMAT(I11,I3,' tet',4I11) 187 : 5024 FORMAT(I11,I3,' tet',10I11) 188 : 5025 FORMAT(I11,I3,' pyr',5I11) 189 : 5026 FORMAT(I11,I3,' pyr',13I11) 190 : 191 : END 192 : 193 :
© Cast3M 2003 - All rights reserved.
Disclaimer