diff --git a/src/interface.f90 b/src/interface.f90 index 74f2e7d8..2c628e55 100644 --- a/src/interface.f90 +++ b/src/interface.f90 @@ -5,12 +5,14 @@ module h5fortran use hdf5, only : HID_T, SIZE_T, HSIZE_T, H5F_ACC_RDONLY_F, H5F_ACC_RDWR_F, H5F_ACC_TRUNC_F, & h5open_f, h5close_f, h5gcreate_f, h5gclose_f, h5fopen_f, h5fcreate_f, h5fclose_f, h5lexists_f, & h5get_libversion_f, h5eset_auto_f +use h5lt, only : h5ltget_dataset_ndims_f, h5ltget_dataset_info_f use string_utils, only : toLower, strip_trailing_null, truncate_string_null implicit none private -public :: hdf5_file, toLower, hsize_t, strip_trailing_null, truncate_string_null, check, h5write, h5read +public :: hdf5_file, toLower, hdf_shape_check, hsize_t, strip_trailing_null, truncate_string_null, & + check, h5write, h5read !> main type @@ -159,13 +161,6 @@ module subroutine lt7read(filename, dname, value, ierr) end subroutine lt7read -module subroutine hdf_setup_read(self, dname, dims, ierr) -class(hdf5_file), intent(in) :: self -character(*), intent(in) :: dname -integer(HSIZE_T), intent(in) :: dims(:) -integer, intent(out) :: ierr -end subroutine hdf_setup_read - module subroutine hdf_setup_write(self, dname, dtype, dims, sid, did, ierr, chunk_size) class(hdf5_file), intent(inout) :: self character(*), intent(in) :: dname @@ -505,4 +500,40 @@ logical function check(ierr, msg) end function check +subroutine hdf_shape_check(self, dname, dims, ierr) +class(hdf5_file), intent(in) :: self +character(*), intent(in) :: dname +integer(HSIZE_T), intent(in) :: dims(:) +integer, intent(out) :: ierr + +integer(SIZE_T) :: dsize +integer(HSIZE_T) :: ddims(size(dims)) +integer :: dtype, drank + +if (.not.self%exist(dname, ierr)) return + +!> check for matching rank, else bad reads can occur--doesn't always crash without this check +call h5ltget_dataset_ndims_f(self%lid, dname, drank, ierr) +if (check(ierr, 'ERROR: get_dataset_ndim ' // dname // ' read ' // self%filename)) return + +if (drank /= size(dims)) then + write(stderr,'(A,I6,A,I6)') 'ERROR: rank mismatch ' // dname // ' = ',drank,' variable rank =', size(dims) + ierr = -1 + return +endif + +!> check for matching size, else bad reads can occur. + +call h5ltget_dataset_info_f(self%lid, dname, ddims, dtype, dsize, ierr) +if (check(ierr, 'ERROR: get_dataset_info ' // dname // ' read ' // self%filename)) return + +if(.not. all(dims == ddims)) then + write(stderr,*) 'ERROR: shape mismatch ' // dname // ' = ',ddims,' variable shape =', dims + ierr = -1 + return + endif + +end subroutine hdf_shape_check + + end module h5fortran diff --git a/src/read.f90 b/src/read.f90 index bad900d4..0d591d2a 100644 --- a/src/read.f90 +++ b/src/read.f90 @@ -2,9 +2,7 @@ !! This submodule is for reading HDF5 via submodules use hdf5, only : h5dopen_f, h5dread_f, h5dclose_f, h5dget_create_plist_f, & h5pget_layout_f, H5D_CONTIGUOUS_F, H5D_CHUNKED_F -use H5LT, only : h5ltget_dataset_info_f, & - h5ltread_dataset_f, h5ltread_dataset_int_f, h5ltread_dataset_float_f, h5ltread_dataset_double_f,& - h5ltget_dataset_ndims_f, & +use H5LT, only : h5ltread_dataset_f, h5ltread_dataset_int_f, h5ltread_dataset_float_f, h5ltread_dataset_double_f,& h5ltread_dataset_string_f, h5ltpath_valid_f implicit none @@ -12,42 +10,6 @@ contains -module procedure hdf_setup_read -! module subroutine hdf_setup_read(self, dname, dims, ierr) -! class(hdf5_file), intent(in) :: self -! character(*), intent(in) :: dname -! integer(hsize_t), intent(in) :: dims(:) -! integer, intent(out) :: ierr -integer(SIZE_T) :: dsize -integer(HSIZE_T) :: ddims(size(dims)) -integer :: dtype, drank - -if (.not.self%exist(dname, ierr)) return - -!> check for matching rank, else bad reads can occur--doesn't always crash without this check -call h5ltget_dataset_ndims_f(self%lid, dname, drank, ierr) -if (check(ierr, 'ERROR: get_dataset_ndim ' // dname // ' read ' // self%filename)) return - -if (drank /= size(dims)) then - write(stderr,'(A,I6,A,I6)') 'ERROR: rank mismatch ' // dname // ' = ',drank,' variable rank =', size(dims) - ierr = -1 - return -endif - -!> check for matching size, else bad reads can occur. - -call h5ltget_dataset_info_f(self%lid, dname, ddims, dtype, dsize, ierr) -if (check(ierr, 'ERROR: get_dataset_info ' // dname // ' read ' // self%filename)) return - -if(.not. all(dims == ddims)) then - write(stderr,*) 'ERROR: shape mismatch ' // dname // ' = ',ddims,' variable shape =', dims - ierr = -1 - return -endif - -end procedure hdf_setup_read - - module procedure hdf_get_shape !! must get dims before info, as "dims" must be allocated or segfault occurs. integer(SIZE_T) :: dsize diff --git a/src/reader.f90 b/src/reader.f90 index 28a43fb5..30cd6533 100644 --- a/src/reader.f90 +++ b/src/reader.f90 @@ -47,7 +47,7 @@ integer(HSIZE_T) :: dims(rank(value)) dims = shape(value) -call hdf_setup_read(self, dname, dims, ierr) +call hdf_shape_check(self, dname, dims, ierr) if (ierr /= 0) return select type (value) @@ -84,7 +84,7 @@ integer(HSIZE_T) :: dims(rank(value)) dims = shape(value) -call hdf_setup_read(self, dname, dims, ierr) +call hdf_shape_check(self, dname, dims, ierr) if (ierr /= 0) return select type (value) @@ -121,7 +121,7 @@ integer(HSIZE_T) :: dims(rank(value)) dims = shape(value) -call hdf_setup_read(self, dname, dims, ierr) +call hdf_shape_check(self, dname, dims, ierr) if (ierr /= 0) return select type (value) @@ -158,7 +158,7 @@ integer(HSIZE_T) :: dims(rank(value)) dims = shape(value) -call hdf_setup_read(self, dname, dims, ierr) +call hdf_shape_check(self, dname, dims, ierr) if (ierr /= 0) return select type (value) @@ -195,7 +195,7 @@ integer(HSIZE_T) :: dims(rank(value)) dims = shape(value) -call hdf_setup_read(self, dname, dims, ierr) +call hdf_shape_check(self, dname, dims, ierr) if (ierr /= 0) return select type (value) @@ -232,7 +232,7 @@ integer(HSIZE_T) :: dims(rank(value)) dims = shape(value) -call hdf_setup_read(self, dname, dims, ierr) +call hdf_shape_check(self, dname, dims, ierr) if (ierr /= 0) return select type (value) @@ -269,7 +269,7 @@ integer(HSIZE_T) :: dims(rank(value)) dims = shape(value) -call hdf_setup_read(self, dname, dims, ierr) +call hdf_shape_check(self, dname, dims, ierr) if (ierr /= 0) return select type (value)