1 : C LIREFI SOURCE JC220346 13/12/19 21:15:04 7889 2 : C ROUTINE DE RELECTURE D'UN MAILLAGE SAUVE ANTERIEUREMENT 3 : C EVENTUELLEMENT COMMUNICATION AVEC UN AUTRE PROGRAMME 4 : C AUCUN ARGUMENT NE PARAIT NECESSAIRE 5 : C LES OBJETS DEJA EXISTANT AYANT LE MEME NOM SERONT ECRASES 6 : C 7 : SUBROUTINE LIREFI 8 : 9 : IMPLICIT INTEGER(I-N) 10 : IMPLICIT REAL*8(A-H,O-Z) 11 : 12 : -INC CCOPTIO 13 : -INC CCGEOME 14 : -INC SMELEME 15 : -INC SMCOORD 16 : 17 : CHARACTER*80 TEX 18 : SEGMENT NOMCL 19 : CHARACTER*4 CNOMCL(NBELEM) 20 : ENDSEGMENT 21 : SEGMENT ISGT 22 : INTEGER ISGTR(ILONG) 23 : ENDSEGMENT 24 : SEGMENT CSGT 25 : CHARACTER*8 CSGTR(ILONG) 26 : ENDSEGMENT 27 : SEGMENT JSGTR(ILONG) 28 : SEGMENT ILIST(ILONG) 29 : CHARACTER*8 ITTEMP 30 : CHARACTER*8 ICAR 31 : CHARACTER*4 NOMLU 32 : 33 : PARAMETER (NTYPRO=5) 34 : CHARACTER*4 MOPROG(NTYPRO) 35 : 36 : DATA MOPROG / 'AVS ','MED ','UNV ', 'FEM ', 'PROC' / 37 : 38 : CMB. Recherche du mot signifiant le type de la sortie ... 38 : CALL LIRMOT(MOPROG,NTYPRO,ITYPRO,0) 39 : 40 : CMB... Lecture du fichier AVS (UCD ASCII) ... 41 : IF (ITYPRO.EQ.1) THEN 42 : CDEBUG WRITE(IOIMP,3001) 43 : CDEBUG 3001 FORMAT('Lecture du fichier AVS') 43 : CALL LIRAVS 44 : RETURN 45 : 46 : C ... Lecture du fichier MED ... 47 : ELSE IF (ITYPRO.EQ.2) THEN 47 : CALL MEDR 48 : RETURN 49 : 50 : C ... Lecture du fichier UNV I-DEAS(R) ... 51 : ELSE IF (ITYPRO.EQ.3) THEN 52 : CDEBUG WRITE(IOIMP,3003) 53 : CDEBUG 3003 FORMAT('Lecture du fichier UNV') 53 : CALL LIRUNV 54 : RETURN 55 : 56 : C ... Lecture du fichier FEM 57 : ELSE IF (ITYPRO.EQ.4) THEN 58 : CDEBUG WRITE(IOIMP,3004) 59 : CDEBUG 3004 FORMAT('Lecture du fichier FEM') 59 : CALL LIRFEM 60 : RETURN 61 : 62 : C ... Lecture d'un fichier PROCEDUR 63 : ELSE IF (ITYPRO.EQ.5) THEN 64 : CDEBUG WRITE(IOIMP,3005) 65 : CDEBUG 3005 FORMAT('Lecture du fichier PROC') 65 : CALL LIPROC 66 : RETURN 67 : 68 : ENDIF 69 : 70 : CMB ... Ici commence l'ancienne lecture (Castem) ... 71 : 71 : CALL QUETYP(ICAR,0,IRET1) 72 : IF (IERR.NE.0) RETURN 73 : IF(IRET1.NE.0) THEN 73 : CALL LIROBJ(ICAR,IPROUT,1,IRETOU) 74 : IF (IERR.NE.0) RETURN 75 : ENDIF 76 : * 77 : READ (IOCAR,100,END=1000,ERR=1000) TEX 78 : 100 FORMAT (A80) 79 : * 80 : IF(IRET1.NE.0) THEN 80 : CALL QUENOM(ICAR) 81 : MOTERR(1:8)=ICAR 81 : IF (TEX(1:8).NE.ICAR) CALL ERREUR(9) 82 : IF (IERR.NE.0) RETURN 83 : ENDIF 84 : * 85 : TITREE=TEX(1:72) 86 : IF (IIMPI.NE.0) WRITE(IOIMP,200) TEX(1:72) 87 : 200 FORMAT (1X,A72) 88 : 89 : READ (IOCAR,101,END=1000,ERR=1000) IONIVE 90 : 101 FORMAT(34X,I3) 91 : 92 : IF (IONIVE.GT.2) GOTO 1000 93 : 93 : CALL NOMENT('&NIVE',IONIVE) 94 : READ(IOCAR,102,END=1000,ERR=1000) IaRR,JDIM,DENSIT 95 : 102 FORMAT(6X,I4,10X,I4,9X,E12.5) 96 : 97 : IF (IIMPI.NE.0) WRITE (IOIMP,201) IaRR,JDIM,DENSIT 98 : 201 FORMAT (1X,'ERREUR ',I2,' DIMENSION ',I2,' DENSITE ',1PE12.5) 99 : 100 : IERMAX=MAX(IERMAX,IaRR) 101 : * IERR=0 101 : CALL GINT2 102 : IF (IDIM.EQ.0) IDIM=JDIM 102 : IF (JDIM.NE.IDIM) CALL ERREUR(12) 102 : CALL NOMENT('&DIME',IDIM) 103 : 104 : READ (IOCAR,103,END=1000,ERR=1000) INOMB 105 : 103 FORMAT(17X,I8) 106 : IF (IIMPI.NE.0) WRITE (IOIMP,202) INOMB 107 : 202 FORMAT(' NOMBRE DE POINTS A LIRE ',I8) 108 : 109 : SEGACT MCOORD 110 : NBANC=XCOOR(/1)/(IDIM+1) 111 : NBNOUV=NBANC+INOMB 112 : NBPTS=NBNOUV 113 : SEGADJ MCOORD 114 : NDEBB=NBANC+1 115 : NBC=IDIM+1 116 : READ (IOCAR,104,ERR=1000,END=1000) ((XCOOR((J-1)*(IDIM+1)+I),I=1, 117 : # NBC),J=NDEBB,NBNOUV) 118 : 104 FORMAT (6E12.5) 119 : 120 : C LECTURE DES POINTS NOMMES 121 : READ (IOCAR,105,END=1000,ERR=1000) ILONG 122 : 105 FORMAT(23X,I8) 123 : IF (ILONG.NE.0) THEN 124 : SEGINI ISGT,CSGT 125 : READ (IOCAR,106,END=1000,ERR=1000)(CSGTR(I),ISGTR(I),I=1,ILONG) 126 : 106 FORMAT(5(A8,I8)) 127 : IF (IIMPI.NE.0) WRITE (IOIMP,203)(CSGTR(I),ISGTR(I),I=1,ILONG) 128 : 203 FORMAT(' LISTE DES POINTS NOMMES',/,5(1X,A8,I8)) 129 : DO 5 I=1,ILONG 130 : ITTEMP=CSGTR(I) 131 : ITVAL=ISGTR(I)+NBANC 131 : CALL NOMOBJ('POINT',ITTEMP,ITVAL) 132 : 5 CONTINUE 133 : SEGSUP ISGT,CSGT 134 : ENDIF 135 : 136 : C LECTURE DES OBJETS 137 : READ (IOCAR,116,END=1000,ERR=1000) ILONG 138 : 116 FORMAT (16X,I8) 139 : 140 : IF (IIMPI.NE.0) WRITE (IOIMP,204) ILONG 141 : 204 FORMAT (' NOMBRE D''OBJETS',I8) 142 : 143 : SEGINI JSGTR 144 : DO 7 IOB=1,ILONG 145 : IF (IONIVE.LE.1) THEN 146 : READ (IOCAR,107,END=1000,ERR=1000) NOMLU,NBSOUS,NBREF, 147 : + NBNN,NBELEM 148 : 107 FORMAT(A4,12X,I4,11X,I4,10X,I4,8X,I4) 149 : ELSE 150 : READ (IOCAR,1107,END=1000,ERR=1000) NOMLU,NBSOUS,NBREF, 151 : + NBNN,NBELEM 152 : 1107 FORMAT(A4,12X,I4,11X,I4,10X,I4,7X,I5) 153 : ENDIF 154 : IF (IIMPI.NE.0) WRITE(IOIMP,205) NOMLU,NBSOUS,NBREF,NBNN,NBELEM 155 : 205 FORMAT(' NOMLU ',A4,' NBSOUS ',I4,' NBREF ',I4,'NBNN ',I4,' NBELEM 156 : # ',I4) 157 : 158 : SEGINI MELEME 159 : JSGTR(IOB)=MELEME 160 : IF (NBSOUS.NE.0) 161 : + READ(IOCAR,108,END=1000,ERR=1000) (LISOUS(I),I=1,NBSOUS) 162 : 108 FORMAT(20I4) 163 : 164 : IF (NBREF.NE.0) 165 : + READ(IOCAR,108,END=1000,ERR=1000) (LISREF(I),I=1,NBREF) 166 : 167 : IF (NBELEM.EQ.0) GOTO 7 168 : 169 : C ... EST CE UN TYPE D'ELEM CONNU 170 : DO 10 I=1,NOMBR 171 : IF (NOMLU.EQ.NOMS(I)) GOTO 11 172 : 10 CONTINUE 173 : SEGSUP MELEME,JSGTR 174 : RETURN 175 : 11 ITYPEL=I 176 : IF( IONIVE .EQ. 0 ) THEN 177 : DO 1800 I = 1,NBELEM 178 : ICOLOR(I)=IDCOUL 179 : 1800 CONTINUE 180 : ELSE 181 : SEGINI NOMCL 182 : READ (IOCAR,112,END=1000,ERR=1000)(CNOMCL(I),I=1,NBELEM) 183 : 112 FORMAT (16(1X,A4)) 184 : DO 18 I=1,NBELEM 185 : IREP=IDCOUL 186 : DO 19 J=0,NBCOUL 187 : IF (CNOMCL(I).EQ.NCOUL(J)) IREP=J 188 : 19 CONTINUE 189 : ICOLOR(I)=IREP 190 : 18 CONTINUE 191 : SEGSUP NOMCL 192 : ENDIF 193 : READ (IOCAR,111,END=1000,ERR=1000)((NUM(I,J),I=1,NBNN), 194 : + J=1,NBELEM) 195 : 111 FORMAT (16I5) 196 : 7 CONTINUE 197 : 198 : DO 12 I=1,ILONG 199 : MELEME=JSGTR(I) 200 : IF (LISOUS(/1).NE.0) THEN 201 : DO 14 J=1,LISOUS(/1) 202 : LISOUS(J)=JSGTR(LISOUS(J)) 203 : 14 CONTINUE 204 : ENDIF 205 : IF (LISREF(/1).NE.0) THEN 206 : DO 16 J=1,LISREF(/1) 207 : LISREF(J)=JSGTR(LISREF(J)) 208 : 16 CONTINUE 209 : ENDIF 210 : DO 17 IK=1,NUM(/1) 211 : DO 17 JK=1,NUM(/2) 212 : NUM(IK,JK)=NUM(IK,JK)+NBANC 213 : 17 CONTINUE 214 : SEGDES MELEME 215 : 12 CONTINUE 216 : 217 : READ (IOCAR,109,ERR=1000,END=1000) INN 218 : 109 FORMAT(22X,I8) 219 : 220 : ILONG=3*INN 221 : SEGINI ILIST 222 : READ (IOCAR,110,END=1000,ERR=1000)(ILIST(I),I=1,ILONG) 223 : 110 FORMAT(5(2A4,I8)) 224 : 225 : IF (IIMPI.NE.0) WRITE (IOIMP,206) (ILIST(I),I=1,ILONG) 226 : 206 FORMAT (' LISTE DES OBJETS NOMMES',/,5(1X,2A4,I8)) 227 : 228 : DO 25 I=1,ILONG,3 229 : WRITE(ITTEMP,FMT='(2A4)')ILIST(I),ILIST(I+1) 230 : ITVAL=JSGTR(ILIST(I+2)) 230 : CALL NOMOBJ('MAILLAGE',ITTEMP,ITVAL) 231 : 25 CONTINUE 232 : SEGSUP JSGTR,ILIST 233 : C 234 : C **** LECTURE DU FICHIER TTMF 235 : C 236 : READ(IOCAR,1002,END=1001) IQUOI 237 : 1002 FORMAT(7X,I5) 238 : 238 : CALL RESTSO(IQUOI,NBANC) 239 : 1001 CONTINUE 240 : RETURN 241 : 242 : 1000 CONTINUE 242 : CALL ERREUR(26) 243 : RETURN 244 : END 245 : 246 : 247 : 248 : 249 :
© Cast3M 2003 - All rights reserved.
Disclaimer