Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

swift_cfgparse.F90 @ 3590

Last change on this file since 3590 was 3560, checked in by debatzbr, 5 weeks ago
Addition of the microphysics model in moments.
File size: 83.5 KB

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

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

Download in other formats:

Original Format