C LIREFI SOURCE JC220346 13/12/19 21:15:04 7889 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 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=5) CHARACTER*4 MOPROG(NTYPRO) DATA MOPROG / 'AVS ','MED ','UNV ', 'FEM ', 'PROC' / CMB. Recherche du mot signifiant le type de la sortie ... CALL LIRMOT(MOPROG,NTYPRO,ITYPRO,0) CMB... Lecture du fichier AVS (UCD ASCII) ... IF (ITYPRO.EQ.1) THEN CDEBUG WRITE(IOIMP,3001) CDEBUG 3001 FORMAT('Lecture du fichier AVS') CALL LIRAVS RETURN C ... Lecture du fichier MED ... ELSE IF (ITYPRO.EQ.2) THEN CALL MEDR RETURN C ... Lecture du fichier UNV I-DEAS(R) ... ELSE IF (ITYPRO.EQ.3) THEN CDEBUG WRITE(IOIMP,3003) CDEBUG 3003 FORMAT('Lecture du fichier UNV') CALL LIRUNV RETURN C ... Lecture du fichier FEM ELSE IF (ITYPRO.EQ.4) THEN CDEBUG WRITE(IOIMP,3004) CDEBUG 3004 FORMAT('Lecture du fichier FEM') CALL LIRFEM RETURN C ... Lecture d'un fichier PROCEDUR ELSE IF (ITYPRO.EQ.5) THEN CDEBUG WRITE(IOIMP,3005) CDEBUG 3005 FORMAT('Lecture du fichier PROC') CALL LIPROC RETURN ENDIF CMB ... Ici commence l'ancienne lecture (Castem) ... 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) IONIVE 101 FORMAT(34X,I3) IF (IONIVE.GT.2) GOTO 1000 CALL NOMENT('&NIVE',IONIVE) 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 NBANC=XCOOR(/1)/(IDIM+1) 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 (IONIVE.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( IONIVE .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 17 IK=1,NUM(/1) DO 17 JK=1,NUM(/2) NUM(IK,JK)=NUM(IK,JK)+NBANC 17 CONTINUE 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) 1001 CONTINUE RETURN 1000 CONTINUE CALL ERREUR(26) RETURN END