add is_hdf5(), %ndim. add test_shape

Author: scivision

src/interface.f90

@@ -14,7 +14,7 @@ module h5mpi
 H5S_ALL_F, H5S_SELECT_SET_F, &
 H5D_CHUNKED_F, H5D_CONTIGUOUS_F, H5D_COMPACT_F, &
 h5dcreate_f, h5dopen_f, h5dclose_f, h5dget_space_f, h5dget_create_plist_f, &
-h5fopen_f, h5fclose_f, h5fcreate_f, h5fget_filesize_f, h5fflush_f, &
+h5fopen_f, h5fclose_f, h5fcreate_f, h5fget_filesize_f, h5fflush_f, h5fis_hdf5_f, &
 h5pcreate_f, h5pclose_f, h5pset_chunk_f, h5pset_dxpl_mpio_f, h5pset_fapl_mpio_f, h5pall_filters_avail_f, &
 h5sselect_hyperslab_f, h5screate_simple_f, h5sclose_f, &
 h5get_libversion_f, &
@@ -44,7 +44,7 @@ module h5mpi
 contains
 
 procedure, public :: open => ph5open, close => ph5close, &
-flush => hdf_flush, shape => h5get_shape, exist => hdf_exist, &
+flush => hdf_flush, ndim => hdf_get_ndim, shape => hdf_get_shape, exist => hdf_exist, &
 create => hdf_create, filesize => hdf_filesize, &
 class => get_class, dtype => get_native_dtype, &
 deflate => get_deflate, &
@@ -72,7 +72,7 @@ module h5mpi
 end type mpi_tags
 
 private
-public :: mpi_h5comm, hdf5_file, mpi_tags, has_parallel_compression, &
+public :: mpi_h5comm, hdf5_file, mpi_tags, has_parallel_compression, is_hdf5, &
 check, hdf_wrapup, hdf_rank_check, hdf_shape_check, mpi_collective, mpi_hyperslab, &
 hdf5version, HSIZE_T
 
@@ -171,6 +171,28 @@ end subroutine ph5write_7d
 
 interface !< read.f90
 
+module integer function get_class(self, dname)
+class(hdf5_file), intent(in) :: self
+character(*), intent(in) :: dname
+end function get_class
+
+module integer(hid_t) function get_native_dtype(self, dname, ds_id)
+class(hdf5_file), intent(in) :: self
+character(*), intent(in) :: dname
+integer(hid_t), intent(in), optional :: ds_id
+end function get_native_dtype
+
+module integer function hdf_get_ndim(self, dname) result (drank)
+class(hdf5_file), intent(in) :: self
+character(*), intent(in) :: dname
+end function hdf_get_ndim
+
+module subroutine hdf_get_shape(self, dname, dims)
+class(hdf5_file), intent(in) :: self
+character(*), intent(in) :: dname
+integer(HSIZE_T), intent(out), allocatable :: dims(:)
+end subroutine hdf_get_shape
+
 module subroutine h5open_read(self, dname, dims, dset_dims, filespace, memspace, dset_id)
 class(hdf5_file), intent(in) :: self
 character(*), intent(in) :: dname
@@ -196,16 +218,6 @@ module subroutine hdf_get_chunk(self, dname, chunk_size)
 integer(hsize_t), intent(out) :: chunk_size(:)
 end subroutine hdf_get_chunk
 
-module integer function get_class(self, dname)
-class(hdf5_file), intent(in) :: self
-character(*), intent(in) :: dname
-end function get_class
-
-module integer(hid_t) function get_native_dtype(self, dname, ds_id)
-class(hdf5_file), intent(in) :: self
-character(*), intent(in) :: dname
-integer(hid_t), intent(in), optional :: ds_id
-end function get_native_dtype
 end interface
 
 
@@ -446,6 +458,23 @@ logical function hdf_is_chunked(self, dname)
 end function hdf_is_chunked
 
 
+logical function is_hdf5(filename)
+!! is this file HDF5?
+
+character(*), intent(in) :: filename
+integer :: ierr
+
+inquire(file=filename, exist=is_hdf5)
+!! avoid warning/error messages
+if (.not. is_hdf5) return
+
+call h5fis_hdf5_f(filename, is_hdf5, ierr)
+
+if (ierr/=0) is_hdf5 = .false.
+!! sometimes h5fis_hdf5_f is .true. for missing file
+
+end function is_hdf5
+
 
 subroutine mpi_hyperslab(mem_dims, dset_dims, dset_id, filespace, memspace, dname, istart, iend)
 !! Each process defines dataset in memory and writes it to the hyperslab in the file.
@@ -593,28 +622,6 @@ logical function check(ierr, filename, dname)
 end function check
 
 
