classe.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE classe
!                   *****************
!
     &(dimens , SIZE   , motcle , utindx , nmax   ,
     & offset , adress , indic  , luign  ,
     & motint , motrea , motlog , motcar , motatt ,
     & defcar , defint , deflog , defrea , defatt )
!
!***********************************************************************
! DAMOCLES   V7P1
!***********************************************************************
!
!brief    STORES IN ARRAYS MOTINT, MOTREA, MOTLOG, MOTCAR AND
!+             MOTATT THE VALUES READ FOR A KEYWORD.
!+
!+             DISCARDS THE WORDS RETURNED BY EDAMOX IN THE DATA FILE.
!
!note     PORTABILITY : IBM,CRAY,HP,SUN
!
!history  O. QUIQUEMPOIX (LNH)
!+        14/12/1993
!+
!+
!
!history  L. LEGUE
!+        16/08/1994
!+        V5P1
!+
!
!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)
!+        20/11/2015
!+        V7P1
!+   An error message was printing the wrong line number. Now printing
!+   the correct keyword instead.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| 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
!| 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 & NON TABLEAU
!| LUIGN          |-->| LOGIQUE POUR LES MOTS A NE PAS CLASSER
!| 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
!| NMAX           |-->| TAILLE MAXIMALE AUTORISEE POUR LES TABLEAUX
!| OFFSET         |<->| TABLEAUX DES PROCHAINES ADRESSES LIBRES
!| SIZE           |<->| TABLEAU DES LONGUEURS DES MOTS CLES
!| UTINDX         |<->| TABLEAU DE LOGIQUES D'UTILISATION DES INDEX
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      USE declarations_damocles
      USE declarations_special
      IMPLICIT NONE
!
      INTEGER          NMAX,MOTINT(*),ADRESS(4,*),DIMENS(4,*)
      INTEGER          SIZE(4,*),OFFSET(4),DEFINT(*),INDIC(4,*)
      LOGICAL          UTINDX(4,*),DEFLOG(*),MOTLOG(*),LUIGN
      CHARACTER(LEN=72)     MOTCLE(4,*)
      CHARACTER(LEN=PATH_LEN)    MOTCAR(*),DEFCAR(*)
      CHARACTER(LEN=PATH_LEN)    MOTATT(4,*),DEFATT(*)
      DOUBLE PRECISION MOTREA(*),DEFREA(*)
!
!-----------------------------------------------------------------------
!
      INTEGER          I
!
!-----------------------------------------------------------------------
!
!
!***********************************************************************
!                                    RCS AND SCCS MARKING
!
!***********************************************************************
!
      IF (luign) GO TO 1600
!
!     GLOBAL TREATMENT OF THE KEYWORD
!
      IF (indx .GT. nmax) THEN
        WRITE(lu,*) '****************************************'
        WRITE(lu,*) 'ERROR AT LINE:',nlign,
     &              ' OF THE DICTIONARY'
        WRITE(lu,*) 'INVALID INDEX: ',indx,' MAX = ',nmax
        WRITE(lu,*) '****************************************'
        CALL plante(1)
        stop
      ENDIF
!
      IF (nmot(ntyp) .GT. nmax) THEN
        WRITE(lu,*)'*****************************************'
        WRITE(lu,*) 'ERROR AT LINE:',nlign,
     &              ' OF THE DICTIONARY'
        WRITE(lu,*) 'TOO MANY KEY-WORDS, MAXIMUM : ',nmax
        WRITE(lu,*)'*****************************************'
        CALL plante(1)
        stop
      ENDIF
!
! REDUNDANT WITH LUIGN? KEPT BY DEFAULT - TO BE CHECKED
      IF (indx .LE. 0) GO TO 1600
!
      IF (utindx(ntyp,indx)) THEN
        WRITE(lu,*)'*****************************'
        WRITE(lu,*) 'ERROR AT LINE: ',nlign
        WRITE(lu,*) 'THE INDEX: ',indx,
     &   ' IS USED TWO TIMES FOR THE TYPE : ',ntyp
        WRITE(lu,*)'*****************************'
        CALL plante(1)
        stop
      ELSE
        utindx(ntyp,indx) = .true.
      ENDIF
!
      IF(itai.LE.0) THEN
        itai = 1
      ELSE
!       PREVENTS DYNAMIC ALLOCATION FOR SOMETHING ELSE THAN AN ARRAY
        indic(ntyp,indx)=indic(ntyp,indx)+1
      ENDIF
