DRIVER, IO: Initialize I/O after reading parameters.

Use it to handle parameters from restart snapshots. Also separate
printing I/O parameters from I/O module initialization.

Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2019-01-29 15:07:50 -02:00
parent 0f0e14dfed
commit 7a2d694629
2 changed files with 188 additions and 190 deletions

View File

@ -48,8 +48,9 @@ program amun
use integrals , only : initialize_integrals, finalize_integrals
use integrals , only : store_integrals
use interpolations , only : initialize_interpolations, finalize_interpolations
use io , only : initialize_io, finalize_io
use io , only : restart_from_snapshot, read_snapshot_parameter
use io , only : initialize_io, finalize_io, print_io
use io , only : restart_snapshot_number, restart_from_snapshot
use io , only : read_snapshot_parameter
use io , only : read_restart_snapshot, write_restart_snapshot
use io , only : write_snapshot, next_tout
use mesh , only : initialize_mesh, finalize_mesh
@ -82,10 +83,9 @@ program amun
!
implicit none
! flat to identify if the problem is run from scratch or restarted
! the number of restarted runs
!
logical :: job_restart = .false.
integer :: nres = 0
integer :: nrun = 0
! default parameters
!
@ -119,10 +119,6 @@ program amun
integer :: ipr, ipi
#endif /* PROFILE */
! local snapshot file counters
!
integer :: nrun = 1
! iteration and time variables
!
integer :: i, ed, eh, em, es, ec
@ -278,15 +274,19 @@ program amun
end if
#endif /* MPI */
! check if the job is restarted
! initialize IO to handle restart snapshots if necessary
!
call get_parameter("restart_number", nres)
job_restart = nres > 0
call initialize_io(master, iret)
if (iret > 0) go to 380
! get the run number
!
nrun = max(1, restart_snapshot_number() + 1)
! if the run is from a restarted job, read the fixed parameters from
! the restart snapshot, otherwise, read them from the parameter file
!
if (job_restart) then
if (restart_from_snapshot()) then
call read_snapshot_parameter("problem", problem, iret)
call read_snapshot_parameter("eqsys" , eqsys , iret)
call read_snapshot_parameter("eos" , eos , iret)
@ -439,20 +439,12 @@ program amun
write (*,"(1x,a)" ) "Snapshots:"
write (*,"(4x,a22,1x,'=',1x,a)") "precise snapshot times", trim(prec_snap)
end if
! initialize module IO
!
call initialize_io(master, nrun, iret)
if (iret > 0) go to 60
call print_io(master)
! check if we initiate new problem or restart previous job
!
if (restart_from_snapshot()) then
! increase the run number
!
nrun = nrun + 1
! initialize the mesh module
!
call initialize_mesh(nrun, master, iret)
@ -704,11 +696,6 @@ program amun
40 continue
call finalize_mesh(iret)
! finalize I/O module
!
60 continue
call finalize_io(iret)
! finalize module OPERATORS
!
80 continue
@ -783,6 +770,11 @@ program amun
!
call finalize_random()
! finalize I/O module
!
380 continue
call finalize_io(iret)
! stop time accounting for the termination
!
call stop_timer(itm)

View File

