dico.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\damocles\dico.f
00002 !
00064                      SUBROUTINE DICO
00065 !                    ***************
00066 !
00067      &( ITYP   , NUMERO , ILONG  , CHAINE , MOTCLE , NMOT   , MOTPRO ,
00068      &  LONPRO , SIZE   , UTINDX , LANGUE , AIDLNG , MOTIGN , NIGN   ,
00069      &  LUIGN  , TYPIGN , LONIGN , NFICDA , NBLANG , NMAXR )
00070 !
00071 !***********************************************************************
00072 ! DAMOCLES   V6P0                                   21/08/2010
00073 !***********************************************************************
00074 !
00075 !
00076 !
00077 !
00078 !
00079 !
00080 !
00081 !
00082 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00083 !| AIDLNG         |<--| LOGIQUE .TRUE. SI L'AIDE EST CELLE DE LNG
00084 !| CHAINE         |-->| CHAINE A ANALYSER
00085 !| ILONG          |-->| LONGUEUR DE LA CHAINE A ANALYSER
00086 !| ITYP           |<--| TYPE DU MOT-CLE  :    1  ENTIER
00087 !|                |   | 2  REEL
00088 !|                |   | 3  LOGIQUE
00089 !|                |   | 4  CARACTERES
00090 !|                |   | 5  MOT RESERVE
00091 !|                |   | 0  MOT INCONNU
00092 !| LANGUE         |<--| LOGIQUE=.TRUE. SI LA CHAINE EST RECONNUE
00093 !| LONIGN         |-->| TABLEAU DES LONGUEURS DES MOTS DE MOTIGN
00094 !| LONPRO         |-->| LONGUEURS DES MOTS CLES DE MOTPRO
00095 !| LUIGN          |-->| LOGIQUE POUR LES MOTS A NE PAS CLASSER
00096 !| MOTCLE         |-->| TABLEAU DES MOTS CLES ACTIFS
00097 !| MOTIGN         |-->| TABLEAU DES MOTS CLES DUS A EDAMOX A IGNORER
00098 !| MOTPRO         |-->| TABLEAU DES MOTS CLES RESERVES AU PROGRAMME
00099 !| NBLANG         |-->| NOMBRE DE LANGUES CONNUES
00100 !| NFICDA         |-->| NUMERO DE CANAL DU FICHIER DES DONNEES
00101 !| NIGN           |-->| NOMBRE DE MOTS CLES DUS A EDAMOX A IGNORER
00102 !| NMAXR          |-->| TABLEAU DES INDEX MAXIMUM REELS PAR TYPES
00103 !| NMOT           |<->| TABLEAU DU NOMBRE DE MOTS CLES PAR TYPE
00104 !|                |   | NMOT(1) ENTIERS
00105 !|                |   | NMOT(2) REELS
00106 !|                |   | NMOT(3) LOGIQUES
00107 !|                |   | NMOT(4) CARACTERES
00108 !| NUMERO         |<--| ORDRE DU MOT-CLE PARMI CEUX DE SON TYPE
00109 !| SIZE           |-->| TABLEAU DES LONGUEURS DES MOTS CLES
00110 !| TYPIGN         |-->| TABLEAU DES TYPES DES MOTS EDAMOX A IGNORER
00111 !| UTINDX         |-->| TABLEAU DE LOGIQUES D'UTILISATION DES INDEX
00112 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00113 !
00114       IMPLICIT NONE
00115 !
00116       INTEGER       NMOT(4),SIZE(4,*),ITYP,NUMERO,ILONG,NBLANG,NMAXR(4)
00117       INTEGER       NIGN,NFICDA,TYPIGN(100),LONIGN(100),LONPRO(15)
00118       LOGICAL       UTINDX(4,*),LANGUE,LUIGN,AIDLNG
00119       CHARACTER*(*) MOTCLE(4,*),MOTPRO(*),CHAINE
00120       CHARACTER*1   LNGPRO(9)
00121       CHARACTER*9   RUBPRO(5),MOTLNG
00122       CHARACTER*72  MOTIGN(100)
00123 !
00124       INTEGER       LNG,LU
00125       INTEGER       NLIGN,LONGLI
00126       INTEGER       NFIC
00127       LOGICAL       ERREUR,RETOUR
00128 !
00129 !-----------------------------------------------------------------------
00130 !
00131       INTEGER       INDX,LGRUB(5),I,K,LNGINT,VALNUM(5)
00132 !
00133 !-----------------------------------------------------------------------
00134 !
00135       COMMON / DCINFO / LNG,LU
00136       COMMON / DCRARE / ERREUR,RETOUR
00137       COMMON / DCMLIG / NLIGN,LONGLI
00138       COMMON / DCCHIE / NFIC
00139 !
00140 !-----------------------------------------------------------------------
00141 !
00142       DATA LNGPRO /'1','2','3','4','5','6','7','8','9'/
00143       DATA RUBPRO /'NOM','DEFAUT','AIDE','CHOIX','RUBRIQUE'/
00144 ! NUMBER OF LETTERS IN THE RUBPRO NAMES
00145       DATA LGRUB  /3,6,4,5,8/
00146 ! CORRESPONDENCES BETWEEN RUBPRO AND MOTPRO
00147       DATA VALNUM /1,5,6,7,8/
00148 !
00149 !***********************************************************************
00150 !                                    RCS AND SCCS MARKING
00151 !
00152 !***********************************************************************
00153 !
00154 ! LANGUE IS ONLY USED WHEN READING THE DICTIONARY.
00155 ! IT IS NOT USED WHEN READING THE USER FILE.
00156 !
00157       LANGUE = .FALSE.
00158       AIDLNG = .FALSE.
00159 !
00160       LNGINT = LNG - 1
00161 !
00162 !*******************************************************
00163 !  1) SEARCHES THROUGH THE USER KEYWORDS:
00164 !*******************************************************
00165 !
00166       IF (NFIC.EQ.NFICDA) THEN
00167         DO ITYP = 1,4
00168           DO INDX=1,NMAXR(ITYP)
00169             IF (UTINDX(ITYP,INDX)) THEN
00170               K=SIZE(ITYP,INDX)
00171               IF(K.EQ.ILONG) THEN
00172                 IF(CHAINE(1:K).EQ.MOTCLE(ITYP,INDX)(1:K)) THEN
00173                   NUMERO=INDX
00174                   GO TO 1000
00175                 ENDIF
00176               ENDIF
00177             ENDIF
00178           ENDDO ! INDX
00179         ENDDO ! ITYP
00180 !
00181 ! IF NOT, DETERMINES IF ITS AN EDAMOX KEYWORD OF INDEX = -1
00182 !
00183         DO I=1,NIGN
00184           IF(LONIGN(I).EQ.ILONG) THEN
00185             IF(CHAINE(1:ILONG).EQ.MOTIGN(I)(1:ILONG)) THEN
00186               ITYP = TYPIGN(I)
00187               LUIGN = .TRUE.
00188               GO TO 1000
00189             ENDIF
00190           ENDIF
00191         ENDDO ! I
00192 !
00193 ! END OF SEARCH THROUGH THE USER KEYWORDS
00194         GO TO 910
00195       ENDIF
00196 !
00197 !
00198 !*********************************************
00199 !  2) SEARCHES THROUGH THE RESERVED WORDS:
00200 !*********************************************
00201 !
00202 !  AIDLNG (LOGICAL) IS TRUE IF THE HELP IS THAT OF THE SELECTED LANGUAGE
00203 !
00204 ! IF IT IS AN ENGLISH WORD: NO NEED TO LOOK FOR IT AMONG THE FR
00205 ! THAT SAVES 50 TESTS PER WORD FOR TELEMAC FOR EXAMPLE
00206 ! (ESTIMATED 6500 TESTS FOR TELEMAC)
00207       IF (CHAINE(ILONG:ILONG).EQ.'1') GOTO 125
00208 !
00209       DO I=1,15
00210         IF (ILONG.EQ.LONPRO(I)) THEN
00211           IF (CHAINE(1:ILONG).EQ.MOTPRO(I)(1:ILONG)) THEN
00212 !           IF 'AIDE' AND LNG=FRANCAIS, WILL EDIT THE HELP IF DOC
00213             IF (I.EQ.6 .AND. LNGINT .EQ. 0) AIDLNG = .TRUE.
00214             LANGUE = .TRUE.
00215             NUMERO = I
00216             ITYP   = 5
00217             GO TO 1000
00218           ENDIF
00219         ENDIF
00220       ENDDO ! I
00221 !
00222 !  IF NOT: LOOKS FOR IT AMONG THE RESERVED WORDS FOR LANGUAGES
00223 !          OTHER THAN FRENCH. (MAX NBLANG LANGUAGES AND NBLANG<=10)
00224 !
00225 ! LNG IS THE EXTERNAL LANGUAGE PARAMETER (1 = FRENCH, 2 = ENGLISH ...)
00226 ! LNGINT IS THE LANGUAGE PARAMETER INTERNAL TO DAMOCLE
00227 ! (I.E. 0 = FRENCH, 1 = ENGLISH ...)
00228 !
00229 !  AIDLNG = NUMBER OF THE HELP LINE IN REQUESTED LANGUAGE
00230 !
00231 125   CONTINUE
00232       IF (NBLANG.GE.2) THEN
00233       DO I=1,5
00234       DO K=1,NBLANG-1
00235         IF (LGRUB(I)+1.EQ.ILONG) THEN
00236         MOTLNG = RUBPRO(I)(1:LGRUB(I))//LNGPRO(K)(1:1)
00237         IF (CHAINE(1:ILONG).EQ.MOTLNG(1:ILONG)) THEN
00238           NUMERO=VALNUM(I)
00239 !
00240           IF (I.EQ.3 .AND. K.EQ.LNGINT) AIDLNG = .TRUE.
00241 !
00242           ITYP = 5
00243 !
00244 ! RETURNS LANGUE = .TRUE. ONLY FOR DAMOCLE KEYWORDS
00245 ! EXCEPT FOR 'AIDE', IN WHICH CASE LANGUE IS NOT USED
00246 ! NOT THE SAME TREATMENT DEPENDING ON THE SELECTED LANGUAGE
00247           IF (K.EQ.LNGINT.AND.I.GE.1.AND.I.LE.3) LANGUE = .TRUE.
00248           GO TO 1000
00249         ENDIF
00250         ENDIF
00251       ENDDO ! K
00252       ENDDO ! I
00253       ENDIF
00254 !
00255 !  6) ERROR : KEYWORD UNKNOWN
00256 !
00257  910  CONTINUE
00258       ERREUR = .TRUE.
00259       ITYP = 0
00260       IF(LNG.EQ.1) THEN
00261         WRITE(LU,*)'*************************************************'
00262         WRITE(LU,*)'A LA LIGNE ',NLIGN,' LE MOT CLE SUIVANT : ',
00263      &              CHAINE(1:ILONG),' EST INCONNU ...'
00264         WRITE(LU,*)'*************************************************'
00265       ELSEIF(LNG.EQ.2) THEN
00266         WRITE(LU,*)'*************************************************'
00267         WRITE(LU,*)'AT LINE    ',NLIGN,' THE KEY-WORD       : ',
00268      &              CHAINE(1:ILONG),' IS UNKNOWN...'
00269         WRITE(LU,*)'*************************************************'
00270       ENDIF
00271 !
00272 1000  CONTINUE
00273 !
00274       RETURN
00275       END

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