-subroutine h5get_shape(self, dname, dims)
-class(hdf5_file), intent(in) :: self
-character(*), intent(in) :: dname
-integer(HSIZE_T), intent(inout), allocatable :: dims(:)
-
-!! must get rank before info, as "dims" must be allocated first.
-integer(SIZE_T) :: type_size
-integer :: type_class, drank, ier
-
-if(.not. self%exist(dname)) error stop 'h5fortran:get_shape: ' // dname // ' does not exist in ' // self%filename
-
-call h5ltget_dataset_ndims_f(self%file_id, dname, drank, ier)
-if (ier /= 0) error stop "h5fortran:get_shape: could not get rank of " // dname // " in " // self%filename
-
-allocate(dims(drank))
-call h5ltget_dataset_info_f(self%file_id, dname, dims=dims, &
-  type_class=type_class, type_size=type_size, errcode=ier)
-if (ier /= 0) error stop "h5fortran:get_shape: could not get shape of " // dname // " in " // self%filename
-
-end subroutine h5get_shape
-
-
 logical function hdf_exist(self, dname) result(exists)
 class(hdf5_file), intent(in) :: self
 character(*), intent(in) :: dname

src/read/read.f90

@@ -93,67 +93,6 @@
 end procedure get_deflate
 
 
-module procedure hdf_get_chunk
-
-integer :: ierr, drank
-integer(HID_T) :: pid, dset_id
-
-if(.not.self%is_open) error stop 'h5fortran:read: file handle is not open'
-
-chunk_size = -1
-if (.not.self%exist(dname)) then
-  write(stderr, *) 'ERROR:get_chunk: ' // dname // ' does not exist in ' // self%filename
-  ierr = -1
-  return
-endif
-
-if(.not.self%is_chunked(dname)) return
-
-call h5ltget_dataset_ndims_f(self%file_id, dname, drank, ierr)
-if (check(ierr, 'ERROR:get_chunk: get rank ' // dname // ' ' // self%filename)) return
-call h5dopen_f(self%file_id, dname, dset_id, ierr)
-if (check(ierr, 'ERROR:get_chunk: open dataset ' // dname // ' ' // self%filename)) return
-call h5dget_create_plist_f(dset_id, pid, ierr)
-if (check(ierr, 'ERROR:get_chunk: get property list ID ' // dname // ' ' // self%filename)) return
-
-call h5pget_chunk_f(pid, drank, chunk_size, ierr)
-if (ierr /= drank) then
-  write(stderr,*) 'ERROR:get_chunk read ' // dname // ' ' // self%filename
-  return
-endif
-
-call h5dclose_f(dset_id, ierr)
-if (check(ierr, 'ERROR:get_chunk: close dataset: ' // dname // ' ' // self%filename)) return
-
-end procedure hdf_get_chunk
-
-
-module procedure hdf_get_layout
-
-integer(HID_T) :: pid, dset_id
-integer :: ierr
-
-if(.not.self%is_open) error stop 'h5fortran:read: file handle is not open'
-
-layout = -1
-
-if (.not.self%exist(dname)) then
-  write(stderr, *) 'ERROR:get_layout: ' // dname // ' does not exist in ' // self%filename
-  return
-endif
-
-call h5dopen_f(self%file_id, dname, dset_id, ierr)
-if (check(ierr, 'ERROR:get_layout: open dataset ' // dname // ' ' // self%filename)) return
-call h5dget_create_plist_f(dset_id, pid, ierr)
-if (check(ierr, 'ERROR:get_layout: get property list ID ' // dname // ' ' // self%filename)) return
-call h5pget_layout_f(pid, layout, ierr)
-if (check(ierr, 'ERROR:get_layout read ' // dname //' ' // self%filename)) return
-call h5dclose_f(dset_id, ierr)
-if (check(ierr, 'ERROR:get_layout: close dataset: ' // dname //' ' // self%filename)) return
-
-end procedure hdf_get_layout
-
-
 subroutine get_dset_class(self, dname, class, ds_id, size_bytes)
 !! get the dataset class (integer, float, string, ...)
 !! {H5T_INTEGER_F, H5T_FLOAT_F, H5T_STRING_F}
@@ -245,4 +184,101 @@ end subroutine get_dset_class
 
 end procedure get_native_dtype
 
+
+module procedure hdf_get_ndim
+!! get rank or "ndims"
+integer :: ier
+
+if(.not.self%is_open) error stop 'h5fortran:read: file handle is not open'
+
+drank = -1
+
+if (self%exist(dname)) then
+  call h5ltget_dataset_ndims_f(self%file_id, dname, drank, ier)
+else
+  write(stderr, '(a)') 'ERROR:get_ndim: ' // dname // ' does not exist in ' // self%filename
+endif
+
+end procedure hdf_get_ndim
+
+
+module procedure hdf_get_shape
+
+!! must get rank before info, as "dims" must be allocated first.
+integer(SIZE_T) :: type_size
+integer :: type_class, drank, ier
+
+if(.not. self%exist(dname)) error stop 'h5fortran:get_shape: ' // dname // ' does not exist in ' // self%filename
+
+call h5ltget_dataset_ndims_f(self%file_id, dname, drank, ier)
+if (ier /= 0) error stop "h5fortran:get_shape: could not get rank of " // dname // " in " // self%filename
+
+allocate(dims(drank))
+call h5ltget_dataset_info_f(self%file_id, dname, dims=dims, &
+  type_class=type_class, type_size=type_size, errcode=ier)
+if (ier /= 0) error stop "h5fortran:get_shape: could not get shape of " // dname // " in " // self%filename
+
+end procedure hdf_get_shape
+
+
+module procedure hdf_get_chunk
+
+integer :: ierr, drank
+integer(HID_T) :: pid, dset_id
+
+if(.not.self%is_open) error stop 'h5fortran:read: file handle is not open'
+
+chunk_size = -1
+if (.not.self%exist(dname)) then
+  write(stderr, *) 'ERROR:get_chunk: ' // dname // ' does not exist in ' // self%filename
+  ierr = -1
+  return
+endif
+
+if(.not.self%is_chunked(dname)) return
+
+call h5ltget_dataset_ndims_f(self%file_id, dname, drank, ierr)
+if (check(ierr, 'ERROR:get_chunk: get rank ' // dname // ' ' // self%filename)) return
+call h5dopen_f(self%file_id, dname, dset_id, ierr)
+if (check(ierr, 'ERROR:get_chunk: open dataset ' // dname // ' ' // self%filename)) return
+call h5dget_create_plist_f(dset_id, pid, ierr)
+if (check(ierr, 'ERROR:get_chunk: get property list ID ' // dname // ' ' // self%filename)) return
+
+call h5pget_chunk_f(pid, drank, chunk_size, ierr)
+if (ierr /= drank) then
+  write(stderr,*) 'ERROR:get_chunk read ' // dname // ' ' // self%filename
+  return
+endif
+
+call h5dclose_f(dset_id, ierr)
+if (check(ierr, 'ERROR:get_chunk: close dataset: ' // dname // ' ' // self%filename)) return
+
+end procedure hdf_get_chunk
+
+
+module procedure hdf_get_layout
+
+integer(HID_T) :: pid, dset_id
+integer :: ierr
+
+if(.not.self%is_open) error stop 'h5fortran:read: file handle is not open'
+
+layout = -1
+
+if (.not.self%exist(dname)) then
+  write(stderr, *) 'ERROR:get_layout: ' // dname // ' does not exist in ' // self%filename
+  return
+endif
+
+call h5dopen_f(self%file_id, dname, dset_id, ierr)
+if (check(ierr, 'ERROR:get_layout: open dataset ' // dname // ' ' // self%filename)) return
+call h5dget_create_plist_f(dset_id, pid, ierr)
+if (check(ierr, 'ERROR:get_layout: get property list ID ' // dname // ' ' // self%filename)) return
+call h5pget_layout_f(pid, layout, ierr)
+if (check(ierr, 'ERROR:get_layout read ' // dname //' ' // self%filename)) return
+call h5dclose_f(dset_id, ierr)
+if (check(ierr, 'ERROR:get_layout: close dataset: ' // dname //' ' // self%filename)) return
+
+end procedure hdf_get_layout
+
 end submodule hdf5_read

src/tests/unit/CMakeLists.txt

@@ -5,7 +5,7 @@ max_gcd(${MPI_MAX} ${MPIEXEC_MAX_NUMPROCS} Nmpi)
 
 message(STATUS "Unit tests using ${Nmpi} processes")
 
-set(test_names deflate_write deflate_props deflate_read scalar)
+set(test_names deflate_write deflate_props deflate_read scalar shape)
 
 foreach(t IN LISTS test_names)
 

src/tests/unit/test_deflate_read.f90

@@ -26,7 +26,6 @@ program test_deflate_read
 call test_read_deflate(fn1, N, mpi_id, Nmpi)
 if(mpi_id==0) print *,'OK: HDF5 read deflate'
 
-
 call mpi_finalize(ierr)
 if (ierr /= 0) error stop "mpi_finalize"
 

src/tests/unit/test_scalar.f90

@@ -43,8 +43,6 @@ subroutine test_scalar_collective(mpi_id)
 
 call h5%close()
 
-
-
 end subroutine test_scalar_collective