PARAMETERS: Rewrite module with use of variable strings.
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
parent
58b6a62ff8
commit
6847d1c994
@ -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
|
||||
|
||||
@ -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 <grzegorz@amuncode.org>
|
||||
!!
|
||||
!! 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 <http://www.gnu.org/licenses/>.
|
||||
!!
|
||||
!!******************************************************************************
|
||||
!!
|
||||
!! 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 <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
|
||||
! 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 <http://www.gnu.org/licenses/>.
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
! 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
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user