Sources Esope | Cast3M

ooomop
C OOOMOP    SOURCE    PV090527  26/04/24    08:23:14     12524          
      SUBROUTINE OOOMOP (LRET)
C-----------------------------------------------------------------
C
C             ALLOCATION DYNAMIQUE DE MEMOIRE POUR  G E M A T
C
C   ->LRET  1  ERREUR OU PAS ASSEZ DE PLACE MEMOIRE
C           2  OK
C
C PROGRAMMEUR : MOUGIN
C       MODIF : 26/01/89    PRISE EN COMPTE DU PARAMETRE  ZERMEM
C
C-----------------------------------------------------------------
C
%INC IOOADR
%INC IOOADZ
%INC IOOSGM
%INC IOOTRO
%INC IOOTF2
%INC IOOUNIT
C
      CHARACTER*16 HPRM
      LOGICAL  ZERMEM, BOERR
C
C     ->LREG     NOMBRE DE MOTS DISPONNIBLE DANS LA REGION
C     ->LBUF     NOMBRE DE MOTS DE LA ZONE BUF
C
C     ->IESO     TELS QUE  :  ( A(IESO+I) , I=1,LESO )
C     ->LESO     PARCOURT LA ZONE MEMOIRE ATTRIBUEE A GEMAT .
C     ->MZLB     NOMBRE DE MOTS LAISSES LIBRES (Pour le systeme).
C
      CALL OOOZZA (LREG)
      IF (LREG.LE.0)                                  GOTO 901
      LBUF=0
      LESO=LREG
      MZLB=0
 
      LBASE = 1
%IF UNIX32,WIN32
      LBASE = 4
%ENDIF
%IF UNIX64,WIN64
      LBASE = 8
%ENDIF
C
      BOERR=.FALSE.
      CALL OOOPRM (LRET1,'ESOPE',HPRM,LPRM,LESO)
      IF (LRET1 .NE. 3) THEN
        IF    (HPRM(LPRM-1:LPRM).EQ.'MO')THEN
          READ(HPRM(1:LPRM-2),*,ERR=101,IOSTAT=IOSTA1) LESO
          IF(IOSTA1 .NE. 0) BOERR = .TRUE.
          GOTO 102
 101      CONTINUE
          BOERR = .TRUE.
 102      CONTINUE
          IF (BOERR) THEN
            LESO=LREG
          ELSE
            LESO=(LESO*1024/LBASE)*1024
          ENDIF
 
        ELSEIF(HPRM(LPRM-1:LPRM).EQ.'GO')THEN
          READ(HPRM(1:LPRM-2),*,ERR=111,IOSTAT=IOSTA1) LESO
          IF(IOSTA1 .NE. 0) GOTO 111
          GOTO 112
 111      CONTINUE
          BOERR = .TRUE.
 112      CONTINUE
          IF (BOERR) THEN
            LESO=LREG
          ELSE
            LESO=(LESO*1024/LBASE)*1024*1024
          ENDIF
 
        ELSEIF(HPRM(LPRM:LPRM).EQ.'%')THEN
          READ(HPRM(1:LPRM-1),*,ERR=121,IOSTAT=IOSTA1) LESO
          IF(IOSTA1 .NE. 0) GOTO 121
          GOTO 122
 121      CONTINUE
          BOERR = .TRUE.
 122      CONTINUE
          IF (BOERR) THEN
            LESO=LREG
          ELSE
            LESO=LREG/100*LESO
          ENDIF
 
        ELSE
          LESO=LREG
        ENDIF
      ENDIF
      LASKED=LESO
 
      IF (LESO.GT.LREG) THEN
        WRITE(JLST,*) ' ESOPE VALEUR MAX=',LREG
        LESO = LREG
      ELSEIF(LESO .LT. 0   )THEN
        WRITE(JLST,*) ' ESOPE VALEUR NEGATIVE...=',LESO
        LESO = LREG
      ENDIF
