diff --git a/src/Config_Fortran/Makefile b/src/Config_Fortran/Makefile new file mode 100644 index 0000000..e139e6a --- /dev/null +++ b/src/Config_Fortran/Makefile @@ -0,0 +1,34 @@ +# Use gfortran unless already defined +F90 ?= ifort + +ifeq ($(F90), gfortran) + FFLAGS ?= -O2 -g -std=f2008 -Wall -Wextra +else ifeq ($(F90), ifort) + FFLAGS := -O2 -stand f08 -warn all +endif + +OBJS := m_config.o +LIB := libconfig_fortran.a +EXAMPLES := example_1 example_2 + +.PHONY: all test clean + +all: $(LIB) $(EXAMPLES) + +$(LIB): $(OBJS) + $(RM) $@ + $(AR) rcs $@ $^ + +clean: + $(RM) $(EXAMPLES) m_config.o m_config.mod $(LIB) + +# Dependency information +$(EXAMPLES): m_config.o + +# How to get .o object files from .f90 source files +%.o: %.f90 + $(F90) -c -o $@ $< $(FFLAGS) + +# How to get executables from .o object files +%: %.o + $(F90) -o $@ $^ $(FFLAGS) diff --git a/src/Config_Fortran/README.md b/src/Config_Fortran/README.md new file mode 100644 index 0000000..f67ad2e --- /dev/null +++ b/src/Config_Fortran/README.md @@ -0,0 +1,164 @@ +# config_fortran + +A configuration file parser for Fortran. The intended usage is as follows: + +1. You create your configuration variables, by providing a default value and + a description. +2. You read in a text file in which new values are specified for (some of) the + variables. +3. You use the updated values in your program, so that there is no need to recompile. + +Steps 1 and 2 can also be reversed, so that you read in the configuration files +before specifying the variables. Variables can be of type integer, real, +logical/bool, or string, and they can also be an array of such types. + +## Example + +Suppose you want to use a grid of size `n_grid`, then you could do: + + integer :: n_grid + type(CFG_t) :: my_cfg + + call CFG_add(my_cfg, "grid_size", 1024, "Size of the grid") + call CFG_read_file(my_cfg, "my_input_file.txt") + call CFG_get(my_cfg, "grid_size", n_grid) + +Here, the default grid size will be 1024. If the file `my_input_file.txt` contains a line + + grid_size = 512 + +the actual grid size used in your program will be 512. It is also possible to +read the file first, and to combine the `add` and the `get`: + + integer :: n_grid = 1024 + type(CFG_t) :: my_cfg + + call CFG_read_file(my_cfg, "my_input_file.txt") + call CFG_add_get(my_cfg, "grid_size", n_grid, "Size of the grid") + +When parsing the input file, the variable `n_grid` will be stored as plain text, +since its type is not yet known. The call `CFG_add_get` converts it to the right +type. The files `example_1.f90` and `example_2.f90` provide further usage +examples. + +The current configuration can be stored in a file with `CFG_write`, which can +then be used as input again. It is also possible to write markdown files with +`CFG_write_markdown`. Writing to the special file name `"stdout"` causes the +configuration to be printed to the screen. By specifying the optional argument +`hide_unused=.true.`, only the variables whose value was used through a +`CFG_get` (or `CFG_add_get`) are included. + +## Command line arguments + +A routine `CFG_update_from_arguments` is included, which parses command line arguments. Currently, two types of arguments are supported, as shown in the examples below. + + # Read in two configuration files + ./my_program config_1.cfg config_2.cfg + + # Read in two variables + ./my_program -var_1=value -var_2=value + + # Read in an array of variables + ./my_program -var_2='value value' + + # Mix the above options + ./my_program config_1.cfg config_2.cfg -var_1=value -var_2=value + +Note that variable specifications should be preceded by a dash (`-`). + +## Configuration file syntax + +There are different types of lines: + +1. Blank lines, or lines only containing a comment (`# ...` or `; ...`), which are ignored. +2. Lines indicating the start of a category: `[category_name]` +3. Lines with an `=`-sign. If they are part of a user-defined category, they + should start with an indent. +4. Lines with a `+=` sign. For a scalar string variable, this will append to the + string. On an array, this will append an element to the array. On other types + of variables, this operation gives an error. + +An example of a configuration file is shown below + + age = 29 + name = John + + [weather] + temperature = 25.2 + humidity = 23.5 + + happy = .true. + + weather%temperature = 23.9 + +Note that `temperature` and `humidity` are indented, and that `happy` is not, +which means that `happy` is not part of weather (it is in the default unnamed +category). At least two spaces or a tab counts as indentation. Outside an indented +`[weather]` group, you can directly refer to its members by using e.g. +`weather%temperature`, as is done on the last line. To place variables in a +category, you add them like this: + + call CFG_add(my_cfg, "weather%temperature", 25.0_dp, "The temperature") + +Variables can also be arrays: + + name_of_variable = value1 [value2 value3 ...] # Optional comment + +The extra values `[value2 value3 ...]` are omitted for a scalar variable. You +can create variables of varying array size, by specifying `dynamic_size=.true.` +when creating a config variable: + + call CFG_add(my_cfg, "numbers", [1, 2], "Comment", dynamic_size=.true.) + +## Methods + +* `CFG_add`: Add a variable to the configuration +* `CFG_get`: Get the value of a variable +* `CFG_add_get`: First `CFG_add`, then `CFG_get` +* `CFG_check`: Check whether all variables read from files have been defined. + This is automatically performed on `CFG_write` and `CFG_write_markdown`. +* `CFG_get_size`: Get the array size of a variable +* `CFG_get_type`: Get the type of a variable +* `CFG_sort`: Sort the configuration (for faster lookup when there are many variables) +* `CFG_write`: Write the configuration to a standard text/config file, which can + be read in again. By default, only the variables that were used are printed. +* `CFG_write_markdown`: Write the configuration to a file in markdown format +* `CFG_read_file`: Read in a configuration file +* `CFG_update_from_arguments`: Read in the program's arguments as configuration files. +* `CFG_clear`: Clear config for reuse + +## Requirements + +A modern Fortran compiler that supports Fortran 2008. The included `Makefile` +was written for `gfortran` (the default) and `ifort`, which you can enable by +typing `make F90=ifort`. + +## Comparison to Fortran namelists + +Benefits of config_fortran: + +* You can read in (1D) arrays of unknown size +* Settings have documentation, and you can write "documented" output in text or markdown format +* If you don't want to use global variables, you have to open and read namelists in each module that requires parameters. I think it's nicer to read in a config_fortran type object once and pass that to the modules +* You can spread out settings over multiple files, which is convenient for setting up parameter studies (this can be done with namelists, but it's not trivial) +* Flexibility: although namelist implementations slightly differ, you cannot change them like you can config_fortran. Config_fortran for example allows to write only those settings that have been requested in a program. + +Benefits of namelist format: + +* More standard, although not completely the same for different vendors/versions yet +* Support for array(3) = ... syntax +* Support for array = 10*'dummy' syntax + +(*Of course, points 2 & 3 could easily be implemented in config_fortran*) + +## Alternatives + +* [libconfig](http://www.hyperrealm.com/libconfig/) (C/C++) +* [config4*](http://www.config4star.org/) (C/C++) +* [KRACKEN](http://www.urbanjost.altervista.org/LIBRARY/libCLI/arguments/src2015/krackenhelp.html) (Fortran argument parser) +* [FLAP](https://github.com/szaghi/FLAP) (Fortran 2003+ argument parser) +* [FiNeR](https://github.com/szaghi/FiNeR) (Fortran 2003+ config file parser) + +## TODO + +* Write tests diff --git a/src/Config_Fortran/benzene.xyz b/src/Config_Fortran/benzene.xyz new file mode 100644 index 0000000..c45fd86 --- /dev/null +++ b/src/Config_Fortran/benzene.xyz @@ -0,0 +1,14 @@ +12 +benzene example + C 0.00000 1.40272 0.00000 + H 0.00000 2.49029 0.00000 + C -1.21479 0.70136 0.00000 + H -2.15666 1.24515 0.00000 + C -1.21479 -0.70136 0.00000 + H -2.15666 -1.24515 0.00000 + C 0.00000 -1.40272 0.00000 + H 0.00000 -2.49029 0.00000 + C 1.21479 -0.70136 0.00000 + H 2.15666 -1.24515 0.00000 + C 1.21479 0.70136 0.00000 + H 2.15666 1.24515 0.00000 \ No newline at end of file diff --git a/src/Config_Fortran/example_1.f90 b/src/Config_Fortran/example_1.f90 new file mode 100644 index 0000000..9ca721d --- /dev/null +++ b/src/Config_Fortran/example_1.f90 @@ -0,0 +1,138 @@ +program test_m_config + use m_config + + integer, parameter :: dp = kind(0.0d0) + type(CFG_t) :: my_cfg + + ! Some dummy variables + real(dp), allocatable :: trial_energy(:) + integer :: n_reals + character(len=20) :: fmt_string + + character(len=20) :: sections + logical :: optimize_wavefunction, optimize_ci + logical :: optimize_jastrow, optimize_orbitals + + ! general block + character(len=100) :: title, filename, molecule + character(len=50) :: output_directory + character(len=50) :: pool + character(len=50) :: basis + character(len=50) :: pseudo + + ! mixed block + + character(len=20) :: unit + integer :: maximum_iterations + logical :: restart_vmc + + + + ! title and external files + call CFG_add(my_cfg, "title", "this/is/a/filename", & + "A string containing a filename") + + call CFG_add(my_cfg, "filename", "this/is/a/filename", & + "A string containing a filename") + + call CFG_add(my_cfg, "molecule", "h2o.xyz", & + "Molecule's coordinates in xyz file format") + + + + ! General block + call CFG_add(my_cfg, "general%output_directory", "./", & + "output directory") + + call CFG_add(my_cfg, "general%pool", "./pool", & + "a pool directory containing required files") + + call CFG_add(my_cfg, "general%basis", "./pool/basis", & + "a basis file with its location") + + call CFG_add(my_cfg, "general%pseudo", "./pool/pseudo", & + "a pseudopotential file with its location") + + + ! a block containing mixed data + call CFG_add(my_cfg, "mixed%unit", "eV", & + "Energy unit") + + call CFG_add(my_cfg, "mixed%maximum_iterations", 250, & + "Maximum iterations") + + call CFG_add(my_cfg, "mixed%trial_energy", (/13.37_dp, 13.40_dp, 13.80_dp , 14.00_dp /), & + "Trial energies", dynamic_size=.true.) + + call CFG_add(my_cfg, "mixed%restart_vmc", .true., & + "Restart VMC ? ") + + + ! optimization block logical + call CFG_add(my_cfg, "optimization_flags%optimize_wavefunction", .false., & + "optimize wavefunctions") + + call CFG_add(my_cfg, "optimization_flags%optimize_ci", .false., & + "optimize ci") + + call CFG_add(my_cfg, "optimization_flags%optimize_orbitals", .false., & + "optimize orbitals") + + call CFG_add(my_cfg, "optimization_flags%optimize_jastrow", .false., & + "optimize jastrow") + + + ! Sort the configuration (this can speed up looking for variables, but only if + ! you have a sufficiently large number of them) + call CFG_sort(my_cfg) + + + print *, "Reading in example_1_input.cfg" + call CFG_read_file(my_cfg, "example_1_input.cfg") ! Update values with file + + print *, "----------------------------------------" + + print *, "----------------------------------------" + print *, "The code below demonstrates how to get values: " + print *, "----------------------------------------" + print *, "" + ! Ravindra added stuff + + ! title and external files + call CFG_get(my_cfg, "title", title) + call CFG_get(my_cfg, "filename", filename) + call CFG_get(my_cfg, "molecule", molecule) + + + call CFG_get(my_cfg, "general%output_directory", output_directory) + call CFG_get(my_cfg, "general%pool", pool) + call CFG_get(my_cfg, "general%basis", basis) + call CFG_get(my_cfg, "general%pseudo", pseudo) + + + call CFG_get(my_cfg, "mixed%unit", unit) + call CFG_get(my_cfg, "mixed%maximum_iterations", maximum_iterations) + call CFG_get(my_cfg, "mixed%restart_vmc", restart_vmc) + + call CFG_get_size(my_cfg, "mixed%trial_energy", n_reals) + ! Generate format string for trial energy values + write(fmt_string, "(A,I0,A)") "(A25,", n_reals, "F10.5)" + + allocate(trial_energy(n_reals)) + call CFG_get(my_cfg, "mixed%trial_energy", trial_energy) +! write(*, fmt_string) "Trial Energies ", trial_energy + deallocate(trial_energy) + + + call CFG_get(my_cfg, "optimization_flags%optimize_wavefunction", optimize_wavefunction) + call CFG_get(my_cfg, "optimization_flags%optimize_ci", optimize_ci) + call CFG_get(my_cfg, "optimization_flags%optimize_orbitals", optimize_orbitals) + call CFG_get(my_cfg, "optimization_flags%optimize_jastrow", optimize_jastrow) + + + ! final printing part + call CFG_write(my_cfg, "stdout") ! Write to stdout + call CFG_write(my_cfg, "example_1_output.cfg") ! Write to file + call CFG_write_markdown(my_cfg, "example_1_output.md") ! Write markdown file + +end program test_m_config diff --git a/src/Config_Fortran/example_1_input.cfg b/src/Config_Fortran/example_1_input.cfg new file mode 100644 index 0000000..5a689f0 --- /dev/null +++ b/src/Config_Fortran/example_1_input.cfg @@ -0,0 +1,31 @@ + +# Quotation marks for strings are optional + +title = "A sample champ input file specification in config format" + +[general] + output_directory = "./" + pool = ./pool + basis = ./pool/BFD-T-normf0 + pseudo = "./pool/BFD" + +[mixed] + # energy units + unit = "Ha" + maximum_iterations = 1000 # max_iter + trial_energy = 12.0 12.4 12.6 12.8 13.0 # a range can be specified + restart_vmc = true # .true. T true TRUE + + +# A string containing a filename: +filename = 'another_file' + +# load molecular coordinates using special keyword molecule +molecule = benzene.xyz + + +[optimization_flags] + optimize_wavefunction = F # Comments after the keywords allowed + optimize_ci = true + optimize_orbitals = .true. + optimize_jastrow = true diff --git a/src/Config_Fortran/example_1_output.cfg b/src/Config_Fortran/example_1_output.cfg new file mode 100644 index 0000000..5d1fd46 --- /dev/null +++ b/src/Config_Fortran/example_1_output.cfg @@ -0,0 +1,48 @@ +# A string containing a filename: +filename = 'another_file' + +[general] + # a basis file with its location: + basis = './pool/BFD-T-normf0' + + # output directory: + output_directory = './' + + # a pool directory containing required files: + pool = './pool' + + # a pseudopotential file with its location: + pseudo = './pool/BFD' + +[mixed] + # Maximum iterations: + maximum_iterations = 1000 + + # Restart VMC ?: + restart_vmc = T + + # Trial energies: + trial_energy = 12.000000 12.400000 12.600000 12.800000 13.000000 + + # Energy unit: + unit = 'Ha' + +# Molecule's coordinates in xyz file format: +molecule = 'benzene.xyz' + +[optimization_flags] + # optimize ci: + optimize_ci = T + + # optimize jastrow: + optimize_jastrow = T + + # optimize orbitals: + optimize_orbitals = T + + # optimize wavefunctions: + optimize_wavefunction = F + +# A string containing a filename: +title = 'A sample champ input file specification in config format' + diff --git a/src/Config_Fortran/example_1_output.md b/src/Config_Fortran/example_1_output.md new file mode 100644 index 0000000..1328e63 --- /dev/null +++ b/src/Config_Fortran/example_1_output.md @@ -0,0 +1,74 @@ +# Configuration file (markdown format) + +## No category + +* A string containing a filename + + filename = 'another_file' + +## general + +* a basis file with its location + + basis = './pool/BFD-T-normf0' + +* output directory + + output_directory = './' + +* a pool directory containing required files + + pool = './pool' + +* a pseudopotential file with its location + + pseudo = './pool/BFD' + +## mixed + +* Maximum iterations + + maximum_iterations = 1000 + +* Restart VMC ? + + restart_vmc = T + +* Trial energies + + trial_energy = 12.000000 12.400000 12.600000 12.800000 13.000000 + +* Energy unit + + unit = 'Ha' + +## No category + +* Molecule's coordinates in xyz file format + + molecule = 'benzene.xyz' + +## optimization_flags + +* optimize ci + + optimize_ci = T + +* optimize jastrow + + optimize_jastrow = T + +* optimize orbitals + + optimize_orbitals = T + +* optimize wavefunctions + + optimize_wavefunction = F + +## No category + +* A string containing a filename + + title = 'A sample champ input file specification in config format' + diff --git a/src/Config_Fortran/example_2.f90 b/src/Config_Fortran/example_2.f90 new file mode 100644 index 0000000..936a26b --- /dev/null +++ b/src/Config_Fortran/example_2.f90 @@ -0,0 +1,39 @@ +program test_m_config2 + use m_config + + integer, parameter :: dp = kind(0.0d0) + type(CFG_t) :: my_cfg + + ! Some dummy variables + integer :: my_int + + print *, "Testing m_config.f90 (test 2)" + print *, "This program reads its arguments as configuration files" + print *, "Try running it like this:" + print *, "./example_2" + print *, "./example_2 example_2_input.cfg -array%int='13 37'" + print *, "" + + call CFG_update_from_arguments(my_cfg) + + call CFG_add(my_cfg, "scalar%real", 1.0_dp, "my_real") + call CFG_add(my_cfg, "scalar%logic", .true., "my_logic") + + print *, "Using CFG_add_get you can immediately get the value" + print *, "that previously has been read in, for example:" + my_int = 5 + call CFG_add_get(my_cfg, "scalar%int", my_int, "my_int") + print *, "scalar%int: ", my_int + print *, "" + + call CFG_add(my_cfg, "scalar%string", "a string", "my_string") + call CFG_add(my_cfg, "array%real", [1.0_dp, 2.0_dp], "my_reals", dynamic_size=.true.) + call CFG_add(my_cfg, "array%logic", [.true., .true.], "my_logics", dynamic_size=.true.) + call CFG_add(my_cfg, "array%int", [1, 2], "my_ints", dynamic_size=.true.) + call CFG_add(my_cfg, "array%string", ["A", "B"], "my_strings", dynamic_size=.true.) + + call CFG_write(my_cfg, "stdout", custom_first=.true.) ! Write to screen + call CFG_write(my_cfg, "example_2_output.cfg") ! Write to file + call CFG_write_markdown(my_cfg, "example_2_output.md") ! Write markdown file + +end program test_m_config2 diff --git a/src/Config_Fortran/example_2_input.cfg b/src/Config_Fortran/example_2_input.cfg new file mode 100644 index 0000000..a4f17bb --- /dev/null +++ b/src/Config_Fortran/example_2_input.cfg @@ -0,0 +1,25 @@ +[array] + # my_string_array: + string = 'hello' 'you' + + # my_int_array: + int = 5 6 + + # my_logic_array: + logic = f f + + # my_real_array: + real = 5. 6. + +[scalar] + # my_string: + string = 'book' + + # my_int: + int = 2 + + # my_logic: + logic = F + + # my_real: + real = 2. diff --git a/src/Config_Fortran/example_2_output.cfg b/src/Config_Fortran/example_2_output.cfg new file mode 100644 index 0000000..770d8db --- /dev/null +++ b/src/Config_Fortran/example_2_output.cfg @@ -0,0 +1,26 @@ +[array] + # my_ints: + int = 1 2 + + # my_logics: + logic = T T + + # my_reals: + real = 1.0000E+00 2.0000E+00 + + # my_strings: + string = 'A' 'B' + +[scalar] + # my_int: + int = 5 + + # my_logic: + logic = T + + # my_real: + real = 1.0000E+00 + + # my_string: + string = 'a string' + diff --git a/src/Config_Fortran/example_2_output.md b/src/Config_Fortran/example_2_output.md new file mode 100644 index 0000000..8b4acaf --- /dev/null +++ b/src/Config_Fortran/example_2_output.md @@ -0,0 +1,38 @@ +# Configuration file (markdown format) + +## array + +* my_ints + + int = 1 2 + +* my_logics + + logic = T T + +* my_reals + + real = 0.1000E+01 0.2000E+01 + +* my_strings + + string = 'A' 'B' + +## scalar + +* my_int + + int = 5 + +* my_logic + + logic = T + +* my_real + + real = 0.1000E+01 + +* my_string + + string = 'a string' + diff --git a/src/Config_Fortran/m_config.f90 b/src/Config_Fortran/m_config.f90 new file mode 100644 index 0000000..d150ced --- /dev/null +++ b/src/Config_Fortran/m_config.f90 @@ -0,0 +1,1441 @@ +!> 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