The TELEMAC-MASCARET system  trunk
dico_data.f
Go to the documentation of this file.
1  ! brief set of function to read/write a dictionary
2  MODULE dico_data
3  USE declarations_damocles
4  USE declarations_special
5  IMPLICIT NONE
6  ! brief Max size of aide
7  INTEGER, PARAMETER :: aide_len = 2400
8  ! brief Size for the CHOIX string
9  INTEGER, PARAMETER :: choix_len = 2500
10  ! brief Size for the DEFAUT string
11  INTEGER, PARAMETER :: defaut_len = 1400
12  ! brief Size for the Condition string
13  INTEGER, PARAMETER :: cond_len = 700
14  ! brief Size for the Consigne string
15  INTEGER, PARAMETER :: consigne_len = 500
16  ! brief Size for the Mnemo string
17  INTEGER, PARAMETER :: string_len = path_len
18  ! brief Size for the Keyword name
19  INTEGER, PARAMETER :: keyword_len = 72
20  ! brief Maximum number of dependencies
21  INTEGER, PARAMETER :: maxdep = 18
22  ! brief Maximum number of conditions
23  INTEGER, PARAMETER :: maxcond = 9
24  ! brief Maximum number of conditions
25  INTEGER, PARAMETER :: maxenum = 70
26  ! brief type for a keyword
27  TYPE keyword
28  ! param Name of the ley in French and English
29  CHARACTER(LEN=KEYWORD_LEN) :: knom(2)
30  ! param Type fo the key word 1:integer 2:real 3:logical 4: String
31  INTEGER :: ktype
32  ! param Index of the keyword
33  INTEGER :: kindex
34  ! param Name of the variable containing the keyword in the Fortran code
35  CHARACTER(LEN=STRING_LEN) :: mnemo
36  ! To Be defined
37  ! param Size of the keyword 0: 1: 2:
38  INTEGER :: taille
39  ! param String containing information on file keyword
40  CHARACTER(LEN=STRING_LEN) :: submit
41  ! param Default value in frecnh and in english
42  CHARACTER(LEN=DEFAUT_LEN) :: defaut(2)
43  ! param List of values for the keyword
44  CHARACTER(LEN=CHOIX_LEN) :: choix(2)
45  ! param Hash table when choix is in form 'id'='name'
46  CHARACTER(LEN=KEYWORD_LEN) :: hash_id(maxenum,2)
47  CHARACTER(LEN=KEYWORD_LEN) :: hash_val(maxenum,2)
48  ! param Classification of the keyword
49  CHARACTER(LEN=STRING_LEN) :: rubrique(2,3)
50  ! param
51  CHARACTER(LEN=STRING_LEN) :: compose
52  ! param
53  CHARACTER(LEN=STRING_LEN) :: comport
54  ! param
55  CHARACTER(LEN=STRING_LEN) :: controle
56  ! param
57  CHARACTER(LEN=STRING_LEN) :: apparence
58  ! param Level of the keyword
59  INTEGER :: niveau
60  ! param help on the keyword in french and in english
61  CHARACTER(LEN=AIDE_LEN) :: aide(2)
62  ! param list of ikey that depend on cond(i)
63  INTEGER depen(maxcond,maxdep)
64  ! param string conition for displaying of keyword
65  CHARACTER(LEN=COND_LEN) cond(maxcond)
66  ! param string conition for displaying of keyword
67  CHARACTER(LEN=CONSIGNE_LEN) consigne(maxcond,2)
68  ! param Hash table for lists
69  END TYPE keyword
70 !
71  ! brief Max number of keyword per type
72  INTEGER, PARAMETER :: nmax=121
73  ! brief Max number of rubrique
74  INTEGER, PARAMETER :: rmax=50
75 !
76  ! brief array of keyword contains the dictionary info once read
77  TYPE(keyword) :: mydico(nmax*4)
78  ! brief Number of keywords in mydico
79  INTEGER :: nkey=0
80 !
81  ! Contains the name of each rubriques for each level and each
82  ! language
83  CHARACTER(LEN=STRING_LEN) :: rubrique(2,rmax,3)
84  ! brief Dependancies between rubriques
85  LOGICAL, ALLOCATABLE :: rub1_dep(:,:),rub2_dep(:,:,:)
86  INTEGER :: nrub(2,3)
87  CHARACTER(LEN=1) :: rubrique_info(rmax,3)
88 !
89  CONTAINS
90  !
91  ! brief write an integer into a string
92  !
93  ! param string The output string
94  ! param i the integer to write
95  ! param pos the position of the first non blank character
96  SUBROUTINE int2str(STRING,I,POS)
97  IMPLICIT NONE
98  !
99  CHARACTER(LEN=3),INTENT(INOUT) :: STRING
100  INTEGER,INTENT(IN) :: I
101  INTEGER,INTENT(INOUT) :: POS
102  !
103  WRITE(string,'(I3)') i
104  pos=1
105  DO
106  IF(string(pos:pos).NE.' ') EXIT
107  pos=pos+1
108  ENDDO
109  END SUBROUTINE
110  !
111  ! brief Fill the array rubrique that contains the list of the rtubriques
112  !
113  SUBROUTINE check_index(NFIC)
114  IMPLICIT NONE
115  !
116  INTEGER, INTENT(IN) :: NFIC
117  !
118  INTEGER IKEY,ITYP,I,IERR,J
119  INTEGER NTYP(4),OLD_NTYP(4)
120  INTEGER MAX_IDX(4)
121  INTEGER,ALLOCATABLE :: ITYP2KEY(:,:)
122  LOGICAL,ALLOCATABLE :: IDX_USED(:,:)
123  CHARACTER(LEN=PATH_LEN) :: USED_IDX(4)
124  CHARACTER(LEN=3) :: I2S
125  INTEGER :: LAST_TRUE,IDX
126  !
127  ! Count the number of keyword by type
128  !
129  ntyp = 0
130  max_idx = 0
131  DO ikey=1,nkey
132  ityp = mydico(ikey)%KTYPE
133  ntyp(ityp) = ntyp(ityp) + 1
134  max_idx(ityp) = max(max_idx(ityp),mydico(ikey)%KINDEX)
135  ENDDO
136  IF(nfic.EQ.6) THEN
137  WRITE(*,*) '---- INDEX INFORMATIONS ----'
138  WRITE(*,*) 'NUMBER OF KEY WORD BY TYPE AND MAX INDEX:'
139  WRITE(*,*) 'FOR INTEGER: ',ntyp(1),max_idx(1)
140  WRITE(*,*) 'FOR REAL : ',ntyp(2),max_idx(2)
141  WRITE(*,*) 'FOR LOGICAL: ',ntyp(3),max_idx(3)
142  WRITE(*,*) 'FOR STRING : ',ntyp(4),max_idx(4)
143  ENDIF
144  ALLOCATE(ityp2key(maxval(ntyp),4),stat=ierr)
145  CALL check_allocate(ierr,'ITYP2KEY')
146  old_ntyp = ntyp
147  ntyp = 0
148  ! Computting the ityp2key array
149  ! Loop on all types
150  DO i=1,4
151  ! Loop on all indexes
152  DO idx=1,max_idx(i)
153  ! Identifying the key associated to the idx
154  DO ikey=1,nkey
155  ityp = mydico(ikey)%KTYPE
156  IF(i.NE.ityp) cycle
157  IF(mydico(ikey)%KINDEX.NE.idx) cycle
158  ntyp(ityp) = ntyp(ityp) + 1
159  ityp2key(ntyp(ityp),ityp) = ikey
160  EXIT
161  ENDDO
162  ENDDO
163  ENDDO
164 !
165  DO i=1,4
166  IF(ntyp(i).NE.old_ntyp(i)) THEN
167  WRITE(*,*) 'ERROR ON INDEX FOR TYPE',i
168  CALL plante(1)
169  ENDIF
170  ENDDO
171  !
172  ALLOCATE(idx_used(maxval(max_idx),4),stat=ierr)
173  CALL check_allocate(ierr,'IDX_USED')
174  idx_used = .false.
175  DO ikey=1,nkey
176  idx_used(mydico(ikey)%KINDEX,mydico(ikey)%KTYPE) = .true.
177  ENDDO
178  DO ityp=1,4
179  used_idx(ityp) = repeat(' ',path_len)
180  IF(ntyp(ityp).EQ.0) cycle
181  last_true = 1
182  last_true = mydico(ityp2key(1,ityp))%KINDEX
183  CALL int2str(i2s,last_true,i)
184  used_idx(ityp)(1:1) = i2s(i:3)
185  DO j=2,ntyp(ityp)
186  ikey = ityp2key(j,ityp)
187  idx = mydico(ikey)%KINDEX
188  IF(idx.EQ.last_true+1) THEN
189  last_true = idx
190  ELSE
191  CALL int2str(i2s,last_true,i)
192  used_idx(ityp) = trim(used_idx(ityp)) // '-' // i2s(i:3)
193  last_true = idx
194  CALL int2str(i2s,last_true,i)
195  used_idx(ityp) = trim(used_idx(ityp)) // ',' // i2s(i:3)
196  ENDIF
197  ENDDO
198  IF(idx_used(max_idx(ityp),ityp)
199  & .AND.idx_used(max_idx(ityp)-1,ityp)) THEN
200  CALL int2str(i2s,max_idx(ityp),i)
201  used_idx(ityp) = trim(used_idx(ityp)) // '-' // i2s(i:3)
202  ENDIF
203  ENDDO
204  WRITE(nfic,'(A)') '/'
205  WRITE(nfic,'(3A,I3)') '/ INTEGER INDEX USED: ',trim(used_idx(1)),
206  & ' OUT OF ',ntyp(1)
207  WRITE(nfic,'(3A,I3)') '/ REAL INDEX USED: ',trim(used_idx(2)),
208  & ' OUT OF ',ntyp(2)
209  WRITE(nfic,'(3A,I3)') '/ LOGICAL INDEX USED: ',trim(used_idx(3)),
210  & ' OUT OF ',ntyp(3)
211  WRITE(nfic,'(3A,I3)') '/ STRING INDEX USED: ',trim(used_idx(4)),
212  & ' OUT OF ',ntyp(4)
213  WRITE(nfic,'(A)') '/'
214  DEALLOCATE(idx_used)
215  DEALLOCATE(ityp2key)
216  !
217  END SUBROUTINE
218  !
219  ! brief Fill the array rubrique that contains the list of the rtubriques
220  !
221  SUBROUTINE identify_rubrique()
222  IMPLICIT NONE
223  !
224  INTEGER :: I,J,IKEY,LNG,RKEY
225  LOGICAL :: ALREADY_IN
226  !
227  ! Check that a rubrique has not the same name as a keyword
228  ! Loop on all languge
229  DO lng=1,2
230  nrub(lng,:) = 0
231  ! Get the first rubriques
232  DO i=1,3
233  IF(mydico(1)%RUBRIQUE(lng,i).NE.' ') THEN
234  nrub(lng,i) = nrub(lng,i) + 1
235  rubrique(lng,nrub(lng,i),i) = mydico(1)%RUBRIQUE(lng,i)
236  rkey = identify_keyword(
237  & mydico(1)%RUBRIQUE(lng,i),lng)
238  IF (rkey.NE.-1) THEN
239  WRITE(*,*) 'ERROR RUBRIQUE: ',
240  & trim(mydico(1)%RUBRIQUE(lng,i))
241  WRITE(*,*) 'IS ALSO A KEYWORD PLEASE RENAME RUBRIQUE'
242  CALL plante(1)
243  ENDIF
244  ENDIF
245  ENDDO
246  DO ikey=1,nkey
247  DO i=1,3
248  IF(mydico(ikey)%RUBRIQUE(lng,i).NE.' ') THEN
249  ! Check if keyword already found
250  already_in = .false.
251  DO j=1,nrub(lng,i)
252  IF(mydico(ikey)%RUBRIQUE(lng,i)
253  & .EQ.rubrique(lng,j,i)) THEN
254  already_in = .true.
255  EXIT
256  ENDIF
257  ENDDO
258  ! If new rubrique adding it to the rubrique array
259  IF(.NOT.already_in) THEN
260  nrub(lng,i) = nrub(lng,i) + 1
261  rubrique(lng,nrub(lng,i),i) =
262  & mydico(ikey)%RUBRIQUE(lng,i)
263  rkey = identify_keyword(
264  & mydico(ikey)%RUBRIQUE(lng,i),lng)
265  IF (rkey.NE.-1) THEN
266  WRITE(*,*) 'ERROR RUBRIQUE: ',
267  & trim(mydico(ikey)%RUBRIQUE(lng,i))
268  WRITE(*,*) 'IS ALSO A KEYWORD PLEASE RENAME RUBRIQUE'
269  ENDIF
270  ENDIF
271  ENDIF
272  ENDDO
273  ENDDO
274 
275  ENDDO ! LNG
276  END SUBROUTINE
277  !
278  ! brief Fill the array rubrique_tree that contains dependencies of
279  ! each rubriques
280  !
281  SUBROUTINE identify_rubrique_depends()
282  IMPLICIT NONE
283  !
284  INTEGER :: IRUB1,IRUB2,IRUB3,IKEY
285  INTEGER :: LNG
286  INTEGER :: IERR
287  !
288  ! Loop on all languge
289  lng = 1
290  ALLOCATE(rub1_dep(nrub(lng,1),max(nrub(lng,2),1)),
291  & stat=ierr)
292  CALL check_allocate(ierr,'RUB1_DEP')
293  ALLOCATE(rub2_dep(nrub(lng,1),max(nrub(lng,2),1),
294  & max(nrub(lng,3),1)),
295  & stat=ierr)
296  CALL check_allocate(ierr,'RUB2_DEP')
297  rub1_dep(:,:) = .false.
298  rub2_dep(:,:,:) = .false.
299  DO irub1 = 1,nrub(lng,1)
300  DO irub2 = 1,nrub(lng,2)
301  ! If we have no level 3 the loop is not done
302  IF (nrub(lng,3).NE.0) THEN
303  DO irub3 = 1,nrub(lng,3)
304  DO ikey=1,nkey
305  IF(has_rubrique(ikey,irub1,1,lng).AND.
306  & has_rubrique(ikey,irub2,2,lng).AND.
307  & has_rubrique(ikey,irub3,3,lng)) THEN
308  ! Link between 2 and 3
309  rub2_dep(irub1,irub2,irub3) = .true.
310  ENDIF
311  IF(has_rubrique(ikey,irub1,1,lng).AND.
312  & has_rubrique(ikey,irub2,2,lng)) THEN
313  ! Link between 1 and 2
314  rub1_dep(irub1,irub2) = .true.
315  ENDIF
316  ENDDO
317  ENDDO
318  ELSE
319  DO ikey=1,nkey
320  IF(has_rubrique(ikey,irub1,1,lng).AND.
321  & has_rubrique(ikey,irub2,2,lng)) THEN
322  ! Link between 1 and 2
323  rub1_dep(irub1,irub2) = .true.
324  ENDIF
325  ENDDO
326  ENDIF
327  ENDDO
328  ENDDO
329 
330  DO irub1 = 1,nrub(lng,1)
331  WRITE(*,*) repeat('--',1),trim(rubrique(lng,irub1,1))
332  DO irub2 = 1,nrub(lng,2)
333  IF(rub1_dep(irub1,irub2)) THEN
334  WRITE(*,*) repeat('--',2),trim(rubrique(lng,irub2,2))
335  ENDIF
336  DO irub3 = 1,nrub(lng,3)
337  IF(rub2_dep(irub1,irub2,irub3)) THEN
338  WRITE(*,*) repeat('--',3),trim(rubrique(lng,irub3,3))
339  ENDIF
340  ENDDO
341  ENDDO
342  ENDDO
343  END SUBROUTINE
344  !
345  ! brief Identify the index and level of a rubrique
346  !
347  ! param rub Name of the rubrique
348  ! param idx index of the rubrique
349  ! param level Level of the rubrique
350  !
351  SUBROUTINE identify_rubrique_idx(RUB,IDX,LEVEL)
352  IMPLICIT NONE
353  !
354  CHARACTER(LEN=STRING_LEN) :: RUB
355  INTEGER, INTENT(OUT) :: IDX
356  INTEGER, INTENT(OUT) :: LEVEL
357  !
358  INTEGER :: I,ILEVEL
359  !
360  ! Check that a rubrique has not the same name as a keyword
361  ! Loop on all languge
362  idx = -1
363  level = -1
364  DO ilevel=1,3
365  DO i=1,nrub(lng_en,ilevel)
366  IF(rubrique(lng_en,i,ilevel).EQ.rub) THEN
367  idx = i
368  level = ilevel
369  RETURN
370  ENDIF
371  ENDDO
372  ENDDO
373  END SUBROUTINE
374  ! brief Return the hash value linked to the hash_id
375  !
376  ! param ikey Id of the keyword
377  ! param hash_id value in the hash_id array
378  ! param lng Language to take into account
379  CHARACTER(LEN=KEYWORD_LEN) FUNCTION get_hash_value(IKEY,ID,LNG)
380  !
381  IMPLICIT NONE
382  !
383  INTEGER, INTENT(IN) :: IKEY
384  CHARACTER(LEN=KEYWORD_LEN) :: ID
385  INTEGER, INTENT(IN) :: LNG
386  !
387  INTEGER I
388  get_hash_value = repeat(' ',keyword_len)
389  DO i=1,maxenum
390  ! If we reach an empty id it is the end of ids
391  IF(mydico(ikey)%HASH_ID(i,lng)(1:1).EQ.' ') EXIT
392  IF (id.EQ.mydico(ikey)%HASH_ID(i,lng)) THEN
393  get_hash_value = mydico(ikey)%HASH_VAL(i,lng)
394  EXIT
395  ENDIF
396  ENDDO
397  END FUNCTION
398  ! brief write in canal a list of values from a keyword
399  !+ as neatly as possible
400  !
401  ! param nfic file canal
402  ! param ktype Type of the keyword
403  ! param str Language of the ouput
404  ! param str_len Length of the keyword value
405  ! param cmd Command to be printed at the beginning of the list
406  ! param cmd_len Length of the cmd string
407  SUBROUTINE dump_list(NFIC,KTYPE,STR,STR_LEN,CMD,CMD_LEN)
408  IMPLICIT NONE
409  !
410  INTEGER,INTENT(IN) :: NFIC
411  INTEGER, INTENT(IN) :: KTYPE
412  INTEGER, INTENT(IN) :: STR_LEN
413  CHARACTER(LEN=STR_LEN) :: STR
414  INTEGER, INTENT(IN) :: CMD_LEN
415  CHARACTER(LEN=CMD_LEN),INTENT(IN) :: CMD
416  !
417  INTEGER LENGTH, IDB, IDE, IDX
418 !
419  length = len(trim(str))
420  ! If the default values are strings we add quote
421  IF(ktype.EQ.4.OR.cmd(1:5).EQ.'CHOIX') THEN
422  ! If they are too many values printing each on a new line
423  IF(length.GT.60.OR.cmd(1:5).EQ.'CHOIX') THEN
424  ! First value printing additional text
425  idb = 1
426  ide = index(str(1:length),';')
427  WRITE(nfic,'(2A)') cmd," ="
428  WRITE(nfic,'(3A)') "'",str(idb:ide-1),"';"
429  DO
430  idb = ide + 1
431  idx = index(str(idb:length),';')
432  ide = idx + idb - 1
433  IF(idx.EQ.0.OR.idb.GT.length) EXIT
434  WRITE(nfic,'(3A)') "'",
435  & str(idb:ide-1),"';"
436  ENDDO
437  WRITE(nfic,'(3A)') "'",
438  & str(idb:length),"'"
439  ELSE
440  ! Normal one line printing with quote
441  WRITE(nfic,'(4A)') cmd," = '",trim(str),"'"
442  ENDIF
443  ELSE
444  IF(length.GT.60) THEN
445  ! First value printing additional text
446  idb = 1
447  ide = index(str(1:length),';')
448  WRITE(nfic,'(2A)') cmd," ="
449  WRITE(nfic,'(2A)') str(idb:ide-1),";"
450  DO
451  idb = ide + 1
452  idx = index(str(idb:length),';')
453  ide = idx + idb - 1
454  IF(idx.EQ.0.OR.idb.GT.length) EXIT
455  WRITE(nfic,'(2A)') str(idb:ide-1),";"
456  ENDDO
457  WRITE(nfic,'(A)') str(idb:length)
458  ! Normal one line printing without quote
459  ELSE
460  WRITE(nfic,'(3A)') cmd," = ",trim(str)
461  ENDIF
462  ENDIF
463  !
464  END SUBROUTINE
465  ! brief write in canal the default value in Latex
466  !+ form as neatly as possible
467  !
468  ! param nfic file canal
469  ! param ikey key index in myDico
470  ! param lng language of the key (1:french,2:english)
471  SUBROUTINE write_default(NFIC,IKEY,LNG)
472  IMPLICIT NONE
473  !
474  INTEGER,INTENT(IN) :: IKEY
475  INTEGER,INTENT(IN) :: NFIC
476  INTEGER, INTENT(IN) :: LNG
477  !
478  INTEGER LENGTH, IDB, IDE, IDX
479  CHARACTER(LEN=DEFAUT_LEN) :: STRING
480 !
481  ! If the default values are strings we add quote
482  IF(mydico(ikey)%KTYPE.EQ.4) THEN
483  string = mydico(ikey)%DEFAUT(lng)
484  length = len(trim(mydico(ikey)%DEFAUT(lng)))
485  ! If they are too many values printing each on a new line
486  IF(length.GT.70) THEN
487  ! First value printing additional text
488  idb = 1
489  ide = index(string(1:length),';')
490  WRITE(nfic,'(3A)') "DEFAULT VALUE : & '",
491  & string(idb:ide),"\\"
492  DO
493  idb = ide + 1
494  idx = index(string(idb:length),';')
495  ide = idx + idb - 1
496  IF(idx.EQ.0.OR.idb.GT.length) EXIT
497  WRITE(nfic,'(3A)') " & ",
498  & string(idb:ide),"\\"
499  ENDDO
500  WRITE(nfic,'(3A)') " & ",
501  & string(idb:length),"'\\"
502  ELSE
503  ! Normal one line printing with quote
504  WRITE(nfic,'(3A)') "DEFAULT VALUE : & '",
505  & trim(mydico(ikey)%DEFAUT(lng)),"'\\"
506  ENDIF
507  ELSE
508  ! Normal one line printing without quote
509  WRITE(nfic,'(3A)') "DEFAULT VALUE : & ",
510  & trim(mydico(ikey)%DEFAUT(lng)),"\\"
511  ENDIF
512  !
513  END SUBROUTINE
514  ! brief Return true if rubrique(irub,level) is in keyword ikey rubrique
515  !
516  ! param ikey key index in myDico
517  ! param level level of the rubrique (1,2,3)
518  ! param irub rubrique in rubrique
519  ! param lng language of the key (1:french,2:english)
520  !
521  ! return A logical
522  LOGICAL FUNCTION has_rubrique(IKEY,IRUB,LEVEL,LNG)
523  IMPLICIT NONE
524  !
525  INTEGER,INTENT(IN) :: IKEY
526  INTEGER,INTENT(IN) :: IRUB
527  INTEGER,INTENT(IN) :: LEVEL
528  INTEGER, INTENT(IN) :: LNG
529  !
530  has_rubrique = .false.
531  ! Looping on each sub rubrique
532  IF(mydico(ikey)%RUBRIQUE(lng,level).EQ.
533  & rubrique(lng,irub,level)) THEN
534  has_rubrique = .true.
535  RETURN
536  ENDIF
537  END FUNCTION
538  ! brief Identify what reserved key is the ligne associated to
539  !
540  ! param chaine key to identify
541  ! param ilong length of chaine
542  ! param numero number of the key
543  ! param lng language of the key (1:french,2:english)
544  SUBROUTINE identify_key(CHAINE,ILONG,NUMERO,LNG)
545  IMPLICIT NONE
546  !
547  CHARACTER(LEN=*),INTENT(IN) :: CHAINE
548  INTEGER,INTENT(INOUT) :: ILONG
549  INTEGER, INTENT(INOUT) :: NUMERO
550  INTEGER, INTENT(INOUT) :: LNG
551  !
552  CHARACTER(LEN=9) :: MOTPRO(15)
553  parameter( motpro = (/
554  & 'NOM ','TYPE ','INDEX ','TAILLE ','DEFAUT ',
555  & 'AIDE ','CHOIX ','RUBRIQUE ','NIVEAU ','MNEMO ',
556  & 'COMPOSE ','COMPORT ','CONTROLE ','APPARENCE','SUBMIT ' /) )
557 ! LENGTH OF THE PROTECTED WORDS
558  INTEGER :: LONPRO(15),I
559  parameter( lonpro = (/ 3,4,5,6,6,4,5,8,6,5,7,7,8,9,6 /) )
560  !
561  lng = 1
562  numero = 0
563  ! Check if it is an english key 1 at the end
564  IF (chaine(ilong:ilong).EQ.'1') THEN
565  ilong = ilong - 1
566  lng = 2
567  ENDIF
568  ! Search in the list of known keyword
569  DO i=1,15
570  IF (ilong.EQ.lonpro(i)) THEN
571  IF (chaine(1:ilong).EQ.motpro(i)(1:ilong)) THEN
572  numero = i
573  EXIT
574  ENDIF
575  ENDIF
576  ENDDO ! I
577  !
578  END SUBROUTINE
579  ! brief Return the id of the given keyword -1 if it is not in the
580  ! dictionary
581  !
582  ! param key_name Name of the keyword
583  ! param lng language of the key (1:french,2:english)
584  !
585  ! return The key of the keyword -1 otherwise
586  INTEGER FUNCTION identify_keyword(KEY_NAME,LNG)
587  IMPLICIT NONE
588  !
589  CHARACTER(LEN=KEYWORD_LEN),INTENT(IN) :: KEY_NAME
590  INTEGER, INTENT(IN) :: LNG
591  !
592  INTEGER I
593  !
594  ! Looping on each sub rubrique
595  identify_keyword = -1
596  DO i=1,nkey
597  IF(mydico(i)%KNOM(lng).EQ.key_name) THEN
598  identify_keyword = i
599  RETURN
600  ENDIF
601  ENDDO
602  RETURN
603  END FUNCTION
604  ! brief Fill the myDico structure by reading the condition
605  ! dependencies file
606  !
607  ! param filename name of the dependencies file
608  SUBROUTINE read_dependencies(FILENAME)
609  !
610  IMPLICIT NONE
611  !
612  CHARACTER(LEN=PATH_LEN), INTENT(IN) :: FILENAME
613  !
614  INTEGER NFIC, NDEP, IKEY, IKEY_DEP, I, ICOND, IERR
615  CHARACTER(LEN=KEYWORD_LEN) KEY_NAME
616  CHARACTER(LEN=COND_LEN) COND
617  CHARACTER(LEN=CONSIGNE_LEN) CONSIGNE
618  CHARACTER(LEN=STRING_LEN) RUB
619  INTEGER LEVEL
620  !
621  nfic = 667
622  WRITE(*,*) '---- READING DEPENDENCIES ----'
623  WRITE(*,*) 'READING: ',trim(filename)
624  OPEN(nfic,file=filename,iostat=ierr)
625  CALL check_call(ierr,'OPEN:DEPEN')
626  !
627  DO
628  READ(nfic,*,iostat=ierr) ndep, icond
629  IF(ierr.LT.0) EXIT
630  IF(ndep.EQ.666) EXIT
631  READ(nfic,'(A)') cond
632  READ(nfic,'(A)') key_name
633  ikey = identify_keyword(key_name,2)
634  IF(ikey.EQ.-1) THEN
635  WRITE(*,*) 'UNKNOWN KEYWORD:'
636  WRITE(*,*) trim(key_name)
637  CALL plante(1)
638  stop
639  ENDIF
640  ! If condition number is negative its a consigne
641  IF(icond.LT.0) THEN
642  READ(nfic,'(A)') consigne
643  mydico(ikey)%COND(-icond) = cond
644  mydico(ikey)%CONSIGNE(-icond,lng_fr) = consigne
645  READ(nfic,'(A)') consigne
646  mydico(ikey)%CONSIGNE(-icond,lng_en) = consigne
647  mydico(ikey)%DEPEN(-icond,1) = -1
648  ! If it is positive its a dependencies
649  ELSE IF(icond.NE.0) THEN
650  mydico(ikey)%COND(icond) = cond
651  DO i=1,ndep-1
652  READ(nfic,'(A)') key_name
653  ikey_dep = identify_keyword(key_name,2)
654  IF(ikey_dep.EQ.-1) THEN
655  WRITE(*,*) 'UNKNOWN KEYWORD:'
656  WRITE(*,*) trim(key_name)
657  CALL plante(1)
658  stop
659  ENDIF
660  mydico(ikey)%DEPEN(icond,i) = ikey_dep
661  ENDDO
662  ! If it is zero it is an internal dependancies
663  ELSE
664  mydico(ikey)%COND(1) = cond
665  ENDIF
666  ENDDO
667  ! Reading RUBRIQUE status information
668  IF(ndep.EQ.666) THEN
669  rubrique_info(:,:) = 'o'
670  DO
671  READ(nfic,'(A)',iostat=ierr) rub
672  IF(ierr.LT.0) EXIT
673  CALL identify_rubrique_idx(rub,i,level)
674  IF(i.EQ.-1) THEN
675  WRITE(lu,*) 'RUBRIQUE UNKNOWN IN DEPENDANCIES FILE: ',
676  & trim(rub)
677  CALL plante(1)
678  ENDIF
679  READ(nfic,'(A)') rubrique_info(i,level)
680  ENDDO
681  ENDIF
682  END SUBROUTINE read_dependencies
683  ! brief Fill the myDico structure by reading the dictionary
684  !
685  ! param filename name of the dictionary file
686  SUBROUTINE read_dictionary(FILENAME)
687  !
688  IMPLICIT NONE
689  !
690  CHARACTER(LEN=PATH_LEN), INTENT(IN) :: FILENAME
691  CHARACTER(LEN=AIDE_LEN) :: TMP
692  INTEGER :: IKEY,IERR,LNG,I,J
693  !
694  INTEGER LCAR,ICOL,JCOL,ILONG,NUMERO,I2
695  INTEGER NBMOT,LONGU
696  INTEGER ORDRE
697  INTEGER NIGN
698  LOGICAL DYNAM,AIDLNG,VUMOT
699  LOGICAL ARRET,EXECMD
700  CHARACTER(LEN=1) PTVIRG,QUOTE
701  CHARACTER(LEN=9) TYPE
702  CHARACTER(LEN=72) LIGNE
703  CHARACTER(LEN=PATH_LEN) TYPE2
704  CHARACTER(LEN=AIDE_LEN) :: TEMP
705  !
706 !
707  CHARACTER(LEN=PATH_LEN),EXTERNAL :: MYCARLU
708  CHARACTER(LEN=AIDE_LEN), EXTERNAL :: MYAIDELU
709  INTEGER, EXTERNAL :: INTLU
710  LOGICAL, EXTERNAL :: LOGLU
711  DOUBLE PRECISION, EXTERNAL :: REALU
712  INTEGER, EXTERNAL :: NEXT,PREV,PREVAL,LONGLU
713  LOGICAL FAIL
714  INTEGER ERR_LEVEL, ERR_LNG
715  !
716 !
717  nfic = 666
718  WRITE(*,*) '---- READING PROCESS ----'
719  WRITE(*,*) 'READING: ',trim(filename)
720  OPEN(nfic,file=filename,iostat=ierr)
721  CALL check_call(ierr,'OPEN:DICO')
722  !
723  arret = .false.
724  erreur = .false.
725  retour = .false.
726  dynam = .false.
727  execmd = .false.
728  aidlng = .false.
729  vumot = .false.
730  longli = 72
731  ptvirg = ';'
732  quote = ''''
733 ! TABUL = CHAR(9)
734  nbmot = 0
735  nign = 0
736  ordre = 0
737  param = ' '
738  longu = 0
739  ntyp = -100
740  indx = 123456
741  itai = -100
742  deflu = 0
743 !
744  icol = longli
745  nlign = 0
746  fail = .false.
747 !
748 ! SEEKS THE FIRST NON-WHITE CHARACTER (IGNORES COMMENTED LINES) :
749 !
750  icol = next(icol+1,ligne)
751  ikey = 0
752 !
753 100 CONTINUE
754  ! New keyword
755 !
756 ! IF REACHED THE END OF FILE :
757 !
758  IF(retour) GO TO 900
759 !
760 ! LOCATES THE COMMANDS STARTING WITH &
761 !
762  IF ( ligne(icol:icol).EQ.'&' ) THEN
763  icol = preval(icol+1,ligne,' ',char(9),' ')
764  icol = next(icol+1,ligne)
765  GO TO 100
766  ENDIF
767 !
768  i2 = preval(icol+1,ligne,'=',':','=')
769 ! CASE WHERE '=' IS ON THE FOLLOWING LINE
770  IF(i2.GT.longli) i2=longli
771  jcol = prev(i2,ligne)
772  ilong = jcol - icol + 1
773 !
774  ! Identify the type of keyword
775  CALL identify_key(ligne,ilong,numero,lng)
776 !
777 ! STOPS IF THE WORD IS UNKNOWN
778  IF(numero.LE.0) THEN
779  WRITE(*,*) 'UNKNOWN KEY: ',ligne(icol:jcol)
780  CALL plante(1)
781  stop
782  ENDIF
783 ! New keyword
784  IF((numero.EQ.1).AND.(lng.EQ.lng_fr)) THEN
785  ikey = ikey + 1
786  ! Initialising the keyword structure
787  mydico(ikey)%KNOM(1) = repeat(' ',keyword_len)
788  mydico(ikey)%KNOM(2) = repeat(' ',keyword_len)
789  mydico(ikey)%KTYPE = 0
790  mydico(ikey)%KINDEX = -1
791  mydico(ikey)%MNEMO = repeat(' ',string_len)
792  mydico(ikey)%TAILLE = 1
793  mydico(ikey)%SUBMIT = repeat(' ',string_len)
794  mydico(ikey)%DEFAUT(1) = repeat(' ',defaut_len)
795  mydico(ikey)%DEFAUT(2) = repeat(' ',defaut_len)
796  mydico(ikey)%DEFAUT(1) = 'OBLIGATOIRE'
797  mydico(ikey)%DEFAUT(2) = 'MANDATORY'
798  mydico(ikey)%CHOIX(1) = repeat(' ',choix_len)
799  mydico(ikey)%CHOIX(2) = repeat(' ',choix_len)
800  DO i=1,maxenum
801  mydico(ikey)%HASH_ID(i,1) = repeat(' ',keyword_len)
802  mydico(ikey)%HASH_VAL(i,1) = repeat(' ',keyword_len)
803  mydico(ikey)%HASH_ID(i,2) = repeat(' ',keyword_len)
804  mydico(ikey)%HASH_VAL(i,2) = repeat(' ',keyword_len)
805  ENDDO
806  DO i=1,3
807  mydico(ikey)%RUBRIQUE(1,i) = repeat(' ',string_len)
808  mydico(ikey)%RUBRIQUE(2,i) = repeat(' ',string_len)
809  ENDDO
810  DO i=1,maxcond
811  mydico(ikey)%COND(i) = repeat(' ',cond_len)
812  mydico(ikey)%CONSIGNE(i,1) = repeat(' ',consigne_len)
813  mydico(ikey)%CONSIGNE(i,2) = repeat(' ',consigne_len)
814  ENDDO
815  mydico(ikey)%SUBMIT = repeat(' ',string_len)
816  mydico(ikey)%COMPOSE = repeat(' ',string_len)
817  mydico(ikey)%COMPORT = repeat(' ',string_len)
818  mydico(ikey)%CONTROLE = repeat(' ',string_len)
819  mydico(ikey)%APPARENCE = repeat(' ',string_len)
820  mydico(ikey)%NIVEAU = 0
821  mydico(ikey)%AIDE(1) = repeat(' ',aide_len)
822  mydico(ikey)%AIDE(2) = repeat(' ',aide_len)
823  mydico(ikey)%DEPEN(:,:) = 0
824  ENDIF
825 !
826  icol = preval(icol+1,ligne,'=',':','=')
827 ! CASE WHERE '=' IS ON THE FOLLOWING LINE
828  IF(icol.GT.longli) THEN
829  icol = next(longli,ligne)
830  IF(retour) GO TO 900
831  ENDIF
832 !
833 !
834 ! 2) RESERVED KEYWORDS:
835 !
836 ! RESERVED KEYWORDS CURRENTLY ARE:
837 !
838 ! 'NOM' :NUMERO = 1 (DE TYPE CARACTERE)
839 ! 'TYPE' :NUMERO = 2 (DE TYPE CARACTERE)
840 ! 'INDEX' :NUMERO = 3 (DE TYPE ENTIER)
841 ! 'TAILLE' :NUMERO = 4 (DE TYPE ENTIER)
842 ! 'DEFAUT' :NUMERO = 5 (DE TYPE VARIABLE)
843 ! 'AIDE' :NUMERO = 6 (DE TYPE CARACTERE)
844 ! 'CHOIX' :NUMERO = 7 (DE TYPE VARIABLE)
845 ! 'RUBRIQUE' :NUMERO = 8 (DE TYPE CARACTERE)
846 ! 'NIVEAU' :NUMERO = 9 (DE TYPE ENTIER)
847 ! 'MNEMO' :NUMERO = 10 (DE TYPE CARACTERE)
848 ! 'COMPOSE' :NUMERO = 11 (DE TYPE CARACTERE)
849 ! 'COMPORT' :NUMERO = 12 (DE TYPE CARACTERE)
850 ! 'CONTROLE' :NUMERO = 13 (DE TYPE ENTIER)
851 ! 'APPARENCE' :NUMERO = 14 (DE TYPE CARACTERE)
852 ! 'SUBMIT' :NUMERO = 15 (DE TYPE CARACTERE)
853 !
854 ! NAME
855 !
856  IF(numero.EQ.1) THEN
857 !
858 ! SHOULD NOT COUNT THE SAME WORD IN SEVERAL LANGUAGES SEVERAL TIMES
859 ! COUNTED ONLY ONCE IN FIRST FOUND LANGUAGE
860 !
861  IF (.NOT.(vumot)) nbmot = nbmot + 1
862 !
863  ordre = 1
864 !
865 ! SIGNALS THAT THIS NEW KEYWORD WAS ALREADY ENCOUNTERED IN ANOTHER LANGUAGE
866  IF (.NOT.(vumot)) vumot=.true.
867 !
868 ! NAME OF THE KEYWORD
869  tmp= mycarlu(lcar,icol,ligne,quote,len(param))
870  longu = lcar
871  mydico(ikey)%KNOM(lng)=tmp(1:min(72,longu))
872 !
873  icol = next(icol+1,ligne)
874 !
875 ! TYPE
876 !
877  ELSE IF(numero.EQ.2) THEN
878  vumot = .false.
879  IF (ordre.NE.1) GOTO 1500
880  ordre=2
881  type2= mycarlu(lcar,icol,ligne,quote,len(type))
882  TYPE=type2(1:min(lcar,9))
883  IF(TYPE(1:6).EQ.'ENTIER'
884  & .OR.TYPE(1:8).EQ.'INTEGER') then
885  ntyp = 1
886  ELSEIF(TYPE(1:4).EQ.'REEL'
887  & .OR.TYPE(1:4).EQ.'REAL') then
888  ntyp = 2
889  ELSEIF(TYPE(1:7).EQ.'LOGIQUE'
890  & .OR.TYPE(1:7).EQ.'LOGICAL') then
891  ntyp = 3
892  ELSEIF(TYPE(1:9).EQ.'CARACTERE'
893  & .OR.TYPE(1:6).EQ.'STRING') then
894  ntyp = 4
895  ELSE
896 ! ERROR: UNKNOWN TYPE
897  WRITE (lu,1003) ligne
898 1003 FORMAT(1x,a72,/,1x,'UNKNOWN TYPE ON THIS LINE')
899  CALL plante(1)
900  stop
901  ENDIF
902  mydico(ikey)%KTYPE = ntyp
903  icol = next(icol+1,ligne)
904 !
905 ! INDEX
906 !
907  ELSE IF(numero.EQ.3) THEN
908  IF (ordre.NE.2) GOTO 1500
909  ordre=3
910  indx = intlu(icol,ligne)
911  icol = next(icol+1,ligne)
912 !
913 ! CASE INDEX=-1 : WORD FOR EDAMOX CONSTRUCTION, TO KEEP
914 !
915  IF (indx.EQ.-1) THEN
916  nign = nign + 1
917  IF (nign.GT.100) THEN
918  WRITE(lu,*) 'TOO MANY WORDS FOR EDAMOX',
919  & ' (MAX=100)'
920  erreur = .true.
921  GO TO 900
922  ENDIF
923  ENDIF
924  mydico(ikey)%KINDEX = indx
925 !
926 ! SIZE
927 !
928  ELSE IF(numero.EQ.4) THEN
929  IF (ordre.NE.3) GOTO 1500
930  ordre=4
931  mydico(ikey)%TAILLE = intlu(icol,ligne)
932  icol = next(icol+1,ligne)
933 !
934 ! DEFAULT VALUE
935 ! FOR ARRAYS, IT IS NOT NECESSARY TO SET ALL VALUES
936 !
937  ELSE IF(numero.EQ.5) THEN
938 !
939 !
940  IF (ordre.LT.3.OR.ordre.GT.6) GOTO 1500
941  ordre=6
942  mydico(ikey)%DEFAUT(lng) = mycarlu(lcar,icol,ligne,quote,
943  & len(mydico(ikey)%DEFAUT(lng)))
944 
945 !
946  icol = next(icol+1,ligne)
947 
948  DO
949  IF(mydico(ikey)%TAILLE.LE.1) EXIT
950  ! Check if there are multiple values (array)
951  IF(icol.GT.longli) THEN
952  icol = longli
953  ELSE
954  IF(ligne(icol:icol).NE.ptvirg) THEN
955  EXIT
956  ENDIF
957  ENDIF
958  mydico(ikey)%DEFAUT(lng) = trim(mydico(ikey)%DEFAUT(lng))
959  & //ptvirg// mycarlu(lcar,icol,ligne,quote,
960  & len(mydico(ikey)%DEFAUT(lng)))
961 
962 !
963  icol = next(icol+1,ligne)
964  ENDDO
965 !
966 ! HELP
967 !
968  ELSE IF(numero.EQ.6) THEN
969 !
970  mydico(ikey)%AIDE(lng) =
971  & myaidelu(icol,ligne)
972 !
973 !
974 ! 'CHOIX' 'RUBRIQUE' 'NIVEAU' 'MNEMO' 'COMPOSE' 'COMPORT' 'CONTROLE' 'APPARENCE'
975 ! NUMBER 7 TO 14 INCLUDED
976 !
977  ELSE IF(numero.EQ.7) THEN
978 !
979  mydico(ikey)%CHOIX(lng) = mycarlu(lcar,icol,ligne,quote,
980  & len(mydico(ikey)%CHOIX(lng)))
981 
982 !
983  icol = next(icol+1,ligne)
984  DO
985  ! Check if there are multiple values (array)
986  IF(icol.GT.longli) THEN
987  icol = longli
988  ELSE
989  IF(ligne(icol:icol).NE.ptvirg) THEN
990  EXIT
991  ENDIF
992  ENDIF
993  mydico(ikey)%CHOIX(lng) =
994  & trim(mydico(ikey)%CHOIX(lng))
995  & //ptvirg//mycarlu(lcar,icol,ligne,quote,
996  & len(mydico(ikey)%CHOIX(lng)))
997 
998 !
999  icol = next(icol+1,ligne)
1000  ENDDO
1001 !
1002  ELSE IF(numero.EQ.8) THEN
1003 !
1004  i = 1
1005  mydico(ikey)%RUBRIQUE(lng,i)= mycarlu(lcar,icol,ligne,quote,
1006  & len(mydico(ikey)%RUBRIQUE(lng,i)))
1007 
1008 !
1009  icol = next(icol+1,ligne)
1010  DO
1011  ! Check if there are multiple values (array)
1012  IF(icol.GT.longli) THEN
1013  icol = longli
1014  ELSE
1015  IF(ligne(icol:icol).NE.ptvirg) THEN
1016  EXIT
1017  ENDIF
1018  ENDIF
1019  i = i + 1
1020  mydico(ikey)%RUBRIQUE(lng,i) =
1021  & mycarlu(lcar,icol,ligne,quote,
1022  & len(mydico(ikey)%RUBRIQUE(lng,i)))
1023 
1024 !
1025  icol = next(icol+1,ligne)
1026  ENDDO
1027 !
1028  ELSE IF(numero.EQ.9) THEN
1029 !
1030  mydico(ikey)%NIVEAU = intlu(icol,ligne)
1031  icol = next(icol+1,ligne)
1032 !
1033  ELSE IF(numero.EQ.10) THEN
1034 !
1035  mydico(ikey)%MNEMO =
1036  & mycarlu(lcar,icol,ligne,quote,
1037  & len(mydico(ikey)%MNEMO))
1038  icol = next(icol+1,ligne)
1039 !
1040  ELSE IF(numero.EQ.11) THEN
1041 !
1042  mydico(ikey)%COMPOSE =
1043  & mycarlu(lcar,icol,ligne,quote,
1044  & len(mydico(ikey)%COMPOSE))
1045  icol = next(icol+1,ligne)
1046 !
1047  ELSE IF(numero.EQ.12) THEN
1048 !
1049  temp = myaidelu(icol,ligne)
1050  mydico(ikey)%COMPORT = temp(1:string_len)
1051 !
1052  ELSE IF(numero.EQ.13) THEN
1053 !
1054  mydico(ikey)%CONTROLE = mycarlu(lcar,icol,ligne,quote,
1055  & len(mydico(ikey)%CONTROLE))
1056 
1057 !
1058  icol = next(icol+1,ligne)
1059 
1060  ! Reading second value
1061  DO
1062  IF(icol.GT.longli) THEN
1063  icol = longli
1064  ELSE
1065  IF(ligne(icol:icol).NE.ptvirg) THEN
1066  EXIT
1067  ENDIF
1068  ENDIF
1069  mydico(ikey)%CONTROLE = trim(mydico(ikey)%CONTROLE)
1070  & //ptvirg// mycarlu(lcar,icol,ligne,quote,
1071  & len(mydico(ikey)%CONTROLE))
1072  ENDDO
1073 
1074 !
1075  icol = next(icol+1,ligne)
1076 !
1077  ELSE IF(numero.EQ.14) THEN
1078 !
1079  mydico(ikey)%APPARENCE =
1080  & mycarlu(lcar,icol,ligne,quote,
1081  & len(mydico(ikey)%APPARENCE))
1082  icol = next(icol+1,ligne)
1083  DO
1084  ! Check if there are multiple values (array)
1085  IF(icol.GT.longli) THEN
1086  icol = longli
1087  ELSE
1088  IF(ligne(icol:icol).NE.ptvirg) THEN
1089  EXIT
1090  ENDIF
1091  ENDIF
1092  mydico(ikey)%APPARENCE =
1093  & trim(mydico(ikey)%SUBMIT)
1094  & //ptvirg//mycarlu(lcar,icol,ligne,quote,
1095  & len(mydico(ikey)%APPARENCE))
1096 
1097 !
1098  icol = next(icol+1,ligne)
1099  ENDDO
1100 !
1101 ! DEFINES A SUBMIT TYPE
1102  ELSE IF (numero .EQ. 15) THEN
1103  IF (ordre.NE.3.AND.ordre.NE.4) GOTO 1500
1104  ordre=5
1105 !
1106 !
1107  mydico(ikey)%SUBMIT = mycarlu(lcar,icol,ligne,quote,
1108  & len(mydico(ikey)%SUBMIT))
1109 
1110 !
1111  icol = next(icol+1,ligne)
1112  DO
1113  ! Check if there are multiple values (array)
1114  IF(icol.GT.longli) THEN
1115  icol = longli
1116  ELSE
1117  IF(ligne(icol:icol).NE.ptvirg) THEN
1118  EXIT
1119  ENDIF
1120  ENDIF
1121  mydico(ikey)%SUBMIT =
1122  & trim(mydico(ikey)%SUBMIT)
1123  & //ptvirg//mycarlu(lcar,icol,ligne,quote,
1124  & len(mydico(ikey)%SUBMIT))
1125 
1126 !
1127  icol = next(icol+1,ligne)
1128  ENDDO
1129 !
1130  ENDIF
1131 !
1132 !
1133  GO TO 100
1134 900 CONTINUE
1135  IF(erreur) THEN
1136  WRITE(lu,*)' '
1137  WRITE(lu,*)'-------------------------------'
1138  WRITE(lu,*)'- ERROR IN THE DICTIONARY -'
1139  WRITE(lu,*)'-------------------------------'
1140  CALL plante(1)
1141  stop
1142  ENDIF
1143 !
1144 ! TRUE END: 2 FILES READ OR 2 FILES IN 1 READ
1145  CLOSE(nfic)
1146  WRITE(*,*) ''
1147  WRITE(*,*) 'TOTAL NUMBER OF KEY IN THE DICTIONARY: ',ikey
1148  WRITE(*,*) ''
1149  nkey = ikey
1150 
1151  ! List all rubriques
1152  CALL identify_rubrique()
1153  ! Verification for user
1154  WRITE(*,*) '---- CHECKING RUBRIQUES ----'
1155  WRITE(*,*) 'CHECK OF TRANSLATION FOR RUBRIQUE'
1156  WRITE(*,*) 'NRUB',nrub
1157  WRITE(*,*) 'LIST OF RUBRIQUES IN BOTH LANGUAGES'
1158  DO j=1,3
1159  WRITE(*,*) 'LEVEL:',j
1160  IF(nrub(1,j).NE.nrub(2,j)) THEN
1161  WRITE(*,*) 'WARNING: NOT THE SAME NUMBER OF RUBRIQUES ',
1162  & 'IN FRENCH AND ENGLISH'
1163  err_level = j
1164  IF(nrub(1,err_level).GT.nrub(2,err_level)) THEN
1165  err_lng = 1
1166  ELSE
1167  err_lng = 2
1168  ENDIF
1169  fail = .true.
1170  ENDIF
1171  DO i=1,minval(nrub(:,j))
1172  WRITE(*,*) repeat('-',j*2),
1173  & trim(rubrique(1,i,j))," = ",trim(rubrique(2,i,j))
1174  ENDDO
1175  ENDDO
1176  IF(fail) THEN
1177  WRITE(*,*) 'ERROR IN RUBRIQUE LEVEL: ',err_level
1178  DO i=1,nrub(err_lng, err_level)
1179  WRITE(*,*) trim(rubrique(err_lng, i, err_level))
1180  ENDDO
1181  CALL plante(1)
1182  stop
1183  ENDIF
1184  WRITE(*,*) ''
1185  CALL check_index(6)
1186  CALL identify_rubrique_depends()
1187 !
1188  RETURN
1189 !
1190 ! TREATS ERRORS OF DECLARATION ORDER IN THE DICTIONARY
1191 !
1192 1500 erreur=.true.
1193  WRITE(lu,'(/,1X,A72,/)') ligne
1194  WRITE(lu,*) 'AT LINE ',nlign,', PRIORITY ORDER NOT RESPECTED'
1195  WRITE(lu,*)
1196  WRITE(lu,*) 'EXPECTED ORDER IS :'
1197  WRITE(lu,*) 'NOM, TYPE, INDEX, (TAILLE), (SUBMIT), (DEFAUT)'
1198  CALL plante(1)
1199  stop
1200  GOTO 900
1201 
1202  END SUBROUTINE
1203  ! brief transform single quote into double quotes
1204  !
1205  ! param strIn Input string
1206  ! return String with quotes instead of double quotes
1207  CHARACTER(LEN=KEYWORD_LEN) FUNCTION dble_quote(STRIN)
1208  !
1209  IMPLICIT NONE
1210  !
1211  CHARACTER(LEN=KEYWORD_LEN), INTENT(IN) :: STRIN
1212  !
1213  INTEGER I,J
1214  !
1215  j = 1
1216  dble_quote = repeat(' ',keyword_len)
1217  DO i=1,len(trim(strin))
1218  IF (strin(i:i).EQ."'") THEN
1219  dble_quote(j:j) = "'"
1220  j=j+1
1221  ENDIF
1222  dble_quote(j:j) = strin(i:i)
1223  j=j+1
1224  ENDDO
1225  !
1226  END FUNCTION dble_quote
1227  ! brief Dump a keyword structure
1228  !
1229  ! param ndic Id of the file
1230  ! param ikey Id of the keyword
1231  SUBROUTINE dump_keyword(NFIC,IKEY)
1232  !
1233  IMPLICIT NONE
1234  !
1235  INTEGER, INTENT(IN) :: NFIC
1236  INTEGER, INTENT(IN) :: IKEY
1237  !
1238  INTEGER :: J
1239  CHARACTER(LEN=10), EXTERNAL :: I2STR
1240  !
1241  WRITE(nfic,'(3A)') "NOM = '",
1242  & trim(dble_quote(mydico(ikey)%KNOM(1))),"'"
1243  WRITE(nfic,'(3A)') "NOM1 = '",trim(mydico(ikey)%KNOM(2)),"'"
1244  SELECT CASE(mydico(ikey)%KTYPE)
1245  CASE(1) ! INTEGER
1246  WRITE(nfic,'(A)') "TYPE = INTEGER"
1247  CASE(2) ! REAL
1248  WRITE(nfic,'(A)') "TYPE = REAL"
1249  CASE(3) ! LOGICAL
1250  WRITE(nfic,'(A)') "TYPE = LOGICAL"
1251  CASE(4) ! CHARACTER
1252  WRITE(nfic,'(A)') "TYPE = STRING"
1253  END SELECT
1254  WRITE(nfic,'(A)') "INDEX = "//trim(i2str(mydico(ikey)%KINDEX))
1255  IF(mydico(ikey)%TAILLE.NE.-1) THEN
1256  WRITE(nfic,'(A)') "TAILLE = "
1257  & //trim(i2str(mydico(ikey)%TAILLE))
1258  ENDIF
1259  IF(mydico(ikey)%SUBMIT(1:1).NE." ") THEN
1260  WRITE(nfic,'(3A)') "SUBMIT = '",trim(mydico(ikey)%SUBMIT),"'"
1261  ENDIF
1262  ! If default = obligatoire IKEY.e no default value
1263  IF(mydico(ikey)%DEFAUT(1)(1:11).NE.'OBLIGATOIRE') THEN
1264  CALL dump_list(nfic,mydico(ikey)%KTYPE,mydico(ikey)%DEFAUT(1),
1265  & defaut_len,'DEFAUT',6)
1266  CALL dump_list(nfic,mydico(ikey)%KTYPE,mydico(ikey)%DEFAUT(2),
1267  & defaut_len,'DEFAUT1',7)
1268  ENDIF
1269  WRITE(nfic,'(3A)') "MNEMO = '",trim(mydico(ikey)%MNEMO),"'"
1270  IF(mydico(ikey)%CONTROLE(1:1).NE.' ') THEN
1271  WRITE(nfic,'(A,A)') "CONTROLE = ",
1272  & trim(mydico(ikey)%CONTROLE)
1273  ENDIF
1274  IF(mydico(ikey)%CHOIX(1)(1:1).NE.' ') THEN
1275  ! If missing english choix crashing
1276  IF(mydico(ikey)%CHOIX(2)(1:1).EQ.' ') THEN
1277  WRITE(*,*) 'MISSING CHOIX FOR',mydico(ikey)%KNOM(1)
1278  CALL plante(1)
1279  stop
1280  ENDIF
1281  CALL dump_list(nfic,mydico(ikey)%KTYPE,mydico(ikey)%CHOIX(1),
1282  & choix_len,'CHOIX',5)
1283  CALL dump_list(nfic,mydico(ikey)%KTYPE,mydico(ikey)%CHOIX(2),
1284  & choix_len,'CHOIX1',6)
1285  ENDIF
1286  IF(mydico(ikey)%APPARENCE(1:1).NE.' ') THEN
1287  WRITE(nfic,'(A)') "APPARENCE ="
1288  WRITE(nfic,'(3A)') "'",trim(mydico(ikey)%APPARENCE),"'"
1289  ENDIF
1290  WRITE(nfic,'(A)') "RUBRIQUE ="
1291  WRITE(nfic,'(2(3A),3A)')
1292  & ("'",trim(mydico(ikey)%RUBRIQUE(1,j)),"';",j=1,2),
1293  & "'",trim(mydico(ikey)%RUBRIQUE(1,3)),"'"
1294  WRITE(nfic,'(A)') "RUBRIQUE1 ="
1295  WRITE(nfic,'(2(3A),3A)')
1296  & ("'",trim(mydico(ikey)%RUBRIQUE(2,j)),"';",j=1,2),
1297  & "'",trim(mydico(ikey)%RUBRIQUE(2,3)),"'"
1298  IF(mydico(ikey)%COMPOSE(1:1).NE." ") THEN
1299  WRITE(nfic,'(3A)') "COMPOSE = '",
1300  & trim(mydico(ikey)%COMPOSE),"'"
1301  ENDIF
1302  IF(mydico(ikey)%COMPORT(1:1).NE." ") THEN
1303  WRITE(nfic,'(A)') "COMPORT ="
1304  WRITE(nfic,'(3A)') "'",trim(mydico(ikey)%COMPORT),"'"
1305  ENDIF
1306  WRITE(nfic,'(A,A)') "NIVEAU = ",trim(i2str(mydico(ikey)%NIVEAU))
1307  WRITE(nfic,'(A)') "AIDE ="
1308  WRITE(nfic,'(3A)') "'",trim(mydico(ikey)%AIDE(1)),"'"
1309  WRITE(nfic,'(A)') "AIDE1 ="
1310  WRITE(nfic,'(3A)') "'",trim(mydico(ikey)%AIDE(2)),"'"
1311  WRITE(nfic,'(A)') "/"
1312  !
1313  END SUBROUTINE
1314  ! brief Dump the myDico structure in index order
1315  !
1316  ! param filename name of the output file
1317  ! param
1318  SUBROUTINE dump_dictionary_index(FILENAME)
1319  !
1320  IMPLICIT NONE
1321  !
1322  CHARACTER(LEN=PATH_LEN), INTENT(IN) :: FILENAME
1323  INTEGER :: NFIC,IERR
1324  INTEGER :: ITYP, IKEY
1325  INTEGER :: IDX(1)
1326  INTEGER, ALLOCATABLE :: INDEX_TYP(:,:)
1327  INTEGER :: LNG
1328 !
1329  nfic = 666
1330  lng = 2
1331  WRITE(*,*) '---- DUMPING PROCESS ----'
1332  WRITE(*,*) 'DUMPING IN : ',trim(filename)
1333  OPEN(nfic,file=trim(filename),iostat=ierr)
1334  CALL check_call(ierr,'DUMP_DICTIONARY')
1335  WRITE(*,*) ''
1336  WRITE(*,*) 'TOTAL NUMBER OF KEY IN THE DICTIONARY: ',nkey
1337  WRITE(*,*) ''
1338  ! Loop on all the keywords
1339  WRITE(nfic,'(A)') '&DYN'
1340  ! Loop on rubriques
1341  ALLOCATE(index_typ(nkey,4),stat=ierr)
1342  CALL check_allocate(ierr,'INDEX_TYP')
1343  index_typ(:,:) = nkey*2
1344  DO ikey=1,nkey
1345  index_typ(ikey,mydico(ikey)%KTYPE) = mydico(ikey)%KINDEX
1346  ENDDO
1347  DO ityp=1,4
1348  idx = minloc(index_typ(:,ityp))
1349  DO WHILE(index_typ(idx(1),ityp).LT.nkey*2)
1350  CALL dump_keyword(nfic,idx(1))
1351  index_typ(idx(1),ityp) = nkey*2
1352  idx = minloc(index_typ(:,ityp))
1353  ENDDO
1354  ENDDO
1355  CLOSE(nfic)
1356  DEALLOCATE(index_typ)
1357  END SUBROUTINE
1358  ! brief Dump the myDico structure
1359  !
1360  ! param filename name of the output file
1361  ! param
1362  SUBROUTINE dump_dictionary_rub(FILENAME)
1363  !
1364  IMPLICIT NONE
1365  !
1366  CHARACTER(LEN=PATH_LEN), INTENT(IN) :: FILENAME
1367  INTEGER :: NFIC,IERR
1368  INTEGER :: IRUB1, IRUB2, IRUB3
1369  INTEGER :: IDX_RUB2, IDX_RUB3
1370  INTEGER :: LNG,IKEY
1371  CHARACTER(LEN=10), EXTERNAL :: I2STR
1372 !
1373  nfic = 666
1374  lng = 2
1375  WRITE(*,*) '---- DUMPING PROCESS ----'
1376  WRITE(*,*) 'DUMPING IN : ',trim(filename)
1377  OPEN(nfic,file=trim(filename),iostat=ierr)
1378  CALL check_call(ierr,'DUMP_DICTIONARY')
1379  WRITE(*,*) ''
1380  WRITE(*,*) 'TOTAL NUMBER OF KEY IN THE DICTIONARY: ',nkey
1381  WRITE(*,*) ''
1382  ! Loop on all the keywords
1383  WRITE(nfic,'(A)') '&DYN'
1384  WRITE(nfic,'(A)') "/ Description of a keyword"
1385  WRITE(nfic,'(A)') "/ NOM : French name"
1386  WRITE(nfic,'(A)') "/ NOM1 : English name"
1387  WRITE(nfic,'(A)') "/ TYPE : STRING, INTEGER, REAL, LOGICAL"
1388  WRITE(nfic,'(A)') "/ INDEX : Index of the keyword"
1389  WRITE(nfic,'(A)') "/ TAILLE : Number of values "//
1390  & "(0 means between 1 and n)"
1391  WRITE(nfic,'(A)') "/ (opt) SUBMIT : Chain for files"
1392  WRITE(nfic,'(A)') "/ DEFAUT : Defaut value in French"
1393  WRITE(nfic,'(A)') "/ DEFAUT1 : Defaut value in English"
1394  WRITE(nfic,'(A)') "/ MNEMO : Name of the variable in the code"
1395  WRITE(nfic,'(A)') "/ (opt) CONTROLE : min;max for the "//
1396  & "keyword value"
1397  WRITE(nfic,'(A)') "/ (opt) CHOIX : List of possible values"
1398  WRITE(nfic,'(A)') "/ (opt) CHOIX1 : CHOIX in french"
1399  WRITE(nfic,'(A)') "/ (opt) APPARENCE : Defined how the keyword "//
1400  & "is filled"
1401  WRITE(nfic,'(A)') "/ LIST, DYNLIST, TUPLE"
1402  WRITE(nfic,'(A)') "/ RUBRIQUE : Classification of the "//
1403  & "keyword 3 level max"
1404  WRITE(nfic,'(A)') "/ RUBRIQUE1 : RUBRIQUE but in English"
1405  WRITE(nfic,'(A)') "/ (opt) COMPOSE : Used for fudaa"
1406  WRITE(nfic,'(A)') "/ (opt) COMPORT : Used for fudaa"
1407  WRITE(nfic,'(A)') "/ NIVEAU : Level of the keyword "//
1408  & "(Level 0 is a mandatory keyword)"
1409  WRITE(nfic,'(A)') "/ AIDE : Help in French (LaTeX syntax)"
1410  WRITE(nfic,'(A)') "/ AIDE1 : Help in English (LaTeX syntax)"
1411  CALL check_index(nfic)
1412  ! Loop on rubriques
1413  DO irub1=1,nrub(lng,1)
1414  idx_rub2 = 0
1415  WRITE(nfic,'(2A)') '/',repeat('/',71)
1416  WRITE(nfic,'(3A,A,2A)')'/',repeat('//',1),
1417  & ' ',trim(i2str(irub1)),'-',
1418  & trim(rubrique(2,irub1,1))
1419  WRITE(nfic,'(2A)') '/',repeat('/',71)
1420  DO ikey=1,nkey
1421  ! Identifying keywwords that are 1 1
1422  IF(has_rubrique(ikey,irub1,1,lng).AND.
1423  & (mydico(ikey)%RUBRIQUE(lng,2)(1:1).EQ.' ')) THEN
1424  CALL dump_keyword(nfic,ikey)
1425  ENDIF
1426  ENDDO
1427  ! LEVEL 2
1428  ! Loop on rubriques
1429  DO irub2=1,nrub(lng,2)
1430  idx_rub3 = 0
1431  IF(rub1_dep(irub1,irub2)) THEN
1432  idx_rub2 = idx_rub2 + 1
1433  WRITE(nfic,'(2A)') '/',repeat('/',71)
1434  WRITE(nfic,'(3A,A,A,A,2A)')'/',repeat('//',2),
1435  & ' ',trim(i2str(irub1)),'.',
1436  & trim(i2str(idx_rub2)),'-',
1437  & trim(rubrique(2,irub2,2))
1438  WRITE(nfic,'(2A)') '/',repeat('/',71)
1439  DO ikey=1,nkey
1440  ! Identifying keywwords that are 2 1
1441  IF(has_rubrique(ikey,irub1,1,lng).AND.
1442  & has_rubrique(ikey,irub2,2,lng).AND.
1443  & (mydico(ikey)%RUBRIQUE(lng,3)(1:1).EQ.' ')) THEN
1444  CALL dump_keyword(nfic,ikey)
1445  ENDIF
1446  ENDDO
1447  ! LEVEL 3
1448  ! Loop on rubriques
1449  DO irub3=1,nrub(lng,3)
1450  IF(rub2_dep(irub1,irub2,irub3)) THEN
1451  idx_rub3 = idx_rub3 + 1
1452  WRITE(nfic,'(2A)') '/',repeat('/',71)
1453  WRITE(nfic,'(3A,A,A,A,A,A,2A)')
1454  & '/',repeat('//',3),
1455  & ' ',trim(i2str(irub1)),'.',
1456  & trim(i2str(idx_rub2)),'.',
1457  & trim(i2str(idx_rub3)),'-',
1458  & trim(rubrique(2,irub3,3))
1459  WRITE(nfic,'(2A)') '/',repeat('/',71)
1460  DO ikey=1,nkey
1461  ! Identifying keywwords that are 3 1
1462  IF(has_rubrique(ikey,irub1,1,lng).AND.
1463  & has_rubrique(ikey,irub2,2,lng).AND.
1464  & has_rubrique(ikey,irub3,3,lng)) THEN
1465  CALL dump_keyword(nfic,ikey)
1466  ENDIF
1467  ENDDO
1468  ENDIF
1469  ENDDO ! LEVEL 3
1470  ENDIF
1471  ENDDO ! LEVEL 2
1472  ENDDO ! LEVEL 1
1473  CLOSE(nfic)
1474 !
1475  END SUBROUTINE
1476  !
1477  END MODULE
dico_data::keyword
Definition: dico_data.f:28
dico_data::maxcond
integer, parameter maxcond
Definition: dico_data.f:24
dico_data
Definition: dico_data.f:3
declarations_special
Definition: declarations_special.F:3
dico_data::identify_rubrique_depends
subroutine identify_rubrique_depends()
Definition: dico_data.f:283
dico_data::read_dictionary
subroutine read_dictionary(FILENAME)
Definition: dico_data.f:688
dico_data::maxdep
integer, parameter maxdep
Definition: dico_data.f:22
declarations_special::lng_en
integer, parameter lng_en
Definition: declarations_special.F:39
dico_data::string_len
integer, parameter string_len
Definition: dico_data.f:18
dico_data::maxenum
integer, parameter maxenum
Definition: dico_data.f:26
dico_data::nmax
integer, parameter nmax
Definition: dico_data.f:73
dico_data::aide_len
integer, parameter aide_len
Definition: dico_data.f:8
dico_data::identify_rubrique
subroutine identify_rubrique()
Definition: dico_data.f:223
dico_data::read_dependencies
subroutine read_dependencies(FILENAME)
Definition: dico_data.f:610
declarations_damocles::indx
integer indx
Definition: declarations_damocles.f:37
dico_data::defaut_len
integer, parameter defaut_len
Definition: dico_data.f:12
dico_data::cond_len
integer, parameter cond_len
Definition: dico_data.f:14
dico_data::write_default
subroutine write_default(NFIC, IKEY, LNG)
Definition: dico_data.f:473
dico_data::identify_rubrique_idx
subroutine identify_rubrique_idx(RUB, IDX, LEVEL)
Definition: dico_data.f:353
declarations_special::lu
integer lu
Definition: declarations_special.F:45
dico_data::check_index
subroutine check_index(NFIC)
Definition: dico_data.f:115
dico_data::rub2_dep
logical, dimension(:,:,:), allocatable rub2_dep
Definition: dico_data.f:86
dico_data::nrub
integer, dimension(2, 3) nrub
Definition: dico_data.f:87
dico_data::nkey
integer nkey
Definition: dico_data.f:80
dico_data::has_rubrique
logical function has_rubrique(IKEY, IRUB, LEVEL, LNG)
Definition: dico_data.f:524
dico_data::int2str
subroutine int2str(STRING, I, POS)
Definition: dico_data.f:98
declarations_special::lng_fr
integer, parameter lng_fr
Y. AUDOUIN & J-M HERVOUET (EDF LAB, LNHE) 09/05/2014 V7P0 First version.
Definition: declarations_special.F:38
dico_data::rubrique
character(len=string_len), dimension(2, rmax, 3) rubrique
Definition: dico_data.f:84
declarations_damocles::retour
logical retour
Definition: declarations_damocles.f:28
declarations_damocles::nlign
integer nlign
Definition: declarations_damocles.f:30
declarations_damocles::nfic
integer nfic
Definition: declarations_damocles.f:33
dico_data::dump_list
subroutine dump_list(NFIC, KTYPE, STR, STR_LEN, CMD, CMD_LEN)
Definition: dico_data.f:409
dico_data::rubrique_info
character(len=1), dimension(rmax, 3) rubrique_info
Definition: dico_data.f:88
dico_data::keyword_len
integer, parameter keyword_len
Definition: dico_data.f:20
dico_data::identify_key
subroutine identify_key(CHAINE, ILONG, NUMERO, LNG)
Definition: dico_data.f:546
declarations_damocles::param
character(len=72) param
Definition: declarations_damocles.f:35
dico_data::dump_dictionary_index
subroutine dump_dictionary_index(FILENAME)
Definition: dico_data.f:1320
dico_data::get_hash_value
character(len=keyword_len) function get_hash_value(IKEY, ID, LNG)
Definition: dico_data.f:381
dico_data::identify_keyword
integer function identify_keyword(KEY_NAME, LNG)
Definition: dico_data.f:588
dico_data::rub1_dep
logical, dimension(:,:), allocatable rub1_dep
Definition: dico_data.f:86
dico_data::rmax
integer, parameter rmax
Definition: dico_data.f:75
dico_data::dump_dictionary_rub
subroutine dump_dictionary_rub(FILENAME)
Definition: dico_data.f:1364
dico_data::dble_quote
character(len=keyword_len) function dble_quote(STRIN)
Definition: dico_data.f:1209
dico_data::dump_keyword
subroutine dump_keyword(NFIC, IKEY)
Definition: dico_data.f:1233
declarations_damocles::deflu
integer deflu
Definition: declarations_damocles.f:37
declarations_damocles::itai
integer itai
Definition: declarations_damocles.f:37
declarations_damocles::ntyp
integer ntyp
Definition: declarations_damocles.f:37
declarations_special::path_len
integer, parameter path_len
Definition: declarations_special.F:41
dico_data::consigne_len
integer, parameter consigne_len
Definition: dico_data.f:16
dico_data::choix_len
integer, parameter choix_len
Definition: dico_data.f:10
dico_data::mydico
type(keyword), dimension(nmax *4) mydico
Definition: dico_data.f:78
declarations_damocles::longli
integer longli
Definition: declarations_damocles.f:31
declarations_damocles::erreur
logical erreur
Y. AUDOUIN (EDF LAB, LNHE) 09/05/2014 V7P0 First version.
Definition: declarations_damocles.f:27
declarations_damocles
Definition: declarations_damocles.f:3
Generated on Tue Jan 5 2021 14:38:01 for The TELEMAC-MASCARET system by doxygen 1.8.13