1 : C RESTSO SOURCE CHAT 07/10/29 21:28:13 5940 2 : SUBROUTINE RESTSO(IQUOI,NBANC) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C======================================================================= 6 : C APPELE PAR L'OPERATEUR SORTIR:LECTURE DU FICHIER TTMF 7 : C LIREFI LIT LE FICHIER SORTIR, RESTSO LIT DES PILES (COMME RESTITUER) 8 : C 9 : C APPELLE : ERREUR(12) LFCDIM LFCDIE LFCDIR SORT5 ENTNOF 10 : C ECRIT PAR FARVACQUE 11 : C 12 : C======================================================================= 13 : -INC CCOPTIO 14 : -INC CCGEOME 15 : -INC SMELEME 16 : -INC SMCHPOI 17 : SEGMENT ILIST(ILL) 18 : SEGMENT ISORTA(0) 19 : -INC TMCOLAC 20 : SEGMENT/ITBBE1/( ITABE1(NN)) 21 : SEGMENT/ITBBE2/( ITABE2(NN)) 22 : SEGMENT/ITBBM1/( ITABM1(NM)) 23 : SEGMENT/NOMM1/(NOM1(NOBJN1)) 24 : SEGMENT/NOMM2/(NOM2(NOBJN2)) 25 : C 26 : CHARACTER*(8) ITYPE 27 : CHARACTER*(8) NOMM 28 : CHARACTER*(72) CK 29 : REAL*8 XK 30 : LOGICAL BK 31 : C 32 : C 33 : C 34 : ITOTO=1 35 : IRETOU=0 36 : NOBJN1=0 37 : NOBJN2=0 38 : SEGINI NOMM1,NOMM2 39 : NITLAC=20 40 : SEGINI ICOLAC 41 : DO 1 IFILE=1,NITLAC 42 : SEGINI ITLACC 43 : KCOLA(IFILE)=ITLACC 44 : C KCOLAC(IFILE)=0 45 : 1 CONTINUE 46 : GOTO 1096 47 : C 48 : 1097 CONTINUE 49 : READ(IOCAR,74,END=1000,ERR=1000) IQUOI 50 : 74 FORMAT(7X,I5) 51 : C 52 : 1096 CONTINUE 53 : IF(IQUOI.EQ.5) GOTO 1000 54 : C *** FIN DES LECTURES *********** 55 : C 56 : C 57 : C 58 : C ***** LECTURE D'UN TITRE 59 : C 60 : C IF(IQUOI.NE.3) GOTO 5000 60 : C CALL LFCDIM(IOCAR,18,TITREE,IRETOU) 61 : C IF(IRETOU.NE.0) GOTO 1000 62 : C GOTO 1097 63 : C 64 : C ***** LECTURE D'UNE PILE 65 : C5000 CONTINUE 66 : IF(IQUOI.NE.2) GOTO 1000 67 : READ(IOCAR,75,END=1000,ERR=1000) IFILE,NOBJN,IMAX1 68 : 75 FORMAT(7X,I5,15X,I5,17X,I5) 69 : ITYPE=' ' 69 : CALL TYPFIL(ITYPE,IFILE) 70 : WRITE(IOIMP,703)IFILE,ITYPE,IMAX1,NOBJN 71 : 703 FORMAT(///' * LA FILE NUMERO',I4,' CONSTITUEE D''OBJETS DE TYPE 72 : 1 ',A8,' CONTIENT',I5, 73 : 1 ' OBJETS, PARMI LESQUELS ',I5,' SONT NOMMES.') 74 : C 74 : IF(NOBJN.NE.0) CALL ENTNOF(IOCAR,NOBJN,NOMM1,NOMM2,IRETOU) 75 : IF(IRETOU.NE.0) GOTO 1000 76 : ITLACC=KCOLA(IFILE) 77 : GO TO (6001,6002),IFILE 78 : C **************************MELEME********************************** 79 : 6001 CONTINUE 80 : C LECTURE DES OBJETS 81 : DO 7 IOB=1,IMAX1 82 : READ (IOCAR,107,END=1000,ERR=1000) NOMLU,NBSOUS,NBREF,NBNN,NBELEM 83 : 107 FORMAT(I4,12X,I4,11X,I4,10X,I4,8X,I4) 84 : IF (IIMPI.NE.0) WRITE(IOIMP,205) NOMLU,NBSOUS,NBREF,NBNN,NBELEM 85 : 205 FORMAT(' ITYPEL',I4,' NBSOUS ',I4,' NBREF ',I4,'NBNN ',I4,' NBELEM 86 : # ',I4) 87 : SEGINI MELEME 88 : ITLAC(**)=MELEME 89 : IF (NBSOUS.EQ.0) GOTO 8 90 : READ(IOCAR,108,END=1000,ERR=1000) (LISOUS(I),I=1,NBSOUS) 91 : 108 FORMAT(20I4) 92 : 8 IF (NBREF.EQ.0) GOTO 9 93 : READ(IOCAR,108,END=1000,ERR=1000) (LISREF(I),I=1,NBREF) 94 : 9 CONTINUE 95 : IF (NBELEM.EQ.0) GOTO 7 96 : C EST CE UN TYPE D'ELEM CONNU 97 : C DO 10 I=1,NOMBR 98 : C IF (NOMLU.EQ.NOMS(I)) GOTO 11 99 : C 10 CONTINUE 100 : C MCOT(1)=NOMLU 101 : C WRITE (MOT(1:4),FMT='(A4)') MCOT 102 : C SEGSUP MELEME,ISGTR 103 : C RETURN 104 : C 11 ITYPEL=I 105 : ITYPEL=NOMLU 106 : C IF( IONIVE .EQ. 0 ) THEN 107 : DO 1800 I = 1,NBELEM 108 : 1800 ICOLOR(I)=IDCOUL 109 : C ELSE 110 : C SEGINI NOMCL 111 : C READ (IOCAR,112,END=1000,ERR=1000)(NOMCL(I),I=1,NBELEM) 112 : 112 FORMAT (16(1X,A4)) 113 : C DO 18 I=1,NBELEM 114 : C IREP=0 115 : C DO 19 J=1,NBCOUL 116 : C 19 IF (NOMCL(I).EQ.NCOUL(J)) IREP=J 117 : C IF (IREP.EQ.0) THEN 118 : C MCOT(1)=NOMCL(I) 119 : C WRITE (MOT(1:4),FMT='(A4)') MCOT 120 : C SEGSUP MELEME,ISGTR,NOMCL 121 : C RETURN 122 : C ELSE 123 : C ICOLOR(I)=IREP 124 : C ENDIF 125 : C18 CONTINUE 126 : C SEGSUP NOMCL 127 : C ENDIF 128 : L=NBELEM*NBNN 128 : CALL LFCDIE(IOCAR,L,NUM,IRETOU,ITOTO) 129 : DO 17 IK=1,NBNN 130 : DO 17 JK=1,NBELEM 131 : NUM(IK,JK)=NUM(IK,JK)+NBANC 132 : 17 CONTINUE 133 : SEGDES MELEME 134 : 7 CONTINUE 135 : GOTO 1098 136 : C **************************CHPOINT********************************* 137 : 6002 CONTINUE 138 : NN=0 139 : NM=0 140 : SEGINI ITBBE1 141 : SEGINI ITBBM1 142 : DO 1101 IEL=1,IMAX1 143 : READ (IOCAR,1199,END=1000,ERR=1000)NSOUPO,NM 144 : 1199 FORMAT(8X,I5,4X,I5) 145 : NAT=1 146 : SEGINI MCHPOI 147 : ITLAC(**)=MCHPOI 148 : NN=3*NSOUPO 149 : SEGADJ ITBBE1 150 : SEGADJ ITBBM1 150 : CALL LFCDIE(IOCAR,NN,ITABE1,IRETOU,ITOTO) 151 : IF(IRETOU.NE.0) GOTO 1000 151 : CALL LFCDIM(IOCAR,NM,ITABM1,IRETOU,ITOTO) 152 : IF(IRETOU.NE.0) GOTO 1000 153 : READ(IOCAR,113,END=1000,ERR=1000) MTYPOI,MOCHDE 154 : 113 FORMAT (A8,A72) 155 : ICC=0 156 : DO 1103 ISOU=1,NSOUPO 157 : NC=ITABE1(3*ISOU) 158 : SEGINI MSOUPO 159 : IPCHP(ISOU)=MSOUPO 160 : IGEOC=ITABE1(3*ISOU -2) 161 : N=ITABE1(3*ISOU -1) 162 : DO 1102 IC=1,NC 163 : ICC=ICC+1 164 : WRITE (NOCOMP(IC),FMT='(A4)') ITABM1(ICC) 165 : 1102 CONTINUE 166 : SEGINI MPOVAL 167 : IPOVAL=MPOVAL 168 : LMAX=N*NC 168 : CALL LFCDIR(IOCAR,LMAX,VPOCHA,IRETOU) 169 : 104 FORMAT(E22.15) 170 : IF(IRETOU.NE.0) GOTO 1000 171 : SEGDES MPOVAL,MSOUPO 172 : 1103 CONTINUE 173 : SEGDES MCHPOI 174 : 1101 CONTINUE 175 : SEGSUP ITBBE1,ITBBM1 176 : GOTO 1098 177 : C 178 : C *****FIN DE LECTURE D'UNE PILE : NOM DES OBJETS******************* 179 : C 180 : 1098 CONTINUE 181 : C KCOLAC(IFILE)=KCOLAC(IFILE)+IMAX1 182 : IF(NOBJN.EQ.0) GOTO 1095 183 : DO 1094 I=1,NOBJN 184 : J=NOM1(I) 185 : IF(J.GT.ITLAC(/1)) THEN 186 : WRITE(IOIMP,708) ITYPE,NOM2(2*I-1),NOM2(2*I) 187 : ELSE 188 : K=ITLAC(J) 189 : WRITE(IOIMP,701)ITYPE,NOM2(2*I-1),NOM2(2*I),K 190 : WRITE(NOMM,FMT='(2A4)') NOM2(2*I-1),NOM2(2*I) 191 : IF(ITYPE.EQ.'ENTIER '.OR.ITYPE.EQ.'FLOTTANT'.OR.ITYPE.EQ. 192 : $ 'LOGIQUE '.OR.ITYPE.EQ.'MOT ') 192 : $ CALL QUEVAL(K,ITYPE,IERT,IK,XK,CK,BK,IOK) 193 : IF(IERT.EQ.1 ) THEN 193 : CALL ERREUR(5) 194 : RETURN 195 : ENDIF 196 : IF(ITYPE.EQ.'ENTIER ') THEN 196 : CALL NOMENT(NOMM,IK) 197 : ELSEIF(ITYPE.EQ.'FLOTTANT') THEN 197 : CALL NOMREE(NOMM,XK) 198 : ELSEIF(ITYPE.EQ.'LOGIQUE ') THEN 198 : CALL NOMLOG(NOMM,BK) 199 : ELSEIF(ITYPE.EQ.'MOT ') THEN 199 : CALL NOMCHA(NOMM,CK) 200 : ELSE 200 : CALL NOMOBJ(ITYPE,NOMM,K) 201 : ENDIF 202 : ENDIF 203 : 1094 CONTINUE 204 : 701 FORMAT(2X,A8,2X,2A4,2X,I5) 205 : 708 FORMAT(2X,A8,' * ATTENTION ERREUR SUR L''OBJET ',2A4) 206 : 1095 CONTINUE 207 : GOTO 1097 208 : 1000 CONTINUE 209 : C 210 : SEGDES ICOLAC 210 : CALL SORT5(ICOLAC) 211 : SEGACT ICOLAC 212 : DO 1001 I=1,NITLAC 213 : ITLACC=KCOLA(I) 214 : SEGSUP ITLACC 215 : 1001 CONTINUE 216 : SEGSUP ICOLAC 217 : RETURN 218 : END 219 : 220 : 221 : 222 : 223 : 224 : 225 : 226 : 227 : 228 : 229 :
© Cast3M 2003 - All rights reserved.
Disclaimer