Sources Esope | Cast3M

ooomin
C OOOMIN    SOURCE    PV090527  26/04/24    08:23:14     12524          
      SUBROUTINE OOOMIN (LRET,KZ,IS,LSEG)
C--------------------------------------------------------------------
C
C                  G E S T I O N   M E M O I R E
C
C             ATTRIBUER UN BLOC DANS UNE ZONE MEMOIRE
C
C
C   ->LRET  1  PLUS DE PLACE MEMOIRE
C           2  OK
C
C     KZ       TYPE   ZONE MEMOIRE (FIXE OU DYNAMIQUE)
C   ->IS       INDICE DU BLOC ATTRIBUE
C   =>LSEG     DONNEE   : NOMBRE DE MOTS DU BLOC
C              RESULTAT : RENDU MULTIPLE DE MSLSM
C
C PROGRAMMEUR : MOUGIN
C       MODIF : 21/12/88    UN PEU DE NETTOYAGE ...
C
C-----------------------------------------------------------------------
C
%INC IOOADR
%INC IOOADZ
%INC IOOSGM
%INC IOOTRO
%INC IOOTF1
%INC IOOTF2
%INC IOOWCOM
C
C
C****** DEBUT DE LA RECHERCHE
C
      MZJMM(QBESOINPLACE) = MZJMM(QBESOINPLACE)+1
 
C       ARRONDI DE  LSEG  AU MULTIPLE  SUPERIEUR DE  MSLSM
C       SI PLACE TOTALE LIBRE INSUFFISANTE RETOUR
 
C  on sauve la longeur initiale
      LSEGI=LSEG
      LSEG = ((LSEG+(MSLSM-1))/MSLSM)*MSLSM
      IF (LSEG.GT.MZLTROU(IZA,KZ))                     THEN
        LRET = 1
                                                       RETURN
      ENDIF
 
C     INITIALISER LA RECHERCHE AVEC LE TROU DE PROCHAINE ATTRIBUTION
 
 10   IT0  = MZITS0(IZA,KZ)
      IT   = IT0
C
C******  TROU DE LG SUFFISANT : ALGORITHME FIRST FIT
C
      itpa = IT0
      ichain=0
 20   IF (LSEG+MTLT1(IT).GT.0)                         THEN
        CASE , KZ
 
        WHEN , ZMEMFIX
 
          IT = INDICE_TROU_PRECEDENT(IT)
          MZJMM(NTROUSBALAYES)=MZJMM(NTROUSBALAYES)+1
          IF (IT.NE.IT0)                               GO TO 20
 
        WHEN , ZMEMDYN
      ichain=ichain+1
C  PV on met eventuellement a jour le pointeur de prochaine attribution
      if (-MTLT1(ITPA).LT.-MTLT1(it)) then
       itpa=it
**     MZITS0 (IZA,KZ)=itpa
      endif
 
 
          ITS = INDICE_TROU_SUIVANT(IT)
          if (.false.) then
          if (its.lt.it.and.it.ne.it0.and.its.ne.it0) then
*  permuter it et its dans la chaine
          ITP = INDICE_TROU_PRECEDENT(IT)
          ITSS= INDICE_TROU_SUIVANT(ITS)
          INDICE_TROU_PRECEDENT(ITSS)=IT
          INDICE_TROU_SUIVANT(IT)=ITSS
          INDICE_TROU_PRECEDENT(IT)=ITS
          INDICE_TROU_SUIVANT(ITS)=IT
          INDICE_TROU_PRECEDENT(ITS)=ITP
          INDICE_TROU_SUIVANT(ITP)=ITS
          endif
          endif
 
 
          IT=ITS
          MZJMM(NTROUSBALAYES)=MZJMM(NTROUSBALAYES)+1
          IF (ichain.lt.200000.and.IT.NE.IT0)          GOTO 20
**        write(6,*) 'OOOMIN fin de la chaine des trous',ichain
**        write(6,*) 'mzltrou mzlen lseg',
**   >       mzltrou(iza,kz),mzlen(iza),lseg
 
 
 
*           IF (MZLTROU(IZA,KZ).GE.MZLEN(IZA)*0.05.AND.
*    >          MZLTROU(IZA,KZ).GE.LSEG
*    >         .and.ichain.ge.200000)                  THEN
            IF ((MZLTROU(IZA,KZ).GE.MZLEN(IZA)*0.05.or.
     >          ichain.ge.200000).AND.MZLTROU(IZA,KZ).GE.LSEG) then
              IF (TESOOO)                              THEN
                CALL OOOWER ('          OOOMIN => OOOMTA : TASSEMENT')
              ENDIF
