Sources Esope | Cast3M

ooosup
C OOOSUP    SOURCE    PV090527  26/04/24    08:23:22     12524          
      SUBROUTINE OOOSUP (LRET,PSEG,KOD)
C--------------------------------------------------------------------
C
C                             SEGSUP , PSEG
C
C   ->LRET  1  PLUS DE PLACE MEMOIRE
C           2  OK
C
C   =>PSEG     POINTEUR DESIGNANT LE SEGMENT A SUPPRIMER
C              REMIS A ZERO EN SORTIE .
C
C PROGRAMMEUR : MOUGIN
C       MODIF : 03/01/89    SUPPRIMER L'ARGUMENT  LRET  DU CALL OOOSUG
C       MODIF : 03/01/89    SUPPRIMER L'ARGUMENT  LRET  DU CALL OOOSUS
C       MODIF : 17/01/89    SUPPRIMER L'ARGUMENT  LRET  DU CALL OOODLB
C       MODIF : 17/01/89    SUPPRIMER L'ARGUMENT  IRET  DU CALL OOOMRD
C
C---------------------------------------------------------------------
C
%INC IOOADR
%INC IOOADZ
%INC IOODES
%INC IOOSGM
%INC IOOWCOM
%INC IOOUNIT
      POINTEUR PSEG.PSEG,psegs.pseg
C
C****** COMPOSANT D'UN SUPER SEGMENT ?
C          EN ZONE DE DEBORDEMENT --> RAMENE EN MEMOIRE
C          EN MEMOIRE --> ON ECLATE LE SUPER SEGMENT
C
      psegs=pseg
      IF (PSEG.NE.0)                                   THEN
 100    ITYP = MDTYP(PSEG)
        ITRK = MDTRK(PSEG)
        IF   (MDCAT (ITYP).EQ.MDBLOCK)                 THEN
          IF (MDDISK(ITYP).EQ.MDDISQUE)                THEN
            IF (TESOOO) CALL OOOWER ('OOOSUP => OOOMRD')
            CALL OOOMRD (LRET,PSEG)
            IF (TESOOO) CALL OOOWER ('OOOSUP &lt;= OOOMRD')
            IF (LRET.EQ.1)                             RETURN
          ELSE
            IF (TESOOO) CALL OOOWER ('OOOSUP => OOOSUS')
            CALL OOOSUS (MDMK(PSEG))
            IF (TESOOO) CALL OOOWER ('OOOSUP &lt;= OOOSUS')
          ENDIF
                                                       GO TO 100
        ENDIF
C
C****** SEGMENT ISOLE :
C
C                       MISE A JOUR DES STATISTIQUES SI ACTIF
C                       LIBERE LA PLACE DISQUE
        IF (MDDISK(ITYP).EQ.MDMEM)                     THEN
          LSEG =MSLS1(MDISG(PSEG))
          IF (MDETAT(ITYP).EQ.MDACT)                   THEN
            MZJSS(ACTACTIF)=MZJSS(ACTACTIF)-1
            MZJSM(ACTACTIF)=MZJSM(ACTACTIF)-LSEG
          ENDIF
          CALL OOOSUG (PSEG)
        ELSE
          LSEG          = MDLEN(PSEG)
          MDZERO(PSEG)  = 0
          MDIDS (PSEG)  = MDIDS(MZIDE1)
          MDIDP(-(MDIDS(MZIDE1)))= -PSEG
          MDIDS(MZIDE1) = -PSEG
          MDIDP(PSEG) = -MZIDE1
        ENDIF
        IF (ITRK.GT.0) CALL OOODLB (MZPTRK,ITRK)
C
        MZJSS(ACTUEL)=MZJSS(ACTUEL)-1
        MZJSM(ACTUEL)=MZJSM(ACTUEL)-LSEG
 
C       signaler qu'on libere le segment
        mdrw(psegs)=0
        mdro1(psegs)=0
        mdro2(psegs)=0
        if (psegs.le.0) write (JLST,*) ' ooowac 1 psegs ',psegs
        if (mdco(psegs).ne.0) then
          call ooocdt(mdco(psegs))
          mdco(psegs)=0
        endif
        if (psegs.le.0) write (JLST,*) ' ooowac 2 psegs ',psegs
        PSEG = 0
      ENDIF
 
      LRET = 2
 
      END