!=============================================================================== ! ! 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-2024 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 private ! MODULE INTERFACES ! ----------------- ! interface get_parameter module procedure get_parameter_integer module procedure get_parameter_real module procedure get_parameter_string end interface ! MODULE STRUCTURES ! ----------------- ! type item character(len=:), allocatable :: key, val type(item), pointer :: next end type ! MODULE VARIABLES ! ---------------- ! character(len=:), allocatable :: parameter_file type(item) , pointer :: parameter_list => null() ! PUBLIC MEMBERS ! -------------- ! public :: read_parameters, finalize_parameters public :: parameter_file, update_parameter, get_parameter #ifdef MPI public :: distribute_parameters #endif /* MPI */ 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. ! ! 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. ! ! Arguments: ! ! verbose - the flag determining if the subroutine should be verbose; ! status - the return flag of the procedure execution status; ! !=============================================================================== ! subroutine read_parameters(verbose, status) use iso_fortran_env, only : error_unit implicit none logical, intent(in) :: verbose integer, intent(out) :: status character(len=4096) :: arg integer :: l logical :: info !------------------------------------------------------------------------------- ! status = 0 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 call get_command_argument(l+1, arg) if (trim(arg) /= '') then parameter_file = trim(arg) else if (verbose) & write (error_unit,*) & "The option '--input' or '-i' requires an argument. Exiting..." status = 112 return end if exit end if end do inquire (file=parameter_file, exist=info) if (info) then call parse_parameters(status) else write (error_unit,*) "The parameter file '" // parameter_file // & "' does not exist. Exiting..." status = 111 end if #ifdef MPI call distribute_parameters() #endif /* MPI */ !------------------------------------------------------------------------------- ! end subroutine read_parameters !=============================================================================== ! ! subroutine FINALIZE_PARAMETERS: ! ------------------------------ ! ! Description: ! ! Subroutine releases memory used by arrays in this module. ! !=============================================================================== ! subroutine finalize_parameters() implicit none type(item), pointer :: item_ptr !------------------------------------------------------------------------------- ! 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 PARSE_PARAMETERS: ! --------------------------- ! ! Description: ! ! 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 parse_parameters(status) use iso_fortran_env, only : error_unit use mpitools , only : master implicit none integer, intent(out) :: status type(item), pointer :: item_ptr logical :: exists integer :: io = 10, n, i, j character(len=:), allocatable :: line, key, val character(len=*), parameter :: loc = 'PARAMETERS::parse_parameters()' !------------------------------------------------------------------------------- ! status = 0 if (.not. master) return n = 0 j = 1024 inquire (file=parameter_file, size=j) allocate(character(len=j) :: line) open (newunit=io, file=parameter_file, action='read', err=30) 10 read (io, fmt="(a)", end=20) line n = n + 1 ! remove comments ! i = index(line, '#') if (i > 0) write (line,"(a)") trim(adjustl(line(:i-1))) ! skip empty lines ! if (len_trim(line) == 0) go to 10 ! process only lines containing '=' ! 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 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)) go to 10 end if ! 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 (io) deallocate(line) return 30 write (error_unit,"('[',a,']: ',a)") loc, & "Unable to open the parameter file '" // & parameter_file // "'!" status = 140 !------------------------------------------------------------------------------- ! end subroutine parse_parameters !=============================================================================== ! ! subroutine UPDATE_PARAMETER: ! --------------------------- ! ! Description: ! ! Subroutine updates the value of the item by the given key. ! ! Arguments: ! ! key - the parameter name; ! val - the value of parameter; ! !=============================================================================== ! subroutine update_parameter(key, val) use iso_fortran_env, only : error_unit implicit none character(len=*), intent(in) :: key, val type(item), pointer :: item_ptr logical :: exists character(len=*), parameter :: loc = 'PARAMETERS::update_parameter()' !------------------------------------------------------------------------------- ! exists = .false. item_ptr => parameter_list do while(associated(item_ptr)) if (key == item_ptr%key) then if (val /= item_ptr%val) item_ptr%val = val exists = .true. exit end if item_ptr => item_ptr%next end do if (.not. exists) then allocate(item_ptr) item_ptr%key = key item_ptr%val = val item_ptr%next => parameter_list parameter_list => item_ptr end if return !------------------------------------------------------------------------------- ! end subroutine update_parameter !=============================================================================== ! ! subroutine GET_PARAMETER_INTEGER: ! -------------------------------- ! ! Description: ! ! Subroutine reads a given parameter name and returns its integer value. ! ! Arguments: ! ! key - the input parameter name; ! val - the output integer value of parameter; ! !=============================================================================== ! subroutine get_parameter_integer(key, val) use iso_fortran_env, only : error_unit implicit none character(len=*), intent(in) :: key integer , intent(inout) :: val type(item), pointer :: item_ptr character(len=*), parameter :: loc = 'PARAMETERS::get_parameter_integer()' !------------------------------------------------------------------------------- ! 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 item_ptr => item_ptr%next end do return 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: ! ! key - the input parameter name; ! val - the output real value of parameter; ! !=============================================================================== ! subroutine get_parameter_real(key, val) use iso_fortran_env, only : error_unit implicit none character(len=*), intent(in) :: key real(kind=8) , intent(inout) :: val type(item), pointer :: item_ptr character(len=*), parameter :: loc = 'PARAMETERS::get_parameter_real()' !------------------------------------------------------------------------------- ! 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 item_ptr => item_ptr%next end do return 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: ! ! key - the input parameter name; ! val - the output string value of parameter; ! !=============================================================================== ! subroutine get_parameter_string(key, val) implicit none character(len=*), intent(in) :: key character(len=*), intent(inout) :: val type(item), pointer :: item_ptr !------------------------------------------------------------------------------- ! item_ptr => parameter_list do while(associated(item_ptr)) if (item_ptr%key == key) then val = item_ptr%val exit end if item_ptr => item_ptr%next end do !------------------------------------------------------------------------------- ! end subroutine get_parameter_string #ifdef MPI !=============================================================================== ! ! subroutine DISTRIBUTE_PARAMETERS: ! -------------------------------- ! ! Description: ! ! Subroutine distributes parameters among the MPI processes. ! !=============================================================================== ! subroutine distribute_parameters() use mpitools, only : master, broadcast implicit none type(item), pointer :: item_ptr character(len=:), allocatable :: str integer, dimension(2) :: counters ! 1: nitems, 2: maxlen integer :: n, i !------------------------------------------------------------------------------- ! counters = 0 if (master) then item_ptr => parameter_list do while(associated(item_ptr)) counters(1) = counters(1) + 1 counters(2) = max(counters(2), len(item_ptr%key // '|' // item_ptr%val)) item_ptr => item_ptr%next end do else 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 if ! broadcast the number of items and the maximum item length ! call broadcast(counters) ! allocate string buffer ! allocate(character(len=counters(2)) :: str) ! iterate over all items in the list and broadcast them ! if (master) then item_ptr => parameter_list do while(associated(item_ptr)) write (str,"(a)") item_ptr%key // '|' // item_ptr%val call broadcast(str) item_ptr => item_ptr%next end do else do n = 1, counters(1) call broadcast(str) i = index(str, '|') allocate(item_ptr) item_ptr%key = trim(adjustl(str(:i-1))) item_ptr%val = trim(adjustl(str(i+1:))) item_ptr%next => parameter_list parameter_list => item_ptr end do end if deallocate(str) !------------------------------------------------------------------------------- ! end subroutine distribute_parameters #endif /* MPI */ !=============================================================================== ! end module parameters