influ.f

Go to the documentation of this file.

!                   ****************
                    SUBROUTINE influ
!                   ****************
!
     &( icol   , ligne  , defatt , trouve , luign , motcle , SIZE,
     &  motign , lonign , nmaxr  , nficda , gestd )
!
!***********************************************************************
! DAMOCLES   V6P0                                   21/08/2010
!***********************************************************************
!
!brief    DECODES THE SUBMIT FIELD FROM COLUMN ICOL+1 OF THE
!+             CURRENT LINE. TESTS THE PRESENCE OF THE 4 FIELDS.
!+             RECOGNISES CHAMP2.
!+             MOVES THE POINTER ICOL TO THE LAST DECODED CHARACTER.
!
!note     PORTABILITY : IBM,CRAY,HP,SUN
!
!warning  IF THE 1ST FIELD IS NOT KNOWN, THERE ARE NO CHECKS OTHER
!+            THAN ON THE 2ND FIELD, WHICH CHARACTERISES THE BEHAVIOUR
!+            OF THE KEYWORD FOR DAMOCLES. THIS EXTENDS THE
!+            COMPATIBILITY OF DAMOCLES WITHOUT DIRECT MODIFICATIONS
!+            TO THE FORTRAN
!
!history  O. QUIQUEMPOIX (LNH)
!+        16/08/1994
!+
!+
!
!history  J-M HERVOUET (LNH)
!+        14/01/2008
!+        V5P8
!+   CORRECTION: IN MOTCH1(1:LCAR), LCAR SHOULD NOT EXCEED 10
!
!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
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| DEFATT         |<--| TABLEAU DES SUBMITS PAR DEFAUT
!| GESTD          |-->| LOGIQUE D'APPEL PAR LE GESTIONNAIRE D'ETUDES
!| ICOL           |<->| POSITION COURANTE DU POINTEUR DANS LA LIGNE
!| LIGNE          |<->| LIGNE EN COURS DE DECODAGE
!| LONIGN         |-->| TABLEAU DES LONGUEURS DES MOTS EDAMOX
!| LUIGN          |-->| LOGIQUE POUR LES MOTS A NE PAS CLASSER
!| MOTCLE         |-->| TABLEAU DES MOTS CLES ACTIFS
!| MOTIGN         |-->| TABLEAU DES MOTS CLES DUS A EDAMOX A IGNORER
!| NFICDA         |-->| NUMERO DE CANAL DU FICHIER DES DONNEES
!| NMAXR          |-->| TABLEAU DES INDEX MAXIMUM REELS PAR TYPES
!| SIZE           |-->| 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
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_damocles
      USE declarations_special
      IMPLICIT NONE
!
      EXTERNAL next,precar,carlu,longlu
!
      INTEGER       TROUVE(4,*),ICOL,NMAXR(4),NFICDA,SIZE(4,*)
      INTEGER       LONIGN(100)
      LOGICAL       LUIGN,GESTD
      CHARACTER(LEN=72)  MOTIGN(100),MOTCLE(4,*)
      CHARACTER(LEN=PATH_LEN) DEFATT(*)
      CHARACTER(LEN=*) LIGNE
!
      INTEGER       NEXT,PRECAR,LONGLU
      CHARACTER(LEN=PATH_LEN) CARLU
!
!-----------------------------------------------------------------------
!
      INTEGER   ::    NBCHP1
      parameter(nbchp1=12)
!
      INTEGER       I,LCAR,ICOLA,JCOLA,CHAMP(4),LGA,II
      INTEGER       :: LGMOTG(nbchp1),GECHP1(nbchp1)
      CHARACTER(LEN=1)   PTVIRG,QUOTE,GUILLT
      CHARACTER(LEN=53)  :: MESERR(2*nbchp1)
      CHARACTER(LEN=10)  :: MOTCH1(nbchp1)
      CHARACTER(LEN=PATH_LEN) NULATT,ANALYS,FIELD,FIELD0
!
!-----------------------------------------------------------------------
!
! ******************* DATABASE FOR THE SUBROUTINE **********************
!
! DEFINITION OF FIELDS 1
      parameter( motch1 = (/
     &  'IN        ','OUT       ','CAS       ','DIC       ',
     &  'QSUB      ','LIB       ','FORTRAN   ','DIROUT    ',
     &  'USER      ','ACCT      ','PRE       ','POST      ' /) )
! LENGTHS OF THE STRINGS FOR FIELDS 1 DEFINED ABOVE
      parameter( lgmotg = (/ 2,3,3,3,4,3,7,6,4,4,3,4 /) )
