Context Navigation

cfgparse.F90 @ 1897

Last change on this file since 1897 was 1897, checked in by jvatant, 7 years ago

Making Titan's hazy again - part II
+ Major updates of J.Burgalat YAMMS library and optical coupling, including :
++ Added the routines for haze optics inside YAMMS
++ Calling rad. transf. with interactive haze is plugged
in but should stay unactive as long as the microphysics is
in test phase : cf "uncoupl_optic_haze" flag : true for now !
++ Also some sanity checks for negative tendencies and
some others upkeep of YAMMS model
+ Also added a temporary CPP key USE_QTEST in physiq_mod
that enables to have microphysical tendencies separated
from dynamics for debugging and test phases
-- JVO and JB

File size: 83.9 KB

Line
1	! Copyright Jérémie Burgalat (2010-2015,2017)
2	!
3	! jeremie.burgalat@univ-reims.fr
4	!
5	! This software is a computer program whose purpose is to provide configuration
6	! file and command line arguments parsing features to Fortran programs.
7	!
8	! This software is governed by the CeCILL-B license under French law and
9	! abiding by the rules of distribution of free software. You can use,
10	! modify and/ or redistribute the software under the terms of the CeCILL-B
11	! license as circulated by CEA, CNRS and INRIA at the following URL
12	! "http://www.cecill.info".
13	!
14	! As a counterpart to the access to the source code and rights to copy,
15	! modify and redistribute granted by the license, users are provided only
16	! with a limited warranty and the software's author, the holder of the
17	! economic rights, and the successive licensors have only limited
18	! liability.
19	!
20	! In this respect, the user's attention is drawn to the risks associated
21	! with loading, using, modifying and/or developing or reproducing the
22	! software by the user in light of its specific status of free software,
23	! that may mean that it is complicated to manipulate, and that also
24	! therefore means that it is reserved for developers and experienced
25	! professionals having in-depth computer knowledge. Users are therefore
26	! encouraged to load and test the software's suitability as regards their
27	! requirements in conditions enabling the security of their systems and/or
28	! data to be ensured and, more generally, to use and operate it in the
29	! same conditions as regards security.
30	!
31	! The fact that you are presently reading this means that you have had
32	! knowledge of the CeCILL-B license and that you accept its terms.
33
34	!! file: cfgparse.F90
35	!! summary: Configuration file parser source file.
36	!! author: J. Burgalat
37	!! date: 2013-2015,2017
38
39	#include "defined.h"
40
41	MODULE CFGPARSE
42	!! Configuration file parsing module
43	!!
44	!! This module defines a set of derived types as well as methods to parse configuration files.
45	!!
46	!! If you only wish to have an overview of cfgparse usage, you'd better go
47	!! [here](\|url\|/page/swift/p02_cfgparse.html).
48	!! @todo
49	!! Add interpolation from environment and/or parser options.
50	USE, INTRINSIC :: ISO_FORTRAN_ENV
51	USE ERRORS
52	USE STRING_OP
53	USE FSYSTEM
54	IMPLICIT NONE
55
56	PRIVATE
57
58	PUBLIC :: cfg_clear, cfg_read_config, cfg_write_config, &
59	cfg_get_value, cfg_set_value, cfg_count, cfg_check_name, &
60	cfg_has_option, cfg_has_section, &
61	cfg_option_names,cfg_section_names, &
62	cfg_remove_option, cfg_remove_section, &
63	cfg_sort_options
64
65	PUBLIC :: noerror,error, error_to_string, aborting
66
67	! some public definitions from other modules
68	! from strings
69	PUBLIC :: to_lower,st_slen, st_llen
70
71	PUBLIC :: OPERATOR(==), OPERATOR(/=), ASSIGNMENT(=)
72
73	TYPE, PUBLIC :: option
74	!! Define an option
75	CHARACTER(len=st_slen), PRIVATE :: name = "" !! Name of the option
76	CHARACTER(len=st_slen), PRIVATE :: section = "" !! Associated section name.
77	TYPE(words), PRIVATE :: values !! Values of the option
78	END TYPE option
79
80	TYPE, PUBLIC :: cfgparser
81	!! Define a parser of options
82	!!
83	!! A [[cfgparser(type)]] stores [[option(type)]] objects.
84	TYPE(option), DIMENSION(:), ALLOCATABLE :: options !! list of options.
85	#if HAVE_FTNPROC
86	CONTAINS
87	PROCEDURE, PRIVATE :: cp_get_rv_sc
88	PROCEDURE, PRIVATE :: cp_get_dv_sc
89	PROCEDURE, PRIVATE :: cp_get_iv_sc
90	PROCEDURE, PRIVATE :: cp_get_lv_sc
91	PROCEDURE, PRIVATE :: cp_get_cv_sc
92	PROCEDURE, PRIVATE :: cp_get_sv_sc
93	PROCEDURE, PRIVATE :: cp_get_rv_ve
94	PROCEDURE, PRIVATE :: cp_get_dv_ve
95	PROCEDURE, PRIVATE :: cp_get_iv_ve
96	PROCEDURE, PRIVATE :: cp_get_lv_ve
97	PROCEDURE, PRIVATE :: cp_get_cv_ve
98	PROCEDURE, PRIVATE :: cp_get_sv_ve
99	PROCEDURE, PRIVATE :: cp_set_rv_sc
100	PROCEDURE, PRIVATE :: cp_set_dv_sc
101	PROCEDURE, PRIVATE :: cp_set_iv_sc
102	PROCEDURE, PRIVATE :: cp_set_lv_sc
103	PROCEDURE, PRIVATE :: cp_set_cv_sc
104	PROCEDURE, PRIVATE :: cp_set_sv_sc
105	PROCEDURE, PRIVATE :: cp_set_rv_ve
106	PROCEDURE, PRIVATE :: cp_set_dv_ve
107	PROCEDURE, PRIVATE :: cp_set_iv_ve
108	PROCEDURE, PRIVATE :: cp_set_lv_ve
109	PROCEDURE, PRIVATE :: cp_set_cv_ve
110	PROCEDURE, PRIVATE :: cp_set_sv_ve
111	!> Read configuration file
112	PROCEDURE, PUBLIC :: read_config => cfg_read_config
113	!> Write configuration file
114	PROCEDURE, PUBLIC :: write_config => cfg_write_config
115	!> Get the number of sections in the parser
116	PROCEDURE, PUBLIC :: count => cfg_count
117	!> Clean the parser (delete all options, free memory)
118	PROCEDURE, PUBLIC :: clear => cfg_clear
119	!> Get the names of the user-defined sections in the parser
120	PROCEDURE, PUBLIC :: section_names => cfg_section_names
121	!> Get the list of options names
122	PROCEDURE, PUBLIC :: option_names => cfg_option_names
123	!> Check if parser has option by name
124	PROCEDURE, PUBLIC :: has_option => cfg_has_option
125	!> Check if parser has section by name
126	PROCEDURE, PUBLIC :: has_section => cfg_has_section
127	!> Remove an option from the parser.
128	PROCEDURE, PUBLIC :: remove_option => cfg_remove_option
129	!> Remove a section (and all the associated options) from the parser.
130	PROCEDURE, PUBLIC :: remove_section => cfg_remove_section
131	!> Get value(s) of an option in the parser by name
132	!!
133	!! ```
134	!! FUNCTION cfg_get_value(this,name,output) RESULT(error)
135	!! ```
136	!!
137	!! The method attempts to get the value(s) of an option that matches _name_ in _this_ parser.
138	!!
139	!! On error, __output__ argument is undefined (that is, left unchanged
140	!! for scalar versions, unallocated for vector version).
141	!!
142	!! Errors occur in the following situations:
143	!! - The option has no value (-6)
144	!! - The option does not exist (-7)
145	!! - The option's value cannot be cast in the desired type (-10)
146	GENERIC, PUBLIC :: get_value => cp_get_rv_sc,cp_get_dv_sc,cp_get_iv_sc, &
147	cp_get_lv_sc,cp_get_cv_sc,cp_get_sv_sc, &
148	cp_get_rv_ve,cp_get_dv_ve,cp_get_iv_ve, &
149	cp_get_lv_ve,cp_get_cv_ve,cp_get_sv_ve
150	!> Set value(s) of an option in the parser by name
151	!!
152	!! ```
153	!! FUNCTION cfg_set_value(this,name,input,create) RESULT(error)
154	!! ```
155	!!
156	!! The method searches for the option matching the given _name_ in _this_ parser and sets new
157	!! values.
158	!!
159	!! If _create_ is set to .true. (default to .false.) the method creates the option if does not
160	!! exist in _this_ parser.
161	!! @warning
162	!! In such case, if the given is not valid, an assertion is raised !
163	!!
164	!! On error (i.e. no option matches the given _name_), no values are set.
165	GENERIC, PUBLIC :: set_value => cp_set_rv_sc,cp_set_dv_sc,cp_set_iv_sc, &
166	cp_set_lv_sc,cp_set_cv_sc,cp_set_sv_sc, &
167	cp_set_rv_ve,cp_set_dv_ve,cp_set_iv_ve, &
168	cp_set_lv_ve,cp_set_cv_ve,cp_set_sv_ve
169	#endif
170
171	END TYPE cfgparser
172
173	!> Get value(s) of an option in the parser by name.
174	!!
175	!! ```
176	!! FUNCTION cfg_get_value(parser,name,output) RESULT(error)
177	!! ```
178	!!
179	!! The method attempts to get the value(s) of an option that matches _name_ in _this_ parser.
180	!!
181	!! On error, __output__ argument is undefined (that is, left unchanged
182	!! for scalar versions, unallocated for vector version).
183	!!
184	!! Errors occur in the following situations:
185	!! - The option has no value (-6)
186	!! - The option does not exist (-7)
187	!! - The option's value cannot be cast in the desired type (-10)
188	INTERFACE cfg_get_value
189	MODULE PROCEDURE cp_get_rv_sc,cp_get_dv_sc,cp_get_iv_sc, &
190	cp_get_lv_sc,cp_get_cv_sc,cp_get_sv_sc, &
191	cp_get_rv_ve,cp_get_dv_ve,cp_get_iv_ve, &
192	cp_get_lv_ve,cp_get_cv_ve,cp_get_sv_ve
193	END INTERFACE
194
195	!> Set value(s) of an option in the parser by name
196	!!
197	!! ```
198	!! FUNCTION set_value(this,name,input,create) RESULT(error)
199	!! ```
200	!!
201	!! The method searches for the option matching the given _name_ in _this_ parser and sets new
202	!! values.
203	!!
204	!! If _create_ is set to .true. (default to .false.) the method quietly create the option if does not
205	!! exist in _this_ parser.
206	!! @warning
207	!! In such case, if the given __name__ is not valid, an error is raised !
208	!!
209	!! On error (i.e. no option matches the given _name_), no values are set.
210	INTERFACE cfg_set_value
211	MODULE PROCEDURE :: cp_set_rv_sc,cp_set_dv_sc,cp_set_iv_sc, &
212	cp_set_lv_sc,cp_set_cv_sc,cp_set_sv_sc, &
213	cp_set_rv_ve,cp_set_dv_ve,cp_set_iv_ve, &
214	cp_set_lv_ve,cp_set_cv_ve,cp_set_sv_ve
215	END INTERFACE
216
217	!> Derived type assignment operator
218	!!
219	!! This interface defines the assignment operator for the containers defined in the module.
220	INTERFACE ASSIGNMENT(=)
221	MODULE PROCEDURE cp_affect_sc, op_affect_sc
222	END INTERFACE
223
224	CONTAINS
225
226	SUBROUTINE op_affect_sc(this,other)
227	!! Option object assignment operator subroutine
228	!!
229	!! The subroutine assigns __other__ to __this__.
230	TYPE(option), INTENT(inout) :: this !! An option object to be assigned
231	TYPE(option), INTENT(in) :: other !! An option object to assign
232	CALL words_clear(this%values) ! normally not needed
233	this%name = other%name
234	this%section = other%section
235	this%values = other%values
236	END SUBROUTINE op_affect_sc
237
238	FUNCTION op_valid(opt) RESULT(ok)
239	!! Check whether or not the option is valid (i.e. has name)
240	TYPE(option), INTENT(in) :: opt !! An option object
241	LOGICAL :: ok !! True if the option is valid, false otherwise.
242	ok = LEN_TRIM(opt%name) > 0
243	END FUNCTION op_valid
244
245	SUBROUTINE op_clear(opt)
246	!! Clear and invalid the given option.
247	TYPE(option), INTENT(inout) :: opt !! An option object
248	opt%name = ''
249	opt%section = ''
250	CALL words_clear(opt%values)
251	END SUBROUTINE op_clear
252
253	FUNCTION op_full_name(opt) RESULT(name)
254	!! Get the full name of an option.
255	!!
256	!! @note
257	!! If no section is defined in the option (that should not happen), "__default__" is used
258	!! as the section part of the full name.
259	TYPE(option), INTENT(in) :: opt !! An option object
260	CHARACTER(len=:), ALLOCATABLE :: name !! The fullname of the option
261	IF (LEN_TRIM(opt%section) == 0) THEN
262	name = "__default__/"//TRIM(opt%name)
263	ELSE
264	name = TRIM(opt%section)//"/"//TRIM(opt%name)
265	ENDIF
266	END FUNCTION op_full_name
267
268	FUNCTION op_split_name(fname,sname,pname) RESULT(err)
269	!> Split a full name in section and option names
270	!!
271	!! The method splits a full name into (section,option) names:
272	!!
273	!! - Option basename is always set in lower-case.
274	!! - If any, section name case is left unmodified.
275	!!
276	!! A full name simply consists in a section name and an option name separated by a single "/".
277	!!
278	!! The method never checks the validity of the output names. Consider using [[cfg_check_name(function)]]
279	!! to do so.
280	!! @note
281	!! If _fname_ does not contains any "/", the method sets the special name "\_\_default\_\_" for the output
282	!! section name.
283	!! @note
284	!! On failure, output arguments are set to empty strings.
285	!! @warning
286	!! If _fname_ ends with a "/", an error (-9, invalid name) is raised: the method always assumes it can
287	!! find an option part in the name.
288	CHARACTER(len=*), INTENT(in) :: fname !! A name to split
289	CHARACTER(len=:), INTENT(out), ALLOCATABLE :: sname, & !! Section part of the name
290	pname !! Option part of the name
291	TYPE(error) :: err !! Error status of the method
292	INTEGER :: idx
293	CHARACTER(len=:), ALLOCATABLE :: tfname
294	err = noerror ; pname = "" ; sname = ""
295	tfname = op_format(fname,sname,pname)
296	IF (LEN_TRIM(tfname) == 0) err = error("Invalid option name ("//TRIM(fname)//")",-9)
297	END FUNCTION op_split_name
298
299	FUNCTION op_format(name,sname,pname) RESULT(oname)
300	!! Format the input name to be consistent with character case requirements.
301	!!
302	!! Given a name, the method tries to split in section/option names.
303	!! Then it converts the option part in lower-case.
304	!!
305	!! If no section part is found (not '/' or set as first character of name), the
306	!! special section name `__default__` is set.
307	!!
308	!! If name ends with a '/', it is an error and the method returns an empty string.
309	CHARACTER(len=*), INTENT(in) :: name !! Name to format.
310	CHARACTER(len=:), ALLOCATABLE, INTENT(out), OPTIONAL :: sname !! Section part of the name (optional output)
311	CHARACTER(len=:), ALLOCATABLE, INTENT(out), OPTIONAL :: pname !! Option part of the name (optional output)
312	CHARACTER(len=:), ALLOCATABLE :: oname !! Formatted full option name.
313	INTEGER :: idx
314	CHARACTER(len=:), ALLOCATABLE :: zsname,zpname
315	zpname = "" ; zsname = ""
316	! splits input name in sname, pname
317	idx = INDEX(name,'/')
318	IF (idx == LEN_TRIM(name)) THEN
319	oname = ''
320	IF (PRESENT(sname)) sname = ''
321	IF (PRESENT(pname)) pname = ''
322	RETURN
323	ELSE IF (idx <= 1) THEN
324	zsname = "__default__" ; zpname = to_lower(TRIM(name))
325	IF (idx == 1) zpname=zpname(2:)
326	ELSE
327	zsname = name(:idx-1)
328	zpname = to_lower(name(idx+1:LEN_TRIM(name)))
329	ENDIF
330	oname = zsname//"/"//zpname
331	IF (PRESENT(sname)) sname = zsname
332	IF (PRESENT(pname)) pname = zpname
333	END FUNCTION op_format
334
335	FUNCTION op_greater_than(left,right) RESULT(ret)
336	!> greater than operator for option derived type.
337	!!
338	!! the comparison is made on section and option name (in alphabetical order).
339	TYPE(option), INTENT(in) :: left !! LHS option.
340	TYPE(option), INTENT(in) :: right !! RHS option.
341	LOGICAL :: ret
342	!! .true. if LHS is _greater_ than RHS (based on section and option name)
343	ret = LGT(op_full_name(left),op_full_name(right))
344	END FUNCTION op_greater_than
345
346	FUNCTION op_less_than(left,right) RESULT(ret)
347	!> Less than operator for option derived type.
348	!!
349	!! the comparison is made on section and option name (in alphabetical order).
350	TYPE(option), INTENT(in) :: left !! LHS option.
351	TYPE(option), INTENT(in) :: right !! RHS option.
352	LOGICAL :: ret
353	!! .true. if LHS is _less_ than RHS (based on section and option name)
354	ret = LLT(op_full_name(left),op_full_name(right))
355	END FUNCTION op_less_than
356
357	FUNCTION op_to_str(opt,num_values) RESULT(str)
358	!! Get the string representation of a option object
359	!! @note
360	!! If the object is not valid an empty string is returned.
361	TYPE(option), INTENT(in) :: opt
362	!! A option object
363	INTEGER, INTENT(in), OPTIONAL :: num_values
364	!! Optional integer with the number of values to print per line
365	CHARACTER(len=:), ALLOCATABLE :: str
366	!! An allocated string with the representation of the option object
367	LOGICAL :: ret
368	INTEGER :: nv,np,i
369	CHARACTER(len=:), ALLOCATABLE :: nspcs
370	CHARACTER(len=st_slen), ALLOCATABLE, DIMENSION(:) :: vec
371	nv = 8 ; IF (PRESENT(num_values)) nv = MAX(1,num_values)
372	str = ""
373	str = TRIM(opt%name)//" = " ; np = LEN(str)
374	ALLOCATE(CHARACTER(len=np) :: nspcs) ; nspcs(1:) = " "
375	! stores the error but do not check...
376	ret = words_to_vector(opt%values,vec)
377	IF (.NOT.ALLOCATED(vec)) RETURN
378	DO i=1,SIZE(vec)
379	IF (string_is(TRIM(vec(i))) == st_string.AND.TRIM(vec(i))/="NULL") THEN
380	str = str//'"'//remove_quotes(TRIM(vec(i)))//'",'
381	ELSE
382	str = str//TRIM(vec(i))//','
383	ENDIF
384	IF (MOD(i,nv) == 0) THEN
385	str = str//NEW_LINE('A')//nspcs
386	ELSE
387	str = str//CHAR(32)
388	ENDIF
389	ENDDO
390	str = TRIM(str)
391	IF (str(LEN(str):) == ",") str=str(:LEN(str)-1)
392	END FUNCTION op_to_str
393
394	!-------------------------------
395	! DERIVED TYPE cfgparser METHODS
396	!-------------------------------
397
398	SUBROUTINE cfg_clear(parser)
399	!! Clear the cfgparser object ("destructor")
400	!!
401	!! This subroutine clears the given parser (deallocates memory).
402	OBJECT(cfgparser), INTENT(inout) :: parser !! A cfgparser object to clear
403	INTEGER :: i
404	IF (ALLOCATED(parser%options)) THEN
405	DO i = 1, SIZE(parser%options)
406	CALL op_clear(parser%options(i))
407	ENDDO
408	DEALLOCATE(parser%options)
409	ENDIF
410	END SUBROUTINE cfg_clear
411
412
413	FUNCTION cfg_check_name(name) RESULT(valid)
414	!! Check if a name is valid.
415	!!
416	!! If name contains a '/' it is assumed to be a full option name. In such case
417	!! both parts of the name are checked against section/option names requirements (see below).
418	!!
419	!! Otherwise it is assumed to be the basename of the option.
420	!!
421	!! A valid option (base) name is an alphanumeric sequence in lower-case that always begin by
422	!! a letter.
423	!!
424	!! A valid section name is and alphanumeric sequence (in any case) that always begins by
425	!! by a letter.
426	CHARACTER(len=*), INTENT(in) :: name !! A string with the name to check.
427	LOGICAL :: valid !! .true. if the name is valid, .false. otherwise
428	INTEGER :: i
429	CHARACTER(len=26), PARAMETER :: alpha = "abcdefghijklmnopqrstuvwxyz"
430	CHARACTER(len=26), PARAMETER :: ualpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
431	CHARACTER(len=12), PARAMETER :: num = "0123456789_"
432	CHARACTER(len=:), ALLOCATABLE :: pname,sname
433	TYPE(error) :: err
434	valid = .false.
435	i = INDEX(TRIM(name),"/")
436	IF (i /= 0) THEN
437	err = op_split_name(name,sname,pname)
438	IF (err /= 0) THEN
439	RETURN
440	ENDIF
441	ELSE
442	pname = to_lower(TRIM(name))
443	sname = "__default__"
444	ENDIF
445	! check option:
446	i = INDEX(pname,CHAR(32))
447	IF (i /= 0.OR.LEN_TRIM(pname) <= 0) RETURN
448	valid = (VERIFY(pname(1:1),alpha) == 0 .AND.VERIFY(TRIM(pname),alpha//num) == 0)
449	IF (.NOT.valid) RETURN
450	! check section
451	IF (sname == "__default__") THEN
452	valid = .true.
453	RETURN
454	ELSE
455	i = INDEX(sname,CHAR(32))
456	IF (i /= 0.OR.LEN_TRIM(sname) <= 0) RETURN
457	valid = (VERIFY(sname(1:1),ualpha//alpha) == 0 .AND.VERIFY(TRIM(sname),ualpha//alpha//num) == 0)
458	ENDIF
459	END FUNCTION cfg_check_name
460
461	FUNCTION cfg_count(this,section) RESULT(num)
462	!! Get the total number of option in the parser.
463	!!
464	!! If a section name is given in argument, the method returns the count for the given section only.
465	!!
466	!! To get the number of top-level options (i.e. that belongs to the default section) the keyword \_\_default\_\_
467	!! should be set for the section argument.
468	!!
469	!! If __section__ is not defined in the parser, the method returns 0.
470	!!
471	!! @internal
472	!! If no options are defined, then it implies that the internal vector of options is
473	!! not allocated.
474	OBJECT(cfgparser), INTENT(in) :: this !! A cfgparser object to search in
475	CHARACTER(len=*), INTENT(in), OPTIONAL :: section !! Optional section name to search in.
476	INTEGER :: num !! Number of current options registered in the parser.
477	INTEGER :: i
478	num = 0
479	IF(.NOT.ALLOCATED(this%options)) RETURN
480	IF (.NOT.PRESENT(section)) THEN
481	num = SIZE(this%options)
482	ELSE
483	DO i=1, SIZE(this%options)
484	IF (this%options(i)%section == section) num = num+1
485	ENDDO
486	ENDIF
487	END FUNCTION cfg_count
488
489	FUNCTION cfg_section_names(this) RESULT(list)
490	!! Get the list of user-defined section names
491	!! @note
492	!! If the parser does not have user-defined sections, the vector is still
493	!! allocated but with 0 elements.
494	OBJECT(cfgparser), INTENT(in) :: this !! A cfgparser object to process.
495	CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: list !! List of section names.
496	CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: tmp
497	INTEGER :: i,j,k,no
498	LOGICAL :: found
499	no = cfg_count(this)
500	IF (no == 0) THEN
501	ALLOCATE(list(0))
502	RETURN
503	ENDIF
504	ALLOCATE(tmp(no))
505	tmp(1) = ''
506	! get the first non-default section
507	DO i=1,no
508	IF (this%options(i)%section /= "__default__") THEN
509	tmp(1) = this%options(i)%section
510	EXIT
511	ENDIF
512	ENDDO
513	! no user defined section
514	IF (LEN_TRIM(tmp(1)) == 0) THEN
515	DEALLOCATE(tmp)
516	ALLOCATE(list(0))
517	RETURN
518	ENDIF
519	k = 1
520	DO i=1,no
521	found = .false.
522	DO j=1,k
523	! Found a match so start looking again
524	found = (tmp(j) == this%options(i)%section .OR. &
525	this%options(i)%section == "__default__")
526	IF (found) EXIT
527	ENDDO
528	IF (.NOT.found) THEN
529	k = k + 1
530	tmp(k) = this%options(i)%section
531	ENDIF
532	ENDDO
533	ALLOCATE(list(k))
534	list(1:k) = tmp(1:k)
535	DEALLOCATE(tmp)
536	END FUNCTION cfg_section_names
537
538	FUNCTION cfg_option_names(this,secname) RESULT(list)
539	!! Get the list of option names.
540	!!
541	!! @note
542	!! If the parser does not have options, the vector is still allocated but with 0 elements.
543	OBJECT(cfgparser), INTENT(in) :: this !! A cfgparser object to process.
544	CHARACTER(len=*), INTENT(in), OPTIONAL :: secname !! Optional section name to search in.
545	CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: list !! List of option names.
546	INTEGER :: j,i,no,nso
547	no = cfg_count(this)
548	IF (no == 0) THEN
549	ALLOCATE(list(no)) ; RETURN
550	ENDIF
551	IF (PRESENT(secname)) THEN
552	IF (.NOT.cfg_has_section(this,TRIM(secname))) THEN
553	ALLOCATE(list(no)) ; RETURN
554	ELSE
555	nso = 0
556	DO i=1,no ; IF (this%options(i)%section == TRIM(secname)) nso = nso + 1 ; ENDDO
557	ALLOCATE(list(nso))
558	IF (nso == 0) RETURN
559	j = 1
560	DO i=1,no
561	IF (this%options(i)%section == TRIM(secname)) THEN
562	list(j) = TRIM(this%options(i)%section)//"/"//TRIM(this%options(i)%name) ; j=j+1
563	ENDIF
564	ENDDO
565	ENDIF
566	ELSE
567	ALLOCATE(list(no))
568	DO i=1,no
569	IF (this%options(i)%section == "__default__") THEN
570	list(i) = TRIM(this%options(i)%name)
571	ELSE
572	list(i) = TRIM(this%options(i)%section)//"/"//TRIM(this%options(i)%name)
573	ENDIF
574	ENDDO
575	ENDIF
576	END FUNCTION cfg_option_names
577
578	FUNCTION cfg_has_section(this,name) RESULT(yes)
579	!! Check if parser has section by name
580	!!
581	!! @note
582	!! Keep in mind that section name in the configuration are case-sensitive.
583	OBJECT(cfgparser), INTENT(in) :: this !! cfgparser object
584	CHARACTER(len=*), INTENT(in) :: name !! Name of the section to search
585	LOGICAL :: yes !! .true. if the section exists, .false. otherwise
586	INTEGER :: i,no
587	yes = .false.
588	no = cfg_count(this)
589	IF (no == 0) RETURN
590	DO i = 1,no
591	IF (this%options(i)%section == name) THEN
592	yes = .true.
593	RETURN
594	ENDIF
595	ENDDO
596	END FUNCTION cfg_has_section
597
598	FUNCTION cfg_has_option(this,name) RESULT(yes)
599	!! Check if parser has option by name
600	OBJECT(cfgparser), INTENT(in) :: this !! A cfgparser object
601	CHARACTER(len=*), INTENT(in) :: name !! (extended) Name of the option to search
602	LOGICAL :: yes !! .true. if the option is found, .false. otherwise
603	CHARACTER(len=:), ALLOCATABLE :: pname,zname
604	INTEGER :: i,no,iscan
605	yes = .false.
606	no = cfg_count(this)
607	IF (no == 0) RETURN
608	zname = op_format(name)
609	IF (LEN_TRIM(zname) == 0) RETURN
610	DO i = 1,no
611	pname = op_full_name(this%options(i))
612	IF (pname == zname) THEN
613	yes = .true.
614	RETURN
615	ENDIF
616	ENDDO
617	END FUNCTION cfg_has_option
618
619	SUBROUTINE cfg_sort_options(this)
620	!! Sort the options in the parser (alphabetiCALLy).
621	OBJECT(cfgparser), INTENT(inout) :: this !! A cfgparser object
622	INTEGER :: no
623	no = cfg_count(this)
624	IF (no == 0) RETURN
625	CALL insertionSort(this%options)
626	END SUBROUTINE cfg_sort_options
627
628	SUBROUTINE cfg_remove_option(this,name)
629	!! Remove an option from parser by name.
630	OBJECT(cfgparser), INTENT(inout) :: this !! A cfgparser object to search in
631	CHARACTER(len=*), INTENT(in) :: name !! The name of the option to remove
632	INTEGER :: no,idx,i,j
633	TYPE(option), DIMENSION(:), ALLOCATABLE :: tmp
634	idx = cp_get_opt_idx(this,name)
635	IF (idx == -1) RETURN
636	no = cfg_count(this)
637	! only one opt
638	IF (no == 1) THEN
639	CALL op_clear(this%options(1))
640	DEALLOCATE(this%options)
641	RETURN
642	ENDIF
643	ALLOCATE(tmp(no-1))
644	j = 1
645	DO i=1,no
646	IF (i /= idx) THEN
647	tmp(j) = this%options(i)
648	j= j+1
649	ENDIF
650	CALL op_clear(this%options(i))
651	ENDDO
652	DEALLOCATE(this%options)
653	ALLOCATE(this%options(no-1))
654	DO i=1,no-1
655	this%options(i) = tmp(i)
656	CALL op_clear(tmp(i))
657	ENDDO
658	DEALLOCATE(tmp)
659	END SUBROUTINE cfg_remove_option
660
661	SUBROUTINE cfg_remove_section(this,name)
662	!! Remove a section from parser by name.
663	!!
664	!! The method removes all the options that belong to the given section name.
665	OBJECT(cfgparser), INTENT(inout) :: this
666	!! A cfgparser object to search in
667	CHARACTER(len=*), INTENT(in) :: name
668	!! The name of the section to remove
669	INTEGER :: no,i,j,icount
670	INTEGER, DIMENSION(:), ALLOCATABLE :: idxs,itmp
671	TYPE(option), DIMENSION(:), ALLOCATABLE :: tmp
672	no = cfg_count(this)
673	IF (no == 0) RETURN
674	ALLOCATE(itmp(no))
675	itmp(:) = -1
676	icount = 0
677	DO i=1,no
678	IF (TRIM(this%options(i)%section) == TRIM(name)) THEN
679	itmp(icount+1) = i
680	icount = icount + 1
681	ENDIF
682	ENDDO
683	IF (icount == 0) RETURN
684	ALLOCATE(idxs(icount))
685	idxs(:) = itmp(1:icount)
686	!DEALLOCATE(itmp)
687	! all options matches (should be rarely the case): remove all
688	IF (icount == no) THEN
689	DO i=1,no ; CALL op_clear(this%options(i)); ENDDO
690	DEALLOCATE(this%options)
691	RETURN
692	ENDIF
693	ALLOCATE(tmp(icount))
694	j = 1
695	DO i=1,no
696	IF (ANY(idxs == i)) THEN
697	tmp(j) = this%options(i)
698	j = j + 1
699	ENDIF
700	CALL op_clear(this%options(i))
701	ENDDO
702	DEALLOCATE(idxs)
703	DEALLOCATE(this%options)
704	ALLOCATE(this%options(icount))
705	DO i=1,icount
706	this%options(i) = tmp(i)
707	CALL op_clear(tmp(i))
708	ENDDO
709	DEALLOCATE(tmp)
710	END SUBROUTINE cfg_remove_section
711
712	FUNCTION cfg_read_config(parser,path,override) RESULT(err)
713	!! Read configuration file
714	!!
715	!! @note
716	!! If the library support C bindings, the method can read included files which are defined
717	!! by the __#include <...>__ directive (see [p_cfgparse](here) from more details).
718	OBJECT(cfgparser), INTENT(inout) :: parser
719	!! A cfgparser object that will store the configuration
720	CHARACTER(len=*), INTENT(in) :: path
721	!! Path of the configuration file
722	LOGICAL, INTENT(in), OPTIONAL :: override
723	!! An optional boolean flag with .true. to override previous value of duplicated options instead of raising an error.
724	TYPE(error) :: err
725	!! An error with the first error encountered
726	INTEGER :: i
727	LOGICAL :: zoverride,ok
728	TYPE(words) :: incfiles
729	CHARACTER(len=:), ALLOCATABLE :: name
730	CHARACTER(len=st_slen) :: isec
731	err = noerror
732	zoverride = .false. ; IF (PRESENT(override)) zoverride = override
733	isec = "__default__"
734	name = TRIM(path)
735	i = INDEX(name,'/',.true.) ; IF (i /= 0) name = name(i+1:)
736	IF (i == 0) THEN
737	name = fs_realpath("./"//path)
738	ELSE
739	name = fs_realpath(path)
740	ENDIF
741	CALL words_append(incfiles,name)
742	INQUIRE(FILE=TRIM(path), EXIST=ok)
743	IF (.NOT.ok) THEN
744	err = error(TRIM(path)//": no such file",-11)
745	ELSE
746	err = read_include(parser,TRIM(path),isec,incfiles,zoverride)
747	ENDIF
748	call words_clear(incfiles)
749	END FUNCTION cfg_read_config
750
751	FUNCTION cfg_write_config(this,lu,num_values) RESULT(err)
752	!> Write the content of the parser in the logical unit.
753	!!
754	!! the method expects the logical unit to be opened and does not close it
755	!! at the end of the process.
756	OBJECT(cfgparser), INTENT(inout) :: this
757	!! Parser to write.
758	INTEGER, INTENT(in) :: lu
759	!! Logical unit. It should be already opened or an error is raised.
760	INTEGER, INTENT(in), OPTIONAL :: num_values
761	!! Optional integer with the number of values to print per line for options (default to 8).
762	TYPE(error) :: err
763	!! Error status
764	CHARACTER(len=st_slen) :: sname
765	LOGICAL :: ok
766	INTEGER :: nv,no,i
767	err = noerror
768	INQUIRE(UNIT=lu,OPENED=ok)
769	IF (.NOT.ok) THEN
770	err = error("Logical unit not opened",-15)
771	RETURN
772	ENDIF
773	no = cfg_count(this)
774	IF (no == 0) THEN
775	err = error("No options to write",-7)
776	RETURN
777	ENDIF
778	! sort options.
779	CALL cfg_sort_options(this)
780	nv = 8 ; IF (PRESENT(num_values)) nv = MAX(1,num_values)
781	sname = this%options(1)%section
782	IF (sname /= "__default__") &
783	WRITE(lu,'(a)') "[ "//TRIM(sname)//" ]"
784	DO i=1,no
785	IF (this%options(i)%section /= sname) THEN
786	sname = this%options(i)%section
787	! write section first
788	WRITE(lu,*)
789	WRITE(lu,'(a)') "[ "//TRIM(sname)//" ]"
790	ENDIF
791	WRITE(lu,'(a)') op_to_str(this%options(i),nv)
792	ENDDO
793	END FUNCTION cfg_write_config
794
795	! internal (private methods)
796
797	SUBROUTINE cp_affect_sc(this,other)
798	!! cfgparser object assignment operator subroutine
799	!!
800	!! The subroutine assigns __other__ to __this__.
801	TYPE(cfgparser), INTENT(inout) :: this !! A cfgparser object to be assigned
802	TYPE(cfgparser), INTENT(in) :: other !! A cfgparser object to assign
803	INTEGER :: i,ono
804	CALL cfg_clear(this)
805	ono = cfg_count(other)
806	IF (ono == 0) RETURN
807	ALLOCATE(this%options(ono))
808	DO i=1,ono
809	this%options(i) = other%options(i)
810	ENDDO
811	RETURN
812	END SUBROUTINE cp_affect_sc
813
814	FUNCTION cp_get_opt_idx(this,name) RESULT(idx)
815	!! Get the index of an option by name in the parser.
816	!!
817	!! The method searches in the parser for the option with the given (full) __name__.
818	!! If found, it returns the index of the option in the internal vector of options. Otherwise
819	!! -1 is returned.
820	OBJECT(cfgparser), INTENT(in) :: this !! A cfgparser object
821	CHARACTER(len=*), INTENT(in) :: name !! A string with the name of the option
822	INTEGER :: idx !! Index of the option (-1 if not found).
823	CHARACTER(len=:), ALLOCATABLE :: zname,pname
824	INTEGER :: no,i
825	idx = -1
826	no = cfg_count(this)
827	IF (no == 0) RETURN
828	zname = op_format(name) ! prepare the name to search.
829	IF (LEN_TRIM(zname) == 0) RETURN
830	DO i=1,no
831	pname = op_full_name(this%options(i))
832	IF (pname == zname) THEN
833	idx = i
834	RETURN
835	ENDIF
836	ENDDO
837	END FUNCTION cp_get_opt_idx
838
839	FUNCTION cp_update_opt(this,sname,pname,values) RESULT(err)
840	!! Update an option in the parser.
841	!!
842	!! The method attempts to update the option in the parser.
843	!!
844	!! If __sname__ is set to empty string, the method searches for the option
845	!! in the default section.
846	!!
847	!! If no option is found, The the option is appended in the parser. Otherwise it is updated
848	!! with the content of __values__.
849	!!
850	!! If the option name is not valid, the method does nothing and -9 error status is returned.
851	!!
852	!! @internal
853	!! The method performs the same kind of operations than the setters except that it
854	!! expects raw data ([[string_op(module):words(type)]]).
855	OBJECT(cfgparser), INTENT(inout) :: this !! cfgparser object to process.
856	CHARACTER(len=*), INTENT(in) :: sname !! Name of the section.
857	CHARACTER(len=*), INTENT(in) :: pname !! Basename of the option.
858	TYPE(words), INTENT(in) :: values !! Raw values.
859	TYPE(error) :: err !! Error status.
860	CHARACTER(len=:), ALLOCATABLE :: zsname,fname
861	INTEGER :: i
862	err = noerror
863	zsname = TRIM(sname)
864	IF (LEN_TRIM(sname) == 0) zsname = "__default__"
865	fname = zsname//"/"//to_lower(TRIM(pname))
866	IF (.NOT.cfg_check_name(fname)) THEN
867	err = error("Invalid option (no name)",-9)
868	RETURN
869	ENDIF
870	i = cp_get_opt_idx(this,fname)
871	IF (i /= -1) THEN
872	CALL words_clear(this%options(i)%values)
873	this%options(i)%values = values
874	ELSE
875	err = cp_add_opt(this,zsname,pname,values)
876	ENDIF
877	END FUNCTION cp_update_opt
878
879	FUNCTION cp_add_opt(this,sname,pname,values) RESULT(err)
880	!! Add an option to the parser.
881	!!
882	!! In order to add an option to the default section, _sname_ should be left empty or set to "\_\_default\_\_".
883	!!
884	!! The following error code can be returned:
885	!! - 0, no error.
886	!! - -8, the option already exists.
887	!! - -9, option name is not valid.
888	OBJECT(cfgparser), INTENT(inout) :: this
889	!! A cfgparser object to process.
890	CHARACTER(len=*), INTENT(in) :: sname
891	!! Section name.
892	CHARACTER(len=*), INTENT(in) :: pname
893	!! Option basename.
894	TYPE(words), INTENT(in) :: values
895	!! Values to set.
896	TYPE(error) :: err
897	!! Return error status.
898	CHARACTER(len=:), ALLOCATABLE :: zsname,fname
899	TYPE(option), DIMENSION(:), ALLOCATABLE :: tmp
900	INTEGER :: no,i
901	TYPE(option) :: sca
902
903	err = noerror
904	zsname = sname
905	no = cfg_count(this)
906	IF (LEN_TRIM(zsname) == 0) zsname = "__default__"
907	fname = TRIM(zsname)//"/"//to_lower(TRIM(pname))
908	! check name
909	IF (.NOT.cfg_check_name(fname)) THEN
910	err = error("Invalid option name '"//fname//"'",-9)
911	RETURN
912	ENDIF
913	! check if opt exists in the parser
914	IF (no > 0) THEN
915	IF (cp_get_opt_idx(this,fname) /= -1) THEN
916	err = error("Duplicate option '"//TRIM(pname)//"' in "//TRIM(zsname),-8)
917	RETURN
918	ENDIF
919	ENDIF
920
921	! build option
922	CALL op_clear(sca)
923	sca%name = to_lower(TRIM(pname))
924	sca%section = zsname
925	sca%values = values
926
927	IF (no == 0) THEN
928	! no options yet -> allocate
929	ALLOCATE(this%options(1))
930	ELSE
931	! parser has options: increase this%options size (ugly copy).
932	ALLOCATE(tmp(no))
933	DO i =1,no
934	tmp(i) = this%options(i)
935	CALL op_clear(this%options(i))
936	ENDDO
937	DEALLOCATE(this%options)
938	ALLOCATE(this%options(no+1))
939	DO i =1,no
940	this%options(i) = tmp(i)
941	CALL op_clear(tmp(i))
942	ENDDO
943	DEALLOCATE(tmp)
944	ENDIF
945	! always add the option at the end.
946	this%options(no+1) = sca
947	CALL op_clear(sca)
948	END FUNCTION cp_add_opt
949
950	FUNCTION cp_get_rv_sc(this,name,output) RESULT(err)
951	!! Get the first value of an option in the parser by name (real/scalar)
952	!!
953	!! The following error status can be returned by the method:
954	!! - -7, no option matches the given name.
955	!! - -6, the option does not have value(s).
956	!! - -10, the value cannot be converted in the output type.
957	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
958	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
959	REAL(kind=4), INTENT(out) :: output !! Output value
960	TYPE(error) :: err
961	!! Error status
962	INTEGER :: idx
963	CHARACTER(len=:), ALLOCATABLE :: tmp
964	err = noerror
965	idx = cp_get_opt_idx(this,name)
966	IF (idx == -1) THEN
967	err = error("Option "//TRIM(name)//" does not exist",-7)
968	RETURN
969	ENDIF
970	IF (words_length(this%options(idx)%values)== 0) THEN
971	err = error("Option "//TRIM(name)//" has no value",-6)
972	ELSE
973	tmp = TRIM(ADJUSTL(words_get(this%options(idx)%values,1)))
974	IF (LEN(tmp) == 0) THEN
975	err = error("Option "//TRIM(name)//" has no value",-6)
976	ELSE
977	IF(.NOT.from_string(tmp,output)) &
978	err = error(TRIM(name)//": Cannot convert "//tmp//" to real.",-10)
979	ENDIF
980	ENDIF
981	END FUNCTION cp_get_rv_sc
982
983	FUNCTION cp_get_dv_sc(this,name,output) RESULT(err)
984	!! Get the first value of an option in the parser by name (double/scalar)
985	!!
986	!! The following error status can be returned by the method:
987	!! - -7, no option matches the given name.
988	!! - -6, the option does not have value(s).
989	!! - -10, the value cannot be converted in the output type.
990	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
991	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
992	REAL(kind=8), INTENT(out) :: output !! Output value
993	TYPE(error) :: err
994	!! Error status
995	INTEGER :: idx
996	CHARACTER(len=:), ALLOCATABLE :: tmp
997	err = noerror
998	idx = cp_get_opt_idx(this,name)
999	IF (idx == -1) THEN
1000	err = error("Option "//TRIM(name)//" does not exist",-7)
1001	RETURN
1002	ENDIF
1003	IF (words_length(this%options(idx)%values)== 0) THEN
1004	err = error("Option "//TRIM(name)//" has no value",-6)
1005	ELSE
1006	tmp = TRIM(ADJUSTL(words_get(this%options(idx)%values,1)))
1007	IF (LEN(tmp) == 0) THEN
1008	err = error("Option "//TRIM(name)//" has no value",-6)
1009	ELSE
1010	IF(.NOT.from_string(tmp,output)) &
1011	err = error(TRIM(name)//": Cannot convert "//tmp//" to double.",-10)
1012	ENDIF
1013	ENDIF
1014	END FUNCTION cp_get_dv_sc
1015
1016	FUNCTION cp_get_iv_sc(this,name,output) RESULT(err)
1017	!! Get the first value of an option in the parser by name (integer/scalar)
1018	!!
1019	!! The following error status can be returned by the method:
1020	!! - -7, no option matches the given name.
1021	!! - -6, the option does not have value(s).
1022	!! - -10, the value cannot be converted in the output type.
1023	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
1024	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1025	INTEGER, INTENT(out) :: output !! Output value
1026	TYPE(error) :: err
1027	!! Error status
1028	INTEGER :: idx
1029	CHARACTER(len=:), ALLOCATABLE :: tmp
1030	err = noerror
1031	idx = cp_get_opt_idx(this,name)
1032	IF (idx == -1) THEN
1033	err = error("Option "//TRIM(name)//" does not exist",-7)
1034	RETURN
1035	ENDIF
1036	IF (words_length(this%options(idx)%values)== 0) THEN
1037	err = error("Option "//TRIM(name)//" has no value",-6)
1038	ELSE
1039	tmp = TRIM(ADJUSTL(words_get(this%options(idx)%values,1)))
1040	IF (LEN(tmp) == 0) THEN
1041	err = error("Option "//TRIM(name)//" has no value",-6)
1042	ELSE
1043	IF(.NOT.from_string(tmp,output)) &
1044	err = error(TRIM(name)//": Cannot convert "//tmp//" to integer.",-10)
1045	ENDIF
1046	ENDIF
1047	END FUNCTION cp_get_iv_sc
1048
1049	FUNCTION cp_get_lv_sc(this,name,output) RESULT(err)
1050	!! Get the first value of an option in the parser by name (logical/scalar)
1051	!!
1052	!! The following error status can be returned by the method:
1053	!! - -7, no option matches the given name.
1054	!! - -6, the option does not have value(s).
1055	!! - -10, the value cannot be converted in the output type.
1056	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
1057	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1058	LOGICAL, INTENT(out) :: output !! Output value
1059	TYPE(error) :: err
1060	!! Error status
1061	INTEGER :: idx
1062	CHARACTER(len=:), ALLOCATABLE :: tmp
1063	err = noerror
1064	idx = cp_get_opt_idx(this,name)
1065	IF (idx == -1) THEN
1066	err = error("Option "//TRIM(name)//" does not exist",-7)
1067	RETURN
1068	ENDIF
1069	IF (words_length(this%options(idx)%values)== 0) THEN
1070	err = error("Option "//TRIM(name)//" has no value",-6)
1071	ELSE
1072	tmp = TRIM(ADJUSTL(words_get(this%options(idx)%values,1)))
1073	IF (LEN(tmp) == 0) THEN
1074	err = error("Option "//TRIM(name)//" has no value",-6)
1075	ELSE
1076	IF(.NOT.from_string(tmp,output)) &
1077	err = error(TRIM(name)//": Cannot convert "//tmp//" to logical.",-10)
1078	ENDIF
1079	ENDIF
1080	END FUNCTION cp_get_lv_sc
1081
1082	FUNCTION cp_get_cv_sc(this,name,output) RESULT(err)
1083	!! Get the first value of an option in the parser by name (complex/scalar)
1084	!!
1085	!! The following error status can be returned by the method:
1086	!! - -7, no option matches the given name.
1087	!! - -6, the option does not have value(s).
1088	!! - -10, the value cannot be converted in the output type.
1089	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
1090	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1091	COMPLEX, INTENT(out) :: output !! Output value
1092	TYPE(error) :: err
1093	!! Error status
1094	INTEGER :: idx
1095	CHARACTER(len=:), ALLOCATABLE :: tmp
1096	err = noerror
1097	idx = cp_get_opt_idx(this,name)
1098	IF (idx == -1) THEN
1099	err = error("Option "//TRIM(name)//" does not exist",-7)
1100	RETURN
1101	ENDIF
1102	IF (words_length(this%options(idx)%values)== 0) THEN
1103	err = error("Option "//TRIM(name)//" has no value",-6)
1104	ELSE
1105	tmp = TRIM(ADJUSTL(words_get(this%options(idx)%values,1)))
1106	IF (LEN(tmp) == 0) THEN
1107	err = error("Option "//TRIM(name)//" has no value",-6)
1108	ELSE
1109	IF(.NOT.from_string(tmp,output)) &
1110	err = error(TRIM(name)//": Cannot convert "//tmp//" to complex.",-10)
1111	ENDIF
1112	ENDIF
1113	END FUNCTION cp_get_cv_sc
1114
1115	FUNCTION cp_get_sv_sc(this,name,output) RESULT(err)
1116	!! Get the first value of an option in the parser by name (string/scalar)
1117	!!
1118	!! The following error status can be returned by the method:
1119	!! - -7, no option matches the given name.
1120	!! - -6, the option does not have value(s).
1121	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
1122	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1123	CHARACTER(len=*), INTENT(out) :: output !! Output value
1124	TYPE(error) :: err
1125	!! Error status
1126	INTEGER :: idx
1127	!CHARACTER(len=:), ALLOCATABLE :: tmp
1128	err = noerror
1129	idx = cp_get_opt_idx(this,name)
1130	IF (idx == -1) THEN
1131	err = error("Option "//TRIM(name)//" does not exist",-7)
1132	RETURN
1133	ENDIF
1134	IF (words_length(this%options(idx)%values)== 0) THEN
1135	err = error("Option "//TRIM(name)//" has no value",-6)
1136	ELSE
1137	output = TRIM(ADJUSTL(words_get(this%options(idx)%values,1)))
1138	err = noerror
1139	ENDIF
1140	END FUNCTION cp_get_sv_sc
1141
1142	FUNCTION cp_get_rv_ve(this,name,output) RESULT(err)
1143	!! Get the value(s) of an option in the parser by name (real/vector)
1144	!!
1145	!! On error, the output vector is not allocated.
1146	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
1147	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1148	REAL(kind=4), INTENT(out), DIMENSION(:), ALLOCATABLE :: output !! Output values
1149	TYPE(error) :: err
1150	!! Error status of the method (see [[cfgparser(type):get_value(bound)]] documentation)
1151	CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: tmp
1152	LOGICAL :: ok
1153	INTEGER :: i,idx
1154	CHARACTER(len=15) :: i2s
1155	err = noerror
1156	idx = cp_get_opt_idx(this,name)
1157	IF (idx == -1) THEN
1158	err = error("Option "//TRIM(name)//" does not exist",-7)
1159	RETURN
1160	ENDIF
1161	IF (words_length(this%options(idx)%values) == 0) THEN
1162	err = error("Option "//TRIM(name)//" has no value",-6)
1163	ELSE
1164	ALLOCATE(output(words_length(this%options(idx)%values)))
1165	ok = words_to_vector(this%options(idx)%values,tmp)
1166	DO i=1, SIZE(tmp)
1167	WRITE(i2s,'(I15)') i ; i2s=ADJUSTL(i2s)
1168	IF (LEN_TRIM(ADJUSTL(tmp(i))) == 0) THEN
1169	err = error("Cannot get value #"//TRIM(i2s)//" from option "//TRIM(name),-6)
1170	DEALLOCATE(output) ; EXIT
1171	ELSE IF (.NOT.from_string(tmp(i), output(i))) THEN
1172	err = error("Cannot convert value #"//TRIM(i2s)//" from option "//TRIM(name),-10)
1173	DEALLOCATE(output) ; EXIT
1174	ENDIF
1175	ENDDO
1176	ENDIF
1177	DEALLOCATE(tmp)
1178	RETURN
1179	END FUNCTION cp_get_rv_ve
1180
1181	FUNCTION cp_get_dv_ve(this,name,output) RESULT(err)
1182	!! Get the value(s) of an option in the parser by name (double/vector)
1183	!!
1184	!! On error, the output vector is not allocated.
1185	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
1186	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1187	REAL(kind=8), INTENT(out), DIMENSION(:), ALLOCATABLE :: output !! Output values
1188	TYPE(error) :: err
1189	!! Error status of the method (see [[cfgparser(type):get_value(bound)]] documentation)
1190	CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: tmp
1191	LOGICAL :: ok
1192	INTEGER :: i,idx
1193	CHARACTER(len=15) :: i2s
1194	err = noerror
1195	idx = cp_get_opt_idx(this,name)
1196	IF (idx == -1) THEN
1197	err = error("Option "//TRIM(name)//" does not exist",-7)
1198	RETURN
1199	ENDIF
1200	IF (words_length(this%options(idx)%values) == 0) THEN
1201	err = error("Option "//TRIM(name)//" has no value",-6)
1202	ELSE
1203	ALLOCATE(output(words_length(this%options(idx)%values)))
1204	ok = words_to_vector(this%options(idx)%values,tmp)
1205	DO i=1, SIZE(tmp)
1206	WRITE(i2s,'(I15)') i ; i2s=ADJUSTL(i2s)
1207	IF (LEN_TRIM(ADJUSTL(tmp(i))) == 0) THEN
1208	err = error("Cannot get value #"//TRIM(i2s)//" from option "//TRIM(name),-6)
1209	DEALLOCATE(output) ; EXIT
1210	ELSE IF (.NOT.from_string(tmp(i), output(i))) THEN
1211	err = error("Cannot convert value #"//TRIM(i2s)//" from option "//TRIM(name),-10)
1212	DEALLOCATE(output) ; EXIT
1213	ENDIF
1214	ENDDO
1215	ENDIF
1216	DEALLOCATE(tmp)
1217	RETURN
1218	END FUNCTION cp_get_dv_ve
1219
1220	FUNCTION cp_get_iv_ve(this,name,output) RESULT(err)
1221	!! Get the value(s) of an option in the parser by name (integer/vector)
1222	!!
1223	!! On error, the output vector is not allocated.
1224	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
1225	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1226	INTEGER, INTENT(out), DIMENSION(:), ALLOCATABLE :: output !! Output values
1227	TYPE(error) :: err
1228	!! Error status of the method (see [[cfgparser(type):get_value(bound)]] documentation)
1229	CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: tmp
1230	LOGICAL :: ok
1231	INTEGER :: i,idx
1232	CHARACTER(len=15) :: i2s
1233	err = noerror
1234	idx = cp_get_opt_idx(this,name)
1235	IF (idx == -1) THEN
1236	err = error("Option "//TRIM(name)//" does not exist",-7)
1237	RETURN
1238	ENDIF
1239	IF (words_length(this%options(idx)%values) == 0) THEN
1240	err = error("Option "//TRIM(name)//" has no value",-6)
1241	ELSE
1242	ALLOCATE(output(words_length(this%options(idx)%values)))
1243	ok = words_to_vector(this%options(idx)%values,tmp)
1244	DO i=1, SIZE(tmp)
1245	WRITE(i2s,'(I15)') i ; i2s=ADJUSTL(i2s)
1246	IF (LEN_TRIM(ADJUSTL(tmp(i))) == 0) THEN
1247	err = error("Cannot get value #"//TRIM(i2s)//" from option "//TRIM(name),-6)
1248	DEALLOCATE(output) ; EXIT
1249	ELSE IF (.NOT.from_string(tmp(i), output(i))) THEN
1250	err = error("Cannot convert value #"//TRIM(i2s)//" from option "//TRIM(name),-10)
1251	DEALLOCATE(output) ; EXIT
1252	ENDIF
1253	ENDDO
1254	ENDIF
1255	DEALLOCATE(tmp)
1256	RETURN
1257	END FUNCTION cp_get_iv_ve
1258
1259	FUNCTION cp_get_lv_ve(this,name,output) RESULT(err)
1260	!! Get the value(s) of an option in the parser by name (logical/vector)
1261	!!
1262	!! On error, the output vector is not allocated.
1263	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
1264	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1265	LOGICAL, INTENT(out), DIMENSION(:), ALLOCATABLE :: output !! Output values
1266	TYPE(error) :: err
1267	!! Error status of the method (see [[cfgparser(type):get_value(bound)]] documentation)
1268	CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: tmp
1269	LOGICAL :: ok
1270	INTEGER :: i,idx
1271	CHARACTER(len=15) :: i2s
1272	err = noerror
1273	idx = cp_get_opt_idx(this,name)
1274	IF (idx == -1) THEN
1275	err = error("Option "//TRIM(name)//" does not exist",-7)
1276	RETURN
1277	ENDIF
1278	IF (words_length(this%options(idx)%values) == 0) THEN
1279	err = error("Option "//TRIM(name)//" has no value",-6)
1280	ELSE
1281	ALLOCATE(output(words_length(this%options(idx)%values)))
1282	ok = words_to_vector(this%options(idx)%values,tmp)
1283	DO i=1, SIZE(tmp)
1284	WRITE(i2s,'(I15)') i ; i2s=ADJUSTL(i2s)
1285	IF (LEN_TRIM(ADJUSTL(tmp(i))) == 0) THEN
1286	err = error("Cannot get value #"//TRIM(i2s)//" from option "//TRIM(name),-6)
1287	DEALLOCATE(output) ; EXIT
1288	ELSE IF (.NOT.from_string(tmp(i), output(i))) THEN
1289	err = error("Cannot convert value #"//TRIM(i2s)//" from option "//TRIM(name),-10)
1290	DEALLOCATE(output) ; EXIT
1291	ENDIF
1292	ENDDO
1293	ENDIF
1294	DEALLOCATE(tmp)
1295	RETURN
1296	END FUNCTION cp_get_lv_ve
1297
1298	FUNCTION cp_get_cv_ve(this,name,output) RESULT(err)
1299	!! Get the value(s) of an option in the parser by name (complex/vector)
1300	!!
1301	!! On error, the output vector is not allocated.
1302	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
1303	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1304	COMPLEX, INTENT(out), DIMENSION(:), ALLOCATABLE :: output !! Output values
1305	TYPE(error) :: err
1306	!! Error status of the method (see [[cfgparser(type):get_value(bound)]] documentation)
1307	CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: tmp
1308	LOGICAL :: ok
1309	INTEGER :: i,idx
1310	CHARACTER(len=15) :: i2s
1311	err = noerror
1312	idx = cp_get_opt_idx(this,name)
1313	IF (idx == -1) THEN
1314	err = error("Option "//TRIM(name)//" does not exist",-7)
1315	RETURN
1316	ENDIF
1317	IF (words_length(this%options(idx)%values) == 0) THEN
1318	err = error("Option "//TRIM(name)//" has no value",-6)
1319	ELSE
1320	ALLOCATE(output(words_length(this%options(idx)%values)))
1321	ok = words_to_vector(this%options(idx)%values,tmp)
1322	DO i=1, SIZE(tmp)
1323	WRITE(i2s,'(I15)') i ; i2s=ADJUSTL(i2s)
1324	IF (LEN_TRIM(ADJUSTL(tmp(i))) == 0) THEN
1325	err = error("Cannot get value #"//TRIM(i2s)//" from option "//TRIM(name),-6)
1326	DEALLOCATE(output) ; EXIT
1327	ELSE IF (.NOT.from_string(tmp(i), output(i))) THEN
1328	err = error("Cannot convert value #"//TRIM(i2s)//" from option "//TRIM(name),-10)
1329	DEALLOCATE(output) ; EXIT
1330	ENDIF
1331	ENDDO
1332	ENDIF
1333	DEALLOCATE(tmp)
1334	RETURN
1335	END FUNCTION cp_get_cv_ve
1336
1337	FUNCTION cp_get_sv_ve(this,name,output) RESULT(err)
1338	!! Get the value(s) of an option in the parser by name (string/vector)
1339	!!
1340	!! On error, the output vector is not allocated.
1341	OBJECT(cfgparser), INTENT(in) :: this !! Cfgparser object
1342	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1343	CHARACTER(len=*), INTENT(out), DIMENSION(:), ALLOCATABLE :: output !! Output values
1344	TYPE(error) :: err !! Error status of the method (see [[cfgparser(type):get_value(bound)]] documentation)
1345	LOGICAL :: ok
1346	INTEGER :: idx
1347	err = noerror
1348	idx = cp_get_opt_idx(this,name)
1349	IF (idx == -1) THEN
1350	err = error("Option "//TRIM(name)//" does not exist",-7)
1351	RETURN
1352	ENDIF
1353	IF (words_length(this%options(idx)%values) == 0) THEN
1354	err = error("Option "//TRIM(name)//" has no value",-6)
1355	ELSE
1356	ok = words_to_vector(this%options(idx)%values,output)
1357	ENDIF
1358	RETURN
1359	END FUNCTION cp_get_sv_ve
1360
1361	FUNCTION cp_set_rv_sc(this,name,input,create) RESULT(err)
1362	!! Set new value for the given option by name (real/scalar)
1363	!!
1364	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1365	!! the parser.
1366	!! In such case, an error ((-9, invalid name)) is raised if the option name is not valid.
1367	!!
1368	!! In other case, if the option is not defined in the parser the error status is set to -7.
1369	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1370	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to set
1371	REAL(kind=4), INTENT(in) :: input !! Input value
1372	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false).
1373	TYPE(error) :: err !! Error status
1374	LOGICAL :: zcreate
1375	INTEGER :: idx
1376	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1377	TYPE(words) :: values
1378	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1379	err = noerror
1380	idx = cp_get_opt_idx(this,name)
1381	CALL words_append(values,to_string(input))
1382	IF (idx == -1) THEN
1383	IF (zcreate) THEN
1384	err = op_split_name(name,sname,pname)
1385	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1386	ELSE
1387	err = error("Option "//TRIM(name)//" does not exist",-7)
1388	ENDIF
1389	ELSE
1390	this%options(idx)%values = values
1391	ENDIF
1392	CALL words_clear(values)
1393	END FUNCTION cp_set_rv_sc
1394
1395	FUNCTION cp_set_dv_sc(this,name,input,create) RESULT(err)
1396	!! Set new value for the given option by name (double/scalar)
1397	!!
1398	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1399	!! the parser.
1400	!! In such case, an error ((-9, invalid name)) is raised if the option name is not valid.
1401	!!
1402	!! In other case, if the option is not defined in the parser the error status is set to -7.
1403	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1404	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to set
1405	REAL(kind=8), INTENT(in) :: input !! Input value
1406	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false).
1407	TYPE(error) :: err !! Error status
1408	LOGICAL :: zcreate
1409	INTEGER :: idx
1410	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1411	TYPE(words) :: values
1412	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1413	err = noerror
1414	idx = cp_get_opt_idx(this,name)
1415	CALL words_append(values,to_string(input))
1416	IF (idx == -1) THEN
1417	IF (zcreate) THEN
1418	err = op_split_name(name,sname,pname)
1419	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1420	ELSE
1421	err = error("Option "//TRIM(name)//" does not exist",-7)
1422	ENDIF
1423	ELSE
1424	this%options(idx)%values = values
1425	ENDIF
1426	CALL words_clear(values)
1427	END FUNCTION cp_set_dv_sc
1428
1429	FUNCTION cp_set_iv_sc(this,name,input,create) RESULT(err)
1430	!! Set new value for the given option by name (double/scalar)
1431	!!
1432	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1433	!! the parser.
1434	!! In such case, an error ((-9, invalid name)) is raised if the option name is not valid.
1435	!!
1436	!! In other case, if the option is not defined in the parser the error status is set to -7.
1437	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1438	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to set
1439	INTEGER, INTENT(in) :: input !! Input value
1440	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false).
1441	TYPE(error) :: err !! Error status
1442	LOGICAL :: zcreate
1443	INTEGER :: idx
1444	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1445	TYPE(words) :: values
1446	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1447	err = noerror
1448	idx = cp_get_opt_idx(this,name)
1449	CALL words_append(values,to_string(input))
1450	IF (idx == -1) THEN
1451	IF (zcreate) THEN
1452	err = op_split_name(name,sname,pname)
1453	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1454	ELSE
1455	err = error("Option "//TRIM(name)//" does not exist",-7)
1456	ENDIF
1457	ELSE
1458	this%options(idx)%values = values
1459	ENDIF
1460	CALL words_clear(values)
1461	END FUNCTION cp_set_iv_sc
1462
1463	FUNCTION cp_set_lv_sc(this,name,input,create) RESULT(err)
1464	!! Set new value for the given option by name (logical/scalar)
1465	!!
1466	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1467	!! the parser.
1468	!! In such case, an error ((-9, invalid name)) is raised if the option name is not valid.
1469	!!
1470	!! In other case, if the option is not defined in the parser the error status is set to -7.
1471	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1472	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to set
1473	LOGICAL, INTENT(in) :: input !! Input value
1474	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false).
1475	TYPE(error) :: err !! Error status
1476	LOGICAL :: zcreate
1477	INTEGER :: idx
1478	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1479	TYPE(words) :: values
1480	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1481	err = noerror
1482	idx = cp_get_opt_idx(this,name)
1483	CALL words_append(values,to_string(input))
1484	IF (idx == -1) THEN
1485	IF (zcreate) THEN
1486	err = op_split_name(name,sname,pname)
1487	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1488	ELSE
1489	err = error("Option "//TRIM(name)//" does not exist",-7)
1490	ENDIF
1491	ELSE
1492	this%options(idx)%values = values
1493	ENDIF
1494	CALL words_clear(values)
1495	END FUNCTION cp_set_lv_sc
1496
1497	FUNCTION cp_set_cv_sc(this,name,input,create) RESULT(err)
1498	!! Set new value for the given option by name (complex/scalar)
1499	!!
1500	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1501	!! the parser.
1502	!! In such case, an error ((-9, invalid name)) is raised if the option name is not valid.
1503	!!
1504	!! In other case, if the option is not defined in the parser the error status is set to -7.
1505	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1506	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to set
1507	COMPLEX, INTENT(in) :: input !! Input value
1508	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false).
1509	TYPE(error) :: err !! Error status
1510	LOGICAL :: zcreate
1511	INTEGER :: idx
1512	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1513	TYPE(words) :: values
1514	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1515	err = noerror
1516	idx = cp_get_opt_idx(this,name)
1517	CALL words_append(values,to_string(input))
1518	IF (idx == -1) THEN
1519	IF (zcreate) THEN
1520	err = op_split_name(name,sname,pname)
1521	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1522	ELSE
1523	err = error("Option "//TRIM(name)//" does not exist",-7)
1524	ENDIF
1525	ELSE
1526	this%options(idx)%values = values
1527	ENDIF
1528	CALL words_clear(values)
1529	END FUNCTION cp_set_cv_sc
1530
1531	FUNCTION cp_set_sv_sc(this,name,input,create) RESULT(err)
1532	!! Set new value for the given option by name (string/scalar)
1533	!!
1534	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1535	!! the parser.
1536	!! In such case, an error ((-9, invalid name)) is raised if the option name is not valid.
1537	!!
1538	!! In other case, if the option is not defined in the parser the error status is set to -7.
1539	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1540	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to set
1541	CHARACTER(len=*), INTENT(in) :: input !! Input value
1542	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false).
1543	TYPE(error) :: err !! Error status
1544	LOGICAL :: zcreate
1545	INTEGER :: idx
1546	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1547	TYPE(words) :: values
1548	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1549	err = noerror
1550	idx = cp_get_opt_idx(this,name)
1551	CALL words_append(values,input)
1552	IF (idx == -1) THEN
1553	IF (zcreate) THEN
1554	err = op_split_name(name,sname,pname)
1555	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1556	ELSE
1557	err = error("Option "//TRIM(name)//" does not exist",-7)
1558	ENDIF
1559	ELSE
1560	this%options(idx)%values = values
1561	ENDIF
1562	CALL words_clear(values)
1563	END FUNCTION cp_set_sv_sc
1564
1565	FUNCTION cp_set_rv_ve(this,name,input,create) RESULT(err)
1566	!! Set new value for the given option by name (real/vector)
1567	!!
1568	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1569	!! the parser.
1570	!! In such case, an error ((-9, invalid name)) is raised if the option name is not valid.
1571	!!
1572	!! In other case, if the option is not defined in the parser the error status is set to -7.
1573	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1574	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1575	REAL(kind=4), INTENT(in), DIMENSION(:) :: input !! Input values
1576	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false)
1577	TYPE(error) :: err !! Error status
1578	LOGICAL :: zcreate
1579	INTEGER :: i,idx
1580	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1581	TYPE(words) :: values
1582	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1583	err = noerror
1584	idx = cp_get_opt_idx(this,name)
1585	DO i=1,SIZE(input) ; CALL words_append(values,to_string(input(i))); ENDDO
1586	IF (idx == -1) THEN
1587	IF (zcreate) THEN
1588	err = op_split_name(name,sname,pname)
1589	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1590	ELSE
1591	err = error("Option "//TRIM(name)//" does not exist",-7)
1592	ENDIF
1593	ELSE
1594	this%options(idx)%values = values
1595	ENDIF
1596	CALL words_clear(values)
1597	END FUNCTION cp_set_rv_ve
1598
1599	FUNCTION cp_set_dv_ve(this,name,input,create) RESULT(err)
1600	!! Set new value for the given option by name (double/vector))
1601	!!
1602	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1603	!! the parser.
1604	!! In such case, an error ((-9, invalid name)) is raised if the option name is not valid.
1605	!!
1606	!! In other case, if the option is not defined in the parser the error status is set to -7.
1607	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1608	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1609	REAL(kind=8), INTENT(in), DIMENSION(:) :: input !! Input values
1610	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false)
1611	TYPE(error) :: err !! Error status
1612	LOGICAL :: zcreate
1613	INTEGER :: i,idx
1614	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1615	TYPE(words) :: values
1616	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1617	err = noerror
1618	idx = cp_get_opt_idx(this,name)
1619	DO i=1,SIZE(input) ; CALL words_append(values,to_string(input(i))); ENDDO
1620	IF (idx == -1) THEN
1621	IF (zcreate) THEN
1622	err = op_split_name(name,sname,pname)
1623	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1624	ELSE
1625	err = error("Option "//TRIM(name)//" does not exist",-7)
1626	ENDIF
1627	ELSE
1628	this%options(idx)%values = values
1629	ENDIF
1630	CALL words_clear(values)
1631	END FUNCTION cp_set_dv_ve
1632
1633	FUNCTION cp_set_iv_ve(this,name,input,create) RESULT(err)
1634	!! Set new value for the given option by name (integer/vector)
1635	!!
1636	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1637	!! the parser.
1638	!! In such case, an error ((-9, invalid name)) is raised if the option name is not valid.
1639	!!
1640	!! In other case, if the option is not defined in the parser the error status is set to -7.
1641	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1642	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1643	INTEGER, INTENT(in), DIMENSION(:) :: input !! Input values
1644	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false)
1645	TYPE(error) :: err !! Error status
1646	LOGICAL :: zcreate
1647	INTEGER :: i,idx
1648	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1649	TYPE(words) :: values
1650	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1651	err = noerror
1652	idx = cp_get_opt_idx(this,name)
1653	DO i=1,SIZE(input) ; CALL words_append(values,to_string(input(i))); ENDDO
1654	IF (idx == -1) THEN
1655	IF (zcreate) THEN
1656	err = op_split_name(name,sname,pname)
1657	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1658	ELSE
1659	err = error("Option "//TRIM(name)//" does not exist",-7)
1660	ENDIF
1661	ELSE
1662	this%options(idx)%values = values
1663	ENDIF
1664	CALL words_clear(values)
1665	END FUNCTION cp_set_iv_ve
1666
1667	FUNCTION cp_set_lv_ve(this,name,input,create) RESULT(err)
1668	!! Set new value for the given option by name (logical/vector)
1669	!!
1670	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1671	!! the parser.
1672	!! In such case, an error ((-9, invalid name)) is raised if the option name is not valid.
1673	!!
1674	!! In other case, if the option is not defined in the parser the error status is set to -7.
1675	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1676	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1677	LOGICAL, INTENT(in), DIMENSION(:) :: input !! Input values
1678	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false)
1679	TYPE(error) :: err !! Error status
1680	LOGICAL :: zcreate
1681	INTEGER :: i,idx
1682	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1683	TYPE(words) :: values
1684	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1685	err = noerror
1686	idx = cp_get_opt_idx(this,name)
1687	DO i=1,SIZE(input) ; CALL words_append(values,to_string(input(i))); ENDDO
1688	IF (idx == -1) THEN
1689	IF (zcreate) THEN
1690	err = op_split_name(name,sname,pname)
1691	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1692	ELSE
1693	err = error("Option "//TRIM(name)//" does not exist",-7)
1694	ENDIF
1695	ELSE
1696	this%options(idx)%values = values
1697	ENDIF
1698	CALL words_clear(values)
1699	END FUNCTION cp_set_lv_ve
1700
1701	FUNCTION cp_set_cv_ve(this,name,input,create) RESULT(err)
1702	!! Set new value for the given option by name (complex/vector)
1703	!!
1704	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1705	!! the parser.
1706	!! In such case, an error ((-9, invalid name)) is raised if the option name is not valid.
1707	!!
1708	!! In other case, if the option is not defined in the parser the error status is set to -7.
1709	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1710	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1711	COMPLEX, INTENT(in), DIMENSION(:) :: input !! Input values
1712	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false)
1713	TYPE(error) :: err !! Error status
1714	LOGICAL :: zcreate
1715	INTEGER :: i,idx
1716	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1717	TYPE(words) :: values
1718	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1719	err = noerror
1720	idx = cp_get_opt_idx(this,name)
1721	DO i=1,SIZE(input) ; CALL words_append(values,to_string(input(i))); ENDDO
1722	IF (idx == -1) THEN
1723	IF (zcreate) THEN
1724	err = op_split_name(name,sname,pname)
1725	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1726	ELSE
1727	err = error("Option "//TRIM(name)//" does not exist",-7)
1728	ENDIF
1729	ELSE
1730	this%options(idx)%values = values
1731	ENDIF
1732	CALL words_clear(values)
1733	END FUNCTION cp_set_cv_ve
1734
1735	FUNCTION cp_set_sv_ve(this,name,input,create) RESULT(err)
1736	!! Set new value for the given option by name (complex/vector)
1737	!!
1738	!! If _create_ is given to .true., the method will add a new option if it does not exist in
1739	!! the parser.
1740	!! In such case, an error ((-9, invalid name)) is raised if the option name is not valid.
1741	!!
1742	!! In other case, if the option is not defined in the parser the error status is set to -7.
1743	OBJECT(cfgparser), INTENT(inout) :: this !! Cfgparser object
1744	CHARACTER(len=*), INTENT(in) :: name !! (Full) Name of the option to get
1745	CHARACTER(len=*), INTENT(in), DIMENSION(:) :: input !! Input values
1746	LOGICAL, INTENT(in), OPTIONAL :: create !! .true. to create option if it does not exist (default to false)
1747	TYPE(error) :: err !! Error status
1748	LOGICAL :: zcreate
1749	INTEGER :: i,idx
1750	CHARACTER(len=:), ALLOCATABLE :: sname,pname
1751	TYPE(words) :: values
1752	zcreate = .false. ; IF (PRESENT(create)) zcreate = create
1753	err = noerror
1754	idx = cp_get_opt_idx(this,name)
1755	DO i=1,SIZE(input) ; CALL words_append(values,trim(input(i))); ENDDO
1756	IF (idx == -1) THEN
1757	IF (zcreate) THEN
1758	err = op_split_name(name,sname,pname)
1759	IF (err == 0) err = cp_add_opt(this,sname,pname,values)
1760	ELSE
1761	err = error("Option "//TRIM(name)//" does not exist",-7)
1762	ENDIF
1763	ELSE
1764	this%options(idx)%values = values
1765	ENDIF
1766	CALL words_clear(values)
1767	END FUNCTION cp_set_sv_ve
1768
1769	! i/o functions
1770	!--------------
1771
1772	RECURSIVE FUNCTION read_include(parser,path,isec,ipaths,override) RESULT(err)
1773	!! Read and parse an included configuration file (internal)
1774	!! @note
1775	!! On error, the cfgparser object is left unchanged.
1776	TYPE(cfgparser), INTENT(inout) :: parser
1777	!! A cfgparser object that will store the configuration
1778	CHARACTER(len=*), INTENT(in) :: path
1779	!! A string with the path of the input file to read
1780	CHARACTER(len=st_slen), INTENT(inout) :: isec
1781	!! Current section name
1782	TYPE(words), INTENT(inout) :: ipaths
1783	!! List of paths of already included files
1784	LOGICAL, INTENT(in), OPTIONAL :: override
1785	!! An optional boolean flag with .true. to override previous value of duplicated options instead of raising an error.
1786	TYPE(error) :: err
1787	!! An error with the first error encountered
1788	TYPE(option) :: curopt
1789	LOGICAL :: zoverride,ok,has_opt
1790	INTEGER :: lineno,lu,i
1791	CHARACTER(len=2), PARAMETER :: space = CHAR(32)//"," ! check if , is really wanted... A: YES space are the delimiter of the words internal object !
1792	CHARACTER(len=2), PARAMETER :: blanks = CHAR(9)//CHAR(32) ! currently not used because blanks truncate.
1793	CHARACTER(len=15) :: sln
1794	CHARACTER(len=:), ALLOCATABLE :: fulp,dirp,basp
1795	CHARACTER(len=:), ALLOCATABLE :: curval,ipath
1796	CHARACTER(len=:), ALLOCATABLE :: line,name,value
1797	INTEGER, PARAMETER :: cfg_UNKNOWN = -1, &
1798	cfg_SECTION = 0, &
1799	cfg_OPTION = 1
1800
1801	zoverride = .false. ; IF (PRESENT(override)) zoverride = override
1802	! initialize local variables
1803	curval = '' ; line = '' ; name = '' ; value = ''
1804	lineno = 0 ; lu = free_lun()
1805	IF (LEN_TRIM(isec) == 0) isec = "__default__"
1806	i = INDEX(TRIM(path),"/",.true.)
1807	IF (i == 0) THEN
1808	fulp = fs_realpath("./"//TRIM(ADJUSTL(path)))
1809	ELSE
1810	fulp = fs_realpath(TRIM(ADJUSTL(path)))
1811	ENDIF
1812	basp = fs_basename(fulp)
1813	dirp = fs_dirname(fulp)
1814	! check for file
1815	INQUIRE(FILE=TRIM(path),EXIST=ok)
1816	IF (.NOT.ok) THEN
1817	err = error(TRIM(path)//": no such file",-11)
1818	RETURN
1819	ENDIF
1820	! check for lun
1821	IF (lu == -1) THEN ; err = error("No available logical unit",-12) ; RETURN ; ENDIF
1822	OPEN(lu,FILE=TRIM(path),STATUS='old',ACTION='READ')
1823	DO WHILE(readline(lu,line))
1824	lineno = lineno + 1
1825	WRITE(sln,'(I15)') lineno ; sln=ADJUSTL(sln)
1826	! comment or blank line ?
1827	IF (is_comment(line,ipath)) THEN
1828	! check for includes
1829	IF (LEN(ipath) > 0) THEN
1830	! 1) get relative path
1831	ipath = fs_relpath(ipath,dirp)
1832	! 2) compute asbolute path
1833	ipath = TRIM(dirp)//"/"//TRIM(ipath)
1834	ipath = fs_realpath(ipath)
1835	IF (.NOT.check_include(ipaths,ipath)) THEN
1836	ipath = fs_basename(ipath)
1837	err = error(basp//'(L'//TRIM(sln)//"): Circular include &
1838	&reference to "//ipath,-14)
1839	EXIT
1840	ENDIF
1841	IF (op_valid(curopt) .AND. LEN(curval) > 0) THEN
1842	CALL words_extend(curopt%values,TRIM(ADJUSTL(curval)),space,.true.,.true.)
1843	IF (zoverride) THEN
1844	err = cp_update_opt(parser,curopt%section,curopt%name,curopt%values)
1845	ELSE
1846	err = cp_add_opt(parser,curopt%section,curopt%name,curopt%values)
1847	ENDIF
1848	CALL op_clear(curopt); curval = ''
1849	ENDIF
1850	err = read_include(parser,ipath,isec,ipaths,zoverride)
1851	IF (err /= 0) EXIT
1852	ENDIF
1853	CYCLE
1854	ENDIF
1855	! continuation line ?
1856	IF (SCAN(line(1:1),blanks) /= 0 .AND. op_valid(curopt)) THEN
1857	IF (LEN(curval) == 0) THEN
1858	curval = strip_comment(line)
1859	ELSE
1860	curval = curval//CHAR(32)//strip_comment(line)
1861	ENDIF
1862	ELSE
1863	! 1. Remove comment part and left adjust line
1864	line = strip_comment(line)
1865	! a section header or option header?
1866	SELECT CASE (get_kind(line,name,value))
1867	CASE(cfg_SECTION)
1868	! 1. add current value to current option (if any)
1869	! 2. update "isec" variable
1870	IF (op_valid(curopt)) THEN
1871	IF (LEN(curval) > 0) &
1872	CALL words_extend(curopt%values,TRIM(ADJUSTL(curval)),space,.true.,.true.)
1873	IF (zoverride) THEN
1874	err = cp_update_opt(parser,curopt%section,curopt%name,curopt%values)
1875	ELSE
1876	err = cp_add_opt(parser,curopt%section,curopt%name,curopt%values)
1877	ENDIF
1878	ENDIF
1879	CALL op_clear(curopt) ; curval = ''
1880	IF (cfg_has_section(parser,name) .AND. &
1881	TRIM(name)/="__default__" .AND. &
1882	.NOT.zoverride) THEN
1883	err = error(basp//'(L'//TRIM(sln)//"): Duplicate section '"//name,-8)
1884	EXIT
1885	ENDIF
1886	isec = TRIM(name)
1887	CASE(cfg_OPTION)
1888	! 1. add current value to current option (if any)
1889	! 2. search for option in cursect:
1890	! --> duplicate option error if it exists
1891	! --> create new option if it does not exist (using curopt)
1892	! 3. curval is set to value
1893	! 4. update curval
1894	IF (op_valid(curopt)) THEN
1895	IF (LEN(curval) > 0) &
1896	CALL words_extend(curopt%values,TRIM(ADJUSTL(curval)),space,.true.,.true.)
1897	IF (zoverride) THEN
1898	err = cp_update_opt(parser,curopt%section,curopt%name,curopt%values)
1899	ELSE
1900	err = cp_add_opt(parser,curopt%section,curopt%name,curopt%values)
1901	ENDIF
1902	ENDIF
1903	CALL op_clear(curopt) ; curval = ''
1904	has_opt = cfg_has_option(parser,TRIM(isec)//"/"//TRIM(name))
1905
1906	IF (has_opt.AND..NOT.zoverride) THEN
1907	! it is an error: no duplicate allowed
1908	err = error(basp//'(L'//TRIM(sln)//"): Duplicate option '"//TRIM(name)//"' in "//isec,-8)
1909	EXIT
1910	ENDIF
1911	curopt%name = TRIM(name)
1912	curopt%section = TRIM(isec)
1913	CALL words_clear(curopt%values)
1914	curval = value
1915	CASE(cfg_UNKNOWN)
1916	! unknown handles also invalid name: it is a critical error
1917	IF (err == -9) EXIT
1918	END SELECT
1919	ENDIF
1920	ENDDO
1921	IF (op_valid(curopt)) THEN
1922	IF (LEN(curval) > 0) &
1923	CALL words_extend(curopt%values,TRIM(ADJUSTL(curval)),space,.true.,.true.)
1924	IF (zoverride) THEN
1925	err = cp_update_opt(parser,curopt%section,curopt%name,curopt%values)
1926	ELSE
1927	err = cp_add_opt(parser,curopt%section,curopt%name,curopt%values)
1928	ENDIF
1929	ENDIF
1930	CALL op_clear(curopt) ; curval = ''
1931
1932	CLOSE(lu)
1933
1934	CONTAINS
1935	FUNCTION get_kind(string,name,value) RESULT(kind)
1936	!! Split input line and attempt to guess its relevant kind of statement
1937	!!
1938	!! The input line is searched for section header format or option assignment.
1939	!!
1940	!! - If line begins with '[', has ']' and no '=#' between '[' and ']'
1941	!! it is a section header.
1942	!! - Otherwise, if line has '=', without '#' before '=', it is an option.
1943	!!
1944	!! Then the method returns an integer with the kind flag of the statement which is one of
1945	!! -1 (cfg_UNKNOWN), 0 (cfg_SECTION) or 1 (cfg_OPTION).
1946	CHARACTER(len=*), INTENT(in) :: string !! Input string to process
1947	CHARACTER(len=:), INTENT(out), ALLOCATABLE :: name, & !! Name of the relevant option/section if any, otherwise an empty string.
1948	value !! Value of the relevant option (if any), otherwise an empty string
1949	INTEGER :: kind !! An integer with the kind of statement.
1950	CHARACTER(len=:), ALLOCATABLE :: copy
1951	INTEGER :: bi,ei
1952	CHARACTER(len=2), PARAMETER :: quotes=CHAR(34)//CHAR(39)
1953	kind = cfg_UNKNOWN
1954	! get a trimmed (and left adjusted) copy
1955	copy = TRIM(string)
1956	! Is it a section ?
1957	! ---> search for subscripts of '[' and ']'
1958	! ---> check that '[' is 1st char and ']' is last char
1959	bi = INDEX(copy,'[') ; ei = INDEX(copy,']')
1960	IF (bi == 1 .AND. ei == LEN(copy) .AND. bi < ei) THEN
1961	! it is a section header
1962	kind = cfg_SECTION
1963	! get section name: adjust and trim to remove extra blank spaces
1964	name = TRIM(ADJUSTL(copy(bi+1:ei-1)))
1965	! hack cfg_check_name: append '/a' to get a valid option part to test
1966	IF (TRIM(name) /= "__default__" .AND. .NOT.cfg_check_name(name//"/a")) THEN
1967	kind = cfg_UNKNOWN
1968	err = error("Invalid section name ("//name//")",-9)
1969	RETURN
1970	ENDIF
1971	value = ''
1972	ELSE
1973	! Is it an option ?
1974	! --> search for '=' and check if it is set before
1975	! 1st quote (if any)
1976	bi = INDEX(copy,"=")
1977	! search for quotes
1978	ei = SCAN(copy,quotes) ; IF (ei==0) ei = LEN(copy)+1
1979	IF (bi /= 0 .AND. bi < ei) THEN
1980	kind = cfg_OPTION
1981	name = to_lower(TRIM(copy(1:bi-1)))
1982	IF (.NOT.cfg_check_name(name)) THEN
1983	kind = cfg_UNKNOWN
1984	err = error("Invalid option name ("//TRIM(name)//")",-9)
1985	RETURN
1986	ENDIF
1987	IF (bi == LEN(copy)) THEN
1988	value = ''
1989	ELSE
1990	value = TRIM(copy(bi+1:))
1991	ENDIF
1992	ELSE
1993	! not an option and not a section: malformed statement !
1994	err = error('Malformed statement at line '//TRIM(sln),-13)
1995	ENDIF
1996	ENDIF
1997	RETURN
1998	END FUNCTION get_kind
1999
2000	FUNCTION strip_comment(line) RESULT(stripped)
2001	!! Replace comments part of a string by blank spaces
2002	!! The method replaces every characters after '#' (included) by spaces.
2003	!! @note
2004	!! Output string is also left adjusted, thus only trailing blank can be present.
2005	CHARACTER(len=*), INTENT(in) :: line !! A string to process
2006	CHARACTER(len=LEN(line)) :: stripped !! A string of same length than 'line' but without comment(s)
2007
2008	INTEGER :: idx
2009	stripped = ADJUSTL(line)
2010	idx = INDEX(stripped,"#")
2011	IF (idx > 0) stripped(idx:) = REPEAT(CHAR(32),LEN(line)-idx+1)
2012	RETURN
2013	END FUNCTION strip_comment
2014
2015	FUNCTION readline(lun,string) RESULT(not_eof)
2016	!! Read a complete line
2017	!!
2018	!! Each time it is CALLed, the function reads a complete of the file opened in 'lun' logical
2019	!! unit and returns .false. if EOF has been reached, .true. otherwise.
2020	!!
2021	!! The function is intended to read a file line by line:
2022	!!
2023	!! ```
2024	!! lu = 1
2025	!! open(lu,file="path/to/the/file/to/read")
2026	!! l=0 ! A line counter
2027	!! DO WHILE(readline(lu,line))
2028	!! l = l + 1
2029	!! WRITE(*,'("L",I2.2,": ",(a))') il,line
2030	!! ENDDO
2031	!! CLOSE(1)
2032	!! ```
2033	INTEGER, INTENT(in) :: lun !! Logical unit with the opened file to read.
2034	CHARACTER(len=:), INTENT(out), ALLOCATABLE :: string !! Output processed line
2035	LOGICAL :: not_eof !! .true. if EOF has NOT been reached yet, .false. otherwise
2036	CHARACTER(len=50) :: buf
2037	INTEGER :: e,sz
2038	not_eof = .true. ; string = ''
2039	DO
2040	READ(lun,'(a)',ADVANCE="no",SIZE=sz,IOSTAT=e) buf
2041	IF (e == IOSTAT_END) THEN
2042	not_eof = .false.
2043	IF (sz > 0) THEN
2044	string=string//buf(1:sz)
2045	ENDIF
2046	EXIT
2047	ELSE IF (e == IOSTAT_EOR) THEN
2048	string = string//buf(1:sz)
2049	EXIT
2050	ELSE
2051	string = string//TRIM(buf)
2052	ENDIF
2053	ENDDO
2054	END FUNCTION readline
2055
2056	FUNCTION is_comment(str,incpath) RESULT(res)
2057	!! Check if line is a comment or an empty string
2058	!! @warning
2059	!! Currently, if an '#include' statement is found, the method assumes a single path is set after the directive.
2060	CHARACTER(len=*), INTENT(in) :: str
2061	!! The string to check
2062	CHARACTER(len=:), INTENT(out), ALLOCATABLE :: incpath
2063	!! A string with the filepath to be included if '#include' statement is found, empty string otherwise
2064	LOGICAL :: res
2065	!! .true. if line is a comment or an empty string, .false. otherwise
2066	CHARACTER(len=:), ALLOCATABLE :: copy
2067	res = .false. ; incpath = ''
2068	copy = TRIM(ADJUSTL(str))
2069	IF (LEN(copy) == 0) THEN
2070	res = .true.
2071	ELSE IF (INDEX(copy,"#") == 1) THEN
2072	res = .true.
2073	! search for include statement
2074	! IMPORTANT: assume that there is only a path after include statement
2075	IF (INDEX(copy,"#include ") == 1) incpath = remove_quotes(TRIM(ADJUSTL(copy(10:))))
2076	ENDIF
2077	RETURN
2078	END FUNCTION is_comment
2079
2080	FUNCTION check_include(list,incpath) RESULT(ok)
2081	!! Check if path is not in list
2082	!! @note
2083	!! If path is not in list it is added to the list.
2084	TYPE(words), INTENT(inout) :: list !! A list of paths
2085	CHARACTER(len=*), INTENT(in) :: incpath !! Path to check in list
2086	LOGICAL :: ok !! .true. if 'path' is __not__ in list, .false. otherwise
2087	CALL words_reset(list)
2088	ok = .true.
2089	DO WHILE(words_valid(list))
2090	IF (TRIM(incpath) == TRIM(words_current(list))) THEN
2091	ok = .false. ; EXIT
2092	ENDIF
2093	CALL words_next(list)
2094	ENDDO
2095	IF (ok) CALL words_append(list,TRIM(incpath))
2096	END FUNCTION check_include
2097
2098	END FUNCTION read_include
2099
2100	! insertion sort... internal
2101
2102	SUBROUTINE insertionSort(opts)
2103	!! Sort an array of Options using insertion sort algorithm
2104	TYPE(option), INTENT(inout), DIMENSION(:) :: opts !! Array to sort.
2105	TYPE(option) :: temp
2106	INTEGER :: i, j
2107	DO i = 2, SIZE(opts)
2108	j = i - 1
2109	temp = opts(i)
2110	DO WHILE (j>=1) ! .AND. op_greater_than(opts(j),temp))
2111	IF (op_greater_than(opts(j),temp)) THEN
2112	opts(j+1) = opts(j)
2113	j = j - 1
2114	ELSE
2115	EXIT
2116	ENDIF
2117	ENDDO
2118	opts(j+1) = temp
2119	CALL op_clear(temp)
2120	ENDDO
2121	END SUBROUTINE insertionSort
2122
2123	END MODULE CFGPARSE
2124

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format