MPI-AMRVAC 3.1
The MPI - Adaptive Mesh Refinement - Versatile Advection Code (development version)
Loading...
Searching...
No Matches
mod_config.t
Go to the documentation of this file.
1!> Module that allows working with a configuration file
3
4 implicit none
5 private
6
7 !> The double precision kind-parameter
8 integer, parameter :: dp = kind(0.0d0)
9
10 integer, parameter :: CFG_num_types = 4 !< Number of variable types
11 integer, parameter :: cfg_integer_type = 1 !< Integer type
12 integer, parameter :: cfg_real_type = 2 !< Real number type
13 integer, parameter :: cfg_string_type = 3 !< String type
14 integer, parameter :: cfg_logic_type = 4 !< Boolean/logical type
15 integer, parameter :: cfg_unknown_type = 0 !< Used before a variable is created
16
17 integer, parameter :: cfg_name_len = 80 !< Maximum length of variable names
18 integer, parameter :: cfg_string_len = 200 !< Fixed length of string type
19
20 !> Names of the types
21 character(len=10), parameter :: cfg_type_names(0:cfg_num_types) = &
22 [character(len=10) :: "storage", "integer", "real", "string ", "logical"]
23
24 !> Maximum number of entries in a variable (if it's an array)
25 integer, parameter :: cfg_max_array_size = 20
26
27 !> The separator(s) for array-like variables (space, comma, ', ", and tab)
28 character(len=*), parameter :: cfg_separators = " ,'"""//char(9)
29
30 !> The separator for categories (stored in var_name)
31 character(len=*), parameter :: cfg_category_separator = "%"
32
33 !> The type of a configuration variable
34 type cfg_var_t
35 private
36 !> Type of variable
37 integer :: var_type
38 !> Size of variable, 1 means scalar, > 1 means array
39 integer :: var_size
40 !> Whether the variable size is flexible
41 logical :: dynamic_size
42 !> Whether the variable's value has been requested
43 logical :: used
44 !> Data that has been read in for this variable
45 character(len=CFG_string_len) :: stored_data
46 !> Name of the variable
47 character(len=CFG_name_len) :: var_name
48 !> Description of variable
49 character(len=CFG_string_len) :: description
50
51 ! These are the arrays used for storage. In the future, a "pointer" based
52 ! approach could be used.
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(:)
57 end type cfg_var_t
58
59 !> The configuration that contains all the variables
60 type cfg_t
61 integer :: num_vars = 0
62 logical :: sorted = .false.
63 type(cfg_var_t), allocatable :: vars(:)
64 end type cfg_t
65
66 !> Interface to add variables to the configuration
67 interface cfg_add
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
72 end interface cfg_add
73
74 !> Interface to get variables from the configuration
75 interface cfg_get
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
80 end interface cfg_get
81
82 !> Interface to get variables from the configuration
83 interface cfg_add_get
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
89
90 ! Public types
91 public :: cfg_t
92 public :: cfg_integer_type
93 public :: cfg_real_type
94 public :: cfg_string_type
95 public :: cfg_logic_type
96 public :: cfg_type_names
97
98 ! Constants
99 public :: cfg_name_len
100 public :: cfg_string_len
101 public :: cfg_max_array_size
102
103 ! Public methods
104 public :: cfg_add
105 public :: cfg_get
106 public :: cfg_add_get
107 public :: cfg_get_size
108 public :: cfg_get_type
109 public :: cfg_check
110 public :: cfg_sort
111 public :: cfg_write
112 public :: cfg_write_markdown
113 public :: cfg_read_file
115
116contains
117
119 type(cfg_t),intent(inout) :: cfg
120 character(len=100) :: cfg_name
121 integer :: ix
122
123 do ix = 1, command_argument_count()
124 call get_command_argument(ix, cfg_name)
125 call cfg_read_file(cfg, trim(cfg_name))
126 end do
127 end subroutine cfg_update_from_arguments
128
129 !> This routine will be called if an error occurs in one of the subroutines of
130 !> this module.
131 subroutine handle_error(err_string)
132 character(len=*), intent(in) :: err_string
133
134 print *, "The following error occured in mod_config:"
135 print *, trim(err_string)
136
137 ! It is usually best to quit after an error, to make sure the error message
138 ! is not overlooked in the program's output
139 error stop
140 end subroutine handle_error
141
142 !> Return the index of the variable with name 'var_name', or -1 if not found.
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
147 integer :: i
148
149 if (cfg%sorted) then
150 call binary_search_variable(cfg, var_name, ix)
151 else
152 ! Linear search
153 do i = 1, cfg%num_vars
154 if (cfg%vars(i)%var_name == var_name) exit
155 end do
156
157 ! If not found, set i to -1
158 if (i == cfg%num_vars + 1) i = -1
159 ix = i
160 end if
161
162 end subroutine get_var_index
163
164 !> Update the variables in the configartion with the values found in 'filename'
165 subroutine cfg_read_file(cfg, filename)
166 type(cfg_t), intent(inout) :: cfg
167 character(len=*), intent(in) :: filename
168
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
176
177 open(my_unit, file=trim(filename), status = "OLD", &
178 action="READ", err=998, iostat=io_state)
179 line_number = 0
180
181 write(line_fmt, "(A,I0,A)") "(A", cfg_string_len, ")"
182
183 ! Default category is empty
184 category = ""
185
186 do
187 read(my_unit, fmt=trim(line_fmt), err=998, end=999) line
188 line_number = line_number + 1
189
190 call trim_comment(line, '#')
191
192 ! Skip empty lines
193 if (line == "") cycle
194
195 ! Locate the '=' sign
196 equal_sign_ix = scan(line, '=')
197
198 ! if there is no '='-sign then a category is indicated
199 if (equal_sign_ix == 0) then
200 line = adjustl(line)
201
202 ! The category name should appear like this: [category_name]
203 ix = scan(line, ']')
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)
208 else
209 category = line(2:ix-1)
210 cycle
211 end if
212 end if
213
214 var_name = line(1 : equal_sign_ix - 1) ! Set variable name
215
216 ! If there is no indent, reset to no category
217 if (var_name(1:1) /= " " .and. var_name(1:1) /= char(9)) then
218 category = ""
219 end if
220
221 ! Remove leading blanks
222 var_name = adjustl(var_name)
223
224 ! Add category if it is defined
225 if (category /= "") then
226 var_name = trim(category) // cfg_category_separator // var_name
227 end if
228
229 line = line(equal_sign_ix + 1:) ! Set line to the values behind the '=' sign
230 line = adjustl(line) ! Remove leading blanks
231
232 ! Find variable corresponding to name in file
233 call get_var_index(cfg, var_name, ix)
234
235 if (ix <= 0) then
236 ! Variable still needs to be created, for now store data as a string
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
240 else
241 cfg%vars(ix)%stored_data = line
242 call read_variable(cfg%vars(ix))
243 end if
244 end do
245
246998 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)
249
250 ! Routine ends here if the end of "filename" is reached
251999 close(my_unit, iostat=io_state)
252
253 end subroutine cfg_read_file
254
255 subroutine read_variable(var)
256 type(cfg_var_t), intent(inout) :: var
257 integer :: n, n_entries
258 integer :: ix_start(cfg_max_array_size)
259 integer :: ix_end(cfg_max_array_size)
260
261 ! Get the start and end positions of the line content, and the number of entries
262 call get_fields_string(var%stored_data, cfg_separators, &
263 cfg_max_array_size, n_entries, ix_start, ix_end)
264
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")
269 else
270 var%var_size = n_entries
271 call resize_storage(var)
272 end if
273 end if
274
275 do n = 1, n_entries
276 select case (var%var_type)
277 case (cfg_integer_type)
278 read(var%stored_data(ix_start(n):ix_end(n)), *) var%int_data(n)
279 case (cfg_real_type)
280 read(var%stored_data(ix_start(n):ix_end(n)), *) var%real_data(n)
281 case (cfg_string_type)
282 var%char_data(n) = trim(var%stored_data(ix_start(n):ix_end(n)))
283 case (cfg_logic_type)
284 read(var%stored_data(ix_start(n):ix_end(n)), *) var%logic_data(n)
285 end select
286 end do
287 end subroutine read_variable
288
289 subroutine trim_comment(line, comment_chars)
290 character(len=*), intent(inout) :: line
291 character(len=*), intent(in) :: comment_chars
292 integer :: n
293 character :: current_char, need_char
294
295 ! Strip comments, but only outside quoted strings (so that var = '#yolo' is
296 ! valid when # is a comment char)
297 need_char = ""
298
299 do n = 1, len(line)
300 current_char = line(n:n)
301
302 if (need_char == "") then
303 if (current_char == "'") then
304 need_char = "'" ! Open string
305 else if (current_char == '"') then
306 need_char = '"' ! Open string
307 else if (index(current_char, comment_chars) /= 0) then
308 line = line(1:n-1) ! Trim line up to comment character
309 exit
310 end if
311 else if (current_char == need_char) then
312 need_char = "" ! Close string
313 end if
314
315 end do
316
317 end subroutine trim_comment
318
319 subroutine cfg_check(cfg)
320 type(cfg_t), intent(in) :: cfg
321 integer :: n
322 character(len=CFG_string_len) :: err_string
323
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)
329 end if
330 end do
331 end subroutine cfg_check
332
333 !> This routine writes the current configuration to a file with descriptions
334 subroutine cfg_write(cfg_in, filename, hide_unused)
335 use iso_fortran_env
336 type(cfg_t), intent(in) :: cfg_in
337 character(len=*), intent(in) :: filename
338 logical, intent(in), optional :: hide_unused
339
340 type(cfg_t) :: cfg
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
346
347 hide_not_used = .false.
348 if (present(hide_unused)) hide_not_used = hide_unused
349
350 ! Always print a sorted configuration
351 cfg = cfg_in
352 if (.not. cfg%sorted) call cfg_sort(cfg)
353
354 write(name_format, fmt="(A,I0,A)") "(A,A", cfg_name_len, ",A)"
355
356 if (filename == "stdout") then
357 myunit = output_unit
358 else
359 myunit = 333
360 open(myunit, file=filename, action="WRITE", err=999, iostat=io_state)
361 end if
362
363 category = ""
364 prev_category = ""
365
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
369
370 ! Write category when it changes
371 call split_category(cfg%vars(i), category, var_name)
372
373 if (category /= prev_category .and. category /= '') then
374 write(myunit, err=998, fmt="(A)") '[' // trim(category) // ']'
375 prev_category = category
376 end if
377
378 ! Indent if inside 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) // " ="
384 else
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) // " ="
389 end if
390
391 select case(cfg%vars(i)%var_type)
392 case (cfg_integer_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)
396 end do
397 case (cfg_real_type)
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)
401 end do
402 case (cfg_string_type)
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)) // "'"
406 end do
407 case (cfg_logic_type)
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)
411 end do
412 end select
413 write(myunit, err=998, fmt="(A)") ""
414 write(myunit, err=998, fmt="(A)") ""
415 end do
416
417 if (myunit /= output_unit) close(myunit, err=999, iostat=io_state)
418 call cfg_check(cfg_in)
419 return
420
421998 continue
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)
425
426999 continue ! If there was an error, the routine will end here
427 write(err_string, *) "CFG_write error: io_state = ", io_state, &
428 " while writing to ", filename
429 call handle_error(err_string)
430
431 end subroutine cfg_write
432
433 !> This routine writes the current configuration to a markdown file
434 subroutine cfg_write_markdown(cfg_in, filename, hide_unused)
435 use iso_fortran_env
436 type(cfg_t), intent(in) :: cfg_in
437 character(len=*), intent(in) :: filename
438 logical, intent(in), optional :: hide_unused
439
440 type(cfg_t) :: cfg
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
446
447 hide_not_used = .false.
448 if (present(hide_unused)) hide_not_used = hide_unused
449
450 ! Always print a sorted configuration
451 cfg = cfg_in
452 if (.not. cfg%sorted) call cfg_sort(cfg)
453
454 write(name_format, fmt="(A,I0,A)") "(A,A", cfg_name_len, ",A)"
455
456 if (filename == "stdout") then
457 myunit = output_unit
458 else
459 myunit = 333
460 open(myunit, file=filename, action="WRITE", err=999, iostat=io_state)
461 end if
462
463 category = ""
464 prev_category = "X"
465 write(myunit, err=998, fmt="(A)") "# Configuration file (markdown format)"
466 write(myunit, err=998, fmt="(A)") ""
467
468 do i = 1, cfg%num_vars
469
470 if (.not. cfg%vars(i)%used .and. hide_not_used) cycle
471 if (cfg%vars(i)%var_type == cfg_unknown_type) cycle
472
473 ! Write category when it changes
474 call split_category(cfg%vars(i), category, var_name)
475
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
481 end if
482
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) // " ="
487
488 select case(cfg%vars(i)%var_type)
489 case (cfg_integer_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)
493 end do
494 case (cfg_real_type)
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)
498 end do
499 case (cfg_string_type)
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)) // "'"
503 end do
504 case (cfg_logic_type)
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)
508 end do
509 end select
510 write(myunit, err=998, fmt="(A)") ""
511 write(myunit, err=998, fmt="(A)") ""
512 end do
513
514 if (myunit /= output_unit) close(myunit, err=999, iostat=io_state)
515 call cfg_check(cfg_in)
516 return
517
518998 continue
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)
522
523999 continue ! If there was an error, the routine will end here
524 write(err_string, *) "CFG_write_markdown error: io_state = ", io_state, &
525 " while writing to ", filename
526 call handle_error(err_string)
527
528 end subroutine cfg_write_markdown
529
530 subroutine split_category(variable, category, var_name)
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
534 integer :: ix
535
536 ix = index(variable%var_name, cfg_category_separator)
537
538 if (ix == 0) then
539 category = ""
540 var_name = variable%var_name
541 else
542 category = variable%var_name(1:ix-1)
543 var_name = variable%var_name(ix+1:)
544 end if
545
546 end subroutine split_category
547
548 !> Resize the storage size of variable, which can be of type integer, logical,
549 !> real or character
550 subroutine resize_storage(variable)
551 type(cfg_var_t), intent(inout) :: variable
552
553 select case (variable%var_type)
554 case (cfg_integer_type)
555 deallocate( variable%int_data )
556 allocate( variable%int_data(variable%var_size) )
557 case (cfg_logic_type)
558 deallocate( variable%logic_data )
559 allocate( variable%logic_data(variable%var_size) )
560 case (cfg_real_type)
561 deallocate( variable%real_data )
562 allocate( variable%real_data(variable%var_size) )
563 case (cfg_string_type)
564 deallocate( variable%char_data )
565 allocate( variable%char_data(variable%var_size) )
566 end select
567 end subroutine resize_storage
568
569 !> Helper routine to store variables. This is useful because a lot of the same
570 !> code is executed for the different types of variables.
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 !< Index of variable
577 logical, intent(in), optional :: dynamic_size
578
579 ! Check if variable already exists
580 call get_var_index(cfg, var_name, ix)
581
582 if (ix == -1) then ! Create a new variable
583 call ensure_free_storage(cfg)
584 cfg%sorted = .false.
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 = ""
589 else
590 ! Only allowed when the variable is not yet created
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")
594 end if
595 end if
596
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
601
602 if (present(dynamic_size)) then
603 cfg%vars(ix)%dynamic_size = dynamic_size
604 else
605 cfg%vars(ix)%dynamic_size = .false.
606 end if
607
608 select case (var_type)
609 case (cfg_integer_type)
610 allocate( cfg%vars(ix)%int_data(var_size) )
611 case (cfg_real_type)
612 allocate( cfg%vars(ix)%real_data(var_size) )
613 case (cfg_string_type)
614 allocate( cfg%vars(ix)%char_data(var_size) )
615 case (cfg_logic_type)
616 allocate( cfg%vars(ix)%logic_data(var_size) )
617 end select
618
619 end subroutine prepare_store_var
620
621 !> Helper routine to get variables. This is useful because a lot of the same
622 !> code is executed for the different types of variables.
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
629
630 call get_var_index(cfg, var_name, ix)
631
632 if (ix == -1) then
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 (" // &
637 trim(cfg_type_names(cfg%vars(ix)%var_type)) // &
638 ") than requested (" // trim(cfg_type_names(var_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)
645 else ! All good, variable will be used
646 cfg%vars(ix)%used = .true.
647 end if
648 end subroutine prepare_get_var
649
650 !> Add a configuration variable with a real value
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
655 integer :: ix
656
657 call prepare_store_var(cfg, var_name, cfg_real_type, 1, comment, ix)
658
659 if (cfg%vars(ix)%stored_data /= "") then
660 call read_variable(cfg%vars(ix))
661 else
662 cfg%vars(ix)%real_data(1) = real_data
663 end if
664 end subroutine add_real
665
666 !> Add a configuration variable with an array of type
667 ! 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
673 integer :: ix
674
675 call prepare_store_var(cfg, var_name, cfg_real_type, &
676 size(real_data), comment, ix, dynamic_size)
677
678 if (cfg%vars(ix)%stored_data /= "") then
679 call read_variable(cfg%vars(ix))
680 else
681 cfg%vars(ix)%real_data = real_data
682 end if
683 end subroutine add_real_array
684
685 !> Add a configuration variable with an integer value
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
690 integer :: ix
691
692 call prepare_store_var(cfg, var_name, cfg_integer_type, 1, comment, ix)
693
694 if (cfg%vars(ix)%stored_data /= "") then
695 call read_variable(cfg%vars(ix))
696 else
697 cfg%vars(ix)%int_data(1) = int_data
698 end if
699 end subroutine add_int
700
701 !> Add a configuration variable with an array of type integer
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
707 integer :: ix
708
709 call prepare_store_var(cfg, var_name, cfg_integer_type, &
710 size(int_data), comment, ix, dynamic_size)
711
712 if (cfg%vars(ix)%stored_data /= "") then
713 call read_variable(cfg%vars(ix))
714 else
715 cfg%vars(ix)%int_data = int_data
716 end if
717 end subroutine add_int_array
718
719 !> Add a configuration variable with an character value
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
723 integer :: ix
724
725 call prepare_store_var(cfg, var_name, cfg_string_type, 1, comment, ix)
726 if (cfg%vars(ix)%stored_data /= "") then
727 call read_variable(cfg%vars(ix))
728 else
729 cfg%vars(ix)%char_data(1) = char_data
730 end if
731 end subroutine add_string
732
733 !> Add a configuration variable with an array of type character
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
739 integer :: ix
740
741 call prepare_store_var(cfg, var_name, cfg_string_type, &
742 size(char_data), comment, ix, dynamic_size)
743
744 if (cfg%vars(ix)%stored_data /= "") then
745 call read_variable(cfg%vars(ix))
746 else
747 cfg%vars(ix)%char_data = char_data
748 end if
749 end subroutine add_string_array
750
751 !> Add a configuration variable with an logical value
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
756 integer :: ix
757
758 call prepare_store_var(cfg, var_name, cfg_logic_type, 1, comment, ix)
759
760 if (cfg%vars(ix)%stored_data /= "") then
761 call read_variable(cfg%vars(ix))
762 else
763 cfg%vars(ix)%logic_data(1) = logic_data
764 end if
765 end subroutine add_logic
766
767 !> Add a configuration variable with an array of type logical
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
774 integer :: ix
775
776 call prepare_store_var(cfg, var_name, cfg_logic_type, &
777 size(logic_data), comment, ix, dynamic_size)
778
779 if (cfg%vars(ix)%stored_data /= "") then
780 call read_variable(cfg%vars(ix))
781 else
782 cfg%vars(ix)%logic_data = logic_data
783 end if
784 end subroutine add_logic_array
785
786 !> Get a real array of a given name
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(:)
791 integer :: ix
792
793 call prepare_get_var(cfg, var_name, cfg_real_type, &
794 size(real_data), ix)
795 real_data = cfg%vars(ix)%real_data
796 end subroutine get_real_array
797
798 !> Get a integer array of a given name
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(:)
803 integer :: ix
804
805 call prepare_get_var(cfg, var_name, cfg_integer_type, &
806 size(int_data), ix)
807 int_data = cfg%vars(ix)%int_data
808 end subroutine get_int_array
809
810 !> Get a character array of a given name
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(:)
815 integer :: ix
816
817 call prepare_get_var(cfg, var_name, cfg_string_type, &
818 size(char_data), ix)
819 char_data = cfg%vars(ix)%char_data
820 end subroutine get_string_array
821
822 !> Get a logical array of a given name
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(:)
827 integer :: ix
828
829 call prepare_get_var(cfg, var_name, cfg_logic_type, &
830 size(logic_data), ix)
831 logic_data = cfg%vars(ix)%logic_data
832 end subroutine get_logic_array
833
834 !> Get a real value of a given name
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
839 integer :: ix
840
841 call prepare_get_var(cfg, var_name, cfg_real_type, 1, ix)
842 res = cfg%vars(ix)%real_data(1)
843 end subroutine get_real
844
845 !> Get a integer value of a given name
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
850 integer :: ix
851
852 call prepare_get_var(cfg, var_name, cfg_integer_type, 1, ix)
853 res = cfg%vars(ix)%int_data(1)
854 end subroutine get_int
855
856 !> Get a logical value of a given name
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
861 integer :: ix
862
863 call prepare_get_var(cfg, var_name, cfg_logic_type, 1, ix)
864 res = cfg%vars(ix)%logic_data(1)
865 end subroutine get_logic
866
867 !> Get a character value of a given name
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
872 integer :: ix
873
874 call prepare_get_var(cfg, var_name, cfg_string_type, 1, ix)
875 res = cfg%vars(ix)%char_data(1)
876 end subroutine get_string
877
878 !> Get or add a real array of a given name
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
885
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
889
890 !> Get or add a integer array of a given name
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
897
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
901
902 !> Get or add a character array of a given name
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
909
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
913
914 !> Get or add a logical array of a given name
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
921
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
925
926 !> Get or add a real value of a given name
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
931
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
935
936 !> Get or add a integer value of a given name
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
941
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
945
946 !> Get or add a logical value of a given name
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
951
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
955
956 !> Get a character value of a given name
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
961
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
965
966 !> Get the size of a variable
967 subroutine cfg_get_size(cfg, var_name, res)
968 type(cfg_t), intent(in) :: cfg
969 character(len=*), intent(in) :: var_name
970 integer, intent(out) :: res
971 integer :: ix
972
973 call get_var_index(cfg, var_name, ix)
974 if (ix /= -1) then
975 res = cfg%vars(ix)%var_size
976 else
977 res = -1
978 call handle_error("CFG_get_size: variable ["//var_name//"] not found")
979 end if
980 end subroutine cfg_get_size
981
982 !> Get the type of a given variable of a configuration type
983 subroutine cfg_get_type(cfg, var_name, res)
984 type(cfg_t), intent(in) :: cfg
985 character(len=*), intent(in) :: var_name
986 integer, intent(out) :: res
987 integer :: ix
988
989 call get_var_index(cfg, var_name, ix)
990
991 if (ix /= -1) then
992 res = cfg%vars(ix)%var_type
993 else
994 res = -1
995 call handle_error("CFG_get_type: variable ["//var_name//"] not found")
996 end if
997 end subroutine cfg_get_type
998
999 !> Routine to ensure that enough storage is allocated for the configuration
1000 !> type. If not the new size will be twice as much as the current size. If no
1001 !> storage is allocated yet a minumum amount of starage is allocated.
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
1007
1008 if (allocated(cfg%vars)) then
1009 cur_size = size(cfg%vars)
1010
1011 if (cur_size < cfg%num_vars + 1) then
1012 new_size = 2 * cur_size
1013 allocate(cfg_copy(cur_size))
1014 cfg_copy = cfg%vars
1015 deallocate(cfg%vars)
1016 allocate(cfg%vars(new_size))
1017 cfg%vars(1:cur_size) = cfg_copy
1018 end if
1019 else
1020 allocate(cfg%vars(min_dyn_size))
1021 end if
1022
1023 end subroutine ensure_free_storage
1024
1025 !> Routine to find the indices of entries in a string
1026 subroutine get_fields_string(line, delims, n_max, n_found, ixs_start, ixs_end)
1027 !> The line from which we want to read
1028 character(len=*), intent(in) :: line
1029 !> A string with delimiters. For example delims = " ,'"""//char(9)
1030 character(len=*), intent(in) :: delims
1031 !> Maximum number of entries to read in
1032 integer, intent(in) :: n_max
1033 !> Number of entries found
1034 integer, intent(inout) :: n_found
1035 !> On return, ix_start(i) holds the starting point of entry i
1036 integer, intent(inout) :: ixs_start(n_max)
1037 !> On return, ix_end(i) holds the end point of entry i
1038 integer, intent(inout) :: ixs_end(n_max)
1039
1040 integer :: ix, ix_prev
1041
1042 ix_prev = 0
1043 n_found = 0
1044
1045 do while (n_found < n_max)
1046
1047 ! Find the starting point of the next entry (a non-delimiter value)
1048 ix = verify(line(ix_prev+1:), delims)
1049 if (ix == 0) exit
1050
1051 n_found = n_found + 1
1052 ixs_start(n_found) = ix_prev + ix ! This is the absolute position in 'line'
1053
1054 ! Get the end point of the current entry (next delimiter index minus one)
1055 ix = scan(line(ixs_start(n_found)+1:), delims) - 1
1056
1057 if (ix == -1) then ! If there is no last delimiter,
1058 ixs_end(n_found) = len(line) ! the end of the line is the endpoint
1059 else
1060 ixs_end(n_found) = ixs_start(n_found) + ix
1061 end if
1062
1063 ix_prev = ixs_end(n_found) ! We continue to search from here
1064 end do
1065
1066 end subroutine get_fields_string
1067
1068 !> Performa a binary search for the variable 'var_name'
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
1074
1075 i_min = 1
1076 i_max = cfg%num_vars
1077 ix = - 1
1078
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
1082 i_min = i_mid + 1
1083 else
1084 i_max = i_mid
1085 end if
1086 end do
1087
1088 ! If not found, binary_search_variable is not set here, and stays -1
1089 if (i_max == i_min .and. cfg%vars(i_min)%var_name == var_name) then
1090 ix = i_min
1091 else
1092 ix = -1
1093 end if
1094 end subroutine binary_search_variable
1095
1096 !> Sort the variables for faster lookup
1097 subroutine cfg_sort(cfg)
1098 type(cfg_t), intent(inout) :: cfg
1099
1100 call qsort_config(cfg%vars(1:cfg%num_vars))
1101 cfg%sorted = .true.
1102 end subroutine cfg_sort
1103
1104 !> Simple implementation of quicksort algorithm to sort the variable list alphabetically.
1105 recursive subroutine qsort_config(list)
1106 type(cfg_var_t), intent(inout) :: list(:)
1107 integer :: split_pos
1108
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:) )
1113 end if
1114 end subroutine qsort_config
1115
1116 !> Helper routine for quicksort, to perform partitioning
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
1123
1124 left = 0
1125 right = size(list) + 1
1126
1127 ! Take the middle element as pivot
1128 pivot_ix = size(list) / 2
1129 pivot_value = list(pivot_ix)%var_name
1130
1131 do while (left < right)
1132
1133 right = right - 1
1134 do while (lgt(list(right)%var_name, pivot_value))
1135 right = right - 1
1136 end do
1137
1138 left = left + 1
1139 do while (lgt(pivot_value, list(left)%var_name))
1140 left = left + 1
1141 end do
1142
1143 if (left < right) then
1144 temp = list(left)
1145 list(left) = list(right)
1146 list(right) = temp
1147 end if
1148 end do
1149
1150 if (left == right) then
1151 marker = left + 1
1152 else
1153 marker = left
1154 end if
1155 end subroutine parition_var_list
1156
1157end module mod_config
Interface to get variables from the configuration.
Definition mod_config.t:83
Interface to add variables to the configuration.
Definition mod_config.t:67
Interface to get variables from the configuration.
Definition mod_config.t:75
Module that allows working with a configuration file.
Definition mod_config.t:2
subroutine, public cfg_get_size(cfg, var_name, res)
Get the size of a variable.
Definition mod_config.t:968
integer, parameter, public cfg_real_type
Real number type.
Definition mod_config.t:12
integer, parameter, public cfg_string_type
String type.
Definition mod_config.t:13
subroutine, public cfg_read_file(cfg, filename)
Update the variables in the configartion with the values found in 'filename'.
Definition mod_config.t:166
integer, parameter, public cfg_name_len
Maximum length of variable names.
Definition mod_config.t:17
integer, parameter, public cfg_string_len
Fixed length of string type.
Definition mod_config.t:18
subroutine, public cfg_check(cfg)
Definition mod_config.t:320
subroutine, public cfg_get_type(cfg, var_name, res)
Get the type of a given variable of a configuration type.
Definition mod_config.t:984
subroutine, public cfg_update_from_arguments(cfg)
Definition mod_config.t:119
integer, parameter, public cfg_logic_type
Boolean/logical type.
Definition mod_config.t:14
subroutine, public cfg_write(cfg_in, filename, hide_unused)
This routine writes the current configuration to a file with descriptions.
Definition mod_config.t:335
integer, parameter, public cfg_max_array_size
Maximum number of entries in a variable (if it's an array)
Definition mod_config.t:25
subroutine, public cfg_write_markdown(cfg_in, filename, hide_unused)
This routine writes the current configuration to a markdown file.
Definition mod_config.t:435
subroutine, public cfg_sort(cfg)
Sort the variables for faster lookup.
integer, parameter, public cfg_integer_type
Integer type.
Definition mod_config.t:11
character(len=10), dimension(0:cfg_num_types), parameter, public cfg_type_names
Names of the types.
Definition mod_config.t:21
The configuration that contains all the variables.
Definition mod_config.t:60