damoc.f

Go to the documentation of this file.

!                   ****************
                    SUBROUTINE damoc
!                   ****************
!
     &( adress , dimens , nmax   , doc    , llng   , llu    ,
     &  motint , motrea , motlog , motcar , motatt ,
     &  defint , defrea , deflog , defcar , defatt ,
     &  usrint , usrrea , usrlog , usrcar , usratt ,
     &  motcle , taille , trouve , utindx , nficmo , nficda ,
     &  indic  , gestd  , nblang , retry )
!
!***********************************************************************
! DAMOCLES   V7P2
!***********************************************************************
!
!brief    MAIN ROUTINE OF THE DAMOCLES LIBRARY
!+             CALLED BY THE DAMOCLES EXECUTABLE (DAMOCLE.F)
!+             CALLED BY THE LNH COMPUTATIONAL CODES.
!
!note     PORTABILITY : IBM,CRAY,HP,SUN
!
!history  J-M HERVOUET (LNH); A. YESSAYAN; L. LEGUE
!+        10/11/2008
!+        V5P9
!+   First version
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!history  J-M HERVOUET (EDF LAB, LNHE)
!+        07/03/2016
!+        V7P2
!+   Changing array SIZE into TAILLE (SIZE is a Fortran function).
!+   Declarations CHARACTER*... replaced by CHARACTER(LEN=...).
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| ADRESS         |<--| TABLEAU DES ADRESSES DES MOTS CLES
!| DEFATT         |<--| TABLEAU DES SUBMITS PAR DEFAUT
!| DEFCAR         |<--| TABLEAU DES VALEURS CARACTERES PAR DEFAUT
!| DEFINT         |<--| TABLEAU DES VALEURS ENTIERES PAR DEFAUT
!| DEFLOG         |<--| TABLEAU DES VALEURS LOGIQUES PAR DEFAUT
!| DEFREA         |<--| TABLEAU DES VALEURS REELLES PAR DEFAUT
!| DIMENS         |<--| TABLEAU DES DIMENSIONS DES MOTS CLES
!| DOC            |-->| LOGIQUE DE DOCUMENTATION DE LA SORTIE
!|                |   | = VRAI : IMPRIME L'AIDE (FICHIER RESULTAT)
!|                |   | = FAUX : N'IMPRIME PAS L'AIDE
!| GESTD          |-->| LOGIQUE D'APPEL PAR LE GESTIONNAIRE D'ETUDES
!| INDIC          |<--| TABLEAU D'INDICATEURS D'ETAT DES MOTS CLES
!|                |   | = 0 : PAS DE SUBMIT & NON TABLEAU
!|                |   | = 1 : PAS DE SUBMIT & TABLEAU
!|                |   | = 2 : AVEC   SUBMIT & NON TABLEAU
!|                |   | = 3 : AVEC   SUBMIT & TABLEAU
!| LLNG           |-->| NUMERO DE LA LANGUE DE DECODAGE
!| LLU            |-->| NUMERO DE L'UNITE LOGIQUE DES SORTIES
!| MOTATT         |<--| TABLEAU DES SUBMITS
!| MOTCAR         |<--| TABLEAU DES VALEURS CARACTERES
!| MOTCLE         |<--| TABLEAU DES MOTS CLES ACTIFS
!| MOTINT         |<--| TABLEAU DES VALEURS ENTIERES
!| MOTLOG         |<--| TABLEAU DES VALEURS LOGIQUES
!| MOTREA         |<--| TABLEAU DES VALEURS REELLES
!| NBLANG         |-->| NOMBRE DE LANGUES CONNUES
!| NFICDA         |-->| NUMERO DE CANAL DU FICHIER DES DONNEES
!| NFICMO         |-->| NUMERO DE CANAL DU FICHIER DES MOTS-CLES
!| NMAX           |-->| TAILLE MAXIMALE AUTORISEE POUR LES TABLEAUX
!| RETRY          |---|
!| TAILLE         |<--| TABLEAU DES LONGUEURS DES MOTS CLES
!| TROUVE         |<--| INDICATEUR D'ETAT DES MOTS CLES
!|                |   | = 0 : AUCUNE VALEUR TROUVEE
!|                |   | = 1 : VALEUR PAR DEFAUT TROUVEE
!|                |   | = 2 : VALEUR TROUVEE (FICHIER DE DONNEES)
!|                |   | = 3 : AUCUNE VALEUR TROUVEE (OPTIONNELLE)
!|                |   | = 5 : TABLEAU DE MOTS A SUBMIT COMPACTE
!|                |   | = 6 : MOT CLE A SUBMIT FORCE NON AFFECTE
!|                |   | = 7 : MOT CLE A SUBMIT FORCE AFFECTE (DICO)
!|                |   | = 8 : MOT CLE A SUBMIT FORCE AFFECTE (CAS)
!|                |   | = 9 : FICHIER DICO : SUBMIT + VALEUR LANCEUR
!|                |   | =10 : FICHIER CAS  : SUBMIT + VALEUR LANCEUR
!| USRATT         |<--| TABLEAU DES SUBMITS A USAGE LOCAL
!| USRCAR         |<--| TABLEAU DES VALEURS CARACTERES A USAGE LOCAL
!| USRINT         |<--| TABLEAU DES VALEURS ENTIERES A USAGE LOCAL
!| USRLOG         |<--| TABLEAU DES VALEURS LOGIQUES A USAGE LOCAL
!| USRREA         |<--| TABLEAU DES VALEURS REELLES A USAGE LOCAL
!| UTINDX         |<--| TABLEAU DE LOGIQUES D'UTILISATION DES INDEX
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_damocles
      USE declarations_special
      IMPLICIT NONE
