C RESTSO SOURCE CHAT 07/10/29 21:28:13 5940 SUBROUTINE RESTSO(IQUOI,NBANC) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C======================================================================= C APPELE PAR L'OPERATEUR SORTIR:LECTURE DU FICHIER TTMF C LIREFI LIT LE FICHIER SORTIR, RESTSO LIT DES PILES (COMME RESTITUER) C C APPELLE : ERREUR(12) LFCDIM LFCDIE LFCDIR SORT5 ENTNOF C ECRIT PAR FARVACQUE C C======================================================================= -INC CCOPTIO -INC CCGEOME -INC SMELEME -INC SMCHPOI SEGMENT ILIST(ILL) SEGMENT ISORTA(0) -INC TMCOLAC SEGMENT/ITBBE1/( ITABE1(NN)) SEGMENT/ITBBE2/( ITABE2(NN)) SEGMENT/ITBBM1/( ITABM1(NM)) SEGMENT/NOMM1/(NOM1(NOBJN1)) SEGMENT/NOMM2/(NOM2(NOBJN2)) C CHARACTER*(8) ITYPE CHARACTER*(8) NOMM CHARACTER*(72) CK REAL*8 XK LOGICAL BK C C C ITOTO=1 IRETOU=0 NOBJN1=0 NOBJN2=0 SEGINI NOMM1,NOMM2 NITLAC=20 SEGINI ICOLAC DO 1 IFILE=1,NITLAC SEGINI ITLACC KCOLA(IFILE)=ITLACC C KCOLAC(IFILE)=0 1 CONTINUE GOTO 1096 C 1097 CONTINUE READ(IOCAR,74,END=1000,ERR=1000) IQUOI 74 FORMAT(7X,I5) C 1096 CONTINUE IF(IQUOI.EQ.5) GOTO 1000 C *** FIN DES LECTURES *********** C C C C ***** LECTURE D'UN TITRE C C IF(IQUOI.NE.3) GOTO 5000 C CALL LFCDIM(IOCAR,18,TITREE,IRETOU) C IF(IRETOU.NE.0) GOTO 1000 C GOTO 1097 C C ***** LECTURE D'UNE PILE C5000 CONTINUE IF(IQUOI.NE.2) GOTO 1000 READ(IOCAR,75,END=1000,ERR=1000) IFILE,NOBJN,IMAX1 75 FORMAT(7X,I5,15X,I5,17X,I5) ITYPE=' ' CALL TYPFIL(ITYPE,IFILE) WRITE(IOIMP,703)IFILE,ITYPE,IMAX1,NOBJN 703 FORMAT(///' * LA FILE NUMERO',I4,' CONSTITUEE D''OBJETS DE TYPE 1 ',A8,' CONTIENT',I5, 1 ' OBJETS, PARMI LESQUELS ',I5,' SONT NOMMES.') C IF(NOBJN.NE.0) CALL ENTNOF(IOCAR,NOBJN,NOMM1,NOMM2,IRETOU) IF(IRETOU.NE.0) GOTO 1000 ITLACC=KCOLA(IFILE) GO TO (6001,6002),IFILE C **************************MELEME********************************** 6001 CONTINUE C LECTURE DES OBJETS DO 7 IOB=1,IMAX1 READ (IOCAR,107,END=1000,ERR=1000) NOMLU,NBSOUS,NBREF,NBNN,NBELEM 107 FORMAT(I4,12X,I4,11X,I4,10X,I4,8X,I4) IF (IIMPI.NE.0) WRITE(IOIMP,205) NOMLU,NBSOUS,NBREF,NBNN,NBELEM 205 FORMAT(' ITYPEL',I4,' NBSOUS ',I4,' NBREF ',I4,'NBNN ',I4,' NBELEM # ',I4) SEGINI MELEME ITLAC(**)=MELEME IF (NBSOUS.EQ.0) GOTO 8 READ(IOCAR,108,END=1000,ERR=1000) (LISOUS(I),I=1,NBSOUS) 108 FORMAT(20I4) 8 IF (NBREF.EQ.0) GOTO 9 READ(IOCAR,108,END=1000,ERR=1000) (LISREF(I),I=1,NBREF) 9 CONTINUE IF (NBELEM.EQ.0) GOTO 7 C EST CE UN TYPE D'ELEM CONNU C DO 10 I=1,NOMBR C IF (NOMLU.EQ.NOMS(I)) GOTO 11 C 10 CONTINUE C MCOT(1)=NOMLU C WRITE (MOT(1:4),FMT='(A4)') MCOT C SEGSUP MELEME,ISGTR C RETURN C 11 ITYPEL=I ITYPEL=NOMLU C IF( IONIVE .EQ. 0 ) THEN DO 1800 I = 1,NBELEM 1800 ICOLOR(I)=IDCOUL C ELSE C SEGINI NOMCL C READ (IOCAR,112,END=1000,ERR=1000)(NOMCL(I),I=1,NBELEM) 112 FORMAT (16(1X,A4)) C DO 18 I=1,NBELEM C IREP=0 C DO 19 J=1,NBCOUL C 19 IF (NOMCL(I).EQ.NCOUL(J)) IREP=J C IF (IREP.EQ.0) THEN C MCOT(1)=NOMCL(I) C WRITE (MOT(1:4),FMT='(A4)') MCOT C SEGSUP MELEME,ISGTR,NOMCL C RETURN C ELSE C ICOLOR(I)=IREP C ENDIF C18 CONTINUE C SEGSUP NOMCL C ENDIF L=NBELEM*NBNN CALL LFCDIE(IOCAR,L,NUM,IRETOU,ITOTO) DO 17 IK=1,NBNN DO 17 JK=1,NBELEM NUM(IK,JK)=NUM(IK,JK)+NBANC 17 CONTINUE SEGDES MELEME 7 CONTINUE GOTO 1098 C **************************CHPOINT********************************* 6002 CONTINUE NN=0 NM=0 SEGINI ITBBE1 SEGINI ITBBM1 DO 1101 IEL=1,IMAX1 READ (IOCAR,1199,END=1000,ERR=1000)NSOUPO,NM 1199 FORMAT(8X,I5,4X,I5) NAT=1 SEGINI MCHPOI ITLAC(**)=MCHPOI NN=3*NSOUPO SEGADJ ITBBE1 SEGADJ ITBBM1 CALL LFCDIE(IOCAR,NN,ITABE1,IRETOU,ITOTO) IF(IRETOU.NE.0) GOTO 1000 CALL LFCDIM(IOCAR,NM,ITABM1,IRETOU,ITOTO) IF(IRETOU.NE.0) GOTO 1000 READ(IOCAR,113,END=1000,ERR=1000) MTYPOI,MOCHDE 113 FORMAT (A8,A72) ICC=0 DO 1103 ISOU=1,NSOUPO NC=ITABE1(3*ISOU) SEGINI MSOUPO IPCHP(ISOU)=MSOUPO IGEOC=ITABE1(3*ISOU -2) N=ITABE1(3*ISOU -1) DO 1102 IC=1,NC ICC=ICC+1 WRITE (NOCOMP(IC),FMT='(A4)') ITABM1(ICC) 1102 CONTINUE SEGINI MPOVAL IPOVAL=MPOVAL LMAX=N*NC CALL LFCDIR(IOCAR,LMAX,VPOCHA,IRETOU) 104 FORMAT(E22.15) IF(IRETOU.NE.0) GOTO 1000 SEGDES MPOVAL,MSOUPO 1103 CONTINUE SEGDES MCHPOI 1101 CONTINUE SEGSUP ITBBE1,ITBBM1 GOTO 1098 C C *****FIN DE LECTURE D'UNE PILE : NOM DES OBJETS******************* C 1098 CONTINUE C KCOLAC(IFILE)=KCOLAC(IFILE)+IMAX1 IF(NOBJN.EQ.0) GOTO 1095 DO 1094 I=1,NOBJN J=NOM1(I) IF(J.GT.ITLAC(/1)) THEN WRITE(IOIMP,708) ITYPE,NOM2(2*I-1),NOM2(2*I) ELSE K=ITLAC(J) WRITE(IOIMP,701)ITYPE,NOM2(2*I-1),NOM2(2*I),K WRITE(NOMM,FMT='(2A4)') NOM2(2*I-1),NOM2(2*I) IF(ITYPE.EQ.'ENTIER '.OR.ITYPE.EQ.'FLOTTANT'.OR.ITYPE.EQ. $ 'LOGIQUE '.OR.ITYPE.EQ.'MOT ') $ CALL QUEVAL(K,ITYPE,IERT,IK,XK,CK,BK,IOK) IF(IERT.EQ.1 ) THEN CALL ERREUR(5) RETURN ENDIF IF(ITYPE.EQ.'ENTIER ') THEN CALL NOMENT(NOMM,IK) ELSEIF(ITYPE.EQ.'FLOTTANT') THEN CALL NOMREE(NOMM,XK) ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN CALL NOMLOG(NOMM,BK) ELSEIF(ITYPE.EQ.'MOT ') THEN CALL NOMCHA(NOMM,CK) ELSE CALL NOMOBJ(ITYPE,NOMM,K) ENDIF ENDIF 1094 CONTINUE 701 FORMAT(2X,A8,2X,2A4,2X,I5) 708 FORMAT(2X,A8,' * ATTENTION ERREUR SUR L''OBJET ',2A4) 1095 CONTINUE GOTO 1097 1000 CONTINUE C SEGDES ICOLAC CALL SORT5(ICOLAC) SEGACT ICOLAC DO 1001 I=1,NITLAC ITLACC=KCOLA(I) SEGSUP ITLACC 1001 CONTINUE SEGSUP ICOLAC RETURN END