Sources Esope | Cast3M

oooact
C OOOACT    SOURCE    PV090527  26/04/24    08:22:58     12524          
      SUBROUTINE OOOACT (LRET,PSEG,KOD)
C--------------------------------------------------------------------
C
C                       SEGACT /ERR=100/ PSEG
C
C   ->LRET  1  PLUS DE PLACE MEMOIRE
C           2  OK
C
C     PSEG     POINTEUR DESIGNANT LE SEGMENT A ACTIVER
C     KOD      1 => SEGACT EN *NOMOD
C              0 => SEGACT EN *MOD
C
C PROGRAMMEUR : MOUGIN
C        CREE : 15/12/88    POUR LA FAMILLE  OOOW..
C       MODIF : 17/01/89    UTILISER LE  OOOMRD  SIMPLIFIE
C
C--------------------------------------------------------------------
C
%INC IOOADR
%INC IOOADZ
%INC IOODES
%INC IOOSGM
%INC IOOWCOM
%INC IOOUNIT
      character*4 hval
      save imod
      data imod/0/
      POINTEUR PSEG.PSEG
       if (imod.eq.0) then
         call oooprm(LRET1,'MOD',HVAL,LVAL,IVAL)
         if (lret1.eq.4.AND.LVAL.EQ.4) then
           if (hval(1:4).eq.'FAUX') imod=-1
         endif
         if (imod.eq.0) imod=1
       endif
      nth=0
      if (thread) nth=oothrd
** si segment deja en lecture on ne fait rien
      if((mdro1(pseg).ne.0.or.mdro2(pseg).ne.0).and.mdrw(pseg).eq.0
     >   .and.ibits(kod,0,18).eq.1.and.imod.eq.1) goto 100
 
C     verif queue de desactivation
      call ooodeq(nth)
C     verif queue de suppression
       call ooosuq(nth)
C
C****** SEGMENT EN ZONE DE DEBORDEMENT ? :ON LE RAPPELLE EN MEMOIRE
C
      ITYP = MDTYP(PSEG)
      IF (MDDISK(ITYP).EQ.MDDISQUE)                     THEN
        IF (TESOOO) CALL OOOWER ('OOOACT => OOOMRD')
        CALL OOOMRD (LRET,PSEG)
        IF (TESOOO) CALL OOOWER ('OOOACT &lt;= OOOMRD')
        IF (LRET.EQ.1)                                  RETURN
      ENDIF
C
C****** SEGMENT EN MEMOIRE :
C
C                CHANGEMENT DE CHAINE DU SEGMENT
C                CHARGEMENT DU NOUVEAU TYPE SEGMENT
C
C                    SI COMPOSANT D'UN SUPER SEGMENT :
C
C                MISE A JOUR DE L'ETAT DU SUPER SEGMENT
C                CHANGEMENT DE CHAINE DU MARQUEUR :
C                         - SI COMPOSANT INACTIF D'UN SUPER SEGMENT
C                         - SI SUPER SEGMENT DEVIENT ACTIF
C
      ITYP  = MDTYP(PSEG)
      IETAT = MDETAT(ITYP)
      ICAT  = MDCAT(ITYP)
C
      IF (ICAT.EQ.MDISOLE) THEN
         IDEA = MDACHN(ACTIF)
      ELSE
         IDMK = MDMK(PSEG)
         IF (IDMK.LT.MZIDEX)                            GO TO 901
         IF (IDMK.GT.MZIDEY)                            GO TO 901
         IF (MOD(IDMK-MZIDE1,MDLDE).NE.0)               GO TO 901
         IF (MDCAT(MDTYP(IDMK)).NE.MDMARK)              GO TO 901
         ISMK   = MDISG(IDMK)
         ITYPMK = MDTYP(IDMK)
C
         ISTAT=MSMKISS(ITYP)
         MSMKSTAT(ISMK,ISTAT)   = MSMKSTAT(ISMK,ISTAT)-1
         MSMKSTAT(ISMK,STACTIF) = MSMKSTAT(ISMK,STACTIF)+1
