Context Navigation

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

Last change on this file since 451 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
1	PROGRAM 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
473	END PROGRAM fparser
474	!
475	!
476	!==========================================================
477	!
478	!
479	SUBROUTINE 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
562	9999 cont = .FALSE.
563	8888 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.

Download in other formats: