8 integer,
parameter :: dp = kind(0.0d0)
10 integer,
parameter :: CFG_num_types = 4
15 integer,
parameter :: cfg_unknown_type = 0
22 [character(len=10) ::
"storage",
"integer",
"real",
"string ",
"logical"]
28 character(len=*),
parameter :: cfg_separators =
" ,'"""//char(9)
31 character(len=*),
parameter :: cfg_category_separator =
"%"
41 logical :: dynamic_size
45 character(len=CFG_string_len) :: stored_data
47 character(len=CFG_name_len) :: var_name
49 character(len=CFG_string_len) :: description
53 real(dp),
allocatable :: real_data(:)
54 integer,
allocatable :: int_data(:)
55 character(len=CFG_string_len),
allocatable :: char_data(:)
56 logical,
allocatable :: logic_data(:)
61 integer :: num_vars = 0
62 logical :: sorted = .false.
63 type(cfg_var_t),
allocatable :: vars(:)
68 module procedure :: add_real, add_real_array
69 module procedure :: add_int, add_int_array
70 module procedure :: add_string, add_string_array
71 module procedure :: add_logic, add_logic_array
76 module procedure :: get_real, get_real_array
77 module procedure :: get_int, get_int_array
78 module procedure :: get_logic, get_logic_array
79 module procedure :: get_string, get_string_array
84 module procedure :: add_get_real, add_get_real_array
85 module procedure :: add_get_int, add_get_int_array
86 module procedure :: add_get_logic, add_get_logic_array
87 module procedure :: add_get_string, add_get_string_array
88 end interface cfg_add_get
106 public :: cfg_add_get
119 type(cfg_t),
intent(inout) :: cfg
120 character(len=100) :: cfg_name
123 do ix = 1, command_argument_count()
124 call get_command_argument(ix, cfg_name)
131 subroutine handle_error(err_string)
132 character(len=*),
intent(in) :: err_string
134 print *,
"The following error occured in mod_config:"
135 print *, trim(err_string)
140 end subroutine handle_error
143 subroutine get_var_index(cfg, var_name, ix)
144 type(cfg_t),
intent(in) :: cfg
145 character(len=*),
intent(in) :: var_name
146 integer,
intent(out) :: ix
150 call binary_search_variable(cfg, var_name, ix)
153 do i = 1, cfg%num_vars
154 if (cfg%vars(i)%var_name == var_name)
exit
158 if (i == cfg%num_vars + 1) i = -1
162 end subroutine get_var_index
166 type(cfg_t),
intent(inout) :: cfg
167 character(len=*),
intent(in) :: filename
169 integer,
parameter :: my_unit = 123
170 integer :: io_state, equal_sign_ix
171 integer :: ix, line_number
172 character(len=CFG_name_len) :: var_name, category
173 character(len=CFG_name_len) :: line_fmt
174 character(len=CFG_string_len) :: err_string
175 character(len=CFG_string_len) :: line
177 open(my_unit, file=trim(filename), status =
"OLD", &
178 action=
"READ", err=998, iostat=io_state)
187 read(my_unit, fmt=trim(line_fmt), err=998,
end=999) line
188 line_number = line_number + 1
190 call trim_comment(line,
'#')
193 if (line ==
"") cycle
196 equal_sign_ix = scan(line,
'=')
199 if (equal_sign_ix == 0)
then
204 if (line(1:1) /=
'[' .or. ix == 0)
then
205 write(err_string, *)
"Cannot read line ", line_number, &
206 " from ", trim(filename)
207 call handle_error(err_string)
209 category = line(2:ix-1)
214 var_name = line(1 : equal_sign_ix - 1)
217 if (var_name(1:1) /=
" " .and. var_name(1:1) /= char(9))
then
222 var_name = adjustl(var_name)
225 if (category /=
"")
then
226 var_name = trim(category) // cfg_category_separator // var_name
229 line = line(equal_sign_ix + 1:)
233 call get_var_index(cfg, var_name, ix)
237 call prepare_store_var(cfg, trim(var_name), cfg_unknown_type, 1, &
238 "Not yet created", ix, .false.)
239 cfg%vars(ix)%stored_data = line
241 cfg%vars(ix)%stored_data = line
242 call read_variable(cfg%vars(ix))
246 998
write(err_string, *)
"io_state = ", io_state,
" while reading from ", &
247 trim(filename),
" at line ", line_number
248 call handle_error(
"CFG_read_file:" // err_string)
251 999
close(my_unit, iostat=io_state)
255 subroutine read_variable(var)
256 type(cfg_var_t),
intent(inout) :: var
257 integer :: n, n_entries
262 call get_fields_string(var%stored_data, cfg_separators, &
265 if (var%var_size /= n_entries)
then
266 if (.not. var%dynamic_size)
then
267 call handle_error(
"read_variable: variable [" // &
268 & trim(var%var_name) //
"] has the wrong size")
270 var%var_size = n_entries
271 call resize_storage(var)
276 select case (var%var_type)
278 read(var%stored_data(ix_start(n):ix_end(n)), *) var%int_data(n)
280 read(var%stored_data(ix_start(n):ix_end(n)), *) var%real_data(n)
282 var%char_data(n) = trim(var%stored_data(ix_start(n):ix_end(n)))
284 read(var%stored_data(ix_start(n):ix_end(n)), *) var%logic_data(n)
287 end subroutine read_variable
289 subroutine trim_comment(line, comment_chars)
290 character(len=*),
intent(inout) :: line
291 character(len=*),
intent(in) :: comment_chars
293 character :: current_char, need_char
300 current_char = line(n:n)
302 if (need_char ==
"")
then
303 if (current_char ==
"'")
then
305 else if (current_char ==
'"')
then
307 else if (index(current_char, comment_chars) /= 0)
then
311 else if (current_char == need_char)
then
317 end subroutine trim_comment
320 type(cfg_t),
intent(in) :: cfg
322 character(len=CFG_string_len) :: err_string
324 do n = 1, cfg%num_vars
325 if (cfg%vars(n)%var_type == cfg_unknown_type)
then
326 write(err_string, *)
"CFG_check: unknown variable ", &
327 trim(cfg%vars(n)%var_name),
" in a config file"
328 call handle_error(err_string)
336 type(cfg_t),
intent(in) :: cfg_in
337 character(len=*),
intent(in) :: filename
338 logical,
intent(in),
optional :: hide_unused
341 integer :: i, j, io_state, myunit
342 logical :: hide_not_used
343 character(len=CFG_name_len) :: name_format, var_name
344 character(len=CFG_name_len) :: category, prev_category
345 character(len=CFG_string_len) :: err_string
347 hide_not_used = .false.
348 if (
present(hide_unused)) hide_not_used = hide_unused
352 if (.not. cfg%sorted)
call cfg_sort(cfg)
354 write(name_format, fmt=
"(A,I0,A)")
"(A,A",
cfg_name_len,
",A)"
356 if (filename ==
"stdout")
then
360 open(myunit, file=filename, action=
"WRITE", err=999, iostat=io_state)
366 do i = 1, cfg%num_vars
367 if (.not. cfg%vars(i)%used .and. hide_not_used) cycle
368 if (cfg%vars(i)%var_type == cfg_unknown_type) cycle
373 if (category /= prev_category .and. category /=
'')
then
374 write(myunit, err=998, fmt=
"(A)")
'[' // trim(category) //
']'
375 prev_category = category
379 if (category /=
"")
then
380 write(myunit, err=998, fmt=
"(A,A,A)")
" # ", &
381 trim(cfg%vars(i)%description),
":"
382 write(myunit, advance=
"NO", err=998, fmt=
"(A)") &
383 " " // trim(var_name) //
" ="
385 write(myunit, err=998, fmt=
"(A,A,A)")
"# ", &
386 trim(cfg%vars(i)%description),
":"
387 write(myunit, advance=
"NO", err=998, fmt=
"(A)") &
388 trim(var_name) //
" ="
391 select case(cfg%vars(i)%var_type)
393 do j = 1, cfg%vars(i)%var_size
394 write(myunit, advance=
"NO", err=998, fmt=
"(A,I0)") &
395 " ", cfg%vars(i)%int_data(j)
398 do j = 1, cfg%vars(i)%var_size
399 write(myunit, advance=
"NO", err=998, fmt=
"(A,E11.4)") &
400 " ", cfg%vars(i)%real_data(j)
403 do j = 1, cfg%vars(i)%var_size
404 write(myunit, advance=
"NO", err=998, fmt=
"(A)") &
405 " '" // trim(cfg%vars(i)%char_data(j)) //
"'"
408 do j = 1, cfg%vars(i)%var_size
409 write(myunit, advance=
"NO", err=998, fmt=
"(A,L1)") &
410 " ", cfg%vars(i)%logic_data(j)
413 write(myunit, err=998, fmt=
"(A)")
""
414 write(myunit, err=998, fmt=
"(A)")
""
417 if (myunit /= output_unit)
close(myunit, err=999, iostat=io_state)
422 write(err_string, *)
"CFG_write error: io_state = ", io_state, &
423 " while writing ", trim(var_name),
" to ", filename
424 call handle_error(err_string)
427 write(err_string, *)
"CFG_write error: io_state = ", io_state, &
428 " while writing to ", filename
429 call handle_error(err_string)
436 type(cfg_t),
intent(in) :: cfg_in
437 character(len=*),
intent(in) :: filename
438 logical,
intent(in),
optional :: hide_unused
441 integer :: i, j, io_state, myunit
442 logical :: hide_not_used
443 character(len=CFG_name_len) :: name_format, var_name
444 character(len=CFG_name_len) :: category, prev_category
445 character(len=CFG_string_len) :: err_string
447 hide_not_used = .false.
448 if (
present(hide_unused)) hide_not_used = hide_unused
452 if (.not. cfg%sorted)
call cfg_sort(cfg)
454 write(name_format, fmt=
"(A,I0,A)")
"(A,A",
cfg_name_len,
",A)"
456 if (filename ==
"stdout")
then
460 open(myunit, file=filename, action=
"WRITE", err=999, iostat=io_state)
465 write(myunit, err=998, fmt=
"(A)")
"# Configuration file (markdown format)"
466 write(myunit, err=998, fmt=
"(A)")
""
468 do i = 1, cfg%num_vars
470 if (.not. cfg%vars(i)%used .and. hide_not_used) cycle
471 if (cfg%vars(i)%var_type == cfg_unknown_type) cycle
476 if (category /= prev_category)
then
477 if (category ==
"") category =
"No category"
478 write(myunit, err=998, fmt=
"(A)")
'## ' // trim(category)
479 write(myunit, err=998, fmt=
"(A)")
""
480 prev_category = category
483 write(myunit, err=998, fmt=
"(A)")
"* " // trim(cfg%vars(i)%description)
484 write(myunit, err=998, fmt=
"(A)")
""
485 write(myunit, advance=
"NO", err=998, fmt=
"(A)") &
486 ' ' // trim(var_name) //
" ="
488 select case(cfg%vars(i)%var_type)
490 do j = 1, cfg%vars(i)%var_size
491 write(myunit, advance=
"NO", err=998, fmt=
"(A,I0)") &
492 " ", cfg%vars(i)%int_data(j)
495 do j = 1, cfg%vars(i)%var_size
496 write(myunit, advance=
"NO", err=998, fmt=
"(A,E11.4)") &
497 " ", cfg%vars(i)%real_data(j)
500 do j = 1, cfg%vars(i)%var_size
501 write(myunit, advance=
"NO", err=998, fmt=
"(A)") &
502 " '" // trim(cfg%vars(i)%char_data(j)) //
"'"
505 do j = 1, cfg%vars(i)%var_size
506 write(myunit, advance=
"NO", err=998, fmt=
"(A,L1)") &
507 " ", cfg%vars(i)%logic_data(j)
510 write(myunit, err=998, fmt=
"(A)")
""
511 write(myunit, err=998, fmt=
"(A)")
""
514 if (myunit /= output_unit)
close(myunit, err=999, iostat=io_state)
519 write(err_string, *)
"CFG_write_markdown error: io_state = ", io_state, &
520 " while writing ", trim(var_name),
" to ", filename
521 call handle_error(err_string)
524 write(err_string, *)
"CFG_write_markdown error: io_state = ", io_state, &
525 " while writing to ", filename
526 call handle_error(err_string)
531 type(cfg_var_t),
intent(in) :: variable
532 character(CFG_name_len),
intent(out) :: category
533 character(CFG_name_len),
intent(out) :: var_name
536 ix = index(variable%var_name, cfg_category_separator)
540 var_name = variable%var_name
542 category = variable%var_name(1:ix-1)
543 var_name = variable%var_name(ix+1:)
550 subroutine resize_storage(variable)
551 type(cfg_var_t),
intent(inout) :: variable
553 select case (variable%var_type)
555 deallocate( variable%int_data )
556 allocate( variable%int_data(variable%var_size) )
558 deallocate( variable%logic_data )
559 allocate( variable%logic_data(variable%var_size) )
561 deallocate( variable%real_data )
562 allocate( variable%real_data(variable%var_size) )
564 deallocate( variable%char_data )
565 allocate( variable%char_data(variable%var_size) )
567 end subroutine resize_storage
571 subroutine prepare_store_var(cfg, var_name, var_type, var_size, &
572 description, ix, dynamic_size)
573 type(cfg_t),
intent(inout) :: cfg
574 character(len=*),
intent(in) :: var_name, description
575 integer,
intent(in) :: var_type, var_size
576 integer,
intent(out) :: ix
577 logical,
intent(in),
optional :: dynamic_size
580 call get_var_index(cfg, var_name, ix)
583 call ensure_free_storage(cfg)
585 ix = cfg%num_vars + 1
586 cfg%num_vars = cfg%num_vars + 1
587 cfg%vars(ix)%used = .false.
588 cfg%vars(ix)%stored_data =
""
591 if (cfg%vars(ix)%var_type /= cfg_unknown_type)
then
592 call handle_error(
"prepare_store_var: variable [" // &
593 & trim(var_name) //
"] already exists")
597 cfg%vars(ix)%var_name = var_name
598 cfg%vars(ix)%description = description
599 cfg%vars(ix)%var_type = var_type
600 cfg%vars(ix)%var_size = var_size
602 if (
present(dynamic_size))
then
603 cfg%vars(ix)%dynamic_size = dynamic_size
605 cfg%vars(ix)%dynamic_size = .false.
608 select case (var_type)
610 allocate( cfg%vars(ix)%int_data(var_size) )
612 allocate( cfg%vars(ix)%real_data(var_size) )
614 allocate( cfg%vars(ix)%char_data(var_size) )
616 allocate( cfg%vars(ix)%logic_data(var_size) )
619 end subroutine prepare_store_var
623 subroutine prepare_get_var(cfg, var_name, var_type, var_size, ix)
624 type(cfg_t),
intent(inout) :: cfg
625 character(len=*),
intent(in) :: var_name
626 integer,
intent(in) :: var_type, var_size
627 integer,
intent(out) :: ix
628 character(len=CFG_string_len) :: err_string
630 call get_var_index(cfg, var_name, ix)
633 call handle_error(
"CFG_get: variable ["//var_name//
"] not found")
634 else if (cfg%vars(ix)%var_type /= var_type)
then
635 write(err_string, fmt=
"(A)")
"CFG_get: variable [" &
636 // var_name //
"] has different type (" // &
639 call handle_error(err_string)
640 else if (cfg%vars(ix)%var_size /= var_size)
then
641 write(err_string, fmt=
"(A,I0,A,I0,A)")
"CFG_get: variable [" &
642 // var_name //
"] has different size (", cfg%vars(ix)%var_size, &
643 ") than requested (", var_size,
")"
644 call handle_error(err_string)
646 cfg%vars(ix)%used = .true.
648 end subroutine prepare_get_var
651 subroutine add_real(cfg, var_name, real_data, comment)
652 type(cfg_t),
intent(inout) :: cfg
653 character(len=*),
intent(in) :: var_name, comment
654 real(dp),
intent(in) :: real_data
657 call prepare_store_var(cfg, var_name,
cfg_real_type, 1, comment, ix)
659 if (cfg%vars(ix)%stored_data /=
"")
then
660 call read_variable(cfg%vars(ix))
662 cfg%vars(ix)%real_data(1) = real_data
664 end subroutine add_real
668 subroutine add_real_array(cfg, var_name, real_data, comment, dynamic_size)
669 type(cfg_t),
intent(inout) :: cfg
670 character(len=*),
intent(in) :: var_name, comment
671 real(dp),
intent(in) :: real_data(:)
672 logical,
intent(in),
optional :: dynamic_size
676 size(real_data), comment, ix, dynamic_size)
678 if (cfg%vars(ix)%stored_data /=
"")
then
679 call read_variable(cfg%vars(ix))
681 cfg%vars(ix)%real_data = real_data
683 end subroutine add_real_array
686 subroutine add_int(cfg, var_name, int_data, comment)
687 type(cfg_t),
intent(inout) :: cfg
688 character(len=*),
intent(in) :: var_name, comment
689 integer,
intent(in) :: int_data
694 if (cfg%vars(ix)%stored_data /=
"")
then
695 call read_variable(cfg%vars(ix))
697 cfg%vars(ix)%int_data(1) = int_data
699 end subroutine add_int
702 subroutine add_int_array(cfg, var_name, int_data, comment, dynamic_size)
703 type(cfg_t),
intent(inout) :: cfg
704 character(len=*),
intent(in) :: var_name, comment
705 integer,
intent(in) :: int_data(:)
706 logical,
intent(in),
optional :: dynamic_size
710 size(int_data), comment, ix, dynamic_size)
712 if (cfg%vars(ix)%stored_data /=
"")
then
713 call read_variable(cfg%vars(ix))
715 cfg%vars(ix)%int_data = int_data
717 end subroutine add_int_array
720 subroutine add_string(cfg, var_name, char_data, comment)
721 type(cfg_t),
intent(inout) :: cfg
722 character(len=*),
intent(in) :: var_name, comment, char_data
726 if (cfg%vars(ix)%stored_data /=
"")
then
727 call read_variable(cfg%vars(ix))
729 cfg%vars(ix)%char_data(1) = char_data
731 end subroutine add_string
734 subroutine add_string_array(cfg, var_name, char_data, &
735 comment, dynamic_size)
736 type(cfg_t),
intent(inout) :: cfg
737 character(len=*),
intent(in) :: var_name, comment, char_data(:)
738 logical,
intent(in),
optional :: dynamic_size
742 size(char_data), comment, ix, dynamic_size)
744 if (cfg%vars(ix)%stored_data /=
"")
then
745 call read_variable(cfg%vars(ix))
747 cfg%vars(ix)%char_data = char_data
749 end subroutine add_string_array
752 subroutine add_logic(cfg, var_name, logic_data, comment)
753 type(cfg_t),
intent(inout) :: cfg
754 character(len=*),
intent(in) :: var_name, comment
755 logical,
intent(in) :: logic_data
758 call prepare_store_var(cfg, var_name,
cfg_logic_type, 1, comment, ix)
760 if (cfg%vars(ix)%stored_data /=
"")
then
761 call read_variable(cfg%vars(ix))
763 cfg%vars(ix)%logic_data(1) = logic_data
765 end subroutine add_logic
768 subroutine add_logic_array(cfg, var_name, logic_data, &
769 comment, dynamic_size)
770 type(cfg_t),
intent(inout) :: cfg
771 character(len=*),
intent(in) :: var_name, comment
772 logical,
intent(in) :: logic_data(:)
773 logical,
intent(in),
optional :: dynamic_size
777 size(logic_data), comment, ix, dynamic_size)
779 if (cfg%vars(ix)%stored_data /=
"")
then
780 call read_variable(cfg%vars(ix))
782 cfg%vars(ix)%logic_data = logic_data
784 end subroutine add_logic_array
787 subroutine get_real_array(cfg, var_name, real_data)
788 type(cfg_t),
intent(inout) :: cfg
789 character(len=*),
intent(in) :: var_name
790 real(dp),
intent(inout) :: real_data(:)
795 real_data = cfg%vars(ix)%real_data
796 end subroutine get_real_array
799 subroutine get_int_array(cfg, var_name, int_data)
800 type(cfg_t),
intent(inout) :: cfg
801 character(len=*),
intent(in) :: var_name
802 integer,
intent(inout) :: int_data(:)
807 int_data = cfg%vars(ix)%int_data
808 end subroutine get_int_array
811 subroutine get_string_array(cfg, var_name, char_data)
812 type(cfg_t),
intent(inout) :: cfg
813 character(len=*),
intent(in) :: var_name
814 character(len=*),
intent(inout) :: char_data(:)
819 char_data = cfg%vars(ix)%char_data
820 end subroutine get_string_array
823 subroutine get_logic_array(cfg, var_name, logic_data)
824 type(cfg_t),
intent(inout) :: cfg
825 character(len=*),
intent(in) :: var_name
826 logical,
intent(inout) :: logic_data(:)
830 size(logic_data), ix)
831 logic_data = cfg%vars(ix)%logic_data
832 end subroutine get_logic_array
835 subroutine get_real(cfg, var_name, res)
836 type(cfg_t),
intent(inout) :: cfg
837 character(len=*),
intent(in) :: var_name
838 real(dp),
intent(out) :: res
842 res = cfg%vars(ix)%real_data(1)
843 end subroutine get_real
846 subroutine get_int(cfg, var_name, res)
847 type(cfg_t),
intent(inout) :: cfg
848 character(len=*),
intent(in) :: var_name
849 integer,
intent(inout) :: res
853 res = cfg%vars(ix)%int_data(1)
854 end subroutine get_int
857 subroutine get_logic(cfg, var_name, res)
858 type(cfg_t),
intent(inout) :: cfg
859 character(len=*),
intent(in) :: var_name
860 logical,
intent(out) :: res
864 res = cfg%vars(ix)%logic_data(1)
865 end subroutine get_logic
868 subroutine get_string(cfg, var_name, res)
869 type(cfg_t),
intent(inout) :: cfg
870 character(len=*),
intent(in) :: var_name
871 character(len=*),
intent(out) :: res
875 res = cfg%vars(ix)%char_data(1)
876 end subroutine get_string
879 subroutine add_get_real_array(cfg, var_name, real_data, &
880 comment, dynamic_size)
881 type(cfg_t),
intent(inout) :: cfg
882 character(len=*),
intent(in) :: var_name, comment
883 real(dp),
intent(inout) :: real_data(:)
884 logical,
intent(in),
optional :: dynamic_size
886 call add_real_array(cfg, var_name, real_data, comment, dynamic_size)
887 call get_real_array(cfg, var_name, real_data)
888 end subroutine add_get_real_array
891 subroutine add_get_int_array(cfg, var_name, int_data, &
892 comment, dynamic_size)
893 type(cfg_t),
intent(inout) :: cfg
894 character(len=*),
intent(in) :: var_name, comment
895 integer,
intent(inout) :: int_data(:)
896 logical,
intent(in),
optional :: dynamic_size
898 call add_int_array(cfg, var_name, int_data, comment, dynamic_size)
899 call get_int_array(cfg, var_name, int_data)
900 end subroutine add_get_int_array
903 subroutine add_get_string_array(cfg, var_name, char_data, &
904 comment, dynamic_size)
905 type(cfg_t),
intent(inout) :: cfg
906 character(len=*),
intent(in) :: var_name, comment
907 character(len=*),
intent(inout) :: char_data(:)
908 logical,
intent(in),
optional :: dynamic_size
910 call add_string_array(cfg, var_name, char_data, comment, dynamic_size)
911 call get_string_array(cfg, var_name, char_data)
912 end subroutine add_get_string_array
915 subroutine add_get_logic_array(cfg, var_name, logic_data, &
916 comment, dynamic_size)
917 type(cfg_t),
intent(inout) :: cfg
918 character(len=*),
intent(in) :: var_name, comment
919 logical,
intent(inout) :: logic_data(:)
920 logical,
intent(in),
optional :: dynamic_size
922 call add_logic_array(cfg, var_name, logic_data, comment, dynamic_size)
923 call get_logic_array(cfg, var_name, logic_data)
924 end subroutine add_get_logic_array
927 subroutine add_get_real(cfg, var_name, real_data, comment)
928 type(cfg_t),
intent(inout) :: cfg
929 character(len=*),
intent(in) :: var_name, comment
930 real(dp),
intent(inout) :: real_data
932 call add_real(cfg, var_name, real_data, comment)
933 call get_real(cfg, var_name, real_data)
934 end subroutine add_get_real
937 subroutine add_get_int(cfg, var_name, int_data, comment)
938 type(cfg_t),
intent(inout) :: cfg
939 character(len=*),
intent(in) :: var_name, comment
940 integer,
intent(inout) :: int_data
942 call add_int(cfg, var_name, int_data, comment)
943 call get_int(cfg, var_name, int_data)
944 end subroutine add_get_int
947 subroutine add_get_logic(cfg, var_name, logical_data, comment)
948 type(cfg_t),
intent(inout) :: cfg
949 character(len=*),
intent(in) :: var_name, comment
950 logical,
intent(inout) :: logical_data
952 call add_logic(cfg, var_name, logical_data, comment)
953 call get_logic(cfg, var_name, logical_data)
954 end subroutine add_get_logic
957 subroutine add_get_string(cfg, var_name, string_data, comment)
958 type(cfg_t),
intent(inout) :: cfg
959 character(len=*),
intent(in) :: var_name, comment
960 character(len=*),
intent(inout) :: string_data
962 call add_string(cfg, var_name, string_data, comment)
963 call get_string(cfg, var_name, string_data)
964 end subroutine add_get_string
968 type(cfg_t),
intent(in) :: cfg
969 character(len=*),
intent(in) :: var_name
970 integer,
intent(out) :: res
973 call get_var_index(cfg, var_name, ix)
975 res = cfg%vars(ix)%var_size
978 call handle_error(
"CFG_get_size: variable ["//var_name//
"] not found")
984 type(cfg_t),
intent(in) :: cfg
985 character(len=*),
intent(in) :: var_name
986 integer,
intent(out) :: res
989 call get_var_index(cfg, var_name, ix)
992 res = cfg%vars(ix)%var_type
995 call handle_error(
"CFG_get_type: variable ["//var_name//
"] not found")
1002 subroutine ensure_free_storage(cfg)
1003 type(cfg_t),
intent(inout) :: cfg
1004 type(cfg_var_t),
allocatable :: cfg_copy(:)
1005 integer,
parameter :: min_dyn_size = 100
1006 integer :: cur_size, new_size
1008 if (
allocated(cfg%vars))
then
1009 cur_size =
size(cfg%vars)
1011 if (cur_size < cfg%num_vars + 1)
then
1012 new_size = 2 * cur_size
1013 allocate(cfg_copy(cur_size))
1015 deallocate(cfg%vars)
1016 allocate(cfg%vars(new_size))
1017 cfg%vars(1:cur_size) = cfg_copy
1020 allocate(cfg%vars(min_dyn_size))
1023 end subroutine ensure_free_storage
1026 subroutine get_fields_string(line, delims, n_max, n_found, ixs_start, ixs_end)
1028 character(len=*),
intent(in) :: line
1030 character(len=*),
intent(in) :: delims
1032 integer,
intent(in) :: n_max
1034 integer,
intent(inout) :: n_found
1036 integer,
intent(inout) :: ixs_start(n_max)
1038 integer,
intent(inout) :: ixs_end(n_max)
1040 integer :: ix, ix_prev
1045 do while (n_found < n_max)
1048 ix = verify(line(ix_prev+1:), delims)
1051 n_found = n_found + 1
1052 ixs_start(n_found) = ix_prev + ix
1055 ix = scan(line(ixs_start(n_found)+1:), delims) - 1
1058 ixs_end(n_found) = len(line)
1060 ixs_end(n_found) = ixs_start(n_found) + ix
1063 ix_prev = ixs_end(n_found)
1066 end subroutine get_fields_string
1069 subroutine binary_search_variable(cfg, var_name, ix)
1070 type(cfg_t),
intent(in) :: cfg
1071 character(len=*),
intent(in) :: var_name
1072 integer,
intent(out) :: ix
1073 integer :: i_min, i_max, i_mid
1076 i_max = cfg%num_vars
1079 do while (i_min < i_max)
1080 i_mid = i_min + (i_max - i_min) / 2
1081 if ( llt(cfg%vars(i_mid)%var_name, var_name) )
then
1089 if (i_max == i_min .and. cfg%vars(i_min)%var_name == var_name)
then
1094 end subroutine binary_search_variable
1098 type(cfg_t),
intent(inout) :: cfg
1100 call qsort_config(cfg%vars(1:cfg%num_vars))
1105 recursive subroutine qsort_config(list)
1106 type(cfg_var_t),
intent(inout) :: list(:)
1107 integer :: split_pos
1109 if (
size(list) > 1)
then
1110 call parition_var_list(list, split_pos)
1111 call qsort_config( list(:split_pos-1) )
1112 call qsort_config( list(split_pos:) )
1114 end subroutine qsort_config
1117 subroutine parition_var_list(list, marker)
1118 type(cfg_var_t),
intent(inout) :: list(:)
1119 integer,
intent(out) :: marker
1120 integer :: left, right, pivot_ix
1121 type(cfg_var_t) :: temp
1122 character(len=CFG_name_len) :: pivot_value
1125 right =
size(list) + 1
1128 pivot_ix =
size(list) / 2
1129 pivot_value = list(pivot_ix)%var_name
1131 do while (left < right)
1134 do while (lgt(list(right)%var_name, pivot_value))
1139 do while (lgt(pivot_value, list(left)%var_name))
1143 if (left < right)
then
1145 list(left) = list(right)
1150 if (left == right)
then
1155 end subroutine parition_var_list
Module that allows working with a configuration file.
subroutine, public cfg_get_size(cfg, var_name, res)
Get the size of a variable.
integer, parameter, public cfg_real_type
Real number type.
subroutine split_category(variable, category, var_name)
integer, parameter, public cfg_string_type
String type.
subroutine, public cfg_read_file(cfg, filename)
Update the variables in the configartion with the values found in 'filename'.
integer, parameter, public cfg_name_len
Maximum length of variable names.
integer, parameter, public cfg_string_len
Fixed length of string type.
subroutine, public cfg_check(cfg)
subroutine, public cfg_get_type(cfg, var_name, res)
Get the type of a given variable of a configuration type.
subroutine, public cfg_update_from_arguments(cfg)
integer, parameter, public cfg_logic_type
Boolean/logical type.
subroutine, public cfg_write(cfg_in, filename, hide_unused)
This routine writes the current configuration to a file with descriptions.
integer, parameter, public cfg_max_array_size
Maximum number of entries in a variable (if it's an array)
subroutine, public cfg_write_markdown(cfg_in, filename, hide_unused)
This routine writes the current configuration to a markdown file.
subroutine, public cfg_sort(cfg)
Sort the variables for faster lookup.
integer, parameter, public cfg_integer_type
Integer type.
character(len=10), dimension(0:cfg_num_types), parameter, public cfg_type_names
Names of the types.