1 : C LIPIL SOURCE PV 14/01/30 21:15:06 7929 2 : SUBROUTINE LIPIL (ICOLAC,IFIN,IRET,IFORM,LABEL) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C======================================================================= 6 : C BUT : LECTURE DU FICHIER FORMATE OU NON IORES DEFINI PAR: 7 : C OPTIO REST IORES ; 8 : C APPELE PAR : REST 9 : C APPELLE : LFCDIM LFCDIE LFCDI2 NOMNST ENSOLF ENTNOM 10 : C : LIPOIN LIMAIL ERREUR(12) 11 : C ECRIT PAR FARVACQUE -REPRIS PAR LENA 12 : C 13 : C HISTORIQUE : ajout des objets de type MATRAK et MATRIK par 14 : C GOUNAND (15/07/98) 15 : C 16 : C======================================================================= 17 : C TABLEAU KCOLA: VOIR LE SOUS-PROGRAMME TYPFIL 18 : C======================================================================= 19 : -INC CCOPTIO 20 : -INC SMELEME 21 : -INC SMBASEM 22 : -INC SMCOORD 23 : POINTEUR MCOOR1.MCOORD,MCOOR2.MCOORD 24 : -INC SMRIGID 25 : -INC SMELSTR 26 : -INC SMCLSTR 27 : -INC SMDEFOR 28 : -INC SMSTRUC 29 : -INC SMLREEL 30 : -INC SMLENTI 31 : -INC SMLMOTS 32 : -INC SMTEXTE 33 : -INC SMTABLE 34 : -INC SMSUPER 35 : -INC SMVECTD 36 : -INC SMCHARG 37 : -INC SMEVOLL 38 : -INC SMLCHPO 39 : -INC SMINTE 40 : -INC CCGEOME 41 : -INC TMCOLAC 42 : -INC CCFXDR 43 : C 44 : SEGMENT JPV(MOTS(/2)) 45 : C======================================================================= 46 : C ICOLAC : KCOLA : POINTEUR SUR LA PILE ITLACC 47 : C MCOLA : NOMBRE D'OBJETS INSPECTES DANS LA PILE 48 : C ICOLA : POINTEUR SUR ISGTR ( NOM-NOM-RANG DANS ITLACC) 49 : C KCOLAC: CONTIENT POUR CHAQUE PILE LE NOMBRE D'OBJETS A 50 : C SORTIR 51 : C======================================================================= 52 : SEGMENT/ITBBE1/( ITABE1(NN)) 53 : SEGMENT/ITBBE2/( ITABE2(NN)) 54 : segment itbbc2 55 : character*4 itabc2(nn) 56 : endsegment 57 : SEGMENT/ITBBM1/( ITABM1(NM)) 58 : segment itbbc1 59 : character*4 itabc1(nm) 60 : endsegment 61 : SEGMENT/ITBBM2/( ITABM2(NM2)) 62 : segment itbbc3 63 : character*4 itabc3(nm2) 64 : endsegment 65 : SEGMENT/ITBBM3/( ITABM3(NM2)) 66 : segment itbbc4 67 : character*4 itabc4(nm2) 68 : endsegment 69 : SEGMENT/ITBBM4/( ITABM4(NM2)) 70 : segment itbbc5 71 : character*4 itabc5(nm2) 72 : endsegment 73 : SEGMENT/ITBBR1/( TABR1(L)*D) 74 : SEGMENT/NOMM1/(NOM1(NOBJN1)) 75 : SEGMENT NOMM2 76 : CHARACTER*(8) NOM2(NOBJN1) 77 : ENDSEGMENT 78 : SEGMENT ITAMOT 79 : CHARACTER*(NN) ITAMO 80 : INTEGER ICOTA(NNN) 81 : ENDSEGMENT 82 : C 83 : DIMENSION IPVV(2) 84 : DIMENSION ILENA(30) 85 : DIMENSION NOMM(2) 86 : CHARACTER*(8) ITYPE,CTYPE 87 : CHARACTER*72 LABEL 88 : REAL*8 XVA 89 : LOGICAL LOGI 90 : CHARACTER*(72) CHA1T 91 : CHARACTER*(512) CHA1 92 : CHARACTER*(1) CHARI 93 : REAL*4 DENSI4 94 : C-------------------------------------------------------------------- 95 : IQUOI=0 96 : NOMM1=0 97 : NOMM2=0 98 : ITBBM1=0 99 : ITBBM2=0 100 : ITBBM3=0 101 : ITBBM4=0 102 : ITBBE1=0 103 : ITBBE2=0 104 : ITBBR1=0 105 : IRET=0 106 : IRETOU=0 107 : NOBJN1=0 108 : CHA1T=' ' 109 : SEGINI NOMM1 110 : SEGINI NOMM2 111 : SEGACT ICOLAC*MOD 112 : NBANC=XCOOR(/1)/(IDIM+1) 113 : C ------------------------------------------------------------------ 114 : C --- BOUCLE DE LECTURE SUR UN DESCRIPTEUR------------------------- 115 : 1097 CONTINUE 116 : IRETOU=0 117 : IQUOI=0 117 : CALL LFCDES (IORES,IQUOI,IRETOU,IFORM) 118 : IF (IIMPI.EQ.5) WRITE(IOIMP,555) IQUOI,IRETOU 119 : 555 FORMAT(' ENREG DE TYPE ',I6,' CODE RETOUR DE LECTURE =',I2) 120 : IF(IRETOU.NE.0) THEN 121 : IF( IONIVE.GE.10) THEN 122 : IF(LABEL.EQ.' '.AND.CHA1T.NE.' ') THEN 123 : IRETOU=0 124 : GO TO 1001 125 : ELSE 126 : MOTERR(1:24) = LABEL 126 : CALL ERREUR (874) 127 : GO TO 1000 128 : ENDIF 129 : ELSE 130 : MOTERR(1:24) = LABEL 130 : CALL ERREUR (874) 131 : GO TO 1000 132 : ENDIF 133 : ENDIF 134 : C *** FIN DES LECTURES ********SI IQUOI=5 135 : IF(IQUOI.EQ.5) THEN 136 : IF(IONIVE.GE.10) THEN 137 : IF(IFORM.EQ.1) READ (IORES,776) CHA1T 138 : IF(IFORM.EQ.0) READ (IORES) CHA1T 139 : if (iform.eq.2) ios=IXDRSTRING( ixdrr,cha1t(1:72)) 140 : 776 FORMAT(A72) 141 : WRITE (IOIMP,778) CHA1T 142 : 778 FORMAT ( 'FIN DE LECTURE DU LABEL : ',/,A72,/) 143 : IF(LABEL.NE.' ') THEN 144 : IF(LABEL.EQ.CHA1T ) GO TO 1001 145 : ENDIF 146 : GO TO 1097 147 : ENDIF 148 : ENDIF 149 : GO TO (999 ,5000,4000,444,1001,999 ,4001 ),IQUOI 150 : C --- ERREUR 151 : 999 GO TO 1000 152 : C-------------------------------------------------------------------- 153 : C ***** LECTURE DES INFORMATIONS GENERALES A METTRE DANS LES COMMONS 154 : C --- IQUOI=4 155 : 444 CONTINUE 156 : IF(IFORM.EQ.1)READ(IORES,701,END=1000,ERR=1000) NIVEAU,IARR,JDIM 157 : IF(IFORM.EQ.0)READ(IORES,END=1000,ERR=1000) NIVEAU,IARR,JDIM 158 : if (iform.eq.2) then 159 : ios=IXDRINT( ixdrr, niveau ) 160 : ios=IXDRINT( ixdrr, iarr ) 161 : ios=IXDRINT( ixdrr, jdim ) 162 : endif 163 : IONIVE=NIVEAU 164 : 701 FORMAT(7X,I4,14X,I4,10X,I4) 165 : WRITE (IOIMP,33201) NIVEAU 166 : 33201 FORMAT (//,' NIVEAU DU FICHIER',I3) 167 : CCCCC IF (NIVEAU.NE.0) GOTO 1000 168 : IF (IFORM.EQ.1) READ(IORES,702) DENSIT 169 : IF (IFORM.EQ.0) READ(IORES) DENSIT 170 : if (iform.eq.2) ios=IXDRREAL( ixdrr, densi4 ) 171 : densit = densi4 172 : 702 FORMAT(8X,E12.5) 173 : WRITE (IOIMP,201) IaRR,JDIM,DENSIT 174 : 201 FORMAT (//,' NIVEAU D''ERREUR ',I2,' DIMENSION ',I2,' DENSITE ', 175 : 1 1PE12.5) 176 : IERMAX=MAX(IERMAX,IaRR) 177 : * IERR=0 177 : CALLGINT2 178 : IF (IDIM.EQ.0) IDIM=JDIM 178 : IF (JDIM.NE.0.AND.JDIM.NE.IDIM) CALL ERREUR(12) 179 : GOTO 1097 180 : C 181 : C **** INFORMATIONS GENERALES CASTEM2000 ***************** 182 : C --- IQUOI=7 183 : 4001 CONTINUE 183 : CALL LIINFG (IRETOU,IFORM) 184 : IF(IRETOU.NE.0) GOTO 1000 185 : GOTO 1097 186 : C 187 : C ***** LECTURE D'UN TITRE ************************************* 188 : C --- IQUOI=3 189 : 4000 CONTINUE 189 : CALL LFCDIM(IORES,18,ILENA,IRETOU,IFORM) 190 : WRITE(TITREE,FMT='(18A4)')(ILENA(IY),IY=1,18) 191 : IF(IRETOU.NE.0) GOTO 1000 192 : GOTO 1097 193 : C 194 : C ***** LECTURE D'UNE PILE ************************************* 195 : C --- IQUOI=2 196 : 5000 CONTINUE 197 : IF(IERR.NE.0) RETURN 198 : ITOTO=3 198 : CALL LFCDIP (IORES,ITOTO,ILENA,IRETOU,IFORM) 199 : IF ( IRETOU.NE.0) GO TO 1000 200 : IFILE =ILENA(1) 201 : NOBJN =ILENA(2) 202 : IMAX1 =ILENA(3) 203 : ITYPE=' ' 204 : IF(IFILE.NE.0) THEN 204 : CALL TYPFIL(ITYPE,IFILE) 205 : WRITE (IOIMP,805) IMAX1,ITYPE 206 : 805 FORMAT( ' LECTURE DE ',I5 , ' OBJETS ',A8) 207 : IF(IIMPI.NE.0) 208 : * WRITE(IOIMP,803)IFILE,ITYPE,IMAX1,NOBJN 209 : ELSE 210 : ITYPE='POINT ' 211 : IF(IIMPI.NE.0) WRITE(IOIMP,804)IMAX1,NOBJN 212 : ENDIF 213 : 803 FORMAT(///' * LA FILE NUMERO',I4,' CONSTITUEE D''OBJETS DE TYPE 214 : 1 ',A8,' CONTIENT',I5, 215 : 1 ' OBJETS, PARMI LESQUELS ',I5,' SONT NOMMES.') 216 : 804 FORMAT(///' * IL Y A ',I6,' NOUVEAUX POINTS, PARMI LESQUELS ', 217 : 1 I6,' SONT NOMMES.') 218 : C --- LECTURE DES NOMS S ILS EXISTENT 218 : CALL ENTNOM(IORES,NOBJN,NOMM1,NOMM2,IRETOU,IFORM) 219 : IF(IRETOU.NE.0) GOTO 1000 220 : C --- LECTURE DE LA PILE - ON EN LIRA IMAX1------------------------- 221 : IF(IFILE.EQ.0) GO TO 5001 222 : C KCOLAC(IFILE)=IMAX1+ KCOLAC(IFILE) 223 : ITLACC=KCOLA(IFILE) 224 : IRETOU=0 225 : C --- 226 : if(ionive.ge.17) then 227 : if(ifile.ge.24.and.ifile.le.27) then 228 : segsup itlacc 229 : segini itlacc 230 : kcolac(ifile)=imax1 231 : kcola(ifile) = itlacc 232 : endif 233 : endif 234 : GO TO (6001,6002,6003,1002,1002,6006,6007,6008,6009,6010,1002, 235 : 1 6012,6013,6014,6015,6016,6017,6018,6019,6020,1002,6022, 236 : 1 6023,6024,6025,6026,6027,6028,6029,6030,6031,6032,6033, 237 : 1 6034,6035,6036,6037,6038,6039,6040,6041, 238 : 1 6042,6043,6010,6045 ),IFILE 239 : 1002 MOTERR(1:8)=ITYPE 239 : CALL ERREUR(336) 240 : GO TO 1000 241 : C *************** POINTS ET COORD********************************** 242 : 5001 CONTINUE 243 : IF(IONIVE.LE.9) THEN 243 : CALL LIPOIN (IMAX1,NOBJN,NOMM1,NOMM2,NBANC,IRETOU,IFORM) 244 : IF (IRETOU.NE.0) GO TO 1000 245 : ENDIF 246 : GOTO 1097 247 : C **************************MELEME********************************** 248 : 6001 CONTINUE 249 : DO 7 IEL=1,IMAX1 250 : IRETOU=0 250 : CALL LIMAIL (MELEME,NBANC,IRETOU,IFORM) 251 : IF (IRETOU.NE.0) GO TO 1000 252 : ITLAC(**)=MELEME 253 : 7 CONTINUE 254 : GOTO 1098 255 : C **************************CHPOINT********************************* 256 : 6002 CONTINUE 256 : CALL LICHPO(IORES,ITLACC,IMAX1,IRETOU,IFORM) 257 : IF (IRETOU.NE.0) GO TO 1000 258 : GOTO 1098 259 : C ***********************MRIGID************************************* 260 : 6003 CONTINUE 261 : NN=0 262 : SEGINI ITBBE1 263 : NM=0 264 : SEGINI ITBBM1,itbbc1 265 : DO 1202 IEL=1,IMAX1 266 : C READ(IORES,8000,END=1000,ERR=1000) NRIGEL,ICHO,NBGEOR,NRIGE,J 267 : ITOTO=5 267 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 268 : IF (IRETOU.NE.0) GO TO 1000 269 : NRIGEL= ILENA(1) 270 : ICHO = ILENA(2) 271 : NBGEOR= ILENA(3) 272 : NRIGE = ILENA(4) 273 : J = ILENA(5) 274 : SEGINI MRIGID 275 : ITLAC(**)=MRIGID 276 : IFORIG=J 277 : C READ(IORES,8001,END=1000,ERR=1000)MTYMAT(1),MTYMAT(2) 278 : ITOTO=2 278 : CCC CALL LFCDIM (IORES,ITOTO,MTYMAT,IRETOU,IFORM) 279 : if (iform.ne.2) then 279 : CALL LFCDIM (IORES,ITOTO,IPVV,IRETOU,IFORM) 280 : IF (IRETOU.NE.0) GO TO 1000 281 : WRITE(MTYMAT,FMT='(2A4)') IPVV(1),IPVV(2) 282 : else 283 : ios=IXDRSTRING( ixdrr, mtymat(1:8)) 284 : if (ios.lt.0) goto 1000 285 : endif 286 : ICHOLE=ICHO 287 : NN=NRIGE*NRIGEL+NBGEOR 288 : IF(IONIVE.GE.5) NN=NN + NRIGEL 289 : SEGADJ ITBBE1 289 : CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM) 290 : IF (IRETOU.NE.0) GO TO 1000 291 : NNN=0 292 : DO 1203 IR=1,NRIGEL 293 : II=NRIGE*(IR-1) 294 : DO 1204 NR=1,NRIGE 295 : IRR=II+NR 296 : IRIGEL(NR,IR)=ITABE1(IRR) 297 : 1204 CONTINUE 298 : NLIGRP=ITABE1(II+3) 299 : NLIGRD=NLIGRP 300 : IF(IONIVE.GE.5) THEN 301 : NLIGRD=ITABE1(IR+ NRIGE*NRIGEL+NBGEOR) 302 : ENDIF 303 : NNN=NNN+NLIGRP + NLIGRD 304 : SEGINI DESCR 305 : IRIGEL(3,IR)=DESCR 306 : if(ionive.ge.18) then 307 : nelrig=ITABE1(II+4) 308 : segini xmatri 309 : irigel(4,ir)=xmatri 310 : endif 311 : 1203 CONTINUE 312 : IF(NBGEOR.EQ.0) GOTO 1207 313 : SEGINI IMGEOD 314 : DO 1206 I=1,NBGEOR 315 : IMGEOR(I)=ITABE1(NRIGE*NRIGEL+I) 316 : 1206 CONTINUE 317 : SEGDES IMGEOD 318 : IMGEO1=IMGEOD 319 : 1207 NN=NNN 320 : IF(IONIVE.LT.5) NN=NN/2 321 : SEGADJ ITBBE1 322 : NM=NNN 323 : SEGADJ ITBBM1,itbbc1 323 : CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM) 324 : IF(IRETOU.NE.0) GOTO 1000 324 : if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM) 325 : if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4)) 326 : IF(IRETOU.NE.0) GOTO 1000 327 : J=0 328 : DO 1208 IR=1,NRIGEL 329 : DESCR=IRIGEL(3,IR) 330 : SEGACT DESCR*MOD 331 : NLIGRP=NOELEP(/1) 332 : IF(IONIVE.GE.5) THEN 333 : DO 1205 I=1,NLIGRP 334 : J=J+1 335 : NOELEP(I)=ITABE1(J) 336 : if (iform.ne.2) WRITE(LISINC(I),FMT='(A4)')ITABM1(J) 337 : if (iform.eq.2) lisinc(i)=itabc1(j) 338 : 1205 CONTINUE 339 : NLIGRD=NOELED(/1) 340 : DO 1209 I=1,NLIGRD 341 : J=J+1 342 : NOELED(I)=ITABE1(J) 343 : if (iform.ne.2) WRITE(LISDUA(I),FMT='(A4)')ITABM1(J) 344 : if (iform.eq.2) lisdua(i)=itabc1(j) 345 : 1209 CONTINUE 346 : ELSE 347 : DO 1215 I=1,NLIGRP 348 : J=J+1 349 : NOELEP(I)=ITABE1(J) 350 : NOELED(I)=ITABE1(J) 351 : if (iform.ne.2) then 352 : WRITE(LISINC(I),FMT='(A4)')ITABM1(2*J-1) 353 : else 354 : lisinc(i)=itabc1(2*j-1) 355 : endif 356 : if (iform.ne.2) WRITE(LISDUA(I),FMT='(A4)')ITABM1(2*J) 357 : if (iform.eq.2) lisdua(i)=itabc1(2*j) 358 : 1215 CONTINUE 359 : ENDIF 360 : SEGDES DESCR 361 : 1208 CONTINUE 361 : CALL LFCDI2(IORES,NRIGEL,COERIG,IRETOU,IFORM) 362 : if(ionive.ge.18) then 363 : do ir=1,nrigel 364 : xmatri=irigel(4,ir) 365 : lval=re(/1)*re(/2)*re(/3) 365 : call lfcdi2(iores,lval,re,iretou,iform) 366 : segdes xmatri 367 : enddo 368 : endif 369 : SEGDES MRIGID 370 : IF(IRETOU.NE.0) GOTO 1000 371 : 1202 CONTINUE 372 : SEGSUP ITBBM1,itbbc1,ITBBE1 373 : GOTO 1098 374 : C *************************** ******************************* 375 : 6004 CONTINUE 376 : GOTO 1098 377 : C *********************** ********************************* 378 : 6005 CONTINUE 379 : GOTO 1098 380 : C ********************************BLOQ STRUC 381 : 6006 CONTINUE 382 : DO 60 IEL=1,IMAX1 383 : ITOTO=1 383 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 384 : IF(IRETOU.NE.0) GO TO 1000 385 : N=ILENA(1) 386 : SEGINI MCLSTR 387 : ITLAC(**)= MCLSTR 387 : CALL LFCDIE (IORES,N ,ISOSTR,IRETOU,IFORM) 388 : IF(IRETOU.NE.0) GO TO 1000 388 : CALL LFCDIE (IORES,N ,IRIGCL,IRETOU,IFORM) 389 : IF(IRETOU.NE.0) GO TO 1000 390 : SEGDES MCLSTR 391 : 60 CONTINUE 392 : GO TO 1098 393 : C ********************************ELEM STRUC 394 : 6007 CONTINUE 395 : DO 70 IEL=1,IMAX1 396 : ITOTO=1 396 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 397 : IF(IRETOU.NE.0) GO TO 1000 398 : N=ILENA(1) 399 : SEGINI MELSTR 400 : ITLAC(**) =MELSTR 400 : CALL LFCDIE (IORES,N ,ISOSTU,IRETOU,IFORM) 401 : IF(IRETOU.NE.0) GO TO 1000 401 : CALL LFCDIE (IORES,N ,IMELEM,IRETOU,IFORM) 402 : IF(IRETOU.NE.0) GO TO 1000 403 : SEGDES MELSTR 404 : 70 CONTINUE 405 : GO TO 1098 406 : C ****************************MSOLUT******************************** 407 : 6008 CONTINUE 408 : IMAX2=IMAX1 409 : DO 1800 IEL=1,IMAX1 410 : IRETOU=0 410 : IF (NIVEAU.LE.2) CALL ENSOLF(ICOLAC,IRET,IFORM) 411 : IF (NIVEAU.LE.2) MSOLUT=IRET 411 : IF (NIVEAU.GE.3) CALL LISOLU(MSOLUT,IRETOU,IFORM) 412 : IF (IRETOU.NE.0) GO TO 1000 413 : IRET=MSOLUT 414 : IF(IRET.GE.0) THEN 415 : ITLAC(**)=IRET 416 : ELSE 417 : IF(IRET.LT.0) THEN 418 : ITLAC(**)=-IRET 419 : IMAX2=IEL 420 : ELSE 421 : IMAX2=IEL-1 422 : ENDIF 423 : GOTO 1801 424 : ENDIF 425 : 1800 CONTINUE 426 : 1801 CONTINUE 427 : IMAX1=IMAX2 428 : GOTO 1098 429 : C ***************************MSTRUC******************************** 430 : 6009 CONTINUE 431 : DO 1901 IEL=1,IMAX1 432 : C READ(IORES,8000,END=1000,ERR=1000) N 433 : ITOTO=1 433 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 434 : IF (IRETOU.NE.0) GO TO 1000 435 : N = ILENA(1) 436 : SEGINI MSTRUC 437 : ITLAC(**)=MSTRUC 437 : CALL LFCDIE(IORES,N,LISTRU,IRETOU,IFORM) 438 : IF(IRETOU.NE.0) GOTO 1000 439 : SEGDES MSTRUC 440 : 1901 CONTINUE 441 : GOTO 1098 442 : C ******************************* MTABLE ************************** 443 : 6010 CONTINUE 444 : NN=0 445 : SEGINI ITBBE1 446 : ITOTO=1 447 : DO 710 IEL=1,IMAX1 448 : MTABLE=0 448 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 449 : * write (6,*) ' lipil table ',ilena(1) 450 : IF (IRETOU.NE.0) GO TO 1000 451 : NN=ILENA(1) 452 : CCC IF (NN.EQ.0) GO TO 109 453 : M=NN/4 454 : SEGINI MTABLE 455 : MLOTAB=M 456 : IF (NN.EQ.0) GO TO 713 457 : SEGADJ ITBBE1 457 : CALL LFCDIE (IORES,NN,ITABE1,IRETOU,IFORM) 458 : * write (6,*) ' lipil table ',(itabe1(ii),ii=1,nn) 459 : IF(IRETOU.NE.0) GO TO 1000 460 : KK=0 461 : DO 711 K=1,NN,4 462 : KK=KK+1 463 : J=ITABE1(K) 464 : IVA=ITABE1(K+1) 465 : CTYPE=' ' 465 : CALL TYPFIL (CTYPE,J) 466 : MTABII(KK)=IVA 467 : MTABTI(KK)=CTYPE 468 : J=ITABE1(K+2) 469 : IVA=ITABE1(K+3) 470 : CTYPE=' ' 470 : CALL TYPFIL (CTYPE,J) 471 : ** en attendant de savoir lire un esclave 472 : IF (CTYPE.EQ.'ESCLAVE') CTYPE='ANNULE' 473 : MTABIV(KK)=IVA 474 : MTABTV(KK)=CTYPE 475 : 711 CONTINUE 476 : 713 SEGDES MTABLE 477 : 109 ITLAC(**)=MTABLE 478 : 710 CONTINUE 479 : SEGSUP ITBBE1 480 : GO TO 1098 481 : C ***************************** ***************************** 482 : 6011 CONTINUE 483 : GOTO 1098 484 : C **********************&**MSOSTU******************************* 485 : 6012 CONTINUE 486 : NN=0 487 : SEGINI ITBBE1 488 : DO 2201 IEL=1,IMAX1 489 : ITOTO=1 489 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 490 : IF (IRETOU.NE.0) GO TO 1000 491 : NS = ILENA(1) 492 : SEGINI MSOSTU 493 : ITLAC (**)=MSOSTU 494 : C READ(IORES,8000,END=1000,ERR=1000)ITYSOU,ISRAID,ISMASS 495 : ITOTO=3+NS 496 : NN=ITOTO 497 : SEGADJ ITBBE1 497 : CALL LFCDIE (IORES,ITOTO,ITABE1(1),IRETOU,IFORM) 498 : IF (IRETOU.NE.0) GO TO 1000 499 : ITYSOU= ITABE1(1) 500 : ISRAID= ITABE1(2) 501 : ISMASS= ITABE1(3) 502 : IF (NS.EQ.0) GO TO 120 503 : DO 12 I=1,NS 504 : ISCHAM(I)= ITABE1(I+3) 505 : 12 CONTINUE 506 : 120 SEGDES MSOSTU 507 : 2201 CONTINUE 508 : SEGSUP ITBBE1 509 : GOTO 1098 510 : C ***************************** IMATRI ***************************** 511 : 6013 CONTINUE 512 : NN=0 513 : SEGINI ITBBE1 514 : DO 2300 IEL=1,IMAX1 515 : C READ(IORES,8000,END=1000,ERR=1000)NELRIG 516 : ITOTO=1 516 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 517 : IF (IRETOU.NE.0) GO TO 1000 518 : nelrig=0 519 : nligrp=0 520 : nligrd=0 521 : NELRIG= ILENA(1) 522 : NN=2 523 : SEGADJ ITBBE1 523 : CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM) 524 : IF(IRETOU.NE.0) GOTO 1000 525 : NLIGRD=ITABE1(1) 526 : NLIGRP=ITABE1(2) 527 : LVAL=NLIGRP*NLIGRD 528 : segini xmatri 529 : * write(6,*) ' nligrd nligrp nelrig',nligrd,nligrp,nelrig 530 : ITLAC(**)=xMATRI 531 : DO 2301 J=1,NELRIG 532 : if (lval.ne.0) 532 : > CALL LFCDI2(IORES,LVAL,RE(1,1,j),IRETOU,IFORM) 533 : IF(IRETOU.NE.0) GOTO 1000 534 : 2301 CONTINUE 535 : SEGDES xMATRI 536 : 2300 CONTINUE 537 : SEGSUP ITBBE1 538 : GOTO 1098 539 : C ***************************** MJONCT ***************************** 540 : 6014 CONTINUE 540 : CALL LIJONC (IORES,ITLACC,IMAX1,IRETOU,IFORM) 541 : IF (IRETOU.NE.0) GO TO 1000 542 : GOTO 1098 543 : C ***************************** MATTAC ***************************** 544 : 6015 CONTINUE 544 : CALL LIATTA (IORES,ITLACC,IMAX1,IRETOU,IFORM) 545 : IF (IRETOU.NE.0) GO TO 1000 546 : GOTO 1098 547 : C ***************************** MMATRI ***************************** 548 : 6016 CONTINUE 548 : CALL LIMMAT (IORES,ITLACC,IMAX1,IRETOU,IFORM) 549 : IF (IRETOU.NE.0) GO TO 1000 550 : GOTO 1098 551 : C *************************MDEFOR******************************* 552 : 6017 CONTINUE 553 : NN=0 554 : SEGINI ITBBE1 555 : DO 2700 IEL=1,IMAX1 556 : C READ(IORES,8000,END=1000,ERR=1000) NDEF 557 : ITOTO=1 557 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 558 : IF (IRETOU.NE.0) GO TO 1000 559 : NDEF = ILENA(1) 560 : SEGINI MDEFOR 561 : ITLAC(**)=MDEFOR 561 : CALL LFCDI2(IORES,NDEF,AMPL,IRETOU,IFORM) 562 : IF(IRETOU.NE.0) GOTO 1000 563 : C READ(IORES,8000,END=1000,ERR=1000)(IELDEF(I),I=1,NDEF),(ICHDEF(I), 564 : C 1 I=1,NDEF), (JCOUL(I),I=1,NDEF) 565 : NN=7*NDEF 566 : SEGADJ ITBBE1 566 : CALL LFCDIE (IORES,NN,ITABE1,IRETOU,IFORM) 567 : IF (IRETOU.NE.0) GO TO 1000 567 : CALL JDANSI ( IELDEF(1),ITABE1(1),NDEF) 567 : CALL JDANSI ( ICHDEF(1),ITABE1(NDEF +1),NDEF) 567 : CALL JDANSI ( JCOUL(1),ITABE1(2*NDEF+1),NDEF) 567 : CALL JDANSI ( MTVECT(1),ITABE1(3*NDEF+1),NDEF) 567 : CALL JDANSI ( MDCHP(1),ITABE1(4*NDEF+1),NDEF) 567 : CALL JDANSI ( MDCHEL(1),ITABE1(5*NDEF+1),NDEF) 567 : CALL JDANSI ( MDMODE(1),ITABE1(6*NDEF+1),NDEF) 568 : SEGDES MDEFOR 569 : 2700 CONTINUE 570 : SEGSUP ITBBE1 571 : GOTO 1098 572 : C ******************************MLREEL************************** 573 : 6018 CONTINUE 574 : DO 2800 IEL=1,IMAX1 575 : C READ(IORES,8000,END=1000,ERR=1000)N 576 : ITOTO=1 576 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 577 : IF (IRETOU.NE.0) GO TO 1000 578 : N = ILENA(1) 579 : JG=N 580 : SEGINI MLREEL 580 : CALL LFCDI2(IORES,N,PROG,IRETOU,IFORM) 581 : SEGDES MLREEL 582 : IF(IRETOU.NE.0) GOTO 1000 583 : ITLAC(**)=MLREEL 584 : 2800 CONTINUE 585 : GOTO 1098 586 : C ******************************MLENTI**************************** 587 : 6019 CONTINUE 588 : DO 2900 IEL=1,IMAX1 589 : ITOTO=1 589 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 590 : IF (IRETOU.NE.0) GO TO 1000 591 : N = ILENA(1) 592 : JG=N 593 : SEGINI MLENTI 593 : CALL LFCDEE(IORES,N,LECT,IRETOU,IFORM) 594 : SEGDES MLENTI 595 : IF(IRETOU.NE.0) GOTO 1000 596 : ITLAC(**)=MLENTI 597 : 2900 CONTINUE 598 : GOTO 1098 599 : C ****************************MCHARG****************************** 600 : 6020 CONTINUE 601 : NN=0 602 : NM=0 603 : NM2=0 604 : SEGINI ITBBM1,itbbc1 605 : SEGINI ITBBM2,itbbc3 606 : SEGINI ITBBM3,itbbc4 607 : SEGINI ITBBM4,itbbc5 608 : SEGINI ITBBE1 609 : SEGINI ITBBE2,itbbc2 610 : DO 3000 IEL=1,IMAX1 611 : C READ(IORES,8000,END=1000,ERR=1000)N 612 : IF(IONIVE.LE.6) THEN 613 : ITOTO=1 613 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 614 : IF (IRETOU.NE.0) GO TO 1000 615 : N = ILENA(1) 616 : SEGINI MCHARG 617 : NM=2*N 618 : SEGADJ ITBBM1,itbbc1 618 : if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM) 619 : if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4)) 620 : IF(IRETOU.NE.0) GOTO 1000 621 : NN=3*N 622 : SEGADJ ITBBE1 622 : CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM) 623 : IF(IRETOU.NE.0) GOTO 1000 624 : DO 3001 I=1,N 625 : c WRITE (CHANOM(I),FMT='(I4)') I 626 : CHANOM(I)=' ' 627 : SEGINI ICHARG 628 : KCHARG(I)=ICHARG 629 : I2=2*I 630 : I3=3*I 631 : if (iform.ne.2) then 632 : WRITE (CHANAT(I),FMT='(2A4)') ITABM1(I2-1),ITABM1(I2) 633 : else 634 : chanat(i)(1:4)=itabc1(i2-1) 635 : chanat(i)(5:8)=itabc1(i2) 636 : endif 637 : CHATYP='CHPOINT ' 638 : ICHPO1=ITABE1(I3-2) 639 : ICHPO2=ITABE1(I3-1) 640 : ICHPO3=ITABE1(I3) 641 : SEGDES ICHARG 642 : 3001 CONTINUE 643 : ELSE IF (IONIVE.GE.7.AND.IONIVE.LE.10) THEN 644 : ITOTO=1 644 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 645 : IF (IRETOU.NE.0) GO TO 1000 646 : N = ILENA(1) 647 : SEGINI MCHARG 648 : NN=2*N 649 : SEGADJ ITBBE2,itbbc2 649 : if (iform.ne.2) CALL LFCDIM(IORES,NN,ITABE2,IRETOU,IFORM) 650 : if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc2(1)(1:nn*4)) 651 : IF(IRETOU.NE.0) GOTO 1000 652 : NM2=N 653 : SEGADJ ITBBM2,itbbc3 653 : if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM) 654 : if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4)) 655 : IF(IRETOU.NE.0) GOTO 1000 656 : NM=2*N 657 : SEGADJ ITBBM1,itbbc1 657 : if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM) 658 : if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4)) 659 : IF(IRETOU.NE.0) GOTO 1000 660 : NN=3*N 661 : SEGADJ ITBBE1 661 : CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM) 662 : IF(IRETOU.NE.0) GOTO 1000 663 : DO 3002 I=1,N 664 : SEGINI ICHARG 665 : KCHARG(I)=ICHARG 666 : I2=2*I 667 : I3=3*I 668 : if (iform.ne.2) then 669 : WRITE (CHATYP,FMT='(2A4)') ITABM1(I2-1),ITABM1(I2) 670 : WRITE (CHANAT(I),FMT='(2A4)') ITABE2(I2-1),ITABE2(I2) 671 : WRITE (CHANOM(I),FMT='(1A4)') ITABM2(I) 672 : else 673 : chatyp(1:4)=itabc1(i2-1) 674 : chatyp(5:8)=itabc1(i2) 675 : chanat(i)(1:4)=itabc2(i2-1) 676 : chanat(i)(5:8)=itabc2(i2) 677 : chanom(i)=itabc3(i) 678 : endif 679 : c initialise par defaut 680 : CHAMOB(I) = 'STAT' 681 : CHALIE(I) = 'LIE ' 682 : c.. 683 : ICHPO1=ITABE1(I3-2) 684 : ICHPO2=ITABE1(I3-1) 685 : ICHPO3=ITABE1(I3) 686 : SEGDES ICHARG 687 : 3002 CONTINUE 688 : ELSE 689 : ITOTO=1 689 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 690 : IF (IRETOU.NE.0) GO TO 1000 691 : N = ILENA(1) 692 : SEGINI MCHARG 693 : NN=2*N 694 : SEGADJ ITBBE2,itbbc2 694 : if (iform.ne.2) CALL LFCDIM(IORES,NN,ITABE2,IRETOU,IFORM) 695 : if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc2(1)(1:nn*4)) 696 : IF(IRETOU.NE.0) GOTO 1000 697 : NM2=N 698 : SEGADJ ITBBM2,itbbc3 698 : if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM) 699 : if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4)) 700 : IF(IRETOU.NE.0) GOTO 1000 701 : SEGADJ ITBBM3,itbbc4 701 : if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM3,IRETOU,IFORM) 702 : if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc4(1)(1:nm2*4)) 703 : IF(IRETOU.NE.0) GOTO 1000 704 : SEGADJ ITBBM4,itbbc5 704 : if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM4,IRETOU,IFORM) 705 : if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc5(1)(1:nm2*4)) 706 : IF(IRETOU.NE.0) GOTO 1000 707 : NM=2*N 708 : SEGADJ ITBBM1,itbbc1 708 : if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM) 709 : if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4)) 710 : IF(IRETOU.NE.0) GOTO 1000 711 : NN=7*N 712 : SEGADJ ITBBE1 712 : CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM) 713 : IF(IRETOU.NE.0) GOTO 1000 714 : DO 3003 I=1,N 715 : SEGINI ICHARG 716 : KCHARG(I)=ICHARG 717 : I2=2*I 718 : I3=7*I 719 : if (iform.ne.2) then 720 : WRITE (CHATYP,FMT='(2A4)') ITABM1(I2-1),ITABM1(I2) 721 : WRITE (CHANAT(I),FMT='(2A4)') ITABE2(I2-1),ITABE2(I2) 722 : WRITE (CHANOM(I),FMT='(1A4)') ITABM2(I) 723 : WRITE (CHAMOB(I),FMT='(1A4)') ITABM3(I) 724 : WRITE (CHALIE(I),FMT='(1A4)') ITABM4(I) 725 : else 726 : chatyp(1:4)=itabc1(i2-1) 727 : chatyp(5:8)=itabc1(i2) 728 : chanat(i)(1:4)=itabc2(i2-1) 729 : chanat(i)(5:8)=itabc2(i2) 730 : chanom(i)=itabc3(i) 731 : chamob(i)=itabc4(i) 732 : chalie(i)=itabc5(i) 733 : endif 734 : ICHPO1=ITABE1(I3-6) 735 : ICHPO2=ITABE1(I3-5) 736 : ICHPO3=ITABE1(I3-4) 737 : ICHPO4=ITABE1(I3-3) 738 : ICHPO5=ITABE1(I3-2) 739 : ICHPO6=ITABE1(I3-1) 740 : ICHPO7=ITABE1(I3) 741 : SEGDES ICHARG 742 : 3003 CONTINUE 743 : ENDIF 744 : SEGDES MCHARG 745 : ITLAC(**)=MCHARG 746 : 3000 CONTINUE 747 : SEGSUP ITBBM1,itbbc1,ITBBE1,ITBBM2,itbbc3,ITBBM3,itbbc4, 748 : > ITBBM4,itbbc5,ITBBE2,itbbc2 749 : GOTO 1098 750 : C **************************** ************************** 751 : 6021 CONTINUE 752 : GOTO 1098 753 : C *****************************MEVOLL*************************** 754 : 6022 CONTINUE 755 : NN=0 756 : NM=0 757 : NM2=20 758 : SEGINI ITBBM2,itbbc3 759 : SEGINI ITBBE1,ITBBM1,itbbc1 760 : LDECA=7 761 : IF(NIVEAU.GE.3) LDECA=11 762 : LDECA2=18 763 : DO 3200 IEL=1,IMAX1 764 : ITOTO=1 764 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 765 : IF (IRETOU.NE.0) GO TO 1000 766 : N = ILENA(1) 767 : NM2=20 768 : SEGADJ ITBBM2,itbbc3 769 : SEGINI MEVOLL 770 : if (iform.ne.2) then 770 : CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM) 771 : IF(IRETOU.NE.0) GOTO 1000 772 : WRITE (ITYEVO,FMT='(2A4)') ITABM2(1),ITABM2(2) 773 : WRITE(IEVTEX,FMT='(18A4)') (ITABM2(I+2),I=1,18) 774 : else 775 : ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4)) 776 : * write (6,*) ' evol itabc3 ',itabc3(1),itabc3(2) 777 : ityevo(1:4)=itabc3(1) 778 : ityevo(5:8)=itabc3(2) 779 : do jpv=1,18 780 : ievtex(1+4*(jpv-1):4*jpv)=itabc3(jpv+2) 781 : enddo 782 : endif 783 : NN=3*N 784 : SEGADJ ITBBE1 784 : CALL LFCDIE(IORES,NN,ITABE1,IRETOU,IFORM) 785 : IF(IRETOU.NE.0) GOTO 1000 786 : NM=LDECA*N 787 : SEGADJ ITBBM1,itbbc1 787 : if (iform.ne.2) CALL LFCDIM(IORES,NM,ITABM1,IRETOU,IFORM) 788 : if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc1(1)(1:nm*4)) 789 : IF(IRETOU.NE.0) GOTO 1000 790 : IF (NIVEAU.LT.3) GO TO 221 791 : NM2=LDECA2*N 792 : SEGADJ ITBBM2,itbbc3 792 : if (iform.ne.2) CALL LFCDIM(IORES,NM2,ITABM2,IRETOU,IFORM) 793 : if (iform.eq.2) ios=IXDRSTRING( ixdrr, itabc3(1)(1:nm2*4)) 794 : IF(IRETOU.NE.0) GOTO 1000 795 : 221 CONTINUE 796 : DO 3201 IN=1,N 797 : SEGINI KEVOLL 798 : IEVOLL(IN)=KEVOLL 799 : I4=3*IN 800 : IPROGX=ITABE1(I4-2) 801 : IPROGY=ITABE1(I4-1) 802 : NUMEVX=ITABE1(I4) 803 : I7=LDECA*(IN-1) 804 : if (iform.ne.2) then 805 : WRITE(NOMEVX,FMT='(3A4)')(ITABM1(I7+I),I=1,3) 806 : WRITE(NOMEVY,FMT='(3A4)')(ITABM1(I7+I+3),I=1,3) 807 : WRITE (NUMEVY,FMT='(A4)') ITABM1(I7+7) 808 : IF(NIVEAU.GE.3) THEN 809 : I8=LDECA2*(IN-1) 810 : WRITE(TYPX,FMT='(2A4)')(ITABM1(I7+7+I),I=1,2) 811 : WRITE(TYPY,FMT='(2A4)')(ITABM1(I7+9+I),I=1,2) 812 : WRITE(KEVTEX,FMT='(18A4)') (ITABM2(I8+JPV),JPV=1,18) 813 : ENDIF 814 : else 815 : * write (6,*) ' evol itabc1 ',itabc1(i7+1),itabc1(i7+2) 816 : * write (6,*) ' evol itabc1 ',itabc1(i7+3+1),itabc1(i7+3+2) 817 : nomevx(1:4)=itabc1(i7+1) 818 : nomevx(5:8)=itabc1(i7+2) 819 : nomevx(9:12)=itabc1(i7+3) 820 : nomevy(1:4)=itabc1(i7+3+1) 821 : nomevy(5:8)=itabc1(i7+3+2) 822 : nomevy(9:12)=itabc1(i7+3+3) 823 : numevy=itabc1(i7+7) 824 : if (niveau.ge.3) then 825 : I8=LDECA2*(IN-1) 826 : typx(1:4)=itabc1(i7+7+1) 827 : typx(5:8)=itabc1(i7+7+2) 828 : typy(1:4)=itabc1(i7+9+1) 829 : typy(5:8)=itabc1(i7+9+2) 830 : do jpv=1,18 831 : kevtex(1+(jpv-1)*4:4*jpv)=itabc3(i8+jpv) 832 : enddo 833 : endif 834 : endif 835 : 3202 CONTINUE 836 : SEGDES KEVOLL 837 : 3201 CONTINUE 838 : SEGDES MEVOLL 839 : ITLAC(**)=MEVOLL 840 : 3200 CONTINUE 841 : SEGSUP ITBBE1,ITBBM1,itbbc1 842 : SEGSUP ITBBM2,itbbc3 843 : GOTO 1098 844 : C 845 : C **********************SUPERELE************************************ 846 : 6023 CONTINUE 847 : ITOTO=1 848 : DO 230 IEL=1,IMAX1 848 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 849 : IF (IRETOU.NE.0) GO TO 1000 850 : NTOTO=ILENA(1) 851 : SEGINI MSUPER 852 : ITLAC(**)=MSUPER 852 : CALL LFCDIE (IORES,NTOTO,ILENA,IRETOU,IFORM) 853 : IF (IRETOU.NE.0) GO TO 1023 854 : MRIGTO=ILENA(1) 855 : MSUPEL=ILENA(2) 856 : MSURAI=ILENA(3) 857 : MBLOQU=ILENA(4) 858 : MSUMAS=ILENA(5) 859 : MCROUT=ILENA(6) 860 : SEGDES MSUPER 861 : 230 CONTINUE 862 : GOTO 1098 863 : 1023 CONTINUE 864 : SEGDES MSUPER 865 : GO TO 1000 866 : C ************************* LOGIQUE *************************** 867 : 6024 CONTINUE 868 : ITOTO=1 868 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 869 : IF (IRETOU.NE.0) GO TO 1000 870 : N = ILENA(1) 871 : M=ITLAC(/1)+1 872 : NM=M+N-1 873 : DO 241 I=1,N 874 : ITLAC(**)=0 875 : 241 CONTINUE 875 : CALL LFCDIE (IORES,N,ITLAC(M),IRETOU,IFORM) 876 : IF(IRETOU.NE.0) GOTO 1000 877 : DO 242 I=M,NM 878 : ITOTO=ITLAC(I) 879 : LOGI=.FALSE. 880 : IF(ITOTO.EQ.1)LOGI=.TRUE. 880 : CALL QUERAN (IRAT,'LOGIQUE ',IVB,XVA,CTYPE,LOGI,IOB) 881 : ITLAC(I) =IRAT 882 : 242 CONTINUE 883 : GO TO 1098 884 : C ******************************FLOTTANT********************** 885 : 6025 CONTINUE 886 : ITOTO=1 886 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 887 : IF (IRETOU.NE.0) GO TO 1000 888 : N = ILENA(1) 889 : M=ITLAC(/1) 890 : DO 251 I=1,N 891 : ITLAC(**)=0 892 : 251 CONTINUE 893 : L=N 894 : SEGINI ITBBR1 894 : CALL LFCDI2(IORES,N,TABR1,IRETOU,IFORM) 895 : IF(IRETOU.NE.0) GO TO 1000 896 : DO 250 I=1,N 897 : XVA=TABR1(I) 897 : CALL QUERAN(IRAT,'FLOTTANT',IVB,XVA,CTYPE,LOGI,IOB) 898 : ITLAC(I+M)=IRAT 899 : 250 CONTINUE 900 : SEGSUP ITBBR1 901 : ITBBR1=0 902 : GO TO 1098 903 : C **************************** ENTIER*************************** 904 : 6026 CONTINUE 905 : ITOTO=1 905 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 906 : IF (IRETOU.NE.0) GO TO 1000 907 : N = ILENA(1) 908 : M=ITLAC(/1) 909 : DO 261 I=1,N 910 : ITLAC(**)=0 911 : 261 CONTINUE 912 : L=N 913 : NN=L 914 : SEGINI ITBBE1 914 : CALL LFCDEE(IORES,N,ITABE1,IRETOU,IFORM) 915 : IF(IRETOU.NE.0) GO TO 1000 916 : DO 260 I=1,L 917 : IVB=ITABE1(I) 917 : CALL QUERAN(IRAT,'ENTIER ',IVB,XVA,CTYPE,LOGI,IOB) 918 : ITLAC(M+I)=IRAT 919 : 260 CONTINUE 920 : SEGSUP ITBBE1 921 : GOTO 1098 922 : C **************************** MOT *************************** 923 : 6027 CONTINUE 924 : ITOTO=2 924 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 925 : IF (IRETOU.NE.0) GO TO 1000 926 : N = ILENA(2) 927 : NNN=N 928 : NN=ILENA(1) 929 : SEGINI ITAMOT 930 : MM=ITLAC(/1)+1 931 : DO 271 I=1,N 932 : ITLAC(**)=0 933 : 271 CONTINUE 933 : CALL LFCDIC(IORES,ITAMO,IRETOU,IFORM) 934 : IF(IRETOU.NE.0) GO TO 1000 934 : CALL LFCDIE(IORES,N,ICOTA,IRETOU,IFORM) 935 : IF(IRETOU.NE.0) GOTO 1000 936 : M=1 937 : DO 270 I=1,N 938 : LL=ICOTA(I) 939 : NN=ICOTA(I)-M+1 940 : IVA=NN 941 : CHA1(1:NN)=ITAMO(M:LL) 942 : M=LL+1 942 : CALL QUERAN(IRAT,'MOT ',IVA,XVA,CHA1(1:NN),LOGI,IOB) 943 : ITLAC(MM+I-1) =IRAT 944 : 270 CONTINUE 945 : SEGSUP ITAMOT 946 : GOTO 1098 947 : C ****************************TEXTE ************************* 948 : 6028 CONTINUE 949 : DO 280 IEL=1,IMAX1 950 : ITOTO=1 950 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 951 : IF (IRETOU.NE.0) GO TO 1000 952 : N = ILENA(1) 953 : SEGINI MTEXTE 954 : NCART= N 954 : CALL LFCDIC(IORES,MTEXT,IRETOU,IFORM) 955 : SEGDES MTEXTE 956 : IF(IRETOU.NE.0) GOTO 1000 957 : ITLAC(**)=MTEXTE 958 : 280 CONTINUE 959 : GO TO 1098 960 : C ******************************MLMOTS**************************** 961 : 6029 CONTINUE 962 : DO 290 IEL=1,IMAX1 963 : ITOTO=2 963 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 964 : IF (IRETOU.NE.0) GO TO 1000 965 : JGN = ILENA(1) 966 : JGM = ILENA(2) 967 : SEGINI MLMOTS 968 : NN=JGN*JGM 969 : NNN=0 970 : SEGINI ITAMOT 970 : CALL LFCDIC(IORES,ITAMO,IRETOU,IFORM) 971 : IF(IRETOU.NE.0) GOTO 1000 972 : DO 56 IUH = 1,JGM 973 : MOTS(IUH)= ITAMO((IUH-1)*JGN+1:IUH*JGN) 974 : 56 CONTINUE 975 : SEGDES MLMOTS 976 : ITLAC(**)=MLMOTS 977 : 290 CONTINUE 978 : GOTO 1098 979 : C **************************MVECTE********************************** 980 : 6030 CONTINUE 981 : DO 300 IOB=1,IMAX1 982 : IRETOU=0 982 : CALL LIVECT (MVECTE,IORES,IRETOU,IFORM) 983 : IF (IRETOU.NE.0) GO TO 1000 984 : ITLAC(**)=MVECTE 985 : 300 CONTINUE 986 : GOTO 1098 987 : C ************************* VECTD *************************** 988 : 6031 CONTINUE 989 : DO 310 IEL=1,IMAX1 990 : ITOTO=1 990 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 991 : IF (IRETOU.NE.0) GO TO 1000 992 : INC = ILENA(1) 993 : SEGINI MVECTD 993 : CALL LFCDI2(IORES,N,VECTBB,IRETOU,IFORM) 994 : SEGDES MVECTD 995 : IF(IRETOU.NE.0) GOTO 1000 996 : ITLAC(**)=MVECTD 997 : 310 CONTINUE 998 : GOTO 1098 999 : C **************************** POINTS ************************** 1000 : 6032 CONTINUE 1001 : ITOTO=1 1001 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 1002 : IF (IRETOU.NE.0) GO TO 1000 1003 : N = ILENA(1) 1004 : M = ITLAC(/1) 1005 : IPLU=N-M 1006 : DO 322 I=1,IPLU 1007 : ITLAC(**)=0 1008 : 322 CONTINUE 1008 : CALL LFCDIE(IORES,N,ITLAC,IRETOU,IFORM) 1009 : IF(IRETOU.NE.0) GOTO 1000 1010 : DO 321 I=1,N 1011 : ITLAC(I)=ITLAC(I)+NBANC 1012 : 321 CONTINUE 1013 : GOTO 1098 1014 : C ****************************CONFIG ************************* 1015 : 6033 CONTINUE 1016 : IAV=ITLAC(/1) 1017 : * write(6,*) ' imax1 iav ' , imax1,iav 1018 : iconul=0 1019 : ibon=0 1020 : DO 330 IEL=1,IMAX1 1021 : ITOTO=1 1021 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 1022 : * write(6,*) ' lipil iel ilena(1)' , iel , ilena(1) 1023 : IF (IRETOU.NE.0) GO TO 1000 1024 : ILONG=ILENA(1) 1025 : * write(6,*) ' lipil iel ilong' , iel , ilong 1026 : if(ilong.eq.0) then 1027 : iconul=iconul+1 1028 : * nbpts=idim+1 1029 : * segini mcoor1 1030 : * itlac(**)=mcoor1 1031 : go to 330 1032 : endif 1033 : IDRES=IDIM 1034 : IDIM = 0 1035 : * write(6,*) ' iel ilong idres nbanc ', iel,ilong,idres,nbanc 1036 : NBPTS = ILONG+NBANC*(IDRES+1) 1037 : SEGINI MCOOR1 1038 : if(ibon.eq.0) ibon=mcoor1 1039 : IDIM=IDRES 1040 : IDIM11= (IDIM+1)*NBANC+1 1040 : CALL LFCDI2(IORES,ILONG,MCOOR1.XCOOR(IDIM11),IRETOU,IFORM) 1041 : IF(IRETOU.NE.0) GOTO 1000 1042 : DO 332 J=1,NBANC*(IDIM+1) 1043 : MCOOR1.XCOOR(J)=XCOOR(J) 1044 : 332 CONTINUE 1045 : * write(6,*) ' mcoor1' , mcoor1 1046 : SEGDES MCOOR1 1047 : ITLAC(**)=MCOOR1 1048 : 330 CONTINUE 1049 : IF(IONIVE.GT.9) THEN 1050 : if( iconul.ne.imax1) then 1051 : MCOOR1=Ibon 1052 : SEGACT MCOOR1*MOD 1053 : SEGDES MCOORD 1054 : MCOORD=MCOOR1 1055 : * write(6,*) ' mcoord ' , mcoord 1056 : endif 1057 : ENDIF 1058 : GO TO 1098 1059 : C *************************** MLCHPO ************************* 1060 : 6034 CONTINUE 1061 : DO 340 IEL=1,IMAX1 1062 : ITOTO=1 1062 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 1063 : IF (IRETOU.NE.0) GO TO 1000 1064 : N1 = ILENA(1) 1065 : SEGINI MLCHPO 1066 : ITLAC(**)=MLCHPO 1066 : CALL LFCDIE(IORES,N1,ICHPOI,IRETOU,IFORM) 1067 : SEGDES MLCHPO 1068 : IF(IRETOU.NE.0) GOTO 1000 1069 : 340 CONTINUE 1070 : GOTO 1098 1071 : C ****************************MBASEM***************************** 1072 : 6035 CONTINUE 1073 : NN=0 1074 : DO 3500 IEL=1,IMAX1 1075 : ITOTO=1 1075 : CALL LFCDIE( IORES,ITOTO,ILENA,IRETOU,IFORM) 1076 : IF (IRETOU.NE.0) GO TO 1000 1077 : N=ILENA(1) 1078 : SEGINI MBASEM 1079 : DO 3501 I=1,N 1080 : ITOTO=1 1080 : CALL LFCDIE( IORES,ITOTO,ILENA,IRETOU,IFORM) 1081 : IF (IRETOU.NE.0) GO TO 1000 1082 : NIBST=ILENA(1) 1083 : SEGINI MSOBAS 1084 : LISBAS(I)=MSOBAS 1084 : CALL LFCDIE(IORES,NIBST,IBSTRM(1),IRETOU,IFORM) 1085 : IF (IRETOU.NE.0) GO TO 1000 1086 : SEGDES MSOBAS 1087 : 3501 CONTINUE 1088 : SEGDES MBASEM 1089 : ITLAC(**)=MBASEM 1090 : 3500 CONTINUE 1091 : GOTO 1098 1092 : C *************************** PROCED **************************** 1093 : 6036 CONTINUE 1094 : IMAX1=NOBJN 1095 : SEGACT NOMM1,NOMM2 1096 : DO 636 IEL=1,IMAX1 1097 : SEGACT NOMM1,NOMM2 1098 : CHA1(1:8)=NOM2(IEL) 1099 : CHA1(9:16)=' ' 1099 : CALL CQUOI(CHA1(1:8),CHA1(9:16),IVAL,XVA,CHARI,LOGI,IOBJ) 1100 : IF(IERR.EQ.0)THEN 1101 : ITLAC(**)= IOBJ 1102 : ELSE 1103 : IRETOU=1 1104 : GO TO 1000 1105 : ENDIF 1106 : 636 CONTINUE 1107 : GOTO 1097 1108 : C *************************** BLOC **************************** 1109 : 6037 CONTINUE 1110 : GOTO 1097 1111 : C *************************** MMODEL **************************** 1112 : 6038 CONTINUE 1112 : CALL LIMODL(IORES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU,NBANC) 1113 : IF (IRETOU.NE.0) GOTO 1000 1114 : GOTO 1098 1115 : C *************************** MCHAML **************************** 1116 : 6039 CONTINUE 1116 : CALL LICHAM(IORES,ITLACC,IMAX1,IRETOU,IFORM,NIVEAU) 1117 : IF (IRETOU.NE.0) GOTO 1000 1118 : GOTO 1098 1119 : C *************************** MINTE **************************** 1120 : 6040 CONTINUE 1121 : DO 2840 IEL=1,IMAX1 1122 : ITOTO=2 1122 : CALL LFCDIE (IORES,ITOTO,ILENA,IRETOU,IFORM) 1123 : IF (IRETOU.NE.0) GO TO 1000 1124 : NBNO = ILENA(1) 1125 : NBPGAU = ILENA(2) 1126 : L=NBPGAU*4+6*NBPGAU*NBNO 1127 : SEGINI ITBBR1 1127 : CALL LFCDI2 (IORES,L,TABR1,IRETOU,IFORM) 1128 : IF(IRETOU.NE.0) GO TO 1000 1129 : SEGINI MINTE 1130 : I=0 1131 : DO 2841 IC=1,NBPGAU 1132 : I=I+1 1133 : POIGAU(IC)=TABR1(I) 1134 : I=I+1 1135 : QSIGAU(IC)=TABR1(I) 1136 : I=I+1 1137 : ETAGAU(IC)=TABR1(I) 1138 : I=I+1 1139 : DZEGAU(IC)=TABR1(I) 1140 : DO 28411 IB=1,NBNO 1141 : DO 28412 IA=1,6 1142 : I=I+1 1143 : SHPTOT(IA,IB,IC)=TABR1(I) 1144 : 28412 CONTINUE 1145 : 28411 CONTINUE 1146 : 2841 CONTINUE 1147 : SEGSUP ITBBR1 1148 : SEGDES MINTE 1149 : ITLAC(**)=MINTE 1150 : 2840 CONTINUE 1151 : GOTO 1098 1152 : C **************************NUAGE *************************** 1152 : 6041 CALL LINUAG(IORES,ITLACC,IMAX1,IRETOU,IFORM) 1153 : IF(IRETOU.NE.0) GO TO 1000 1154 : GOTO 1098 1155 : C ************************* MATRAK ******************************** 1156 : 6042 CONTINUE 1156 : CALL LIMTAK(IORES,ITLACC,IMAX1,IRETOU,IFORM) 1157 : IF (IRETOU.NE.0) GO TO 1000 1158 : GOTO 1098 1159 : C ************************* MATRIK ******************************** 1160 : 6043 CONTINUE 1160 : CALL LIMTIK(IORES,ITLACC,IMAX1,IRETOU,IFORM) 1161 : IF (IRETOU.NE.0) GO TO 1000 1162 : GOTO 1098 1163 : C ************************** METHODE ***************************** 1164 : 6045 CONTINUE 1165 : DO 6945 I=1,IMAX1 1166 : ITLAC(**)=0 1167 : 6945 CONTINUE 1167 : CALL LFCDIE(IORES,1,ILENA,IRETOU,IFORM) 1168 : IF (IRETOU.NE.0) GO TO 1000 1168 : CALL LFCDIE(IORES,IMAX1,ITLAC,IRETOU,IFORM) 1169 : IF (IRETOU.NE.0) GO TO 1000 1170 : GOTO 1098 1171 : C ****************************************************************** 1172 : C *****FIN DE LECTURE D'UNE PILE : NOM DES OBJETS******************* 1173 : C 1174 : 1098 CONTINUE 1175 : ******* KCOLAC(IFILE)=IMAX1+ KCOLAC(IFILE) 1175 : CALL CREOB (ITYPE,NOMM1,NOMM2,ITLACC) 1176 : IF(IFIN.EQ.1) GOTO 1000 1177 : GOTO 1097 1178 : ********************* ON REBOUCLE EN LECTURE ********************** 1179 : 1000 CONTINUE 1180 : 1099 CONTINUE 1181 : 1001 CONTINUE 1182 : IRET=IRETOU 1183 : IF(NOMM1.NE.0) SEGSUP NOMM1 1184 : IF(NOMM2.NE.0) SEGSUP NOMM2 1185 : IF (ITBBM1.NE.0) SEGSUP ITBBM1,itbbc1 1186 : IF (ITBBM2.NE.0) SEGSUP ITBBM2,itbbc3 1187 : IF (ITBBE1.NE.0) SEGSUP ITBBE1 1188 : IF (ITBBE2.NE.0) SEGSUP ITBBE2,itbbc2 1189 : IF (ITBBR1.NE.0) SEGSUP ITBBR1 1190 : SEGDES ICOLAC 1191 : RETURN 1192 : C ------------------------------------------------------- 1193 : 8000 FORMAT(16I5) 1194 : 8001 FORMAT(16(1X,A4)) 1195 : END 1196 : 1197 : 1198 : 1199 : 1200 :
© Cast3M 2003 - All rights reserved.
Disclaimer