!
      INTEGER            NMAX,LLNG,LLU,NFICMO,NFICDA,NBLANG,RETRY
      INTEGER            MOTINT(*),DEFINT(*),USRINT(*)
      INTEGER            TAILLE(4,*),ADRESS(4,*),DIMENS(4,*)
      INTEGER            INDIC(4,*),TROUVE(4,*)
      LOGICAL            MOTLOG(*),DEFLOG(*),USRLOG(*),UTINDX(4,*),DOC
      CHARACTER(LEN=72)  MOTCLE(4,*)
      CHARACTER(LEN=PATH_LEN) MOTATT(4,*),DEFATT(*),USRATT(*)
      CHARACTER(LEN=PATH_LEN) MOTCAR(*),DEFCAR(*),USRCAR(*)
      DOUBLE PRECISION   MOTREA(*),DEFREA(*),USRREA(*)
!
      INTEGER            INTLU,NEXT,PREV,PREVAL,LONGLU
      LOGICAL            LOGLU
      CHARACTER(LEN=PATH_LEN) CARLU,PARAM2
      DOUBLE PRECISION   REALU
!
!-----------------------------------------------------------------------
!
      INTEGER            I,K,IVAL,LCAR,ICOL,JCOL,ILONG,ITYP,NUMERO,I2
      INTEGER            DEPLAC,ADD,J,OFFSET(4),NBMOT
      INTEGER            TYPIGN(100),LONIGN(100),NMAXR(4),ORDRE
      INTEGER         ::  ADSRC,ADDES,NULINT,NVAL,NIGN,L1,LONPRO(15)
      LOGICAL            DYNAM,LANGUE,NULLOG,LUIGN,AIDLNG,VUMOT
      LOGICAL            ARRET,VUCMD(5),VUCMD0(5),EXECMD,GESTD
      CHARACTER(LEN=1)   PTVIRG,QUOTE
      CHARACTER(LEN=9) :: MOTPRO(15),TYPE
      CHARACTER(LEN=72)  MOTIGN(100),LIGNE
      CHARACTER(LEN=PATH_LEN) NULCAR,TYPE2
      DOUBLE PRECISION   NULREA
!
!-----------------------------------------------------------------------
!
      EXTERNAL carlu,intlu,loglu,realu,next,prev,preval,longlu
!
!-----------------------------------------------------------------------
!
      parameter( motpro = (/
     &  'NOM      ','TYPE     ','INDEX    ','TAILLE   ','DEFAUT   ',
     &  'AIDE     ','CHOIX    ','RUBRIQUE ','NIVEAU   ','MNEMO    ',
     &  'COMPOSE  ','COMPORT  ','CONTROLE ','APPARENCE','SUBMIT   ' /) )
!     LENGTH OF THE PROTECTED WORDS
      parameter( lonpro =(/ 3,4,5,6,6,4,5,8,6,5,7,7,8,9,6 /) )
