Sources Esope | Cast3M

oooxtr
C OOOXTR    SOURCE    PV090527  26/04/24    08:23:35     12524          
      SUBROUTINE OOOXTR (PSEG,LSEG)
C-------------------------------------------------------------------
C
C               R E D U C T I O N  D'U N  S E G M E N T
C
C
C     PSEG      POINTEUR SUR LE SEGMENT
C     LSEG      NOMBRE DE MOTS DE DONNEES DU SEGMENT REDUIT
C
C PROGRAMMEUR : MOUGIN
C       MODIF : 16/11/88    RETIRER L'ARGUMENT LRET DU CALL OOOMSU
C       MODIF : 03/01/89    RETIRER L'ARGUMENT LRET DU CALL OOOSUS
C       MODIF : 27/01/89    IPP=>PSEG  L=>LSEG ET CALL OOOVPN
C
C-------------------------------------------------------------------
C
%INC IOOADR
%INC IOOADZ
%INC IOODES
%INC IOOSGM
%INC IOOTRO
 
      POINTEUR PSEG.PSEG
C
      IDE   = PSEG
      ITYP  = MDTYP(IDE)
      ICAT  = MDCAT(ITYP)
      IETAT = MDETAT(ITYP)
      IF (IETAT.NE.MDACT)                              GO TO 901
C
C****** LONGUEUR DE DONNEES ACTUELLE DU SEGMENT
C
      ISG=MDISG(IDE)
      LSG=MSLS1(ISG)
      LSS=LSG-MSLCZ
         LSEG = ((LSEG+(MSLSM-1))/MSLSM)*MSLSM
C
      IF (LSS.LE.LSEG .OR. (LSS-MSLSM).LE.LSEG)        RETURN
C
      IF (ICAT.EQ.MDBLOCK)                             THEN
        CALL OOOSUS (MDMK(IDE))
      ENDIF
C
C******  REDUCTION NECESSAIRE
 
C
         LT=LSS-LSEG
         CALL OOOZMR (JSG(ISG+MSLZ1+LSEG+1),LT)
         MZJMM(QXFNRAZ)=MZJMM(QXFNRAZ)+LT
C         RECONSTRUCTION DU MOT DE CONTROLE DE QUEUE DU SEGMENT
C          ET INSERTION DU TROU
         LSX=LSG
         LSG=(LSEG+MSLCZ+(MSLSM-1))/MSLSM*MSLSM
         MSLS1(ISG) = LSG
         MSLS2(ISG) = LSG
         MSIDE(ISG) = IDE
         IT  = ISG+LSG
         LT  = LSX-LSG
         LSE = -LT
         CALL OOOMSU (IZA,IT,LT)
C
C****** FIN DE REDUCTION
C
      MZJSM(ACTUEL)=MZJSM(ACTUEL)+LSE
      MZJSM(DEF)=MAX0(MZJSM(DEF),MZJSM(ACTUEL))
      MZJSM(ACTACTIF)=MZJSM(ACTACTIF)+LSE
      MZJSM(MAXACTIF)=MAX0(MZJSM(MAXACTIF),MZJSM(ACTACTIF))
      IF (ICAT.EQ.MDFIXE) THEN
        MZQCHN(FIXE)=MZQCHN(FIXE)+LSE
      ELSE
        MZQCHN(ACTIF)=MZQCHN(ACTIF)+LSE
      ENDIF
                                                       RETURN
C-----------------------------------------------------------------------
C
C                        MESSAGES D'ERREUR
C
 901  CALL OOOERR (IDE ,-1,'SEGMENT NON ACTIF ')
                                                       STOP 16
      END