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

Merge branch 'master' into binaries

Browse Source
This commit is contained in:
Grzegorz Kowal 2023-12-18 09:34:59 -03:00
commit 78c6d1d83f
4 changed files with 729 additions and 795 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

645
sources/io.F90
View File

@ -38,17 +38,7 @@ module io
implicit none
interface read_snapshot_parameter
module procedure read_snapshot_parameter_string
module procedure read_snapshot_parameter_integer
module procedure read_snapshot_parameter_double
end interface
#ifdef HDF5
interface read_snapshot_parameter_h5
module procedure read_snapshot_parameter_string_h5
module procedure read_snapshot_parameter_integer_h5
module procedure read_snapshot_parameter_double_h5
end interface
interface restore_attribute_h5
module procedure restore_attribute_string_h5
module procedure restore_attribute_number_h5
@ -153,7 +143,7 @@ module io
public :: initialize_io, finalize_io, print_io
public :: restart_snapshot_number, restart_from_snapshot
public :: read_snapshot_parameter
public :: restore_snapshot_parameters
public :: read_restart_snapshot, write_restart_snapshot, write_snapshot
public :: update_dtp
@ -600,6 +590,61 @@ module io
!
!===============================================================================
!
! subroutine RESTORE_SNAPSHOT_PARAMETERS:
! --------------------------------------
!
! Description:
!
! The subroutine restores parameters from the restart snapshot for
! restarted jobs, ensuring that these parameters remain unchanged during
! the restart process.
!
! Arguments:
!
! status - the subroutine call status;
!
!===============================================================================
!
subroutine restore_snapshot_parameters(status)
use helpers , only : print_message
#ifdef MPI
use parameters, only : distribute_parameters
#endif /* MPI */
implicit none
integer, intent(out) :: status
character(len=*), parameter :: loc = 'IO::restore_snapshot_parameters()'
!-------------------------------------------------------------------------------
!
call start_timer(iio)
status = 0
select case(restart_format)
#ifdef HDF5
case(snapshot_hdf5)
call restore_snapshot_parameters_h5(status)
#endif /* HDF5 */
case default
call restore_snapshot_parameters_xml(status)
end select
#ifdef MPI
call distribute_parameters()
#endif /* MPI */
call stop_timer(iio)
!-------------------------------------------------------------------------------
!
end subroutine restore_snapshot_parameters
!
!===============================================================================
!
! subroutine READ_RESTART_SNAPSHOT:
! --------------------------------
!
@ -808,260 +853,94 @@ module io
!
!===============================================================================
!
! subroutine READ_SNAPSHOT_PARAMETER_STRING:
! -----------------------------------------
! subroutine RESTORE_SNAPSHOT_PARAMETERS_XML:
! ------------------------------------------
!
! Subroutine reads a string parameter from the restart snapshot.
! Subroutine restores parameters from the restart snapshot.
!
! Arguments:
!
! pname - the parameter name;
! pvalue - the parameter value;
! status - the status flag (the success is 0, failure otherwise);
!
!===============================================================================
!
subroutine read_snapshot_parameter_string(pname, pvalue, status)
subroutine restore_snapshot_parameters_xml(status)
use helpers, only : print_message
use helpers , only : print_message
use mpitools , only : master
use parameters, only : update_parameter
implicit none
character(len=*), intent(in) :: pname
character(len=*), intent(inout) :: pvalue
integer , intent(inout) :: status
integer, intent(inout) :: status
logical :: test
character(len=255) :: dname, fname, line
integer(kind=4) :: lun = 103
integer :: l, u
integer :: n, l, u
character(len=*), parameter :: loc = 'IO::read_snapshot_parameter_string'
character(len=8), dimension(14) :: keys = &
[ "problem ", "eqsys ", "eos ", &
"ncells ", "last_id ", &
"xblocks ", "yblocks ", "zblocks ", &
"xmin ", "ymin ", "zmin ", &
"xmax ", "ymax ", "zmax " ]
character(len=*), parameter :: loc = 'IO::restore_snapshot_parameters_xml'
!-------------------------------------------------------------------------------
!
status = 0
select case(restart_format)
#ifdef HDF5
case(snapshot_hdf5)
call read_snapshot_parameter_h5(pname, pvalue, status)
#endif /* HDF5 */
case default
if (.not. master) return
! check if the snapshot directory and metafile exist
!
write(dname, "(a,'restart-',i5.5)") trim(respath), nrest
write(dname, "(a,'restart-',i5.5)") trim(respath), nrest
#ifdef __INTEL_COMPILER
inquire(directory = dname, exist = test)
inquire(directory = dname, exist = test)
#else /* __INTEL_COMPILER */
inquire(file = dname, exist = test)
inquire(file = dname, exist = test)
#endif /* __INTEL_COMPILER */
if (.not. test) then
call print_message(loc, trim(dname) // " does not exist!")
status = 121
return
end if
if (.not. test) then
call print_message(loc, trim(dname) // " does not exist!")
status = 121
return
end if
write(fname,"(a,'/metadata.xml')") trim(dname)
inquire(file = fname, exist = test)
if (.not. test) then
call print_message(loc, trim(fname) // " does not exist!")
status = 121
return
end if
write(fname,"(a,'/metadata.xml')") trim(dname)
inquire(file = fname, exist = test)
if (.not. test) then
call print_message(loc, trim(fname) // " does not exist!")
status = 121
return
end if
! read requested parameter from the file
!
open(newunit = lun, file = fname, status = 'old')
10 read(lun, fmt = "(a)", end = 20) line
l = index(line, trim(adjustl(pname)))
open(newunit = lun, file = fname, status = 'old')
10 read(lun, fmt = "(a)", end = 20) line
do n = 1, size(keys)
l = index(line, trim(keys(n)))
if (l > 0) then
l = index(line, '>') + 1
u = index(line, '<', back = .true.) - 1
pvalue = trim(adjustl(line(l:u)))
if (keys(n) == "eqsys") then
call update_parameter("equation_system", trim(adjustl(line(l:u))))
else if (keys(n) == "eos") then
call update_parameter("equation_of_state", trim(adjustl(line(l:u))))
else
call update_parameter(trim(keys(n)), trim(adjustl(line(l:u))))
end if
end if
go to 10
20 close(lun)
end select
end do
go to 10
20 close(lun)
!-------------------------------------------------------------------------------
!
end subroutine read_snapshot_parameter_string
!
!===============================================================================
!
! subroutine READ_SNAPSHOT_PARAMETER_INTEGER:
! ------------------------------------------
!
! Subroutine reads an integer parameter from the restart snapshot.
!
! Arguments:
!
! pname - the parameter name;
! pvalue - the parameter value;
! status - the status flag (the success is 0, failure otherwise);
!
!===============================================================================
!
subroutine read_snapshot_parameter_integer(pname, pvalue, status)
use helpers, only : print_message
implicit none
character(len=*), intent(in) :: pname
integer , intent(inout) :: pvalue
integer , intent(inout) :: status
logical :: test
character(len=255) :: dname, fname, line, svalue
integer(kind=4) :: lun = 103
integer :: l, u
character(len=*), parameter :: loc = 'IO::read_snapshot_parameter_integer'
!-------------------------------------------------------------------------------
!
status = 0
select case(restart_format)
#ifdef HDF5
case(snapshot_hdf5)
call read_snapshot_parameter_h5(pname, pvalue, status)
#endif /* HDF5 */
case default
! check if the snapshot directory and metafile exist
!
write(dname, "(a,'restart-',i5.5)") trim(respath), nrest
#ifdef __INTEL_COMPILER
inquire(directory = dname, exist = test)
#else /* __INTEL_COMPILER */
inquire(file = dname, exist = test)
#endif /* __INTEL_COMPILER */
if (.not. test) then
call print_message(loc, trim(dname) // " does not exist!")
status = 121
return
end if
write(fname,"(a,'/metadata.xml')") trim(dname)
inquire(file = fname, exist = test)
if (.not. test) then
call print_message(loc, trim(fname) // " does not exist!")
status = 121
return
end if
! read parameter from the file
!
open(newunit = lun, file = fname, status = 'old')
10 read(lun, fmt = "(a)", end = 20) line
l = index(line, trim(adjustl(pname)))
if (l > 0) then
l = index(line, '>') + 1
u = index(line, '<', back = .true.) - 1
svalue = trim(adjustl(line(l:u)))
read(svalue, fmt = *) pvalue
end if
go to 10
20 close(lun)
end select
!-------------------------------------------------------------------------------
!
end subroutine read_snapshot_parameter_integer
!
!===============================================================================
!
! subroutine READ_SNAPSHOT_PARAMETER_DOUBLE:
! -----------------------------------------
!
! Subroutine reads a floating point parameter from the restart snapshot.
!
! Arguments:
!
! pname - the parameter name;
! pvalue - the parameter value;
! status - the status flag (the success is 0, failure otherwise);
!
!===============================================================================
!
subroutine read_snapshot_parameter_double(pname, pvalue, status)
use helpers, only : print_message
implicit none
character(len=*), intent(in) :: pname
real(kind=8) , intent(inout) :: pvalue
integer , intent(inout) :: status
logical :: test
character(len=255) :: dname, fname, line, svalue
integer(kind=4) :: lun = 103
integer :: l, u
character(len=*), parameter :: loc = 'IO::read_snapshot_parameter_double'
!-------------------------------------------------------------------------------
!
status = 0
select case(restart_format)
#ifdef HDF5
case(snapshot_hdf5)
call read_snapshot_parameter_h5(pname, pvalue, status)
#endif /* HDF5 */
case default
! check if the snapshot directory and metafile exist
!
write(dname, "(a,'restart-',i5.5)") trim(respath), nrest
#ifdef __INTEL_COMPILER
inquire(directory = dname, exist = test)
#else /* __INTEL_COMPILER */
inquire(file = dname, exist = test)
#endif /* __INTEL_COMPILER */
if (.not. test) then
call print_message(loc, trim(dname) // " does not exist!")
status = 121
return
end if
write(fname,"(a,'/metadata.xml')") trim(dname)
inquire(file = fname, exist = test)
if (.not. test) then
call print_message(loc, trim(fname) // " does not exist!")
status = 121
return
end if
! read parameter from the file
!
open(newunit = lun, file = fname, status = 'old')
10 read(lun, fmt = "(a)", end = 20) line
l = index(line, trim(adjustl(pname)))
if (l > 0) then
l = index(line, '>') + 1
u = index(line, '<', back = .true.) - 1
svalue = trim(adjustl(line(l:u)))
read(svalue, fmt = *) pvalue
end if
go to 10
20 close(lun)
end select
!-------------------------------------------------------------------------------
!
end subroutine read_snapshot_parameter_double
end subroutine restore_snapshot_parameters_xml
!
!===============================================================================
!
@ -1751,7 +1630,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 +1706,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 +2072,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 +2130,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
@ -2785,41 +2662,46 @@ module io
!
!===============================================================================
!
! subroutine READ_SNAPSHOT_PARAMETER_STRING_H5:
! --------------------------------------------
! subroutine RESTORE_SNAPSHOT_PARAMETERS_H5:
! -----------------------------------------
!
! Subroutine reads a string parameter from the restart snapshot.
! Subroutine restores parameters from the restart snapshot.
!
! Arguments:
!
! pname - the parameter's name;
! pvalue - the parameter's value;
! status - the subroutine call status;
! status - the status flag (the success is 0, failure otherwise);
!
!===============================================================================
!
subroutine read_snapshot_parameter_string_h5(pname, pvalue, status)
subroutine restore_snapshot_parameters_h5(status)
use helpers, only : print_message
use helpers , only : print_message
use mpitools , only : master
use parameters, only : update_parameter
implicit none
character(len=*), intent(in) :: pname
character(len=*), intent(inout) :: pvalue
integer , intent(inout) :: status
integer, intent(inout) :: status
character(len=255) :: fname
logical :: flag
integer(hid_t) :: file_id, grp_id
character(len=*), parameter :: loc = &
'IO::read_snapshot_parameter_string_h5()'
integer :: ival
real(kind=8) :: rval
character(len=64) :: sval
character(len=:), allocatable :: pname
character(len=*), parameter :: loc = 'IO::restore_snapshot_parameters_h5'
!-------------------------------------------------------------------------------
!
status = 0
if (.not. master) return
write(fname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, 0
inquire(file=fname, exist=flag)
if (.not. flag) then
@ -2837,159 +2719,140 @@ module io
call h5gopen_f(file_id, 'attributes', grp_id, status)
if (status == 0) then
call restore_attribute_h5(grp_id, pname, pvalue, status)
pname = "problem"
call restore_attribute_h5(grp_id, pname, sval, status)
if (status /= 0) &
call print_message(loc, "Failed to restore attribute" // &
trim(pname) // "!")
call h5gclose_f(grp_id, status)
call update_parameter(pname, trim(adjustl(sval)))
pname = "eqsys"
call restore_attribute_h5(grp_id, pname, sval, status)
if (status /= 0) &
call print_message(loc, "Could not close group 'attributes'!")
else
call print_message(loc, "Could not open group 'attributes'!")
end if
call print_message(loc, "Failed to restore attribute" // &
trim(pname) // "!")
call update_parameter("equation_system", trim(adjustl(sval)))
call h5fclose_f(file_id, status)
if (status /= 0) &
call print_message(loc, "Could not close " // trim(fname) // "!")
pname = "eos"
call restore_attribute_h5(grp_id, pname, sval, status)
if (status /= 0) &
call print_message(loc, "Failed to restore attribute" // &
trim(pname) // "!")
call update_parameter("equation_of_state", trim(adjustl(sval)))
!-------------------------------------------------------------------------------
!
end subroutine read_snapshot_parameter_string_h5
!
!===============================================================================
!
! subroutine READ_SNAPSHOT_PARAMETER_INTEGER_H5:
! ---------------------------------------------
!
! Subroutine reads an integer parameter from the restart snapshot.
!
! Arguments:
!
! pname - the parameter's name;
! pvalue - the parameter's value;
! status - the subroutine call status;
!
!===============================================================================
!
subroutine read_snapshot_parameter_integer_h5(pname, pvalue, status)
use helpers, only : print_message
implicit none
character(len=*), intent(in) :: pname
integer , intent(inout) :: pvalue
integer , intent(inout) :: status
character(len=255) :: fname
logical :: flag
integer(hid_t) :: file_id, grp_id
character(len=*), parameter :: loc = &
'IO::read_snapshot_parameter_integer_h5()'
!-------------------------------------------------------------------------------
!
status = 0
write(fname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, 0
inquire(file=fname, exist=flag)
if (.not. flag) then
call print_message(loc, "Restart snapshot " // trim(fname) // &
" does not exist!")
status = 1
return
end if
call h5fopen_f(fname, H5F_ACC_RDONLY_F, file_id, status)
if (status /= 0) then
call print_message(loc, "Could not open " // trim(fname) // "!")
return
end if
call h5gopen_f(file_id, 'attributes', grp_id, status)
if (status == 0) then
pname = "nprocs"
call restore_attribute_h5(grp_id, pname, &
H5T_NATIVE_INTEGER, 1, pvalue, status)
H5T_NATIVE_INTEGER, 1, ival, status)
if (status /= 0) &
call print_message(loc, "Failed to restore attribute" // &
trim(pname) // "!")
call h5gclose_f(grp_id, status)
if (status /= 0) &
call print_message(loc, "Could not close group 'attributes'!")
else
call print_message(loc, "Could not open group 'attributes'!")
end if
write(sval,"(i0)") ival
call update_parameter("nfiles", trim(adjustl(sval)))
call h5fclose_f(file_id, status)
if (status /= 0) &
call print_message(loc, "Could not close " // trim(fname) // "!")
!-------------------------------------------------------------------------------
!
end subroutine read_snapshot_parameter_integer_h5
!
!===============================================================================
!
! subroutine READ_SNAPSHOT_PARAMETER_DOUBLE_H5:
! --------------------------------------------
!
! Subroutine reads a double precision real parameter from the restart
! snapshot.
!
! Arguments:
!
! pname - the parameter's name;
! pvalue - the parameter's value;
! status - the subroutine call status;
!
!===============================================================================
!
subroutine read_snapshot_parameter_double_h5(pname, pvalue, status)
use helpers, only : print_message
implicit none
character(len=*), intent(in) :: pname
real(kind=8) , intent(inout) :: pvalue
integer , intent(inout) :: status
character(len=255) :: fname
logical :: flag
integer(hid_t) :: file_id, grp_id
character(len=*), parameter :: loc = &
'IO::read_snapshot_parameter_double_h5()'
!-------------------------------------------------------------------------------
!
status = 0
write(fname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, 0
inquire(file=fname, exist=flag)
if (.not. flag) then
call print_message(loc, "Restart snapshot " // trim(fname) // &
" does not exist!")
status = 1
return
end if
call h5fopen_f(fname, H5F_ACC_RDONLY_F, file_id, status)
if (status /= 0) then
call print_message(loc, "Could not open " // trim(fname) // "!")
return
end if
call h5gopen_f(file_id, 'attributes', grp_id, status)
if (status == 0) then
pname = "ncells"
call restore_attribute_h5(grp_id, pname, &
H5T_NATIVE_DOUBLE, 1, pvalue, status)
H5T_NATIVE_INTEGER, 1, ival, status)
if (status /= 0) &
call print_message(loc, "Failed to restore attribute" // &
trim(pname) // "!")
write(sval,"(i0)") ival
call update_parameter(pname, trim(adjustl(sval)))
pname = "xblocks"
call restore_attribute_h5(grp_id, pname, &
H5T_NATIVE_INTEGER, 1, ival, status)
if (status /= 0) &
call print_message(loc, "Failed to restore attribute" // &
trim(pname) // "!")
write(sval,"(i0)") ival
call update_parameter(pname, trim(adjustl(sval)))
pname = "yblocks"
call restore_attribute_h5(grp_id, pname, &
H5T_NATIVE_INTEGER, 1, ival, status)
if (status /= 0) &
call print_message(loc, "Failed to restore attribute" // &
trim(pname) // "!")
write(sval,"(i0)") ival
call update_parameter(pname, trim(adjustl(sval)))
#if NDIMS == 3
pname = "zblocks"
call restore_attribute_h5(grp_id, pname, &
H5T_NATIVE_INTEGER, 1, ival, status)
if (status /= 0) &
call print_message(loc, "Failed to restore attribute" // &
trim(pname) // "!")
write(sval,"(i0)") ival
call update_parameter(pname, trim(adjustl(sval)))
#endif /* NDIMS == 3 */
pname = "last_id"
call restore_attribute_h5(grp_id, pname, &
H5T_NATIVE_INTEGER, 1, ival, status)
if (status /= 0) &
call print_message(loc, "Failed to restore attribute" // &
trim(pname) // "!")
write(sval,"(i0)") ival
call update_parameter(pname, trim(adjustl(sval)))
pname = "xmin"
call restore_attribute_h5(grp_id, pname, &
H5T_NATIVE_DOUBLE, 1, rval, status)
if (status /= 0) &
call print_message(loc, "Failed to restore attribute" // &
trim(pname) // "!")
write(sval,"(1es32.20)") rval
call update_parameter(pname, trim(adjustl(sval)))
pname = "xmax"
call restore_attribute_h5(grp_id, pname, &
H5T_NATIVE_DOUBLE, 1, rval, status)
if (status /= 0) &
call print_message(loc, "Failed to restore attribute" // &
trim(pname) // "!")
write(sval,"(1es32.20)") rval
call update_parameter(pname, trim(adjustl(sval)))
pname = "ymin"
call restore_attribute_h5(grp_id, pname, &
H5T_NATIVE_DOUBLE, 1, rval, status)
if (status /= 0) &
call print_message(loc, "Failed to restore attribute" // &
trim(pname) // "!")
write(sval,"(1es32.20)") rval
call update_parameter(pname, trim(adjustl(sval)))
pname = "ymax"
call restore_attribute_h5(grp_id, pname, &
H5T_NATIVE_DOUBLE, 1, rval, status)
if (status /= 0) &
call print_message(loc, "Failed to restore attribute" // &
trim(pname) // "!")
write(sval,"(1es32.20)") rval
call update_parameter(pname, trim(adjustl(sval)))
#if NDIMS == 3
pname = "zmin"
call restore_attribute_h5(grp_id, pname, &
H5T_NATIVE_DOUBLE, 1, rval, status)
if (status /= 0) &
call print_message(loc, "Failed to restore attribute" // &
trim(pname) // "!")
write(sval,"(1es32.20)") rval
call update_parameter(pname, trim(adjustl(sval)))
pname = "zmax"
call restore_attribute_h5(grp_id, pname, &
H5T_NATIVE_DOUBLE, 1, rval, status)
if (status /= 0) &
call print_message(loc, "Failed to restore attribute" // &
trim(pname) // "!")
write(sval,"(1es32.20)") rval
call update_parameter(pname, trim(adjustl(sval)))
#endif /* NDIMS == 3 */
call h5gclose_f(grp_id, status)
if (status /= 0) &
call print_message(loc, "Could not close group 'attributes'!")
@ -3003,7 +2866,7 @@ module io
!-------------------------------------------------------------------------------
!
end subroutine read_snapshot_parameter_double_h5
end subroutine restore_snapshot_parameters_h5
!
!===============================================================================
!
@ -3022,13 +2885,14 @@ module io
!
subroutine read_restart_snapshot_h5(status)
use blocks , only : change_blocks_process
use forcing , only : einj
use helpers , only : print_message
use blocks , only : change_blocks_process
use forcing , only : einj
use helpers , only : print_message
#ifdef MPI
use mesh , only : redistribute_blocks
use mesh , only : redistribute_blocks
#endif /* MPI */
use mpitools, only : nprocs, nproc
use mpitools , only : nprocs, nproc
use parameters, only : get_parameter
implicit none
@ -3061,8 +2925,9 @@ module io
return
end if
call read_snapshot_parameter_h5('nprocs' , nfiles , status)
call read_snapshot_parameter_h5('last_id', last_id, status)
call get_parameter("nfiles", nfiles)
call get_parameter("last_id", last_id)
allocate(block_array(last_id))
call restore_attributes_h5(file_id, status)

77
sources/mpitools.F90
View File

@ -41,6 +41,10 @@ module mpitools
! subroutine interfaces
!
#ifdef MPI
interface broadcast
module procedure broadcast_integer
module procedure broadcast_string
end interface
interface reduce_minimum
module procedure reduce_minimum_double_array
end interface
@ -83,6 +87,7 @@ module mpitools
public :: initialize_mpitools, finalize_mpitools
public :: check_status
#ifdef MPI
public :: broadcast
public :: reduce_minimum, reduce_maximum, reduce_sum
public :: send_array, receive_array
public :: exchange_arrays
@ -353,6 +358,78 @@ module mpitools
!
!===============================================================================
!
! subroutine BROADCAST_INTEGER:
! ----------------------------
!
! Subroutine broadcasts an integer buffer.
!
!===============================================================================
!
subroutine broadcast_integer(buf)
use helpers, only : print_message
implicit none
integer, dimension(..), intent(inout) :: buf
integer :: ierror
character(len=*), parameter :: loc = 'MPITOOLS::broadcast_integer()'
!-------------------------------------------------------------------------------
!
call start_timer(imc)
call mpi_bcast(buf, size(buf), MPI_INTEGER, 0, MPI_COMM_WORLD, ierror)
if (ierror /= MPI_SUCCESS) &
call print_message(loc, 'Could not broadcast an integer buffer.')
call stop_timer(imc)
!-------------------------------------------------------------------------------
!
end subroutine broadcast_integer
!
!===============================================================================
!
! subroutine BROADCAST_STRING:
! ---------------------------
!
! Subroutine broadcasts a string buffer.
!
!===============================================================================
!
subroutine broadcast_string(buf)
use helpers, only : print_message
implicit none
character(len=*), intent(inout) :: buf
integer :: ierror
character(len=*), parameter :: loc = 'MPITOOLS::broadcast_string()'
!-------------------------------------------------------------------------------
!
call start_timer(imc)
call mpi_bcast(buf, len(buf), MPI_CHARACTER, 0, MPI_COMM_WORLD, ierror)
if (ierror /= MPI_SUCCESS) &
call print_message(loc, 'Could not broadcast a string buffer.')
call stop_timer(imc)
!-------------------------------------------------------------------------------
!
end subroutine broadcast_string
!
!===============================================================================
!
! subroutine SEND_ARRAY:
! ---------------------
!

732
sources/parameters.F90
View File

@ -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,51 @@ 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, 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.
!
! 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 +103,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 +111,52 @@ 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
#ifdef MPI
call distribute_parameters()
#endif /* MPI */
!-------------------------------------------------------------------------------
!
end subroutine read_parameters
!
!===============================================================================
!
! subroutine FINALIZE_PARAMETERS:
! ------------------------------
!
! Description:
!
! Subroutine releases memory used by arrays in this module.
!
!===============================================================================
@ -194,407 +165,456 @@ 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
use mpitools , only : master
implicit none
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)
if (.not. master) return
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
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 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)
subroutine update_parameter(key, val)
use iso_fortran_env, only : error_unit
implicit none
character(len=*), intent(in) :: line
character(len=*), intent(inout) :: name, value
integer , intent(out) :: status
character(len=*), intent(in) :: key, val
integer :: l, p, c, i, j = 1
type(item), pointer :: item_ptr
logical :: exists
character(len=*), parameter :: loc = 'PARAMETERS::update_parameter()'
!-------------------------------------------------------------------------------
!
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.)
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
! 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
return
!-------------------------------------------------------------------------------
!
end subroutine parse_line
!
end subroutine update_parameter
!===============================================================================
!
! 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
!-------------------------------------------------------------------------------
!
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 */
!===============================================================================
!

70
sources/system.F90
View File

@ -617,7 +617,7 @@ module system
subroutine restore_parameters(status)
use io , only : restart_from_snapshot, restart_snapshot_number
use io , only : read_snapshot_parameter
use io , only : restore_snapshot_parameters
use parameters, only : get_parameter
implicit none
@ -636,57 +636,29 @@ module system
dbnds(:,2) = 1.0d+00
if (resumed) then
call read_snapshot_parameter("problem", name, status)
call restore_snapshot_parameters(status)
if (status /=0) return
call read_snapshot_parameter("eqsys" , eqsys, status)
if (status /=0) return
call read_snapshot_parameter("eos" , eos , status)
if (status /=0) return
call read_snapshot_parameter("ncells" , ncells, status)
if (status /=0) return
call read_snapshot_parameter("maxlev" , maxlev, status)
if (status /=0) return
call read_snapshot_parameter("xblocks", bdims(1), status)
if (status /=0) return
call read_snapshot_parameter("yblocks", bdims(2), status)
if (status /=0) return
call read_snapshot_parameter("zblocks", bdims(3), status)
if (status /=0) return
call read_snapshot_parameter("xmin", dbnds(1,1), status)
if (status /=0) return
call read_snapshot_parameter("xmax", dbnds(1,2), status)
if (status /=0) return
call read_snapshot_parameter("ymin", dbnds(2,1), status)
if (status /=0) return
call read_snapshot_parameter("ymax", dbnds(2,2), status)
if (status /=0) return
#if NDIMS == 3
call read_snapshot_parameter("zmin", dbnds(3,1), status)
if (status /=0) return
call read_snapshot_parameter("zmax", dbnds(3,2), status)
if (status /=0) return
#endif /* NDIMS == 3 */
else
call get_parameter("problem", name)
call get_parameter("equation_system" , eqsys)
call get_parameter("equation_of_state", eos)
call get_parameter("ncells", ncells)
call get_parameter("maxlev", maxlev)
call get_parameter("xblocks", bdims(1))
call get_parameter("yblocks", bdims(2))
#if NDIMS == 3
call get_parameter("zblocks", bdims(3))
#endif /* NDIMS == 3 */
call get_parameter("xmin", dbnds(1,1))
call get_parameter("xmax", dbnds(1,2))
call get_parameter("ymin", dbnds(2,1))
call get_parameter("ymax", dbnds(2,2))
#if NDIMS == 3
call get_parameter("zmin", dbnds(3,1))
call get_parameter("zmax", dbnds(3,2))
#endif /* NDIMS == 3 */
end if
call get_parameter("problem", name)
call get_parameter("equation_system" , eqsys)
call get_parameter("equation_of_state", eos)
call get_parameter("ncells", ncells)
call get_parameter("maxlev", maxlev)
call get_parameter("xblocks", bdims(1))
call get_parameter("yblocks", bdims(2))
#if NDIMS == 3
call get_parameter("zblocks", bdims(3))
#endif /* NDIMS == 3 */
call get_parameter("xmin", dbnds(1,1))
call get_parameter("xmax", dbnds(1,2))
call get_parameter("ymin", dbnds(2,1))
call get_parameter("ymax", dbnds(2,2))
#if NDIMS == 3
call get_parameter("zmin", dbnds(3,1))
call get_parameter("zmax", dbnds(3,2))
#endif /* NDIMS == 3 */
call get_parameter("rngtype", rngtype)
call get_parameter("tmax" , tmax)
call get_parameter("trun" , trun)