!
! ISSUES A WARNING WHEN THE DEFAULT VALUES ARE DEFINED
! IN INSUFFICIENT NUMBER COMPARED TO THE DIMENSIONS
!
      IF(deflu.GT.0.AND.deflu.NE.itai) THEN
        WRITE(lu,*) ' '
        WRITE(lu,*) 'WARNING IN DICTIONARY:'
        WRITE(lu,*) 'FOR KEYWORD: ',param(1:longu)
        WRITE(lu,*) 'THE NUMBER OF DEFAULT VALUES ',deflu,
     &              ' IS DIFFERENT FROM THE DECLARED SIZE ',itai
        WRITE(lu,*) ' '
      ENDIF
!
      IF(deflu .EQ. 0) THEN
        IF     (ntyp .EQ. 1) THEN
          defint(1) = 0
        ELSEIF (ntyp .EQ. 2) THEN
          defrea(1) = 0.0
        ELSEIF (ntyp .EQ. 3)THEN
          deflog(1) = .false.
        ELSEIF (ntyp .EQ. 4) THEN
          defcar(1) = ' '
        ENDIF
      ENDIF
!
      IF (itai .NE. deflu) THEN
        IF (itai .GT. deflu) THEN
          DO i = deflu + 1 , itai
            IF     (ntyp .EQ. 1) THEN
              defint(i) = defint(max(1,deflu))
            ELSEIF (ntyp .EQ. 2) THEN
              defrea(i) = defrea(max(1,deflu))
            ELSEIF (ntyp .EQ. 3) THEN
              deflog(i) = deflog(max(1,deflu))
            ELSEIF (ntyp .EQ. 4) THEN
              defcar(i) = defcar(max(1,deflu))
            ENDIF
!           DEFATT(NYTP,I) = DEFATT(NYTP,MAX(1,DEFLU))
          ENDDO ! I
        ENDIF
        deflu = itai
      ENDIF
!
!   STORES THE KEYWORD ATTRIBUTES IN THE ARRAYS
!   NUMBER OF KEYWORDS OF TYPE NTYP
!
      nmot(ntyp) = nmot(ntyp) + 1
!
!   NEXT FREE ADDRESS FOR THE KEYWORD OF TYPE NTYP
!
      adress(ntyp,indx) = offset(ntyp)
!
!   STORED KEYWORD
!
      motcle(ntyp,indx) = param(1:longu)
!
!   NUNBER OF VALUES ASSOCIATED WITH THE KEYWORD OF TYPE NTYP
!
      dimens(ntyp,indx) = itai
!
!   LENGTH OF THE KEYWORD (CHARACTERS)
!
      SIZE(ntyp,indx) = longu
!
!   STORES THE VALUES IN THE ARRAYS
!
      IF (((adress(ntyp,indx)+itai-1) .GT. nmax)
     &   .OR. (offset(ntyp) .GT. nmax)) THEN
        WRITE(lu,*) 'ADRESS GREATER THAN NMAX = ',nmax
        WRITE(lu,*) 'TOO MANY VALUES OF TYPE : ',ntyp
     &              ,' DECLARED.'
        WRITE(lu,*) 'STOP AT KEY-WORD OF INDEX: ',indx
        CALL plante(1)
        stop
      ENDIF
!
      DO i = 1 , itai
        IF (ntyp .EQ. 1) THEN
          motint(adress(ntyp,indx)+i-1) = defint(i)
        ELSE IF (ntyp .EQ. 2) THEN
          motrea(adress(ntyp,indx)+i-1) = defrea(i)
        ELSE IF (ntyp .EQ. 3) THEN
          motlog(adress(ntyp,indx)+i-1) = deflog(i)
        ELSE IF (ntyp .EQ. 4) THEN
          motcar(adress(ntyp,indx)+i-1) = defcar(i)
        ENDIF
        IF (indic(ntyp,indx).GE.2)
     &    motatt(ntyp,adress(ntyp,indx)+i-1) = defatt(i)
      ENDDO ! I
!
!   UPDATES THE NEXT FREE ADDRESS
!
      offset(ntyp) = offset(ntyp) + itai
!
!   INITIALISES THE TEMPORARY VARIABLES
!
1600  CONTINUE
      param  = ' '
      longu  = 0
      ntyp   = -100
      indx   = 123456
      itai   = -100
      deflu  = 0
!
!-----------------------------------------------------------------------
!
      RETURN
      END