IO, PARAMETERS, SYSTEM: Better parameter restoring.
This commit implements a better way (less I/O operations) restoring of the parameters during the job restart. Some parameters, such as the size of the block, or the equation system, cannot be changed during the restart. Such parameters need to be restored from the restart snapshots. The new way restores these parameters on the MPI master process only, updates their values if they were changed, and distributes them to other MPI processes. This way the number of I/O operations is kept to the minimum (only one process access one file). Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
parent
66f5fc5c58
commit
0c8cab74a2
635
sources/io.F90
635
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
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
@ -2783,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
|
||||
@ -2835,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'!")
|
||||
@ -3001,7 +2866,7 @@ module io
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
end subroutine read_snapshot_parameter_double_h5
|
||||
end subroutine restore_snapshot_parameters_h5
|
||||
!
|
||||
!===============================================================================
|
||||
!
|
||||
@ -3020,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
|
||||
|
||||
@ -3059,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)
|
||||
|
||||
@ -66,7 +66,10 @@ module parameters
|
||||
! --------------
|
||||
!
|
||||
public :: read_parameters, finalize_parameters
|
||||
public :: parameter_file, get_parameter
|
||||
public :: parameter_file, update_parameter, get_parameter
|
||||
#ifdef MPI
|
||||
public :: distribute_parameters
|
||||
#endif /* MPI */
|
||||
|
||||
contains
|
||||
|
||||
@ -324,6 +327,63 @@ module 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 update_parameter(key, val)
|
||||
|
||||
use iso_fortran_env, only : error_unit
|
||||
|
||||
implicit none
|
||||
|
||||
character(len=*), intent(in) :: key, val
|
||||
|
||||
type(item), pointer :: item_ptr
|
||||
|
||||
logical :: exists
|
||||
|
||||
character(len=*), parameter :: loc = 'PARAMETERS::update_parameter()'
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
exists = .false.
|
||||
item_ptr => parameter_list
|
||||
do while(associated(item_ptr))
|
||||
if (key == item_ptr%key) then
|
||||
if (val /= item_ptr%val) item_ptr%val = val
|
||||
exists = .true.
|
||||
exit
|
||||
end if
|
||||
item_ptr => item_ptr%next
|
||||
end do
|
||||
|
||||
if (.not. exists) then
|
||||
allocate(item_ptr)
|
||||
item_ptr%key = key
|
||||
item_ptr%val = val
|
||||
item_ptr%next => parameter_list
|
||||
parameter_list => item_ptr
|
||||
end if
|
||||
|
||||
return
|
||||
|
||||
!-------------------------------------------------------------------------------
|
||||
!
|
||||
end subroutine update_parameter
|
||||
|
||||
!===============================================================================
|
||||
!
|
||||
! subroutine GET_PARAMETER_INTEGER:
|
||||
@ -499,6 +559,17 @@ module parameters
|
||||
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
|
||||
|
||||
@ -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)
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user