source: IOIPSL/trunk/tools/Fparser.f90 @ 386

Last change on this file since 386 was 386, checked in by bellier, 16 years ago

Added CeCILL License information

  • Property svn:keywords set to Id
File size: 24.9 KB
Line 
1PROGRAM fparser
2!-
3!$Id$
4!-
5! This software is governed by the CeCILL license
6! See IOIPSL/IOIPSL_License_CeCILL.txt
7
8  USE stringop
9
10  IMPLICIT NONE
11  !
12  !
13  !     Parses the code to create the Config.in Config.default and Config.help
14  !     which are used by the tk shell.
15  !
16  !
17  INTEGER nbkeymax, nbhelpmax, nbcasemax, nbsourmax, nbelmax
18  PARAMETER (nbkeymax=100, nbhelpmax=50, nbcasemax=50, nbsourmax=20,nbelmax=nbhelpmax+10)
19  INTEGER nbfilesmax
20  PARAMETER (nbfilesmax=150)
21
22  !
23  CHARACTER*120 :: configs(nbkeymax,nbelmax)
24  CHARACTER*120 :: tmp_help, tmp_key, tmp_desc, tmp_def
25  INTEGER :: keylen(nbkeymax), nbkeys
26  INTEGER :: key_pos(nbkeymax), help_pos(nbkeymax,2), def_pos(nbkeymax,2)
27  INTEGER :: des_pos(nbkeymax), IF_pos(nbkeymax)
28  CHARACTER*6 TYPE_op(nbkeymax)
29  !
30  CHARACTER*120 :: def_out(nbkeymax, nbhelpmax)
31  INTEGER :: nbdef_out(nbkeymax)
32  !
33  CHARACTER*120 :: tke
34  !
35  CHARACTER*2 :: nbstr
36  !
37  CHARACTER*80 :: files(nbfilesmax), source(nbsourmax), filetmp
38  CHARACTER*80 :: tmp, main_name
39  CHARACTER*120 :: keycase(nbcasemax), tmp_CASE
40  INTEGER :: nbcase, ii, find, nbsource
41  LOGICAL :: next_source, next_name, last_or
42
43  LOGICAL :: is_main, cont
44
45  CHARACTER*1 :: backslash, simplequote, doublequote
46
47  INTEGER :: ia, iread, iret, IFF, ih, nb_line, iv, id
48  INTEGER :: ind_space, ind_comma, ind_USE
49  INTEGER :: nbfiles, nb_key, nb_key_file
50  !
51  INTEGER, EXTERNAL ::  iargc, getarg 
52  !
53  !
54  next_source = .FALSE.
55  next_name = .FALSE.
56  is_main = .FALSE.
57  nbsource = 0
58  nbfiles = 0
59  main_name = 'IPSL'
60  !
61  backslash = ACHAR(92)
62  simplequote = ACHAR(39)
63  doublequote = ACHAR(34)
64  !
65  !
66  !
67  !     Analyse command line
68  !
69  !
70  !     Get the number of arguments, that is the options and the
71  !     files to be parsed.
72  !
73  !
74
75  iread = iargc()
76  !
77  DO ia=1,iread
78     !
79     iret = getarg(ia,tmp)
80     !
81     IF (next_source) THEN
82
83        nbsource = nbsource + 1
84        IF ( nbsource .GT. nbsourmax) THEN
85           WRITE(*,*) 'Too many files to source in the arguments.' 
86           WRITE(*,*) 'Increase nbsourmax'
87           STOP
88        ELSE
89           source(nbsource) = tmp(1:LEN_TRIM(tmp))
90        ENDIF
91        next_source = .FALSE.
92
93     ELSE IF (next_name) THEN
94        main_name = tmp(1:LEN_TRIM(tmp))
95        next_name = .FALSE.
96
97     ELSE
98        !     
99        IF ( INDEX(tmp,'-m') .GT. 0) THEN
100           is_main = .TRUE.
101        ELSE IF ( INDEX(tmp,'-n') .GT. 0) THEN
102           next_name = .TRUE.
103        ELSE IF ( INDEX(tmp,'-s') .GT. 0) THEN
104           next_source = .TRUE.
105        ELSE IF ( INDEX(tmp,'-h') .GT. 0) THEN
106           WRITE(*,*) 'USAGE : Fparse [-name NAME] '
107           WRITE(*,*) '               [-source file_to_source]'
108           WRITE(*,*) '               [-main] FORTAN_files'
109        ELSE
110           nbfiles = nbfiles + 1
111           IF ( nbfiles .GT. nbfilesmax) THEN
112              WRITE(*,*) 'Too many files to include in &
113                   &                 the arguments.' 
114              WRITE(*,*) 'Increase nbfilesmax'
115              STOP
116           ELSE
117              files(nbfiles) = tmp(1:LEN_TRIM(tmp))
118           ENDIF
119        ENDIF
120
121     ENDIF
122
123  ENDDO
124  !
125  IF ( nbfiles .LT. 1 ) THEN
126     WRITE(*,*) 'No files provided'
127     STOP
128  ENDIF
129  !
130  !
131  !     1.0 Read files and extract the lines which we need
132  !
133  !
134  nb_key = 0
135  !
136  DO IFF=1,nbfiles
137     !
138     filetmp = files(IFF)
139     CALL READ_from_file(filetmp, nbkeymax, nbelmax, configs, nb_key, keylen)
140     !
141  ENDDO
142  !
143  !     2.0 Scan the information we have extracted from the file for the elements we need
144  !
145  !
146  CALL analyse_configs(nbkeymax, nb_key, nbelmax, keylen, configs, key_pos, help_pos, def_pos, des_pos, IF_pos, TYPE_op)
147  !
148  !
149  !  3.0 Prepare the default values to put them in an array
150  !
151  !
152  DO ia = 1,nb_key
153     !
154     !  3.1 Go to blank delimited lines
155     !
156     nbdef_out(ia) = 0
157     !
158     DO ii=def_pos(ia,1), def_pos(ia,2)
159        !
160        tmp_help = configs(ia,ii)
161        ind_comma = INDEX(tmp_help(1:len_TRIM(tmp_help)),',')
162        DO WHILE (ind_comma .GT. 0) 
163           tmp_help(ind_comma:ind_comma) = ' '
164           ind_comma = INDEX(tmp_help,',')
165        ENDDO
166        CALL cmpblank(tmp_help)
167        configs(ia,ii) = tmp_help
168        !
169        !  3.2 extract the values
170        !
171        tmp_help = TRIM(ADJUSTL(configs(ia,ii)))
172        ind_space= INDEX(tmp_help(1:LEN_TRIM(tmp_help)),' ')
173        ! Get the first one (there is no space in between)
174        IF ( ind_space .EQ. 0) THEN
175           nbdef_out(ia) = nbdef_out(ia) + 1
176           def_out(ia, nbdef_out(ia)) = tmp_help(1:LEN_TRIM(tmp_help))
177        ELSE
178           ! Get all those which are before spaces
179           DO WHILE (ind_space .GT. 0) 
180              nbdef_out(ia) = nbdef_out(ia) + 1
181              def_out(ia, nbdef_out(ia)) = tmp_help(1:ind_space)
182              tmp_help = ADJUSTL(tmp_help(ind_space+1:LEN_TRIM(tmp_help)))
183              ind_space= INDEX(tmp_help(1:LEN_TRIM(tmp_help)),' ')
184           ENDDO
185           !    Get the last one which does not have a space behind
186           IF ( LEN_TRIM(tmp_help) .GT. 0) THEN
187              nbdef_out(ia) = nbdef_out(ia) + 1
188              def_out(ia, nbdef_out(ia)) = tmp_help(1:LEN_TRIM(tmp_help))
189           ENDIF
190           !
191        ENDIF
192     ENDDO
193     !
194  ENDDO
195  !
196  !
197  !
198  !      4.0 OPEN Config.in Defaults and Help files
199  !
200  !
201  OPEN (16, FILE='Config.in')
202  OPEN (17, FILE='Config.help')
203  OPEN (18, FILE='Config.defaults')
204  !
205  !     Some explantation
206  !
207  DO IFF=16,18
208     WRITE(IFF,'(1a)') '# '
209     WRITE(IFF,'(1a)') '# File created by Fparser, DO NOT EDIT'
210     WRITE(IFF,'(2a)') '# ', main_name(1:LEN_TRIM(main_name))
211     WRITE(IFF,'(1a)') '# '
212     WRITE(IFF,'(1a)') '# '
213  ENDDO
214  !
215  WRITE(17,'(2a)') '# Format of this file: description<nl>', &
216       &     ' variable<nl>helptext<nl><nl>.'
217  WRITE(17,'(2a)') '# If the question being documented is of', &
218       &     ' type "choice", we list'
219  WRITE(17,'(2a)') '# only the first occurring config variable.', &
220       &     ' The help texts'
221  WRITE(17,'(2a)') '# must not contain empty lines. No variable', &
222       &     ' should occur twice; if it'
223  WRITE(17,'(2a)') '# does, only the first occurrence will be', &
224       &     ' used by Configure. The lines'
225  WRITE(17,'(2a)') '# in a help text should be indented two', &
226       &     ' positions. Lines starting with'
227  WRITE(17,'(2a)') '# "#" are ignored. To be nice to menuconfig,', &
228       &     ' limit your lines to 70'
229  WRITE(17,'(2a)') '# characters. Use emacs" kfill.el to edit', &
230       &     ' this file or you lose.'
231  WRITE(17,'(2a)') '#'
232  !
233  IF ( is_main ) THEN
234     WRITE(16,'(3a)') 'mainmenu_name "Configuration of model ', &
235          &        main_name(1:LEN_TRIM(main_name)), '"'
236     WRITE(16,'(1a)') '# '
237  ENDIF
238  !
239  WRITE(16,'(1a)') 'mainmenu_option next_comment'
240  WRITE(16,'(3a)') 'comment "', main_name(1:LEN_TRIM(main_name)), '"'
241  WRITE(16,'(1a)') '# '
242  !
243  !   5.0 Loop through the KEYWORDS to prepare the output
244  !
245  DO IFF =1,nb_key
246     !
247     !     Config.in file
248     !
249
250     !
251     !     Is it a conditional option ?
252     !
253     IF ( IF_pos(IFF) .GE. 0)  THEN
254        tmp_help = configs(IFF,IF_pos(IFF))
255        !
256        IF ( (index(tmp_help,'||') .LE. 0) .AND. (index(tmp_help,'&&') .LE. 0) ) THEN
257           IF ( tmp_help(1:1) .EQ. '!') THEN
258              WRITE(16,'(3a)') 'if [ "$', tmp_help(2:LEN_TRIM(tmp_help)),  '" = "n" ]; then'
259           ELSE
260              WRITE(16,'(3a)') 'if [ "$', tmp_help(1:LEN_TRIM(tmp_help)),  '" = "y" ]; then'
261           ENDIF
262        ELSE
263           !
264           last_or = .TRUE.
265           nbcase = 0
266           !
267           DO WHILE( INDEX(tmp_help,'||') .GT. 0)
268              ii = INDEX(tmp_help,'||')
269              nbcase = nbcase + 1
270              if ( nbcase .EQ. 1 ) THEN
271                 IF ( tmp_help(1:1) .EQ. '!') THEN
272                    WRITE(16,'(3a)') 'if [ "$', tmp_help(2:ii-1),  '" = "n" \\'
273                 ELSE
274                    WRITE(16,'(3a)') 'if [ "$', tmp_help(1:ii-1),  '" = "y" \\'
275                 ENDIF
276              ELSE
277                 IF ( tmp_help(1:1) .EQ. '!') THEN
278                    WRITE(16,'(3a)') '-o "$', tmp_help(2:ii-1),  '" = "n" \\'
279                 ELSE
280                    WRITE(16,'(3a)') '-o "$', tmp_help(1:ii-1),  '" = "y" \\'
281                 ENDIF
282              ENDIF
283              tmp_help = TRIM(ADJUSTL(tmp_help(ii+2:LEN_TRIM(tmp_help))))
284           ENDDO
285           !
286           DO WHILE( INDEX(tmp_help,'&&') .GT. 0)
287              ii = INDEX(tmp_help,'&&')
288              nbcase = nbcase + 1
289              if ( nbcase .EQ. 1 ) THEN
290                 IF ( tmp_help(1:1) .EQ. '!') THEN
291                    WRITE(16,'(3a)') 'if [ "$', tmp_help(2:ii-1),  '" = "n" \\'
292                 ELSE
293                    WRITE(16,'(3a)') 'if [ "$', tmp_help(1:ii-1),  '" = "y" \\'
294                 ENDIF
295              ELSE
296                 IF ( tmp_help(1:1) .EQ. '!') THEN
297                    WRITE(16,'(3a)') '-a "$', tmp_help(2:ii-1),  '" = "n" \\'
298                 ELSE
299                    WRITE(16,'(3a)') '-a "$', tmp_help(1:ii-1),  '" = "y" \\'
300                 ENDIF
301              ENDIF
302              tmp_help = TRIM(ADJUSTL(tmp_help(ii+2:LEN_TRIM(tmp_help))))
303              last_or = .FALSE.
304           ENDDO
305           !
306           IF ( last_or ) THEN
307              IF ( tmp_help(1:1) .EQ. '!') THEN
308                 WRITE(16,'(3a)') '-o "$', tmp_help(2:LEN_TRIM(tmp_help)),  '" = "n" ]; then'
309              ELSE
310                 WRITE(16,'(3a)') '-o "$', tmp_help(1:LEN_TRIM(tmp_help)),  '" = "y" ]; then'
311              ENDIF
312           ELSE
313              IF ( tmp_help(1:1) .EQ. '!') THEN
314                 WRITE(16,'(3a)') '-a "$', tmp_help(2:LEN_TRIM(tmp_help)),  '" = "n" ]; then'
315              ELSE
316                 WRITE(16,'(3a)') '-a "$', tmp_help(1:LEN_TRIM(tmp_help)),  '" = "y" ]; then'
317              ENDIF
318           ENDIF
319        ENDIF
320        WRITE(16,'(1a)') '       '
321     ENDIF
322     !
323     !      Extract the information from configs
324     !
325     DO iv = 1,nbdef_out(IFF)
326
327        IF (nbdef_out(IFF) .EQ. 1) THEN
328           tmp_key = configs(IFF,key_pos(IFF))
329           tmp_desc = configs(IFF,des_pos(IFF))
330           tmp_def = def_out(IFF,iv)
331        ELSE
332           tmp_key = configs(IFF,key_pos(IFF))
333           WRITE(nbstr,'(I2.2)') iv
334           tmp_key = tmp_key(1:LEN_TRIM(tmp_key))//'__'//nbstr
335           tmp_desc = configs(IFF,des_pos(IFF))
336           IF ( iv .EQ. 1) THEN
337              tmp_desc = tmp_desc(1:LEN_TRIM(tmp_desc))//' (Vector)'
338           ELSE
339              tmp_desc = 'Cont...    '//tmp_key(1:LEN_TRIM(tmp_key))
340           ENDIF
341           tmp_def = def_out(IFF,iv)
342        ENDIF
343        !
344        !
345        !
346        IF (INDEX(TYPE_op(IFF),'bool') .GT. 0) THEN
347           !
348           WRITE(16,'(4a)') 'bool "', tmp_desc(1:LEN_TRIM(tmp_desc)), &
349                &              '" ',tmp_key(1:LEN_TRIM(tmp_key))
350           !
351        ELSE IF (INDEX(TYPE_op(IFF),'hex') .GT. 0) THEN
352           !
353           WRITE(16,'(6a)') 'hex "', tmp_desc(1:LEN_TRIM(tmp_desc)) &
354                &              ,'" ',tmp_key(1:LEN_TRIM(tmp_key)) &
355                &              ,' ',tmp_def(1:LEN_TRIM(tmp_def))
356           !
357        ELSE IF (INDEX(TYPE_op(IFF),'choice') .GT. 0) THEN
358           !
359           !   Get number of options
360           !
361           nbcase = 0
362           DO WHILE( INDEX(tmp_key,'||') .GT. 0)
363              ii = INDEX(tmp_key,'||')
364              nbcase = nbcase + 1
365              keycase(nbcase) = tmp_key(1:ii-1)
366              tmp_key=tmp_key(ii+2:LEN_TRIM(tmp_key))
367           ENDDO
368           nbcase = nbcase + 1
369           keycase(nbcase) = tmp_key(1:LEN_TRIM(tmp_key))
370
371           WRITE(16,'(4a)') "choice '", tmp_desc(1:LEN_TRIM(tmp_desc))," '",backslash
372           !
373           !   List options
374           !
375           tmp_CASE = keycase(1)
376           WRITE(16,'(5a)') '        "', tmp_CASE(1:LEN_TRIM(tmp_CASE)), "          "&
377                &,tmp_CASE(1:LEN_TRIM(tmp_CASE)), backslash
378           !
379           DO ii=2,nbcase-1
380              tmp_CASE = keycase(ii)
381              WRITE(16,'(5a)') '         ',   tmp_CASE(1:LEN_TRIM(tmp_CASE)),  '          ',&
382                   & tmp_CASE(1:LEN_TRIM(tmp_CASE)),  backslash
383           ENDDO
384           !
385           tmp_CASE = keycase(nbcase)
386           WRITE(16,'(6a)') '         ', &
387                &              tmp_CASE(1:LEN_TRIM(tmp_CASE)), &
388                &              '          ', tmp_CASE(1:LEN_TRIM(tmp_CASE)), &
389                &              '"  ',tmp_def(1:LEN_TRIM(tmp_def)) 
390           !
391        ELSE
392           WRITE(*,'(2a)') 'Uniplemented operation : ', TYPE_op(IFF)
393           STOP
394        ENDIF
395        !
396        !     Config.help file
397        !
398        tmp_key = configs(IFF,key_pos(IFF))
399        IF (INDEX(TYPE_op(IFF),'choice') .GT. 0) THEN
400           ii = INDEX(tmp_key,'||')-1
401        ELSE
402           ii = LEN_TRIM(tmp_key)
403        ENDIF
404
405        IF ( nbdef_out(IFF) .GT. 1) THEN
406           WRITE(17,'(1a)') tmp_desc(1:LEN_TRIM(tmp_desc))
407           WRITE(nbstr,'(I2.2)') iv
408           tke = tmp_key(1:ii)//'__'//nbstr
409           WRITE(17,'(1a)') tke(1:LEN_TRIM(tke))
410           WRITE(17,'(1a)') '  (Vector)'
411        ELSE
412           WRITE(17,'(1a)') tmp_desc(1:LEN_TRIM(tmp_desc))
413           WRITE(17,'(1a)') tmp_key(1:ii)
414        ENDIF
415        !
416        DO ih=help_pos(IFF,1),help_pos(IFF,2)
417           tmp_help = configs(IFF,ih)
418           WRITE(17,'("  ",1a)') tmp_help(1:LEN_TRIM(tmp_help))
419        ENDDO
420        !
421        !     Config.default file
422        !
423        IF (INDEX(TYPE_op(IFF),'choice') .GT. 0) THEN
424
425           WRITE(18,'(2a)') tmp_def(1:LEN_TRIM(tmp_def)),'=y'
426
427        ELSE
428
429           WRITE(18,'(3a)') tmp_key(1:LEN_TRIM(tmp_key)),'=', &
430                &              tmp_def(1:LEN_TRIM(tmp_def))
431
432        ENDIF
433        !     
434        !     Add some empty line to all files
435        !     
436        WRITE(16,'(1a)') '       '
437        WRITE(17,'(1a)') '       '
438        WRITE(17,'(1a)') '       '
439     ENDDO
440     !
441     !
442     !     Close the IF if needed
443     !
444
445     IF ( IF_pos(IFF) .GT. 0) THEN
446        WRITE(16,'(1a)') 'fi'
447        WRITE(16,'(1a)') '       '
448     ENDIF
449
450     !
451  ENDDO
452  !
453  WRITE(16,'(1a)') 'endmenu'
454  WRITE(16,'(1a)') '       '
455  IF ( nbsource .GT. 0) THEN
456     DO ih=1,nbsource
457        tmp = source(ih)
458        WRITE(16,'(1a)') '              '
459        WRITE(16,'(3a)') 'source ',tmp(1:LEN_TRIM(tmp)), &
460             &           '/Config.in'
461     ENDDO
462  ENDIF
463  !
464  !
465  CLOSE(16)
466  CLOSE(17)
467  CLOSE(18)
468  !
469  !
470  !
471  STOP
472
473END PROGRAM fparser
474!
475!
476!==========================================================
477!
478!
479SUBROUTINE READ_from_file(file, nbkeymax, nbelmax, configs, nbitems, itemlen)
480  !
481  USE stringop
482  !
483  IMPLICIT NONE
484  !
485  !
486  !     This routine reads the file and adds the config info it finds to the configs array.
487  !     Thus the nbitems is an imput variable as it can be increased as we go through the files.
488  !
489  !
490  CHARACTER*(*) :: file
491  INTEGER :: nbkeymax, nbelmax
492  CHARACTER*120 :: configs(nbkeymax, nbelmax)
493  INTEGER ::  nbitems, itemlen(nbkeymax)
494  !
495  INTEGER :: conf_pos, ip
496  CHARACTER*250 line
497  LOGICAL :: cont, conf_END
498  !
499  cont = .TRUE.
500  conf_END = .TRUE.
501  !
502  OPEN (12, file=file)
503  !
504  !   1.0 Loop over all the lines of a given file to extract all the configuration line
505  !
506  DO WHILE (cont)
507    READ(12,'(a)',END=9999) line
508    !
509    !   1.0  A configuration line is detected by the line below.
510    !
511    IF ( INDEX(line,'Config') .EQ. 1 .OR. INDEX(line,'!'//'Config') .GE. 1 ) THEN
512        !
513        IF ( conf_END ) THEN
514            nbitems = nbitems + 1
515            IF ( nbitems .GT. nbkeymax) THEN
516                WRITE(*,*) 'read_from_file : The number of keys in the input array is too small for this file'
517                STOP
518            ENDIF
519            itemlen(nbitems) = 0
520            conf_END = .FALSE.
521        ENDIF
522        !
523        itemlen(nbitems) = itemlen(nbitems) + 1
524        IF ( itemlen(nbitems) .GT. nbelmax ) THEN
525            WRITE(*,*) 'read_from_file : The number of elements per key in the input array is too small'
526            STOP
527        ENDIF
528        !
529        !  The detected line is shaved !
530        !
531        IF ( INDEX(line,'Config') .EQ. 1) THEN
532            conf_pos = 7
533        ELSE
534            conf_pos = INDEX(line,'!'//'Config') +7
535        ENDIF
536        line = line(conf_pos:LEN_TRIM(line))
537        line = TRIM(ADJUSTL(line))
538        CALL cmpblank(line)
539        !
540        configs(nbitems,itemlen(nbitems)) = line
541        !
542    ELSE
543        !
544        !   Look for the end of a configuration structure.
545        !  It is determined by a call to the getin subroutine
546        !
547        CALL strlowercase(line)
548        CALL cmpblank(line)
549        ip = INDEX(line,' (')
550        DO WHILE (ip .GT. 0)
551          line = line(1:ip-1)//line(ip+1:LEN_TRIM(line))
552          ip = INDEX(line,' (')
553        ENDDO
554        IF ( INDEX(line, 'call getin(') .GT. 0 .OR. INDEX(line, 'call setvar(') .GT. 0) THEN
555            conf_END = .TRUE.
556        ENDIF
557        !
558    ENDIF
559    !
560    cont = .TRUE.
561    GOTO 8888
5629999 cont = .FALSE.
5638888 CONTINUE
564   
565    ENDDO
566  !
567  CLOSE(12)
568  !
569  END SUBROUTINE READ_from_file
570  !
571  !==========================================================
572  !
573  !
574  SUBROUTINE analyse_configs(nbkmax, nb_key, nbelmax, keylen, configs, key_pos, help_pos, def_pos, des_pos, IF_pos, TYPE_op)
575    !
576  USE stringop
577  !
578    IMPLICIT NONE
579    !
580    !
581    !    This subroutine will localize the KEYWORDS in the configs array
582    !    and extract all their arguments. For the moment 5 arguments are recognized :
583    !    KEY  : The keyword by which the all is identified
584    !    HELP : This identifies the help text
585    !    DEF : The default value of for this KEYWORD
586    !    DESC : A short description, not more than one line
587    !    IF : Specifies the other Keyword it depend on. This is a nice features for the menus as it can hide
588    !            things we do not need
589    !
590    !    The DEF and HELP keywords can be multi line
591    !
592    INTEGER :: nbkmax, nb_key, nbelmax
593    INTEGER :: keylen(nbkmax)
594    INTEGER :: key_pos(nbkmax), help_pos(nbkmax,2), def_pos(nbkmax,2), des_pos(nbkmax), IF_pos(nbkmax)
595    CHARACTER*120 :: configs(nbkmax,nbelmax)
596    CHARACTER*6 :: TYPE_op(nbkmax)
597    !
598    !   This is the number of arguments we need to find an end for and the total number of arguments  we can have.
599    !   Thus these parameters needs to be updated when the list of arguments to the routine is changed
600    !
601    INTEGER, PARAMETER :: toendlen=2, indexlen=5
602    !
603    INTEGER :: toend(toendlen), foundend(toendlen), kindex(indexlen)
604    INTEGER :: ik, il, ieq
605    CHARACTER*120 :: tmp_str, tmp_str2
606    !
607    !
608    key_pos(1:nb_key)=-1
609    help_pos(1:nb_key,1:2)=-1
610    def_pos(1:nb_key,1:2)=-1
611    des_pos(1:nb_key)=-1
612    IF_pos(1:nb_key)=-1
613    TYPE_op(1:nb_key)='hex'
614    !
615    DO ik=1,nb_key
616      !
617      !
618      DO il=1,keylen(ik)
619        !
620        ieq = INDEX(configs(ik,il),'=')
621        tmp_str = configs(ik,il)
622        tmp_str = tmp_str(1:ieq)
623        CALL struppercase(tmp_str)
624        !
625        !      Decide if this is a reserved name and where it fits
626        !
627        !      At the same time we clean up the configs array
628        !
629        IF ( INDEX(tmp_str,'KEY') .GT. 0) THEN
630            IF ( key_pos(ik) .GT. 0) THEN
631                WRITE(*,*) 'analyse_config : Already have a KEYWORD, check that you have a call to getin'
632                WRITE(*,*) 'analyse_config : ', configs(ik,il)
633                STOP
634            ENDIF
635            key_pos(ik) = il
636            tmp_str2 = configs(ik,il)
637            tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2))
638            configs(ik,il) = TRIM(ADJUSTL(tmp_str2))
639            !
640            !   Here we have to check that we are not in an 'choice' case
641            !
642            IF ( INDEX(tmp_str2,'||') .GT. 0) THEN
643                TYPE_op(ik) = 'choice'
644            ENDIF
645            !
646        ENDIF
647        !
648        IF ( INDEX(tmp_str,'DEF') .GT. 0) THEN
649            IF ( def_pos(ik,1) .GT. 0) THEN
650                WRITE(*,*) 'analyse_config : Already have a DEF, check that you have a call to getin'
651                WRITE(*,*) 'analyse_config : ', configs(ik,il)
652                STOP
653            ENDIF
654            def_pos(ik,1) = il
655            tmp_str2 = configs(ik,il)
656            tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2))
657            tmp_str2 = TRIM(ADJUSTL(tmp_str2))
658            configs(ik,il) = tmp_str2 
659            !
660            !  Here we can check if we have a boolean operation
661            !  We also wish to standardise the value of booleans
662            !
663            CALL struppercase(tmp_str2)
664            IF (INDEX(tmp_str2,'Y') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 1 .OR.&
665               & INDEX(tmp_str2,'T') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 1 .OR.&
666               & INDEX(tmp_str2,'YES') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 3 .OR.&
667               & INDEX(tmp_str2,'TRUE') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 4 .OR.&
668               & INDEX(tmp_str2,'.TRUE.') .EQ. 1) THEN
669                configs(ik,il) = 'y'
670                TYPE_op(ik) = 'bool'
671            ENDIF
672            !
673            IF (INDEX(tmp_str2,'N') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 1 .OR.&
674               & INDEX(tmp_str2,'F') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 1 .OR.&
675               & INDEX(tmp_str2,'NO') .EQ. 1 .AND. LEN_TRIM(tmp_str2) .EQ. 2 .OR.&
676               & INDEX(tmp_str2,'FALSE') .EQ. 1  .AND. LEN_TRIM(tmp_str2) .EQ. 5 .OR.&
677               & INDEX(tmp_str2,'.FALSE.') .EQ. 1) THEN
678                configs(ik,il) = 'n'
679                TYPE_op(ik) = 'bool'
680            ENDIF
681            !
682            ! Here we check if we have a default behavior and put a standard name
683            !
684            IF (INDEX(tmp_str2,'DEF') .EQ. 1 .OR. INDEX(tmp_str2,'NONE') .EQ. 1) THEN
685                configs(ik,il) = 'default'
686            ENDIF
687            !
688        ENDIF
689        !
690        IF ( INDEX(tmp_str,'DESC') .GT. 0) THEN
691            IF ( des_pos(ik) .GT. 0) THEN
692                WRITE(*,*) 'analyse_config : Already have a DESC, check that you have a call to getin'
693                WRITE(*,*) 'analyse_config : ', configs(ik,il)
694                STOP
695            ENDIF
696            des_pos(ik) = il
697            tmp_str2 = configs(ik,il)
698            tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2))
699            configs(ik,il) = TRIM(ADJUSTL(tmp_str2))
700        ENDIF
701        !
702        IF ( INDEX(tmp_str,'IF') .GT. 0) THEN
703            IF ( IF_pos(ik) .GT. 0) THEN
704                WRITE(*,*) 'analyse_config : Already have a IF, check that you have a call to getin'
705                WRITE(*,*) 'analyse_config : ', configs(ik,il)
706                STOP
707            ENDIF
708            IF_pos(ik) = il
709            tmp_str2 = configs(ik,il)
710            tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2))
711            configs(ik,il) = TRIM(ADJUSTL(tmp_str2))
712        ENDIF 
713        !
714        IF ( INDEX(tmp_str,'HELP') .GT. 0) THEN
715            help_pos(ik,1) = il
716            tmp_str2 = configs(ik,il)
717            tmp_str2 = tmp_str2(ieq+1:LEN_TRIM(tmp_str2))
718            configs(ik,il) = TRIM(ADJUSTL(tmp_str2))
719        ENDIF
720        !
721      ENDDO
722      !
723      !     Check if we not missing some important informations as for instance
724      !
725      !     THE KEYWORD
726      !
727      IF ( key_pos(ik) .LT. 1) THEN
728          WRITE(*,*) 'analyse_configs : Could not find a keyword in the following entry :'
729          DO il=1,keylen(ik)
730            WRITE(*,'(a70)') configs(ik,il)
731          ENDDO
732          STOP
733      ENDIF
734      !
735      !      THE DEFAULT VALUE
736      !
737      IF ( def_pos(ik,1) .LT. 1) THEN
738          WRITE(*,*) 'analyse_configs : Could not find a default value in the following entry :'
739          DO il=1,keylen(ik)
740            WRITE(*,'(a70)') configs(ik,il)
741          ENDDO
742          STOP
743      ENDIF
744      !
745      !   Get the end of all the multi line arguments
746      !
747      toend(1) = MAX(def_pos(ik,1),1)
748      toend(2) = MAX(help_pos(ik,1),1)
749      foundend(:) = keylen(ik)
750      kindex(1) = MAX(key_pos(ik),1)
751      kindex(2) = MAX(des_pos(ik),1)
752      kindex(3) = MAX(def_pos(ik,1),1)
753      kindex(4) = MAX(IF_pos(ik),1)
754      kindex(5) = MAX(help_pos(ik,1),1)
755      CALL find_ends(toendlen, toend, indexlen, kindex, foundend)
756      def_pos(ik,2) = foundend(1)
757      help_pos(ik,2) = foundend(2)
758      !
759    ENDDO
760    !
761  END SUBROUTINE analyse_configs
762  !
763  SUBROUTINE find_ends(toendlen, toend, indexlen, kindex, foundend)
764    !
765    IMPLICIT NONE
766    !
767    !
768    !  We find the end of the text for all the elements in the key which are multi line
769    !   This subroutine aims at providing a flexible way to determine this so that other
770    !   elements in the Keyword can be multi line. For the moment it is only the Help and Ded
771    !  which are allowed to be multi line.
772    !
773    !  Foundend need to be initialized to the maximum value of the elements
774    !
775    !
776    INTEGER :: toendlen, toend(toendlen), indexlen, kindex(indexlen), foundend(toendlen)
777    !
778    INTEGER :: whmin(1), ie, ii
779    !
780    DO ie=1,toendlen
781      !
782      whmin = MINLOC(toend(1:toendlen))
783      !
784      DO ii=1,indexlen
785        IF ( kindex(ii) .GT. toend(whmin(1)) .AND. foundend(whmin(1)) .GE. kindex(ii)) THEN
786            foundend(whmin(1)) = kindex(ii)-1
787            toend(whmin(1)) = 100000
788        ENDIF
789      ENDDO
790      !
791    ENDDO
792    !
793  END SUBROUTINE find_ends
Note: See TracBrowser for help on using the repository browser.