!
!***********************************************************************
!                                    RCS AND SCCS MARKING
!
!***********************************************************************
!
!     TYPE NUMBERING :    1 : INTEGER
!                         2 : REAL
!                         3 : LOGICAL
!                         4 : CHARACTER
!
!     MOTPRO(I)   : IEME MOT RESERVE POUR LE PROGRAMME (NOM,TYPE,...)
!     MOTCLE(I,J) : NOM DU JIEME MOT-CLE DE TYPE I
!     DIMENS(I,J) : DIMENSION DU JIEME MOT-CLE DE TYPE I
!     ADRESS(I,J) : ADRESSE DU JIEME MOT-CLE DE TYPE I DANS LE TABLEAU
!     MOTINT(I)   : IEME RESULTAT ENTIER
!     MOTREA(I)   : IEME RESULTAT REEL
!     MOTLOG(I)   : IEME RESULTAT LOGIQUE
!     MOTCAR(I)   : IEME RESULTAT CARACTERE
!     MOTATT(I,J) : JEME SUBMIT DU TYPE I
!     TAILLE(I,J) : LONGUEUR DU JIEME MOT-CLE DE TYPE I
!     TROUVE(I,J) : CONCERNE LE JIEME MOT-CLE DE TYPE I
!     INDIC(I,J)  : CONCERNE LE JIEME MOT-CLE DE TYPE I
!     LUIGN       : INDIQUE SI C'EST UN MOT POUR EDAMOX SEULEMENT
!     MOTIGN(I)   : IEME MOT LU DANS LE FICHIER CAS DONNE PAR EDAMOX
!                   ET LU COMME IGNORE DANS LE DICTIONNAIRE
!     DYNAM       : LOGIQUE POUR LE DYNAMIQUE (.TRUE. SI MODE DYNAMIQUE)
!     VUCMD(I)    : TABLEAU DE LOGIQUES (MEMORISATION DES COMMANDES)
!                   I=1->&LIS;I=2->&ETA;I=3->&IND;I=4->&STO;I=5->&FIN
!     EXECMD      : LOGIQUE D'ACTIVATION DES COMMANDES MEMORISEES
!     NMAXR(I)    : INDEX MAXIMUM REELLEMENT UTILISE POUR LE TYPE I
!
!-----------------------------------------------------------------------
!
! INITIALISES :
!
      lu      = llu
      lng     = llng
      arret   = .false.
      erreur  = .false.
      retour  = .false.
      dynam   = .false.
      execmd  = .false.
      aidlng  = .false.
      vumot   = .false.
      longli  = 72
      nfic    = nficmo
      ptvirg  = ';'
      quote   = ''''
!     TABUL   = CHAR(9)
      nbmot   = 0
      nign    = 0
      ordre   = 0
      param  = ' '
      longu  = 0
      ntyp   = -100
      indx   =  123456
      itai   = -100
      deflu  = 0
!
      DO k=1, 5
        vucmd(k) = .false.
        vucmd0(k) = .false.
      ENDDO ! K
!
      DO k=1,100
        motign(k)= ' '
        typign(k)=1
        lonign(k)=0
      ENDDO ! K
!
      DO k=1, 4
        nmot(k) = 0
        nmaxr(k) = 0
        offset(k) = 1
        DO i=1,nmax
          adress(k,i)  = 0
          dimens(k,i)  = 1
          trouve(k,i)  = 0
          taille(k,i)  = 0
          utindx(k,i)  = .false.
          motint(i)    = 0
          motrea(i)    = 0.
          motlog(i)    = .false.
          motcar(i)    = ' '
          motatt(k,i)  = ' '
          defint(i)    = 0
          defrea(i)    = 0.
          deflog(i)    = .false.
          defcar(i)    = ' '
          defatt(i)    = ' '
          usrint(i)    = 0
          usrrea(i)    = 0.
          usrlog(i)    = .false.
          usrcar(i)    = ' '
          usratt(i)    = ' '
          motcle(k,i)  = ' '
          indic(k,i)   = 0
        ENDDO ! I
      ENDDO ! K
!
! CHECKS THE LANGUAGE
!
      IF(lng.LT.1.OR.lng.GT.nblang) THEN
        WRITE(lu,*) ' '
        WRITE(lu,*) ' CHOICE FOR LANGAGE = ',lng,' INVALID.'
        WRITE(lu,*) ' DAMOCLES STOPS'
        WRITE(lu,*) ' '
        CALL plante(1)
        stop
      ENDIF
!
! 99 : NEW FILE   100 : NEW KEYWORD
!
  99  CONTINUE
!
      icol   = longli
      nlign = 0
!
! SEEKS THE FIRST NON-WHITE CHARACTER (IGNORES COMMENTED LINES) :
!
      icol = next(icol+1,ligne)
!
100   CONTINUE
!
! IF REACHED THE END OF FILE :
!
      IF(retour) GO TO 900
!
! LOCATES THE COMMANDS STARTING WITH &
!
      IF ( ligne(icol:icol).EQ.'&' ) THEN
        CALL cmd (icol,ligne,adress,dimens,trouve,motcle,nmot,
     &       motint,motrea,motlog,motcar,motatt,indic,taille,
     &       utindx,dynam,vucmd,execmd,nficda,nmaxr)
!
!     IF FOUND &FIN, ENDS AFTER COMPACTING :
        IF (vucmd(5)) GO TO 900
!     IF FOUND &STO, ENDS FILE READING :
        IF (vucmd(4)) GO TO 1000
!
        icol = next(icol+1,ligne)
        IF(retour) GO TO 900
      ELSE
!
        i2 = preval(icol+1,ligne,'=',':','=')
!       CASE WHERE '=' IS ON THE FOLLOWING LINE
        IF(i2.GT.longli) i2=longli
        jcol = prev(i2,ligne)
        ilong = jcol - icol + 1
!
        luign = .false.
        IF (nfic.EQ.nficmo.AND.indx.LE.0) luign = .true.
!
        CALL dico(ityp,numero,ilong,ligne(icol:jcol),
     &       motcle,motpro,lonpro,taille,utindx,langue,
     &       aidlng,motign,nign,luign,typign,lonign,nficda,
     &       nblang,nmaxr)
!
        IF(erreur) THEN
          WRITE(lu,*)
          WRITE(lu,*)'************************'
          WRITE(lu,*)'* DAMOCLES STOPPED     *'
          WRITE(lu,*)'************************'
          GO TO 900
        ENDIF
!
! STOPS IF THE WORD IS UNKNOWN
        IF(ityp.EQ.0) THEN
          arret=.true.
          GOTO 1300
        ENDIF
!
        icol = preval(icol+1,ligne,'=',':','=')
!       CASE WHERE '=' IS ON THE FOLLOWING LINE
        IF(icol.GT.longli) THEN
          icol  = next(longli,ligne)
          IF(retour) GO TO 900
        ENDIF
!
! 1) READS AND ASSIGNS A VALUE:
!
        IF(ityp.LE.4) THEN
!
! A PRIORI THE NUMBER OF VALUES TO READ IS DIMENS(ITYP,NUMERO)
! BUT MISSING OR ADDITIONAL VALUES ARE TOLERATED
!
! WHEN THIS IS IDENTIFIED THE VARIOUS ARRAYS ARE UPDATED
!
!
          IF (.NOT.(luign)) THEN
            ntyp = ityp
            indx = numero
            itai = dimens(ntyp,indx)
            add  = adress(ntyp,indx)
!           PARAM = MOTCLE(NTYP,INDX)
!           LONGU = LONGLU(PARAM)
            ival = 1
            IF (trouve(ntyp,indx).EQ.2.OR.trouve(ntyp,indx).EQ.8) THEN
              WRITE(lu,*) ' '
              WRITE(lu,*) 'THE KEY-WORD: ',motcle(ntyp,indx)(1:ilong)
              WRITE(lu,*) 'APPPEARS AT LEAST TWICE , THE LAST',
     &                    ' VALUE WILL BE KEPT...'
              WRITE(lu,*) ' '
            ENDIF
          ENDIF
 10       CONTINUE
          IF (.NOT.(luign)) THEN
            IF     (ntyp.EQ.1) THEN
              defint(ival) = intlu(icol,ligne)
            ELSEIF (ntyp.EQ.2) THEN
              defrea(ival) = realu(icol,ligne)
            ELSEIF (ntyp.EQ.3) THEN
              deflog(ival) = loglu(icol,ligne)
            ELSEIF (ntyp.EQ.4) THEN
              defcar(ival) = carlu(lcar,icol,ligne,quote,motcle,
     &                             taille,motign,lonign,nmaxr,
     &                             nficda,len(defcar(ival)))
            ENDIF
!
!           SUBMIT FOR A CHARACTER ARRAY
!           THERE IS ONLY ONE; WHEREAS IT WAS PREVIOUSLY ASSUMED
!           THAT THERE WERE AS MANY AS CHARACTER STRINGS ?
            defatt(ival) = motatt(ntyp,add)
!
!           CASE OF THE OPTIONAL EMPTY SUBMIT: REMAINS OPTIONAL
            IF (itai.LE.1.AND.indic(ntyp,indx).GE.2.AND.
     &        trouve(ntyp,indx).EQ.3) THEN
              l1 = longlu(defcar(ival))
              IF (l1.GT.0) trouve(ntyp,indx)=2
!
            ELSEIF(trouve(ntyp,indx).LT.6) THEN
              trouve(ntyp,indx)=2
!
            ELSEIF (trouve(ntyp,indx).EQ.6.OR.
     &        trouve(ntyp,indx).EQ.7) THEN
              trouve(ntyp,indx)=8
            ENDIF
!
          ELSE
            ntyp = ityp
            IF     (ntyp .EQ. 1) THEN
                    nulint = intlu(icol,ligne)
            ELSEIF (ntyp .EQ. 2) THEN
                    nulrea = realu(icol,ligne)
            ELSEIF (ntyp .EQ. 3) THEN
                    nullog = loglu(icol,ligne)
            ELSEIF (ntyp .EQ. 4) THEN
                    nulcar = carlu(lcar,icol,ligne,quote,motcle,
     &                             taille,motign,lonign,nmaxr,nficda,
     &                             len(nulcar))
            ENDIF
          ENDIF
!
          icol = next(icol+1,ligne)
          IF(icol.LE.longli) THEN
            IF(ligne(icol:icol).EQ.ptvirg) THEN
              ival = ival + 1
              GO TO 10
            ENDIF
          ENDIF
!
          IF (luign) GO TO 100
!
! ALL THE VALUES FOR A KEYWORD HAVE BEEN READ
!
! PARTICULAR CASE: KEYWORDS WITH A SUBMIT
! PREVENTS DYNAMIC ALLOCATION WHEN VALUES ARE GREATER THAN TAILLE (SEE SUBMIT)
! OR FOR KEYWORDS NOT ASSOCIATED WITH ARRAYS
!
          IF (indic(ntyp,indx).NE.1.AND.ival.GT.itai) ival = itai
!
!
! IF THE KEYWORD &DYN IS NOT IN THE STEERING FILE AND IF THERE ARE
! MORE VALUES THAN THE PARAMETER TAILLE THEN TRUNCATES TO ITAI;
! ELSE (&DYN IN THE STEERING FILE) READS ALL THE VALUES OF THE STEERING FILE
!
! IS IT REALLY NECESSARY TO SET BACK TO DYNAMIC MODE EVERY TIME ???
! IS MODIFYING DIMENS NOT ENOUGH ?
! IF LECDON IS WELL WRITTEN : IT DOES NOT MATTER IF THERE ARE HOLES
! IN THE ARRAYS SENT ... THINK ABOUT THIS
!
!
          IF (.NOT.(dynam)) THEN
            DO i=1 , min(ival,itai)
              IF     (ntyp.EQ.1) THEN
                motint(add+i-1) = defint(i)
              ELSEIF (ntyp.EQ.2) THEN
                motrea(add+i-1) = defrea(i)
              ELSEIF (ntyp.EQ.3)THEN
                motlog(add+i-1) = deflog(i)
              ELSEIF (ntyp.EQ.4)THEN
                motcar(add+i-1) = defcar(i)
              ENDIF
            ENDDO ! I
          ELSE
            DO i=1 ,nmaxr(ntyp)
              IF (utindx(ntyp,i)) THEN
                IF(adress(ntyp,i) .NE. add) THEN
                  IF (adress(ntyp,i) .LT. add) deplac = 0
                  IF (adress(ntyp,i) .GT. add) deplac = ival - itai
                  DO j=1 , dimens(ntyp,i)
                    adsrc = adress(ntyp,i)+j-1
                    addes = adress(ntyp,i)+j-1+deplac
                    IF (addes.GT. nmax) GO TO 1515
                    IF     (ntyp.EQ.1) THEN
                      usrint(addes) = motint(adsrc)
                    ELSEIF (ntyp.EQ.2) THEN
                      usrrea(addes) = motrea(adsrc)
                    ELSEIF (ntyp.EQ.3) THEN
                      usrlog(addes) = motlog(adsrc)
                    ELSEIF (ntyp.EQ.4) THEN
                      usrcar(addes) = motcar(adsrc)
                    ENDIF
                    usratt(addes) = motatt(ntyp,adsrc)
                  ENDDO ! J
                  IF (adress(ntyp,i) .GT. add) THEN
                    adress(ntyp,i) = adress(ntyp,i) + deplac
                    IF (adress(ntyp,i) .GT. nmax) GO TO 1515
                  ENDIF
!
                ELSE IF (adress(ntyp,i) .EQ. add) THEN
                  DO j=1 ,ival
                    IF     (ntyp.EQ.1) THEN
                      usrint(add+j-1) = defint(j)
                    ELSEIF (ntyp.EQ.2) THEN
                      usrrea(add+j-1) = defrea(j)
                    ELSEIF (ntyp.EQ.3) THEN
                      usrlog(add+j-1) = deflog(j)
                    ELSEIF (ntyp.EQ.4)THEN
                      usrcar(add+j-1) = defcar(j)
                    ENDIF
                    usratt(add+j-1) = defatt(j)
                  ENDDO ! J
                  dimens(ntyp,i) = ival
                ENDIF
              ENDIF
            ENDDO ! I
!           SORTS IN FINAL ARRAYS
            DO i=1 ,nmaxr(ntyp)
              IF (utindx(ntyp,i)) THEN
                adsrc = adress(ntyp,i)
                DO j=1 ,dimens(ntyp,i)
                  IF     (ntyp.EQ.1) THEN
                    motint(adsrc+j-1)=usrint(adsrc+j-1)
                  ELSEIF (ntyp.EQ.2) THEN
                    motrea(adsrc+j-1)=usrrea(adsrc+j-1)
                  ELSEIF (ntyp.EQ.3) THEN
                    motlog(adsrc+j-1)=usrlog(adsrc+j-1)
                  ELSEIF (ntyp.EQ.4)  THEN
                    motcar(adsrc+j-1)=usrcar(adsrc+j-1)
                  ENDIF
                  motatt(ntyp,adsrc+j-1) = usratt(adsrc+j-1)
                ENDDO ! J
              ENDIF
            ENDDO ! I
          ENDIF
!
!
!       ICOL = NEXT(ICOL,LIGNE)
!
! ENDIF DU IF(ITYP.LE.4) ...
        ENDIF
!
!
! 2) RESERVED KEYWORDS:
!
!    RESERVED KEYWORDS CURRENTLY ARE:
!
!           'NOM'       :NUMERO = 1  (DE TYPE CARACTERE)
!           'TYPE'      :NUMERO = 2  (DE TYPE CARACTERE)
!           'INDEX'     :NUMERO = 3  (DE TYPE ENTIER)
!           'TAILLE'    :NUMERO = 4  (DE TYPE ENTIER)
!           'DEFAUT'    :NUMERO = 5  (DE TYPE VARIABLE)
!           'AIDE'      :NUMERO = 6  (DE TYPE CARACTERE)
!           'CHOIX'     :NUMERO = 7  (DE TYPE VARIABLE)
!           'RUBRIQUE'  :NUMERO = 8  (DE TYPE CARACTERE)
!           'NIVEAU'    :NUMERO = 9  (DE TYPE ENTIER)
!           'MNEMO'     :NUMERO = 10 (DE TYPE CARACTERE)
!           'COMPOSE'   :NUMERO = 11 (DE TYPE CARACTERE)
!           'COMPORT'   :NUMERO = 12 (DE TYPE CARACTERE)
!           'CONTROLE'  :NUMERO = 13 (DE TYPE ENTIER)
!           'APPARENCE' :NUMERO = 14 (DE TYPE CARACTERE)
!           'SUBMIT'    :NUMERO = 15 (DE TYPE CARACTERE)
!
        IF(ityp.EQ.5) THEN
!
!    NAME
!
          IF(numero.EQ.1) THEN
!
! SHOULD NOT COUNT THE SAME WORD IN SEVERAL LANGUAGES SEVERAL TIMES
! COUNTED ONLY ONCE IN FIRST FOUND LANGUAGE
!
            IF (.NOT.(vumot)) nbmot = nbmot + 1
!
            ordre = 1
!
! COMING FROM THE PRECEDING WORD, SORTS IT BEFORE READING THE FOLLOWING
! SINCE ALL THE INFORMATION ON THE PRECEDING WORD IS AVAILABLE
!
            IF (nbmot.GT.1 .AND. (.NOT.(vumot)) ) THEN
              IF (indx.GT.nmaxr(ntyp)) nmaxr(ntyp)=indx
              CALL classe(dimens,taille,motcle,utindx,nmax,
     &                    offset,adress,indic,luign,
     &                    motint,motrea,motlog,motcar,motatt ,
     &                    defcar,defint,deflog,defrea,defatt )
            ENDIF
!
! SIGNALS THAT THIS NEW KEYWORD WAS ALREADY ENCOUNTERED IN ANOTHER LANGUAGE
            IF (.NOT.(vumot)) vumot=.true.
!
!           NAME OF THE KEYWORD
            IF (langue) THEN
              param2= carlu(lcar,icol,ligne,quote,motcle,taille,motign,
     &                      lonign,nmaxr,nficda,len(param))
              longu = lcar
              param=param2(1:min(72,longu))
            ELSE
! READS THE NAME OF A NON-REQUESTED LANGUAGE (NOT USED)
              nulcar = carlu(lcar,icol,ligne,quote,motcle,taille,
     &                       motign,lonign,nmaxr,nficda,len(nulcar))
            ENDIF
!
            icol = next(icol+1,ligne)
!
!    TYPE
!
          ELSE IF(numero.EQ.2) THEN
            vumot = .false.
            IF (ordre.NE.1) GOTO 1500
            ordre=2
            type2= carlu(lcar,icol,ligne,quote,motcle,taille,motign,
     &                   lonign,nmaxr,nficda,len(type))
            TYPE=type2(1:min(lcar,9))
            IF(TYPE(1:6).EQ.'ENTIER'
     &      .OR.TYPE(1:8).EQ.'INTEGER') then
              ntyp = 1
            ELSEIF(TYPE(1:4).EQ.'REEL'
     &      .OR.TYPE(1:4).EQ.'REAL') then
              ntyp = 2
            ELSEIF(TYPE(1:7).EQ.'LOGIQUE'
     &      .OR.TYPE(1:7).EQ.'LOGICAL') then
              ntyp = 3
            ELSEIF(TYPE(1:9).EQ.'CARACTERE'
     &      .OR.TYPE(1:6).EQ.'STRING') then
!    *      OR.TYPE(1:4).EQ.'FILE'
!    *      OR.TYPE(1:7).EQ.'FICHIER') THEN
              ntyp = 4
            ELSE
!           ERROR: UNKNOWN TYPE
              WRITE (lu,1003) ligne
1003          FORMAT(1x,a72,/,1x,'UNKNOWN TYPE ON THIS LINE')
              CALL plante(1)
              stop
            ENDIF
            icol = next(icol+1,ligne)
!
!    INDEX
!
          ELSE IF(numero.EQ.3) THEN
            IF (ordre.NE.2) GOTO 1500
            ordre=3
            indx = intlu(icol,ligne)
            icol = next(icol+1,ligne)
!
! CASE INDEX=-1 : WORD FOR EDAMOX CONSTRUCTION, TO KEEP
!
            IF (indx.EQ.-1) THEN
              nign = nign + 1
              IF (nign.GT.100) THEN
                WRITE(lu,*) 'TOO MANY WORDS FOR EDAMOX',
     &                      ' (MAX=100)'
                erreur = .true.
                GO TO 900
              ENDIF
              motign(nign)=param(1:longu)
              lonign(nign)=longu
              typign(nign)=ntyp
            ENDIF
!
!    SIZE
!
          ELSE IF(numero.EQ.4) THEN
            IF (ordre.NE.3) GOTO 1500
            ordre=4
            itai = intlu(icol,ligne)
            icol = next(icol+1,ligne)
!
!    DEFAULT VALUE
!    FOR ARRAYS, IT IS NOT NECESSARY TO SET ALL VALUES
!
          ELSE IF(numero.EQ.5) THEN
!
!
            IF (ordre.LT.3.OR.ordre.GT.6) GOTO 1500
            ordre=6
            IF (langue) THEN
              deflu = 1
              IF (ntyp.NE.4) trouve(ntyp,indx) = 1
!
200           CONTINUE
!
              IF (ntyp .EQ. 1) THEN
                defint(deflu) = intlu(icol,ligne)
              ELSE IF (ntyp .EQ. 2) THEN
                defrea(deflu) = realu(icol,ligne)
              ELSE IF (ntyp .EQ. 3) THEN
                deflog(deflu) = loglu(icol,ligne)
              ELSE IF (ntyp .EQ. 4) THEN
                defcar(deflu) = carlu(lcar,icol,ligne,quote,motcle,
     &                               taille,motign,lonign,nmaxr,nficda,
     &                               len(defcar(deflu)))
                l1 = longlu(defcar(deflu))
                IF (itai.LE.1.AND.indic(ntyp,indx).GE.2) THEN
                  IF (trouve(ntyp,indx).LE.3) THEN
                    IF (l1.GT.0) trouve(ntyp,indx)=1
                  ELSEIF(trouve(ntyp,indx).EQ.6) THEN
                    trouve(ntyp,indx)=7
                  ENDIF
                ELSE
                  trouve(ntyp,indx)=1
                ENDIF
              ENDIF
!
              icol = next(icol+1,ligne)
!
              IF(icol.GT.longli) THEN
                icol = longli
              ELSE
                IF(ligne(icol:icol).EQ.ptvirg) THEN
                  deflu = deflu + 1
                  GO TO 200
                ELSE
                  icol=icol-1
                ENDIF
              ENDIF

!
!
!
            ELSE
!
! READS THE DEFAULT OF A NON-REQUESTED LANGUAGE (NOT USED)
!
 210          CONTINUE
!
              IF (ntyp .EQ. 1) THEN
                nulint = intlu(icol,ligne)
              ELSE IF (ntyp .EQ. 2) THEN
                nulrea = realu(icol,ligne)
              ELSE IF (ntyp .EQ. 3) THEN
                nullog = loglu(icol,ligne)
              ELSE IF (ntyp .EQ. 4) THEN
                nulcar = carlu(lcar,icol,ligne,quote,motcle,taille,
     &                        motign,lonign,nmaxr,nficda,len(nulcar))
              ENDIF
!
              icol = next(icol+1,ligne)
!
              IF (ligne(icol:icol) .EQ. ptvirg) THEN
                GO TO 210
              ELSE
                icol=icol-1
              ENDIF
            ENDIF
!
            icol = next(icol+1,ligne)
!
!    HELP
!
          ELSE IF(numero.EQ.6) THEN
!
            IF(aidlng.AND.doc) THEN
              WRITE(lu,511)
511           FORMAT(1x,72('-'))
              WRITE(lu,*) param(1:longu)
              WRITE(lu,511)
            ENDIF
            CALL aidelu(icol,ligne,doc.AND.aidlng)
            aidlng = .false.
!
!
!    'CHOIX' 'RUBRIQUE' 'NIVEAU' 'MNEMO' 'COMPOSE' 'COMPORT' 'CONTROLE' 'APPARENCE'
!    NUMBER 7 TO 14 INCLUDED
!
          ELSE IF((numero .GE. 7) .AND. (numero .LE. 14)) THEN
            CALL aidelu(icol,ligne,.false.)
!
!    DEFINES A SUBMIT TYPE
          ELSE IF (numero .EQ. 15) THEN
            IF (ordre.NE.3.AND.ordre.NE.4) GOTO 1500
            ordre=5
            IF (.NOT.(luign)) indic(ntyp,indx)=indic(ntyp,indx)+2
            icol = next(icol+1,ligne) -1
            CALL influ(icol,ligne,defatt,trouve,luign,motcle,taille,
     &                 motign,lonign,nmaxr,nficda,gestd)
            DO i=1,deflu
              defint(i)    = 0
              defrea(i)    = 0.
              deflog(i)    = .false.
              defcar(i)    = ' '
            ENDDO ! I
            IF (erreur) GO TO 900
            icol = next(icol,ligne)
          ENDIF
!
        ENDIF
!
      ENDIF
!
      GO TO 100
900   CONTINUE
      IF(erreur) THEN
        WRITE(lu,*)' '
        IF(nfic.EQ.nficmo) THEN
          WRITE(lu,*)'-------------------------------'
          WRITE(lu,*)'- ERROR IN THE DICTIONARY     -'
          WRITE(lu,*)'-------------------------------'
          CALL plante(1)
          stop
        ELSE
          WRITE(lu,*)'-----------------------------------------'
          WRITE(lu,*)'- ERROR IN THE STEERING FILE            -'
          WRITE(lu,*)'-----------------------------------------'
          retry=retry+1
        ENDIF
        IF(retry.LE.1) THEN
          RETURN
        ELSE
          CALL plante(1)
          stop
        ENDIF
      ENDIF
!
      IF(nfic.EQ.nficmo) THEN
        IF (indx.GT.nmaxr(ntyp)) nmaxr(ntyp)=indx
        CALL classe(dimens,taille,motcle,utindx,nmax,
     &              offset,adress,indic,luign,
     &              motint,motrea,motlog,motcar,motatt ,
     &              defcar,defint,deflog,defrea,defatt )
      ENDIF
      IF(nficmo.EQ.nficda.OR.nfic.EQ.nficda) THEN
!       TRUE END: 2 FILES READ OR 2 FILES IN 1 READ
        GO TO 1000
      ELSE
!       FALSE END: REMAINS A FILE
        nfic = nficda
        retour = .false.
        GO TO 99
      ENDIF
!
1515  CONTINUE
      WRITE(lu,*)'*********************************************'
      WRITE(lu,*)'ADRESS GREATER THAN NMAX = ',nmax
      WRITE(lu,*)'TOO MANY VALUES OF TYPE : ',ntyp,' DECLARED.'
      WRITE(lu,*)'STOP OF DAMOCLES AT KEY-WORD NUMBER: ',indx
      WRITE(lu,*)'*********************************************'
      CALL plante(1)
      stop
!
1000  CONTINUE
!
! COMPACTS WHITE CHARS - REDISTRIBUTES - TESTS THE RESULTS
!
      DO k=1,nmaxr(4)
        IF (utindx(4,k).AND.indic(4,k).GE.2.AND.
     &      trouve(4,k).LT.3.AND.trouve(4,k).GT.0) THEN
          add = adress(4,k)
          param = motcle(4,k)
          longu = taille(4,k)
          nval = dimens(4,k)
          i=0
 1180     CONTINUE
          i=i+1
 1185     CONTINUE
! IF IT IS A WHITE CHAR (LENGTH=0):
          IF (longlu(motcar(add+i-1)).EQ.0) THEN
            DO j=i,nval-1
              motcar(add+j-1)=motcar(add+j)
!
! SUBMITS DO NOT FOLLOW IF THIS LINE IS COMMENTED OUT
! OTHERWISE PB EXPERIENCED WITH STBTEL
!            MOTATT(4,ADD+J-1)=MOTATT(4,ADD+J)
!
            ENDDO ! J
            nval = nval-1
            IF (i.LE.nval) GO TO 1185
          ENDIF
          IF (i.LT.nval) GO TO 1180
!
! CASE OF EMPTY ALLOCATIONS FOR NON ARRAYS
!
          IF (nval.EQ.0.AND.indic(4,k).EQ.2) THEN
            WRITE(lu,*) 'EMPTY ALLOCATION NOT ALLOWED FOR ',
     &                  'THE KEY WORD : ', param(1:longu)
            WRITE(lu,*)
            arret = .true.
            GO TO 1300
          ENDIF
!
! HAS COMPACTED ARRAYS TO DIMENSION NVAL (CAN BE = 0)
          IF (nval.LT.dimens(4,k)) THEN
            dimens(4,k) = nval
            trouve(4,k) = 5
          ENDIF
        ENDIF
!
! CASE OF SUBMIT ARRAYS NEVER AFFECTED -> DIMENSION = 0
        IF (utindx(4,k).AND.indic(4,k).EQ.3.AND.trouve(4,k).EQ.0.
     &      and.dimens(4,k).GT.1) THEN
          dimens(4,k) = 0
          trouve(4,k) = 3
        ENDIF
!
      ENDDO ! K
!
! CARRIES OUT THE COMMANDS RECORDED BEFORE THE END
      execmd = .true.
!     TO AVOID TESTS ON LINE IN CMD
      ligne = 'NUL'
      DO k = 1,5
        vucmd0(k) = vucmd(k)
        vucmd(k)  = .false.
      ENDDO
!
      DO k=1,5
        vucmd(k)=vucmd0(k)
        IF (vucmd(k).AND.(.NOT.(erreur))) THEN
          CALL cmd (icol,ligne,adress,dimens,trouve,motcle,nmot,
     &          motint,motrea,motlog,motcar,motatt,indic,taille,
     &          utindx,dynam,vucmd,execmd,nficda,nmaxr)
          vucmd(k) = .false.
        ENDIF
      ENDDO
!
!  LOOKS FOR REQUIRED KEYWORDS THAT HAVE NOT BEEN READ:
!
      WRITE(lu,*) ' '
!
      DO k = 1,4
      DO indx = 1 , nmaxr(k)
        IF (utindx(k,indx)) THEN
          IF (trouve(k,indx).EQ.0) THEN
!
! IF NO DEFAULT VALUE AND NOTHING IN STEERING FILE, DIMENS = 0 FOR ARRAYS
            IF (dimens(k,indx).NE.1) THEN
              IF (dynam) dimens(k,indx) = 0
            ELSE
              WRITE(lu,*)'----------------------------------------'
              arret= .true.
              WRITE(lu,1102) motcle(k,indx)(1:taille(k,indx))
 1102         FORMAT(1x,'BEWARE, THE KEY-WORD:',1x,a,/,1x,
     &        'HAS BEEN GIVEN NO VALUE')
            ENDIF
          ENDIF
!
!       WILL WRITE THE UNUSED INDICES IN EVERY CATEGORY
!
!       ELSE
!         WRITE(LU,*) 'KEYWORD ',INDX,' OF TYPE ',K,' NOT USED'
        ENDIF
      ENDDO ! INDX
      ENDDO ! K
!
1300  CONTINUE
      IF(arret) THEN
        WRITE(lu,*)  ' '
        WRITE(lu,*) 'DAMOC IS STOPPED'
        CALL plante(1)
        stop
      ENDIF
!
      RETURN
!
! TREATS ERRORS OF DECLARATION ORDER IN THE DICTIONARY
!
1500  erreur=.true.
      WRITE(lu,'(/,1X,A72,/)') ligne
      WRITE(lu,*) 'AT LINE ',nlign,', PRIORITY ORDER NOT RESPECTED'
      WRITE(lu,*)
      WRITE(lu,*) 'EXPECTED ORDER IS :'
      WRITE(lu,*) 'NOM, TYPE, INDEX, (TAILLE), (SUBMIT), (DEFAUT)'
      GOTO 900
!
!-----------------------------------------------------------------------
!
      END