! CHANGE TO 'NUL;FOR' IF GESTD=.TRUE. ? : 1-YES, 0-NO
      parameter( gechp1 = (/ 1,1,0,0,0,0,1,1,0,0,0,0 /) )
! NUMBER OF THE FIELDS TO BE GIVEN TO THESE WORDS --> ERROR MESSAGES
!      DATA NOCHMP /1,2,3,4,5,6,7,8,9,10,11,12/
! ERROR MESSAGES ASSOCIATED WITH THE FIELD NUMBERS
      parameter( meserr = (/
     &  'PAS D''ALLOCATION DE FICHIER D''ENTREE !!              ',
     &  'NO ALLOCATION FOR INPUT FILE !!                      ',
     &  'PAS D''ALLOCATION DE FICHIER DE SORTIE !!             ',
     &  'NO ALLOCATION FOR OUTPUT FILE !!                     ',
     &  'PAS D''ALLOCATION POUR LE FICHIER CAS !!              ',
     &  'NO ALLOCATION FOR THE STEERING FILE !!               ',
     &  'PAS D''ALLOCATION POUR LE DICTIONNAIRE !!             ',
     &  'NO ALLOCATION FOR THE DICTIONARY !!                  ',
     &  'PAS DE COMMANDE CRAY !!                              ',
     &  'NO INSTRUCTION FOR CRAY !!                           ',
     &  'PAS DE LIBRAIRIE !!                                  ',
     &  'NO LIBRARY !!                                        ',
     &  'PAS DE VALEUR POUR LE REPERTOIRE FORTRAN !!          ',
     &  'NO VALUE FOR THE FORTRAN DIRECTORY !!                ',
     &  'PAS DE VALEUR POUR LE REPERTOIRE DE SORTIE !!        ',
     &  'NO VALUE FOR THE OUTPUT DIRECTORY !!                 ',
     &  'PAS DE COMMANDE CRAY !!                              ',
     &  'NO INSTRUCTION FOR CRAY !!                           ',
     &  'PAS DE COMMANDE CRAY !!                              ',
     &  'NO INSTRUCTION FOR CRAY !!                           ',
     &  'PAS DE COMMANDE PRE !!                               ',
     &  'NO INSTRUCTION FOR PRE !!                            ',
     &  'PAS DE COMMANDE POST !!                              ',
     &  'NO INSTRUCTION FOR POST !!                           ' /) )
