mirror of
https://github.com/TREX-CoE/fparser.git
synced 2025-01-08 04:19:38 +01:00
1442 lines
50 KiB
Fortran
1442 lines
50 KiB
Fortran
!> Module that allows working with a configuration file
|
|
module m_config
|
|
|
|
implicit none
|
|
private
|
|
|
|
!> The double precision kind-parameter
|
|
integer, parameter :: dp = kind(0.0d0)
|
|
|
|
integer, parameter :: CFG_num_types = 4 !< Number of variable types
|
|
integer, parameter :: CFG_integer_type = 1 !< Integer type
|
|
integer, parameter :: CFG_real_type = 2 !< Real number type
|
|
integer, parameter :: CFG_string_type = 3 !< String type
|
|
integer, parameter :: CFG_logic_type = 4 !< Boolean/logical type
|
|
integer, parameter :: CFG_unknown_type = 0 !< Used before a variable is created
|
|
|
|
!> Indicates a variable has its default value
|
|
integer, parameter :: CFG_set_by_default = 1
|
|
!> Indicates a variable was set by a command line argument
|
|
integer, parameter :: CFG_set_by_arg = 2
|
|
!> Indicates a variable was set by reading a file
|
|
integer, parameter :: CFG_set_by_file = 3
|
|
|
|
!> Names of the types
|
|
character(len=10), parameter :: CFG_type_names(0:CFG_num_types) = &
|
|
[character(len=10) :: "storage", "integer", "real", "string ", "logical"]
|
|
|
|
integer, parameter :: CFG_name_len = 80 !< Maximum length of variable names
|
|
integer, parameter :: CFG_string_len = 200 !< Fixed length of string type
|
|
|
|
!> Maximum number of entries in a variable (if it's an array)
|
|
integer, parameter :: CFG_max_array_size = 1000
|
|
|
|
character, parameter :: tab_char = char(9)
|
|
|
|
!> The separator(s) for array-like variables (space, comma, ', ", and tab)
|
|
character(len=*), parameter :: CFG_separators = " ,'"""//tab_char
|
|
|
|
!> The separator for categories (stored in var_name)
|
|
character(len=*), parameter :: CFG_category_separator = "%"
|
|
|
|
!> The default string for data that is not yet stored
|
|
character(len=*), parameter :: unstored_data_string = "__UNSTORED_DATA_STRING"
|
|
|
|
!> The type of a configuration variable
|
|
type CFG_var_t
|
|
private
|
|
!> Name of the variable
|
|
character(len=CFG_name_len) :: var_name
|
|
!> Description of variable
|
|
character(len=CFG_string_len) :: description
|
|
!> Type of variable
|
|
integer :: var_type
|
|
!> Size of variable, 1 means scalar, > 1 means array
|
|
integer :: var_size
|
|
!> Whether the variable size is flexible
|
|
logical :: dynamic_size
|
|
!> Whether the variable's value has been requested
|
|
logical :: used
|
|
!> How the variable has been set (default, command line, file)
|
|
integer :: set_by = CFG_set_by_default
|
|
!> Data that has been read in for this variable
|
|
character(len=CFG_string_len) :: stored_data
|
|
|
|
! These are the arrays used for storage. In the future, a "pointer" based
|
|
! approach could be used.
|
|
real(dp), allocatable :: real_data(:)
|
|
integer, allocatable :: int_data(:)
|
|
character(len=CFG_string_len), allocatable :: char_data(:)
|
|
logical, allocatable :: logic_data(:)
|
|
end type CFG_var_t
|
|
|
|
!> The configuration that contains all the variables
|
|
type CFG_t
|
|
logical :: sorted = .false.
|
|
integer :: num_vars = 0
|
|
type(CFG_var_t), allocatable :: vars(:)
|
|
end type CFG_t
|
|
|
|
type coords
|
|
real(dp), allocatable :: cartesian(:,:)
|
|
integer :: natoms
|
|
character (len=3), allocatable :: elements(:)
|
|
character (len=CFG_string_len) :: comment
|
|
end type coords
|
|
|
|
|
|
!> Interface to add variables to the configuration
|
|
interface CFG_add
|
|
module procedure add_real, add_real_array
|
|
module procedure add_int, add_int_array
|
|
module procedure add_string, add_string_array
|
|
module procedure add_logic, add_logic_array
|
|
end interface CFG_add
|
|
|
|
!> Interface to get variables from the configuration
|
|
interface CFG_get
|
|
module procedure get_real, get_real_array
|
|
module procedure get_int, get_int_array
|
|
module procedure get_logic, get_logic_array
|
|
module procedure get_string, get_string_array
|
|
end interface CFG_get
|
|
|
|
!> Interface to get variables from the configuration
|
|
interface CFG_add_get
|
|
module procedure add_get_real, add_get_real_array
|
|
module procedure add_get_int, add_get_int_array
|
|
module procedure add_get_logic, add_get_logic_array
|
|
module procedure add_get_string, add_get_string_array
|
|
end interface CFG_add_get
|
|
|
|
! Public types
|
|
public :: CFG_t
|
|
public :: CFG_integer_type
|
|
public :: CFG_real_type
|
|
public :: CFG_string_type
|
|
public :: CFG_logic_type
|
|
public :: CFG_type_names
|
|
|
|
! Constants
|
|
public :: CFG_name_len
|
|
public :: CFG_string_len
|
|
public :: CFG_max_array_size
|
|
|
|
! Public methods
|
|
public :: CFG_add
|
|
public :: CFG_get
|
|
public :: CFG_add_get
|
|
public :: CFG_get_size
|
|
public :: CFG_get_type
|
|
public :: CFG_check
|
|
public :: CFG_sort
|
|
public :: CFG_write
|
|
public :: CFG_write_markdown
|
|
public :: CFG_read_file
|
|
public :: CFG_read_xyz
|
|
public :: CFG_update_from_arguments
|
|
public :: CFG_update_from_line
|
|
public :: CFG_clear
|
|
public :: coords
|
|
contains
|
|
|
|
!> Read command line arguments. Both files and variables can be specified, for
|
|
!> example as: ./my_program config.cfg -n_runs=3
|
|
!>
|
|
!> config files should have an extension .cfg or .txt
|
|
!> command line arguments should be preceded by a single dash
|
|
subroutine CFG_update_from_arguments(cfg, ignore_unknown)
|
|
type(CFG_t),intent(inout) :: cfg
|
|
!> Ignore unknown arguments (default: false)
|
|
logical, intent(in), optional :: ignore_unknown
|
|
character(len=CFG_string_len) :: arg
|
|
integer :: ix, n
|
|
logical :: valid_syntax, strict
|
|
character(len=4) :: extension
|
|
|
|
strict = .true.; if (present(ignore_unknown)) strict = .not. ignore_unknown
|
|
|
|
do ix = 1, command_argument_count()
|
|
call get_command_argument(ix, arg)
|
|
|
|
n = len_trim(arg)
|
|
if (n > 3) extension = arg(n-3:)
|
|
|
|
! Look for arguments starting with a single dash
|
|
if (arg(1:1) == '-' .and. arg(2:2) /= '-') then
|
|
! This sets a variable
|
|
call parse_line(cfg, CFG_set_by_arg, arg(2:), valid_syntax)
|
|
|
|
if (.not. valid_syntax) then
|
|
call handle_error("Invalid variable specified on command line")
|
|
end if
|
|
else if (arg(1:1) /= '-' .and. &
|
|
(extension == ".cfg" .or. extension == ".txt")) then
|
|
! Read a configuration file
|
|
call CFG_read_file(cfg, trim(arg))
|
|
else if (strict) then
|
|
print *, "This error message can be disabled by setting"
|
|
print *, "ignore_unknown = .true. for CFG_update_from_arguments"
|
|
call handle_error("Unknown argument: " // trim(arg))
|
|
end if
|
|
end do
|
|
end subroutine CFG_update_from_arguments
|
|
|
|
!> Update the configuration by parsing a line
|
|
subroutine CFG_update_from_line(cfg, line)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: line
|
|
logical :: valid_syntax
|
|
|
|
! This sets a variable
|
|
call parse_line(cfg, CFG_set_by_arg, line, valid_syntax)
|
|
|
|
if (.not. valid_syntax) then
|
|
call handle_error("CFG_set: invalid syntax")
|
|
end if
|
|
end subroutine CFG_update_from_line
|
|
|
|
!> This routine will be called if an error occurs in one of the subroutines of
|
|
!> this module.
|
|
subroutine handle_error(err_string)
|
|
character(len=*), intent(in) :: err_string
|
|
|
|
print *, "The following error occured in m_config:"
|
|
print *, trim(err_string)
|
|
|
|
! It is usually best to quit after an error, to make sure the error message
|
|
! is not overlooked in the program's output
|
|
error stop
|
|
end subroutine handle_error
|
|
|
|
!> Return the index of the variable with name 'var_name', or -1 if not found.
|
|
subroutine get_var_index(cfg, var_name, ix)
|
|
type(CFG_t), intent(in) :: cfg
|
|
character(len=*), intent(in) :: var_name
|
|
integer, intent(out) :: ix
|
|
integer :: i
|
|
|
|
if (cfg%sorted) then
|
|
call binary_search_variable(cfg, var_name, ix)
|
|
else
|
|
! Linear search
|
|
do i = 1, cfg%num_vars
|
|
if (cfg%vars(i)%var_name == var_name) exit
|
|
end do
|
|
|
|
! If not found, set i to -1
|
|
if (i == cfg%num_vars + 1) i = -1
|
|
ix = i
|
|
end if
|
|
|
|
end subroutine get_var_index
|
|
|
|
!> Update the variables in the configartion with the values found in 'filename'
|
|
subroutine CFG_read_file(cfg, filename)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: filename
|
|
|
|
integer, parameter :: my_unit = 123
|
|
integer :: io_state
|
|
integer :: line_number
|
|
logical :: valid_syntax
|
|
character(len=CFG_name_len) :: line_fmt
|
|
character(len=CFG_string_len) :: err_string
|
|
character(len=CFG_string_len) :: line
|
|
character(len=CFG_name_len) :: category
|
|
|
|
open(my_unit, file=trim(filename), status="old", action="read")
|
|
write(line_fmt, "(A,I0,A)") "(A", CFG_string_len, ")"
|
|
|
|
category = "" ! Default category is empty
|
|
line_number = 0
|
|
|
|
do
|
|
read(my_unit, FMT=trim(line_fmt), ERR=998, end=999) line
|
|
line_number = line_number + 1
|
|
|
|
call parse_line(cfg, CFG_set_by_file, line, valid_syntax, category)
|
|
|
|
if (.not. valid_syntax) then
|
|
write(err_string, *) "Cannot read line ", line_number, &
|
|
" from ", trim(filename)
|
|
call handle_error(err_string)
|
|
end if
|
|
end do
|
|
|
|
! Error handling
|
|
998 write(err_string, "(A,I0,A,I0)") " IOSTAT = ", io_state, &
|
|
" while reading from " // trim(filename) // " at line ", &
|
|
line_number
|
|
call handle_error("CFG_read_file:" // err_string)
|
|
|
|
! Routine ends here if the end of "filename" is reached
|
|
999 close(my_unit, iostat=io_state)
|
|
|
|
end subroutine CFG_read_file
|
|
|
|
!> Update the variables in the configartion with the values found in 'filename.xyz'
|
|
subroutine CFG_read_xyz(coordinates, filename)
|
|
type(coords), intent(inout) :: coordinates
|
|
character(len=*), intent(in) :: filename
|
|
|
|
integer, parameter :: my_unit = 786
|
|
integer :: io_state
|
|
integer :: line_number
|
|
logical :: valid_syntax
|
|
character(len=CFG_name_len) :: line_fmt
|
|
character(len=CFG_string_len) :: err_string
|
|
character(len=CFG_string_len) :: line
|
|
character(len=CFG_name_len) :: category
|
|
|
|
open(my_unit, file=trim(filename), status="old", action="read")
|
|
write(line_fmt, "(A,I0,A)") "(A", CFG_string_len, ")"
|
|
|
|
category = "" ! Default category is empty
|
|
line_number = 0
|
|
|
|
do
|
|
read(my_unit, FMT=trim(line_fmt), ERR=998, end=999) line
|
|
line_number = line_number + 1
|
|
if (line_number == 1) then
|
|
! parse the line and store the number as number of atoms
|
|
coordinates%natoms = adjustl(line)
|
|
allocate((coordinates%cartesian(3,coordinates%natoms)))
|
|
write(*,*) "Number of atoms from the xyz file", coordinates%natoms
|
|
elseif (line_number == 2) then
|
|
! parse the line and store the string as a comment
|
|
coordinates%comment = adjustl(line)
|
|
write(*,*) "Comment from the xyz file", coordinates%comment
|
|
else
|
|
! parse the line and store the variables
|
|
call prepare_get_var(coordinates, "", CFG_string_type, 1, 1) ! 1 for element name and 1 is the position where line starts
|
|
call prepare_get_var(coordinates, "", CFG_real_type, 3, 2) ! 3 for x,y,z and 2 is the position where numbers start
|
|
real_data = cfg%vars(ix)%real_data
|
|
|
|
call parse_xyz(coordinates, line)
|
|
coordinates%cartesian(3,coordinates%natoms)
|
|
endif
|
|
end do
|
|
|
|
! Error handling
|
|
998 write(err_string, "(A,I0,A,I0)") " IOSTAT = ", io_state, &
|
|
" while reading from " // trim(filename) // " at line ", &
|
|
line_number
|
|
call handle_error("CFG_read_xyz:" // err_string)
|
|
|
|
! Routine ends here if the end of "filename" is reached
|
|
999 close(my_unit, iostat=io_state)
|
|
|
|
end subroutine CFG_read_xyz
|
|
|
|
!> Update the cfg by parsing xyz file line by line
|
|
subroutine parse_xyz(coordinates, line_arg)
|
|
type(coords), intent(inout) :: coordinates
|
|
character(len=*), intent(in) :: line_arg !< Line to parse
|
|
logical :: append
|
|
character(len=CFG_string_len) :: line
|
|
|
|
character(len=CFG_name_len) :: var_name, category
|
|
integer :: ix, equal_sign_ix
|
|
logical :: append
|
|
|
|
|
|
! Work on a copy
|
|
line = line_arg
|
|
|
|
call trim_comment(line, '#;')
|
|
|
|
! Skip empty lines
|
|
if (line == "") return
|
|
|
|
|
|
if (ix <= 0) then
|
|
! Variable still needs to be created, for now store data as a string
|
|
call prepare_store_var(cfg, trim(var_name), CFG_unknown_type, 1, &
|
|
"Not yet created", ix, .false.)
|
|
cfg%vars(ix)%stored_data = line
|
|
else
|
|
if (append) then
|
|
cfg%vars(ix)%stored_data = &
|
|
trim(cfg%vars(ix)%stored_data) // trim(line)
|
|
else
|
|
cfg%vars(ix)%stored_data = line
|
|
end if
|
|
|
|
! If type is known, read in values
|
|
if (cfg%vars(ix)%var_type /= CFG_unknown_type) then
|
|
call read_variable(cfg%vars(ix))
|
|
end if
|
|
end if
|
|
|
|
! Store how the variable was set
|
|
cfg%vars(ix)%set_by = set_by
|
|
|
|
end subroutine parse_xyz
|
|
|
|
|
|
|
|
!> Update the cfg by parsing one line
|
|
subroutine parse_line(cfg, set_by, line_arg, valid_syntax, category_arg)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
integer, intent(in) :: set_by !< Where the line came from
|
|
character(len=*), intent(in) :: line_arg !< Line to parse
|
|
logical, intent(out) :: valid_syntax
|
|
character(len=CFG_name_len), intent(inout), optional :: category_arg !< The category
|
|
character(len=CFG_name_len) :: var_name, category
|
|
integer :: ix, equal_sign_ix
|
|
logical :: append
|
|
character(len=CFG_string_len) :: line
|
|
|
|
valid_syntax = .true.
|
|
|
|
! Work on a copy
|
|
line = line_arg
|
|
category = ""
|
|
if (present(category_arg)) category = category_arg
|
|
|
|
call trim_comment(line, '#;')
|
|
|
|
! Skip empty lines
|
|
if (line == "") return
|
|
|
|
! Locate the '=' sign
|
|
equal_sign_ix = scan(line, '=')
|
|
|
|
! if there is no '='-sign then a category is indicated
|
|
if (equal_sign_ix == 0) then
|
|
line = adjustl(line)
|
|
|
|
! The category name should appear like this: [category_name]
|
|
ix = scan(line, ']')
|
|
if (line(1:1) /= '[' .or. ix == 0) then
|
|
valid_syntax = .false.
|
|
return
|
|
else
|
|
if (present(category_arg)) category_arg = line(2:ix-1)
|
|
return
|
|
end if
|
|
end if
|
|
|
|
if (line(equal_sign_ix-1:equal_sign_ix) == '+=') then
|
|
append = .true.
|
|
var_name = line(1 : equal_sign_ix - 2) ! Set variable name
|
|
else
|
|
append = .false.
|
|
var_name = line(1 : equal_sign_ix - 1) ! Set variable name
|
|
end if
|
|
|
|
! If there are less than two spaces or a tab, reset to no category
|
|
if (var_name(1:2) /= " " .and. var_name(1:1) /= tab_char) then
|
|
category = ""
|
|
end if
|
|
|
|
! Replace leading tabs by spaces
|
|
ix = verify(var_name, tab_char) ! Find first non-tab character
|
|
var_name(1:ix-1) = ""
|
|
|
|
! Remove leading blanks
|
|
var_name = adjustl(var_name)
|
|
|
|
! Add category if it is defined
|
|
if (category /= "") then
|
|
var_name = trim(category) // CFG_category_separator // var_name
|
|
end if
|
|
|
|
line = line(equal_sign_ix + 1:) ! Set line to the values behind the '=' sign
|
|
|
|
! Find variable corresponding to name in file
|
|
call get_var_index(cfg, var_name, ix)
|
|
|
|
if (ix <= 0) then
|
|
! Variable still needs to be created, for now store data as a string
|
|
call prepare_store_var(cfg, trim(var_name), CFG_unknown_type, 1, &
|
|
"Not yet created", ix, .false.)
|
|
cfg%vars(ix)%stored_data = line
|
|
else
|
|
if (append) then
|
|
cfg%vars(ix)%stored_data = &
|
|
trim(cfg%vars(ix)%stored_data) // trim(line)
|
|
else
|
|
cfg%vars(ix)%stored_data = line
|
|
end if
|
|
|
|
! If type is known, read in values
|
|
if (cfg%vars(ix)%var_type /= CFG_unknown_type) then
|
|
call read_variable(cfg%vars(ix))
|
|
end if
|
|
end if
|
|
|
|
! Store how the variable was set
|
|
cfg%vars(ix)%set_by = set_by
|
|
|
|
end subroutine parse_line
|
|
|
|
subroutine read_variable(var)
|
|
type(CFG_var_t), intent(inout) :: var
|
|
integer :: n, n_entries
|
|
integer :: ix_start(CFG_max_array_size)
|
|
integer :: ix_end(CFG_max_array_size), stat
|
|
|
|
! Get the start and end positions of the line content, and the number of entries
|
|
call get_fields_string(var%stored_data, CFG_separators, &
|
|
CFG_max_array_size, n_entries, ix_start, ix_end)
|
|
|
|
if (var%var_size /= n_entries) then
|
|
|
|
if (.not. var%dynamic_size) then
|
|
! Allow strings of length 1 to be automatically concatenated
|
|
if (var%var_type == CFG_string_type .and. var%var_size == 1) then
|
|
var%char_data(1) = trim(var%stored_data(ix_start(1):ix_end(n_entries)))
|
|
return ! Leave routine
|
|
else
|
|
call handle_error("read_variable: variable [" // &
|
|
& trim(var%var_name) // "] has the wrong size")
|
|
end if
|
|
else
|
|
var%var_size = n_entries
|
|
call resize_storage(var)
|
|
end if
|
|
end if
|
|
|
|
do n = 1, n_entries
|
|
stat = 0
|
|
select case (var%var_type)
|
|
case (CFG_integer_type)
|
|
read(var%stored_data(ix_start(n):ix_end(n)), *, iostat=stat) var%int_data(n)
|
|
case (CFG_real_type)
|
|
read(var%stored_data(ix_start(n):ix_end(n)), *, iostat=stat) var%real_data(n)
|
|
case (CFG_string_type)
|
|
var%char_data(n) = trim(var%stored_data(ix_start(n):ix_end(n)))
|
|
case (CFG_logic_type)
|
|
read(var%stored_data(ix_start(n):ix_end(n)), *, iostat=stat) var%logic_data(n)
|
|
end select
|
|
|
|
if(stat /= 0) then
|
|
write (*, *) "** m_config error **"
|
|
write (*, *) "reading variable: ", trim(var%var_name)
|
|
write (*, *) "variable type: ", trim(CFG_type_names(var%var_type))
|
|
write (*, *) "parsing value: ", var%stored_data(ix_start(n):ix_end(n))
|
|
write (*, "(A,I0)") " iostat value: ", stat
|
|
stop
|
|
endif
|
|
end do
|
|
end subroutine read_variable
|
|
|
|
subroutine trim_comment(line, comment_chars)
|
|
character(len=*), intent(inout) :: line
|
|
character(len=*), intent(in) :: comment_chars
|
|
character :: current_char, need_char
|
|
integer :: n
|
|
|
|
! Strip comments, but only outside quoted strings (so that var = '#yolo' is
|
|
! valid when # is a comment char)
|
|
need_char = ""
|
|
|
|
do n = 1, len(line)
|
|
current_char = line(n:n)
|
|
|
|
if (need_char == "") then
|
|
if (current_char == "'") then
|
|
need_char = "'" ! Open string
|
|
else if (current_char == '"') then
|
|
need_char = '"' ! Open string
|
|
else if (index(comment_chars, current_char) /= 0) then
|
|
line = line(1:n-1) ! Trim line up to comment character
|
|
exit
|
|
end if
|
|
else if (current_char == need_char) then
|
|
need_char = "" ! Close string
|
|
end if
|
|
|
|
end do
|
|
|
|
end subroutine trim_comment
|
|
|
|
subroutine CFG_check(cfg)
|
|
type(CFG_t), intent(in) :: cfg
|
|
integer :: n
|
|
character(len=CFG_string_len) :: err_string
|
|
|
|
do n = 1, cfg%num_vars
|
|
if (cfg%vars(n)%var_type == CFG_unknown_type) then
|
|
write(err_string, *) "CFG_check: unknown variable ", &
|
|
trim(cfg%vars(n)%var_name), " specified"
|
|
call handle_error(err_string)
|
|
end if
|
|
end do
|
|
end subroutine CFG_check
|
|
|
|
!> This routine writes the current configuration to a file with descriptions
|
|
subroutine CFG_write(cfg_in, filename, hide_unused, custom_first)
|
|
use iso_fortran_env
|
|
type(CFG_t), intent(in) :: cfg_in
|
|
character(len=*), intent(in) :: filename
|
|
!> Hide variables whose value was not requested
|
|
logical, intent(in), optional :: hide_unused
|
|
!> Show user-set variables first (default: false)
|
|
logical, intent(in), optional :: custom_first
|
|
logical :: hide_not_used, sort_set_by
|
|
type(CFG_t) :: cfg
|
|
integer :: i, j, n, io_state, myUnit
|
|
integer :: n_custom_set
|
|
integer, allocatable :: cfg_order(:)
|
|
character(len=CFG_name_len) :: name_format, var_name
|
|
character(len=CFG_name_len) :: category, prev_category
|
|
character(len=CFG_string_len) :: err_string
|
|
|
|
hide_not_used = .false.
|
|
if (present(hide_unused)) hide_not_used = hide_unused
|
|
|
|
sort_set_by = .false.
|
|
if (present(custom_first)) sort_set_by = custom_first
|
|
|
|
! Always print a sorted configuration
|
|
cfg = cfg_in
|
|
!if (.not. cfg%sorted) call CFG_sort(cfg)
|
|
|
|
write(name_format, FMT="(A,I0,A)") "(A,A", CFG_name_len, ",A)"
|
|
|
|
if (filename == "stdout") then
|
|
myUnit = output_unit
|
|
else
|
|
open(newunit=myUnit, FILE=filename, ACTION="WRITE")
|
|
end if
|
|
|
|
category = ""
|
|
prev_category = ""
|
|
|
|
allocate(cfg_order(cfg%num_vars))
|
|
if (sort_set_by) then
|
|
n = 0
|
|
do i = 1, cfg%num_vars
|
|
if (cfg%vars(i)%set_by /= CFG_set_by_default) then
|
|
n = n + 1
|
|
cfg_order(n) = i
|
|
end if
|
|
end do
|
|
n_custom_set = n
|
|
|
|
do i = 1, cfg%num_vars
|
|
if (cfg%vars(i)%set_by == CFG_set_by_default) then
|
|
n = n + 1
|
|
cfg_order(n) = i
|
|
end if
|
|
end do
|
|
else
|
|
n_custom_set = -1 ! To prevent undefined warning
|
|
cfg_order(:) = [(i, i = 1, cfg%num_vars)]
|
|
end if
|
|
|
|
do n = 1, cfg%num_vars
|
|
i = cfg_order(n)
|
|
|
|
if (.not. cfg%vars(i)%used .and. hide_not_used) cycle
|
|
if (cfg%vars(i)%var_type == CFG_unknown_type) cycle
|
|
|
|
if (sort_set_by .and. n == n_custom_set + 1) then
|
|
write(myUnit, ERR=998, FMT="(A)") '# Variables below have default values'
|
|
write(myUnit, ERR=998, FMT="(A)") ''
|
|
end if
|
|
|
|
! Write category when it changes
|
|
call split_category(cfg%vars(i), category, var_name)
|
|
|
|
if (category /= prev_category .and. category /= '') then
|
|
write(myUnit, ERR=998, FMT="(A)") '[' // trim(category) // ']'
|
|
prev_category = category
|
|
end if
|
|
|
|
! Indent if inside category
|
|
if (category /= "") then
|
|
write(myUnit, ERR=998, FMT="(A,A,A)") " # ", &
|
|
trim(cfg%vars(i)%description), ":"
|
|
write(myUnit, ADVANCE="NO", ERR=998, FMT="(A)") &
|
|
" " // trim(var_name) // " ="
|
|
else
|
|
write(myUnit, ERR=998, FMT="(A,A,A)") "# ", &
|
|
trim(cfg%vars(i)%description), ":"
|
|
write(myUnit, ADVANCE="NO", ERR=998, FMT="(A)") &
|
|
trim(var_name) // " ="
|
|
end if
|
|
|
|
select case(cfg%vars(i)%var_type)
|
|
case (CFG_integer_type)
|
|
do j = 1, cfg%vars(i)%var_size
|
|
write(myUnit, ADVANCE="NO", ERR=998, FMT="(A,I0)") &
|
|
" ", cfg%vars(i)%int_data(j)
|
|
end do
|
|
case (CFG_real_type)
|
|
do j = 1, cfg%vars(i)%var_size
|
|
write(myUnit, ADVANCE="NO", ERR=998, FMT="(A,F12.6)") &
|
|
" ", cfg%vars(i)%real_data(j)
|
|
end do
|
|
case (CFG_string_type)
|
|
do j = 1, cfg%vars(i)%var_size
|
|
write(myUnit, ADVANCE="NO", ERR=998, FMT="(A)") &
|
|
" '" // trim(cfg%vars(i)%char_data(j)) // "'"
|
|
end do
|
|
case (CFG_logic_type)
|
|
do j = 1, cfg%vars(i)%var_size
|
|
write(myUnit, ADVANCE="NO", ERR=998, FMT="(A,L1)") &
|
|
" ", cfg%vars(i)%logic_data(j)
|
|
end do
|
|
end select
|
|
write(myUnit, ERR=998, FMT="(A)") ""
|
|
write(myUnit, ERR=998, FMT="(A)") ""
|
|
end do
|
|
|
|
if (myUnit /= output_unit) close(myUnit, ERR=999, IOSTAT=io_state)
|
|
call CFG_check(cfg_in)
|
|
return
|
|
|
|
998 continue
|
|
write(err_string, *) "CFG_write error: io_state = ", io_state, &
|
|
" while writing ", trim(var_name), " to ", filename
|
|
call handle_error(err_string)
|
|
|
|
999 continue ! If there was an error, the routine will end here
|
|
write(err_string, *) "CFG_write error: io_state = ", io_state, &
|
|
" while writing to ", filename
|
|
call handle_error(err_string)
|
|
|
|
end subroutine CFG_write
|
|
|
|
!> This routine writes the current configuration to a markdown file
|
|
subroutine CFG_write_markdown(cfg_in, filename, hide_unused)
|
|
use iso_fortran_env
|
|
type(CFG_t), intent(in) :: cfg_in
|
|
character(len=*), intent(in) :: filename
|
|
logical, intent(in), optional :: hide_unused
|
|
logical :: hide_not_used
|
|
integer :: i, j, io_state, myUnit
|
|
type(CFG_t) :: cfg
|
|
character(len=CFG_name_len) :: name_format, var_name
|
|
character(len=CFG_name_len) :: category, prev_category
|
|
character(len=CFG_string_len) :: err_string
|
|
|
|
hide_not_used = .false.
|
|
if (present(hide_unused)) hide_not_used = hide_unused
|
|
|
|
! Always print a sorted configuration
|
|
cfg = cfg_in
|
|
if (.not. cfg%sorted) call CFG_sort(cfg)
|
|
|
|
write(name_format, FMT="(A,I0,A)") "(A,A", CFG_name_len, ",A)"
|
|
|
|
if (filename == "stdout") then
|
|
myUnit = output_unit
|
|
else
|
|
myUnit = 333
|
|
open(myUnit, FILE=filename, ACTION="WRITE")
|
|
end if
|
|
|
|
category = ""
|
|
prev_category = "X"
|
|
write(myUnit, ERR=998, FMT="(A)") "# Configuration file (markdown format)"
|
|
write(myUnit, ERR=998, FMT="(A)") ""
|
|
|
|
do i = 1, cfg%num_vars
|
|
|
|
if (.not. cfg%vars(i)%used .and. hide_not_used) cycle
|
|
if (cfg%vars(i)%var_type == CFG_unknown_type) cycle
|
|
|
|
! Write category when it changes
|
|
call split_category(cfg%vars(i), category, var_name)
|
|
|
|
if (category /= prev_category) then
|
|
if (category == "") category = "No category"
|
|
write(myUnit, ERR=998, FMT="(A)") '## ' // trim(category)
|
|
write(myUnit, ERR=998, FMT="(A)") ""
|
|
prev_category = category
|
|
end if
|
|
|
|
write(myUnit, ERR=998, FMT="(A)") "* " // trim(cfg%vars(i)%description)
|
|
write(myUnit, ERR=998, FMT="(A)") ""
|
|
write(myUnit, ADVANCE="NO", ERR=998, FMT="(A)") &
|
|
' ' // trim(var_name) // " ="
|
|
|
|
select case(cfg%vars(i)%var_type)
|
|
case (CFG_integer_type)
|
|
do j = 1, cfg%vars(i)%var_size
|
|
write(myUnit, ADVANCE="NO", ERR=998, FMT="(A,I0)") &
|
|
" ", cfg%vars(i)%int_data(j)
|
|
end do
|
|
case (CFG_real_type)
|
|
do j = 1, cfg%vars(i)%var_size
|
|
write(myUnit, ADVANCE="NO", ERR=998, FMT="(A,F12.6)") &
|
|
" ", cfg%vars(i)%real_data(j)
|
|
end do
|
|
case (CFG_string_type)
|
|
do j = 1, cfg%vars(i)%var_size
|
|
write(myUnit, ADVANCE="NO", ERR=998, FMT="(A)") &
|
|
" '" // trim(cfg%vars(i)%char_data(j)) // "'"
|
|
end do
|
|
case (CFG_logic_type)
|
|
do j = 1, cfg%vars(i)%var_size
|
|
write(myUnit, ADVANCE="NO", ERR=998, FMT="(A,L1)") &
|
|
" ", cfg%vars(i)%logic_data(j)
|
|
end do
|
|
end select
|
|
write(myUnit, ERR=998, FMT="(A)") ""
|
|
write(myUnit, ERR=998, FMT="(A)") ""
|
|
end do
|
|
|
|
if (myUnit /= output_unit) close(myUnit, ERR=999, IOSTAT=io_state)
|
|
call CFG_check(cfg_in)
|
|
return
|
|
|
|
998 continue
|
|
write(err_string, *) "CFG_write_markdown error: io_state = ", io_state, &
|
|
" while writing ", trim(var_name), " to ", filename
|
|
call handle_error(err_string)
|
|
|
|
999 continue ! If there was an error, the routine will end here
|
|
write(err_string, *) "CFG_write_markdown error: io_state = ", io_state, &
|
|
" while writing to ", filename
|
|
call handle_error(err_string)
|
|
|
|
end subroutine CFG_write_markdown
|
|
|
|
subroutine split_category(variable, category, var_name)
|
|
type(CFG_var_t), intent(in) :: variable
|
|
character(CFG_name_len), intent(out) :: category
|
|
character(CFG_name_len), intent(out) :: var_name
|
|
integer :: ix
|
|
|
|
ix = index(variable%var_name, CFG_category_separator)
|
|
|
|
if (ix == 0) then
|
|
category = ""
|
|
var_name = variable%var_name
|
|
else
|
|
category = variable%var_name(1:ix-1)
|
|
var_name = variable%var_name(ix+1:)
|
|
end if
|
|
|
|
end subroutine split_category
|
|
|
|
!> Resize the storage size of variable, which can be of type integer, logical,
|
|
!> real or character
|
|
subroutine resize_storage(variable)
|
|
type(CFG_var_t), intent(inout) :: variable
|
|
|
|
select case (variable%var_type)
|
|
case (CFG_integer_type)
|
|
deallocate( variable%int_data )
|
|
allocate( variable%int_data(variable%var_size) )
|
|
case (CFG_logic_type)
|
|
deallocate( variable%logic_data )
|
|
allocate( variable%logic_data(variable%var_size) )
|
|
case (CFG_real_type)
|
|
deallocate( variable%real_data )
|
|
allocate( variable%real_data(variable%var_size) )
|
|
case (CFG_string_type)
|
|
deallocate( variable%char_data )
|
|
allocate( variable%char_data(variable%var_size) )
|
|
end select
|
|
end subroutine resize_storage
|
|
|
|
!> Helper routine to store variables. This is useful because a lot of the same
|
|
!> code is executed for the different types of variables.
|
|
subroutine prepare_store_var(cfg, var_name, var_type, var_size, &
|
|
description, ix, dynamic_size)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name, description
|
|
integer, intent(in) :: var_type, var_size
|
|
integer, intent(out) :: ix !< Index of variable
|
|
logical, intent(in), optional :: dynamic_size
|
|
|
|
! Check if variable already exists
|
|
call get_var_index(cfg, var_name, ix)
|
|
|
|
if (ix == -1) then ! Create a new variable
|
|
call ensure_free_storage(cfg)
|
|
cfg%sorted = .false.
|
|
ix = cfg%num_vars + 1
|
|
cfg%num_vars = cfg%num_vars + 1
|
|
cfg%vars(ix)%used = .false.
|
|
cfg%vars(ix)%stored_data = unstored_data_string
|
|
else
|
|
! Only allowed when the variable is not yet created
|
|
if (cfg%vars(ix)%var_type /= CFG_unknown_type) then
|
|
call handle_error("prepare_store_var: variable [" // &
|
|
& trim(var_name) // "] already exists")
|
|
end if
|
|
end if
|
|
|
|
cfg%vars(ix)%var_name = var_name
|
|
cfg%vars(ix)%description = description
|
|
cfg%vars(ix)%var_type = var_type
|
|
cfg%vars(ix)%var_size = var_size
|
|
|
|
if (present(dynamic_size)) then
|
|
cfg%vars(ix)%dynamic_size = dynamic_size
|
|
else
|
|
cfg%vars(ix)%dynamic_size = .false.
|
|
end if
|
|
|
|
select case (var_type)
|
|
case (CFG_integer_type)
|
|
allocate( cfg%vars(ix)%int_data(var_size) )
|
|
case (CFG_real_type)
|
|
allocate( cfg%vars(ix)%real_data(var_size) )
|
|
case (CFG_string_type)
|
|
allocate( cfg%vars(ix)%char_data(var_size) )
|
|
case (CFG_logic_type)
|
|
allocate( cfg%vars(ix)%logic_data(var_size) )
|
|
end select
|
|
|
|
end subroutine prepare_store_var
|
|
|
|
!> Helper routine to get variables. This is useful because a lot of the same
|
|
!> code is executed for the different types of variables.
|
|
subroutine prepare_get_var(cfg, var_name, var_type, var_size, ix)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name
|
|
integer, intent(in) :: var_type, var_size
|
|
integer, intent(out) :: ix
|
|
character(len=CFG_string_len) :: err_string
|
|
|
|
call get_var_index(cfg, var_name, ix)
|
|
|
|
if (ix == -1) then
|
|
call handle_error("CFG_get: variable ["//var_name//"] not found")
|
|
else if (cfg%vars(ix)%var_type /= var_type) then
|
|
write(err_string, fmt="(A)") "CFG_get: variable [" &
|
|
// var_name // "] has different type (" // &
|
|
trim(CFG_type_names(cfg%vars(ix)%var_type)) // &
|
|
") than requested (" // trim(CFG_type_names(var_type)) // ")"
|
|
call handle_error(err_string)
|
|
else if (cfg%vars(ix)%var_size /= var_size) then
|
|
write(err_string, fmt="(A,I0,A,I0,A)") "CFG_get: variable [" &
|
|
// var_name // "] has different size (", cfg%vars(ix)%var_size, &
|
|
") than requested (", var_size, ")"
|
|
call handle_error(err_string)
|
|
else ! All good, variable will be used
|
|
cfg%vars(ix)%used = .true.
|
|
end if
|
|
end subroutine prepare_get_var
|
|
|
|
!> Add a configuration variable with a real value
|
|
subroutine add_real(cfg, var_name, real_data, comment)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name, comment
|
|
real(dp), intent(in) :: real_data
|
|
integer :: ix
|
|
|
|
call prepare_store_var(cfg, var_name, CFG_real_type, 1, comment, ix)
|
|
|
|
if (cfg%vars(ix)%stored_data /= unstored_data_string) then
|
|
call read_variable(cfg%vars(ix))
|
|
else
|
|
cfg%vars(ix)%real_data(1) = real_data
|
|
end if
|
|
end subroutine add_real
|
|
|
|
!> Add a configuration variable with an array of type
|
|
! real
|
|
subroutine add_real_array(cfg, var_name, real_data, comment, dynamic_size)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name, comment
|
|
real(dp), intent(in) :: real_data(:)
|
|
logical, intent(in), optional :: dynamic_size
|
|
integer :: ix
|
|
|
|
call prepare_store_var(cfg, var_name, CFG_real_type, &
|
|
size(real_data), comment, ix, dynamic_size)
|
|
|
|
if (cfg%vars(ix)%stored_data /= unstored_data_string) then
|
|
call read_variable(cfg%vars(ix))
|
|
else
|
|
cfg%vars(ix)%real_data = real_data
|
|
end if
|
|
end subroutine add_real_array
|
|
|
|
!> Add a configuration variable with an integer value
|
|
subroutine add_int(cfg, var_name, int_data, comment)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name, comment
|
|
integer, intent(in) :: int_data
|
|
integer :: ix
|
|
|
|
call prepare_store_var(cfg, var_name, CFG_integer_type, 1, comment, ix)
|
|
|
|
if (cfg%vars(ix)%stored_data /= unstored_data_string) then
|
|
call read_variable(cfg%vars(ix))
|
|
else
|
|
cfg%vars(ix)%int_data(1) = int_data
|
|
end if
|
|
end subroutine add_int
|
|
|
|
!> Add a configuration variable with an array of type integer
|
|
subroutine add_int_array(cfg, var_name, int_data, comment, dynamic_size)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name, comment
|
|
integer, intent(in) :: int_data(:)
|
|
logical, intent(in), optional :: dynamic_size
|
|
integer :: ix
|
|
|
|
call prepare_store_var(cfg, var_name, CFG_integer_type, &
|
|
size(int_data), comment, ix, dynamic_size)
|
|
|
|
if (cfg%vars(ix)%stored_data /= unstored_data_string) then
|
|
call read_variable(cfg%vars(ix))
|
|
else
|
|
cfg%vars(ix)%int_data = int_data
|
|
end if
|
|
end subroutine add_int_array
|
|
|
|
!> Add a configuration variable with an character value
|
|
subroutine add_string(cfg, var_name, char_data, comment)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name, comment, char_data
|
|
integer :: ix
|
|
|
|
call prepare_store_var(cfg, var_name, CFG_string_type, 1, comment, ix)
|
|
if (cfg%vars(ix)%stored_data /= unstored_data_string) then
|
|
call read_variable(cfg%vars(ix))
|
|
else
|
|
cfg%vars(ix)%char_data(1) = char_data
|
|
end if
|
|
end subroutine add_string
|
|
|
|
!> Add a configuration variable with an array of type character
|
|
subroutine add_string_array(cfg, var_name, char_data, &
|
|
comment, dynamic_size)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name, comment, char_data(:)
|
|
logical, intent(in), optional :: dynamic_size
|
|
integer :: ix
|
|
|
|
call prepare_store_var(cfg, var_name, CFG_string_type, &
|
|
size(char_data), comment, ix, dynamic_size)
|
|
|
|
if (cfg%vars(ix)%stored_data /= unstored_data_string) then
|
|
call read_variable(cfg%vars(ix))
|
|
else
|
|
cfg%vars(ix)%char_data = char_data
|
|
end if
|
|
end subroutine add_string_array
|
|
|
|
!> Add a configuration variable with an logical value
|
|
subroutine add_logic(cfg, var_name, logic_data, comment)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name, comment
|
|
logical, intent(in) :: logic_data
|
|
integer :: ix
|
|
|
|
call prepare_store_var(cfg, var_name, CFG_logic_type, 1, comment, ix)
|
|
|
|
if (cfg%vars(ix)%stored_data /= unstored_data_string) then
|
|
call read_variable(cfg%vars(ix))
|
|
else
|
|
cfg%vars(ix)%logic_data(1) = logic_data
|
|
end if
|
|
end subroutine add_logic
|
|
|
|
!> Add a configuration variable with an array of type logical
|
|
subroutine add_logic_array(cfg, var_name, logic_data, &
|
|
comment, dynamic_size)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name, comment
|
|
logical, intent(in) :: logic_data(:)
|
|
logical, intent(in), optional :: dynamic_size
|
|
integer :: ix
|
|
|
|
call prepare_store_var(cfg, var_name, CFG_logic_type, &
|
|
size(logic_data), comment, ix, dynamic_size)
|
|
|
|
if (cfg%vars(ix)%stored_data /= unstored_data_string) then
|
|
call read_variable(cfg%vars(ix))
|
|
else
|
|
cfg%vars(ix)%logic_data = logic_data
|
|
end if
|
|
end subroutine add_logic_array
|
|
|
|
!> Get a real array of a given name
|
|
subroutine get_real_array(cfg, var_name, real_data)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name
|
|
real(dp), intent(inout) :: real_data(:)
|
|
integer :: ix
|
|
|
|
call prepare_get_var(cfg, var_name, CFG_real_type, &
|
|
size(real_data), ix)
|
|
real_data = cfg%vars(ix)%real_data
|
|
end subroutine get_real_array
|
|
|
|
!> Get a integer array of a given name
|
|
subroutine get_int_array(cfg, var_name, int_data)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name
|
|
integer, intent(inout) :: int_data(:)
|
|
integer :: ix
|
|
|
|
call prepare_get_var(cfg, var_name, CFG_integer_type, &
|
|
size(int_data), ix)
|
|
int_data = cfg%vars(ix)%int_data
|
|
end subroutine get_int_array
|
|
|
|
!> Get a character array of a given name
|
|
subroutine get_string_array(cfg, var_name, char_data)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name
|
|
character(len=*), intent(inout) :: char_data(:)
|
|
integer :: ix
|
|
|
|
call prepare_get_var(cfg, var_name, CFG_string_type, &
|
|
size(char_data), ix)
|
|
char_data = cfg%vars(ix)%char_data
|
|
end subroutine get_string_array
|
|
|
|
!> Get a logical array of a given name
|
|
subroutine get_logic_array(cfg, var_name, logic_data)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name
|
|
logical, intent(inout) :: logic_data(:)
|
|
integer :: ix
|
|
|
|
call prepare_get_var(cfg, var_name, CFG_logic_type, &
|
|
size(logic_data), ix)
|
|
logic_data = cfg%vars(ix)%logic_data
|
|
end subroutine get_logic_array
|
|
|
|
!> Get a real value of a given name
|
|
subroutine get_real(cfg, var_name, res)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name
|
|
real(dp), intent(out) :: res
|
|
integer :: ix
|
|
|
|
call prepare_get_var(cfg, var_name, CFG_real_type, 1, ix)
|
|
res = cfg%vars(ix)%real_data(1)
|
|
end subroutine get_real
|
|
|
|
!> Get a integer value of a given name
|
|
subroutine get_int(cfg, var_name, res)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name
|
|
integer, intent(inout) :: res
|
|
integer :: ix
|
|
|
|
call prepare_get_var(cfg, var_name, CFG_integer_type, 1, ix)
|
|
res = cfg%vars(ix)%int_data(1)
|
|
end subroutine get_int
|
|
|
|
!> Get a logical value of a given name
|
|
subroutine get_logic(cfg, var_name, res)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name
|
|
logical, intent(out) :: res
|
|
integer :: ix
|
|
|
|
call prepare_get_var(cfg, var_name, CFG_logic_type, 1, ix)
|
|
res = cfg%vars(ix)%logic_data(1)
|
|
end subroutine get_logic
|
|
|
|
!> Get a character value of a given name
|
|
subroutine get_string(cfg, var_name, res)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name
|
|
character(len=*), intent(out) :: res
|
|
integer :: ix
|
|
|
|
call prepare_get_var(cfg, var_name, CFG_string_type, 1, ix)
|
|
res = cfg%vars(ix)%char_data(1)
|
|
end subroutine get_string
|
|
|
|
!> Get or add a real array of a given name
|
|
subroutine add_get_real_array(cfg, var_name, real_data, &
|
|
comment, dynamic_size)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name, comment
|
|
real(dp), intent(inout) :: real_data(:)
|
|
logical, intent(in), optional :: dynamic_size
|
|
|
|
call add_real_array(cfg, var_name, real_data, comment, dynamic_size)
|
|
call get_real_array(cfg, var_name, real_data)
|
|
end subroutine add_get_real_array
|
|
|
|
!> Get or add a integer array of a given name
|
|
subroutine add_get_int_array(cfg, var_name, int_data, &
|
|
comment, dynamic_size)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name, comment
|
|
integer, intent(inout) :: int_data(:)
|
|
logical, intent(in), optional :: dynamic_size
|
|
|
|
call add_int_array(cfg, var_name, int_data, comment, dynamic_size)
|
|
call get_int_array(cfg, var_name, int_data)
|
|
end subroutine add_get_int_array
|
|
|
|
!> Get or add a character array of a given name
|
|
subroutine add_get_string_array(cfg, var_name, char_data, &
|
|
comment, dynamic_size)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name, comment
|
|
character(len=*), intent(inout) :: char_data(:)
|
|
logical, intent(in), optional :: dynamic_size
|
|
|
|
call add_string_array(cfg, var_name, char_data, comment, dynamic_size)
|
|
call get_string_array(cfg, var_name, char_data)
|
|
end subroutine add_get_string_array
|
|
|
|
!> Get or add a logical array of a given name
|
|
subroutine add_get_logic_array(cfg, var_name, logic_data, &
|
|
comment, dynamic_size)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name, comment
|
|
logical, intent(inout) :: logic_data(:)
|
|
logical, intent(in), optional :: dynamic_size
|
|
|
|
call add_logic_array(cfg, var_name, logic_data, comment, dynamic_size)
|
|
call get_logic_array(cfg, var_name, logic_data)
|
|
end subroutine add_get_logic_array
|
|
|
|
!> Get or add a real value of a given name
|
|
subroutine add_get_real(cfg, var_name, real_data, comment)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name, comment
|
|
real(dp), intent(inout) :: real_data
|
|
|
|
call add_real(cfg, var_name, real_data, comment)
|
|
call get_real(cfg, var_name, real_data)
|
|
end subroutine add_get_real
|
|
|
|
!> Get or add a integer value of a given name
|
|
subroutine add_get_int(cfg, var_name, int_data, comment)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name, comment
|
|
integer, intent(inout) :: int_data
|
|
|
|
call add_int(cfg, var_name, int_data, comment)
|
|
call get_int(cfg, var_name, int_data)
|
|
end subroutine add_get_int
|
|
|
|
!> Get or add a logical value of a given name
|
|
subroutine add_get_logic(cfg, var_name, logical_data, comment)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name, comment
|
|
logical, intent(inout) :: logical_data
|
|
|
|
call add_logic(cfg, var_name, logical_data, comment)
|
|
call get_logic(cfg, var_name, logical_data)
|
|
end subroutine add_get_logic
|
|
|
|
!> Get a character value of a given name
|
|
subroutine add_get_string(cfg, var_name, string_data, comment)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
character(len=*), intent(in) :: var_name, comment
|
|
character(len=*), intent(inout) :: string_data
|
|
|
|
call add_string(cfg, var_name, string_data, comment)
|
|
call get_string(cfg, var_name, string_data)
|
|
end subroutine add_get_string
|
|
|
|
!> Get the size of a variable
|
|
subroutine CFG_get_size(cfg, var_name, res)
|
|
type(CFG_t), intent(in) :: cfg
|
|
character(len=*), intent(in) :: var_name
|
|
integer, intent(out) :: res
|
|
integer :: ix
|
|
|
|
call get_var_index(cfg, var_name, ix)
|
|
if (ix /= -1) then
|
|
res = cfg%vars(ix)%var_size
|
|
else
|
|
res = -1
|
|
call handle_error("CFG_get_size: variable ["//var_name//"] not found")
|
|
end if
|
|
end subroutine CFG_get_size
|
|
|
|
!> Get the type of a given variable of a configuration type
|
|
subroutine CFG_get_type(cfg, var_name, res)
|
|
type(CFG_t), intent(in) :: cfg
|
|
character(len=*), intent(in) :: var_name
|
|
integer, intent(out) :: res
|
|
integer :: ix
|
|
|
|
call get_var_index(cfg, var_name, ix)
|
|
|
|
if (ix /= -1) then
|
|
res = cfg%vars(ix)%var_type
|
|
else
|
|
res = -1
|
|
call handle_error("CFG_get_type: variable ["//var_name//"] not found")
|
|
end if
|
|
end subroutine CFG_get_type
|
|
|
|
!> Routine to ensure that enough storage is allocated for the configuration
|
|
!> type. If not the new size will be twice as much as the current size. If no
|
|
!> storage is allocated yet a minumum amount of starage is allocated.
|
|
subroutine ensure_free_storage(cfg)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
type(CFG_var_t), allocatable :: cfg_copy(:)
|
|
integer, parameter :: min_dyn_size = 100
|
|
integer :: cur_size, new_size
|
|
|
|
if (allocated(cfg%vars)) then
|
|
cur_size = size(cfg%vars)
|
|
|
|
if (cur_size < cfg%num_vars + 1) then
|
|
new_size = 2 * cur_size
|
|
allocate(cfg_copy(cur_size))
|
|
cfg_copy = cfg%vars
|
|
deallocate(cfg%vars)
|
|
allocate(cfg%vars(new_size))
|
|
cfg%vars(1:cur_size) = cfg_copy
|
|
end if
|
|
else
|
|
allocate(cfg%vars(min_dyn_size))
|
|
end if
|
|
|
|
end subroutine ensure_free_storage
|
|
|
|
!> Routine to find the indices of entries in a string
|
|
subroutine get_fields_string(line, delims, n_max, n_found, ixs_start, ixs_end)
|
|
!> The line from which we want to read
|
|
character(len=*), intent(in) :: line
|
|
!> A string with delimiters. For example delims = " ,'"""//tab_char
|
|
character(len=*), intent(in) :: delims
|
|
!> Maximum number of entries to read in
|
|
integer, intent(in) :: n_max
|
|
!> Number of entries found
|
|
integer, intent(inout) :: n_found
|
|
!> On return, ix_start(i) holds the starting point of entry i
|
|
integer, intent(inout) :: ixs_start(n_max)
|
|
!> On return, ix_end(i) holds the end point of entry i
|
|
integer, intent(inout) :: ixs_end(n_max)
|
|
|
|
integer :: ix, ix_prev
|
|
|
|
ix_prev = 0
|
|
n_found = 0
|
|
|
|
do while (n_found < n_max)
|
|
|
|
! Find the starting point of the next entry (a non-delimiter value)
|
|
ix = verify(line(ix_prev+1:), delims)
|
|
if (ix == 0) exit
|
|
|
|
n_found = n_found + 1
|
|
ixs_start(n_found) = ix_prev + ix ! This is the absolute position in 'line'
|
|
|
|
! Get the end point of the current entry (next delimiter index minus one)
|
|
ix = scan(line(ixs_start(n_found)+1:), delims) - 1
|
|
|
|
if (ix == -1) then ! If there is no last delimiter,
|
|
ixs_end(n_found) = len(line) ! the end of the line is the endpoint
|
|
else
|
|
ixs_end(n_found) = ixs_start(n_found) + ix
|
|
end if
|
|
|
|
ix_prev = ixs_end(n_found) ! We continue to search from here
|
|
end do
|
|
|
|
end subroutine get_fields_string
|
|
|
|
!> Performa a binary search for the variable 'var_name'
|
|
subroutine binary_search_variable(cfg, var_name, ix)
|
|
type(CFG_t), intent(in) :: cfg
|
|
character(len=*), intent(in) :: var_name
|
|
integer, intent(out) :: ix
|
|
integer :: i_min, i_max, i_mid
|
|
|
|
i_min = 1
|
|
i_max = cfg%num_vars
|
|
ix = - 1
|
|
|
|
do while (i_min < i_max)
|
|
i_mid = i_min + (i_max - i_min) / 2
|
|
if ( llt(cfg%vars(i_mid)%var_name, var_name) ) then
|
|
i_min = i_mid + 1
|
|
else
|
|
i_max = i_mid
|
|
end if
|
|
end do
|
|
|
|
! If not found, binary_search_variable is not set here, and stays -1
|
|
if (i_max == i_min .and. cfg%vars(i_min)%var_name == var_name) then
|
|
ix = i_min
|
|
else
|
|
ix = -1
|
|
end if
|
|
end subroutine binary_search_variable
|
|
|
|
!> Sort the variables for faster lookup
|
|
subroutine CFG_sort(cfg)
|
|
type(CFG_t), intent(inout) :: cfg
|
|
|
|
call qsort_config(cfg%vars(1:cfg%num_vars))
|
|
cfg%sorted = .true.
|
|
end subroutine CFG_sort
|
|
|
|
!> Simple implementation of quicksort algorithm to sort the variable list alphabetically.
|
|
recursive subroutine qsort_config(list)
|
|
type(CFG_var_t), intent(inout) :: list(:)
|
|
integer :: split_pos
|
|
|
|
if (size(list) > 1) then
|
|
call parition_var_list(list, split_pos)
|
|
call qsort_config( list(:split_pos-1) )
|
|
call qsort_config( list(split_pos:) )
|
|
end if
|
|
end subroutine qsort_config
|
|
|
|
!> Helper routine for quicksort, to perform partitioning
|
|
subroutine parition_var_list(list, marker)
|
|
type(CFG_var_t), intent(inout) :: list(:)
|
|
integer, intent(out) :: marker
|
|
integer :: left, right, pivot_ix
|
|
type(CFG_var_t) :: temp
|
|
character(len=CFG_name_len) :: pivot_value
|
|
|
|
left = 0
|
|
right = size(list) + 1
|
|
|
|
! Take the middle element as pivot
|
|
pivot_ix = size(list) / 2
|
|
pivot_value = list(pivot_ix)%var_name
|
|
|
|
do while (left < right)
|
|
|
|
right = right - 1
|
|
do while (lgt(list(right)%var_name, pivot_value))
|
|
right = right - 1
|
|
end do
|
|
|
|
left = left + 1
|
|
do while (lgt(pivot_value, list(left)%var_name))
|
|
left = left + 1
|
|
end do
|
|
|
|
if (left < right) then
|
|
temp = list(left)
|
|
list(left) = list(right)
|
|
list(right) = temp
|
|
end if
|
|
end do
|
|
|
|
if (left == right) then
|
|
marker = left + 1
|
|
else
|
|
marker = left
|
|
end if
|
|
end subroutine parition_var_list
|
|
|
|
!> Clear all data from a CFG_t object, so that it can be reused. Note that
|
|
!> this also happens automatically when such an object goes out of scope.
|
|
subroutine CFG_clear(cfg)
|
|
implicit none
|
|
type(CFG_t) :: cfg
|
|
|
|
cfg%sorted = .false.
|
|
cfg%num_vars = 0
|
|
if(allocated(cfg%vars)) then
|
|
deallocate(cfg%vars)
|
|
endif
|
|
end subroutine CFG_clear
|
|
|
|
end module m_config
|