Sources Esope | Cast3M

restri
C RESTRI    SOURCE    PV        19/02/25    21:16:42     10121          
      SUBROUTINE RESTRI (ICOLAC,ITLACC,IMAX1,IDEB)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C=======================================================================
C   RESTAURATION DES POINTEURS
C
C   APPELE PAR RESTPI
C=======================================================================
C  TABLEAU KCOLA :
C    1  MELEME  2 CHPOIN  3 MRIGID  4 MCHAFF  5 MCHELM  6 MCLSTR
C    7  MELSTR  8 MSOLUT  9 MSTRUC 10        11 MAFFEC 12 MSOSTU
C   13  IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL
C   19  MLENTI 20 MCHARG 21 MODELE 22 MEVOLL 23 MSUPER
C=======================================================================
 
-INC PPARAM
-INC CCOPTIO
-INC SMRIGID
-INC TMCOLAC
-INC TMVECRIG
C     ***********************MRIGID*************************************
 6003 CONTINUE
      ITLAC1=KCOLA(1)
      ITLAC2=KCOLA(13)
      ITLAC3=KCOLA(16)
      ITLAC4=KCOLA(3)
      ITLAC5=KCOLA(10)
      ITLAC6=KCOLA(2)
 
      DO 1202 IEL=IDEB,IMAX1
         MRIGID=ITLAC(IEL)
         IF (MRIGID.EQ.0) GO TO 1202
         SEGACT MRIGID*MOD
         NRIGEL=IRIGEL(/2)
         IF(IMGEO1.EQ.0) GOTO 1204
         IMGEOD=IMGEO1
         SEGACT IMGEOD*MOD
         DO 1205 I=1,IMGEOR(/1)
            IVA=ABS(IMGEOR(I))
*            IMGEOR(I)=ITLAC1.ITLAC(IVA)           MILL 3/ 9 / 92
            IF(IMGEOR(I).LT.0) IMGEOR(I)=ITLAC1.ITLAC(IVA)
 1205    CONTINUE
         SEGDES IMGEOD
 1204    CONTINUE
         IF(IVECRI.EQ.0) GO TO 1208
           MVECRI=IVECRI
           SEGACT MVECRI*MOD
           DO 1209 I=1,MELZON(/1)
            IVA=ABS(MELZON(I))
            IF(MELZON(I).LT.0) MELZON(I)=ITLAC1.ITLAC(IVA)
 1209    CONTINUE
         SEGDES MVECRI
 1208    CONTINUE
         IF (IMGEO2.LT.0) IMGEO2=ITLAC6.ITLAC(ABS(IMGEO2))
 
C    ... Le pointeur ICHOLE dans le fichier de sauvegarde est nul
C        (MMATRI non sauvé) ou positif (voir SORTRI, EXARIG et WRPIL) ...
C    ... On laisse .NE. (et non .GT.) et le ABS au cas où quelqu'un
C        miodifiait la sortie ...
         IVA=ICHOLE
*        IF(IVA   .NE.0) ICHOLE=ITLAC3.ITLAC(ABS(IVA))
         ichole=abs(iva)
 
         IVA=ISUPEQ
         IF(IVA.NE.0) ISUPEQ=ITLAC5.ITLAC(IVA)
         DO 1203 IR=1,NRIGEL
            IVA=ABS(IRIGEL(1,IR))
*            IRIGEL(1,IR)=ITLAC1.ITLAC(IVA)        MILL 3 / 9 / 92
            IF(IRIGEL(1,IR).LT.0) IRIGEL(1,IR)=ITLAC1.ITLAC(IVA)
 
            IVA=ABS(IRIGEL(2,IR))
*            IF(IVA.NE.0) IRIGEL(2,IR)=ITLAC1.ITLAC(IVA)
            IF(IRIGEL(2,IR).LT.0) IRIGEL(2,IR)=ITLAC1.ITLAC(IVA)
            if(ionive.lt.18.or.ionive.ge.20) then
              IVA=ABS(IRIGEL(4,IR))
**            write (6,*) ' restri iva ',iva
*              IRIGEL(4,IR)=ITLAC2.ITLAC(IVA)
              IF(IRIGEL(4,IR).LT.0) IRIGEL(4,IR)=ITLAC2.ITLAC(IVA)
              xmatri=irigel(4,ir)
*              segact xmatri
**          write (6,*) 'restri xmatri ',xmatri,re(/1),re(/2),re(/3)
 
            endif
 1203    CONTINUE
         iva=abs(jrcond)
         if (iva.ne.0) jrcond=itlac4.itlac(iva)
         iva=abs(jrsup)
         if (iva.ne.0) jrsup=itlac4.itlac(iva)
         iva=abs(jrdepp)
         if (iva.ne.0) jrdepp=itlac4.itlac(iva)
         iva=abs(jrdepd)
         if (iva.ne.0) jrdepd=itlac4.itlac(iva)
         iva=abs(jrelim)
         if (iva.ne.0) jrelim=itlac4.itlac(iva)
         iva=abs(jrgard)
         if (iva.ne.0) jrgard=itlac4.itlac(iva)
         iva=abs(jrtot)
         if (iva.ne.0) jrtot =itlac4.itlac(iva)
         iva=abs(imlag)
         if (iva.ne.0) imlag =itlac1.itlac(iva)
         SEGDES MRIGID
 
 1202 CONTINUE
      GOTO 1098
C***********************************************************************
 1098 CONTINUE
C*********************************************************************
      RETURN
      END