Télécharger la plaquette Cast3M


fr en

Télécharger restri.eso

Retour à la liste

Numérotation des lignes : 

restri

  1. C RESTRI    SOURCE    OF166741  24/12/18    21:15:34     12089          
  2.  
  3. C=======================================================================
  4. C   RESTAURATION DES POINTEURS
  5. C
  6. C   APPELE PAR RESTPI
  7. C=======================================================================
  8. C  TABLEAU KCOLA : VOIR SOUSPROGRAMMME TYPFIL
  9. C=======================================================================
  10.  
  11.       SUBROUTINE RESTRI (ICOLAC,ITLACC,IMAX1,IDEB)
  12.  
  13.       IMPLICIT INTEGER(I-N)
  14.       IMPLICIT REAL*8 (A-H,O-Z)
  15.  
  16. -INC PPARAM
  17. -INC CCOPTIO
  18.  
  19. C     ***********************MRIGID*************************************
  20. -INC SMRIGID
  21. -INC TMCOLAC
  23.  
  24.       ITLAC1=KCOLA(1)
  25.       ITLAC2=KCOLA(13)
  26.       ITLAC3=KCOLA(16)
  27.       ITLAC4=KCOLA(3)
  28.       ITLAC5=KCOLA(10)
  29.       ITLAC6=KCOLA(2)
  30.  
  31.       DO 1202 IEL = IDEB,IMAX1
  32.          MRIGID=ITLAC(IEL)
  33.          IF (MRIGID.EQ.0) GO TO 1202
  34.          SEGACT MRIGID*MOD
  35.  
  36.          IF (IMGEO1.NE.0) THEN
  37.            IMGEOD=IMGEO1
  38.            SEGACT IMGEOD*MOD
  39.            DO I=1,IMGEOR(/1)
  40.              IVA = IMGEOR(I)
  41.              IF (IVA.LT.0) IMGEOR(I)=ITLAC1.ITLAC(ABS(IVA))
  42.            ENDDO
  43.            SEGDES IMGEOD
  44.          ENDIF
  45.          IF (IVECRI.NE.0) THEN
  46.            MVECRI=IVECRI
  47.            SEGACT MVECRI*MOD
  48.            DO I=1,MELZON(/1)
  49.              IVA = MELZON(I)
  50.              IF (IVA.LT.0) MELZON(I)=ITLAC1.ITLAC(ABS(IVA))
  51.            ENDDO
  52.            SEGDES MVECRI
  53.          ENDIF
  54.          IF (IMGEO2.LT.0) IMGEO2=ITLAC6.ITLAC(ABS(IMGEO2))
  55.  
  56. C    ... Le pointeur ICHOLE dans le fichier de sauvegarde est nul
  57. C        (MMATRI non sauve) ou positif (voir SORTRI, EXARIG et WRPIL) ...
  58. C    ... On laisse .NE. (et non .GT.) et le ABS au cas où quelqu'un
  59. C        modifera la sortie ...
  60.          IVA=ICHOLE
  61. C*        IF (IVA.NE.0) ICHOLE=ITLAC3.ITLAC(ABS(IVA))
  62.          IF (IVA.NE.0) ICHOLE=ABS(IVA)
  63.  
  64.          IVA=ISUPEQ
  65.          IF (IVA.NE.0) ISUPEQ=ITLAC5.ITLAC(IVA)
  66.  
  67.          NRIGEL=IRIGEL(/2)
  68.          DO IR = 1, NRIGEL
  69.             IVA = IRIGEL(1,IR)
  70.             IF (IVA.LT.0) IRIGEL(1,IR)=ITLAC1.ITLAC(ABS(IVA))
  71.  
  72.             IVA = IRIGEL(2,IR)
  73.             IF (IVA.LT.0) IRIGEL(2,IR)=ITLAC1.ITLAC(ABS(IVA))
  74.  
  75.             IVA = IRIGEL(4,IR)
  76.             IF (IVA.LT.0) IRIGEL(4,IR)=ITLAC2.ITLAC(ABS(IVA))
  77.          ENDDO
  78.  
  79.          iva=jrcond
  80.          if (iva.ne.0) jrcond=itlac4.itlac(abs(iva))
  81.          iva=jrsup
  82.          if (iva.ne.0) jrsup =itlac4.itlac(abs(iva))
  83.          iva=jrdepp
  84.          if (iva.ne.0) jrdepp=itlac4.itlac(abs(iva))
  85.          iva=jrdepd
  86.          if (iva.ne.0) jrdepd=itlac4.itlac(abs(iva))
  87.          iva=jrelim
  88.          if (iva.ne.0) jrelim=itlac4.itlac(abs(iva))
  89.          iva=jrgard
  90.          if (iva.ne.0) jrgard=itlac4.itlac(abs(iva))
  91.          iva=jrtot
  92.          if (iva.ne.0) jrtot =itlac4.itlac(abs(iva))
  93.          iva=imlag
  94.          if (iva.ne.0) imlag =itlac1.itlac(abs(iva))
  95.          SEGDES MRIGID
  96.  
  97.  1202 CONTINUE
  98.  
  99.       RETURN
  100.       END
  101.  
  102.  
  103.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales