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  !> Names of the types
18  character(len=10), parameter :: cfg_type_names(0:cfg_num_types) = &
19  [character(len=10) :: "storage", "integer", "real", "string ", "logical"]
20 
21  integer, parameter :: cfg_name_len = 80 !< Maximum length of variable names
22  integer, parameter :: cfg_string_len = 200 !< Fixed length of string type
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  !> Name of the variable
37  character(len=CFG_name_len) :: var_name
38  !> Description of variable
39  character(len=CFG_string_len) :: description
40  !> Type of variable
41  integer :: var_type
42  !> Size of variable, 1 means scalar, > 1 means array
43  integer :: var_size
44  !> Whether the variable size is flexible
45  logical :: dynamic_size
46  !> Whether the variable's value has been requested
47  logical :: used
48  !> Data that has been read in for this variable
49  character(len=CFG_string_len) :: stored_data
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  logical :: sorted = .false.
62  integer :: num_vars = 0
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  character :: current_char, need_char
293  integer :: n
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  logical :: hide_not_used
340  type(cfg_t) :: cfg
341  integer :: i, j, io_state, myunit
342  character(len=CFG_name_len) :: name_format, var_name
343  character(len=CFG_name_len) :: category, prev_category
344  character(len=CFG_string_len) :: err_string
345 
346  hide_not_used = .false.
347  if (present(hide_unused)) hide_not_used = hide_unused
348 
349  ! Always print a sorted configuration
350  cfg = cfg_in
351  if (.not. cfg%sorted) call cfg_sort(cfg)
352 
353  write(name_format, fmt="(A,I0,A)") "(A,A", cfg_name_len, ",A)"
354 
355  if (filename == "stdout") then
356  myunit = output_unit
357  else
358  myunit = 333
359  open(myunit, file=filename, action="WRITE", err=999, iostat=io_state)
360  end if
361 
362  category = ""
363  prev_category = ""
364 
365  do i = 1, cfg%num_vars
366  if (.not. cfg%vars(i)%used .and. hide_not_used) cycle
367  if (cfg%vars(i)%var_type == cfg_unknown_type) cycle
368 
369  ! Write category when it changes
370  call split_category(cfg%vars(i), category, var_name)
371 
372  if (category /= prev_category .and. category /= '') then
373  write(myunit, err=998, fmt="(A)") '[' // trim(category) // ']'
374  prev_category = category
375  end if
376 
377  ! Indent if inside category
378  if (category /= "") then
379  write(myunit, err=998, fmt="(A,A,A)") " # ", &
380  trim(cfg%vars(i)%description), ":"
381  write(myunit, advance="NO", err=998, fmt="(A)") &
382  " " // trim(var_name) // " ="
383  else
384  write(myunit, err=998, fmt="(A,A,A)") "# ", &
385  trim(cfg%vars(i)%description), ":"
386  write(myunit, advance="NO", err=998, fmt="(A)") &
387  trim(var_name) // " ="
388  end if
389 
390  select case(cfg%vars(i)%var_type)
391  case (cfg_integer_type)
392  do j = 1, cfg%vars(i)%var_size
393  write(myunit, advance="NO", err=998, fmt="(A,I0)") &
394  " ", cfg%vars(i)%int_data(j)
395  end do
396  case (cfg_real_type)
397  do j = 1, cfg%vars(i)%var_size
398  write(myunit, advance="NO", err=998, fmt="(A,E11.4)") &
399  " ", cfg%vars(i)%real_data(j)
400  end do
401  case (cfg_string_type)
402  do j = 1, cfg%vars(i)%var_size
403  write(myunit, advance="NO", err=998, fmt="(A)") &
404  " '" // trim(cfg%vars(i)%char_data(j)) // "'"
405  end do
406  case (cfg_logic_type)
407  do j = 1, cfg%vars(i)%var_size
408  write(myunit, advance="NO", err=998, fmt="(A,L1)") &
409  " ", cfg%vars(i)%logic_data(j)
410  end do
411  end select
412  write(myunit, err=998, fmt="(A)") ""
413  write(myunit, err=998, fmt="(A)") ""
414  end do
415 
416  if (myunit /= output_unit) close(myunit, err=999, iostat=io_state)
417  call cfg_check(cfg_in)
418  return
419 
420 998 continue
421  write(err_string, *) "CFG_write error: io_state = ", io_state, &
422  " while writing ", trim(var_name), " to ", filename
423  call handle_error(err_string)
424 
425 999 continue ! If there was an error, the routine will end here
426  write(err_string, *) "CFG_write error: io_state = ", io_state, &
427  " while writing to ", filename
428  call handle_error(err_string)
429 
430  end subroutine cfg_write
431 
432  !> This routine writes the current configuration to a markdown file
433  subroutine cfg_write_markdown(cfg_in, filename, hide_unused)
434  use iso_fortran_env
435  type(cfg_t), intent(in) :: cfg_in
436  character(len=*), intent(in) :: filename
437  logical, intent(in), optional :: hide_unused
438  logical :: hide_not_used
439  integer :: i, j, io_state, myunit
440  type(cfg_t) :: cfg
441  character(len=CFG_name_len) :: name_format, var_name
442  character(len=CFG_name_len) :: category, prev_category
443  character(len=CFG_string_len) :: err_string
444 
445  hide_not_used = .false.
446  if (present(hide_unused)) hide_not_used = hide_unused
447 
448  ! Always print a sorted configuration
449  cfg = cfg_in
450  if (.not. cfg%sorted) call cfg_sort(cfg)
451 
452  write(name_format, fmt="(A,I0,A)") "(A,A", cfg_name_len, ",A)"
453 
454  if (filename == "stdout") then
455  myunit = output_unit
456  else
457  myunit = 333
458  open(myunit, file=filename, action="WRITE", err=999, iostat=io_state)
459  end if
460 
461  category = ""
462  prev_category = "X"
463  write(myunit, err=998, fmt="(A)") "# Configuration file (markdown format)"
464  write(myunit, err=998, fmt="(A)") ""
465 
466  do i = 1, cfg%num_vars
467 
468  if (.not. cfg%vars(i)%used .and. hide_not_used) cycle
469  if (cfg%vars(i)%var_type == cfg_unknown_type) cycle
470 
471  ! Write category when it changes
472  call split_category(cfg%vars(i), category, var_name)
473 
474  if (category /= prev_category) then
475  if (category == "") category = "No category"
476  write(myunit, err=998, fmt="(A)") '## ' // trim(category)
477  write(myunit, err=998, fmt="(A)") ""
478  prev_category = category
479  end if
480 
481  write(myunit, err=998, fmt="(A)") "* " // trim(cfg%vars(i)%description)
482  write(myunit, err=998, fmt="(A)") ""
483  write(myunit, advance="NO", err=998, fmt="(A)") &
484  ' ' // trim(var_name) // " ="
485 
486  select case(cfg%vars(i)%var_type)
487  case (cfg_integer_type)
488  do j = 1, cfg%vars(i)%var_size
489  write(myunit, advance="NO", err=998, fmt="(A,I0)") &
490  " ", cfg%vars(i)%int_data(j)
491  end do
492  case (cfg_real_type)
493  do j = 1, cfg%vars(i)%var_size
494  write(myunit, advance="NO", err=998, fmt="(A,E11.4)") &
495  " ", cfg%vars(i)%real_data(j)
496  end do
497  case (cfg_string_type)
498  do j = 1, cfg%vars(i)%var_size
499  write(myunit, advance="NO", err=998, fmt="(A)") &
500  " '" // trim(cfg%vars(i)%char_data(j)) // "'"
501  end do
502  case (cfg_logic_type)
503  do j = 1, cfg%vars(i)%var_size
504  write(myunit, advance="NO", err=998, fmt="(A,L1)") &
505  " ", cfg%vars(i)%logic_data(j)
506  end do
507  end select
508  write(myunit, err=998, fmt="(A)") ""
509  write(myunit, err=998, fmt="(A)") ""
510  end do
511 
512  if (myunit /= output_unit) close(myunit, err=999, iostat=io_state)
513  call cfg_check(cfg_in)
514  return
515 
516 998 continue
517  write(err_string, *) "CFG_write_markdown error: io_state = ", io_state, &
518  " while writing ", trim(var_name), " to ", filename
519  call handle_error(err_string)
520 
521 999 continue ! If there was an error, the routine will end here
522  write(err_string, *) "CFG_write_markdown error: io_state = ", io_state, &
523  " while writing to ", filename
524  call handle_error(err_string)
525 
526  end subroutine cfg_write_markdown
527 
528  subroutine split_category(variable, category, var_name)
529  type(cfg_var_t), intent(in) :: variable
530  character(CFG_name_len), intent(out) :: category
531  character(CFG_name_len), intent(out) :: var_name
532  integer :: ix
533 
534  ix = index(variable%var_name, cfg_category_separator)
535 
536  if (ix == 0) then
537  category = ""
538  var_name = variable%var_name
539  else
540  category = variable%var_name(1:ix-1)
541  var_name = variable%var_name(ix+1:)
542  end if
543 
544  end subroutine split_category
545 
546  !> Resize the storage size of variable, which can be of type integer, logical,
547  !> real or character
548  subroutine resize_storage(variable)
549  type(cfg_var_t), intent(inout) :: variable
550 
551  select case (variable%var_type)
552  case (cfg_integer_type)
553  deallocate( variable%int_data )
554  allocate( variable%int_data(variable%var_size) )
555  case (cfg_logic_type)
556  deallocate( variable%logic_data )
557  allocate( variable%logic_data(variable%var_size) )
558  case (cfg_real_type)
559  deallocate( variable%real_data )
560  allocate( variable%real_data(variable%var_size) )
561  case (cfg_string_type)
562  deallocate( variable%char_data )
563  allocate( variable%char_data(variable%var_size) )
564  end select
565  end subroutine resize_storage
566 
567  !> Helper routine to store variables. This is useful because a lot of the same
568  !> code is executed for the different types of variables.
569  subroutine prepare_store_var(cfg, var_name, var_type, var_size, &
570  description, ix, dynamic_size)
571  type(cfg_t), intent(inout) :: cfg
572  character(len=*), intent(in) :: var_name, description
573  integer, intent(in) :: var_type, var_size
574  integer, intent(out) :: ix !< Index of variable
575  logical, intent(in), optional :: dynamic_size
576 
577  ! Check if variable already exists
578  call get_var_index(cfg, var_name, ix)
579 
580  if (ix == -1) then ! Create a new variable
581  call ensure_free_storage(cfg)
582  cfg%sorted = .false.
583  ix = cfg%num_vars + 1
584  cfg%num_vars = cfg%num_vars + 1
585  cfg%vars(ix)%used = .false.
586  cfg%vars(ix)%stored_data = ""
587  else
588  ! Only allowed when the variable is not yet created
589  if (cfg%vars(ix)%var_type /= cfg_unknown_type) then
590  call handle_error("prepare_store_var: variable [" // &
591  & trim(var_name) // "] already exists")
592  end if
593  end if
594 
595  cfg%vars(ix)%var_name = var_name
596  cfg%vars(ix)%description = description
597  cfg%vars(ix)%var_type = var_type
598  cfg%vars(ix)%var_size = var_size
599 
600  if (present(dynamic_size)) then
601  cfg%vars(ix)%dynamic_size = dynamic_size
602  else
603  cfg%vars(ix)%dynamic_size = .false.
604  end if
605 
606  select case (var_type)
607  case (cfg_integer_type)
608  allocate( cfg%vars(ix)%int_data(var_size) )
609  case (cfg_real_type)
610  allocate( cfg%vars(ix)%real_data(var_size) )
611  case (cfg_string_type)
612  allocate( cfg%vars(ix)%char_data(var_size) )
613  case (cfg_logic_type)
614  allocate( cfg%vars(ix)%logic_data(var_size) )
615  end select
616 
617  end subroutine prepare_store_var
618 
619  !> Helper routine to get variables. This is useful because a lot of the same
620  !> code is executed for the different types of variables.
621  subroutine prepare_get_var(cfg, var_name, var_type, var_size, ix)
622  type(cfg_t), intent(inout) :: cfg
623  character(len=*), intent(in) :: var_name
624  integer, intent(in) :: var_type, var_size
625  integer, intent(out) :: ix
626  character(len=CFG_string_len) :: err_string
627 
628  call get_var_index(cfg, var_name, ix)
629 
630  if (ix == -1) then
631  call handle_error("CFG_get: variable ["//var_name//"] not found")
632  else if (cfg%vars(ix)%var_type /= var_type) then
633  write(err_string, fmt="(A)") "CFG_get: variable [" &
634  // var_name // "] has different type (" // &
635  trim(cfg_type_names(cfg%vars(ix)%var_type)) // &
636  ") than requested (" // trim(cfg_type_names(var_type)) // ")"
637  call handle_error(err_string)
638  else if (cfg%vars(ix)%var_size /= var_size) then
639  write(err_string, fmt="(A,I0,A,I0,A)") "CFG_get: variable [" &
640  // var_name // "] has different size (", cfg%vars(ix)%var_size, &
641  ") than requested (", var_size, ")"
642  call handle_error(err_string)
643  else ! All good, variable will be used
644  cfg%vars(ix)%used = .true.
645  end if
646  end subroutine prepare_get_var
647 
648  !> Add a configuration variable with a real value
649  subroutine add_real(cfg, var_name, real_data, comment)
650  type(cfg_t), intent(inout) :: cfg
651  character(len=*), intent(in) :: var_name, comment
652  real(dp), intent(in) :: real_data
653  integer :: ix
654 
655  call prepare_store_var(cfg, var_name, cfg_real_type, 1, comment, ix)
656 
657  if (cfg%vars(ix)%stored_data /= "") then
658  call read_variable(cfg%vars(ix))
659  else
660  cfg%vars(ix)%real_data(1) = real_data
661  end if
662  end subroutine add_real
663 
664  !> Add a configuration variable with an array of type
665  ! real
666  subroutine add_real_array(cfg, var_name, real_data, comment, dynamic_size)
667  type(cfg_t), intent(inout) :: cfg
668  character(len=*), intent(in) :: var_name, comment
669  real(dp), intent(in) :: real_data(:)
670  logical, intent(in), optional :: dynamic_size
671  integer :: ix
672 
673  call prepare_store_var(cfg, var_name, cfg_real_type, &
674  size(real_data), comment, ix, dynamic_size)
675 
676  if (cfg%vars(ix)%stored_data /= "") then
677  call read_variable(cfg%vars(ix))
678  else
679  cfg%vars(ix)%real_data = real_data
680  end if
681  end subroutine add_real_array
682 
683  !> Add a configuration variable with an integer value
684  subroutine add_int(cfg, var_name, int_data, comment)
685  type(cfg_t), intent(inout) :: cfg
686  character(len=*), intent(in) :: var_name, comment
687  integer, intent(in) :: int_data
688  integer :: ix
689 
690  call prepare_store_var(cfg, var_name, cfg_integer_type, 1, comment, ix)
691 
692  if (cfg%vars(ix)%stored_data /= "") then
693  call read_variable(cfg%vars(ix))
694  else
695  cfg%vars(ix)%int_data(1) = int_data
696  end if
697  end subroutine add_int
698 
699  !> Add a configuration variable with an array of type integer
700  subroutine add_int_array(cfg, var_name, int_data, comment, dynamic_size)
701  type(cfg_t), intent(inout) :: cfg
702  character(len=*), intent(in) :: var_name, comment
703  integer, intent(in) :: int_data(:)
704  logical, intent(in), optional :: dynamic_size
705  integer :: ix
706 
707  call prepare_store_var(cfg, var_name, cfg_integer_type, &
708  size(int_data), comment, ix, dynamic_size)
709 
710  if (cfg%vars(ix)%stored_data /= "") then
711  call read_variable(cfg%vars(ix))
712  else
713  cfg%vars(ix)%int_data = int_data
714  end if
715  end subroutine add_int_array
716 
717  !> Add a configuration variable with an character value
718  subroutine add_string(cfg, var_name, char_data, comment)
719  type(cfg_t), intent(inout) :: cfg
720  character(len=*), intent(in) :: var_name, comment, char_data
721  integer :: ix
722 
723  call prepare_store_var(cfg, var_name, cfg_string_type, 1, comment, ix)
724  if (cfg%vars(ix)%stored_data /= "") then
725  call read_variable(cfg%vars(ix))
726  else
727  cfg%vars(ix)%char_data(1) = char_data
728  end if
729  end subroutine add_string
730 
731  !> Add a configuration variable with an array of type character
732  subroutine add_string_array(cfg, var_name, char_data, &
733  comment, dynamic_size)
734  type(cfg_t), intent(inout) :: cfg
735  character(len=*), intent(in) :: var_name, comment, char_data(:)
736  logical, intent(in), optional :: dynamic_size
737  integer :: ix
738 
739  call prepare_store_var(cfg, var_name, cfg_string_type, &
740  size(char_data), comment, ix, dynamic_size)
741 
742  if (cfg%vars(ix)%stored_data /= "") then
743  call read_variable(cfg%vars(ix))
744  else
745  cfg%vars(ix)%char_data = char_data
746  end if
747  end subroutine add_string_array
748 
749  !> Add a configuration variable with an logical value
750  subroutine add_logic(cfg, var_name, logic_data, comment)
751  type(cfg_t), intent(inout) :: cfg
752  character(len=*), intent(in) :: var_name, comment
753  logical, intent(in) :: logic_data
754  integer :: ix
755 
756  call prepare_store_var(cfg, var_name, cfg_logic_type, 1, comment, ix)
757 
758  if (cfg%vars(ix)%stored_data /= "") then
759  call read_variable(cfg%vars(ix))
760  else
761  cfg%vars(ix)%logic_data(1) = logic_data
762  end if
763  end subroutine add_logic
764 
765  !> Add a configuration variable with an array of type logical
766  subroutine add_logic_array(cfg, var_name, logic_data, &
767  comment, dynamic_size)
768  type(cfg_t), intent(inout) :: cfg
769  character(len=*), intent(in) :: var_name, comment
770  logical, intent(in) :: logic_data(:)
771  logical, intent(in), optional :: dynamic_size
772  integer :: ix
773 
774  call prepare_store_var(cfg, var_name, cfg_logic_type, &
775  size(logic_data), comment, ix, dynamic_size)
776 
777  if (cfg%vars(ix)%stored_data /= "") then
778  call read_variable(cfg%vars(ix))
779  else
780  cfg%vars(ix)%logic_data = logic_data
781  end if
782  end subroutine add_logic_array
783 
784  !> Get a real array of a given name
785  subroutine get_real_array(cfg, var_name, real_data)
786  type(cfg_t), intent(inout) :: cfg
787  character(len=*), intent(in) :: var_name
788  real(dp), intent(inout) :: real_data(:)
789  integer :: ix
790 
791  call prepare_get_var(cfg, var_name, cfg_real_type, &
792  size(real_data), ix)
793  real_data = cfg%vars(ix)%real_data
794  end subroutine get_real_array
795 
796  !> Get a integer array of a given name
797  subroutine get_int_array(cfg, var_name, int_data)
798  type(cfg_t), intent(inout) :: cfg
799  character(len=*), intent(in) :: var_name
800  integer, intent(inout) :: int_data(:)
801  integer :: ix
802 
803  call prepare_get_var(cfg, var_name, cfg_integer_type, &
804  size(int_data), ix)
805  int_data = cfg%vars(ix)%int_data
806  end subroutine get_int_array
807 
808  !> Get a character array of a given name
809  subroutine get_string_array(cfg, var_name, char_data)
810  type(cfg_t), intent(inout) :: cfg
811  character(len=*), intent(in) :: var_name
812  character(len=*), intent(inout) :: char_data(:)
813  integer :: ix
814 
815  call prepare_get_var(cfg, var_name, cfg_string_type, &
816  size(char_data), ix)
817  char_data = cfg%vars(ix)%char_data
818  end subroutine get_string_array
819 
820  !> Get a logical array of a given name
821  subroutine get_logic_array(cfg, var_name, logic_data)
822  type(cfg_t), intent(inout) :: cfg
823  character(len=*), intent(in) :: var_name
824  logical, intent(inout) :: logic_data(:)
825  integer :: ix
826 
827  call prepare_get_var(cfg, var_name, cfg_logic_type, &
828  size(logic_data), ix)
829  logic_data = cfg%vars(ix)%logic_data
830  end subroutine get_logic_array
831 
832  !> Get a real value of a given name
833  subroutine get_real(cfg, var_name, res)
834  type(cfg_t), intent(inout) :: cfg
835  character(len=*), intent(in) :: var_name
836  real(dp), intent(out) :: res
837  integer :: ix
838 
839  call prepare_get_var(cfg, var_name, cfg_real_type, 1, ix)
840  res = cfg%vars(ix)%real_data(1)
841  end subroutine get_real
842 
843  !> Get a integer value of a given name
844  subroutine get_int(cfg, var_name, res)
845  type(cfg_t), intent(inout) :: cfg
846  character(len=*), intent(in) :: var_name
847  integer, intent(inout) :: res
848  integer :: ix
849 
850  call prepare_get_var(cfg, var_name, cfg_integer_type, 1, ix)
851  res = cfg%vars(ix)%int_data(1)
852  end subroutine get_int
853 
854  !> Get a logical value of a given name
855  subroutine get_logic(cfg, var_name, res)
856  type(cfg_t), intent(inout) :: cfg
857  character(len=*), intent(in) :: var_name
858  logical, intent(out) :: res
859  integer :: ix
860 
861  call prepare_get_var(cfg, var_name, cfg_logic_type, 1, ix)
862  res = cfg%vars(ix)%logic_data(1)
863  end subroutine get_logic
864 
865  !> Get a character value of a given name
866  subroutine get_string(cfg, var_name, res)
867  type(cfg_t), intent(inout) :: cfg
868  character(len=*), intent(in) :: var_name
869  character(len=*), intent(out) :: res
870  integer :: ix
871 
872  call prepare_get_var(cfg, var_name, cfg_string_type, 1, ix)
873  res = cfg%vars(ix)%char_data(1)
874  end subroutine get_string
875 
876  !> Get or add a real array of a given name
877  subroutine add_get_real_array(cfg, var_name, real_data, &
878  comment, dynamic_size)
879  type(cfg_t), intent(inout) :: cfg
880  character(len=*), intent(in) :: var_name, comment
881  real(dp), intent(inout) :: real_data(:)
882  logical, intent(in), optional :: dynamic_size
883 
884  call add_real_array(cfg, var_name, real_data, comment, dynamic_size)
885  call get_real_array(cfg, var_name, real_data)
886  end subroutine add_get_real_array
887 
888  !> Get or add a integer array of a given name
889  subroutine add_get_int_array(cfg, var_name, int_data, &
890  comment, dynamic_size)
891  type(cfg_t), intent(inout) :: cfg
892  character(len=*), intent(in) :: var_name, comment
893  integer, intent(inout) :: int_data(:)
894  logical, intent(in), optional :: dynamic_size
895 
896  call add_int_array(cfg, var_name, int_data, comment, dynamic_size)
897  call get_int_array(cfg, var_name, int_data)
898  end subroutine add_get_int_array
899 
900  !> Get or add a character array of a given name
901  subroutine add_get_string_array(cfg, var_name, char_data, &
902  comment, dynamic_size)
903  type(cfg_t), intent(inout) :: cfg
904  character(len=*), intent(in) :: var_name, comment
905  character(len=*), intent(inout) :: char_data(:)
906  logical, intent(in), optional :: dynamic_size
907 
908  call add_string_array(cfg, var_name, char_data, comment, dynamic_size)
909  call get_string_array(cfg, var_name, char_data)
910  end subroutine add_get_string_array
911 
912  !> Get or add a logical array of a given name
913  subroutine add_get_logic_array(cfg, var_name, logic_data, &
914  comment, dynamic_size)
915  type(cfg_t), intent(inout) :: cfg
916  character(len=*), intent(in) :: var_name, comment
917  logical, intent(inout) :: logic_data(:)
918  logical, intent(in), optional :: dynamic_size
919 
920  call add_logic_array(cfg, var_name, logic_data, comment, dynamic_size)
921  call get_logic_array(cfg, var_name, logic_data)
922  end subroutine add_get_logic_array
923 
924  !> Get or add a real value of a given name
925  subroutine add_get_real(cfg, var_name, real_data, comment)
926  type(cfg_t), intent(inout) :: cfg
927  character(len=*), intent(in) :: var_name, comment
928  real(dp), intent(inout) :: real_data
929 
930  call add_real(cfg, var_name, real_data, comment)
931  call get_real(cfg, var_name, real_data)
932  end subroutine add_get_real
933 
934  !> Get or add a integer value of a given name
935  subroutine add_get_int(cfg, var_name, int_data, comment)
936  type(cfg_t), intent(inout) :: cfg
937  character(len=*), intent(in) :: var_name, comment
938  integer, intent(inout) :: int_data
939 
940  call add_int(cfg, var_name, int_data, comment)
941  call get_int(cfg, var_name, int_data)
942  end subroutine add_get_int
943 
944  !> Get or add a logical value of a given name
945  subroutine add_get_logic(cfg, var_name, logical_data, comment)
946  type(cfg_t), intent(inout) :: cfg
947  character(len=*), intent(in) :: var_name, comment
948  logical, intent(inout) :: logical_data
949 
950  call add_logic(cfg, var_name, logical_data, comment)
951  call get_logic(cfg, var_name, logical_data)
952  end subroutine add_get_logic
953 
954  !> Get a character value of a given name
955  subroutine add_get_string(cfg, var_name, string_data, comment)
956  type(cfg_t), intent(inout) :: cfg
957  character(len=*), intent(in) :: var_name, comment
958  character(len=*), intent(inout) :: string_data
959 
960  call add_string(cfg, var_name, string_data, comment)
961  call get_string(cfg, var_name, string_data)
962  end subroutine add_get_string
963 
964  !> Get the size of a variable
965  subroutine cfg_get_size(cfg, var_name, res)
966  type(cfg_t), intent(in) :: cfg
967  character(len=*), intent(in) :: var_name
968  integer, intent(out) :: res
969  integer :: ix
970 
971  call get_var_index(cfg, var_name, ix)
972  if (ix /= -1) then
973  res = cfg%vars(ix)%var_size
974  else
975  res = -1
976  call handle_error("CFG_get_size: variable ["//var_name//"] not found")
977  end if
978  end subroutine cfg_get_size
979 
980  !> Get the type of a given variable of a configuration type
981  subroutine cfg_get_type(cfg, var_name, res)
982  type(cfg_t), intent(in) :: cfg
983  character(len=*), intent(in) :: var_name
984  integer, intent(out) :: res
985  integer :: ix
986 
987  call get_var_index(cfg, var_name, ix)
988 
989  if (ix /= -1) then
990  res = cfg%vars(ix)%var_type
991  else
992  res = -1
993  call handle_error("CFG_get_type: variable ["//var_name//"] not found")
994  end if
995  end subroutine cfg_get_type
996 
997  !> Routine to ensure that enough storage is allocated for the configuration
998  !> type. If not the new size will be twice as much as the current size. If no
999  !> storage is allocated yet a minumum amount of starage is allocated.
1000  subroutine ensure_free_storage(cfg)
1001  type(cfg_t), intent(inout) :: cfg
1002  type(cfg_var_t), allocatable :: cfg_copy(:)
1003  integer, parameter :: min_dyn_size = 100
1004  integer :: cur_size, new_size
1005 
1006  if (allocated(cfg%vars)) then
1007  cur_size = size(cfg%vars)
1008 
1009  if (cur_size < cfg%num_vars + 1) then
1010  new_size = 2 * cur_size
1011  allocate(cfg_copy(cur_size))
1012  cfg_copy = cfg%vars
1013  deallocate(cfg%vars)
1014  allocate(cfg%vars(new_size))
1015  cfg%vars(1:cur_size) = cfg_copy
1016  end if
1017  else
1018  allocate(cfg%vars(min_dyn_size))
1019  end if
1020 
1021  end subroutine ensure_free_storage
1022 
1023  !> Routine to find the indices of entries in a string
1024  subroutine get_fields_string(line, delims, n_max, n_found, ixs_start, ixs_end)
1025  !> The line from which we want to read
1026  character(len=*), intent(in) :: line
1027  !> A string with delimiters. For example delims = " ,'"""//char(9)
1028  character(len=*), intent(in) :: delims
1029  !> Maximum number of entries to read in
1030  integer, intent(in) :: n_max
1031  !> Number of entries found
1032  integer, intent(inout) :: n_found
1033  !> On return, ix_start(i) holds the starting point of entry i
1034  integer, intent(inout) :: ixs_start(n_max)
1035  !> On return, ix_end(i) holds the end point of entry i
1036  integer, intent(inout) :: ixs_end(n_max)
1037 
1038  integer :: ix, ix_prev
1039 
1040  ix_prev = 0
1041  n_found = 0
1042 
1043  do while (n_found < n_max)
1044 
1045  ! Find the starting point of the next entry (a non-delimiter value)
1046  ix = verify(line(ix_prev+1:), delims)
1047  if (ix == 0) exit
1048 
1049  n_found = n_found + 1
1050  ixs_start(n_found) = ix_prev + ix ! This is the absolute position in 'line'
1051 
1052  ! Get the end point of the current entry (next delimiter index minus one)
1053  ix = scan(line(ixs_start(n_found)+1:), delims) - 1
1054 
1055  if (ix == -1) then ! If there is no last delimiter,
1056  ixs_end(n_found) = len(line) ! the end of the line is the endpoint
1057  else
1058  ixs_end(n_found) = ixs_start(n_found) + ix
1059  end if
1060 
1061  ix_prev = ixs_end(n_found) ! We continue to search from here
1062  end do
1063 
1064  end subroutine get_fields_string
1065 
1066  !> Performa a binary search for the variable 'var_name'
1067  subroutine binary_search_variable(cfg, var_name, ix)
1068  type(cfg_t), intent(in) :: cfg
1069  character(len=*), intent(in) :: var_name
1070  integer, intent(out) :: ix
1071  integer :: i_min, i_max, i_mid
1072 
1073  i_min = 1
1074  i_max = cfg%num_vars
1075  ix = - 1
1076 
1077  do while (i_min < i_max)
1078  i_mid = i_min + (i_max - i_min) / 2
1079  if ( llt(cfg%vars(i_mid)%var_name, var_name) ) then
1080  i_min = i_mid + 1
1081  else
1082  i_max = i_mid
1083  end if
1084  end do
1085 
1086  ! If not found, binary_search_variable is not set here, and stays -1
1087  if (i_max == i_min .and. cfg%vars(i_min)%var_name == var_name) then
1088  ix = i_min
1089  else
1090  ix = -1
1091  end if
1092  end subroutine binary_search_variable
1093 
1094  !> Sort the variables for faster lookup
1095  subroutine cfg_sort(cfg)
1096  type(cfg_t), intent(inout) :: cfg
1097 
1098  call qsort_config(cfg%vars(1:cfg%num_vars))
1099  cfg%sorted = .true.
1100  end subroutine cfg_sort
1101 
1102  !> Simple implementation of quicksort algorithm to sort the variable list alphabetically.
1103  recursive subroutine qsort_config(list)
1104  type(cfg_var_t), intent(inout) :: list(:)
1105  integer :: split_pos
1106 
1107  if (size(list) > 1) then
1108  call parition_var_list(list, split_pos)
1109  call qsort_config( list(:split_pos-1) )
1110  call qsort_config( list(split_pos:) )
1111  end if
1112  end subroutine qsort_config
1113 
1114  !> Helper routine for quicksort, to perform partitioning
1115  subroutine parition_var_list(list, marker)
1116  type(cfg_var_t), intent(inout) :: list(:)
1117  integer, intent(out) :: marker
1118  integer :: left, right, pivot_ix
1119  type(cfg_var_t) :: temp
1120  character(len=CFG_name_len) :: pivot_value
1121 
1122  left = 0
1123  right = size(list) + 1
1124 
1125  ! Take the middle element as pivot
1126  pivot_ix = size(list) / 2
1127  pivot_value = list(pivot_ix)%var_name
1128 
1129  do while (left < right)
1130 
1131  right = right - 1
1132  do while (lgt(list(right)%var_name, pivot_value))
1133  right = right - 1
1134  end do
1135 
1136  left = left + 1
1137  do while (lgt(pivot_value, list(left)%var_name))
1138  left = left + 1
1139  end do
1140 
1141  if (left < right) then
1142  temp = list(left)
1143  list(left) = list(right)
1144  list(right) = temp
1145  end if
1146  end do
1147 
1148  if (left == right) then
1149  marker = left + 1
1150  else
1151  marker = left
1152  end if
1153  end subroutine parition_var_list
1154 
1155 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:966
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:529
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:21
integer, parameter, public cfg_string_len
Fixed length of string type.
Definition: mod_config.t:22
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:982
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:434
subroutine, public cfg_sort(cfg)
Sort the variables for faster lookup.
Definition: mod_config.t:1096
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:18