diff --git a/sources/io.F90 b/sources/io.F90 index d7db328..5174756 100644 --- a/sources/io.F90 +++ b/sources/io.F90 @@ -58,7 +58,6 @@ module io interface read_snapshot_parameter_h5 module procedure read_snapshot_parameter_string_h5 module procedure read_snapshot_parameter_integer_h5 - module procedure read_snapshot_parameter_integer_vector_h5 module procedure read_snapshot_parameter_double_h5 end interface #endif /* HDF5 */ @@ -68,7 +67,6 @@ module io module procedure write_scalar_attribute_integer_h5 module procedure write_scalar_attribute_double_h5 module procedure write_vector_attribute_integer_h5 - module procedure write_vector_attribute_double_h5 module procedure write_array_attribute_long_h5 module procedure write_array_attribute_complex_h5 #endif /* HDF5 */ @@ -77,8 +75,6 @@ module io #ifdef HDF5 module procedure read_scalar_attribute_integer_h5 module procedure read_scalar_attribute_double_h5 - module procedure read_vector_attribute_integer_h5 - module procedure read_vector_attribute_double_h5 module procedure read_array_attribute_long_h5 module procedure read_array_attribute_complex_h5 #endif /* HDF5 */ @@ -87,28 +83,31 @@ module io #ifdef HDF5 module procedure write_1d_array_integer_h5 module procedure write_2d_array_integer_h5 +#if NDIMS == 2 module procedure write_3d_array_integer_h5 +#endif /* NDIMS == 2 */ module procedure write_4d_array_integer_h5 +#if NDIMS == 3 module procedure write_5d_array_integer_h5 +#endif /* NDIMS == 3 */ module procedure write_1d_array_double_h5 - module procedure write_2d_array_double_h5 module procedure write_3d_array_double_h5 module procedure write_4d_array_double_h5 - module procedure write_5d_array_double_h5 #endif /* HDF5 */ end interface interface read_array #ifdef HDF5 module procedure read_1d_array_integer_h5 module procedure read_2d_array_integer_h5 +#if NDIMS == 2 module procedure read_3d_array_integer_h5 +#endif /* NDIMS == 2 */ module procedure read_4d_array_integer_h5 +#if NDIMS == 3 module procedure read_5d_array_integer_h5 +#endif /* NDIMS == 3 */ module procedure read_1d_array_double_h5 - module procedure read_2d_array_double_h5 - module procedure read_3d_array_double_h5 module procedure read_4d_array_double_h5 - module procedure read_5d_array_double_h5 #endif /* HDF5 */ end interface @@ -188,7 +187,6 @@ module io ! HDF5 property object identifier ! integer(hid_t) , save :: pid -#endif /* HDF5 */ ! local variables to store the number of processors ! @@ -197,6 +195,7 @@ module io ! array of pointer used during job restart ! type(pointer_meta), dimension(:), allocatable, save :: block_array +#endif /* HDF5 */ ! by default everything is private ! @@ -268,9 +267,11 @@ module io integer, dimension(1) :: cd_values = 3 #endif /* HDF5 */ +#ifdef HDF5 ! local parameters ! character(len=*), parameter :: loc = 'IO::initialize_io()' +#endif /* HDF5 */ ! !------------------------------------------------------------------------------- ! @@ -479,9 +480,11 @@ module io ! integer, intent(out) :: status +#ifdef HDF5 ! local parameters ! character(len=*), parameter :: loc = 'IO::finalize_io()' +#endif /* HDF5 */ ! !------------------------------------------------------------------------------- ! @@ -809,8 +812,10 @@ module io ! subroutine write_snapshot() - use evolution , only : time - use mpitools , only : master + use evolution, only : time +#ifdef HDF5 + use mpitools , only : master +#endif /* HDF5 */ implicit none @@ -1175,7 +1180,7 @@ module io subroutine read_restart_snapshot_xml(status) use blocks , only : block_meta, block_data, pointer_meta, list_meta - use blocks , only : ndims, ns => nsides, nc => nchildren + use blocks , only : ns => nsides, nc => nchildren use blocks , only : append_metablock, append_datablock, link_blocks use blocks , only : get_mblocks use blocks , only : set_last_id, get_last_id @@ -1186,7 +1191,7 @@ module io use blocks , only : metablock_set_coordinates, metablock_set_bounds use blocks , only : metablock_set_leaf use blocks , only : change_blocks_process - use coordinates , only : nn => bcells, ncells, nghosts, minlev, maxlev + use coordinates , only : nn => bcells, ncells use coordinates , only : xmin, xmax, ymin, ymax, zmin, zmax use evolution , only : step, time, dt, dtn use forcing , only : nmodes, fcoefs, einj @@ -1196,7 +1201,7 @@ module io use mesh , only : redistribute_blocks #endif /* MPI */ use mpitools , only : nprocs, nproc - use random , only : gentype, nseeds, set_seeds + use random , only : gentype, set_seeds implicit none @@ -1206,7 +1211,7 @@ module io ! logical :: test character(len=255) :: dname, fname, line, sname, svalue - integer :: id, il, iu, nl, nx, nm, nd, nv, i, j, k, l, n, p, nu + integer :: il, iu, nl, nx, nm, nd, nv, i, j, k, l, n, p, nu integer(kind=4) :: lndims, lnprocs, lnproc, lmblocks, lnleafs, llast_id integer(kind=4) :: ldblocks, lncells, lnseeds, lnmodes real(kind=8) :: deinj @@ -1765,6 +1770,7 @@ module io ! divide files between processes ! + nl = 0 i = mod(lnprocs, nprocs) j = lnprocs / nprocs do p = 0, nprocs @@ -1938,7 +1944,10 @@ module io use blocks , only : get_last_id use blocks , only : ns => nsides, nc => nchildren use coordinates , only : nn => bcells, ncells, nghosts, minlev, maxlev - use coordinates , only : xmin, xmax, ymin, ymax, zmin, zmax + use coordinates , only : xmin, xmax, ymin, ymax +#if NDIMS == 3 + use coordinates , only : zmin, zmax +#endif /* NDIMS == 3 */ use coordinates , only : bdims => domain_base_dims use equations , only : eqsys, eos, nv use evolution , only : step, time, dt, dtn @@ -1963,11 +1972,17 @@ module io character(len=64) :: dname, fname integer(kind=8) :: digest, bytes integer(kind=4) :: lun = 103 - integer :: nd, nl, nm, nx, i, j, k, l, n, p + integer :: nd, nl, nm, nx, i, j, l, n, p +#if NDIMS == 3 + integer :: k +#endif /* NDIMS == 3 */ ! hash strings ! - character(len=22) :: hfield, hchild, hface, hedge, hcorner, hbound + character(len=22) :: hfield, hchild, hedge, hcorner, hbound +#if NDIMS == 3 + character(len=22) :: hface +#endif /* NDIMS == 3 */ character(len=22) :: hids, harray, hseed, hforce ! local pointers @@ -2444,9 +2459,11 @@ module io use blocks , only : block_meta, block_data, list_meta, list_data use blocks , only : get_dblocks, get_nleafs - use blocks , only : ns => nsides, nc => nchildren use coordinates , only : nn => bcells, ncells, nghosts, minlev, maxlev - use coordinates , only : xmin, xmax, ymin, ymax, zmin, zmax + use coordinates , only : xmin, xmax, ymin, ymax +#if NDIMS == 3 + use coordinates , only : zmin, zmax +#endif /* NDIMS == 3 */ use coordinates , only : bdims => domain_base_dims use equations , only : eqsys, eos, nv, pvars, gamma, csnd use evolution , only : step, time, dt, dtn @@ -3015,7 +3032,7 @@ module io use hdf5 , only : hid_t 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 : hid_t, hsize_t use hdf5 , only : h5fopen_f, h5fclose_f use hdf5 , only : h5gopen_f, h5gclose_f use hdf5 , only : h5aexists_by_name_f @@ -3040,7 +3057,6 @@ module io character(len=255) :: rname integer :: np integer(hid_t) :: fid, gid, aid - integer(size_t) :: aln integer(hsize_t) :: am(1) = 1 ! local parameters @@ -3095,107 +3111,6 @@ module io ! !=============================================================================== ! -! subroutine READ_SNAPSHOT_PARAMETER_INTEGER_VECTOR_H5: -! ---------------------------------------------------- -! -! Subroutine reads an integer vector parameter from the restart snapshot. -! -! Arguments: -! -! pname - the parameter name; -! pvalue - the parameter value; -! iret - the success flag (the success is 0, failure otherwise); -! -!=============================================================================== -! - subroutine read_snapshot_parameter_integer_vector_h5(pname, pvalue, iret) - -! import external procedures -! - use hdf5 , only : hid_t - 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 : h5fopen_f, h5fclose_f - use hdf5 , only : h5gopen_f, h5gclose_f - use hdf5 , only : h5aexists_by_name_f - use hdf5 , only : h5aopen_by_name_f, h5aread_f, h5aclose_f - use iso_fortran_env, only : error_unit - use mpitools , only : nproc - use parameters , only : get_parameter - -! local variables are not implicit by default -! - implicit none - -! subroutine arguments -! - character(len=*) , intent(in) :: pname - integer, dimension(:), intent(inout) :: pvalue - integer , intent(inout) :: iret - -! local variables -! - logical :: info - character(len=255) :: rname - integer :: np - integer(hid_t) :: fid, gid, aid - integer(size_t) :: aln - integer(hsize_t) :: am(1) = 1 - -! local parameters -! - character(len=*), parameter :: loc = & - 'IO::read_snapshot_parameter_integer_vector_h5()' -! -!------------------------------------------------------------------------------- -! -! reset the success flag -! - iret = 0 - -! 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(respath), nrest, np - inquire(file = rname, exist = info) - end do - -! procees if file exists -! - if (info) then - call h5fopen_f(rname, H5F_ACC_RDONLY_F, fid, 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 - end if - call h5gclose_f(gid, iret) - end if - call h5fclose_f(fid, iret) - end if - else - write(error_unit,"('[', a, ']: ', a)") trim(loc) & - , "Snapshot " // trim(rname) // " file does not exist!" - iret = 1 - end if - -!------------------------------------------------------------------------------- -! - end subroutine read_snapshot_parameter_integer_vector_h5 -! -!=============================================================================== -! ! subroutine READ_SNAPSHOT_PARAMETER_DOUBLE_H5: ! -------------------------------------------- ! @@ -3217,7 +3132,7 @@ module io use hdf5 , only : hid_t 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 : hid_t, hsize_t use hdf5 , only : h5fopen_f, h5fclose_f use hdf5 , only : h5gopen_f, h5gclose_f use hdf5 , only : h5aexists_by_name_f @@ -3242,7 +3157,6 @@ module io character(len=255) :: rname integer :: np integer(hid_t) :: fid, gid, aid - integer(size_t) :: aln integer(hsize_t) :: am(1) = 1 ! local parameters @@ -4052,15 +3966,14 @@ module io use blocks , only : append_metablock use blocks , only : set_last_id, get_last_id use blocks , only : get_mblocks, get_dblocks, get_nleafs - use coordinates , only : ncells, nghosts + use coordinates , only : ncells use coordinates , only : xmin, xmax, ymin, ymax, zmin, zmax use evolution , only : step, time, dt, dtn use forcing , only : nmodes, fcoefs - use hdf5 , only : hid_t, hsize_t + use hdf5 , only : hid_t use hdf5 , only : h5gopen_f, h5gclose_f use iso_fortran_env, only : error_unit - use mpitools , only : nprocs, nproc - use random , only : nseeds, set_seeds, gentype + use random , only : set_seeds, gentype ! local variables are not implicit by default ! @@ -4235,7 +4148,10 @@ module io ! local variables ! integer(hid_t) :: gid - integer(kind=4) :: i, j, k, l, n, p + integer(kind=4) :: i, j, l, n, p +#if NDIMS == 3 + integer(kind=4) :: k +#endif /* NDIMS == 3 */ integer :: iret integer(hsize_t), dimension(1) :: am, cm integer(hsize_t), dimension(2) :: dm, pm @@ -4547,7 +4463,6 @@ module io use hdf5 , only : hid_t, hsize_t use hdf5 , only : h5gopen_f, h5gclose_f use iso_fortran_env, only : error_unit - use mpitools , only : nprocs ! local variables are not implicit by default ! @@ -4560,7 +4475,10 @@ module io ! local variables ! integer(hid_t) :: gid - integer(kind=4) :: i, j, k, l, p, n, ip + integer(kind=4) :: i, j, l, p, n, ip +#if NDIMS == 3 + integer(kind=4) :: k +#endif /* NDIMS == 3 */ integer :: err integer(hsize_t), dimension(1) :: am integer(hsize_t), dimension(2) :: dm, pm @@ -4573,7 +4491,6 @@ module io ! local allocatable arrays ! - integer(kind=4), dimension(:) , allocatable :: idx integer(kind=4), dimension(:) , allocatable :: par, dat integer(kind=4), dimension(:) , allocatable :: id, cpu, lev, cfg, ref, lea real (kind=8), dimension(:) , allocatable :: xmn, xmx, ymn, ymx, zmn, zmx @@ -4870,7 +4787,6 @@ module io ! import external procedures and variables ! - use blocks , only : ndims use blocks , only : block_meta, block_data, list_data use blocks , only : get_dblocks use coordinates , only : nn => bcells @@ -4889,7 +4805,6 @@ module io ! local pointers ! - type(block_meta), pointer :: pmeta type(block_data), pointer :: pdata ! local variables @@ -5023,7 +4938,7 @@ module io ! import external procedures and variables ! - use blocks , only : block_meta, block_data, list_data + use blocks , only : block_meta, block_data use blocks , only : append_datablock, link_blocks use coordinates , only : nn => bcells, ng => nghosts use equations , only : nv @@ -5045,10 +4960,10 @@ module io ! local variables ! - logical :: flag character(len=16) :: bname integer(hid_t) :: gid, bid - integer(kind=4) :: l, i + integer(hsize_t) :: l + integer(kind=4) :: i integer :: dblocks, ncells, nghosts, nc, nb, ne, status ! local arrays @@ -5438,7 +5353,7 @@ module io ! local variables ! integer :: err - integer(kind=4) :: i, j, k, l, n + integer(kind=4) :: l, n integer(kind=4) :: il, jl, kl = 1 integer(kind=4) :: iu, ju, ku = 1 @@ -5627,7 +5542,7 @@ module io ! local variables ! integer :: err - integer(kind=4) :: i, j, k, l, n + integer(kind=4) :: l, n integer(kind=4) :: il, jl, kl = 1 integer(kind=4) :: iu, ju, ku = 1 @@ -6190,105 +6105,6 @@ module io ! !=============================================================================== ! -! subroutine WRITE_VECTOR_ATTRIBUTE_DOUBLE_H5: -! ------------------------------------------- -! -! Subroutine stores a vector of the double precision attribute in the group -! provided by an identifier and the attribute name. -! -! Arguments: -! -! gid - the group identifier to which the attribute should be linked; -! aname - the attribute name; -! avalue - the attribute values; -! -!=============================================================================== -! - subroutine write_vector_attribute_double_h5(gid, aname, avalue) - -! import procedures and variables from other modules -! - use hdf5 , only : H5T_NATIVE_DOUBLE - use hdf5 , only : hid_t, hsize_t - use hdf5 , only : h5screate_simple_f, h5sclose_f - use hdf5 , only : h5acreate_f, h5awrite_f, h5aclose_f - use iso_fortran_env, only : error_unit - -! local variables are not implicit by default -! - implicit none - -! attribute arguments -! - integer(hid_t) , intent(in) :: gid - character(len=*) , intent(in) :: aname - real(kind=8) , dimension(:), intent(in) :: avalue - -! local variables -! - integer(hid_t) :: sid, aid - integer(hsize_t), dimension(1) :: am = (/ 1 /) - integer :: ierr - -! local parameters -! - character(len=*), parameter :: loc = 'IO::write_vector_attribute_double_h5()' -! -!------------------------------------------------------------------------------- -! -! set the proper attribute length -! - am(1) = size(avalue) - -! create space for the attribute value -! - call h5screate_simple_f(1, am, sid, ierr) - if (ierr /= 0) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot create space for attribute :" // trim(aname) - return - end if - -! create the attribute in the given group -! - call h5acreate_f(gid, aname, H5T_NATIVE_DOUBLE, sid, aid, ierr) - if (ierr == 0) then - -! write the attribute data -! - call h5awrite_f(aid, H5T_NATIVE_DOUBLE, avalue, am, ierr) - if (ierr /= 0) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot write the attribute data in :" // trim(aname) - end if - -! close the attribute -! - call h5aclose_f(aid, ierr) - if (ierr /= 0) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot close attribute :" // trim(aname) - end if - - else - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot create attribute :" // trim(aname) - end if - -! release the space -! - call h5sclose_f(sid, ierr) - if (ierr /= 0) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot close space for attribute :" // trim(aname) - end if - -!------------------------------------------------------------------------------- -! - end subroutine write_vector_attribute_double_h5 -! -!=============================================================================== -! ! subroutine WRITE_ARRAY_ATTRIBUTE_LONG_H5: ! ---------------------------------------- ! @@ -6692,252 +6508,6 @@ module io ! !=============================================================================== ! -! subroutine READ_VECTOR_ATTRIBUTE_INTEGER_H5: -! ------------------------------------------- -! -! Subroutine reads a vector of the integer attribute provided by the group -! identifier to which it is linked and its name. -! -! Arguments: -! -! gid - the group identifier to which the attribute is linked; -! aname - the attribute name; -! avalue - the attribute value; -! -!=============================================================================== -! - subroutine read_vector_attribute_integer_h5(gid, aname, avalue) - -! import procedures and variables from other modules -! - use hdf5 , only : H5T_NATIVE_INTEGER - use hdf5 , only : hid_t, hsize_t - use hdf5 , only : h5aexists_by_name_f, h5aget_space_f - use hdf5 , only : h5aopen_by_name_f, h5aread_f, h5aclose_f - use hdf5 , only : h5sclose_f, h5sget_simple_extent_dims_f - use iso_fortran_env, only : error_unit - -! local variables are not implicit by default -! - implicit none - -! attribute arguments -! - integer(hid_t) , intent(in) :: gid - character(len=*) , intent(in) :: aname - integer(kind=4) , dimension(:), intent(inout) :: avalue - -! local variables -! - logical :: exists = .false. - integer(hid_t) :: aid, sid - integer(hsize_t), dimension(1) :: am, bm - integer(hsize_t) :: alen - integer :: ierr - -! local parameters -! - character(len=*), parameter :: loc = 'IO::read_vector_attribute_integer_h5()' -! -!------------------------------------------------------------------------------- -! -! check if the attribute exists in the group provided by gid -! - call h5aexists_by_name_f(gid, '.', aname, exists, ierr) - if (ierr /= 0) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot check if attribute exists :" // trim(aname) - return - end if - if (.not. exists) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Attribute does not exist :" // trim(aname) - return - end if - -! open the attribute -! - call h5aopen_by_name_f(gid, '.', aname, aid, ierr) - if (ierr /= 0) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot open attribute :" // trim(aname) - return - end if - -! get the attribute space -! - call h5aget_space_f(aid, sid, ierr) - if (ierr == 0) then - call h5sget_simple_extent_dims_f(sid, am, bm, ierr) - if (ierr /= 1) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot get attribute dimensions :" // trim(aname) - end if - call h5sclose_f(sid, ierr) - if (ierr /= 0) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot close the attribute space :" // trim(aname) - end if - else - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot get the attribute space :" // trim(aname) - return - end if - -! check if the output array is large enough -! - if (am(1) > size(avalue)) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Attribute too large for output argument :" // trim(aname) - return - end if - -! read attribute value -! - call h5aread_f(aid, H5T_NATIVE_INTEGER, avalue, am(:), ierr) - if (ierr /= 0) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot read attribute :" // trim(aname) - end if - -! close the attribute -! - call h5aclose_f(aid, ierr) - if (ierr /= 0) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot close attribute :" // trim(aname) - return - end if - -!------------------------------------------------------------------------------- -! - end subroutine read_vector_attribute_integer_h5 -! -!=============================================================================== -! -! subroutine READ_VECTOR_ATTRIBUTE_DOUBLE_H5: -! ------------------------------------------ -! -! Subroutine reads a vector of the double precision attribute provided by -! the group identifier to which it is linked and its name. -! -! Arguments: -! -! gid - the group identifier to which the attribute is linked; -! aname - the attribute name; -! avalue - the attribute value; -! -!=============================================================================== -! - subroutine read_vector_attribute_double_h5(gid, aname, avalue) - -! import procedures and variables from other modules -! - use hdf5 , only : H5T_NATIVE_DOUBLE - use hdf5 , only : hid_t, hsize_t - use hdf5 , only : h5aexists_by_name_f, h5aget_space_f - use hdf5 , only : h5aopen_by_name_f, h5aread_f, h5aclose_f - use hdf5 , only : h5sclose_f, h5sget_simple_extent_dims_f - use iso_fortran_env, only : error_unit - -! local variables are not implicit by default -! - implicit none - -! attribute arguments -! - integer(hid_t) , intent(in) :: gid - character(len=*) , intent(in) :: aname - real(kind=8) , dimension(:), intent(inout) :: avalue - -! local variables -! - logical :: exists = .false. - integer(hid_t) :: aid, sid - integer(hsize_t), dimension(1) :: am, bm - integer(hsize_t) :: alen - integer :: ierr - -! local parameters -! - character(len=*), parameter :: loc = 'IO::read_vector_attribute_double_h5()' -! -!------------------------------------------------------------------------------- -! -! check if the attribute exists in the group provided by gid -! - call h5aexists_by_name_f(gid, '.', aname, exists, ierr) - if (ierr /= 0) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot check if attribute exists :" // trim(aname) - return - end if - if (.not. exists) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Attribute does not exist :" // trim(aname) - return - end if - -! open the attribute -! - call h5aopen_by_name_f(gid, '.', aname, aid, ierr) - if (ierr /= 0) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot open attribute :" // trim(aname) - return - end if - -! get the attribute space -! - call h5aget_space_f(aid, sid, ierr) - if (ierr == 0) then - call h5sget_simple_extent_dims_f(sid, am, bm, ierr) - if (ierr /= 1) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot get attribute dimensions :" // trim(aname) - end if - call h5sclose_f(sid, ierr) - if (ierr /= 0) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot close the attribute space :" // trim(aname) - end if - else - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot get the attribute space :" // trim(aname) - return - end if - -! check if the output array is large enough -! - if (am(1) > size(avalue)) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Attribute too large for output argument :" // trim(aname) - return - end if - -! read attribute value -! - call h5aread_f(aid, H5T_NATIVE_DOUBLE, avalue, am(:), ierr) - if (ierr /= 0) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot read attribute :" // trim(aname) - end if - -! close the attribute -! - call h5aclose_f(aid, ierr) - if (ierr /= 0) then - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot close attribute :" // trim(aname) - return - end if - -!------------------------------------------------------------------------------- -! - end subroutine read_vector_attribute_double_h5 -! -!=============================================================================== -! ! subroutine READ_ARRAY_ATTRIBUTE_LONG_H5: ! --------------------------------------- ! @@ -6978,7 +6548,6 @@ module io logical :: exists = .false. integer(hid_t) :: aid, sid integer(hsize_t), dimension(2) :: am, bm - integer(hsize_t) :: alen integer :: ierr ! local parameters @@ -7101,7 +6670,6 @@ module io logical :: exists = .false. integer(hid_t) :: aid, sid integer(hsize_t), dimension(3) :: am, bm - integer(hsize_t) :: alen integer :: ierr ! local allocatable arrays @@ -7515,6 +7083,7 @@ module io !------------------------------------------------------------------------------- ! end subroutine write_2d_array_integer_h5 +#if NDIMS == 2 ! !=============================================================================== ! @@ -7668,6 +7237,7 @@ module io !------------------------------------------------------------------------------- ! end subroutine write_3d_array_integer_h5 +#endif /* NDIMS == 2 */ ! !=============================================================================== ! @@ -7821,6 +7391,7 @@ module io !------------------------------------------------------------------------------- ! end subroutine write_4d_array_integer_h5 +#if NDIMS == 3 ! !=============================================================================== ! @@ -7975,6 +7546,7 @@ module io !------------------------------------------------------------------------------- ! end subroutine write_5d_array_integer_h5 +#endif /* NDIMS == 3 */ ! !=============================================================================== ! @@ -8139,159 +7711,6 @@ module io ! !=============================================================================== ! -! subroutine WRITE_2D_ARRAY_DOUBLE_H5: -! ------------------------------------ -! -! Subroutine stores a two-dimensional double precision array in a group -! specified by identifier. -! -! Arguments: -! -! gid - the HDF5 group identifier -! name - the string name describing the array -! dm - the array dimensions -! value - the array values -! -!=============================================================================== -! - subroutine write_2d_array_double_h5(gid, name, dm, var) - -! import procedures and variables from other modules -! - use hdf5 , only : H5T_NATIVE_DOUBLE - use hdf5 , only : hid_t, hsize_t - use hdf5 , only : h5screate_simple_f, h5sclose_f - use hdf5 , only : h5dcreate_f, h5dwrite_f, h5dclose_f - use hdf5 , only : h5pset_chunk_f - use iso_fortran_env, only : error_unit - -! local variables are not implicit by default -! - implicit none - -! subroutine arguments -! - integer(hid_t) , intent(in) :: gid - character(len=*) , intent(in) :: name - integer(hsize_t), dimension(2) , intent(in) :: dm - real(kind=8) , dimension(:,:), intent(in) :: var - -! HDF5 object identifiers -! - integer(hid_t) :: sid, did - -! procedure return value -! - integer :: iret - -! local parameters -! - character(len=*), parameter :: loc = 'IO::write_2d_array_double_h5()' -! -!------------------------------------------------------------------------------- -! -! create a space for the array -! - call h5screate_simple_f(2, dm(1:2), sid, iret) - -! check if the space has been created successfuly, if not quit -! - if (iret < 0) then - -! print error about the problem with creating the space -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot create space for dataset: " // trim(name) - -! quit the subroutine -! - return - - end if - -! set the chunk size -! - call h5pset_chunk_f(pid, 2, dm(1:2), iret) - -! check if the chunk size has been set properly -! - if (iret > 0) then - -! print error about the problem with setting the chunk size -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot set the size of the chunk!" - - end if - -! create the dataset -! - call h5dcreate_f(gid, name, H5T_NATIVE_DOUBLE, sid, did, iret, pid) - -! check if the dataset has been created successfuly -! - if (iret >= 0) then - -! write the dataset data -! - call h5dwrite_f(did, H5T_NATIVE_DOUBLE, var(:,:), dm(1:2), iret, sid) - -! check if the dataset has been written successfuly -! - if (iret > 0) then - -! print error about the problem with writing down the dataset -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot write dataset: " // trim(name) - - end if - -! close the dataset -! - call h5dclose_f(did, iret) - -! check if the dataset has been closed successfuly -! - if (iret > 0) then - -! print error about the problem with closing the dataset -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot close dataset: " // trim(name) - - end if - - else - -! print error about the problem with creating the dataset -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot create dataset: " // trim(name) - - end if - -! release the space -! - call h5sclose_f(sid, iret) - -! check if the space has been released successfuly -! - if (iret > 0) then - -! print error about the problem with closing the space -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot close space for dataset: " // trim(name) - - end if - -!------------------------------------------------------------------------------- -! - end subroutine write_2d_array_double_h5 -! -!=============================================================================== -! ! subroutine WRITE_3D_ARRAY_DOUBLE_H5: ! ----------------------------------- ! @@ -8596,160 +8015,6 @@ module io ! end subroutine write_4d_array_double_h5 ! -!=============================================================================== -! -! subroutine WRITE_5D_ARRAY_DOUBLE_H5: -! ----------------------------------- -! -! Subroutine stores a five-dimensional double precision array in a group -! specified by identifier. -! -! Arguments: -! -! gid - the HDF5 group identifier -! name - the string name describing the array -! dm - the array dimensions -! value - the array values -! -!=============================================================================== -! - subroutine write_5d_array_double_h5(gid, name, dm, var) - -! import procedures and variables from other modules -! - use hdf5 , only : H5T_NATIVE_DOUBLE - use hdf5 , only : hid_t, hsize_t - use hdf5 , only : h5screate_simple_f, h5sclose_f - use hdf5 , only : h5dcreate_f, h5dwrite_f, h5dclose_f - use hdf5 , only : h5pset_chunk_f - use iso_fortran_env, only : error_unit - -! local variables are not implicit by default -! - implicit none - -! subroutine arguments -! - integer(hid_t) , intent(in) :: gid - character(len=*) , intent(in) :: name - integer(hsize_t), dimension(5) , intent(in) :: dm - real(kind=8) , dimension(:,:,:,:,:), intent(in) :: var - -! HDF5 object identifiers -! - integer(hid_t) :: sid, did - -! procedure return value -! - integer :: iret - -! local parameters -! - character(len=*), parameter :: loc = 'IO::write_5d_array_double_h5()' -! -!------------------------------------------------------------------------------- -! -! create a space for the array -! - call h5screate_simple_f(5, dm(1:5), sid, iret) - -! check if the space has been created successfuly, if not quit -! - if (iret < 0) then - -! print error about the problem with creating the space -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot create space for dataset: " // trim(name) - -! quit the subroutine -! - return - - end if - -! set the chunk size -! - call h5pset_chunk_f(pid, 5, dm(1:5), iret) - -! check if the chunk size has been set properly -! - if (iret > 0) then - -! print error about the problem with setting the chunk size -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot set the size of the chunk!" - - end if - -! create the dataset -! - call h5dcreate_f(gid, name, H5T_NATIVE_DOUBLE, sid, did, iret, pid) - -! check if the dataset has been created successfuly -! - if (iret >= 0) then - -! write the dataset data -! - call h5dwrite_f(did, H5T_NATIVE_DOUBLE, var(:,:,:,:,:), dm(1:5) & - , iret, sid) - -! check if the dataset has been written successfuly -! - if (iret > 0) then - -! print error about the problem with writing down the dataset -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot write dataset: " // trim(name) - - end if - -! close the dataset -! - call h5dclose_f(did, iret) - -! check if the dataset has been closed successfuly -! - if (iret > 0) then - -! print error about the problem with closing the dataset -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot close dataset: " // trim(name) - - end if - - else - -! print error about the problem with creating the dataset -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot create dataset: " // trim(name) - - end if - -! release the space -! - call h5sclose_f(sid, iret) - -! check if the space has been released successfuly -! - if (iret > 0) then - -! print error about the problem with closing the space -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot close space for dataset: " // trim(name) - - end if - -!------------------------------------------------------------------------------- -! - end subroutine write_5d_array_double_h5 - !=============================================================================== ! ! READ_ARRAY SUBROUTINES @@ -8955,6 +8220,7 @@ module io !------------------------------------------------------------------------------- ! end subroutine read_2d_array_integer_h5 +#if NDIMS == 2 ! !=============================================================================== ! @@ -9056,6 +8322,7 @@ module io !------------------------------------------------------------------------------- ! end subroutine read_3d_array_integer_h5 +#endif /* NDIMS == 2 */ ! !=============================================================================== ! @@ -9157,6 +8424,7 @@ module io !------------------------------------------------------------------------------- ! end subroutine read_4d_array_integer_h5 +#if NDIMS == 3 ! !=============================================================================== ! @@ -9258,6 +8526,7 @@ module io !------------------------------------------------------------------------------- ! end subroutine read_5d_array_integer_h5 +#endif /* NDIMS == 3 */ ! !=============================================================================== ! @@ -9362,208 +8631,6 @@ module io ! !=============================================================================== ! -! subroutine READ_2D_ARRAY_DOUBLE_H5: -! ----------------------------------- -! -! Subroutine restores a two-dimensional double precision array from a group -! specified by identifier. -! -! Arguments: -! -! gid - the HDF5 group identifier -! name - the string name describing the array -! dm - the array dimensions -! value - the array values -! -!=============================================================================== -! - subroutine read_2d_array_double_h5(gid, name, dm, var) - -! import procedures and variables from other modules -! - use hdf5 , only : H5T_NATIVE_DOUBLE - use hdf5 , only : hid_t, hsize_t - use hdf5 , only : h5dopen_f, h5dread_f, h5dclose_f - use iso_fortran_env, only : error_unit - -! local variables are not implicit by default -! - implicit none - -! subroutine arguments -! - integer(hid_t) , intent(in) :: gid - character(len=*) , intent(in) :: name - integer(hsize_t), dimension(2) , intent(inout) :: dm - real(kind=8) , dimension(:,:), intent(inout) :: var - -! local variables -! - integer(hid_t) :: did - integer :: iret - -! local parameters -! - character(len=*), parameter :: loc = 'IO::read_2d_array_double_h5()' -! -!------------------------------------------------------------------------------- -! -! open the dataset -! - call h5dopen_f(gid, name, did, iret) - -! check if the dataset has been opened successfuly -! - if (iret < 0) then - -! print error about the problem with opening the data space -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot open dataset: " // trim(name) - -! quit the subroutine -! - return - - end if - -! read dataset data -! - call h5dread_f(did, H5T_NATIVE_DOUBLE, var(:,:), dm(1:2), iret) - -! check if the dataset has been read successfuly -! - if (iret > 0) then - -! print error about the problem with reading the dataset -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot read dataset: " // trim(name) - - end if - -! close the dataset -! - call h5dclose_f(did, iret) - -! check if the dataset has been closed successfuly -! - if (iret > 0) then - -! print error about the problem with closing the dataset -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot close dataset: " // trim(name) - - end if - -!------------------------------------------------------------------------------- -! - end subroutine read_2d_array_double_h5 -! -!=============================================================================== -! -! subroutine READ_3D_ARRAY_DOUBLE_H5: -! ----------------------------------- -! -! Subroutine restores a three-dimensional double precision array from a group -! specified by identifier. -! -! Arguments: -! -! gid - the HDF5 group identifier -! name - the string name describing the array -! dm - the array dimensions -! value - the array values -! -!=============================================================================== -! - subroutine read_3d_array_double_h5(gid, name, dm, var) - -! import procedures and variables from other modules -! - use hdf5 , only : H5T_NATIVE_DOUBLE - use hdf5 , only : hid_t, hsize_t - use hdf5 , only : h5dopen_f, h5dread_f, h5dclose_f - use iso_fortran_env, only : error_unit - -! local variables are not implicit by default -! - implicit none - -! subroutine arguments -! - integer(hid_t) , intent(in) :: gid - character(len=*) , intent(in) :: name - integer(hsize_t), dimension(3) , intent(inout) :: dm - real(kind=8) , dimension(:,:,:), intent(inout) :: var - -! local variables -! - integer(hid_t) :: did - integer :: iret - -! local parameters -! - character(len=*), parameter :: loc = 'IO::read_3d_array_double_h5()' -! -!------------------------------------------------------------------------------- -! -! open the dataset -! - call h5dopen_f(gid, name, did, iret) - -! check if the dataset has been opened successfuly -! - if (iret < 0) then - -! print error about the problem with opening the data space -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot open dataset: " // trim(name) - -! quit the subroutine -! - return - - end if - -! read dataset data -! - call h5dread_f(did, H5T_NATIVE_DOUBLE, var(:,:,:), dm(1:3), iret) - -! check if the dataset has been read successfuly -! - if (iret > 0) then - -! print error about the problem with reading the dataset -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot read dataset: " // trim(name) - - end if - -! close the dataset -! - call h5dclose_f(did, iret) - -! check if the dataset has been closed successfuly -! - if (iret > 0) then - -! print error about the problem with closing the dataset -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot close dataset: " // trim(name) - - end if - -!------------------------------------------------------------------------------- -! - end subroutine read_3d_array_double_h5 -! -!=============================================================================== -! ! subroutine READ_4D_ARRAY_DOUBLE_H5: ! ----------------------------------- ! @@ -9665,107 +8732,6 @@ module io ! !=============================================================================== ! -! subroutine READ_5D_ARRAY_DOUBLE_H5: -! ----------------------------------- -! -! Subroutine restores a five-dimensional double precision array from a group -! specified by identifier. -! -! Arguments: -! -! gid - the HDF5 group identifier -! name - the string name describing the array -! dm - the array dimensions -! value - the array values -! -!=============================================================================== -! - subroutine read_5d_array_double_h5(gid, name, dm, var) - -! import procedures and variables from other modules -! - use hdf5 , only : H5T_NATIVE_DOUBLE - use hdf5 , only : hid_t, hsize_t - use hdf5 , only : h5dopen_f, h5dread_f, h5dclose_f - use iso_fortran_env, only : error_unit - -! local variables are not implicit by default -! - implicit none - -! subroutine arguments -! - integer(hid_t) , intent(in) :: gid - character(len=*) , intent(in) :: name - integer(hsize_t), dimension(5) , intent(inout) :: dm - real(kind=8) , dimension(:,:,:,:,:), intent(inout) :: var - -! local variables -! - integer(hid_t) :: did - integer :: iret - -! local parameters -! - character(len=*), parameter :: loc = 'IO::read_5d_array_double_h5()' -! -!------------------------------------------------------------------------------- -! -! open the dataset -! - call h5dopen_f(gid, name, did, iret) - -! check if the dataset has been opened successfuly -! - if (iret < 0) then - -! print error about the problem with opening the data space -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot open dataset: " // trim(name) - -! quit the subroutine -! - return - - end if - -! read dataset data -! - call h5dread_f(did, H5T_NATIVE_DOUBLE, var(:,:,:,:,:), dm(1:5), iret) - -! check if the dataset has been read successfuly -! - if (iret > 0) then - -! print error about the problem with reading the dataset -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot read dataset: " // trim(name) - - end if - -! close the dataset -! - call h5dclose_f(did, iret) - -! check if the dataset has been closed successfuly -! - if (iret > 0) then - -! print error about the problem with closing the dataset -! - write(error_unit,"('[',a,']: ',a)") trim(loc) & - , "Cannot close dataset: " // trim(name) - - end if - -!------------------------------------------------------------------------------- -! - end subroutine read_5d_array_double_h5 -! -!=============================================================================== -! ! subroutine WRITE_SNAPSHOT_XDMF: ! ------------------------------ ! @@ -9788,7 +8754,10 @@ module io use equations , only : nv, pvars use mpitools , only : nproc use coordinates , only : ni => ncells, ng => nghosts - use coordinates , only : adx, ady, adz + use coordinates , only : adx, ady +#if NDIMS == 3 + use coordinates , only : adz +#endif /* NDIMS == 3 */ use evolution , only : time ! local variables are not implicit by default @@ -9804,7 +8773,10 @@ module io character(len=64) :: fname, hname character(len=128) :: stmp, ttmp, sdim, bdim, pdim integer(kind=4) :: l, p - integer(kind=4) :: ip, jp, kp + integer(kind=4) :: ip, jp +#if NDIMS == 3 + integer(kind=4) :: kp +#endif /* NDIMS == 3 */ ! local arrays !