!!****************************************************************************** !! !! 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-2022 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. !! !!****************************************************************************** ! module parameters implicit none ! MODULE INTERFACES: ! ================= ! interface get_parameter module procedure get_parameter_integer module procedure get_parameter_real module procedure get_parameter_string end interface ! MODULE PARAMETERS: ! ================= ! ! module parameters determining the name and value field lengths, and the ! maximum string length ! integer, parameter :: nlen = 64, vlen = 128, mlen = 256 ! the name of the parameter file ! character(len=mlen), save :: fname = './params.in' ! a file handler to the parameter file ! integer(kind=4) , save :: punit = 10 ! 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 :: read_parameters, finalize_parameters public :: get_parameter_file, get_parameter !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ! contains ! !=============================================================================== ! ! subroutine READ_PARAMETERS: ! -------------------------- ! ! 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: ! ! verbose - the flag determining if the subroutine should be verbose; ! status - the return flag of the procedure execution status; ! ! 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. ! !=============================================================================== ! subroutine read_parameters(verbose, status) use iso_fortran_env, only : error_unit implicit none logical, intent(in) :: verbose integer, intent(out) :: status character(len=mlen) :: opt, arg integer :: l logical :: info !------------------------------------------------------------------------------- ! status = 0 ! parse the command line to check if a different parameter file has been ! provided ! 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) if (trim(arg) /= '') then fname = trim(arg) else if (verbose) then write(error_unit,*) "The option '" // trim(opt) // & "' requires an argument! Exiting..." end if status = 112 return end if end if end do ! check if the file exists ! inquire(file = fname, 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) else write(error_unit,*) "The parameter file '" // trim(fname) & // "' does not exist! Exiting..." status = 111 end if !------------------------------------------------------------------------------- ! end subroutine read_parameters ! !=============================================================================== ! ! subroutine FINALIZE_PARAMETERS: ! ------------------------------ ! ! Subroutine releases memory used by arrays in this module. ! !=============================================================================== ! subroutine finalize_parameters() implicit none !------------------------------------------------------------------------------- ! if (allocated(pnames) ) deallocate(pnames) if (allocated(pvalues)) deallocate(pvalues) !------------------------------------------------------------------------------- ! end subroutine finalize_parameters ! !=============================================================================== ! ! subroutine GET_PARAMETER_FILE: ! ----------------------------- ! ! 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: ! ------------------------- ! ! Subroutine scans the input file, reads parameter names and values, and ! stores them in module arrays. ! ! Arguments: ! ! status - the status value, 0 for success; ! !=============================================================================== ! subroutine get_parameters(status) use iso_fortran_env, only : error_unit implicit none integer, intent(out) :: status integer :: np, nl character(len=256) :: line, name, value character(len=*), parameter :: loc = 'PARAMETERS::get_parameters_number()' !------------------------------------------------------------------------------- ! np = 1 nl = 0 open(newunit = punit, file = fname, err = 30) 10 read(punit, fmt = "(a)", end = 20) line nl = nl + 1 ! 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 ! parse the line to get parameter name and value ! call parse_line(line, name, value, status) ! check if the line was parsed successfuly ! 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 end if ! fill the arrays of parameter names and values ! pnames (np) = name (1:nlen) pvalues(np) = value(1:vlen) ! increase the parameter counter ! np = np + 1 ! go to the next line ! go to 10 20 close(punit) return 30 write(error_unit,"('[',a,']: ',a)") trim(loc) & , "Cannot open the parameter file '" // trim(fname) // "'!" 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) 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 reads a given parameter name and returns its integer value. ! ! Arguments: ! ! name - the input parameter name; ! value - the output integer value of parameter; ! !=============================================================================== ! subroutine get_parameter_integer(name, value) use iso_fortran_env, only : error_unit implicit none character(len=*), intent(in) :: name integer , intent(inout) :: value integer :: np 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 end if np = np + 1 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!" !------------------------------------------------------------------------------- ! end subroutine get_parameter_integer ! !=============================================================================== ! ! subroutine GET_PARAMETER_REAL: ! ----------------------------- ! ! Subroutine reads a given parameter name and returns its real value. ! ! Arguments: ! ! name - the input parameter name; ! value - the output real value of parameter; ! !=============================================================================== ! subroutine get_parameter_real(name, value) use iso_fortran_env, only : error_unit implicit none character(len=*), intent(in) :: name real(kind=8) , intent(inout) :: value integer :: np 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 end if np = np + 1 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!" !------------------------------------------------------------------------------- ! end subroutine get_parameter_real ! !=============================================================================== ! ! subroutine GET_PARAMETER_STRING: ! ------------------------------- ! ! Subroutine reads a given parameter name and returns its string value. ! ! Arguments: ! ! name - the input parameter name; ! value - the output string value of parameter; ! !=============================================================================== ! subroutine get_parameter_string(name, value) implicit none character(len=*), intent(in) :: name character(len=*), intent(inout) :: value integer :: np, nl !------------------------------------------------------------------------------- ! nl = min(vlen, len(value)) np = 1 do while (np <= nparams) if (name == pnames(np)) then value = pvalues(np)(1:nl) end if np = np + 1 end do !------------------------------------------------------------------------------- ! end subroutine get_parameter_string !=============================================================================== ! end module parameters