diff --git a/sources/io.F90 b/sources/io.F90 index ca3f3ed..b9c6452 100644 --- a/sources/io.F90 +++ b/sources/io.F90 @@ -1751,7 +1751,7 @@ module io use helpers , only : print_message use iso_c_binding, only : c_loc use mpitools , only : nprocs, nproc - use parameters , only : get_parameter_file + use parameters , only : parameter_file use random , only : gentype, nseeds, get_seeds use XML , only : XMLNode, XMLAddElement, & XMLInitTree, XMLFreeTree, XMLSaveTree @@ -1827,8 +1827,7 @@ module io if (nproc == 0) then - call get_parameter_file(str, status) - cmd = "cp -a " // trim(str) // " " // rpath + cmd = "cp -a " // parameter_file // " " // rpath if (status == 0) then call execute_command_line(cmd) else @@ -2194,7 +2193,7 @@ module io use helpers , only : print_message use iso_c_binding, only : c_loc use mpitools , only : nprocs, nproc - use parameters , only : get_parameter_file + use parameters , only : parameter_file use sources , only : viscosity, resistivity use XML , only : XMLNode, XMLAddElement, & XMLInitTree, XMLFreeTree, XMLSaveTree @@ -2252,8 +2251,7 @@ module io if (nproc == 0) then - call get_parameter_file(str, status) - cmd = "cp -a " // trim(str) // " " // rpath + cmd = "cp -a " // parameter_file // " " // rpath if (status == 0) then call execute_command_line(cmd) else diff --git a/sources/parameters.F90 b/sources/parameters.F90 index 91060c8..86fcb2e 100644 --- a/sources/parameters.F90 +++ b/sources/parameters.F90 @@ -1,39 +1,44 @@ -!!****************************************************************************** -!! -!! This file is part of the AMUN source code, a program to perform -!! Newtonian or relativistic magnetohydrodynamical simulations on uniform or -!! adaptive mesh. -!! -!! Copyright (C) 2008-2023 Grzegorz Kowal -!! -!! This program is free software: you can redistribute it and/or modify -!! it under the terms of the GNU General Public License as published by -!! the Free Software Foundation, either version 3 of the License, or -!! (at your option) any later version. -!! -!! This program is distributed in the hope that it will be useful, -!! but WITHOUT ANY WARRANTY; without even the implied warranty of -!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -!! GNU General Public License for more details. -!! -!! You should have received a copy of the GNU General Public License -!! along with this program. If not, see . -!! -!!****************************************************************************** -!! -!! module: PARAMETERS -!! -!! This module handles runtime parameters by reading them from a parameter -!! file and distributing among all processes. -!! -!!****************************************************************************** +!=============================================================================== +! +! This file is part of the source code of AMUN, a magnetohydrodynamic +! (classical and relativistic) plasma modeling software for the study of +! astrophysical phenomena. +! +! Copyright (C) 2008-2023 Grzegorz Kowal +! +! +! This program is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program. If not, see . +! +!=============================================================================== +! +! Name: PARAMETERS +! +! Description: +! +! This module handles runtime parameters by reading them from a parameter +! file and distributing among all processes. +! +!------------------------------------------------------------------------------- ! module parameters implicit none -! MODULE INTERFACES: -! ================= + private + +! MODULE INTERFACES +! ----------------- ! interface get_parameter module procedure get_parameter_integer @@ -41,62 +46,48 @@ module parameters module procedure get_parameter_string end interface -! MODULE PARAMETERS: -! ================= +! MODULE STRUCTURES +! ----------------- ! -! module parameters determining the name and value field lengths, and the -! maximum string length -! - integer, parameter :: nlen = 64, vlen = 128, mlen = 256 + type item + character(len=:), allocatable :: key, val -! the name of the parameter file -! - character(len=mlen), save :: fname = './params.in' + type(item), pointer :: next + end type -! a file handler to the parameter file +! MODULE VARIABLES +! ---------------- ! - integer(kind=4) , save :: punit = 10 + character(len=:), allocatable :: parameter_file + type(item) , pointer :: parameter_list => null() -! the number of parameters stored in the parameter file -! - integer , save :: nparams = 0 -! allocatable arrays to store parameter names and values -! - character(len=nlen), dimension(:), allocatable, save :: pnames - character(len=vlen), dimension(:), allocatable, save :: pvalues - -! by default everything is private -! - private - -! declare public subroutines +! PUBLIC MEMBERS +! -------------- ! public :: read_parameters, finalize_parameters - public :: get_parameter_file, get_parameter + public :: parameter_file, get_parameter -!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -! contains -! + !=============================================================================== ! ! subroutine READ_PARAMETERS: ! -------------------------- ! +! Description: +! ! Subroutine checks if the parameter file exists, checks its length, ! allocates structures to store all parameters provided in the parameters ! file and read parameters into these structures. ! -! Arguments: +! There is a possibility to specify customized input file by adding a +! command line option -i or --input followed by the name of the input file. ! -! verbose - the flag determining if the subroutine should be verbose; -! status - the return flag of the procedure execution status; +! Arguments: ! -! Note: -! -! There is a possibility to specify customized input file by adding a -! command line option -i or --input followed by the name of the input file. +! verbose - the flag determining if the subroutine should be verbose; +! status - the return flag of the procedure execution status; ! !=============================================================================== ! @@ -109,7 +100,7 @@ module parameters logical, intent(in) :: verbose integer, intent(out) :: status - character(len=mlen) :: opt, arg + character(len=4096) :: arg integer :: l logical :: info @@ -117,75 +108,48 @@ module parameters ! status = 0 -! parse the command line to check if a different parameter file has been -! provided + parameter_file = 'params.in' + +! parse the command line to check for the parameter file ! do l = 1, command_argument_count() call get_command_argument(l, arg) if (trim(arg) == '-i' .or. trim(arg) == '--input') then - opt = trim(arg) - call get_command_argument(l + 1, arg) + call get_command_argument(l+1, arg) if (trim(arg) /= '') then - fname = trim(arg) + parameter_file = trim(arg) else - if (verbose) then - write(error_unit,*) "The option '" // trim(opt) // & - "' requires an argument! Exiting..." - end if + if (verbose) & + write(error_unit,*) & + "The option '--input' or '-i' requires an argument. Exiting..." status = 112 return end if + exit end if end do -! check if the file exists -! - inquire(file = fname, exist = info) + inquire(file=parameter_file, exist=info) if (info) then - -! obtain the number of parameters stored in the file -! - call get_parameters_number(status) - - if (status > 0) return - -! if the parameter file is empty, print an error and quit the subroutine -! - if (nparams <= 0) then - write(error_unit,*) "The parameter file '" // trim(fname) & - // "' is empty! Exiting..." - status = 110 - - return - end if - -! allocate arrays to store the parameter names and values as string variables -! - allocate(pnames (nparams)) - allocate(pvalues(nparams)) - -! get the parameter names and values and copy them to the corresponding arrays -! - call get_parameters(status) - + call parse_parameters(status) else - - write(error_unit,*) "The parameter file '" // trim(fname) & - // "' does not exist! Exiting..." + write(error_unit,*) "The parameter file '" // parameter_file // & + "' does not exist. Exiting..." status = 111 - end if !------------------------------------------------------------------------------- ! end subroutine read_parameters -! + !=============================================================================== ! ! subroutine FINALIZE_PARAMETERS: ! ------------------------------ ! +! Description: +! ! Subroutine releases memory used by arrays in this module. ! !=============================================================================== @@ -194,132 +158,42 @@ module parameters implicit none + type(item), pointer :: item_ptr + !------------------------------------------------------------------------------- ! - if (allocated(pnames) ) deallocate(pnames) - if (allocated(pvalues)) deallocate(pvalues) + item_ptr => parameter_list + do while(associated(item_ptr)) + parameter_list => parameter_list%next + + nullify(item_ptr%next) + deallocate(item_ptr%key, item_ptr%val) + deallocate(item_ptr) + + item_ptr => parameter_list + end do !------------------------------------------------------------------------------- ! end subroutine finalize_parameters -! + !=============================================================================== ! -! subroutine GET_PARAMETER_FILE: -! ----------------------------- +! subroutine PARSE_PARAMETERS: +! --------------------------- ! -! Subroutine returns the full path to the parameter file. -! -! Arguments: -! -! pfile - the parameter full file path; -! status - the status value, 0 for success; -! -!=============================================================================== -! - subroutine get_parameter_file(pfile, status) - - use iso_fortran_env, only : error_unit - - implicit none - - character(len=*), intent(out) :: pfile - integer , intent(out) :: status - - character(len=mlen) :: tfile - - character(len=*), parameter :: loc = 'PARAMETERS::get_parameter_file()' - -!------------------------------------------------------------------------------- -! - status = 0 - if (len(pfile) <= mlen) then - write(pfile,"(a)") trim(adjustl(fname)) - else - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Parameter file path too long for subroutine argument!" - write(tfile,"(a)") trim(adjustl(fname)) - write(pfile,"(a)") tfile(1:len(pfile)) - status = 1 - end if - -!------------------------------------------------------------------------------- -! - end subroutine get_parameter_file -! -!=============================================================================== -! -! subroutine GET_PARAMETERS_NUMBER: -! -------------------------------- -! -! Subroutine scans the input file and accounts the number of parameters -! stored in it. -! -! Arguments: -! -! status - the status value, 0 for success; -! -!=============================================================================== -! - subroutine get_parameters_number(status) - - use iso_fortran_env, only : error_unit - - implicit none - - integer, intent(out) :: status - - character(len=mlen) :: line - - character(len=*), parameter :: loc = 'PARAMETERS::get_parameters_number()' - -!------------------------------------------------------------------------------- -! - nparams = 0 - - open(newunit = punit, file = fname, err = 30) - -10 read(punit, fmt = "(a)", end = 20) line - -! if the line is empty or it's a comment, skip the counting -! - if ((len_trim(line) == 0) & - .or. index(trim(adjustl(line)), '#') == 1) go to 10 - - nparams = nparams + 1 - - go to 10 - -20 close(punit) - - return - -! print a massage if an error occurred -! -30 write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot open the parameter file '" // trim(fname) // "'!" - - status = 112 - -!------------------------------------------------------------------------------- -! - end subroutine get_parameters_number -! -!=============================================================================== -! -! subroutine GET_PARAMETERS: -! ------------------------- +! Description: ! ! Subroutine scans the input file, reads parameter names and values, and ! stores them in module arrays. ! -! Arguments: +! Arguments: ! -! status - the status value, 0 for success; +! status - the status value, 0 for success; ! !=============================================================================== ! - subroutine get_parameters(status) + subroutine parse_parameters(status) use iso_fortran_env, only : error_unit @@ -327,269 +201,257 @@ module parameters integer, intent(out) :: status - integer :: np, nl + type(item), pointer :: item_ptr - character(len=256) :: line, name, value + logical :: exists - character(len=*), parameter :: loc = 'PARAMETERS::get_parameters_number()' + integer :: io = 10, n, i, j + + character(len=:), allocatable :: line, key, val + + character(len=*), parameter :: loc = 'PARAMETERS::parse_parameters()' !------------------------------------------------------------------------------- ! - np = 1 - nl = 0 + status = 0 - open(newunit = punit, file = fname, err = 30) -10 read(punit, fmt = "(a)", end = 20) line + n = 0 + j = 1024 - nl = nl + 1 + inquire(file=parameter_file, size=j) -! if the line is empty or it's a comment, skip the counting + allocate(character(len=j) :: line) + + open(newunit=io, file=parameter_file, err=30) + +10 read(io, fmt="(a)", end=20) line + + n = n + 1 + +! remove comments ! - if ((len_trim(line) == 0) & - .or. index(trim(adjustl(line)), '#') == 1) go to 10 + i = index(line, '#') + if (i > 0) write(line,"(a)") trim(adjustl(line(:i-1))) -! parse the line to get parameter name and value +! skip empty lines ! - call parse_line(line, name, value, status) + if (len_trim(line) == 0) go to 10 -! check if the line was parsed successfuly +! process only lines containing '=' ! - if (status > 0) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Wrong parameter format in '" & - // trim(adjustl(fname)) // "'." - write (error_unit,"('[',a,']: Line',i4,' : ',a)") & - trim(loc), nl, trim(line) - go to 30 + i = index(line, '=') + if (i > 1) then + key = trim(adjustl(line(:i-1))) + + if (len_trim(key) > 0) then + val = trim(adjustl(line(i+1:))) + if (index(val, '"') > 0 .and. index(val, "'") > 0) then + status = 1 + else + i = index(val, '"') + if (i > 0) then + j = index(val, '"', back=.true.) + val = val(i+1:j-1) + end if + i = index(val, "'") + if (i > 0) then + j = index(val, "'", back=.true.) + val = val(i+1:j-1) + end if + end if + if (len_trim(val) == 0) status = 1 + else + status = 1 + end if + else + status = 1 end if -! fill the arrays of parameter names and values -! - pnames (np) = name (1:nlen) - pvalues(np) = value(1:vlen) + if (status > 0) then + write(error_unit,"('[',a,']: ',a)") loc, & + "Wrong parameter format in '" // parameter_file // "'." + write (error_unit,"('[',a,']: ',a,i0,':')") loc, "Verify line ", n + write (error_unit,"('[',a,']: ',a)") loc, trim(adjustl(line)) -! increase the parameter counter -! - np = np + 1 + go to 10 + end if -! go to the next line +! allocate a new item and add it to the parameter list ! + exists = .false. + item_ptr => parameter_list + do while(associated(item_ptr)) + if (key == item_ptr%key) then + exists = .true. + exit + end if + item_ptr => item_ptr%next + end do + if (exists) then + write(error_unit,"('[',a,']: ',a)") loc, "Parameter '" // key // & + "' appears multiple times. " // & + "Only the value of the first occurrence is considered." + else + allocate(item_ptr) + item_ptr%key = key + item_ptr%val = val + item_ptr%next => parameter_list + parameter_list => item_ptr + end if + go to 10 -20 close(punit) +20 close(io) + + deallocate(line) return -30 write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot open the parameter file '" // trim(fname) // "'!" +30 write(error_unit,"('[',a,']: ',a)") loc, & + "Unable to open the parameter file '" // & + parameter_file // "'!" status = 140 !------------------------------------------------------------------------------- ! - end subroutine get_parameters -! -!=============================================================================== -! -! subroutine PARSE_LINE: -! --------------------- -! -! Subroutine extracts the parameter name and value from the input line. -! -! Arguments: -! -! line - the input line containing the parameter information; -! name - the extracted name of the parameter; -! value - the extracted value of the parameter; -! status - the status value, 0 for success; -! -!=============================================================================== -! - subroutine parse_line(line, name, value, status) + end subroutine parse_parameters - implicit none - - character(len=*), intent(in) :: line - character(len=*), intent(inout) :: name, value - integer , intent(out) :: status - - integer :: l, p, c, i, j = 1 - -!------------------------------------------------------------------------------- -! - status = 0 - - l = len_trim(line) - -! find the indices of '=' and '#' in the line -! - p = index(line, '=') - c = index(line, '#') - i = index(line, '"') - if (i > 0) then - j = index(line, '"', back = .true.) - else - i = index(line, "'") - if (i > 0) then - j = index(line, "'", back = .true.) - end if - end if - -! remove the length of the inline comment from the length of the whole line -! - if (c > 0) l = c - 1 - if (i > 0 .and. j > 0) then - i = i + 1 - j = j - 1 - else - i = p + 1 - j = l - end if - -! limit the indices, so we don't overrun the variable memory -! - p = min(p, nlen) - j = min(j, vlen + i) - - name = trim(adjustl(line(1:p-1))) - value = trim(adjustl(line(i:j))) - -! check possible errors in formatting -! - if (p <= 2 .or. len_trim(name) == 0 .or. len_trim(value) == 0) status = 1 - -!------------------------------------------------------------------------------- -! - end subroutine parse_line -! !=============================================================================== ! ! subroutine GET_PARAMETER_INTEGER: ! -------------------------------- ! +! Description: +! ! Subroutine reads a given parameter name and returns its integer value. ! -! Arguments: +! Arguments: ! -! name - the input parameter name; -! value - the output integer value of parameter; +! key - the input parameter name; +! val - the output integer value of parameter; ! !=============================================================================== ! - subroutine get_parameter_integer(name, value) + subroutine get_parameter_integer(key, val) use iso_fortran_env, only : error_unit implicit none - character(len=*), intent(in) :: name - integer , intent(inout) :: value + character(len=*), intent(in) :: key + integer , intent(inout) :: val - integer :: np + type(item), pointer :: item_ptr character(len=*), parameter :: loc = 'PARAMETERS::get_parameter_integer()' !------------------------------------------------------------------------------- ! - np = 1 - do while (np <= nparams) - if (name == pnames(np)) then - read(pvalues(np), err = 100, fmt = *) value + item_ptr => parameter_list + do while(associated(item_ptr)) + if (item_ptr%key == key) then + read(item_ptr%val, err=10, fmt=*) val + exit end if - np = np + 1 + item_ptr => item_ptr%next end do return -100 write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Wrong format of the parameter '" // trim(name) // & - "' or the value is too small or too large!" +10 write(error_unit,"('[',a,']: ',a)") loc, & + "Incorrect format for the integer parameter '" // key // & + "', or its value is either too small or too large!" !------------------------------------------------------------------------------- ! end subroutine get_parameter_integer -! + !=============================================================================== ! ! subroutine GET_PARAMETER_REAL: ! ----------------------------- ! +! Description: +! ! Subroutine reads a given parameter name and returns its real value. ! -! Arguments: +! Arguments: ! -! name - the input parameter name; -! value - the output real value of parameter; +! key - the input parameter name; +! val - the output real value of parameter; ! !=============================================================================== ! - subroutine get_parameter_real(name, value) + subroutine get_parameter_real(key, val) use iso_fortran_env, only : error_unit implicit none - character(len=*), intent(in) :: name - real(kind=8) , intent(inout) :: value + character(len=*), intent(in) :: key + real(kind=8) , intent(inout) :: val - integer :: np + type(item), pointer :: item_ptr character(len=*), parameter :: loc = 'PARAMETERS::get_parameter_real()' !------------------------------------------------------------------------------- ! - np = 1 - do while (np <= nparams) - if (name == pnames(np)) then - read(pvalues(np), err = 100, fmt = *) value + item_ptr => parameter_list + do while(associated(item_ptr)) + if (item_ptr%key == key) then + read(item_ptr%val, err=10, fmt=*) val + exit end if - np = np + 1 + item_ptr => item_ptr%next end do return -100 write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Wrong format of the parameter '" // trim(name) // & - "' or the value is too small or too large!" +10 write(error_unit,"('[',a,']: ',a)") loc, & + "Incorrect format for the float parameter '" // key // & + "', or its value is either too small or too large!" !------------------------------------------------------------------------------- ! end subroutine get_parameter_real -! + !=============================================================================== ! ! subroutine GET_PARAMETER_STRING: ! ------------------------------- ! +! Description: +! ! Subroutine reads a given parameter name and returns its string value. ! -! Arguments: +! Arguments: ! -! name - the input parameter name; -! value - the output string value of parameter; +! key - the input parameter name; +! val - the output string value of parameter; ! !=============================================================================== ! - subroutine get_parameter_string(name, value) + subroutine get_parameter_string(key, val) implicit none - character(len=*), intent(in) :: name - character(len=*), intent(inout) :: value + character(len=*), intent(in) :: key + character(len=*), intent(inout) :: val - integer :: np, nl + type(item), pointer :: item_ptr !------------------------------------------------------------------------------- ! - nl = min(vlen, len(value)) - - np = 1 - do while (np <= nparams) - if (name == pnames(np)) then - value = pvalues(np)(1:nl) + item_ptr => parameter_list + do while(associated(item_ptr)) + if (item_ptr%key == key) then + val = item_ptr%val + exit end if - np = np + 1 + item_ptr => item_ptr%next end do !-------------------------------------------------------------------------------