amun-code/sources/parameters.F90

!===============================================================================
!
!  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 <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

  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