@ -141,10 +141,18 @@ module io
logical , save :: with_xdmf = .false.
#ifdef HDF5
! compression type
!
integer , parameter :: H5Z_DEFLATE = 1, H5Z_ZSTANDARD = 32015
! compression type (0 for no compressions, 1 for deflate, 32015 for zstandard)
!
integer , save :: compression = 0
! compression level
!
integer , save :: clevel = 0
! HDF5 property object identifier
!
integer(hid_t) , save :: pid
@ -164,10 +172,10 @@ module io
! declare public subroutines
!
public :: initialize_io, finalize_io
public :: initialize_io, finalize_io, print_io
public :: restart_snapshot_number, restart_from_snapshot
public :: read_snapshot_parameter
public :: read_restart_snapshot, write_restart_snapshot, write_snapshot
public :: restart_from_snapshot
public :: next_tout
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@ -190,12 +198,11 @@ module io
! Arguments:
!
! verbose - flag determining if the subroutine should be verbose;
! irun - job execution counter;
! iret - return flag of the procedure execution status;
!
!===============================================================================
!
subroutine initialize_io(verbose, irun, iret)
subroutine initialize_io(verbose, iret)
! import external procedures
!
@ -215,26 +222,16 @@ module io
! subroutine arguments
!
logical, intent(in) :: verbose
integer, intent(inout) :: irun, iret
integer, intent(inout) :: iret
! local variables
!
character(len=255) :: ghosts = "on"
character(len=255) :: xdmf = "off"
integer :: dd, hh, mm, ss
#ifdef HDF5
logical :: status = .false.
integer :: err
integer(hsize_t) :: cd_nelmts = 1
integer, dimension(1) :: cd_values = 3
! compression level
!
integer :: clevel = 0
! local parameters
!
integer, parameter :: H5Z_DEFLATE = 1, H5Z_ZSTANDARD = 32015
#endif /* HDF5 */
! local parameters
@ -322,11 +319,11 @@ module io
!
status = .false.
if (.not. status) then
call h5zfilter_avail_f(H5Z_ZSTANDARD, status, err)
call h5zfilter_avail_f(H5Z_ZSTANDARD, status, iret)
if (status) compression = H5Z_ZSTANDARD
end if
if (.not. status) then
call h5zfilter_avail_f(H5Z_DEFLATE, status, err)
call h5zfilter_avail_f(H5Z_DEFLATE, status, iret)
if (status) compression = H5Z_DEFLATE
end if
@ -349,54 +346,6 @@ module io
end select
#endif /* HDF5 */
! return the run number
!
irun = max(1, nrest)
! print info about snapshot parameters
!
if (verbose) then
if (ftype == 'p') write (*,"(4x,a13,10x,'=',1x,a)") &
"snapshot type", "primitive variables"
if (ftype == 'c') write (*,"(4x,a13,10x,'=',1x,a)") &
"snapshot type", "conservative variables"
if (with_ghosts) then
write (*,"(4x,a21,2x,'=',1x,a)") "with ghosts cells ", "on"
else
write (*,"(4x,a21,2x,'=',1x,a)") "with ghosts cells ", "off"
end if
#ifdef HDF5
select case(compression)
case(H5Z_ZSTANDARD)
write (*,"(4x,a21,2x,'=',1x,a)") "HDF5 compression ", "zstd"
write (*,"(4x,a21,2x,'=', i3)") "compression level ", clevel
case(H5Z_DEFLATE)
write (*,"(4x,a21,2x,'=',1x,a)") "HDF5 compression ", "deflate"
write (*,"(4x,a21,2x,'=', i3)") "compression level ", clevel
case default
write (*,"(4x,a21,2x,'=',1x,a)") "HDF5 compression ", "none"
end select
#endif /* HDF5 */
if (with_xdmf) then
write (*,"(4x,a21,2x,'=',1x,a)") "generate XDMF files ", "on"
else
write (*,"(4x,a21,2x,'=',1x,a)") "generate XDMF files ", "off"
end if
write (*,"(4x,a21,2x,'=',1x,es9.2)") "snapshot interval ", hsnap
if (hrest > 0.0d+00) then
dd = int(hrest / 2.4d+01)
hh = int(mod(hrest, 2.4d+01))
mm = int(mod(6.0d+01 * hrest, 6.0d+01))
ss = int(mod(3.6d+03 * hrest, 6.0d+01))
write (*,"(4x,a16,7x,'=',1x,i2.2,'d',i2.2,'h',i2.2,'m',i2.2,'s')") &
"restart interval", dd, hh, mm, ss
end if
if (restart_from_snapshot()) then
write (*,"(4x,a18,5x,'=',1x,'[',a,']')") "restart from path ", trim(respath)
write (*,"(4x,a21,2x,'=',1x,i4)") "restart from snapshot", nrest
end if
end if
#ifdef PROFILE
! stop accounting time for module initialization/finalization
!
@ -487,11 +436,116 @@ module io
!
!===============================================================================
!
! subroutine PRINT_IO:
! -------------------
!
! Subroutine prints IO parameters.
!
! Arguments:
!
! verbose - flag determining if the subroutine should be verbose;
!
!===============================================================================
!
subroutine print_io(verbose)
! local variables are not implicit by default
!
implicit none
! subroutine arguments
!
logical, intent(in) :: verbose
! local variables
!
integer :: dd, hh, mm, ss
! local parameters
!
character(len=*), parameter :: loc = 'IO::print_io()'
!
!-------------------------------------------------------------------------------
!
if (verbose) then
if (ftype == 'p') write (*,"(4x,a13,10x,'=',1x,a)") &
"snapshot type", "primitive variables"
if (ftype == 'c') write (*,"(4x,a13,10x,'=',1x,a)") &
"snapshot type", "conservative variables"
if (with_ghosts) then
write (*,"(4x,a21,2x,'=',1x,a)") "with ghosts cells ", "on"
else
write (*,"(4x,a21,2x,'=',1x,a)") "with ghosts cells ", "off"
end if
#ifdef HDF5
select case(compression)
case(H5Z_ZSTANDARD)
write (*,"(4x,a21,2x,'=',1x,a)") "HDF5 compression ", "zstd"
write (*,"(4x,a21,2x,'=', i3)") "compression level ", clevel
case(H5Z_DEFLATE)
write (*,"(4x,a21,2x,'=',1x,a)") "HDF5 compression ", "deflate"
write (*,"(4x,a21,2x,'=', i3)") "compression level ", clevel
case default
write (*,"(4x,a21,2x,'=',1x,a)") "HDF5 compression ", "none"
end select
#endif /* HDF5 */
if (with_xdmf) then
write (*,"(4x,a21,2x,'=',1x,a)") "generate XDMF files ", "on"
else
write (*,"(4x,a21,2x,'=',1x,a)") "generate XDMF files ", "off"
end if
write (*,"(4x,a21,2x,'=',1x,es9.2)") "snapshot interval ", hsnap
if (hrest > 0.0d+00) then
dd = int(hrest / 2.4d+01)
hh = int(mod(hrest, 2.4d+01))
mm = int(mod(6.0d+01 * hrest, 6.0d+01))
ss = int(mod(3.6d+03 * hrest, 6.0d+01))
write (*,"(4x,a16,7x,'=',1x,i2.2,'d',i2.2,'h',i2.2,'m',i2.2,'s')") &
"restart interval", dd, hh, mm, ss
end if
if (restart_from_snapshot()) then
write (*,"(4x,a18,5x,'=',1x,'[',a,']')") "restart from path ", &
trim(respath)
write (*,"(4x,a21,2x,'=',1x,i4)") "restart from snapshot", nrest
end if
end if
!-------------------------------------------------------------------------------
!
end subroutine print_io
!
!===============================================================================
!
! function RESTART_SNAPSHOT_NUMBER:
! --------------------------------
!
! Subroutine returns the number of restart snapshot.
!
!
!===============================================================================
!
integer function restart_snapshot_number()
! local variables are not implicit by default
!
implicit none
!
!-------------------------------------------------------------------------------
!
restart_snapshot_number = nrest
!-------------------------------------------------------------------------------
!
end function restart_snapshot_number
!
!===============================================================================
!
! function RESTART_FROM_SNAPSHOT:
! ------------------------------
!
! Subroutine returns true if the job was selected to be restarted from
! a snapshot.
! Subroutine returns true if the current job is the restarted one.
!
!
!===============================================================================
@ -778,7 +832,6 @@ module io
use hdf5 , only : H5F_ACC_RDONLY_F
use hdf5 , only : H5T_NATIVE_CHARACTER
use hdf5 , only : hid_t, hsize_t, size_t
use hdf5 , only : h5open_f, h5close_f
use hdf5 , only : h5fopen_f, h5fclose_f
use hdf5 , only : h5gopen_f, h5gclose_f
use hdf5 , only : h5aexists_by_name_f
@ -801,9 +854,7 @@ module io
! local variables
!
logical :: info
character(len=255) :: rpath = "./"
character(len=255) :: rname
integer :: nrest = 0
integer :: np
integer(hid_t) :: fid, gid, tid, aid
integer(size_t) :: aln
@ -820,46 +871,37 @@ module io
!
iret = 0
! get the path and the number of the restart snapshot
!
call get_parameter("restart_path" , rpath)
call get_parameter("restart_number", nrest)
! generate the filename of the restart snapshot
!
info = .false.
np = nproc + 1
do while (.not. info .and. np >= 0)
np = np - 1
write (rname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(rpath), nrest, np
write (rname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, np
inquire(file = rname, exist = info)
end do
! procees if file exists
!
if (info) then
call h5open_f(iret)
call h5fopen_f(rname, H5F_ACC_RDONLY_F, fid, iret)
if (iret >= 0) then
call h5fopen_f(rname, H5F_ACC_RDONLY_F, fid, iret)
call h5gopen_f(fid, 'attributes', gid, iret)
if (iret >= 0) then
call h5gopen_f(fid, 'attributes', gid, iret)
if (iret >= 0) then
call h5aexists_by_name_f(gid, '.', trim(pname), info, iret)
if (info .and. iret >= 0) then
call h5aopen_by_name_f(gid, '.', trim(pname), aid, iret)
if (iret >= 0) then
aln = len(pvalue)
call h5tcopy_f(H5T_NATIVE_CHARACTER, tid, iret)
call h5tset_size_f(tid, aln, iret)
call h5aread_f(aid, tid, pvalue, am(:), iret)
call h5aclose_f(aid, iret)
end if
call h5aexists_by_name_f(gid, '.', trim(pname), info, iret)
if (info .and. iret >= 0) then
call h5aopen_by_name_f(gid, '.', trim(pname), aid, iret)
if (iret >= 0) then
aln = len(pvalue)
call h5tcopy_f(H5T_NATIVE_CHARACTER, tid, iret)
call h5tset_size_f(tid, aln, iret)
call h5aread_f(aid, tid, pvalue, am(:), iret)
call h5aclose_f(aid, iret)
end if
call h5gclose_f(gid, iret)
end if
call h5fclose_f(fid, iret)
call h5gclose_f(gid, iret)
end if
call h5close_f(iret)
call h5fclose_f(fid, iret)
end if
else
write(error_unit,"('[', a, ']: ', a)") trim(loc) &
@ -894,7 +936,6 @@ module io
use hdf5 , only : H5F_ACC_RDONLY_F
use hdf5 , only : H5T_NATIVE_INTEGER
use hdf5 , only : hid_t, hsize_t, size_t
use hdf5 , only : h5open_f, h5close_f
use hdf5 , only : h5fopen_f, h5fclose_f
use hdf5 , only : h5gopen_f, h5gclose_f
use hdf5 , only : h5aexists_by_name_f
@ -916,9 +957,7 @@ module io
! local variables
!
logical :: info
character(len=255) :: rpath = "./"
character(len=255) :: rname
integer :: nrest = 0
integer :: np
integer(hid_t) :: fid, gid, aid
integer(size_t) :: aln
@ -935,43 +974,34 @@ module io
!
iret = 0
! get the path and the number of the restart snapshot
!
call get_parameter("restart_path" , rpath)
call get_parameter("restart_number", nrest)
! generate the filename of the restart snapshot
!
info = .false.
np = nproc + 1
do while (.not. info .and. np >= 0)
np = np - 1
write (rname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(rpath), nrest, np
write (rname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, np
inquire(file = rname, exist = info)
end do
! procees if file exists
!
if (info) then
call h5open_f(iret)
call h5fopen_f(rname, H5F_ACC_RDONLY_F, fid, iret)
if (iret >= 0) then
call h5fopen_f(rname, H5F_ACC_RDONLY_F, fid, iret)
call h5gopen_f(fid, 'attributes', gid, iret)
if (iret >= 0) then
call h5gopen_f(fid, 'attributes', gid, iret)
if (iret >= 0) then
call h5aexists_by_name_f(gid, '.', trim(pname), info, iret)
if (info .and. iret >= 0) then
call h5aopen_by_name_f(gid, '.', trim(pname), aid, iret)
if (iret >= 0) then
call h5aread_f(aid, H5T_NATIVE_INTEGER, pvalue, am(:), iret)
call h5aclose_f(aid, iret)
end if
call h5aexists_by_name_f(gid, '.', trim(pname), info, iret)
if (info .and. iret >= 0) then
call h5aopen_by_name_f(gid, '.', trim(pname), aid, iret)
if (iret >= 0) then
call h5aread_f(aid, H5T_NATIVE_INTEGER, pvalue, am(:), iret)
call h5aclose_f(aid, iret)
end if
call h5gclose_f(gid, iret)
end if
call h5fclose_f(fid, iret)
call h5gclose_f(gid, iret)
end if
call h5close_f(iret)
call h5fclose_f(fid, iret)
end if
else
write(error_unit,"('[', a, ']: ', a)") trim(loc) &
@ -1006,7 +1036,6 @@ module io
use hdf5 , only : H5F_ACC_RDONLY_F
use hdf5 , only : H5T_NATIVE_INTEGER
use hdf5 , only : hid_t, hsize_t, size_t
use hdf5 , only : h5open_f, h5close_f
use hdf5 , only : h5fopen_f, h5fclose_f
use hdf5 , only : h5gopen_f, h5gclose_f
use hdf5 , only : h5aexists_by_name_f
@ -1028,9 +1057,7 @@ module io
! local variables
!
logical :: info
character(len=255) :: rpath = "./"
character(len=255) :: rname
integer :: nrest = 0
integer :: np
integer(hid_t) :: fid, gid, aid
integer(size_t) :: aln
@ -1047,44 +1074,35 @@ module io
!
iret = 0
! get the path and the number of the restart snapshot
!
call get_parameter("restart_path" , rpath)
call get_parameter("restart_number", nrest)
! generate the filename of the restart snapshot
!
info = .false.
np = nproc + 1
do while (.not. info .and. np >= 0)
np = np - 1
write (rname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(rpath), nrest, np
write (rname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, np
inquire(file = rname, exist = info)
end do
! procees if file exists
!
if (info) then
call h5open_f(iret)
call h5fopen_f(rname, H5F_ACC_RDONLY_F, fid, iret)
if (iret >= 0) then
call h5fopen_f(rname, H5F_ACC_RDONLY_F, fid, iret)
call h5gopen_f(fid, 'attributes', gid, iret)
if (iret >= 0) then
call h5gopen_f(fid, 'attributes', gid, iret)
if (iret >= 0) then
call h5aexists_by_name_f(gid, '.', trim(pname), info, iret)
if (info .and. iret >= 0) then
call h5aopen_by_name_f(gid, '.', trim(pname), aid, iret)
if (iret >= 0) then
am(1) = size(pvalue)
call h5aread_f(aid, H5T_NATIVE_INTEGER, pvalue, am(:), iret)
call h5aclose_f(aid, iret)
end if
call h5aexists_by_name_f(gid, '.', trim(pname), info, iret)
if (info .and. iret >= 0) then
call h5aopen_by_name_f(gid, '.', trim(pname), aid, iret)
if (iret >= 0) then
am(1) = size(pvalue)
call h5aread_f(aid, H5T_NATIVE_INTEGER, pvalue, am(:), iret)
call h5aclose_f(aid, iret)
end if
call h5gclose_f(gid, iret)
end if
call h5fclose_f(fid, iret)
call h5gclose_f(gid, iret)
end if
call h5close_f(iret)
call h5fclose_f(fid, iret)
end if
else
write(error_unit,"('[', a, ']: ', a)") trim(loc) &
@ -1120,7 +1138,6 @@ module io
use hdf5 , only : H5F_ACC_RDONLY_F
use hdf5 , only : H5T_NATIVE_DOUBLE
use hdf5 , only : hid_t, hsize_t, size_t
use hdf5 , only : h5open_f, h5close_f
use hdf5 , only : h5fopen_f, h5fclose_f
use hdf5 , only : h5gopen_f, h5gclose_f
use hdf5 , only : h5aexists_by_name_f
@ -1142,9 +1159,7 @@ module io
! local variables
!
logical :: info
character(len=255) :: rpath = "./"
character(len=255) :: rname
integer :: nrest = 0
integer :: np
integer(hid_t) :: fid, gid, aid
integer(size_t) :: aln
@ -1161,43 +1176,34 @@ module io
!
iret = 0
! get the path and the number of the restart snapshot
!
call get_parameter("restart_path" , rpath)
call get_parameter("restart_number", nrest)
! generate the filename of the restart snapshot
!
info = .false.
np = nproc + 1
do while (.not. info .and. np >= 0)
np = np - 1
write (rname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(rpath), nrest, np
write (rname, "(a,'r',i6.6,'_',i5.5,'.h5')") trim(respath), nrest, np
inquire(file = rname, exist = info)
end do
! procees if file exists
!
if (info) then
call h5open_f(iret)
call h5fopen_f(rname, H5F_ACC_RDONLY_F, fid, iret)
if (iret >= 0) then
call h5fopen_f(rname, H5F_ACC_RDONLY_F, fid, iret)
call h5gopen_f(fid, 'attributes', gid, iret)
if (iret >= 0) then
call h5gopen_f(fid, 'attributes', gid, iret)
if (iret >= 0) then
call h5aexists_by_name_f(gid, '.', trim(pname), info, iret)
if (info .and. iret >= 0) then
call h5aopen_by_name_f(gid, '.', trim(pname), aid, iret)
if (iret >= 0) then
call h5aread_f(aid, H5T_NATIVE_DOUBLE, pvalue, am(:), iret)
call h5aclose_f(aid, iret)
end if
call h5aexists_by_name_f(gid, '.', trim(pname), info, iret)
if (info .and. iret >= 0) then
call h5aopen_by_name_f(gid, '.', trim(pname), aid, iret)
if (iret >= 0) then
call h5aread_f(aid, H5T_NATIVE_DOUBLE, pvalue, am(:), iret)
call h5aclose_f(aid, iret)
end if
call h5gclose_f(gid, iret)
end if
call h5fclose_f(fid, iret)
call h5gclose_f(gid, iret)
end if
call h5close_f(iret)
call h5fclose_f(fid, iret)
end if
else
write(error_unit,"('[', a, ']: ', a)") trim(loc) &