C
      BOERR=.FALSE.
      CALL OOOPRM (LRET3,'LIBRE',HPRM,LPRM,MZLB)
      IF (LRET3 .NE. 3) THEN
        IF    (HPRM(LPRM-1:LPRM).EQ.'MO')THEN
          READ(HPRM(1:LPRM-2),*,ERR=201,IOSTAT=IOSTA1) MZLB
          IF(IOSTA1 .NE. 0) GOTO 201
          GOTO 202
 201      CONTINUE
          BOERR = .TRUE.
 202      CONTINUE
          IF (BOERR) THEN
            MZLB=0
          ELSE
            MZLB=(MZLB*1024/LBASE)*1024
          ENDIF
 
        ELSEIF(HPRM(LPRM-1:LPRM).EQ.'GO')THEN
          READ(HPRM(1:LPRM-2),*,ERR=211,IOSTAT=IOSTA1) MZLB
          IF(IOSTA1 .NE. 0) GOTO 211
          GOTO 212
 211      CONTINUE
          BOERR = .TRUE.
 212      CONTINUE
          IF (BOERR) THEN
            MZLB=0
          ELSE
            MZLB=(MZLB*1024/LBASE)*1024*1024
          ENDIF
 
        ELSEIF(HPRM(LPRM:LPRM).EQ.'%')THEN
          READ(HPRM(1:LPRM-1),*,ERR=221,IOSTAT=IOSTA1) MZLB
          IF(IOSTA1 .NE. 0) GOTO 221
          GOTO 222
 221      CONTINUE
          BOERR = .TRUE.
 222      CONTINUE
          IF (BOERR) THEN
            MZLB=0
          ELSE
            MZLB=LREG/100*MZLB
          ENDIF
 
        ELSE
          MZLB=0
        ENDIF
      ENDIF
 
      IF    (MZLB .GE. LREG) THEN
        WRITE(JLST,*) ' LIBRE VALEUR MAX=',LREG
        MZLB = 0
      ELSEIF(MZLB .LT. 0   )THEN
        WRITE(JLST,*) ' LIBRE VALEUR NEGATIVE...=',MZLB
        MZLB = 0
      ENDIF
 
C     *********************************
C     ****** RESERVATION MEMOIRE ******
C     *********************************
      CALL OOOZZB (LRET,IESO,LREG,LESO,MZLB)
      IF (LRET.EQ.1)                                  GOTO 903
C-----------------------------------------------------------------------
C
C                 A PARTIR DE IESO ET LESO , CALCULER
C                 IZA  ET  LZA  MULTIPLES DE    MSLSM
C
C   ->IZA    TEL QUE : JZZ(IZA+I),I=1,LZA  PARCOURT LA ZONE
C   ->LZA    NOMBRE DE MOTS DE LA ZONE ESOPE
C
C
      IZA=((IESO+MSLSM-1)/MSLSM)*MSLSM
      LZA=((IESO+LESO   )/MSLSM)*MSLSM-IZA
      IF (IZA.LT.0) IZA=IZA-MSLSM
      IF (LZA.LT.256*MSLSM)                            GOTO 903
C
C                  REMISE A ZERO DE LA ZONE ESOPE
C               SAUVEGARDE IESO ET LESO POUR  OOOSTP
C
      CALL OOOPRM   (LRET,'ZERMEM',HPRM,LPRM,IPRM)
C  sur les machines type sun la memoire est allouee a zero
%IF UNIX32,UNIX64,WIN32,WIN64
      ZERMEM = .FALSE.
%ELSE
      ZERMEM = .TRUE.
%ENDIF
      IF (LRET.EQ.4) ZERMEM = HPRM.NE.'NON'
      IF (ZERMEM) CALL OOOZMR (JZZ(IZA+1),LZA)
      MZLEN(IZA)=LZA
      MZIZA(IZA)=IESO
      MZLZA(IZA)=LESO
C
C       INIT TROUS DE LONGUEUR NULLE ET CHAINE DES TROUS
C         POUR LES ZONES DYNAMIQUES ET FIXES
C
      DO    K=1,2
        IT0=MZIT0(IZA,K)
        MTLT1(IT0)      =-0
        JTR  (IT0+MSLSM)=-0
        MTITP(IT0)      =IT0
        MTITS(IT0)      =IT0
        MZITS0(IZA,K)   =IT0
      ENDDO
C
C      TROU RESULTANT ET LIMITE ZONE DYNAMIQUE/FIXE
C
      IT=MZIS0(IZA)
      LT=((MZLEN(IZA)-(MZLAZ)-MSLSM*2)/MSLSM)*MSLSM
      MZLTROU(IZA,ZMEMDYN)=LT
      MZLTROU(IZA,ZMEMFIX)=0
      MZDLIM (IZA)        =IT+LT
C       ON INSERT LE TROU D'INDICE IT ET DE LG LT DS LA CHAINE DES TROUS
      MTF2 , IZA(ZMEMDYN,IT,LT)
      MZITS0(IZA,ZMEMDYN)=IT
      LRET=2
                                                       RETURN
C-----------------------------------------------------------------------
C
C                        MESSAGES D'ERREUR
C
  901 CALL OOOERR (LREG,1,' ALLOCATION MEMOIRE IMPOSSIBLE')
                                                       GOTO 950
  903 CALL OOOERR (LREG,1,' ALLOCATION MEMOIRE INSUFFISANTE')
                                                       GOTO 950
  950 LRET=1
                                                       RETURN
      END