1 : C RESTRI SOURCE CHAT 09/10/09 21:23:00 6519 2 : SUBROUTINE RESTRI (ICOLAC,ITLACC,IMAX1,IDEB) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C======================================================================= 6 : C RESTAURATION DES POINTEURS 7 : C 8 : C APPELE PAR RESTPI 9 : C======================================================================= 10 : C TABLEAU KCOLA : 11 : C 1 MELEME 2 CHPOIN 3 MRIGID 4 MCHAFF 5 MCHELM 6 MCLSTR 12 : C 7 MELSTR 8 MSOLUT 9 MSTRUC 10 11 MAFFEC 12 MSOSTU 13 : C 13 IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL 14 : C 19 MLENTI 20 MCHARG 21 MODELE 22 MEVOLL 23 MSUPER 15 : C======================================================================= 16 : -INC CCOPTIO 17 : -INC SMRIGID 18 : -INC TMCOLAC 19 : -INC TMVECRIG 20 : C ***********************MRIGID************************************* 21 : 6003 CONTINUE 22 : ITLAC1=KCOLA(1) 23 : ITLAC2=KCOLA(13) 24 : ITLAC3=KCOLA(16) 25 : ITLAC4=KCOLA(3) 26 : ITLAC5=KCOLA(10) 27 : ITLAC6=KCOLA(2) 28 : 29 : DO 1202 IEL=IDEB,IMAX1 30 : MRIGID=ITLAC(IEL) 31 : IF (MRIGID.EQ.0) GO TO 1202 32 : SEGACT MRIGID*MOD 33 : NRIGEL=IRIGEL(/2) 34 : IF(IMGEO1.EQ.0) GOTO 1204 35 : IMGEOD=IMGEO1 36 : SEGACT IMGEOD*MOD 37 : DO 1205 I=1,IMGEOR(/1) 38 : IVA=ABS(IMGEOR(I)) 39 : * IMGEOR(I)=ITLAC1.ITLAC(IVA) MILL 3/ 9 / 92 40 : IF(IMGEOR(I).LT.0) IMGEOR(I)=ITLAC1.ITLAC(IVA) 41 : 1205 CONTINUE 42 : SEGDES IMGEOD 43 : 1204 CONTINUE 44 : IF(IVECRI.EQ.0) GO TO 1208 45 : MVECRI=IVECRI 46 : SEGACT MVECRI*MOD 47 : DO 1209 I=1,MELZON(/1) 48 : IVA=ABS(MELZON(I)) 49 : IF(MELZON(I).LT.0) MELZON(I)=ITLAC1.ITLAC(IVA) 50 : 1209 CONTINUE 51 : SEGDES MVECRI 52 : 1208 CONTINUE 53 : IF (IMGEO2.LT.0) IMGEO2=ITLAC6.ITLAC(ABS(IMGEO2)) 54 : 55 : C ... Le pointeur ICHOLE dans le fichier de sauvegarde est nul 56 : C (MMATRI non sauvé) ou positif (voir SORTRI, EXARIG et WRPIL) ... 57 : C ... On laisse .NE. (et non .GT.) et le ABS au cas où quelqu'un 58 : C miodifiait la sortie ... 59 : IVA=ICHOLE 60 : * IF(IVA .NE.0) ICHOLE=ITLAC3.ITLAC(ABS(IVA)) 61 : ichole=abs(iva) 62 : 63 : IVA=ISUPEQ 64 : IF(IVA.NE.0) ISUPEQ=ITLAC5.ITLAC(IVA) 65 : DO 1203 IR=1,NRIGEL 66 : IVA=ABS(IRIGEL(1,IR)) 67 : * IRIGEL(1,IR)=ITLAC1.ITLAC(IVA) MILL 3 / 9 / 92 68 : IF(IRIGEL(1,IR).LT.0) IRIGEL(1,IR)=ITLAC1.ITLAC(IVA) 69 : 70 : IVA=ABS(IRIGEL(2,IR)) 71 : * IF(IVA.NE.0) IRIGEL(2,IR)=ITLAC1.ITLAC(IVA) 72 : IF(IRIGEL(2,IR).LT.0) IRIGEL(2,IR)=ITLAC1.ITLAC(IVA) 73 : if(ionive.lt.18) then 74 : IVA=ABS(IRIGEL(4,IR)) 75 : * IRIGEL(4,IR)=ITLAC2.ITLAC(IVA) 76 : IF(IRIGEL(4,IR).LT.0) IRIGEL(4,IR)=ITLAC2.ITLAC(IVA) 77 : endif 78 : 1203 CONTINUE 79 : iva=abs(jrcond) 80 : if (iva.ne.0) jrcond=itlac4.itlac(iva) 81 : iva=abs(jrdepp) 82 : if (iva.ne.0) jrdepp=itlac4.itlac(iva) 83 : iva=abs(jrdepd) 84 : if (iva.ne.0) jrdepd=itlac4.itlac(iva) 85 : iva=abs(jrelim) 86 : if (iva.ne.0) jrelim=itlac4.itlac(iva) 87 : iva=abs(jrgard) 88 : if (iva.ne.0) jrgard=itlac4.itlac(iva) 89 : iva=abs(jrtot) 90 : if (iva.ne.0) jrtot =itlac4.itlac(iva) 91 : iva=abs(imlag) 92 : if (iva.ne.0) imlag =itlac1.itlac(iva) 93 : 94 : 95 : 96 : 97 : 98 : 99 : 100 : 101 : 102 : SEGDES MRIGID 103 : 104 : 1202 CONTINUE 105 : GOTO 1098 106 : C*********************************************************************** 107 : 1098 CONTINUE 108 : C********************************************************************* 109 : RETURN 110 : END 111 : 112 : 113 : 114 : 115 : 116 : 117 : 118 : 119 : 120 : 121 : 122 : 123 : 124 : 125 : 126 :
© Cast3M 2003 - All rights reserved.
Disclaimer