C
         IF (S S ACTIF(ISMK)) THEN
           IDEA=MDACHN(ACTIF)
           MDCHN , IDEA(IDMK)
           MDETAT(ITYPMK)=MDACT
           MDQUEU(ITYPMK)=0
           MDTYP(IDMK)=ITYPMK
           MZJSS(ACTACTIF)=MZJSS(ACTACTIF)+1
           MZJSS(MAXACTIF)=MAX0(MZJSS(MAXACTIF),MZJSS(ACTACTIF))
           MZJSM(ACTACTIF)=MZJSM(ACTACTIF)+(MSLMARK)
           MZJSM(MAXACTIF)=MAX0(MZJSM(MAXACTIF),MZJSM(ACTACTIF))
         ELSE IF (IETAT.EQ.MDINACT) THEN
           IDEA  = MDACHN(LRU)
           MDCHN , IDEA(IDMK)
         ENDIF
 
         IDEA = MDACHN(CACTIF)
 
      ENDIF
C
      MDCHN , IDEA(PSEG)
      MDTYP(PSEG)=MDLTYP(ICAT,MDMEM,MDACT,0,MDNBUF)
C
C****** MISE A JOUR DES STATISTIQUES
C
      ISEG = MDISG(PSEG)
      LSEG = MSLS1(ISEG)
      IF (IETAT.EQ.MDINACT)                            THEN
        MZJSS(LUACT) = MZJSS(LUACT)+1
        MZJSM(LUACT) = MZJSM(LUACT)+LSEG
      ENDIF
      IF (IETAT.NE.MDACT)                              THEN
        MZJSS(ACTACTIF) =     MZJSS(ACTACTIF)+1
        MZJSS(MAXACTIF) = MAX(MZJSS(ACTACTIF),MZJSS(MAXACTIF))
        MZJSM(ACTACTIF) =     MZJSM(ACTACTIF)+LSEG
        MZJSM(MAXACTIF) = MAX(MZJSM(ACTACTIF),MZJSM(MAXACTIF))
      ENDIF
C
C******  CONTROLE DE VRAISEMBLANCE DES ZONES GEREES PAR GEMAUX
C            A L'INTERIEUR DU SGM ET DUMP SEGMENT
      CALL OOODMS (PSEG,1)
      IDG=0
      IF (MSIDE(ISEG).NE.PSEG) IDG=IDG+1
      IF (MSLS2(ISEG).NE.LSEG) IDG=IDG+2
      IF (IDG.NE.0)                                    GO TO 902
      MDISG(PSEG) = ISEG
      IF (ibits(KOD,0,18).EQ.1) THEN
       if (imod.eq.1) then
        METTRE CE SEGMENT EN READ ONLY (PSEG) = PSEG
       endif
      ELSE
       if (pseg.eq.0) then
         write (JLST,*) ' 2 pseg 0 dans oooact '
C         write (JERR,*) ' 2 pseg 0 dans oooact '
         stop 16
       endif
 
 
        IF (ICAT.EQ.MDISOLE)                              THEN
           ITRK   = MDTRK(PSEG)
           if (itrk.ne.0) CALL OOODLB (MZPTRK,ITRK)
           MDTRK(PSEG)   = 0
        ELSE
           ITRK = MDTRK(IDMK)
           IF (ITRK.GT.0) CALL OOODLB (MZPTRK,ITRK)
           MDTRK(IDMK)   = 0
        ENDIF
      ENDIF
 100  continue
      LRET = 2
C  notre numero de thread dans mdrw
      if (ibits(KOD,0,18).ne.1.or.imod.ne.1) mdrw(pseg)=nth+1
      if(nth.lt.64) mdro1(pseg)=ibset(mdro1(pseg),nth)
      if(nth.ge.64) mdro2(pseg)=ibset(mdro2(pseg),nth-64)
                                                       RETURN
C-----------------------------------------------------------------------
C
C                        MESSAGES D'ERREUR
C
 901  CALL OOOERR (IDMK,-1,'SUPER SEGMENT INCOHERENT')
                                                       GO TO 950
 902  CALL OOOERR (IDG , 1,'DESTRUCTION MEMOIRE')
                                                       GO TO 950
 950                                                   STOP 16
      END