influ.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\damocles\influ.f
00002 !
00068                      SUBROUTINE INFLU
00069 !                    ****************
00070 !
00071      &( ICOL   , LIGNE  , DEFATT , TROUVE , LUIGN , MOTCLE , SIZE,
00072      &  MOTIGN , LONIGN , NMAXR  , NFICDA , GESTD )
00073 !
00074 !***********************************************************************
00075 ! DAMOCLES   V6P0                                   21/08/2010
00076 !***********************************************************************
00077 !
00078 !
00079 !
00080 !
00081 !
00082 !
00083 !
00084 !
00085 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00086 !| DEFATT         |<--| TABLEAU DES SUBMITS PAR DEFAUT
00087 !| GESTD          |-->| LOGIQUE D'APPEL PAR LE GESTIONNAIRE D'ETUDES
00088 !| ICOL           |<->| POSITION COURANTE DU POINTEUR DANS LA LIGNE
00089 !| LIGNE          |<->| LIGNE EN COURS DE DECODAGE
00090 !| LONIGN         |-->| TABLEAU DES LONGUEURS DES MOTS EDAMOX
00091 !| LUIGN          |-->| LOGIQUE POUR LES MOTS A NE PAS CLASSER
00092 !| MOTCLE         |-->| TABLEAU DES MOTS CLES ACTIFS
00093 !| MOTIGN         |-->| TABLEAU DES MOTS CLES DUS A EDAMOX A IGNORER
00094 !| NFICDA         |-->| NUMERO DE CANAL DU FICHIER DES DONNEES
00095 !| NMAXR          |-->| TABLEAU DES INDEX MAXIMUM REELS PAR TYPES
00096 !| SIZE           |-->| TABLEAU DES LONGUEURS DES MOTS CLES
00097 !| TROUVE         |<->| INDICATEUR D'ETAT DES MOTS CLES
00098 !|                |   | = 0 : AUCUNE VALEUR TROUVEE
00099 !|                |   | = 1 : VALEUR PAR DEFAUT TROUVEE
00100 !|                |   | = 2 : VALEUR TROUVEE (FICHIER DE DONNEES)
00101 !|                |   | = 3 : AUCUNE VALEUR TROUVEE (OPTIONNELLE)
00102 !|                |   | = 5 : TABLEAU DE MOTS A SUBMIT COMPACTE
00103 !|                |   | = 6 : MOT CLE A SUBMIT FORCE NON AFFECTE
00104 !|                |   | = 7 : MOT CLE A SUBMIT FORCE AFFECTE (DICO)
00105 !|                |   | = 8 : MOT CLE A SUBMIT FORCE AFFECTE (CAS)
00106 !|                |   | = 9 : FICHIER DICO : SUBMIT + VALEUR LANCEUR
00107 !|                |   | =10 : FICHIER CAS  : SUBMIT + VALEUR LANCEUR
00108 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00109 !
00110       IMPLICIT NONE
00111 !
00112       EXTERNAL NEXT,PRECAR,CARLU,LONGLU
00113 !
00114       INTEGER       TROUVE(4,*),ICOL,NMAXR(4),NFICDA,SIZE(4,*)
00115       INTEGER       LONIGN(100)
00116       LOGICAL       LUIGN,GESTD
00117       CHARACTER*72  MOTIGN(100),MOTCLE(4,*)
00118       CHARACTER*144 DEFATT(*)
00119       CHARACTER*(*) LIGNE
00120 !
00121       INTEGER       NEXT,PRECAR,LONGLU
00122       CHARACTER*144 CARLU
00123 !
00124       INTEGER       LNG,LU
00125       INTEGER       INDX,NTYP,ITAI,LONGU,NMOT(4),DEFLU
00126       INTEGER       NLIGN,LONGLI
00127       LOGICAL       ERREUR,RETOUR
00128       CHARACTER*72  PARAM
00129 !
00130 !-----------------------------------------------------------------------
00131 !
00132       INTEGER       NBCHP1
00133       PARAMETER (NBCHP1=12)
00134 !
00135       INTEGER       I,LCAR,ICOLA,JCOLA,CHAMP(4),LGA,II
00136       INTEGER       LGMOTG(NBCHP1),GECHP1(NBCHP1)
00137       CHARACTER*1   PTVIRG,QUOTE,GUILLT
00138       CHARACTER*72  MESERR(2*NBCHP1)
00139       CHARACTER*10  MOTCH1(NBCHP1)
00140       CHARACTER*144 NULATT,ANALYS,FIELD,FIELD0
00141 !
00142 !-----------------------------------------------------------------------
00143 !
00144       COMMON / DCINFO / LNG,LU
00145       COMMON / DCNGE  / INDX,NTYP,ITAI,LONGU,NMOT,DEFLU
00146       COMMON / DCNGEC / PARAM
00147       COMMON / DCRARE / ERREUR,RETOUR
00148       COMMON / DCMLIG / NLIGN,LONGLI
00149 !
00150 !-----------------------------------------------------------------------
00151 !
00152 ! ******************* DATABASE FOR THE SUBROUTINE **********************
00153 !
00154 ! DEFINITION OF FIELDS 1
00155       DATA MOTCH1 /'IN','OUT','CAS','DIC','QSUB','LIB','FORTRAN',
00156      &            'DIROUT','USER','ACCT','PRE','POST'/
00157 ! LENGTHS OF THE STRINGS FOR FIELDS 1 DEFINED ABOVE
00158       DATA LGMOTG /2,3,3,3,4,3,7,6,4,4,3,4/
00159 ! CHANGE TO 'NUL;FOR' IF GESTD=.TRUE. ? : 1-YES, 0-NO
00160       DATA GECHP1 /1,1,0,0,0,0,1,1,0,0,0,0/
00161 ! NUMBER OF THE FIELDS TO BE GIVEN TO THESE WORDS --> ERROR MESSAGES
00162 !      DATA NOCHMP /1,2,3,4,5,6,7,8,9,10,11,12/
00163 ! ERROR MESSAGES ASSOCIATED WITH THE FIELD NUMBERS
00164       DATA MESERR /
00165      & 'PAS D''ALLOCATION DE FICHIER D''ENTREE !!',
00166      & 'NO ALLOCATION FOR INPUT FILE !!',
00167      & 'PAS D''ALLOCATION DE FICHIER DE SORTIE !!',
00168      & 'NO ALLOCATION FOR OUTPUT FILE !!',
00169      & 'PAS D''ALLOCATION POUR LE FICHIER CAS !!',
00170      & 'NO ALLOCATION FOR THE STEERING FILE !!',
00171      & 'PAS D''ALLOCATION POUR LE DICTIONNAIRE !!',
00172      & 'NO ALLOCATION FOR THE DICTIONARY !!',
00173      & 'PAS DE COMMANDE CRAY !!','NO INSTRUCTION FOR CRAY !!',
00174      & 'PAS DE LIBRAIRIE !!', 'NO LIBRARY !!',
00175      & 'PAS DE VALEUR POUR LE REPERTOIRE FORTRAN !!',
00176      & 'NO VALUE FOR THE FORTRAN DIRECTORY !!',
00177      & 'PAS DE VALEUR POUR LE REPERTOIRE DE SORTIE !!',
00178      & 'NO VALUE FOR THE OUTPUT DIRECTORY !!',
00179      & 'PAS DE COMMANDE CRAY !!','NO INSTRUCTION FOR CRAY !!',
00180      & 'PAS DE COMMANDE CRAY !!','NO INSTRUCTION FOR CRAY !!',
00181      & 'PAS DE COMMANDE PRE !!','NO INSTRUCTION FOR PRE !!',
00182      & 'PAS DE COMMANDE POST !!','NO INSTRUCTION FOR POST !!'
00183      & /
00184 !
00185 !***********************************************************************
00186 !                                    RCS AND SCCS MARKING
00187 !
00188 !***********************************************************************
00189 !
00190 !  INITIALISES
00191 !
00192       PTVIRG = ';'
00193       QUOTE  = ''''
00194       GUILLT = '"'
00195       DEFLU  = 0
00196 !
00197 100   DEFLU = DEFLU +1
00198       IF(.NOT.(LUIGN)) THEN
00199         DEFATT(DEFLU)=CARLU(LCAR,ICOL,LIGNE,QUOTE,MOTCLE,SIZE,MOTIGN,
00200      &                      LONIGN,NMAXR,NFICDA,LEN(DEFATT(DEFLU)))
00201       ELSE
00202         NULATT = CARLU(LCAR,ICOL,LIGNE,QUOTE,MOTCLE,SIZE,MOTIGN,
00203      &                 LONIGN,NMAXR,NFICDA,LEN(NULATT))
00204       ENDIF
00205 !
00206       ICOL = NEXT(ICOL+1,LIGNE)
00207 !
00208       IF (LIGNE(ICOL:ICOL) .EQ. PTVIRG) GO TO 100
00209 !
00210 ! NO ANALYSIS IF TO BE IGNORED ...
00211       IF (LUIGN) GO TO 1300
00212 !
00213       IF (DEFLU .LT. ITAI) THEN
00214         ERREUR = .TRUE.
00215         IF(LNG.EQ.1) THEN
00216           WRITE(LU,*)'POUR LE MOT CLE : ',PARAM(1:LONGU)
00217           WRITE(LU,*)'PAS ASSEZ DE VALEURS DEFINIES POUR SUBMIT...'
00218         ELSEIF(LNG.EQ.2) THEN
00219           WRITE(LU,*)'FOR THE KEY-WORD : ', PARAM(1:LONGU)
00220           WRITE(LU,*)'NOT ENOUGH DATAS DEFINED FOR SUBMIT...'
00221         ENDIF
00222         WRITE(LU,*)' '
00223         GO TO 1300
00224       ENDIF
00225 !
00226 !  EXAMINES THE SUBMIT FIELDS
00227 !
00228       DO I = 1 , DEFLU
00229  200    ICOLA = 0
00230         ANALYS = DEFATT(I)
00231 !
00232 !   *** FIELD 1 ***
00233 !
00234         LGA = MAX(LONGLU(ANALYS),1)
00235         IF (ANALYS(ICOLA+1:ICOLA+1).EQ.';') THEN
00236           LCAR = 0
00237         ELSE
00238           JCOLA = PRECAR(ICOLA+1,ANALYS,';',';',';')
00239           LCAR = LONGLU(ANALYS(ICOLA+1:JCOLA-1))
00240           IF (LCAR.GT.0) THEN
00241             FIELD0 = CARLU(LCAR,ICOLA,ANALYS,GUILLT,MOTCLE,SIZE,MOTIGN,
00242      &                     LONIGN,NMAXR,NFICDA,LEN(FIELD0))
00243             LCAR = LONGLU(FIELD0(1:LCAR))
00244           ENDIF
00245         ENDIF
00246         IF (LCAR.LE.0) THEN
00247           IF (LNG.EQ.1) THEN
00248             WRITE(LU,*)'POUR LE MOT CLE : ',PARAM(1:LONGU)
00249             WRITE(LU,*)'SUBMIT INCORRECT : ',ANALYS(1:LGA)
00250             WRITE(LU,*)'PAS DE PREMIER CHAMP !!'
00251           ELSEIF (LNG.EQ.2) THEN
00252             WRITE(LU,*)'FOR THE KEY-WORD : ', PARAM(1:LONGU)
00253             WRITE(LU,*)'INVALID SUBMIT : ',ANALYS(1:LGA)
00254             WRITE(LU,*)'NO FIRST FIELD !!'
00255           ENDIF
00256           ERREUR = .TRUE.
00257           GO TO 1300
00258         ENDIF
00259         IF (ERREUR) GO TO 1300
00260         FIELD = FIELD0
00261         CALL MAJUS(FIELD)
00262 !
00263         CHAMP(1)=100
00264         DO II=1,NBCHP1
00265           IF (LCAR.EQ.LGMOTG(II).AND.
00266      &        FIELD(1:MIN(LCAR,10)).EQ.MOTCH1(II)(1:MIN(LCAR,10))) THEN
00267             IF (GESTD.AND.GECHP1(II).EQ.1) THEN
00268               DEFATT(I) = 'NUL;FOR'//DEFATT(I)(JCOLA+4:MAX(LGA,JCOLA+4))
00269               GO TO 200
00270             ELSE
00271 !             CHAMP(1)=NOCHMP(II)
00272               CHAMP(1)=II
00273               GOTO 400
00274             ENDIF
00275           ENDIF
00276         ENDDO ! II
00277 !
00278 !   *** FIELD 2 ***
00279 !
00280 400     ICOLA = JCOLA
00281         IF (ICOLA.GE.LONGLI) THEN
00282           LCAR = 0
00283         ELSEIF (ANALYS(ICOLA+1:ICOLA+1).EQ.';') THEN
00284           LCAR = 0
00285         ELSE
00286           JCOLA = PRECAR(ICOLA+1,ANALYS,';',';',';')
00287           LCAR = LONGLU(ANALYS(ICOLA+1:JCOLA-1))
00288           IF (LCAR.GT.0) THEN
00289             FIELD0 = CARLU(LCAR,ICOLA,ANALYS,GUILLT,MOTCLE,SIZE,MOTIGN,
00290      &                     LONIGN,NMAXR,NFICDA,LEN(FIELD0))
00291             LCAR = LONGLU(FIELD0(1:LCAR))
00292           ENDIF
00293         ENDIF
00294         IF (LCAR.LE.0) THEN
00295           IF (LNG.EQ.1) THEN
00296             WRITE(LU,*)'POUR LE MOT CLE : ',PARAM(1:LONGU)
00297             WRITE(LU,*)'SUBMIT INCORRECT : ',ANALYS(1:LGA)
00298             WRITE(LU,*)'PAS DE DEUXIEME CHAMP !!'
00299           ELSEIF (LNG.EQ.2) THEN
00300             WRITE(LU,*)'FOR THE KEY-WORD : ', PARAM(1:LONGU)
00301             WRITE(LU,*)'INVALID SUBMIT : ',ANALYS(1:LGA)
00302             WRITE(LU,*)'NO SECOND FIELD !! '
00303           ENDIF
00304           ERREUR = .TRUE.
00305           GO TO 1300
00306         ENDIF
00307 !
00308         IF (ERREUR) GO TO 1300
00309         FIELD = FIELD0
00310         CALL MAJUS(FIELD)
00311 !
00312 !  NOTE JMH 13/11/2001 : SUPPRESSION OF AN OBSOLETE CONTROL
00313 !  THE 2ND SUBMIT FIELD CAN BE DIFFERENT FROM FOR...
00314 !  (CASE OF SUBIEF)
00315 !
00316         IF (FIELD(1:3).EQ.'OPT') THEN
00317           CHAMP(2) = 1
00318         ELSEIF (FIELD(1:3).EQ.'REQ') THEN
00319           CHAMP(2) = 2
00320 !       ELSEIF (FIELD(1:3).EQ.'FOR') THEN
00321         ELSE
00322           CHAMP(2) = 3
00323 !       ELSE
00324 !         ERREUR = .TRUE.
00325 !         IF (LNG.EQ.1) THEN
00326 !           WRITE(LU,*)'POUR LE MOT CLE : ',PARAM(1:LONGU)
00327 !           WRITE(LU,*)'SUBMIT INCORRECT : ',ANALYS(1:LGA)
00328 !           WRITE(LU,*)'DEUXIEME CHAMP INCONNU : ',FIELD0(1:LCAR)
00329 !         ELSEIF (LNG.EQ.2) THEN
00330 !           WRITE(LU,*)'FOR THE KEY-WORD : ', PARAM(1:LONGU)
00331 !           WRITE(LU,*)'INVALID SUBMIT : ',ANALYS(1:LGA)
00332 !           WRITE(LU,*)'SECOND FIELD UNKNOWN : ',FIELD0(1:LCAR)
00333 !         ENDIF
00334 !         GO TO 1300
00335         ENDIF
00336 !
00337 ! ASSIGNS THE INITIAL VALUE TO TROUVE ACCORDING TO CHAMP(1)
00338         IF (ITAI.LE.1.AND.I.LE.MAX(ITAI,1)) THEN
00339           IF (CHAMP(2) .EQ. 1) TROUVE(NTYP,INDX)=3
00340           IF (CHAMP(2) .EQ. 3) TROUVE(NTYP,INDX)=6
00341 !         IF (CHAMP(1) .EQ. 3) TROUVE(NTYP,INDX)=10
00342           IF (CHAMP(1) .EQ. 4) TROUVE(NTYP,INDX)=9
00343         ENDIF
00344 !
00345 ! IF THE 1ST FIELD IS NOT KNOWN, IGNORES THE REST
00346 ! TO BE COMPATIBLE WITH EVOLUTIONS OF THE LAUNCHER
00347         IF (CHAMP(1).EQ.100) CYCLE
00348 !
00349 !   *** FIELD 3 ***
00350 !
00351         ICOLA = JCOLA
00352         IF (JCOLA.GE.LONGLI) THEN
00353           IF (LNG.EQ.1) THEN
00354             WRITE(LU,*)'POUR LE MOT CLE : ',PARAM(1:LONGU)
00355             WRITE(LU,*)'SUBMIT INCORRECT : ',ANALYS(1:LGA)
00356             WRITE(LU,*)'PAS DE TROISIEME CHAMP !!'
00357           ELSEIF (LNG.EQ.2) THEN
00358             WRITE(LU,*)'FOR THE KEY-WORD : ', PARAM(1:LONGU)
00359             WRITE(LU,*)'INVALID SUBMIT : ',ANALYS(1:LGA)
00360             WRITE(LU,*)'NO THIRD FIELD !! '
00361           ENDIF
00362           ERREUR = .TRUE.
00363           GO TO 1300
00364         ENDIF
00365         JCOLA = PRECAR(ICOLA+1,ANALYS,';',';',';')
00366 !
00367 !   *** FIELD 4 ***
00368 !
00369         ICOLA = JCOLA
00370         IF (ICOLA.GE.LONGLI) THEN
00371           LCAR = 0
00372         ELSEIF (ANALYS(ICOLA+1:ICOLA+1).EQ.';') THEN
00373            LCAR = 0
00374         ELSE
00375            JCOLA = PRECAR(ICOLA+1,ANALYS,';',';',';')
00376            LCAR = LONGLU(ANALYS(ICOLA+1:JCOLA-1))
00377         ENDIF
00378         IF (LCAR.LE.0) THEN
00379           IF (LNG.EQ.1) THEN
00380             WRITE(LU,*)'POUR LE MOT CLE : ',PARAM(1:LONGU)
00381             WRITE(LU,*)'SUBMIT INCORRECT : ',ANALYS(1:LGA)
00382           ELSEIF (LNG.EQ.2) THEN
00383             WRITE(LU,*)'FOR THE KEY-WORD : ', PARAM(1:LONGU)
00384             WRITE(LU,*)'INVALID SUBMIT : ',ANALYS(1:LGA)
00385           ENDIF
00386           ERREUR = .TRUE.
00387 !
00388 ! WRITES THE CORRESPONDING ERROR MESSAGE
00389           WRITE(LU,*) MESERR(2*(CHAMP(1)-1)+LNG)
00390           GO TO 1300
00391         ENDIF
00392       ENDDO ! I
00393 !
00394 !-----------------------------------------------------------------------
00395 !
00396 1300  CONTINUE
00397       RETURN
00398       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0