MPI-AMRVAC  3.1
The MPI - Adaptive Mesh Refinement - Versatile Advection Code (development version)
mod_config.t
Go to the documentation of this file.
1 !> Module that allows working with a configuration file
2 module mod_config
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
114  public :: cfg_update_from_arguments
115 
116 contains
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 
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)
249 
250  ! Routine ends here if the end of "filename" is reached
251 999 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 
421 998 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 
426 999 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 
518 998 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 
523 999 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 
1157 end module mod_config
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
subroutine split_category(variable, category, var_name)
Definition: mod_config.t:531
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.
Definition: mod_config.t:1098
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