gkowal/amun-code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

PARAMETERS: Rewrite module with use of variable strings.

Browse Source 
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2023-12-17 18:09:12 -03:00
parent 58b6a62ff8
commit 6847d1c994
2 changed files with 237 additions and 377 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
sources/io.F90
View File

@ -1751,7 +1751,7 @@ module io
use helpers , only : print_message use helpers , only : print_message
use iso_c_binding, only : c_loc use iso_c_binding, only : c_loc
use mpitools , only : nprocs, nproc use mpitools , only : nprocs, nproc
use parameters , only : get_parameter_file use parameters , only : parameter_file
use random , only : gentype, nseeds, get_seeds use random , only : gentype, nseeds, get_seeds
use XML , only : XMLNode, XMLAddElement, & use XML , only : XMLNode, XMLAddElement, &
XMLInitTree, XMLFreeTree, XMLSaveTree XMLInitTree, XMLFreeTree, XMLSaveTree
@ -1827,8 +1827,7 @@ module io
if (nproc == 0) then if (nproc == 0) then
call get_parameter_file(str, status) cmd = "cp -a " // parameter_file // " " // rpath
cmd = "cp -a " // trim(str) // " " // rpath
if (status == 0) then if (status == 0) then
call execute_command_line(cmd) call execute_command_line(cmd)
else else
@ -2194,7 +2193,7 @@ module io
use helpers , only : print_message use helpers , only : print_message
use iso_c_binding, only : c_loc use iso_c_binding, only : c_loc
use mpitools , only : nprocs, nproc use mpitools , only : nprocs, nproc
use parameters , only : get_parameter_file use parameters , only : parameter_file
use sources , only : viscosity, resistivity use sources , only : viscosity, resistivity
use XML , only : XMLNode, XMLAddElement, & use XML , only : XMLNode, XMLAddElement, &
XMLInitTree, XMLFreeTree, XMLSaveTree XMLInitTree, XMLFreeTree, XMLSaveTree
@ -2252,8 +2251,7 @@ module io
if (nproc == 0) then if (nproc == 0) then
call get_parameter_file(str, status) cmd = "cp -a " // parameter_file // " " // rpath
cmd = "cp -a " // trim(str) // " " // rpath
if (status == 0) then if (status == 0) then
call execute_command_line(cmd) call execute_command_line(cmd)
else else

604
sources/parameters.F90
View File

