Sources Esope | Cast3M

menage
C MENAGE    SOURCE    PV090527  23/03/31    21:15:08     11649          
C  SUPPRIMER LES SEGMENTS INDESIRABLES
C
      SUBROUTINE MENAGE(IAUTOM)
*
      IMPLICIT INTEGER(I-N)
      integer iautom
      integer icolac
      integer iplaob, iplaoc
      integer iretou
      integer nomlus
 
-INC PPARAM
-INC CCOPTIO
-INC CCASSIS
-INC CCNOYAU
-INC SMELEME
-INC SMTABLE
-INC SMLENTI
-INC SMCOORD
 
      INTEGER NACTI
      INTEGER NTAACT
      INTEGER MACTIP
      INTEGER MTOTAP
      INTEGER MTOTA
      INTEGER MSEGMP
      INTEGER MACTI
 
      SAVE NACTI
      SAVE NTAACT
      SAVE MACTIP
      SAVE MTOTAP
      SAVE MTOTA
      SAVE MSEGMP
      SAVE MACTI
      data nacti/0/
 
      SEGMENT ITLAC(0)
      INTEGER OOOVAL
*
      CHARACTER*4 CMOT
      REAL*8 XPLTOT
*
       if (nacti.eq.0) then
C  place totale disponible
      XPLTOT=(1.D0*OOOVAL(1,3) * OOOVAL(1,4))/2.D0+OOOVAL(1,1)
      IPLTOT=INT(MIN(XPLTOT,2.D9))
      MTOTA=IPLTOT
         NACTI  = OOOVAL(2,3)
         NTAACT = OOOVAL(3,3)
C     initialisations pour le non menage 
         MACTIP = OOOVAL(3,3)
         MTOTAP = OOOVAL(3,1)
         MSEGMP = OOOVAL(2,1)
         MACTI  = OOOVAL(1,1)
       endif
      segdes mcoord
      cmot=' '
      call lircha(cmot, 0,iretou)
      if( iretou.ne.0) then
        if( cmot .eq.'OBLI')go to 1
        call refus
      endif
C  autres criteres de menage :
        IFMEN=0
C  + de 10% de la memoire active depuis la derniere fois
        MACTIC=OOOVAL(3,3)
        IF (MACTIC-MACTIP.gt.MACTI*0.1) IFMEN=1
C  + de 20% de la memoire totale depuis la derniere fois
        MTOTAC=OOOVAL(3,1)
        IF (MTOTAC-MTOTAP.gt.MTOTA*0.20) IFMEN=2
C  + de 15% de la memoire active en memoire totale depuis la derniere fois
        IF (MTOTAC-MTOTAP.gt.MACTI*0.15) IFMEN=3
C  + de 100000 segments depuis la derniere fois
        MSEGMC=OOOVAL(2,1)
        IF (MSEGMC-MSEGMP.gt.32000*max(1,nbescr))      IFMEN=4
        IF (IFMEN.LE.0) RETURN                     
        if (iimpi.ne.0) write (6,*) 'menage ',ifmen
 
 
 
   1  CONTINUE
*  horodatage
      call ooohor(0)
      SEGDES,IPILOC,mcoord
 
C *   attention aux assistants ....
      if (NBESC.NE.0.and.imestr.ne.0) then
          if (iimpi .eq. 1234)
     &  write(ioimp,*) ' il faut bloquer les assistants'
        mestra=imestr
        SEGACT MESTRA*MOD
          if (iimpi .eq. 1234)
     &  write(ioimp,*) ' assistants en attente'
*  on passe en mode force
         call ooofrc(1)
*       lodesl=.true.
        call setass(1)
      end if
      call oooprl(1)
 
      call chleha(1,0,0,0,0)
 
*  on met NOMLU a 1 pour bloquer le decodage des instructions
      NOMLUS=NOMLU
      nomlu=1
      segini itlac
      call ecrcha('NOOP')
      call tasspo(itlac,icolac,meleme,1,0)
      segdes meleme
*
*  icolac ,cree dans tasspo  pointe sur les piles d'objets accessibles
*
      CALL MENAG5(ICOLAC,0)
*
*  QUELLE PLACE RESTE T'IL MAINTENANT
        IF(IIMPI.NE.0) write(IOIMP,12) mactip,mactic
         MACTIP=OOOVAL(3,3)
         MTOTAP=OOOVAL(3,1)
         MSEGMP=OOOVAL(2,1)
 12   FORMAT( ' place occupée avant apres ',3I14)
*      CALL PLAC
*      CALL LIRENT(IPLRES,1,IRETOU)
*  EST-CE SUFFISANT ??
*      INTERR(1)=IPLRES
*      IF (IPLADE.NE.0.AND.IPLRES.LT.IPLADE) CALL ERREUR(436)
*  restauration de nomlu
      NOMLU=NOMLUS
*  retassement memoire y compris segment actifs
* ??  call ooomta(lret,mtota)
 
C *   attention aux assistants ....
      if (NBESC.NE.0.and.imestr.ne.0) then
C *     il faut liberer le segment de dialogue
        mestra=imestr
*  repasser en mode normal
        call ooofrc(0)
        SEGDES MESTRA
*       lodesl=.false.
        call setass(0)
      end if
C JYY
      SEGDES MCOORD
      segact ipiloc
      call oooprl(0)
      END