Sources Esope | Cast3M

ooores
C OOORES    SOURCE    PV090527  26/04/24    08:23:19     12524          
      SUBROUTINE OOORES (NTAPE,IREP,IPS)
C--------------------------------------------------------------------
C
C                         RESTAURATION GLOBALE
C
C         ON REIMPLANTE LES SEGMENTS DE DONNEES SAUVEGARDES
C         DANS UN ESPACE ESOPE DEJA INITIALISE EN CONSERVANT LES
C         MEMES VALEURS DE POINTEUR
C
C     NTAPE   SUR LE FICHIER SEQUENTIEL NTAPE
C     IREP    REPERE DE LA SAUVEGARDE
C
C   ->IPS POINTEUR DE REPRISE (PERMET DE RETROUVER TOUS LES SEGMENTS
C
C 18 FEVRIER 86 - ERREUR TROUVEE PAR MIREILLE BOULET (CENG GRENOBLE)
C                 LORS DE LA SUPRESSION DES  SEGMENTS  EXISTANTS  AU
C                 MOMENT DE LA REPRISE , ON NE DISTINGUAIT PAS ENTRE
C                 SUPRESSION D'UN  MARQUEUR  DE  SUPER SEGMENT ET LA
C                 SUPRESSION D'UN SEGMENT ORDINAIRE .
C
C PROGRAMMEUR : MOUGIN
C       MODIF : 03/11/88    CALL OOOXXX ... => SEGXXX ...
C       MODIF : 03/01/89    SUPPRIMER L'ARGUMENT  LRET  DU CALL OOOSUS
C       MODIF : 03/01/89    SUPPRIMER L'ARGUMENT  IRET  DU CALL OOODEX
C
C---------------------------------------------------------------------
C
%INC IOOSRE
%INC IOOADR
%INC IOOADZ
%INC IOODES
%INC IOOSGM
%INC IOOVAL
      SEGMENT , IP
        INTEGER III(LS5-1)
      ENDSEGMENT
C
C****** INIT ZONE DE CONTROLE-->7 MOTS
C
      INTEGER IREC (8)
      DATA    IREC /8*0/
C
C****** SUPPRIMER TOUS LES SEGMENTS SAUF :
C
C        - LE SEGMENT DES DESCRIPTEURS
C        - LES MAP DE DEBORDEMENT MEMOIRE
C
C****** INITIALISATION
      IF (MZPBUF.EQ.0)                                 THEN
       IDX=MZIDEX
      ELSE
       IDX=MZPBUF+MDLDE
      ENDIF
      IDY=MZIDEY
C       ESPACE ESOPE JUSTE APRES INIT
      IF (MZIDEY.GE.MZIDEX)                            THEN
        LDDE=MDLDE
        DO     IDE=IDX,IDY,LDDE
          IF (MDIDS(IDE).GE.0)                         THEN
            IP   = IDE
            ITYP = MDTYP(IDE)
 
C           MARQUEUR SUPER SEGMENT ?
 
            IF (MDCAT(ITYP).EQ.MDMARK)                 THEN
              CALL OOOSUS (IP)
            ELSE
              SEGSUP , IP
            ENDIF
          ENDIF
        ENDDO
      ENDIF
C
C****** POSITIONNEMENT SUR LE FICHIER (ENR TYPE 1)
C
 110    READ (NTAPE,END=901) IREC
        IF (MIREPSVGDE.NE.IREP)                        GO TO 110
        IF (MITYPSVGDE.NE.1)                           GO TO 110
C
C****** ADAPTER LA TAILLE DU SEGMENT DES DESCRIPTEURS
C
C       REINIT MZIDEY :
      MZIDEY=IDX-MDLDE
C       EVALUE LE NOMBRE DE SEGMENTS A RESTAURER ET LE NOMBRE DE SEGMENT
C        POTENTIEL DU SEGMENT DESCRIPTEUR AU MOMENT DE LA RESTAURATION
      NDE  =(IDY-IDX)/MDLDE+1
      NSEG =MNSEGSVGDE
      IF (NSEG.GT.NDE)                                 THEN
        NDDE=NSEG-NDE
      ELSE
        NDDE=0
      ENDIF
      CALL OOODEX (LRET,NDDE)
      IF (LRET.EQ.1)                                   GO TO 904
C         IDE1P=DESCRIPTEUR PRECEDENT LA TETE DE CHAINE DES DESCRIPTEURS
C          LIBRES
      IDE1P=MZIDEY
C
C****** RESTAURER LES SEGMENTS
C
 120    READ (NTAPE,END=902) IREC
        IF (MIREPSVGDE.NE.IREP)                        GO TO 903
C        RESTAURER LONGUEUR ET POINTEUR DU SEGMENT
        IF (MITYPSVGDE.NE.2)                           GO TO 130
        LS5=MLSEGSVGDE
        IP =MIPSVGDE
        IDE=IP
C         CONTROLE DE VRAISEMBLANCE DE L'INDICE
        IF (IDE.LT.MZIDEX)                             GO TO 903
        IF (IDE.GT.MZIDEY)                             GO TO 903
C         ON PLACE LE DESCRIPTEUR IDE DERRIERE LA TETE DE CHAINE DES
C          DES DESCRIPTEURS LIBRES : IL SERA ATTRIBUE LORS DU SEGINI
C          LES DESCRIPTEURS INTERMEDIAIRES SONT PLACES EN QUEUE DE
C          CHAINE .
C         COMME LES SEGMENTS SONT SAUVEGARDES DANS L'ORDRE DU SEGMENT
C          DES DESCRIPTEURS,ON PARCOURERA AU MAXIMUM UNE FOIS LA CHAINE
C          DES DESCRIPTEURS LIBRES.
 125    IDE1S=-MDIDS(MZIDE1)
        IF (IDE1S.NE.IDE)                              THEN
          MDIDS(MZIDE1)=MDIDS(IDE1S)
          MDIDS(IDE1P) =-IDE1S
          MDIDS(IDE1S) =-MZIDE1
          IDE1P=IDE1S
                                                       GO TO 125
        ENDIF
C
CISI    CALL OOOYIN (LRET,0,IP,LS5)
        SEGINI , IP
        IS4=MDISG(IDE)+MSLZ1
C         LECTURE D'UN ENR LG VARIABLE
        READ  (NTAPE,END=902) IREC,(JSG(IS4+I),I=1,LS5)
        NDES=LMOD-1
CISI    CALL OOOYDE (LRET,0,IP,NDES)
        SEGDES , IP
                                                       GO TO 120
C
C****** DERNIER ENREGISTREMENT
C
 130  IF (MITYPSVGDE.NE.3)                             GO TO 903
      IPS=MIPSVGDE
                                                       RETURN
C
C****** DIAGNOSTIQUES
C
 901  CALL OOOERR (0,0,'OOORES : SAUVEGARDE NON TROUVEE')
                                                       GO TO 950
 902  CALL OOOERR (0,0,'OOORES : SAUVEGARDE INCOMPLETE')
                                                       GO TO 950
 903  CALL OOOERR (0,0,'OOORES : SAUVEGARDE INCOHERENTE')
                                                       GO TO 950
 904  CALL OOOERR (0,0,'OOORES : PAS ASSEZ DE PLACE MEMOIRE')
                                                       GO TO 950
 950                                                   STOP 16
      END