*              write(6,*) 'appel OOOMTA dans ooomin'
              CALL OOOMTA (LRET,LSEG)
              IF (TESOOO)                              THEN
                CALL OOOWER ('          OOOMIN &lt;= OOOMTA')
              ENDIF
              IF (LRET.EQ.2)                           GO TO 10
            ENDIF
        ENDCASE
 
        LRET = 1
                                                       RETURN
      ENDIF
 
C******  SI LE TROU CORRESPOND JUSTE A LA DEMANDE,ON LE RETIRE DE LA
C           CHAINE DES TROUS
 
      MZLTROU(IZA,KZ) = MZLTROU(IZA,KZ)-LSEG
      LENT            =      -MTLT1(IT)-LSEG
 
      ITP = INDICE_TROU_PRECEDENT(IT)
      ITS = INDICE_TROU_SUIVANT  (IT)
 
C******  RETIRE LE TROU IT DE LA CHAINE DES TROUS
 
      if(itpa.eq.it) itpa=0
      IF (LENT.EQ.0)                                   THEN
          if(itpa.ne.0) then
            MZITS0(IZA,KZ) = ITPA
          else
            MZITS0(IZA,KZ) = ITS
          endif
        INDICE_TROU_SUIVANT  (ITP)   = ITS
        INDICE_TROU_PRECEDENT(ITS)   = ITP
        INDICE_TROU_PRECEDENT(IT)    = 0
        INDICE_TROU_SUIVANT  (IT)    = 0
        IS = IT
 
C******  ATTRIBUTION A DROITE DANS LE TROU
 
      ELSE
        IF (MZATGD(IZA,KZ).NE.0)                       THEN
          IS = IT+LENT
 
C******  ATTRIBUTION A GAUCHE DANS LE TROU
 
        ELSE
          IS = IT
          INDICE_TROU_PRECEDENT(IT)    = 0
          INDICE_TROU_SUIVANT  (IT)    = 0
          IT = IT+LSEG
          INDICE_TROU_PRECEDENT(IT ) = ITP
          INDICE_TROU_SUIVANT  (IT ) = ITS
          INDICE_TROU_PRECEDENT(ITS) = IT
          INDICE_TROU_SUIVANT  (ITP) = IT
        ENDIF
        MTLT1(IT)     = -LENT
        MTLT2(IT)     = -LENT
 
C******    LE TROU  EST RETENU POUR PROCHAINE ATTRIBUTION
C          SAUF SI ON EST EN EXTENSION OU SI ON EST SUR LA
C          ZONE MEMOIRE DYNAMIQUE FIXE .
C          DANS CE CAS ON FAIT PASSER LE TROU RESULTANT DE LA ZONE
C          FIXE --> DYNAMIQUE
 
        IF   (IT.EQ.MZDLIM(IZA) .AND. KZ.EQ.ZMEMFIX)   THEN
          IF (IT.EQ.MZITS0(IZA,ZMEMFIX))               THEN
                    MZITS0(IZA,ZMEMFIX) = INDICE_TROU_SUIVANT(IT)
          ENDIF
          MTF1 ,  IZA(IT,LENT)
          MZLTROU(IZA,ZMEMFIX)=MZLTROU(IZA,ZMEMFIX)-LSEG
          MTF2 ,  IZA(ZMEMDYN,IT,LENT)
          MZLTROU(IZA,ZMEMDYN)=MZLTROU(IZA,ZMEMDYN)+LSEG
          MZDLIM (IZA)=IS
        ELSE
          if(itpa.ne.0) then
            MZITS0(IZA,KZ) = ITPA
          else
            MZITS0(IZA,KZ) = IT
          endif
        ENDIF
      ENDIF
 
C  PV on pointe sur le plus grand trou dispo pour la prochaine
C  attribution
      it=MZITS0(IZA,KZ)
      if(itpa.ne.0) then
      if (-MTLT1(IT).LT.-MTLT1(itpa)) it=itpa
      endif
      if (-MTLT1(IT).LT.-MTLT1(itp)) it=itp
      if (-MTLT1(IT).LT.-MTLT1(its)) it=its
      MZITS0 (IZA,KZ)=it
 
      MSLS1 (IS) = LSEG
      MSLS2 (IS) = LSEG
C  on met a -1 la zone comprise entre les longeurs initiales et corrigees
C*    DO 30 IP=LSEGI-MSLZ2+1,LSEG-MSLZ2
C*      JSG(IS+IP)=-1
C*30  CONTINUE
C
      LRET       = 2
 
      END