1 : C WRPIL SOURCE PV 14/01/31 21:15:17 7935 2 : SUBROUTINE WRPIL (ICOLAC,IMAX,IFORM,LABEL,isilen) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C======================================================================= 6 : C BUT : ECRITURE DES PILES SUR LE FICHIER IOSAU 7 : C APPELE PAR SAUV 8 : C APPELLE : WRPOIN NOMMEF SOPAPF ECDIFE ECDIFM ECDIFR SOSOLF 9 : C : ECDES ECDIFP JDANSI WRMAIL 10 : C ECRIT PAR FARVACQUE - REPRIS PAR LENA 11 : C 12 : C HISTORIQUE : ajout des objets de type MATRAK et MATRIK par 13 : C GOUNAND (15/07/98) 14 : C 15 : C======================================================================= 16 : C TABLEAU KCOLA: VOIR SIGNIFICATION DANS SOUS-PROGRAMME TYPFIL 17 : C======================================================================= 18 : -INC CCOPTIO 19 : -INC CCNOYAU 20 : -INC CCGEOME 21 : -INC CCFXDR 22 : 23 : -INC SMELEME 24 : -INC SMBASEM 25 : -INC SMRIGID 26 : -INC SMCOORD 27 : POINTEUR MCOOR1.MCOORD 28 : -INC SMSTRUC 29 : -INC SMDEFOR 30 : -INC SMLREEL 31 : -INC SMLENTI 32 : -INC SMCHARG 33 : -INC SMEVOLL 34 : -INC SMELSTR 35 : -INC SMCLSTR 36 : -INC SMTEXTE 37 : -INC SMSUPER 38 : -INC SMVECTD 39 : -INC SMLMOTS 40 : -INC SMTABLE 41 : -INC SMLCHPO 42 : -INC SMINTE 43 : -INC TMCOLAC 44 : 45 : SEGMENT/ITBBE1/( ITABE1(NN)) 46 : SEGMENT/ITBBE2/( ITABE2(NN)) 47 : segment itbbc2 48 : character*4 itabc2(nn) 49 : endsegment 50 : SEGMENT/ITBBM1/( ITABM1(NM)) 51 : segment itbbc1 52 : character*4 itabc1(nm) 53 : endsegment 54 : SEGMENT/ITBBM2/( ITABM2(NM2)) 55 : segment itbbc3 56 : character*4 itabc3(nm2) 57 : endsegment 58 : SEGMENT/ITBBM3/( ITABM3(NM2)) 59 : segment itbbc4 60 : character*4 itabc4(nm2) 61 : endsegment 62 : SEGMENT/ITBBM4/( ITABM4(NM2)) 63 : segment itbbc5 64 : character*4 itabc5(nm2) 65 : endsegment 66 : SEGMENT/ITABR1/( TABR1(L)*D) 67 : SEGMENT ITAMOT 68 : CHARACTER*(NN) ITAMO 69 : INTEGER ICOTA(NNN) 70 : ENDSEGMENT 71 : C 72 : CHARACTER*(8) ITYPE,ITYPO 73 : CHARACTER*512 CHA1 74 : CHARACTER*72 LABEL 75 : REAL*8 XRA 76 : LOGICAL LIRA 77 : DIMENSION ILENA(30) 78 : DIMENSION IPV(2) 79 : real*4 densi4 80 : C--- 81 : DATA NIVEAU /2/ 82 : C====================================================================== 83 : * verif ouverture du fichier de sauvegarde 84 : if(iform.eq.2) then 84 : if (ixdrw.eq.0) call erreur(-195) 84 : if (ixdrw.eq.0) call erreur(558) 85 : if (ierr.ne.0) return 86 : endif 87 : * 88 : ITBBE1=0 89 : ITBBE2=0 90 : ITBBM1=0 91 : ITBBM2=0 92 : ITBBM3=0 93 : ITBBM4=0 94 : ITABR1=0 95 : C 96 : SEGACT ICOLAC 97 : NITLAC=ICOLA(/1) 98 : IF(IPSAUV.NE.0) GO TO 7654 99 : C 100 : C **** TITRE ******************************************** 101 : C 102 : C IQUOI=3 102 : C CALL ECDES (IOSAU,IQUOI,IFORM) 102 : C CALL ECDIFM (IOSAU,18,TITREE,IFORM) 103 : C 104 : C **** INFORMATIONS GENERALES MAILLAGE ***************** 105 : C 106 : IQUOI=4 106 : CALL ECDES (IOSAU,IQUOI,IFORM) 107 : IF(IFORM.EQ.1) WRITE (IOSAU,701)IONIVE, IERMAX,IDIM 108 : IF(IFORM.EQ.0)WRITE (IOSAU)IONIVE, IERMAX,IDIM 109 : if (iform.eq.2) then 110 : ios=IXDRINT( ixdrw, ionive ) 111 : ios=IXDRINT( ixdrw, iermax ) 112 : ios=IXDRINT( ixdrw, idim ) 113 : dimatt = dimatt + 4 114 : endif 115 : 701 FORMAT(' NIVEAU',I4,' NIVEAU ERREUR',I4,' DIMENSION',I4) 116 : IF (IFORM.EQ.1)WRITE(IOSAU,702) DENSIT 117 : IF (IFORM.EQ.0)WRITE(IOSAU) DENSIT 118 : if (iform.eq.2) then 119 : densi4=densit 120 : ios=IXDRREAL( ixdrw, densi4 ) 121 : dimatt = dimatt + 2 122 : endif 123 : 702 FORMAT(' DENSITE',E12.5) 124 : C 125 : C ***** INFORMATIONS GENERALES CASTEM2000 ***************** 126 : C 127 : IQUOI=7 127 : CALL ECDES (IOSAU,IQUOI,IFORM) 128 : N=7 129 : IF(IONIVE.GE.6) N=8 130 : IF(IFORM.EQ.1)WRITE(IOSAU,703) N 131 : IF(IFORM.EQ.0)WRITE(IOSAU) N 132 : if (iform.eq.2) then 133 : ios=IXDRINT( ixdrw, n) 134 : dimatt = dimatt + 2 135 : endif 136 : 703 FORMAT(' NOMBRE INFO CASTEM2000',I4) 137 : IF(IFORM.EQ.1) WRITE(IOSAU,704) IFOUR,NIFOUR,IFOMOD,IECHO,IIMPI 138 : * ,IOSPI ,ISOTYP 139 : IF(IFORM.EQ.1.AND.IONIVE.GE.6) WRITE(IOSAU,706) NSDPGE 140 : IF(IFORM.EQ.0.AND.IONIVE.LT.6) 141 : * WRITE(IOSAU) IFOUR,NIFOUR,IFOMOD,IECHO,IIMPI 142 : * ,IOSPI ,ISOTYP ,NSDPGE 143 : IF(IFORM.EQ.0.AND.IONIVE.GE.6) 144 : * WRITE(IOSAU) IFOUR,NIFOUR,IFOMOD,IECHO,IIMPI 145 : * ,IOSPI ,ISOTYP ,NSDPGE 146 : if (iform.eq.2) then 147 : ios=IXDRINT( ixdrw, ifour ) 148 : ios=IXDRINT( ixdrw, nifour ) 149 : ios=IXDRINT( ixdrw, ifomod ) 150 : ios=IXDRINT( ixdrw, iecho ) 151 : ios=IXDRINT( ixdrw, iimpi ) 152 : ios=IXDRINT( ixdrw, iospi ) 153 : ios=IXDRINT( ixdrw, isotyp ) 154 : ios=IXDRINT( ixdrw, nsdpge ) 155 : dimatt = dimatt + 9 156 : endif 157 : 704 FORMAT(' IFOUR',I4,' NIFOUR',I4,' IFOMOD',I4,' IECHO',I4, 158 : * ' IIMPI',I4,' IOSPI',I4,' ISOTYP',I4) 159 : 706 FORMAT(' NSDPGE',I6) 160 : 7654 CONTINUE 161 : C 162 : C **** COORDONNEES + MELEME : APPEL DE MAILLA ******************** 163 : C 163 : C IF(IMAX.NE.0) CALL WRPOIN (IMAX,IFORM,ICOLAC) 164 : C 165 : C 166 : C **** BOUCLE SUR LES FILES DE SORTIE IFILE=1,NITLAC ************* 167 : C 168 : DO 1099 IFILE=1,NITLAC 169 : *pv on se sort pas le mmatri 170 : if (ifile.eq.16) goto 1099 171 : *tc on ne sort pas les points 172 : * if(ifile.eq.32) go to 1099 173 : ITLACC=KCOLA(IFILE) 174 : IMAX1=ITLAC(/1) 175 : IF(IMAX1.EQ.0) GO TO 1099 176 : IDEB=1 177 : IF(IPSAUV.NE.0) IDEB=KCOLAC(IFILE)+1 178 : IF(IMAX1.LT.IDEB.AND.IFILE.NE.32) GO TO 1099 179 : ITYPE=' ' 179 : CALL TYPFIL (ITYPE,IFILE) 180 : C 181 : 182 : IF (IFILE.NE.8.AND.IFILE.NE.36.AND. ISILEN.NE.1) 183 : $ WRITE(IOIMP,801)IFILE,IMAX1,ITYPE 184 : 801 FORMAT(/,' LA PILE NUMERO',I4,' CONTIENT',I8,' OBJET(S) ',A8) 185 : C 186 : IP1=ICOLA(IFILE) 187 : IF (IFILE.NE.8.AND.IFILE.NE.36) 187 : $ CALL NOMMEF (IP1,IMAX1,IFILE,IFORM,IDEB,isilen) 188 : GO TO (6001,6002,6003,6004,6005,6006,6007,6008,6009,6010,6011, 189 : 1 6012,6013,6014,6015,6016,6017,6018,6019,6020,6021,6022, 190 : 1 6023,6024,6025,6026,6027,6028,6029,6030,6031,6032, 191 : 1 6033,6034,6035,6036,6037,6038,6039,6040,6041, 192 : 1 6042,6043,6010,6045 ),IFILE 193 : 1001 MOTERR(1:8)=ITYPE 193 : CALL ERREUR (336) 194 : GO TO 1099 195 : C **************************MELEME ********************************* 196 : 6001 CONTINUE 197 : DO 1100 IEL=IDEB,IMAX1 198 : MELEME =ITLAC(IEL) 198 : CALL WRMAIL (MELEME,IOSAU,IRETOU,IFORM) 199 : 1100 CONTINUE 200 : GO TO 1098 201 : C **************************CHPOINT********************************* 202 : 6002 CONTINUE 202 : CALL WRCHPO (IOSAU,ITLACC,IMAX1,IFORM,IDEB) 203 : GOTO 1098 204 : C ***********************MRIGID************************************* 205 : 6003 CONTINUE 206 : DO 1202 IEL=IDEB,IMAX1 207 : MRIGID=ITLAC(IEL) 208 : SEGACT MRIGID 209 : NRIGEL=IRIGEL(/2) 210 : NRIGE =IRIGEL(/1) 211 : NBGEOR=0 212 : IF(IMGEO1.NE.0) THEN 213 : IMGEOD=IMGEO1 214 : SEGACT IMGEOD 215 : NBGEOR=IMGEOR(/1) 216 : ENDIF 217 : *pv IF(ICHOLE.GE.0) THEN 218 : *pv ICHOLX=0 219 : *pv ELSE 220 : *pv ICHOLX=-ICHOLE 221 : *pv ENDIF 222 : ICHOLX=0 223 : ILENA(1)=NRIGEL 224 : ILENA(2)=ICHOLX 225 : ILENA(3)=NBGEOR 226 : ILENA(4)=NRIGE 227 : ILENA(5)=IFORIG 228 : ITOTO=5 228 : CALL ECDIFE (IOSAU,ITOTO,ILENA,IFORM) 229 : 230 : ITOTO=2 231 : READ (MTYMAT,FMT='(2A4)') IPV 231 : if (iform.ne.2) CALL ECDIFM (IOSAU,ITOTO,IPV,IFORM) 232 : if (iform.eq.2) then 233 : ios=IXDRSTRING( ixdrw, mtymat(1:8)) 234 : dimatt = dimatt + 2 235 : endif 236 : 237 : NN=NRIGE*NRIGEL+NBGEOR +NRIGEL 238 : SEGINI ITBBE1 239 : NNN=0 240 : DO 1203 IR=1,NRIGEL 241 : DESCR=IRIGEL(3,IR) 242 : SEGACT DESCR 243 : xmatri=irigel(4,ir) 244 : segact xmatri 245 : nelrig=re(/3) 246 : NLIGRP=NOELEP(/1) 247 : NLIGRD=NOELED(/1) 248 : II=NRIGE*(IR-1) 249 : DO 1204 NR=1,NRIGE 250 : IRR=II+NR 251 : ITABE1(IRR)=IRIGEL(NR,IR) 252 : 1204 CONTINUE 253 : ITABE1(II+3)=NLIGRP 254 : itabe1(ii+4)=nelrig 255 : ITABE1(NRIGE*NRIGEL + NBGEOR + IR)=NLIGRD 256 : NNN=NNN+NLIGRP + NLIGRD 257 : SEGDES DESCR 258 : 1203 CONTINUE 259 : IF(NBGEOR.NE.0) THEN 260 : DO 1206 I=1,NBGEOR 261 : IVA=IMGEOR(I) 262 : ITABE1(NRIGE*NRIGEL+I)=IVA 263 : 1206 CONTINUE 264 : SEGDES IMGEOD 265 : ENDIF 265 : 1207 CALL ECDIFE(IOSAU,NN,ITABE1,IFORM) 266 : 267 : NN=NNN 268 : SEGADJ ITBBE1 269 : NM=NNN 270 : SEGINI ITBBM1,itbbc1 271 : J=0 272 : DO 1208 IR=1,NRIGEL 273 : DESCR=IRIGEL(3,IR) 274 : SEGACT DESCR 275 : NLIGRP=NOELEP(/1) 276 : NLIGRD=NOELED(/1) 277 : DO 1205 I=1,NLIGRP 278 : J=J+1 279 : ITABE1(J)=NOELEP(I) 280 : READ (LISINC(I),FMT='(A4)') ITABM1(J) 281 : itabc1(j)=lisinc(i) 282 : 1205 CONTINUE 283 : DO 1209 I=1,NLIGRD 284 : J=J+1 285 : ITABE1(J)=NOELED(I) 286 : READ (LISDUA(I),FMT='(A4)') ITABM1(J ) 287 : itabc1(j)=lisdua(i) 288 : 1209 CONTINUE 289 : SEGDES DESCR 290 : 1208 CONTINUE 290 : CALL ECDIFE(IOSAU,NN,ITABE1,IFORM) 290 : if (iform.ne.2) CALL ECDIFM(IOSAU,NM,ITABM1,IFORM) 291 : if (iform.eq.2) then 292 : ios=IXDRSTRING( ixdrw, itabc1(1)(1:nm*4)) 293 : dimatt = dimatt + nm 294 : endif 295 : SEGSUP ITBBE1,ITBBM1,itbbc1 295 : CALL ECDIFR(IOSAU,NRIGEL,COERIG,IFORM) 296 : do 1210 ir=1,nrigel 297 : xmatri=irigel(4,ir) 298 : segact xmatri 299 : lval=re(/1)*re(/2)*re(/3) 299 : CALL ECDIFR(IOSAU,lval,re,IFORM) 300 : segdes xmatri 301 : 1210 continue 302 : SEGDES MRIGID 303 : 1202 CONTINUE 304 : GOTO 1098 305 : C *************************** ******************************* 306 : 6004 CONTINUE 307 : GOTO 1098 308 : C *********************** ********************************* 309 : 6005 CONTINUE 310 : GOTO 1098 311 : C ********************************BLOQ STRUC 312 : 6006 CONTINUE 313 : DO 60 IEL=IDEB,IMAX1 314 : MCLSTR=ITLAC(IEL) 315 : SEGACT MCLSTR 316 : N=ISOSTR(/1) 317 : ILENA(1)=N 318 : ITOTO=1 318 : CALL ECDIFE (IOSAU,ITOTO,ILENA,IFORM) 318 : CALL ECDIFE (IOSAU,N ,ISOSTR,IFORM) 318 : CALL ECDIFE (IOSAU,N ,IRIGCL,IFORM) 319 : SEGDES MCLSTR 320 : 60 CONTINUE 321 : GO TO 1098 322 : C ********************************ELEM STRUC 323 : 6007 CONTINUE 324 : DO 70 IEL=IDEB,IMAX1 325 : MELSTR=ITLAC(IEL) 326 : SEGACT MELSTR 327 : N=ISOSTU(/1) 328 : ILENA(1)=N 329 : ITOTO=1 329 : CALL ECDIFE (IOSAU,ITOTO,ILENA,IFORM) 329 : CALL ECDIFE (IOSAU,N ,ISOSTU,IFORM) 329 : CALL ECDIFE (IOSAU,N ,IMELEM,IFORM) 330 : SEGDES MELSTR 331 : 70 CONTINUE 332 : GO TO 1098 333 : C ********************MSOLUT************************************* 334 : 6008 CONTINUE 335 : C---- TRAITE PLUS LOIN EN FIN DE SP ------------------------------- 336 : GO TO 1099 337 : C ********************MSTRUC************************************* 338 : 6009 CONTINUE 339 : DO 1900 IEL=IDEB,IMAX1 340 : MSTRUC=ITLAC(IEL) 341 : SEGACT MSTRUC 342 : NS=LISTRU(/1) 343 : ILENA(1)=NS 344 : ITOTO=1 344 : CALL ECDIFE (IOSAU,ITOTO,ILENA,IFORM) 344 : CALL ECDIFE(IOSAU,NS,LISTRU,IFORM) 345 : SEGDES MSTRUC 346 : 1900 CONTINUE 347 : GOTO 1098 348 : C ******************************* MTABLE ************************** 349 : 6010 CONTINUE 350 : NTOTO=6 351 : if(meffac.ne.0) segact meffac 352 : DO 710 IEL=IDEB,IMAX1 353 : MMM=0 354 : MTABLE=ITLAC(IEL) 355 : IF (MTABLE.EQ.0) GO TO 109 356 : SEGACT MTABLE 357 : L6=MLOTAB 358 : L=L6 359 : NN=0 360 : SEGINI ITBBE1 361 : IF (L.EQ.0) GO TO 109 362 : DO 711 K=1,L 363 : ITYPE=MTABTI(K) 364 : JI=0 365 : * IF(ITYPE.EQ.'METHODE ') ITYPE='MOT ' 365 : CALL TYPFIL (ITYPE,JI) 366 : IF(JI.LE.0) GO TO 711 367 : ITYPE=MTABTV(K) 368 : J=0 368 : CALL TYPFIL (ITYPE,J) 369 : IF(J.LE.0) GO TO 711 370 : IVA=MTABII(K) 371 : ITABE1(**)=JI 372 : ITABE1(**)=IVA 373 : IVA=MTABIV(K) 374 : * on remplace les procedures par des entiers valant ?. 375 : if( j.eq.36) then 376 : j = 26 377 : iva= 1 378 : endif 379 : if(j.eq.47) then 380 : itype = tyeffa(iva) 381 : j=0 381 : call typfil(itype,j) 382 : iva= neffac(iva) 383 : endif 384 : ITABE1(**)=J 385 : ITABE1(**)=IVA 386 : 711 CONTINUE 387 : MMM=ITABE1(/1) 388 : 109 ITOTO=1 389 : ILENA(1)=MMM 389 : CALL ECDIFE (IOSAU,ITOTO,ILENA,IFORM) 390 : IF (MTABLE.EQ.0) GO TO 710 390 : CALL ECDIFE (IOSAU,MMM,ITABE1,IFORM) 391 : SEGSUP ITBBE1 392 : 713 SEGDES MTABLE 393 : 710 CONTINUE 394 : GO TO 1098 395 : 715 CONTINUE 396 : MOTERR(1:8)=ITYPE 396 : CALL ERREUR (336) 397 : SEGDES MTABLE 398 : SEGSUP ITBBE1 399 : GO TO 1099 400 : C ***************************** ***************************** 401 : 6011 CONTINUE 402 : GOTO 1098 403 : C *************************MSOSTU******************************* 404 : 6012 CONTINUE 405 : NN=3 406 : SEGINI ITBBE1 407 : DO 2201 IEL=IDEB,IMAX1 408 : MSOSTU=ITLAC(IEL) 409 : IF(MSOSTU.EQ.0) GOTO 2201 410 : SEGACT MSOSTU 411 : NS=ISCHAM(/1) 412 : ITOTO = 1 413 : ILENA(1)=NS 413 : CALL ECDIFE(IOSAU,ITOTO,ILENA,IFORM) 414 : ITOTO=3+NS 415 : NN=ITOTO 416 : SEGADJ ITBBE1 417 : ITABE1(1)=ITYSOU 418 : ITABE1(2)=ISRAID 419 : ITABE1(3)=ISMASS 419 : CALL JDANSI(ITABE1(4),ISCHAM(1),NS) 419 : CALL ECDIFE (IOSAU,ITOTO,ITABE1(1),IFORM) 420 : SEGDES MSOSTU 421 : 2201 CONTINUE 422 : SEGSUP ITBBE1 423 : GOTO 1098 424 : C ***************************** IMATRI ***************************** 425 : 6013 CONTINUE 426 : * DO 2300 IEL=IDEB,IMAX1 427 : * IMATRI=ITLAC(IEL) 428 : * SEGACT IMATRI 429 : * NELRIG=IMATTT(/1) 430 : * ILENA(1)=NELRIG 431 : * ITOTO=1 431 : * CALL ECDIFE (IOSAU,ITOTO,ILENA,IFORM) 432 : * NN=2 433 : * SEGINI ITBBE1 434 : C DO 2301 J=1,NELRIG 435 : * IF (NELRIG.NE.0) THEN 436 : * XMATRI=IMATTT(1) 437 : * SEGACT XMATRI 438 : * ITABE1(1)=RE(/1) 439 : * ITABE1(2)=RE(/2) 440 : * LVAL=RE(/1)*RE(/2) 441 : * SEGDES XMATRI 442 : * ELSE 443 : * ITABE1(1)=0 444 : * ITABE1(2)=0 445 : * ENDIF 446 : C 2301 CONTINUE 446 : * CALL ECDIFE(IOSAU,NN,ITABE1,IFORM) 447 : * SEGSUP ITBBE1 448 : * DO 2303 J=1,NELRIG 449 : * XMATRI=IMATTT(J) 450 : * SEGACT XMATRI 451 : C LVAL=RE(/1)*RE(/2) 451 : * CALL ECDIFR(IOSAU,LVAL,RE,IFORM) 452 : * SEGDES XMATRI 453 : * 2303 CONTINUE 454 : * SEGDES IMATRI 455 : * 2300 CONTINUE 456 : GOTO 1098 457 : C ***************************** MJONCT ***************************** 458 : 6014 CONTINUE 458 : CALL WRJONC (IOSAU,ITLACC,IMAX1,IFORM,IDEB) 459 : GO TO 1098 460 : C ***************************** MATTAC ***************************** 461 : 6015 CONTINUE 461 : CALL WRATTA (IOSAU,ITLACC,IMAX1,IRETOU,IFORM,IDEB) 462 : GOTO 1098 463 : C ***************************** MMATRI ***************************** 464 : 6016 CONTINUE 464 : CALL WRMMAT (IOSAU,ITLACC,IMAX1,IFORM,IDEB) 465 : GOTO 1098 466 : C *********************MDEFOR*********************************** 467 : 6017 CONTINUE 468 : DO 2700 IEL=IDEB,IMAX1 469 : MDEFOR=ITLAC(IEL) 470 : SEGACT MDEFOR 471 : NDEF=IELDEF(/1) 472 : ILENA(1)= NDEF 473 : ITOTO = 1 473 : CALL ECDIFE(IOSAU,ITOTO,ILENA,IFORM) 473 : CALL ECDIFR(IOSAU,NDEF,AMPL,IFORM) 474 : NN=7*NDEF 475 : SEGINI ITBBE1 475 : CALL JDANSI (ITABE1(1), IELDEF(1),NDEF) 475 : CALL JDANSI (ITABE1(NDEF+1), ICHDEF(1),NDEF) 475 : CALL JDANSI (ITABE1(2*NDEF+1),JCOUL(1),NDEF) 475 : CALL JDANSI (ITABE1(3*NDEF+1),MTVECT(1),NDEF) 475 : CALL JDANSI (ITABE1(4*NDEF+1),MDCHP(1),NDEF) 475 : CALL JDANSI (ITABE1(5*NDEF+1),MDCHEL(1),NDEF) 475 : CALL JDANSI (ITABE1(6*NDEF+1),MDMODE(1),NDEF) 475 : CALL ECDIFE (IOSAU,NN,ITABE1,IFORM) 476 : SEGSUP ITBBE1 477 : C 478 : SEGDES MDEFOR 479 : 2700 CONTINUE 480 : GOTO 1098 481 : C ***************************MLREEL****************************** 482 : 6018 CONTINUE 483 : DO 2800 IEL=IDEB,IMAX1 484 : MLREEL=ITLAC(IEL) 485 : SEGACT MLREEL 486 : L=PROG(/1) 487 : ILENA(1)=L 488 : ITOTO=1 488 : CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM) 488 : CALL ECDIFR(IOSAU,L,PROG,IFORM) 489 : SEGDES MLREEL 490 : 2800 CONTINUE 491 : GOTO 1098 492 : C *****************************MLENTI*************************** 493 : 6019 CONTINUE 494 : DO 2900 IEL=IDEB,IMAX1 495 : MLENTI=ITLAC(IEL) 496 : SEGACT MLENTI 497 : L=LECT(/1) 498 : ILENA(1)=L 499 : ITOTO=1 499 : CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM) 499 : CALL ECDIEE(IOSAU,L,LECT,IFORM) 500 : SEGDES MLENTI 501 : 2900 CONTINUE 502 : GOTO 1098 503 : C ****************************MCHARG***************************** 504 : 6020 CONTINUE 505 : NN=0 506 : NM=0 507 : NM2=0 508 : SEGINI ITBBM1,itbbc1 509 : SEGINI ITBBM2,itbbc3 510 : SEGINI ITBBM3,itbbc4 511 : SEGINI ITBBM4,itbbc5 512 : SEGINI ITBBE1 513 : SEGINI ITBBE2,itbbc2 514 : DO 3000 IEL=IDEB,IMAX1 515 : IF(IONIVE.LE.6) THEN 516 : MCHARG=ITLAC(IEL) 517 : SEGACT MCHARG 518 : N=KCHARG(/1) 519 : ILENA(1)=N 520 : ITOTO=1 520 : CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM) 521 : NM=2*N 522 : SEGADJ ITBBM1,itbbc1 523 : NN=3*N 524 : SEGADJ ITBBE1 525 : DO 3001 I=1,N 526 : ICHARG=KCHARG(I) 527 : SEGACT ICHARG 528 : IF(CHATYP.NE.'CHPOINT ') THEN 529 : 530 : *---- cas du nouveau chargement . Incompatible avec niveau 6 ---- 531 : 531 : CALL ERREUR(691) 532 : GOTO 1099 533 : ENDIF 534 : I2=2*I 535 : I3=3*I 536 : READ (CHANAT(I),FMT='(2A4)') ITABM1(I2-1),ITABM1(I2) 537 : itabc1(i2-1)=chanat(i)(1:4) 538 : itabc1(i2)=chanat(i)(5:8) 539 : ITABE1(I3-2)=ICHPO1 540 : ITABE1(I3-1)=ICHPO2 541 : ITABE1(I3 )=ICHPO3 542 : SEGDES ICHARG 543 : 3001 CONTINUE 543 : if (iform.ne.2) CALL ECDIFM(IOSAU,NM,ITABM1,IFORM) 544 : if (iform.eq.2) then 545 : ios=IXDRSTRING( ixdrw, itabc1(1)(1:nm*4)) 546 : dimatt = dimatt + nm 547 : endif 547 : CALL ECDIFE(IOSAU,NN,ITABE1,IFORM) 548 : SEGDES MCHARG 549 : ELSE IF(IONIVE.GE.7.AND.IONIVE.LE.10) THEN 550 : MCHARG=ITLAC(IEL) 551 : SEGACT MCHARG 552 : N=KCHARG(/1) 553 : ILENA(1)=N 554 : ITOTO=1 554 : CALL ECDIFE(IOSAU,ITOTO,ILENA,IFORM) 554 : c CALL ECDIFM(IOSAU,NM,CHANAT,IFORM) 554 : c CALL ECDIFM(IOSAU,N ,CHANOM,IFORM) 555 : NN=2*N 556 : SEGADJ ITBBE2,itbbc2 557 : NM=2*N 558 : SEGADJ ITBBM1,itbbc1 559 : NM2=N 560 : SEGADJ ITBBM2,itbbc3 561 : NN=3*N 562 : SEGADJ ITBBE1 563 : DO 3002 I=1,N 564 : ICHARG=KCHARG(I) 565 : SEGACT ICHARG 566 : I2=2*I 567 : I3=3*I 568 : READ (CHATYP,FMT='(2A4)') ITABM1(I2-1),ITABM1(I2) 569 : itabc1(i2-1)=chatyp(1:4) 570 : itabc1(i2)=chatyp(5:8) 571 : READ (CHANAT(I),FMT='(2A4)') ITABE2(I2-1),ITABE2(I2) 572 : itabc2(i2-1)=chanat(i)(1:4) 573 : itabc2(i2)=chanat(i)(5:8) 574 : READ (CHANOM(I),FMT='(1A4)') ITABM2(I) 575 : itabc3(i)=chanom(i) 576 : ITABE1(I3-2)=ICHPO1 577 : ITABE1(I3-1)=ICHPO2 578 : ITABE1(I3)=ICHPO3 579 : SEGDES ICHARG 580 : 3002 CONTINUE 580 : if (iform.ne.2) CALL ECDIFM(IOSAU,2*N,ITABE2,IFORM) 581 : if (iform.eq.2)ios=IXDRSTRING( ixdrw, itabc2(1)(1:4*2*n)) 581 : if (iform.ne.2) CALL ECDIFM(IOSAU,N,ITABM2,IFORM) 582 : if (iform.eq.2) ios=IXDRSTRING( ixdrw, itabc3(1)(1:4*n)) 582 : if (iform.ne.2) CALL ECDIFM(IOSAU,NM,ITABM1,IFORM) 583 : if (iform.eq.2) ios=IXDRSTRING( ixdrw, itabc1(1)(1:4*nm)) 584 : dimatt = dimatt + (3*n) +nm 584 : CALL ECDIFE(IOSAU,NN,ITABE1,IFORM) 585 : SEGDES MCHARG 586 : ELSE 587 : MCHARG=ITLAC(IEL) 588 : SEGACT MCHARG 589 : N=KCHARG(/1) 590 : ILENA(1)=N 591 : ITOTO=1 591 : CALL ECDIFE(IOSAU,ITOTO,ILENA,IFORM) 592 : NN=2*N 593 : SEGADJ ITBBE2,itbbc2 594 : NM=2*N 595 : SEGADJ ITBBM1,itbbc1 596 : NM2=N 597 : SEGADJ ITBBM2,itbbc3 598 : SEGADJ ITBBM3,itbbc4 599 : SEGADJ ITBBM4,itbbc5 600 : NN=7*N 601 : SEGADJ ITBBE1 602 : DO 3003 I=1,N 603 : ICHARG=KCHARG(I) 604 : SEGACT ICHARG 605 : I2=2*I 606 : I3=7*I 607 : READ (CHATYP,FMT='(2A4)') ITABM1(I2-1),ITABM1(I2) 608 : itabc1(i2-1)=chatyp(1:4) 609 : itabc1(i2)=chatyp(5:8) 610 : READ (CHANAT(I),FMT='(2A4)') ITABE2(I2-1),ITABE2(I2) 611 : itabc2(i2-1)=chanat(i)(1:4) 612 : itabc2(i2)=chanat(i)(5:8) 613 : READ (CHANOM(I),FMT='(1A4)') ITABM2(I) 614 : itabc3(i)=chanom(i) 615 : READ (CHAMOB(I),FMT='(1A4)') ITABM3(I) 616 : itabc4(i)=chamob(i) 617 : READ (CHALIE(I),FMT='(1A4)') ITABM4(I) 618 : itabc5(i)=chalie(i) 619 : ITABE1(I3-6)=ICHPO1 620 : ITABE1(I3-5)=ICHPO2 621 : ITABE1(I3-4)=ICHPO3 622 : ITABE1(I3-3)=ICHPO4 623 : ITABE1(I3-2)=ICHPO5 624 : ITABE1(I3-1)=ICHPO6 625 : ITABE1(I3) =ICHPO7 626 : SEGDES ICHARG 627 : 3003 CONTINUE 627 : if (iform.ne.2) CALL ECDIFM(IOSAU,2*N,ITABE2,IFORM) 628 : if (iform.eq.2)ios=IXDRSTRING( ixdrw, itabc2(1)(1:4*2*n)) 628 : if (iform.ne.2) CALL ECDIFM(IOSAU,N,ITABM2,IFORM) 629 : if (iform.eq.2) ios=IXDRSTRING( ixdrw,itabc3(1)(1:4*n)) 629 : if (iform.ne.2) CALL ECDIFM(IOSAU,N,ITABM3,IFORM) 630 : if (iform.eq.2) ios=IXDRSTRING( ixdrw,itabc4(1)(1:4*n)) 630 : if (iform.ne.2) CALL ECDIFM(IOSAU,N,ITABM4,IFORM) 631 : if (iform.eq.2) ios=IXDRSTRING( ixdrw,itabc5(1)(1:4*n)) 631 : if (iform.ne.2) CALL ECDIFM(IOSAU,NM,ITABM1,IFORM) 632 : if (iform.eq.2) ios=IXDRSTRING( ixdrw,itabc1(1)(1:4*nm)) 633 : dimatt = dimatt + (5*n) +nm 633 : CALL ECDIFE(IOSAU,NN,ITABE1,IFORM) 634 : SEGDES MCHARG 635 : ENDIF 636 : 3000 CONTINUE 637 : SEGSUP ITBBE1,ITBBM1,itbbc1,ITBBE2,itbbc2,ITBBM2,itbbc3, 638 : > ITBBM3,itbbc4,ITBBM4,itbbc5 639 : 640 : GOTO 1098 641 : C **************************** ************************** 642 : 6021 CONTINUE 643 : GOTO 1098 644 : C *****************************MEVOLL*************************** 645 : 6022 CONTINUE 646 : NN=0 647 : NM=0 648 : NM2=20 649 : SEGINI ITBBM2,itbbc3 650 : SEGINI ITBBE2,itbbc2 651 : SEGINI ITBBE1,ITBBM1,itbbc1 652 : LDECA=7 653 : IF(IONIVE.GE.3) LDECA=11 654 : LDECA2=18 655 : DO 3200 IEL=IDEB,IMAX1 656 : MEVOLL=ITLAC(IEL) 657 : SEGACT MEVOLL 658 : N=IEVOLL(/1) 659 : ILENA(1)=N 660 : ITOTO=1 661 : NM2=20 662 : SEGADJ ITBBM2,itbbc3 662 : CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM) 663 : READ (ITYEVO,FMT='(2A4)') ITABM2(1),ITABM2(2) 664 : itabc3(1)=ityevo(1:4) 665 : itabc3(2)=ityevo(5:8) 666 : READ (IEVTEX,FMT='(18A4)') (ITABM2(2+JPV),JPV=1,18) 667 : do jpv=1,18 668 : itabc3(2+jpv)=ievtex(1+(jpv-1)*4:jpv*4) 669 : enddo 669 : if (iform.ne.2) CALL ECDIFM (IOSAU,NM2,ITABM2,IFORM) 670 : if (iform.eq.2) then 671 : ios=IXDRSTRING( ixdrw,itabc3(1)(1:4*nm2)) 672 : dimatt = dimatt + nm2 673 : endif 674 : NN=3*N 675 : SEGADJ ITBBE1 676 : NM=LDECA*N 677 : SEGADJ ITBBM1,itbbc1 678 : NM2=LDECA2*N 679 : SEGADJ ITBBM2,itbbc3 680 : C LOOP SUR LES KEVOL- 681 : DO 3201 IN=1,N 682 : KEVOLL=IEVOLL(IN) 683 : SEGACT KEVOLL 684 : I4=3*IN 685 : ITABE1(I4-2)= IPROGX 686 : ITABE1(I4-1)= IPROGY 687 : ITABE1(I4)= NUMEVX 688 : I7=LDECA*(IN-1) 689 : I8=LDECA2*(IN-1) 690 : READ (NOMEVX,FMT='(3A4)') (ITABM1(I7+I),I=1,3) 691 : itabc1(i7+1)=nomevx(1:4) 692 : itabc1(i7+2)=nomevx(5:8) 693 : itabc1(i7+3)=nomevx(9:12) 694 : READ (NOMEVY,FMT='(3A4)') (ITABM1(I7+I+3),I=1,3) 695 : itabc1(i7+3+1)=nomevy(1:4) 696 : itabc1(i7+3+2)=nomevy(5:8) 697 : itabc1(i7+3+3)=nomevy(9:12) 698 : READ (NUMEVY,FMT='(A4)') ITABM1(I7 +7) 699 : itabc1(i7+7)=numevy 700 : IF(IONIVE.GE.3) THEN 701 : READ (TYPX,FMT='(2A4)') (ITABM1(I7+7+I),I=1,2) 702 : itabc1(i7+7+1)=typx(1:4) 703 : itabc1(i7+7+2)=typx(5:8) 704 : READ (TYPY,FMT='(2A4)') (ITABM1(I7+9+I),I=1,2) 705 : itabc1(i7+9+1)=typy(1:4) 706 : itabc1(i7+9+2)=typy(5:8) 707 : READ(KEVTEX,FMT='(18A4)')(ITABM2(I8+JPV),JPV=1,18) 708 : do jpv=1,18 709 : itabc3(i8+jpv)=kevtex(1+(jpv-1)*4:4*jpv) 710 : enddo 711 : ENDIF 712 : SEGDES KEVOLL 713 : 3201 CONTINUE 714 : SEGDES MEVOLL 715 : NN=3*N 715 : CALL ECDIFE(IOSAU,NN,ITABE1,IFORM) 716 : NN=LDECA*N 716 : if (iform.ne.2) CALL ECDIFM(IOSAU,NN,ITABM1,IFORM) 717 : if (iform.eq.2) then 718 : ios=IXDRSTRING( ixdrw,itabc1(1)(1:4*nn)) 719 : dimatt = dimatt + nn 720 : endif 721 : IF(IONIVE.GE.3) then 721 : if (iform.ne.2) CALL ECDIFM (IOSAU,NM2,ITABM2,IFORM) 722 : if (iform.eq.2) then 723 : ios=IXDRSTRING( ixdrw,itabc3(1)(1:4*nm2)) 724 : dimatt = dimatt + nm2 725 : endif 726 : endif 727 : 3200 CONTINUE 728 : SEGSUP ITBBM2,itbbc3 729 : SEGSUP ITBBE2,itbbc2 730 : SEGSUP ITBBE1,ITBBM1,itbbc1 731 : GOTO 1098 732 : C **********************SUPERELE************************************ 733 : 6023 CONTINUE 734 : NTOTO=6 735 : ITOTO=1 736 : DO 230 IEL=IDEB,IMAX1 737 : MSUPER=ITLAC(IEL) 738 : SEGACT MSUPER 739 : ILENA(1)=NTOTO 739 : CALL ECDIFE (IOSAU,ITOTO,ILENA,IFORM) 740 : ILENA(1)=MRIGTO 741 : ILENA(2)=MSUPEL 742 : ILENA(3)=MSURAI 743 : ILENA(4)=MBLOQU 744 : ILENA(5)=MSUMAS 745 : C *** On ecrit MCROUT pour memoire mais il ne sera pas sauve (MMATRI) 746 : ILENA(6)=MCROUT 746 : CALL ECDIFE (IOSAU,NTOTO,ILENA,IFORM) 747 : SEGDES MSUPER 748 : 230 CONTINUE 749 : GOTO 1098 750 : C ************************* LOGIQUE *************************** 751 : 6024 CONTINUE 752 : ITOTO=1 753 : IVLON=IMAX1-IDEB+1 754 : ILENA(1)=IVLON 754 : CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM) 755 : NN=IVLON 756 : SEGINI ITBBE1 757 : DO 240 I=1,IVLON 758 : IVA=ITLAC(I+IDEB-1) 758 : CALL QUEVAL(IVA,'LOGIQUE ',IRETP,IVALIN,XRA,CHA1,LIRA,IOBVA) 759 : IF(LIRA)ITOTO=1 760 : IF(.NOT.LIRA)ITOTO=0 761 : ITABE1(I)=ITOTO 762 : 240 CONTINUE 762 : CALL ECDIFE( IOSAU,IVLON,ITABE1(1),IFORM) 763 : SEGSUP ITBBE1 764 : GO TO 1098 765 : C ************************* FLOTTANT *************************** 766 : 6025 CONTINUE 767 : ITOTO=1 768 : IVLON=IMAX1-IDEB+1 769 : ILENA(1)=IVLON 770 : L=IVLON 771 : SEGINI ITABR1 771 : CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM) 772 : DO 250 I=1,IVLON 773 : IVA=ITLAC(I+IDEB-1) 773 : CALL QUEVAL(IVA,'FLOTTANT',IRETP,IVALIN,XRA,CHA1,LIRA,IOBVA) 774 : TABR1(I)=XRA 775 : 250 CONTINUE 775 : CALL ECDIFR(IOSAU,IVLON,TABR1,IFORM) 776 : SEGSUP ITABR1 777 : GOTO 1098 778 : C **************************** ENTIER*************************** 779 : 6026 CONTINUE 780 : IVLON=IMAX1-IDEB+1 781 : ILENA(1)=IVLON 782 : ITOTO=1 782 : CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM) 783 : NN=IVLON 784 : SEGINI ITBBE1 785 : DO 260 I=1,IVLON 786 : IVA=ITLAC(I+IDEB-1) 786 : CALL QUEVAL(IVA,'ENTIER ',IRETP,IVALIN,XRA,CHA1,LIRA,IOBVA) 787 : ITABE1(I)=IVALIN 788 : 260 CONTINUE 788 : CALL ECDIEE( IOSAU,IVLON,ITABE1(1),IFORM) 789 : GOTO 1098 790 : C **************************** MOT *************************** 791 : 6027 CONTINUE 792 : NN=0 793 : NNN=0 794 : SEGINI ITAMOT 795 : IVLON=IMAX1-IDEB+1 796 : DO 270 I=1,IVLON 797 : IVA=ITLAC(I+IDEB-1) 798 : C CHA1 EST UNE CHAINE DE 512 CARACTERES 798 : CALL QUEVAL(IVA,'MOT ',IRETP,IVALIN,XRA,CHA1,LIRA,IOBVA) 799 : NN1=NN 800 : NN=NN+IVALIN 801 : NNN=NNN+1 802 : SEGADJ ITAMOT 803 : ICOTA(NNN)=NN 804 : ITAMO(1+NN1:IVALIN+NN1)=CHA1(1:IVALIN) 805 : 270 CONTINUE 806 : ILENA(1)=NN 807 : ITOTO=2 808 : ILENA(2)=IVLON 808 : CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM) 808 : CALL ECDIFC( IOSAU,ITAMO,IFORM) 808 : CALL ECDIFE( IOSAU,IVLON,ICOTA,IFORM) 809 : SEGSUP ITAMOT 810 : GOTO 1098 811 : C ****************************TEXTE ************************* 812 : 6028 CONTINUE 813 : DO 2928 IEL=IDEB,IMAX1 814 : MTEXTE=ITLAC(IEL) 815 : SEGACT MTEXTE 816 : CCCC L =(NCART+3)/4 817 : L=NCART 818 : ITOTO=1 819 : ILENA(1)=L 819 : CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM) 819 : CALL ECDIFC( IOSAU,MTEXT,IFORM) 820 : SEGDES MTEXTE 821 : 2928 CONTINUE 822 : GO TO 1098 823 : C ****************************LISTMOTS ************************* 824 : 6029 CONTINUE 825 : DO 2929 IEL=IDEB,IMAX1 826 : MLMOTS=ITLAC(IEL) 827 : SEGACT MLMOTS 828 : ILENA(1)=MOTS(/1) 829 : ILENA(2)=MOTS(/2) 830 : ITOTO=2 830 : CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM) 831 : NNA=ILENA(1) 832 : NNN = 0 833 : NN = ILENA(1)*ILENA(2) 834 : SEGINI ITAMOT 835 : DO 2930 IMM=1,ILENA(2) 836 : ITAMO((IMM-1)*NNA+1:IMM*NNA)=MOTS(IMM) 837 : 2930 CONTINUE 837 : CALL ECDIFC( IOSAU,ITAMO,IFORM) 838 : SEGDES MLMOTS 839 : SEGSUP ITAMOT 840 : 2929 CONTINUE 841 : GOTO 1098 842 : C **************************** VECTEUR************************** 843 : 6030 CONTINUE 844 : DO 300 IEL=IDEB,IMAX1 845 : MVECTE =ITLAC(IEL) 845 : CALL WRVECT (MVECTE,IOSAU,IRETOU,IFORM) 846 : 300 CONTINUE 847 : GO TO 1098 848 : C ************************* VECTD *************************** 849 : 6031 CONTINUE 850 : DO 310 IEL=IDEB,IMAX1 851 : MVECTD=ITLAC(IEL) 852 : SEGACT MVECTD 853 : INC=VECTBB(/1) 854 : ILENA(1)=INC 855 : ITOTO=1 855 : CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM) 855 : CALL ECDIFR(IOSAU,INC,VECTBB,IFORM) 856 : SEGDES MVECTD 857 : 310 CONTINUE 858 : GOTO 1098 859 : C ************************* POINT *************************** 860 : 6032 CONTINUE 861 : * on sauve tout le itlac car numerotation a pu changer 862 : ILENA(1)=IMAX1 863 : ITOTO=1 863 : CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM) 863 : CALL ECDIFE( IOSAU,IMAX1,ITLAC,IFORM) 864 : GO TO 1098 865 : C ************************* CONFIG *************************** 866 : 6033 CONTINUE 866 : CALL WRCONF(IOSAU,ITLACC,IMAX1,IFORM,IDEB,IDIM,MCOORD) 867 : GO TO 1098 868 : C ******************* MLCHPO ************************************ 869 : 6034 CONTINUE 870 : DO 340 IEL=IDEB,IMAX1 871 : MLCHPO=ITLAC(IEL) 872 : SEGACT MLCHPO 873 : N1=ICHPOI(/1) 874 : ILENA(1)=N1 875 : ITOTO=1 875 : CALL ECDIFE (IOSAU,ITOTO,ILENA,IFORM) 875 : CALL ECDIFE(IOSAU,N1,ICHPOI,IFORM) 876 : SEGDES MLCHPO 877 : 340 CONTINUE 878 : GOTO 1098 879 : C ****************************MBASEM***************************** 880 : 6035 CONTINUE 881 : NN=0 882 : DO 3500 IEL=IDEB,IMAX1 883 : MBASEM=ITLAC(IEL) 884 : SEGACT MBASEM 885 : N=LISBAS(/1) 886 : ILENA(1)=N 887 : ITOTO=1 887 : CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM) 888 : ITOTO=1 889 : DO 3501 I=1,N 890 : MSOBAS=LISBAS(I) 891 : SEGACT MSOBAS 892 : NIBST=IBSTRM(/1) 893 : ILENA(1)=NIBST 893 : CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM) 893 : CALL ECDIFE(IOSAU,NIBST,IBSTRM(1),IFORM) 894 : SEGDES MSOBAS 895 : 3501 CONTINUE 896 : SEGDES MBASEM 897 : 3500 CONTINUE 898 : GOTO 1098 899 : C **********************PROCEDUR************************************ 900 : 6036 CONTINUE 901 : GOTO 1098 902 : C **********************BLOC**************************************** 903 : 6037 CONTINUE 904 : GOTO 1098 905 : C *********************** MODELE MMODEL **************************** 906 : 6038 CONTINUE 906 : CALL WRMODL(IOSAU,ITLACC,IMAX1,IFORM,IONIVE,IDEB) 907 : GOTO 1098 908 : C *********************** MCHAML *********************************** 909 : 6039 CONTINUE 909 : CALL WRCHAM(IOSAU,ITLACC,IMAX1,IFORM,IONIVE,IDEB) 910 : GOTO 1098 911 : C ************************** MINTE ******************************* 912 : 6040 CONTINUE 913 : DO 2840 IEL=IDEB,IMAX1 914 : MINTE=ITLAC(IEL) 915 : SEGACT MINTE 916 : NBNO =SHPTOT(/2) 917 : NBPGAU=SHPTOT(/3) 918 : L=NBPGAU*4+6*NBPGAU*NBNO 919 : ILENA(1)= NBNO 920 : ILENA(2)= NBPGAU 921 : ITOTO=2 921 : CALL ECDIFE(IOSAU,ITOTO,ILENA,IFORM) 922 : SEGINI ITABR1 923 : I=0 924 : DO 2841 IC=1,NBPGAU 925 : I=I+1 926 : TABR1(I)=POIGAU(IC) 927 : I=I+1 928 : TABR1(I)=QSIGAU(IC) 929 : I=I+1 930 : TABR1(I)=ETAGAU(IC) 931 : I=I+1 932 : TABR1(I)=DZEGAU(IC) 933 : DO 2842 IB=1,NBNO 934 : DO 2843 IA=1,6 935 : I=I+1 936 : TABR1(I)=SHPTOT(IA,IB,IC) 937 : 2843 CONTINUE 938 : 2842 CONTINUE 939 : 2841 CONTINUE 939 : CALL ECDIFR (IOSAU,L,TABR1,IFORM) 940 : SEGSUP ITABR1 941 : SEGDES MINTE 942 : 2840 CONTINUE 943 : GOTO 1098 944 : C *********************** NUAGE *************************** 945 : 6041 CONTINUE 945 : CALL WRNUAG(IOSAU,ITLACC,IMAX1,IFORM,IDEB) 946 : GOTO 1098 947 : C ********************** MATRAK ********************************* 948 : 6042 CONTINUE 948 : CALL WRMTAK (IOSAU,ITLACC,IMAX1,IFORM,IDEB) 949 : GOTO 1098 950 : C ********************** MATRIK ********************************* 951 : 6043 CONTINUE 951 : CALL WRMTIK(IOSAU,ITLACC,IMAX1,IFORM,IDEB) 952 : GOTO 1098 953 : C *****************************METHODE ********************* 954 : 6045 CONTINUE 955 : IVLON=IMAX1-IDEB+1 956 : C APPELE PAR WRPI 957 : ILENA(1)=IVLON 958 : ITOTO=1 958 : CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM) 958 : CALL ECDIFE(IOSAU,IVLON,ITLAC(IDEB),IFORM) 959 : GO TO 1098 960 : C **************************************************************** 961 : 962 : 1098 CONTINUE 963 : 1099 CONTINUE 964 : C 965 : C **********************MSOLUT: TRAITE EN DERNIER***************** 966 : C 967 : IFILE=8 968 : ITLACC=KCOLA(IFILE) 969 : IMAX1=ITLAC(/1) 970 : IDEB=1 971 : IF(IPSAUV.NE.0) IDEB=KCOLAC(IFILE)+1 972 : IF(IMAX1.LT.IDEB) GOTO 2099 973 : ITYPE=' ' 973 : CALL TYPFIL(ITYPE,IFILE) 974 : WRITE(IOIMP,801)IFILE,IMAX1,ITYPE 975 : IP1=ICOLA(IFILE) 976 : ITLACC=KCOLA(IFILE) 977 : C 977 : CALL NOMMEF(IP1,IMAX1,IFILE,IFORM,IDEB,isilen) 978 : DO 1800 IEL=IDEB,IMAX1 979 : MSOLUT=ITLAC(IEL) 979 : C* IF (IONIVE.LE.2) CALL SOSOLF(ICOLAC,MSOLUT,IFORM) 979 : IF (IONIVE.GE.3) CALL WRSOLU(MSOLUT,IRETOU,IFORM) 980 : 1800 CONTINUE 981 : C ***************************************************************** 982 : 2099 CONTINUE 983 : C 984 : IQUOI=5 984 : CALL ECDES (IOSAU,IQUOI,IFORM) 985 : IF(IFORM.EQ.1)WRITE (IOSAU,772)LABEL 986 : IF(IFORM.EQ.0)WRITE (IOSAU)LABEL 987 : if (iform.eq.2) then 988 : ios=IXDRSTRING( ixdrw, label(1:72)) 989 : dimatt = dimatt + 18 990 : else 991 : * sur certaines machines, la fermeture du fichier pouvait poser 992 : * probleme (buffer non ecrit avant de sortir de castem) 992 : CALL FLUSH(IOSAU) 993 : endif 994 : MOTERR=LABEL 994 : Call erreur(-345) 995 : 772 FORMAT(A72) 996 : SEGDES ICOLAC 997 : RETURN 998 : END 999 : 1000 : 1001 : 1002 : 1003 : 1004 : 1005 : 1006 :
© Cast3M 2003 - All rights reserved.
Disclaimer