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

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

JB: add Id (ommited !)

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