Esope source files

   1 : C REST      SOURCE    PV        05/04/13    21:16:59     5073           
   2 :       SUBROUTINE REST
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)
   5 : C=======================================================================
   6 : C      DIRECTIVE RESTITUER
   7 : C      ----------------
   8 : C
   9 : C
  10 : C    BUT: LECTURE ET RESTAURATION DES OBJETS NOMMES ET DE CEUX QU ILS
  11 : C         SOUS-TENDENT,   SUR LE FICHIER IORES
  12 : C         IORESSAU EST DEFINI PAR:   OPTIO RESTSAUV IORESSAU ;
  13 : C
  14 : C
  15 : C         ON SAIT RESTITUER LES OBJETS DONT LE TYPE EST CONTENU
  16 : C         DANS LE SP TYPFIL
  17 : C
  18 : C       APPELLE TYPFIL CREPIL LIPIL
  19 : C       ECRIT    PAR FARVACQUE
  20 : C       REPRIS   PAR LENA
  21 : C ---------------------------------------------------------------------
  22 : C=======================================================================
  23 : -INC TMCOLAC
  24 : -INC CCOPTIO
  25 : -INC CCFXDR
  26 : C
  27 : C
  28 :       CHARACTER*8 ITYPE
  29 :       CHARACTER*72 LABEL
  30 :       CHARACTER*4 MOFORM(2)
  31 :       DATA MOFORM/'FORM','LABE'/
  32 : C
  33 :       IFORM=0
  34 :       ISTOPR=1000000
  35 :       LABEL= ' '
  36 :     1 CONTINUE
  36 :       CALL LIRMOT(MOFORM,2,IRET,0)
  37 :       IF(IRET.EQ.1) THEN
  38 :         IFORM=1
  39 :         if(irefor.ne.iform) then
  39 :          call erreur(21)
  40 :          return
  41 :         endif
  42 :         GO TO 1
  43 :       ELSEIF(IRET.EQ.2) THEN
  43 :         CALL LIRCHA ( LABEL,1,IRETOU)
  44 :         IF(IERR.NE.0) RETURN
  45 :         IF( LABEL(1:5).EQ.'AUTO ') THEN
  46 :           LABEL='LABEL AUTOMATIQUE :'
  46 :           CALL LIRENT (ILABAU,1,IRETOU)
  47 :           IF(IERR.NE.0) RETURN
  48 :           WRITE(LABEL(20:23),FMT='(I4)') ILABAU
  49 :         ENDIF
  50 :         GO TO 1
  51 :       ENDIF
  52 :       iform=irefor
  53 : *     write (6,*) ' iformx dans rest ',iformx
  54 :       if (iformx.eq.2) iform=2 
  55 : C
  56 : C  **** ICOLAC EST INITIALISEE DANS CREPIL
  57 :       ITYPE='        '
  58 :       K=-1
  58 :       CALL TYPFIL( ITYPE,K)
  59 :       NITLAC=-K
  59 :       CALL CREPIL(ICOLAC,NITLAC)
  60 : CCC   IF (IIMPI.EQ.5)WRITE (IOIMP,801) NITLAC
  61 :  801  FORMAT(' NOMBRE DE PILES CREEES : ',I5)
  62 : C-------------------------------------------------------------
  63 :       if (iform.ne.2) REWIND IORES
  64 : *     if (iform.eq.2) ios=IXDRREWIND( ixdrw )
  65 : C  *** LECTURE  SUR LE FICHIER DE RESTAURATION
  66 : C ---  LECTURE DES PILES
  67 :       IFIN=0
  68 :       IRET=0
  69 :       ISNIV=IONIVE
  69 :       CALL LIPIL  (ICOLAC,IFIN,IRET,IFORM,LABEL)
  70 :       IF (IRET.NE.0) GO TO 5000
  71 :       IF (IIMPI.EQ.5)WRITE (IOIMP,805)
  72 :  805  FORMAT(' RESTAURATION  EFFECTUEE ')
  73 : C --- IMPRESSIONS INTERMEDIAIRES DES PILES
  74 :       IVOULU=0
  75 : C-------------------------------------------------------------
  76 : C ---  RESTAURATION DES POINTEURS
  76 :       CALL RESTPI (ICOLAC)
  77 :       IF (IIMPI.EQ.5)WRITE (IOIMP,806)
  78 :  806  FORMAT(' RESTAURATION  DES POINTEURS EFFECTUEE ')
  79 : * fusion des éventuels doubles multiplicateurs de L
  79 :       IF (IONIVE.LE.15) CALL DBBSUP(ICOLAC)
  80 : C-------------------------------------------------------------
  80 :       CALL ERREUR(-277)
  81 : C MODI N.BLAY LE 17/09/91 COHERENCE AVEC SAUV-----------------
  82 :       if (iform.ne.2) REWIND IORES
  83 :       if (iform.eq.2) ios=IXDRREWIND( ixdrr )
  84 :  1000 CONTINUE
  85 : C --- SUPPRESSION DES PILES (IVOULU=0)
  86 :       IVOULU=10000
  86 :       CALL SUPPIL (ICOLAC,IVOULU)
  87 :       IF (IIMPI.EQ.5)WRITE (IOIMP,807)
  88 :  807  FORMAT(' SUPPRESSION  DES PILES EFFECTUEE ')
  89 : *  on ne sait pas sauver en dessous de 16 a cause des mult de L
  90 :       IONIVE=max(ISNIV,16)
  91 :       GO TO 11
  92 : C-------------------------------------------------------------
  93 :  5000 CONTINUE
  93 :       CALL ERREUR(559)
  94 :       GO TO 1000
  95 :   11  RETURN
  96 :       END
  97 :  
  98 :  
  99 :  
 100 :  
 101 :  
 102 : 
 103 : 
 104 :  
 105 :  
 106 :  
 107 :  
 108 :  
 109 :