Télécharger ooosav.eso

Retour à la liste

ooosav
C OOOSAV    SOURCE    PV090527  26/04/24    08:23:20     12524          
      SUBROUTINE OOOSAV (NTAPE,IREP,IPS)
C--------------------------------------------------------------------
C
C                          SAUVEGARDE GLOBALE
C
C     NTAPE   SUR LE FICHIER SEQUENTIEL NTAPE
C     IREP    REPERE DE LA SAUVEGARDE
C     IPS     POINTEUR DE REPRISE ( POUR RETROUVER TOUS LES SEGMENTS )
C
C 18 FEVRIER 86 - ERREUR TROUVEE PAR MIREILLE BOULET (CENG GRENOBLE)
C                 LE DEUXIEME ARGUMENT IDE DU CALL OOOSUS (LRET,IDE)
C                 EST REMIS A ZERO PAR OOOSUS , MAIS  IDE  EST AUSSI
C                 L'INDICE DE LA BOUCLE . LA CORRECTION PROPOSEE PAR
C                 MIREILLE BOULET : REMPLACER  IDE  PAR  IP .
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 : 17/01/89    SUPPRIMER L'ARGUMENT  IRET  DU CALL OOOMRD
C
C---------------------------------------------------------------------
C
%INC IOOSRE
%INC IOOADR
%INC IOOADZ
%INC IOODES
%INC IOOSGM
%INC IOOVAL
%INC IOOUNIT
      POINTEUR IP.IP
C
C****** INIT ZONE DE CONTROLE-->7 MOTS
C
      INTEGER IREC (8)
      DATA    IREC /8*0/
C
C****** INITIALISATION
C        SI DEBORDEMENT DISQUE LES SEGMENTS CORRESPONDANTS NE SONT PAS
C         SAUVEGARDES
      IF (MZPBUF.EQ.0)                                 THEN
        IDX=MZIDEX
      ELSE
        IDX=MZPBUF+MDLDE
      ENDIF
      IDY=MZIDEY
      LDDE=MDLDE
      NSGM=(IDY-IDX)/MDLDE+1
C
C****** PRESENCE DE SEGMENTS FIXES ?
C
      IDFIX=MDACHN(FIXE)
      IF (MSIDS(MDISG(IDFIX)).NE.IDFIX)                GO TO 901
C
C****** DESACTIVER TOUS LES SEGMENTS
C
      DO    IDE=IDX,IDY,LDDE
        ITYP=MDTYP(IDE)
C         DESCRIPTEUR LIBRE?
        IF (MDIDS(IDE).GE.0 )                          THEN
C         DESCRIPTEUR ACTIF?
          IF (MDETAT(ITYP).EQ.MDACT .AND. MDCAT(ITYP).NE.MDMARK ) THEN
CISI        NDES=LMOD-1
            IP  =IDE
CISI        CALL OOOYDE (LRET,0,IP,NDES)
            SEGDES , IP
          ENDIF
        ENDIF
      ENDDO
C
C******* PREMIER ENREGISTREMENT:INFO DE CONTROLE DE LA SVGDE
C
      MLENRSVGDE=7
      MIREPSVGDE=IREP
      MITYPSVGDE=1
      MNSEGSVGDE=NSGM
      MNVERSVGDE=OOOVAL(GO,NUMVERSION)
      WRITE (NTAPE) IREC
C
C****** ENREGISTREMENTS DE SAUVEGARDE DES SEGMENTS (TYPE 2)
C
      MITYPSVGDE=2
C       TRAITE TOUT LES DESCRIPT. DU SGM DES DESCRIPTEURS
      DO 40 IDE=IDX,IDY,LDDE
C         DESCRIPT. LIBRE?
        IF (MDIDS(IDE).GE.0)  THEN
          IP   =IDE
          ITYP =MDTYP(IDE)
          IQUEU=MDQUEU(ITYP)
C
C       MARQUEUR SUPER SEGMENT ?
C
          IF (MDCAT(ITYP).EQ.MDMARK)                   THEN
C           CALL OOOSUS (IDE)
            CALL OOOSUS (IP)
                                                       GO TO 40
          ENDIF
C
C****** COMPOSANT D'UN SUPER SEGMENT ?
C          EN ZONE DE DEBORDEMENT --> RAMENE EN MEMOIRE
C          EN MEMOIRE --> ON ECLATE LE SUPER SEGMENT
C
          IF   (MDCAT (ITYP).EQ.MDBLOCK)               THEN
            IF (MDDISK(ITYP).EQ.MDDISQUE)              THEN
              CALL OOOMRD (LRET,IDE)
              IF (LRET.EQ.1)                           GO TO 902
            ENDIF
            CALL OOOSUS (MDMK(IDE))
          ENDIF
CISI      CALL OOOYAC (LRET,0,IP,1)
          SEGACT , IP
          IS4=MDISG(IDE)+MSLZ1
          LS5=MSLS1(IS4-MSLZ1)-MSLCZ
C         SVGDE LG DONNEE ET INDICE DESCRIPT
          MLENRSVGDE=7
          MLSEGSVGDE=LS5
          MIPSVGDE  =IP
          WRITE (NTAPE)        IREC
          MLENRSVGDE=7+LS5
          WRITE (NTAPE)        IREC,(JSG(IS4+I),I=1,LS5)
C        DESACTIVATION SANS MODIFS
          IF (IQUEU.EQ.MDLRU)                          THEN
            SEGDES , IP*(NOMOD,LRU)
CISI        NDES=LNOMOD-1
          ELSE
            SEGDES , IP*(NOMOD,MRU)
CISI        NDES=MNOMOD-1
          ENDIF
CISI      CALL OOOYDE (LRET,0,IP,NDES)
        ENDIF
 40   CONTINUE
C
C****** DERNIER ENREGISTREMENT
C
      MLENRSVGDE=7
      MITYPSVGDE=3
      MIPSVGDE  =IPS
      WRITE (NTAPE)            IREC
                                                       RETURN
C---------------------------------------------------------------
C
C                       MESSAGES D'ERREUR
C
 901  CALL OOOERR (0,0,'OOOSAV : PRESENCE DE SEGMENTS FIXES ?')
                                                       GO TO 950
 902  CALL OOOERR (0,0,'OOOSAV : PAS ASSEZ DE PLACE MEMOIRE')
                                                       GO TO 950
 950                                                   STOP 16
      END
 
 

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