Context Navigation

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

Last change on this file since 15 was 15, checked in by bellier, 18 years ago
JB: add tools and examples dd
File size: 24.8 KB

Line
1	PROGRAM 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
469	END PROGRAM fparser
470	!
471	!
472	!==========================================================
473	!
474	!
475	SUBROUTINE 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
558	9999 cont = .FALSE.
559	8888 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.

Download in other formats: