C
C This file is issued from the MODULEF library, but has been 
C subsequently modified
C
      SUBROUTINE ZALDY1 (NOMSP,ITYPE,NOM,IADRES,L,M,NSORT)
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C BUT :
C     ALLOCATION DYNAMIQUE - ALLOUER UN TABLEAU
C
C PARAMETRES :
C     NOMSP  : NOM DU SOUS-PROGRAMME APPELANT
C     ITYPE  : TYPE DU TABLEAU
C              1 ENTIER    . 2 REEL SIMPLE PRECISION . 3 LOGIQUE  .
C              4 CARACTERE . 5 REEL DOUBLE PRECISION . 6 COMPLEXE .
C              7 COMPLEXE DOUBLE PRECISION .
C     NOM    : NOM DU TABLEAU
C     IADRES : EN SORTIE, INDICE DU TABLEAU DANS LE SUPER-TABLEAU
C     L      : LONGUEUR EN MOTS DU TABLEAU
C     M      : SUPER-TABLEAU
C     NSORT  : 1 LE TABLEAU EXISTAIT AVEC MEME LONGUEUR ET MEME TYPE
C              0 SINON
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C PROGRAMMEUR : F. HECHT - INRIA - AVRIL 86
C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      CHARACTER*(*) NOM
      CHARACTER*6 NOMSP
      DIMENSION M(*)
      NNN = LIBINQ('A')
      NSORT=0
      IF(L.LE.0) GOTO 2000
      CALL ZALDY3(M,NOM,LONG,ITYP,IADRES,IPOINT,IPOPRE)
      IF(IADRES.LE.0) GOTO 100
      IF(ITYPE.NE.ITYP) GOTO 200
      IDIFF=LONG-L
      IF(IDIFF) 200,20,10
   10 NBMNOM=NBMCHA(NOM)
      IIPP=IPOINT+NBMNOM+2
      M(IIPP)=L
      IF(IDIFF.GE.10) GOTO 50
      IF(NNN.GT.1) WRITE(IINFO('I'),1001)NOMSP,M(4),NOM,ITYPE,L,IADRES
      RETURN
   20 IF(NNN.GT.2) WRITE(IINFO('I'),1002)NOMSP,M(4),NOM,ITYPE,L,IADRES
      NSORT=1
      RETURN
C ......................................................................
C                   AJUSTEMENT DU TABLEAU
C ......................................................................
   50 IF(NNN.GT.1) WRITE(IINFO('I'),1003)NOMSP,M(4),NOM,ITYPE,L,IADRES
C
C          DECOUPE DU TABLEAU EN DEUX
C
      IPONEW=IADRES+L
      IPOSUI=M(IPOINT)
      M(IPOINT)=IPONEW
      M(IPONEW)=IPOSUI
      LMAX=MIN(IPOSUI+5,M(1))
      IF(LMAX.EQ.M(2)) M(2)=IPONEW
C
C        TUER LE TABLEAU 2
C
      CALL ZALDY2(M,IPONEW,IPOINT)
      RETURN
C ......................................................................
C                   LE TABLEAU N EXITE PAR => ADRESSAGE
C ......................................................................
  100 CALL ZALDY4(M,NOM,L,ITYPE,IADRES)
      IF(NNN.GT.2) WRITE(IINFO('I'),1004)NOMSP,M(4),NOM,ITYPE,L,IADRES
      RETURN
C ......................................................................
C                    NOUVELLE LONGUEUR > ANCIENNE LONGUEUR
C                      OU TYPE DIFFERENT
C ......................................................................
  200 CALL ZALDY2(M,IPOINT,IPOPRE)
      CALL ZALDY4(M,NOM,L,ITYPE,IADRES)
      IF(NNN.NE.0) WRITE(IINFO('I'),1005)NOMSP,M(4),NOM,ITYPE,L,IADRES
      RETURN
 2000 WRITE(IINFO('I'),1006)
      WRITE(IINFO('I'),1007)NOMSP,ITYPE,NOM,IADRES,L
      STOP
C
C1001 FORMAT(1X,A6,': (NO ADJUSTMENT )     '                            #GB
C    +        ,A4,2X,A16,1X,I1,1X,I9,1X,I9)                             #GB
C1002 FORMAT(1X,A6,': (DOING NOTHING     )     '                        #GB
C    +        ,A4,2X,A16,1X,I1,1X,I9,1X,I9)                             #GB
C1003 FORMAT(1X,A6,': (ADJUST THE SIZE  )     '                         #GB
C    +        ,A4,2X,A16,1X,I1,1X,I9,1X,I9)                             #GB
C1004 FORMAT(1X,A6,': (ADDRESS ONLY )     '                             #GB
C    +        ,A4,2X,A16,1X,I1,1X,I9,1X,I9)                             #GB
C1005 FORMAT(1X,A6,': (ERASE THEN ADDRESS  )     '                      #GB
C    +        ,A4,2X,A16,1X,I1,1X,I9,1X,I9)                             #GB
C1006 FORMAT(/1X,' %% ERROR IN THE DYNAMIC ALLOCATION'//)               #GB
C1007 FORMAT(1X,A6,': THE LENGTH OF ARRAY IS NEGATIVE OR ZERO'/         #GB
C    +' TYPE     : ',I6,'  NAME : ',A20, '  ADDRESS GIVEN : ',I11/      #GB
C    +' LENGTH   : ',I11/' ===> STOP ')                                 #GB
C
 1001 FORMAT(1X,A6,': (PAS D''AJUSTEMENT )     '                        #F
     +        ,A4,2X,A16,1X,I1,1X,I9,1X,I9)                             #F
 1002 FORMAT(1X,A6,': (NE FAIT RIEN      )     '                        #F
     +        ,A4,2X,A16,1X,I1,1X,I9,1X,I9)                             #F
 1003 FORMAT(1X,A6,': (AJUSTE LA TAILLE  )     '                        #F
     +        ,A4,2X,A16,1X,I1,1X,I9,1X,I9)                             #F
 1004 FORMAT(1X,A6,': (ADRESSE SEULEMENT )     '                        #F
     +        ,A4,2X,A16,1X,I1,1X,I9,1X,I9)                             #F
 1005 FORMAT(1X,A6,': (TUE PUIS ADRESSE  )     '                        #F
     +        ,A4,2X,A16,1X,I1,1X,I9,1X,I9)                             #F
 1006 FORMAT(/1X,' %% ERREUR DANS L''ALLOCATION DYNAMIQUE'//)           #F
 1007 FORMAT(1X,A6,': LA LONGUEUR DU TABLEAU EST NEGATIVE OU NULLE'/    #F
     +' TYPE     : ',I6,'  NOM : ',A20, '  ADRESSE DONNEE : ',I11/      #F
     +' LONGUEUR : ',I11/' ===> STOP ')                                 #F
C
      END
