1 : C RESTPI SOURCE AM 13/07/17 21:15:00 7797 2 : SUBROUTINE RESTPI (ICOLAC) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C======================================================================= 6 : C RESTAURATION DES POINTEURS 7 : C 8 : C PROGRAMME PAR FARVACQUE 9 : C APPELE PAR SAUV 10 : C APPELLE : ERREUR 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 LE SOUS-PROGRAMME TYPFIL 17 : C======================================================================= 18 : -INC CCNOYAU 19 : -INC CCOPTIO 20 : -INC CCASSIS 21 : 22 : CINC SMELEME 23 : -INC SMBASEM 24 : CINC SMCHPOI 25 : CINC SMRIGID 26 : -INC SMMATRI 27 : -INC SMELSTR 28 : -INC SMCLSTR 29 : -INC SMSTRUC 30 : -INC SMATTAC 31 : -INC SMSOLUT 32 : -INC SMLENTI 33 : -INC SMLREEL 34 : -INC SMDEFOR 35 : -INC SMCHARG 36 : -INC SMEVOLL 37 : -INC SMTABLE 38 : -INC SMSUPER 39 : -INC SMVECTE 40 : -INC SMLCHPO 41 : -INC SMINTE 42 : CINC SMNUAGE 43 : -INC TMCOLAC 44 : 45 : CHARACTER*(8) ITYPE 46 : SEGACT ICOLAC 47 : NITLAC=ICOLA(/1) 48 : C 49 : C****** BOUCLE SUR LES FILES DE SORTIE IFILE=1,NITLAC****************** 50 : C 51 : DO 1099 IFILE=1,NITLAC 52 : ITLACC=KCOLA(IFILE) 53 : IMAX1=ITLAC(/1) 54 : IDEB=KCOLAC(IFILE)+1 55 : IF(IMAX1.EQ.0.OR.IDEB.GT.IMAX1) GO TO 1099 56 : C ITLACC=KCOLA(IFILE) 57 : GO TO (6001,6002,6003,1099,1099,6006,6007,6008, 509,510,1099 58 : 1 ,512,6013,6014,6015,6016,6017,6018,6019,6020,1099,6022 59 : 1 ,6023,6024,6025,6026,6027,6028,6029,6030,6031,6032,6033 60 : 1 ,534 ,6035,1098,1098,6038,6039,6040,6041,6042 61 : 1 ,6043,510,1099 ),IFILE 62 : C ---- 63 : 1001 ITYPE=' ' 63 : CALL TYPFIL (ITYPE,IFILE) 64 : MOTERR(1:8)=ITYPE 64 : CALL ERREUR (336) 65 : GO TO 1099 66 : C ****************************** MELEME **************************** 67 : 6001 CONTINUE 67 : CALL RESTME (ITLACC,IMAX1,ICOLAC,IDEB) 68 : GOTO 1098 69 : C **************************CHPOINT********************************* 70 : 6002 CONTINUE 70 : CALL RESTCH (ICOLAC,ITLACC,IMAX1,IDEB) 71 : GOTO 1098 72 : C ***********************MRIGID************************************* 73 : 6003 CONTINUE 73 : CALL RESTRI (ICOLAC,ITLACC,IMAX1,IDEB) 74 : GOTO 1098 75 : C *************************** ******************************* 76 : 6004 CONTINUE 77 : GOTO 1098 78 : C *************************** ******************************* 79 : 6005 CONTINUE 80 : GOTO 1098 81 : C **************************** MCLSTR ****************************** 82 : 6006 CONTINUE 83 : ITLAC1=KCOLA(12) 84 : ITLAC3=KCOLA(3) 85 : DO 614 IEL=IDEB,IMAX1 86 : MCLSTR=ITLAC(IEL) 87 : IF (MCLSTR.EQ.0) GO TO 614 88 : SEGACT MCLSTR*MOD 89 : N=ISOSTR(/1) 90 : DO 615 I=1,N 91 : IVA=ISOSTR(I) 92 : IF (IVA.NE.0)ISOSTR(I)=ITLAC1.ITLAC(IVA) 93 : IVA=IRIGCL(I) 94 : IF (IVA.NE.0)IRIGCL(I)=ITLAC3.ITLAC(I) 95 : 615 CONTINUE 96 : SEGDES MCLSTR 97 : 614 CONTINUE 98 : GO TO 1098 99 : C **************************** MELSTR ****************************** 100 : 6007 CONTINUE 101 : ITLAC2=KCOLA(12) 102 : ITLAC1=KCOLA(1) 103 : DO 616 IEL=IDEB,IMAX1 104 : MELSTR=ITLAC(IEL) 105 : IF (MELSTR.EQ.0) GO TO 616 106 : SEGACT MELSTR*MOD 107 : N=ISOSTU(/1) 108 : DO 617 I=1,N 109 : IVA=ISOSTU(I) 110 : IF(IVA.NE.0)ISOSTU(I)=ITLAC2.ITLAC(I) 111 : IVA=IMELEM(I) 112 : IF(IVA.NE.0)IMELEM(I)=ITLAC1.ITLAC(IVA) 113 : 617 CONTINUE 114 : SEGDES MELSTR 115 : 616 CONTINUE 116 : GO TO 1098 117 : C ****************************MSOLUT******************************** 118 : 6008 CONTINUE 119 : DO 1800 IEL=IDEB,IMAX1 120 : MSOLUT=ITLAC(IEL) 121 : IF (MSOLUT.EQ.0) GO TO 1800 122 : SEGACT MSOLUT*MOD 123 : IF (IONIVE.GE.3) GO TO 818 124 : C ANCIEN NIVEAU------------------ 125 : IF(MSOLIS(3).LE.0) GOTO 1802 126 : ITLAC1=KCOLA(1) 127 : IVA=MSOLIS(3) 128 : IF (IVA.NE.0) MSOLIS(3)=ITLAC1.ITLAC(IVA) 129 : GOTO 1803 130 : 1802 CONTINUE 131 : MSOLIS(3)=-MSOLIS(3) 132 : 1803 CONTINUE 133 : GO TO 817 134 : C FIN ANCIEN NIVEAU------------------ 135 : 818 NIPO=MSOLIS(/1) 136 : DO 620 II=1,NIPO 137 : IF(MSOLIS(II).EQ.0) GOTO 620 138 : IF(II.EQ.3) THEN 139 : IVA=MSOLIS(3) 140 : ITLAC1= KCOLA(1) 141 : IF(IVA.NE.0) MSOLIS(3)=ITLAC1.ITLAC(IVA) 142 : GOTO 620 143 : ENDIF 144 : IF(II.LE.4) GOTO 620 145 : ITLAC2=KCOLA(MSOLIT(II)) 146 : MSOLEN=MSOLIS(II) 147 : SEGACT MSOLEN*MOD 148 : LTAB=ISOLEN(/1) 149 : DO 619 I=1,LTAB 150 : IVA=ISOLEN(I) 151 : IF (IVA.NE.0) ISOLEN(I)=ITLAC2.ITLAC(IVA) 152 : 619 CONTINUE 153 : SEGDES MSOLEN 154 : 620 CONTINUE 155 : 817 SEGDES MSOLUT 156 : 1800 CONTINUE 157 : GOTO 1098 158 : C ************************** MSTRUC ******************************** 159 : 509 CONTINUE 160 : ITLAC1=KCOLA(12) 161 : DO 621 IEL=IDEB,IMAX1 162 : MSTRUC=ITLAC(IEL) 163 : IF (MSTRUC.EQ.0) GO TO 621 164 : SEGACT MSTRUC*MOD 165 : N=LISTRU(/1) 166 : DO 622 I=1,N 167 : IVA=ABS(LISTRU(I)) 168 : * IF (IVA.NE.0)LISTRU(I)=ITLAC1.ITLAC(IVA) MILL 3 / 9 / 92 169 : IF (LISTRU(I).LT.0)LISTRU(I)=ITLAC1.ITLAC(IVA) 170 : 622 CONTINUE 171 : SEGDES MSTRUC 172 : 621 CONTINUE 173 : GOTO 1098 174 : C ******************************* MTABLE ************************** 175 : 510 CONTINUE 176 : ITLAC2=KCOLA(27) 177 : NTOTO=6 178 : if(nbesc.ne.0) segact ipiloc 179 : DO 710 IEL=IDEB,IMAX1 180 : MTABLE=ITLAC(IEL) 181 : IF (MTABLE.EQ.0) GO TO 710 182 : SEGACT MTABLE*MOD 183 : L6=MLOTAB 184 : L=L6 185 : 186 : IF (L.EQ.0) GO TO 713 187 : DO 711 K=1,L 188 : ITYPE=MTABTI(K) 189 : IVA=MTABII(K) 189 : CALL TYPFIL (ITYPE,J) 190 : IF(J.LE.0) GO TO 711 191 : ITLAC1=KCOLA(J) 192 : MTABII(K)=ITLAC1.ITLAC(IVA) 193 : IF(MTABTI(K).EQ.'METHODE ') MTABII(K)=ITLAC2 194 : $ .ITLAC(MTABII(K)) 195 : IF (ITYPE.EQ.'FLOTTANT') RMTABI(K)=XIFLOT(MTABII(K)) 196 : C-----SI ON POINTE SUR UNE TABLE IL NE FAUT PAS DESACTIVER 197 : ITYPE=MTABTV(K) 198 : IVA=MTABIV(K) 198 : CALL TYPFIL (ITYPE,J) 199 : IF(J.LE.0) GO TO 711 200 : IF(J.eq.47) GO TO 711 201 : ITLAC1=KCOLA(J) 202 : MTABIV(K)=ITLAC1.ITLAC(IVA) 203 : IF (ITYPE.EQ.'FLOTTANT') RMTABV(K)=XIFLOT(MTABIV(K)) 204 : C-----SI ON POINTE SUR UNE TABLE IL NE FAUT PAS DESACTIVER 205 : 711 CONTINUE 206 : 713 SEGDES MTABLE 207 : 710 CONTINUE 208 : if(nbesc.ne.0) segdes ipiloc 209 : GO TO 1098 210 : 715 CONTINUE 211 : MOTERR(1:8)=ITYPE 211 : CALL ERREUR (336) 212 : GO TO 1098 213 : C ***************************** ***************************** 214 : 6011 CONTINUE 215 : GOTO 1098 216 : C ******************************** MSOSTU ************************** 217 : 512 CONTINUE 218 : ITLAC1=KCOLA(5) 219 : ITLAC3=KCOLA(3) 220 : DO 630 IEL=IDEB,IMAX1 221 : MSOSTU=ITLAC(IEL) 222 : IF (MSOSTU.EQ.0) GO TO 630 223 : SEGACT MSOSTU*MOD 224 : IVA=ISRAID 225 : IF(IVA.NE.0)ISRAID=ITLAC3.ITLAC(IVA) 226 : IVA=ISMASS 227 : IF(IVA.NE.0)ISMASS=ITLAC3.ITLAC(IVA) 228 : NS=ISCHAM(/1) 229 : DO 121 I=1,NS 230 : IVA= ISCHAM(I) 231 : IF (IVA.NE.0)ISCHAM(I)= ITLAC1.ITLAC(IVA) 232 : 121 CONTINUE 233 : SEGDES MSOSTU 234 : 630 CONTINUE 235 : GO TO 1098 236 : C ***************************** IMATRI ***************************** 237 : 6013 CONTINUE 238 : GOTO 1098 239 : C ***************************** MJONCT ***************************** 240 : 6014 CONTINUE 241 : ITLAC1=KCOLA(1) 242 : ITLAC2=KCOLA(2) 243 : ITLAC3=KCOLA(12) 244 : DO 631 IEL=IDEB,IMAX1 245 : MJONCT=ITLAC(IEL) 246 : IF (MJONCT.EQ.0) GO TO 631 247 : SEGACT MJONCT*MOD 248 : IVA=MJOPOI 249 : CCCC MJOPOI=ITLAC1.ITLAC(IVA) 250 : IF(MJOTYP.EQ.'CHOC') THEN 251 : IF(IVA.NE.0) MJOPOI=ITLAC2.ITLAC(IVA) 252 : ELSE 253 : IF(IVA.NE.0) MJOPOI=ITLAC1.ITLAC(IVA) 254 : ENDIF 255 : DO 632 I=1,ISTRJO(/1) 256 : IVA=ISTRJO(I) 257 : IF (IVA.NE.0)ISTRJO(I)= ITLAC3.ITLAC(IVA) 258 : IVA=IPCHJO(I) 259 : IF (IVA.NE.0)IPCHJO(I)=ITLAC2.ITLAC(IVA) 260 : IVA=IPOSJO(I) 261 : IF (IVA.NE.0) IPOSJO(I)= ITLAC1.ITLAC(IVA) 262 : 632 CONTINUE 263 : SEGDES MJONCT 264 : 631 CONTINUE 265 : GO TO 1098 266 : C ************************ MATTAC ********************************** 267 : 6015 CONTINUE 268 : ITLAC1=KCOLA(1) 269 : ITLAC3=KCOLA(3) 270 : ITLAC4=KCOLA(14) 271 : DO 150 IEL=IDEB,IMAX1 272 : MATTAC =ITLAC(IEL) 273 : IF (MATTAC.EQ.0) GO TO 150 274 : SEGACT MATTAC*MOD 275 : NN=LISATT(/1) 276 : DO 151 I=1,NN 277 : MSOUMA=LISATT(I) 278 : SEGACT MSOUMA*MOD 279 : N=IPMATK(/1) 280 : DO 152 J=1,N 281 : IVA=IPMATK(J) 282 : IF (IVA.NE.0)IPMATK(J)= ITLAC3.ITLAC(IVA) 283 : 152 CONTINUE 284 : N=IATREL(/1) 285 : DO 153 J=1,N 286 : IVA=IATREL(J) 287 : IF (IVA.NE.0)IATREL(J)=ITLAC4.ITLAC(IVA) 288 : 153 CONTINUE 289 : IF(IGEOCH.EQ.0) GO TO 156 290 : MGEOCH=IGEOCH 291 : SEGACT MGEOCH*MOD 292 : NI=INORCH(/1) 293 : DO 154 J=1,NI 294 : IVA=INORCH(J) 295 : IF (IVA.NE.0)INORCH(J)= ITLAC1.ITLAC(IVA) 296 : 154 CONTINUE 297 : N1=IMAPRO(/1) 298 : DO 155 J=1,N1 299 : IVA=IMAPRO(J) 300 : IF (IVA.NE.0)IMAPRO(J)= ITLAC1.ITLAC(IVA) 301 : 155 CONTINUE 302 : SEGDES MGEOCH 303 : 156 CONTINUE 304 : SEGDES MSOUMA 305 : 151 CONTINUE 306 : SEGDES MATTAC 307 : 150 CONTINUE 308 : GOTO 1098 309 : C ***************************** MMATRI ***************************** 310 : 6016 CONTINUE 311 : ITLAC1=KCOLA(1) 312 : DO 2600 IEL=IDEB,IMAX1 313 : MMATRI=ITLAC(IEL) 314 : IF (MMATRI.EQ.0) GO TO 2600 315 : SEGACT MMATRI*MOD 316 : IVA=IGEOMA 317 : IGEOMA=ITLAC1.ITLAC(IVA) 318 : SEGDES MMATRI 319 : 2600 CONTINUE 320 : GOTO 1098 321 : C ************************* MDEFOR******************************* 322 : 6017 CONTINUE 323 : ITLAC1=KCOLA(1) 324 : ITLAC2=KCOLA(2) 325 : ITLAC3=KCOLA(30) 326 : ITLAC4=KCOLA(38) 327 : ITLAC5=KCOLA(39) 328 : DO 2700 IEL=IDEB,IMAX1 329 : MDEFOR=ITLAC(IEL) 330 : IF (MDEFOR.EQ.0) GO TO 2700 331 : SEGACT MDEFOR*MOD 332 : NDEF=IELDEF(/1) 333 : DO 2701 I=1,NDEF 334 : IVA=IELDEF(I) 335 : IELDEF(I)=ITLAC1.ITLAC(IVA) 336 : IVA=ICHDEF(I) 337 : ICHDEF(I)=ITLAC2.ITLAC(IVA) 338 : IVA=MTVECT(I) 339 : IF (IVA.NE.0) MTVECT(I)=ITLAC3.ITLAC(IVA) 340 : IVA=MDCHP(I) 341 : IF (IVA.NE.0) MDCHP(I)=ITLAC2.ITLAC(IVA) 342 : IVA=MDCHEL(I) 343 : IF (IVA.NE.0) MDCHEL(I)=ITLAC5.ITLAC(IVA) 344 : IVA=MDMODE(I) 345 : IF (IVA.NE.0) MDMODE(I)=ITLAC4.ITLAC(IVA) 346 : 2701 CONTINUE 347 : SEGDES MDEFOR 348 : 2700 CONTINUE 349 : GOTO 1098 350 : C ***************************MLREEL****************************** 351 : 6018 CONTINUE 352 : GOTO 1098 353 : C *****************************MLENTI*************************** 354 : 6019 CONTINUE 355 : GOTO 1098 356 : C ****************************MCHARG***************************** 357 : 6020 CONTINUE 358 : ITLAC1=KCOLA(2) 359 : ITLAC2=KCOLA(18) 360 : ITLAC3=KCOLA(39) 361 : ITLAC4=KCOLA(10) 362 : ITLAC5=KCOLA(32) 363 : ITLAC6=KCOLA(1) 364 : DO 3000 IEL=IDEB,IMAX1 365 : MCHARG=ITLAC(IEL) 366 : SEGACT MCHARG 367 : IF (MCHARG.EQ.0) GO TO 3000 368 : N=KCHARG(/1) 369 : DO 3001 I=1,N 370 : ICHARG=KCHARG(I) 371 : SEGACT ICHARG*MOD 372 : IF(CHATYP.EQ.'CHPOINT ') THEN 373 : IVA=ABS(ICHPO1) 374 : IF(ICHPO1.LT.0) ICHPO1=ITLAC1.ITLAC(IVA) 375 : IVA=ABS(ICHPO2) 376 : IF(ICHPO2.LT.0) ICHPO2=ITLAC2.ITLAC(IVA) 377 : IVA=ABS(ICHPO3) 378 : IF(ICHPO3.LT.0) ICHPO3=ITLAC2.ITLAC(IVA) 379 : ELSE IF (CHATYP.EQ.'MCHAML ') THEN 380 : IVA=ABS(ICHPO1) 381 : IF(ICHPO1.LT.0) ICHPO1=ITLAC3.ITLAC(IVA) 382 : IVA=ABS(ICHPO2) 383 : IF(ICHPO2.LT.0) ICHPO2=ITLAC2.ITLAC(IVA) 384 : IVA=ABS(ICHPO3) 385 : IF(ICHPO3.LT.0) ICHPO3=ITLAC2.ITLAC(IVA) 386 : ELSE IF (CHATYP.EQ.'TABLE ') THEN 387 : IVA=ABS(ICHPO1) 388 : IF(ICHPO1.LT.0) ICHPO1=ITLAC4.ITLAC(IVA) 389 : IVA=ABS(ICHPO2) 390 : IF(ICHPO2.LT.0) ICHPO2=ITLAC4.ITLAC(IVA) 391 : ENDIF 392 : IF(CHAMOB(I).EQ.'TRAN') THEN 393 : IVA=ABS(ICHPO4) 394 : IF(ICHPO4.LT.0) ICHPO4=ITLAC5.ITLAC(IVA) 395 : IVA=ABS(ICHPO6) 396 : IF(ICHPO6.LT.0) ICHPO6=ITLAC2.ITLAC(IVA) 397 : IVA=ABS(ICHPO7) 398 : IF(ICHPO7.LT.0) ICHPO7=ITLAC2.ITLAC(IVA) 399 : ELSEIF(CHAMOB(I).EQ.'ROTA') THEN 400 : IVA=ABS(ICHPO4) 401 : IF(ICHPO4.LT.0) ICHPO4=ITLAC5.ITLAC(IVA) 402 : IVA=ABS(ICHPO5) 403 : IF(ICHPO5.LT.0.AND.IDIM.GT.2) ICHPO5=ITLAC5.ITLAC(IVA) 404 : IVA=ABS(ICHPO6) 405 : IF(ICHPO6.LT.0) ICHPO6=ITLAC2.ITLAC(IVA) 406 : IVA=ABS(ICHPO7) 407 : IF(ICHPO7.LT.0) ICHPO7=ITLAC2.ITLAC(IVA) 408 : ELSEIF(CHAMOB(I).EQ.'TRAJ') THEN 409 : IVA=ABS(ICHPO4) 410 : IF(ICHPO4.LT.0) ICHPO4=ITLAC1.ITLAC(IVA) 411 : IVA=ABS(ICHPO5) 412 : IF(ICHPO5.LT.0) ICHPO5=ITLAC6.ITLAC(IVA) 413 : IVA=ABS(ICHPO6) 414 : IF(ICHPO6.LT.0) ICHPO6=ITLAC2.ITLAC(IVA) 415 : ENDIF 416 : SEGDES ICHARG 417 : 3001 CONTINUE 418 : SEGDES MCHARG 419 : 3000 CONTINUE 420 : GOTO 1098 421 : C ************************ ***************************** 422 : 6021 CONTINUE 423 : GOTO 1098 424 : C *********************MEVOLL************************************ 425 : 6022 CONTINUE 426 : ITLACR=KCOLA(18) 427 : ITLACM=KCOLA(29) 428 : ITLAC2=ITLACR 429 : ITLAC2=ITLACM 430 : DO 3200 IEL=IDEB,IMAX1 431 : MEVOLL=ITLAC(IEL) 432 : IF (MEVOLL.EQ.0) GO TO 3200 433 : SEGACT MEVOLL 434 : N=IEVOLL(/1) 435 : DO 3201 I=1,N 436 : KEVOLL=IEVOLL(I) 437 : SEGACT KEVOLL*MOD 438 : IVA=ABS(IPROGX) 439 : IF(IONIVE.GE.3) THEN 440 : IF(TYPX.EQ.'LISTMOTS') THEN 441 : ITLAC2=ITLACM 442 : ELSEIF(TYPX.EQ.'LISTREEL') THEN 443 : ITLAC2=ITLACR 444 : ENDIF 445 : ENDIF 446 : * IPROGX=ITLAC2.ITLAC(IVA) MILL 3 / 9 /92 447 : IF(IPROGX.LT.0) IPROGX=ITLAC2.ITLAC(IVA) 448 : IVA=ABS(IPROGY) 449 : IF(IONIVE.GE.3) THEN 450 : IF(TYPY.EQ.'LISTMOTS') THEN 451 : ITLAC2=ITLACM 452 : ELSEIF(TYPY.EQ.'LISTREEL') THEN 453 : ITLAC2=ITLACR 454 : ENDIF 455 : ENDIF 456 : * IPROGY=ITLAC2.ITLAC(IVA) MILL 3 / 9 / 92 457 : IF(IPROGY.LT.0) IPROGY=ITLAC2.ITLAC(IVA) 458 : SEGDES KEVOLL 459 : 3201 CONTINUE 460 : SEGDES MEVOLL 461 : 3200 CONTINUE 462 : ITLAC2=ITLACR 463 : ITLAC2=ITLACM 464 : GOTO 1098 465 : C **********************SUPERELE************************************ 466 : 6023 CONTINUE 467 : ITLAC1=KCOLA(1) 468 : ITLAC3=KCOLA(3) 469 : ITLAC2=KCOLA( 2) 470 : ITLAC4=KCOLA(16) 471 : DO 5230 IEL=IDEB,IMAX1 472 : MSUPER=ITLAC(IEL) 473 : IF (MSUPER.EQ.0) GO TO 5230 474 : SEGACT MSUPER*MOD 475 : IVA=MRIGTO 476 : MRIGTO=ITLAC3.ITLAC(IVA) 477 : IVA=MSUPEL 478 : MSUPEL=ITLAC1.ITLAC(IVA) 479 : IVA=MSURAI 480 : MSURAI=ITLAC3.ITLAC(IVA) 481 : IVA=MCROUT 482 : if (iva.le.ITLAC4.ITLAC(/1)) then 483 : MCROUT=ITLAC4.ITLAC(IVA) 484 : else 485 : MCROUT=0 486 : endif 487 : IVA=MSUMAS 488 : IF (IVA.NE.0) MSUMAS=ITLAC3.ITLAC(IVA) 489 : SEGDES MSUPER 490 : 5230 CONTINUE 491 : GOTO 1098 492 : C **********************LOGIQUE*********************************** 493 : 6024 CONTINUE 494 : GOTO 1098 495 : C **********************FLOTTANT********************************** 496 : 6025 CONTINUE 497 : GOTO 1098 498 : C ********************** ENTIER ********************************** 499 : 6026 CONTINUE 500 : GOTO 1098 501 : C ********************** MOT *********************************** 502 : 6027 CONTINUE 503 : GOTO 1098 504 : C ********************** TEXTE *********************************** 505 : 6028 CONTINUE 506 : GOTO 1098 507 : C ********************** LISTMOTS********************************* 508 : 6029 CONTINUE 509 : GOTO 1098 510 : C ********************** VECTEUR********************************** 511 : 6030 CONTINUE 512 : ITLAC1=KCOLA(1) 513 : ITLAC2=KCOLA( 2) 514 : DO 5300 IEL=IDEB,IMAX1 515 : MVECTE=ITLAC(IEL) 516 : IF (MVECTE.EQ.0) GO TO 5300 517 : SEGACT MVECTE*MOD 518 : NVEC=ICHPO(/1) 519 : DO 5301 I=1,NVEC 520 : * PAS UTILISE ACTUELLEMENT 521 : * IVA=IGEOV(I) 522 : * IGEOV(I)=ITLAC1.ITLAC(IVA) 523 : IVA=ICHPO(I) 524 : ICHPO(I)=ITLAC2.ITLAC(IVA) 525 : 5301 CONTINUE 526 : SEGDES MVECTE 527 : 5300 CONTINUE 528 : GOTO 1098 529 : C ********************** VECTDOUB********************************* 530 : 6031 CONTINUE 531 : GOTO 1098 532 : C ********************** POINT ********************************* 533 : 6032 CONTINUE 534 : GOTO 1098 535 : C ********************** CONFIG ********************************* 536 : 6033 CONTINUE 537 : GOTO 1098 538 : C *********************** LISTCHPO ****************************** 539 : 534 CONTINUE 540 : ITLAC2=KCOLA(2) 541 : DO 340 IEL=IDEB,IMAX1 542 : MLCHPO =ITLAC(IEL) 543 : IF (MLCHPO.EQ.0) GO TO 340 544 : SEGACT MLCHPO*MOD 545 : N1=ICHPOI(/1) 546 : DO 341 I=1,N1 547 : IVA=ICHPOI(I) 548 : ICHPOI(I)=ITLAC2.ITLAC(IVA) 549 : 341 CONTINUE 550 : SEGDES MLCHPO 551 : 340 CONTINUE 552 : GO TO 1098 553 : C ************************** BASEM ******************************** 554 : 6035 CONTINUE 555 : ITLAC1=KCOLA(12) 556 : ITLAC2=KCOLA(8 ) 557 : ITLAC3=KCOLA(15) 558 : DO 350 IEL=IDEB,IMAX1 559 : MBASEM=ITLAC(IEL) 560 : IF (MBASEM.EQ.0) GO TO 350 561 : SEGACT MBASEM 562 : N=LISBAS(/1) 563 : IF (N.EQ.0) GO TO 352 564 : DO 351 I=1,N 565 : MSOBAS=LISBAS(I) 566 : SEGACT MSOBAS*MOD 567 : IVA=ABS(IBSTRM(1)) 568 : * IBSTRM(1)=ITLAC1.ITLAC(IVA) MILL 3 / 9 /92 569 : IF(IBSTRM(1).LT.0) IBSTRM(1)=ITLAC1.ITLAC(IVA) 570 : IVA=ABS(IBSTRM(2)) 571 : * IBSTRM(2)=ITLAC2.ITLAC(IVA) 572 : IF(IBSTRM(2).LT.0) IBSTRM(2)=ITLAC2.ITLAC(IVA) 573 : IVA=ABS(IBSTRM(3)) 574 : * IBSTRM(3)=ITLAC2.ITLAC(IVA) 575 : IF(IBSTRM(3).LT.0) IBSTRM(3)=ITLAC2.ITLAC(IVA) 576 : 353 CONTINUE 577 : IVA=ABS(IBSTRM(4)) 578 : * IBSTRM(4)=ITLAC3.ITLAC(IVA) 579 : IF(IBSTRM(4).LT.0) IBSTRM(4)=ITLAC3.ITLAC(IVA) 580 : 354 CONTINUE 581 : IVA=ABS(IBSTRM(5)) 582 : * IBSTRM(5)=ITLAC2.ITLAC(IVA) 583 : IF(IBSTRM(5).LT.0) IBSTRM(5)=ITLAC2.ITLAC(IVA) 584 : 355 CONTINUE 585 : SEGDES MSOBAS 586 : 351 CONTINUE 587 : 352 SEGDES MBASEM 588 : 350 CONTINUE 589 : GOTO 1098 590 : C ************************ MMODEL ********************************** 591 : 6038 CONTINUE 591 : CALL RESMMO(ICOLAC,ITLACC,IMAX1,IDEB) 592 : GOTO 1098 593 : C ************************ MCHAML ********************************** 594 : 6039 CONTINUE 594 : CALL RESCHA(ICOLAC,ITLACC,IMAX1,IDEB) 595 : GOTO 1098 596 : C ************************ MINTE ********************************** 597 : 6040 CONTINUE 598 : GOTO 1098 599 : C ************************ MNUAGE ****************************** 600 : 6041 CONTINUE 600 : CALL RESNUA(ICOLAC,ITLACC,IMAX1) 601 : GOTO 1098 602 : C ************************* MATRAK ********************************* 603 : 6042 CONTINUE 603 : CALL RESMAK(ICOLAC,ITLACC,IMAX1,IDEB) 604 : GOTO 1098 605 : C ************************* MATRIK ******************************** 606 : 6043 CONTINUE 606 : CALL RESMIK(ICOLAC,ITLACC,IMAX1,IDEB) 607 : GOTO 1098 608 : C ************************ ****************************** 609 : 6045 CONTINUE 610 : GO TO 1098 611 : C ****************************************************************** 612 : 1098 CONTINUE 613 : C********************************************************************* 614 : 1099 CONTINUE 615 : SEGDES ICOLAC 616 : C 617 : RETURN 618 : END 619 : 620 : 621 :
© Cast3M 2003 - All rights reserved.
Disclaimer