@ -1,39 +1,44 @@
!!****************************************************************************** !===============================================================================
!! !
!! This file is part of the AMUN source code, a program to perform ! This file is part of the source code of AMUN, a magnetohydrodynamic
!! Newtonian or relativistic magnetohydrodynamical simulations on uniform or ! (classical and relativistic) plasma modeling software for the study of
!! adaptive mesh. ! astrophysical phenomena.
!! !
!! Copyright (C) 2008-2023 Grzegorz Kowal <grzegorz@amuncode.org> ! Copyright (C) 2008-2023 Grzegorz Kowal <grzegorz@amuncode.org>
!! ! <respective copyright line for all contributing authors>
!! 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 ! This program is free software: you can redistribute it and/or modify
!! the Free Software Foundation, either version 3 of the License, or ! it under the terms of the GNU General Public License as published by
!! (at your option) any later version. ! 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 ! This program is distributed in the hope that it will be useful,
!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! but WITHOUT ANY WARRANTY; without even the implied warranty of
!! GNU General Public License for more details. ! 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 <http://www.gnu.org/licenses/>. ! You should have received a copy of the GNU General Public License
!! ! along with this program. If not, see <http://www.gnu.org/licenses/>.
!!****************************************************************************** !
!! !===============================================================================
!! module: PARAMETERS !
!! ! Name: PARAMETERS
!! This module handles runtime parameters by reading them from a parameter !
!! file and distributing among all processes. ! Description:
!! !
!!****************************************************************************** ! This module handles runtime parameters by reading them from a parameter
! file and distributing among all processes.
!
!-------------------------------------------------------------------------------
! !
module parameters module parameters
implicit none implicit none
! MODULE INTERFACES: private
! =================
! MODULE INTERFACES
! -----------------
! !
interface get_parameter interface get_parameter
module procedure get_parameter_integer module procedure get_parameter_integer
@ -41,62 +46,48 @@ module parameters
module procedure get_parameter_string module procedure get_parameter_string
end interface end interface
! MODULE PARAMETERS: ! MODULE STRUCTURES
! ================= ! -----------------
! !
! module parameters determining the name and value field lengths, and the type item
! maximum string length character(len=:), allocatable :: key, val
!
integer, parameter :: nlen = 64, vlen = 128, mlen = 256
! the name of the parameter file type(item), pointer :: next
! end type
character(len=mlen), save :: fname = './params.in'
! 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 ! PUBLIC MEMBERS
! ! --------------
character(len=nlen), dimension(:), allocatable, save :: pnames
character(len=vlen), dimension(:), allocatable, save :: pvalues
! by default everything is private
!
private
! declare public subroutines
! !
public :: read_parameters, finalize_parameters public :: read_parameters, finalize_parameters
public :: get_parameter_file, get_parameter public :: parameter_file, get_parameter
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
contains contains
!
!=============================================================================== !===============================================================================
! !
! subroutine READ_PARAMETERS: ! subroutine READ_PARAMETERS:
! -------------------------- ! --------------------------
! !
! Description:
!
! Subroutine checks if the parameter file exists, checks its length, ! Subroutine checks if the parameter file exists, checks its length,
! allocates structures to store all parameters provided in the parameters ! allocates structures to store all parameters provided in the parameters
! file and read parameters into these structures. ! 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; ! Arguments:
! status - the return flag of the procedure execution status;
! !
! Note: ! verbose - the flag determining if the subroutine should be verbose;
! ! status - the return flag of the procedure execution status;
! 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.
! !
!=============================================================================== !===============================================================================
! !
@ -109,7 +100,7 @@ module parameters
logical, intent(in) :: verbose logical, intent(in) :: verbose
integer, intent(out) :: status integer, intent(out) :: status
character(len=mlen) :: opt, arg character(len=4096) :: arg
integer :: l integer :: l
logical :: info logical :: info
@ -117,75 +108,48 @@ module parameters
! !
status = 0 status = 0
! parse the command line to check if a different parameter file has been parameter_file = 'params.in'
! provided
! parse the command line to check for the parameter file
! !
do l = 1, command_argument_count() do l = 1, command_argument_count()
call get_command_argument(l, arg) call get_command_argument(l, arg)
if (trim(arg) == '-i' .or. trim(arg) == '--input') then 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 if (trim(arg) /= '') then
fname = trim(arg) parameter_file = trim(arg)
else else
if (verbose) then if (verbose) &
write(error_unit,*) "The option '" // trim(opt) // & write(error_unit,*) &
"' requires an argument! Exiting..." "The option '--input' or '-i' requires an argument. Exiting..."
end if
status = 112 status = 112
return return
end if end if
exit
end if end if
end do end do
! check if the file exists inquire(file=parameter_file, exist=info)
!
inquire(file = fname, exist = info)
if (info) then if (info) then
call parse_parameters(status)
! 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)
else else
write(error_unit,*) "The parameter file '" // parameter_file // &
write(error_unit,*) "The parameter file '" // trim(fname) & "' does not exist. Exiting..."
// "' does not exist! Exiting..."
status = 111 status = 111
end if end if
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
end subroutine read_parameters end subroutine read_parameters
!
!=============================================================================== !===============================================================================
! !
! subroutine FINALIZE_PARAMETERS: ! subroutine FINALIZE_PARAMETERS:
! ------------------------------ ! ------------------------------
! !
! Description:
!
! Subroutine releases memory used by arrays in this module. ! Subroutine releases memory used by arrays in this module.
! !
!=============================================================================== !===============================================================================
@ -194,132 +158,42 @@ module parameters
implicit none implicit none
type(item), pointer :: item_ptr
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
if (allocated(pnames) ) deallocate(pnames) item_ptr => parameter_list
if (allocated(pvalues)) deallocate(pvalues) 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 end subroutine finalize_parameters
!
!=============================================================================== !===============================================================================
! !
! subroutine GET_PARAMETER_FILE: ! subroutine PARSE_PARAMETERS:
! ----------------------------- ! ---------------------------
! !
! Subroutine returns the full path to the parameter file. ! Description:
!
! 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:
! -------------------------
! !
! Subroutine scans the input file, reads parameter names and values, and ! Subroutine scans the input file, reads parameter names and values, and
! stores them in module arrays. ! 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 use iso_fortran_env, only : error_unit
@ -327,269 +201,257 @@ module parameters
integer, intent(out) :: status 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 status = 0
nl = 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) & i = index(line, '#')
.or. index(trim(adjustl(line)), '#') == 1) go to 10 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 i = index(line, '=')
write(error_unit,"('[',a,']: ',a)") trim(loc) & if (i > 1) then
, "Wrong parameter format in '" & key = trim(adjustl(line(:i-1)))
// trim(adjustl(fname)) // "'."
write (error_unit,"('[',a,']: Line',i4,' : ',a)") & if (len_trim(key) > 0) then
trim(loc), nl, trim(line) val = trim(adjustl(line(i+1:)))
go to 30 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 end if
! fill the arrays of parameter names and values if (status > 0) then
! write(error_unit,"('[',a,']: ',a)") loc, &
pnames (np) = name (1:nlen) "Wrong parameter format in '" // parameter_file // "'."
pvalues(np) = value(1:vlen) write (error_unit,"('[',a,']: ',a,i0,':')") loc, "Verify line ", n
write (error_unit,"('[',a,']: ',a)") loc, trim(adjustl(line))
! increase the parameter counter go to 10
! end if
np = np + 1
! 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 go to 10
20 close(punit) 20 close(io)
deallocate(line)
return return
30 write(error_unit,"('[',a,']: ',a)") trim(loc) & 30 write(error_unit,"('[',a,']: ',a)") loc, &
, "Cannot open the parameter file '" // trim(fname) // "'!" "Unable to open the parameter file '" // &
parameter_file // "'!"
status = 140 status = 140
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
end subroutine get_parameters end subroutine parse_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)
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: ! subroutine GET_PARAMETER_INTEGER:
! -------------------------------- ! --------------------------------
! !
! Description:
!
! Subroutine reads a given parameter name and returns its integer value. ! Subroutine reads a given parameter name and returns its integer value.
! !
! Arguments: ! Arguments:
! !
! name - the input parameter name; ! key - the input parameter name;
! value - the output integer value of parameter; ! 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 use iso_fortran_env, only : error_unit
implicit none implicit none
character(len=*), intent(in) :: name character(len=*), intent(in) :: key
integer , intent(inout) :: value integer , intent(inout) :: val
integer :: np type(item), pointer :: item_ptr
character(len=*), parameter :: loc = 'PARAMETERS::get_parameter_integer()' character(len=*), parameter :: loc = 'PARAMETERS::get_parameter_integer()'
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
np = 1 item_ptr => parameter_list
do while (np <= nparams) do while(associated(item_ptr))
if (name == pnames(np)) then if (item_ptr%key == key) then
read(pvalues(np), err = 100, fmt = *) value read(item_ptr%val, err=10, fmt=*) val
exit
end if end if
np = np + 1 item_ptr => item_ptr%next
end do end do
return return
100 write(error_unit,"('[',a,']: ',a)") trim(loc) & 10 write(error_unit,"('[',a,']: ',a)") loc, &
, "Wrong format of the parameter '" // trim(name) // & "Incorrect format for the integer parameter '" // key // &
"' or the value is too small or too large!" "', or its value is either too small or too large!"
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
end subroutine get_parameter_integer end subroutine get_parameter_integer
!
!=============================================================================== !===============================================================================
! !
! subroutine GET_PARAMETER_REAL: ! subroutine GET_PARAMETER_REAL:
! ----------------------------- ! -----------------------------
! !
! Description:
!
! Subroutine reads a given parameter name and returns its real value. ! Subroutine reads a given parameter name and returns its real value.
! !
! Arguments: ! Arguments:
! !
! name - the input parameter name; ! key - the input parameter name;
! value - the output real value of parameter; ! 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 use iso_fortran_env, only : error_unit
implicit none implicit none
character(len=*), intent(in) :: name character(len=*), intent(in) :: key
real(kind=8) , intent(inout) :: value real(kind=8) , intent(inout) :: val
integer :: np type(item), pointer :: item_ptr
character(len=*), parameter :: loc = 'PARAMETERS::get_parameter_real()' character(len=*), parameter :: loc = 'PARAMETERS::get_parameter_real()'
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
np = 1 item_ptr => parameter_list
do while (np <= nparams) do while(associated(item_ptr))
if (name == pnames(np)) then if (item_ptr%key == key) then
read(pvalues(np), err = 100, fmt = *) value read(item_ptr%val, err=10, fmt=*) val
exit
end if end if
np = np + 1 item_ptr => item_ptr%next
end do end do
return return
100 write(error_unit,"('[',a,']: ',a)") trim(loc) & 10 write(error_unit,"('[',a,']: ',a)") loc, &
, "Wrong format of the parameter '" // trim(name) // & "Incorrect format for the float parameter '" // key // &
"' or the value is too small or too large!" "', or its value is either too small or too large!"
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
end subroutine get_parameter_real end subroutine get_parameter_real
!
!=============================================================================== !===============================================================================
! !
! subroutine GET_PARAMETER_STRING: ! subroutine GET_PARAMETER_STRING:
! ------------------------------- ! -------------------------------
! !
! Description:
!
! Subroutine reads a given parameter name and returns its string value. ! Subroutine reads a given parameter name and returns its string value.
! !
! Arguments: ! Arguments:
! !
! name - the input parameter name; ! key - the input parameter name;
! value - the output string value of parameter; ! val - the output string value of parameter;
! !
!=============================================================================== !===============================================================================
! !
subroutine get_parameter_string(name, value) subroutine get_parameter_string(key, val)
implicit none implicit none
character(len=*), intent(in) :: name character(len=*), intent(in) :: key
character(len=*), intent(inout) :: value character(len=*), intent(inout) :: val
integer :: np, nl type(item), pointer :: item_ptr
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
nl = min(vlen, len(value)) item_ptr => parameter_list
do while(associated(item_ptr))
np = 1 if (item_ptr%key == key) then
do while (np <= nparams) val = item_ptr%val
if (name == pnames(np)) then exit
value = pvalues(np)(1:nl)
end if end if
np = np + 1 item_ptr => item_ptr%next
end do end do
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------