!
!***********************************************************************
!                                    RCS AND SCCS MARKING
!
!***********************************************************************
!
!  INITIALISES
!
      ptvirg = ';'
      quote  = ''''
      guillt = '"'
      deflu  = 0
!
100   deflu = deflu +1
      IF(.NOT.(luign)) THEN
        defatt(deflu)=carlu(lcar,icol,ligne,quote,motcle,SIZE,motign,
     &                      lonign,nmaxr,nficda,len(defatt(deflu)))
      ELSE
        nulatt = carlu(lcar,icol,ligne,quote,motcle,SIZE,motign,
     &                 lonign,nmaxr,nficda,len(nulatt))
      ENDIF
!
      icol = next(icol+1,ligne)
!
      IF (ligne(icol:icol) .EQ. ptvirg) GO TO 100
!
! NO ANALYSIS IF TO BE IGNORED ...
      IF (luign) GO TO 1300
!
      IF (deflu .LT. itai) THEN
        erreur = .true.
        WRITE(lu,*)'FOR THE KEY-WORD : ', param(1:longu)
        WRITE(lu,*)'NOT ENOUGH DATAS DEFINED FOR SUBMIT...'
        WRITE(lu,*)' '
        GO TO 1300
      ENDIF
!
!  EXAMINES THE SUBMIT FIELDS
!
      DO i = 1 , deflu
 200    icola = 0
        analys = defatt(i)
!
!   *** FIELD 1 ***
!
        lga = max(longlu(analys),1)
        IF (analys(icola+1:icola+1).EQ.';') THEN
          lcar = 0
        ELSE
          jcola = precar(icola+1,analys,';',';',';')
          lcar = longlu(analys(icola+1:jcola-1))
          IF (lcar.GT.0) THEN
            field0 = carlu(lcar,icola,analys,guillt,motcle,SIZE,motign,
     &                     lonign,nmaxr,nficda,len(field0))
            lcar = longlu(field0(1:lcar))
          ENDIF
        ENDIF
        IF (lcar.LE.0) THEN
          WRITE(lu,*)'FOR THE KEY-WORD : ', param(1:longu)
          WRITE(lu,*)'INVALID SUBMIT : ',analys(1:lga)
          WRITE(lu,*)'NO FIRST FIELD !!'
          erreur = .true.
          GO TO 1300
        ENDIF
        IF (erreur) GO TO 1300
        field = field0
        CALL majus(field)
!
        champ(1)=100
        DO ii=1,nbchp1
          IF (lcar.EQ.lgmotg(ii).AND.
     &        field(1:min(lcar,10)).EQ.motch1(ii)(1:min(lcar,10))) THEN
            IF (gestd.AND.gechp1(ii).EQ.1) THEN
              defatt(i) = 'NUL;FOR'//defatt(i)(jcola+4:max(lga,jcola+4))
              GO TO 200
            ELSE
!             CHAMP(1)=NOCHMP(II)
              champ(1)=ii
              GOTO 400
            ENDIF
          ENDIF
        ENDDO ! II
!
!   *** FIELD 2 ***
!
400     icola = jcola
        IF (icola.GE.longli) THEN
          lcar = 0
        ELSEIF (analys(icola+1:icola+1).EQ.';') THEN
          lcar = 0
        ELSE
          jcola = precar(icola+1,analys,';',';',';')
          lcar = longlu(analys(icola+1:jcola-1))
          IF (lcar.GT.0) THEN
            field0 = carlu(lcar,icola,analys,guillt,motcle,SIZE,motign,
     &                     lonign,nmaxr,nficda,len(field0))
            lcar = longlu(field0(1:lcar))
          ENDIF
        ENDIF
        IF (lcar.LE.0) THEN
          WRITE(lu,*)'FOR THE KEY-WORD : ', param(1:longu)
          WRITE(lu,*)'INVALID SUBMIT : ',analys(1:lga)
          WRITE(lu,*)'NO SECOND FIELD !! '
          erreur = .true.
          GO TO 1300
        ENDIF
!
        IF (erreur) GO TO 1300
        field = field0
        CALL majus(field)
!
!  SUPPRESSION OF AN OBSOLETE CONTROL
!  THE 2ND SUBMIT FIELD CAN BE DIFFERENT FROM FOR...
!  (CASE OF SUBIEF)
!
        IF (field(1:3).EQ.'OPT') THEN
          champ(2) = 1
        ELSEIF (field(1:3).EQ.'REQ') THEN
          champ(2) = 2
        ELSE
          champ(2) = 3
        ENDIF
!
! ASSIGNS THE INITIAL VALUE TO TROUVE ACCORDING TO CHAMP(1)
        IF (itai.LE.1.AND.i.LE.max(itai,1)) THEN
          IF (champ(2) .EQ. 1) trouve(ntyp,indx)=3
          IF (champ(2) .EQ. 3) trouve(ntyp,indx)=6
          IF (champ(1) .EQ. 4) trouve(ntyp,indx)=9
        ENDIF
!
! IF THE 1ST FIELD IS NOT KNOWN, IGNORES THE REST
! TO BE COMPATIBLE WITH EVOLUTIONS OF THE LAUNCHER
        IF (champ(1).EQ.100) cycle
!
!   *** FIELD 3 ***
!
        icola = jcola
        IF (jcola.GE.longli) THEN
          WRITE(lu,*)'FOR THE KEY-WORD : ', param(1:longu)
          WRITE(lu,*)'INVALID SUBMIT : ',analys(1:lga)
          WRITE(lu,*)'NO THIRD FIELD !! '
          erreur = .true.
          GO TO 1300
        ENDIF
        jcola = precar(icola+1,analys,';',';',';')
!
!   *** FIELD 4 ***
!
        icola = jcola
        IF (icola.GE.longli) THEN
          lcar = 0
        ELSEIF (analys(icola+1:icola+1).EQ.';') THEN
          lcar = 0
        ELSE
          jcola = precar(icola+1,analys,';',';',';')
          lcar = longlu(analys(icola+1:jcola-1))
        ENDIF
        IF (lcar.LE.0) THEN
          WRITE(lu,*)'FOR THE KEY-WORD : ', param(1:longu)
          WRITE(lu,*)'INVALID SUBMIT : ',analys(1:lga)
          erreur = .true.
!
! WRITES THE CORRESPONDING ERROR MESSAGE
          WRITE(lu,*) meserr(2*(champ(1)-1)+lng)
          GO TO 1300
        ENDIF
      ENDDO ! I
!
!-----------------------------------------------------------------------
!
1300  CONTINUE
      RETURN
      END