Sources Esope | Cast3M

rest
C REST      SOURCE    CB215821  20/11/25    13:39:08     10792          
      SUBROUTINE REST
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
C=======================================================================
C      DIRECTIVE RESTITUER
C      ----------------
C
C
C    BUT: LECTURE ET RESTAURATION DES OBJETS NOMMES ET DE CEUX QU ILS
C         SOUS-TENDENT,   SUR LE FICHIER IORES
C         IORESSAU EST DEFINI PAR:   OPTIO RESTSAUV IORESSAU ;
C
C
C         ON SAIT RESTITUER LES OBJETS DONT LE TYPE EST CONTENU
C         DANS LE SP TYPFIL
C
C       APPELLE TYPFIL CREPIL LIPIL
C       ECRIT    PAR FARVACQUE
C       REPRIS   PAR LENA
C ---------------------------------------------------------------------
C=======================================================================
-INC TMCOLAC
 
-INC PPARAM
-INC CCOPTIO
-INC CCFXDR
C
C
      CHARACTER*8 ITYPE
      CHARACTER*72 LABEL
      CHARACTER*4 MOFORM(2)
      DATA MOFORM/'FORM','LABE'/
C
      IFORM=0
      ISTOPR=1000000
      LABEL= ' '
    1 CONTINUE
      CALL LIRMOT(MOFORM,2,IRET,0)
      IF(IRET.EQ.1) THEN
        IFORM=1
        if(irefor.ne.iform) then
         call erreur(21)
         return
        endif
        GO TO 1
      ELSEIF(IRET.EQ.2) THEN
        CALL LIRCHA ( LABEL,1,IRETOU)
        IF(IERR.NE.0) RETURN
        IF( LABEL(1:5).EQ.'AUTO ') THEN
          LABEL='LABEL AUTOMATIQUE :'
          CALL LIRENT (ILABAU,1,IRETOU)
          IF(IERR.NE.0) RETURN
          WRITE(LABEL(20:23),FMT='(I4)') ILABAU
        ENDIF
        GO TO 1
      ENDIF
      iform=irefor
*     write (6,*) ' iformx dans rest ',iformx
      if (iformx.eq.2) iform=2
C
C  **** ICOLAC EST INITIALISEE DANS CREPIL
      ITYPE='        '
      K=-1
      CALL TYPFIL( ITYPE,K)
      NITLAC=-K
      CALL CREPIL(ICOLAC,NITLAC)
CCC   IF (IIMPI.EQ.5)WRITE (IOIMP,801) NITLAC
 801  FORMAT(' NOMBRE DE PILES CREEES : ',I5)
C-------------------------------------------------------------
      if (iform.ne.2) REWIND IORES
*     if (iform.eq.2) ios=IXDRREWIND( ixdrw )
C  *** LECTURE  SUR LE FICHIER DE RESTAURATION
C ---  LECTURE DES PILES
      IFIN=0
      IRET=0
      ISNIV=IONIVE
      CALL LIPIL  (ICOLAC,IFIN,IRET,IFORM,LABEL)
      IF (IRET.NE.0) GO TO 5000
      IF (IIMPI.EQ.5)WRITE (IOIMP,805)
 805  FORMAT(' RESTAURATION  EFFECTUEE ')
C --- IMPRESSIONS INTERMEDIAIRES DES PILES
      IVOULU=0
C-------------------------------------------------------------
C ---  RESTAURATION DES POINTEURS
      CALL RESTPI (ICOLAC)
      IF (IIMPI.EQ.5)WRITE (IOIMP,806)
 806  FORMAT(' RESTAURATION  DES POINTEURS EFFECTUEE ')
* fusion des éventuels doubles multiplicateurs de L
      IF (IONIVE.LE.15) CALL DBBSUP(ICOLAC)
C-------------------------------------------------------------
      CALL ERREUR(-277)
C MODI N.BLAY LE 17/09/91 COHERENCE AVEC SAUV-----------------
      if (iform.ne.2) REWIND IORES
      if (iform.eq.2) ios=IXDRREWIND( ixdrr )
 1000 CONTINUE
C --- SUPPRESSION DES PILES (IVOULU=0)
      IVOULU=10000
      CALL SUPPIL (ICOLAC,IVOULU)
      IF (IIMPI.EQ.5)WRITE (IOIMP,807)
 807  FORMAT(' SUPPRESSION  DES PILES EFFECTUEE ')
*  on ne sait pas sauver en dessous de 16 a cause des mult de L
      IONIVE=max(ISNIV,16)
      GO TO 11
C-------------------------------------------------------------
 5000 CONTINUE
      CALL ERREUR(559)
      GO TO 1000
  11  RETURN
      END