diff --git a/sources/io.F90 b/sources/io.F90 index ca3f3ed..12d0ea1 100644 --- a/sources/io.F90 +++ b/sources/io.F90 @@ -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) diff --git a/sources/mpitools.F90 b/sources/mpitools.F90 index e04915e..bf40e3c 100644 --- a/sources/mpitools.F90 +++ b/sources/mpitools.F90 @@ -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: ! --------------------- ! diff --git a/sources/parameters.F90 b/sources/parameters.F90 index 91060c8..67cc7e9 100644 --- a/sources/parameters.F90 +++ b/sources/parameters.F90 @@ -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 -!! -!! 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. -!! -!!****************************************************************************** +!=============================================================================== +! +! 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 +! +! +! 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 -! 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 */ !=============================================================================== ! diff --git a/sources/system.F90 b/sources/system.F90 index bf15025..3972834 100644 --- a/sources/system.F90 +++ b/sources/system.F90 @@ -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)