Context Navigation

cfgparse.F90 @ 3094

Last change on this file since 3094 was 3090, checked in by slebonnois, 15 months ago
BdeBatz? : Cleans microphysics and makes few corrections for physics
File size: 83.4 KB

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

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

Download in other formats:

Original Format