C LIREFI SOURCE OF166741 24/11/14 21:15:17 12078 C ROUTINE DE RELECTURE D'UN MAILLAGE SAUVE ANTERIEUREMENT C EVENTUELLEMENT COMMUNICATION AVEC UN AUTRE PROGRAMME C AUCUN ARGUMENT NE PARAIT NECESSAIRE C LES OBJETS DEJA EXISTANT AYANT LE MEME NOM SERONT ECRASES C SUBROUTINE LIREFI IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCGEOME -INC SMELEME -INC SMCOORD CHARACTER*80 TEX SEGMENT NOMCL CHARACTER*4 CNOMCL(NBELEM) ENDSEGMENT SEGMENT ISGT INTEGER ISGTR(ILONG) ENDSEGMENT SEGMENT CSGT CHARACTER*8 CSGTR(ILONG) ENDSEGMENT SEGMENT JSGTR(ILONG) SEGMENT ILIST(ILONG) CHARACTER*8 ITTEMP CHARACTER*8 ICAR CHARACTER*4 NOMLU PARAMETER (NTYPRO=8) CHARACTER*4 MOPROG(NTYPRO) INTEGER ITYPRO DATA MOPROG / 'AVS ','MED ','UNV ', 'FEM ', 'PROC','CSV ','NAS ', & 'STL '/ ITYPRO=0 C Recherche du mot signifiant le type de la lecture CALL LIRMOT(MOPROG,NTYPRO,ITYPRO,0) C Redirection directe vers le bon type de fichier GOTO(7001,7002,7003,7004,7005,7006,7007,7008),ITYPRO C Si ITYPRO=0 on va en 999 GOTO 999 C Lecture du fichier AVS (UCD ASCII) ... 7001 CONTINUE CDEBUG WRITE(IOIMP,3001) CDEBUG 3001 FORMAT('Lecture du fichier AVS') CALL LIRAVS RETURN C Lecture du fichier MED ... 7002 CONTINUE CALL LIRMED RETURN C Lecture du fichier UNV I-DEAS(R) ... 7003 CONTINUE CDEBUG WRITE(IOIMP,3003) CDEBUG 3003 FORMAT('Lecture du fichier UNV') CALL LIRUNV RETURN C Lecture du fichier FEM 7004 CONTINUE CDEBUG WRITE(IOIMP,3004) CDEBUG 3004 FORMAT('Lecture du fichier FEM') CALL LIRFEM RETURN C Lecture d'un fichier PROCEDUR 7005 CONTINUE CDEBUG WRITE(IOIMP,3005) CDEBUG 3005 FORMAT('Lecture du fichier PROC') CALL LIPROC RETURN C Lecture d'un fichier CSV 7006 CONTINUE CDEBUG WRITE(IOIMP,3006) CDEBUG 3006 FORMAT('Lecture du fichier CSV') CALL LIRCSV RETURN C Lecture d'un fichier NAS 7007 CONTINUE CDEBUG WRITE(IOIMP,3007) CDEBUG 3007 FORMAT('Lecture du fichier NAS') CALL LIRNAS RETURN C Lecture d'un fichier STL 7008 CONTINUE CDEBUG WRITE(IOIMP,3008) CDEBUG 3008 FORMAT('Lecture du fichier STL') CALL LIRSTL RETURN CMB ... Ici commence l'ancienne lecture (Castem) ... 999 CONTINUE CALL QUETYP(ICAR,0,IRET1) IF (IERR.NE.0) RETURN IF(IRET1.NE.0) THEN CALL LIROBJ(ICAR,IPROUT,1,IRETOU) IF (IERR.NE.0) RETURN ENDIF READ (IOCAR,100,END=1000,ERR=1000) TEX 100 FORMAT (A80) IF(IRET1.NE.0) THEN CALL QUENOM(ICAR) MOTERR(1:8)=ICAR IF (TEX(1:8).NE.ICAR) CALL ERREUR(9) IF (IERR.NE.0) RETURN ENDIF TITREE=TEX(1:72) IF (IIMPI.NE.0) WRITE(IOIMP,200) TEX(1:72) 200 FORMAT (1X,A72) READ (IOCAR,101,END=1000,ERR=1000) NIVOLU 101 FORMAT(34X,I3) IF (IIMPI.NE.0) WRITE(IOIMP,*) 'NIVEAU ',NIVOLU IF (NIVOLU.GT.2) GOTO 1000 CALL NOMENT('&NIVE',NIVOLU) READ(IOCAR,102,END=1000,ERR=1000) IaRR,JDIM,DENSIT 102 FORMAT(6X,I4,10X,I4,9X,E12.5) IF (IIMPI.NE.0) WRITE (IOIMP,201) IaRR,JDIM,DENSIT 201 FORMAT (1X,'ERREUR ',I2,' DIMENSION ',I2,' DENSITE ',1PE12.5) IERMAX=MAX(IERMAX,IaRR) * IERR=0 CALL GINT2 IF (IDIM.EQ.0) IDIM=JDIM IF (JDIM.NE.IDIM) CALL ERREUR(12) CALL NOMENT('&DIME',IDIM) READ (IOCAR,103,END=1000,ERR=1000) INOMB 103 FORMAT(17X,I8) IF (IIMPI.NE.0) WRITE (IOIMP,202) INOMB 202 FORMAT(' NOMBRE DE POINTS A LIRE ',I8) SEGACT MCOORD*mod NBANC=nbpts NBNOUV=NBANC+INOMB NBPTS=NBNOUV SEGADJ MCOORD NDEBB=NBANC+1 NBC=IDIM+1 READ (IOCAR,104,ERR=1000,END=1000) ((XCOOR((J-1)*(IDIM+1)+I),I=1, # NBC),J=NDEBB,NBNOUV) 104 FORMAT (6E12.5) C LECTURE DES POINTS NOMMES READ (IOCAR,105,END=1000,ERR=1000) ILONG 105 FORMAT(23X,I8) IF (ILONG.NE.0) THEN SEGINI ISGT,CSGT READ (IOCAR,106,END=1000,ERR=1000)(CSGTR(I),ISGTR(I),I=1,ILONG) 106 FORMAT(5(A8,I8)) IF (IIMPI.NE.0) WRITE (IOIMP,203)(CSGTR(I),ISGTR(I),I=1,ILONG) 203 FORMAT(' LISTE DES POINTS NOMMES',/,5(1X,A8,I8)) DO 5 I=1,ILONG ITTEMP=CSGTR(I) ITVAL=ISGTR(I)+NBANC CALL NOMOBJ('POINT',ITTEMP,ITVAL) 5 CONTINUE SEGSUP ISGT,CSGT ENDIF C LECTURE DES OBJETS READ (IOCAR,116,END=1000,ERR=1000) ILONG 116 FORMAT (16X,I8) IF (IIMPI.NE.0) WRITE (IOIMP,204) ILONG 204 FORMAT (' NOMBRE D''OBJETS',I8) SEGINI JSGTR DO 7 IOB=1,ILONG IF (NIVOLU.LE.1) THEN READ (IOCAR,107,END=1000,ERR=1000) NOMLU,NBSOUS,NBREF, + NBNN,NBELEM 107 FORMAT(A4,12X,I4,11X,I4,10X,I4,8X,I4) ELSE READ (IOCAR,1107,END=1000,ERR=1000) NOMLU,NBSOUS,NBREF, + NBNN,NBELEM 1107 FORMAT(A4,12X,I4,11X,I4,10X,I4,7X,I5) ENDIF IF (IIMPI.NE.0) WRITE(IOIMP,205) NOMLU,NBSOUS,NBREF,NBNN,NBELEM 205 FORMAT(' NOMLU ',A4,' NBSOUS ',I4,' NBREF ',I4,'NBNN ',I4,' NBELEM # ',I4) SEGINI MELEME JSGTR(IOB)=MELEME IF (NBSOUS.NE.0) + READ(IOCAR,108,END=1000,ERR=1000) (LISOUS(I),I=1,NBSOUS) 108 FORMAT(20I4) IF (NBREF.NE.0) + READ(IOCAR,108,END=1000,ERR=1000) (LISREF(I),I=1,NBREF) IF (NBELEM.EQ.0) GOTO 7 C ... EST CE UN TYPE D'ELEM CONNU DO 10 I=1,NOMBR IF (NOMLU.EQ.NOMS(I)) GOTO 11 10 CONTINUE SEGSUP MELEME,JSGTR RETURN 11 ITYPEL=I IF( NIVOLU .EQ. 0 ) THEN DO 1800 I = 1,NBELEM ICOLOR(I)=IDCOUL 1800 CONTINUE ELSE SEGINI NOMCL READ (IOCAR,112,END=1000,ERR=1000)(CNOMCL(I),I=1,NBELEM) 112 FORMAT (16(1X,A4)) DO 18 I=1,NBELEM IREP=IDCOUL DO 19 J=0,NBCOUL IF (CNOMCL(I).EQ.NCOUL(J)) IREP=J 19 CONTINUE ICOLOR(I)=IREP 18 CONTINUE SEGSUP NOMCL ENDIF READ (IOCAR,111,END=1000,ERR=1000)((NUM(I,J),I=1,NBNN), + J=1,NBELEM) 111 FORMAT (16I5) 7 CONTINUE DO 12 I=1,ILONG MELEME=JSGTR(I) IF (LISOUS(/1).NE.0) THEN DO 14 J=1,LISOUS(/1) LISOUS(J)=JSGTR(LISOUS(J)) 14 CONTINUE ENDIF IF (LISREF(/1).NE.0) THEN DO 16 J=1,LISREF(/1) LISREF(J)=JSGTR(LISREF(J)) 16 CONTINUE ENDIF DO JK=1,NUM(/2) DO IK=1,NUM(/1) NUM(IK,JK)=NUM(IK,JK)+NBANC ENDDO ENDDO SEGDES MELEME 12 CONTINUE READ (IOCAR,109,ERR=1000,END=1000) INN 109 FORMAT(22X,I8) ILONG=3*INN SEGINI ILIST READ (IOCAR,110,END=1000,ERR=1000)(ILIST(I),I=1,ILONG) 110 FORMAT(5(2A4,I8)) IF (IIMPI.NE.0) WRITE (IOIMP,206) (ILIST(I),I=1,ILONG) 206 FORMAT (' LISTE DES OBJETS NOMMES',/,5(1X,2A4,I8)) DO 25 I=1,ILONG,3 WRITE(ITTEMP,FMT='(2A4)')ILIST(I),ILIST(I+1) ITVAL=JSGTR(ILIST(I+2)) CALL NOMOBJ('MAILLAGE',ITTEMP,ITVAL) 25 CONTINUE SEGSUP JSGTR,ILIST C C **** LECTURE DU FICHIER TTMF C READ(IOCAR,1002,END=1001) IQUOI 1002 FORMAT(7X,I5) CALL RESTSO(IQUOI,NBANC,NIVOLU) 1001 CONTINUE RETURN 1000 CONTINUE CALL ERREUR(26) RETURN END