read: correct for non-mpi reads, add non-mpi test

Author: scivision

src/interface.f90

@@ -249,14 +249,6 @@ module subroutine hdf_get_shape(self, dname, dims)
 integer(HSIZE_T), intent(out), allocatable :: dims(:)
 end subroutine
 
-module subroutine h5open_read(self, dname, dims, dset_dims, filespace, memspace, dset_id)
-class(hdf5_file), intent(in) :: self
-character(*), intent(in) :: dname
-integer(HSIZE_T), intent(in) :: dims(:)
-integer(HSIZE_T), intent(out) :: dset_dims(:)
-integer(HID_T), intent(out) :: filespace, memspace, dset_id
-end subroutine
-
 module integer function get_strpad(self, dset_name)
 class(hdf5_file), intent(in) :: self
 character(*), intent(in) :: dset_name

src/read.f90

@@ -17,23 +17,6 @@
 contains
 
 
-module procedure h5open_read
-
-integer :: ierr
-integer(HID_T) :: plist_id
-
-filespace = H5S_ALL_F
-memspace = H5S_ALL_F
-plist_id = H5P_DEFAULT_F
-
-call hdf_shape_check(self, dname, dims, dset_dims)
-
-call h5dopen_f(self%file_id, dname, dset_id, ierr)
-if(ierr /= 0) error stop 'ERROR:h5open_read: open ' // dname // ' from ' // self%filename
-
-end procedure h5open_read
-
-
 module procedure get_class
 call get_dset_class(self, dname, get_class)
 end procedure get_class

src/reader.inc

@@ -2,16 +2,24 @@ integer(HSIZE_T), dimension(rank(A)) :: dims, dset_dims
 integer(HID_T) :: dset_id, file_space_id, mem_space_id, xfer_id
 integer :: dclass, ier
 
-xfer_id = H5P_DEFAULT_F
+file_space_id = H5S_ALL_F
+mem_space_id = H5S_ALL_F
+
 dims = shape(A, HSIZE_T)
 
-call h5open_read(self, dname, dims, dset_dims, file_space_id, mem_space_id, dset_id)
+call H5Dopen_f(self%file_id, dname, dset_id, ier)
+if(ier /= 0) error stop 'ERROR:h5open_read: open ' // dname // ' from ' // self%filename
+
+if(present(istart) .and. present(iend)) then
+  call mpi_hyperslab(dims, dset_dims, dset_id, file_space_id, mem_space_id, istart=istart, iend=iend, stride=stride)
+else
+  call hdf_shape_check(self, dname, dims, dset_dims)
+endif
 
 if(self%use_mpi) then
-  if(present(istart) .and. present(iend)) then
-    call mpi_hyperslab(dims, dset_dims, dset_id, file_space_id, mem_space_id, istart=istart, iend=iend, stride=stride)
-  endif
   xfer_id = mpi_collective(dname)
+else
+  xfer_id = H5P_DEFAULT_F
 endif
 
 call get_dset_class(self, dname, dclass, dset_id)

src/utils.f90

@@ -181,6 +181,7 @@
     if(ierr /= 0) error stop "ERROR:h5fortran:close:h5fget_name: could not get filename of open dataset: " // self%filename
 
     call h5iget_name_f(obj_ids(i), dset_name, L, Lds_name, ierr)
+    if(ierr /= 0) error stop "ERROR:h5fortran:close:h5iget_name could not get dataset name: " // self%filename
 
     write(stderr,*) "h5fortran:close: open dataset: " // dset_name(:Lds_name) // " in file: " // file_name(:Lf_name)
   end do

test/CMakeLists.txt

@@ -27,6 +27,10 @@ add_test(NAME ${name} COMMAND test_${name})
 
 endforeach()
 
+set_tests_properties(${names} PROPERTIES
+LABELS nompi
+)
+
 endfunction(nompi_test)
 
 
@@ -51,18 +55,23 @@ endif()
 
 add_test(NAME ${name} COMMAND ${cmd})
 
-set_tests_properties(${name} PROPERTIES
+endforeach()
+
+set_tests_properties(${names} PROPERTIES
 RESOUCE_LOCK cpu_mpi
+LABELS mpi
 )
 
-endforeach()
-
 endfunction(mpi_test)
 
 cmake_path(SET string_file ${CMAKE_CURRENT_BINARY_DIR}/test_string_py.h5)
 
 # --- write test data
 
+set(nompi_tests array)
+
+nompi_test(${nompi_tests})
+
 set(mpi_tests array_mpi attributes cast destructor exist fill groups layout shape
 string string_read write
 )

test/test_array.f90

@@ -0,0 +1,220 @@
+program array_test
+
+use, intrinsic:: ieee_arithmetic, only: ieee_value, ieee_quiet_nan, ieee_is_nan
+use, intrinsic :: iso_fortran_env, only: real32, real64, int32, stderr=>error_unit
+
+use h5mpi, only : hdf5_file, HSIZE_T, H5T_NATIVE_INTEGER
+
+implicit none (type, external)
+
+real(real32) :: nan
+
+call test_basic_array('test_array.h5')
+print *, 'PASSED: array write'
+
+call test_read_slice('test_array.h5')
+print *, 'PASSED: slice read'
+
+call test_write_slice('test_array.h5')
+print *, 'PASSED: slice write'
+
+call test_readwrite_array('test_group_array.h5', ng=69, nn=100, pn=5)
+print *,'PASSED: array write / read'
+
+
+contains
+
+subroutine test_basic_array(filename)
+
+character(*), intent(in) :: filename
+!! tests that compression doesn't fail for very small datasets, where it really shouldn't be used (makes file bigger)
+type(hdf5_file) :: h
+integer(HSIZE_T), allocatable :: dims(:)
+
+integer(int32), dimension(4) :: i1, i1t
+integer(int32), dimension(4,4) :: i2, i2t
+real(real32), allocatable :: rr2(:,:)
+real(real32)  ::  nant, r1(4), r2(4,4), B(6,6)
+integer :: i
+integer(int32) :: i2_8(8,8)
+
+nan = ieee_value(1.0, ieee_quiet_nan)
+
+do i = 1,size(i1)
+  i1(i) = i
+enddo
+
+i2(1,:) = i1
+do i = 1,size(i2,2)
+  i2(i,:) = i2(1,:) * i
+enddo
+
+r1 = i1
+r2 = i2
+
+call h%open(filename, action='w', comp_lvl=1, mpi=.false.)
+
+call h%write('/int32-1d', i1)
+call h%write('/test/group2/int32-2d', i2)
+call h%write('/real32-2d', r2)
+call h%write('/nan', nan)
+
+call h%close()
+
+!! read
+call h%open(filename, action='r', mpi=.false.)
+
+!> int32
+call h%read('/int32-1d', i1t)
+if (.not.all(i1==i1t)) error stop 'read 1-d int32: does not match write'
+
+call h%read('/test/group2/int32-2d',i2t)
+if (.not.all(i2==i2t)) error stop 'read 2-D: int32 does not match write'
+
+!> verify reading into larger array
+i2_8 = 0
+call h%read('/test/group2/int32-2d', i2_8(2:5,3:6))
+if (.not.all(i2_8(2:5,3:6) == i2)) error stop 'read into larger array fail'
+
+!> real
+call h%shape('/real32-2d',dims)
+allocate(rr2(dims(1), dims(2)))
+call h%read('real32-2d',rr2)
+if (.not.all(r2 == rr2)) error stop 'real 2-D: read does not match write'
+
+! check read into a variable slice
+call h%read('real32-2d', B(2:5,3:6))
+if(.not.all(B(2:5,3:6) == r2)) error stop 'real 2D: reading into variable slice'
+
+call h%read('/nan',nant)
+if (.not.ieee_is_nan(nant)) error stop 'failed storing or reading NaN'
+
+call h%close()
+
+end subroutine test_basic_array
+
+
+subroutine test_read_slice(filename)
+
+character(*), intent(in) :: filename
+
+type(hdf5_file) :: h
+integer :: i
+integer(int32), dimension(4) :: i1, i1t
+integer(int32), dimension(4,4) :: i2, i2t
+
+do i = 1,size(i1)
+  i1(i) = i
+enddo
+
+i2(1,:) = i1
+do i = 1,size(i2,2)
+  i2(i,:) = i2(1,:) * i
+enddo
+
+call h%open(filename, action='r', mpi=.false.)
+
+i1t = 0
+call h%read('/int32-1d', i1t(:2), istart=[2], iend=[3], stride=[1])
+if (any(i1t(:2) /= [2,3])) then
+  write(stderr, *) 'read 1D slice does not match. expected [2,3] but got ',i1t(:2)
+  error stop
+endif
+
+i1t = 0
+call h%read('/int32-1d', i1t(:2), istart=[2], iend=[3])
+if (any(i1t(:2) /= [2,3])) then
+  write(stderr, *) 'read 1D slice does not match. expected [2,3] but got ',i1t(:2)
+  error stop
+endif
+
+i2t = 0
+call h%read('/test/group2/int32-2d', i2t(:2,:3), istart=[2,1], iend=[3,3], stride=[1,1])
+if (any(i2t(:2,:3) /= i2(2:3,1:3))) then
+  write(stderr, *) 'read 2D slice does not match. expected:',i2(2:3,1:3),' but got ',i2t(:2,:3)
+  error stop
+endif
+
+call h%close()
+
+end subroutine test_read_slice
+
+
+subroutine test_write_slice(filename)
+
+character(*), intent(in) :: filename
+
+type(hdf5_file) :: h
+integer(int32), dimension(4) :: i1t
+integer(int32), dimension(4,4) :: i2t
+integer :: dims(1), dims2(2)
+
+dims = [3]
+
+call h%open(filename, action='r+', debug=.true., mpi=.false.)
+
+call h%create('/int32a-1d', dtype=H5T_NATIVE_INTEGER, dset_dims=dims)
+call h%write('/int32a-1d', [1,3], dset_dims=dims, istart=[1], iend=[2])
+print *, 'PASSED: create dataset and write slice 1D'
+
+call h%write('/int32-1d', [35, 70], dset_dims=dims, istart=[2], iend=[3], stride=[1])
+
+call h%read('/int32-1d', i1t)
+if (.not.all(i1t==[1,35,70,4])) then
+  write(stderr, *) 'write 1D slice does not match. Got ',i1t, ' in ', filename
+  error stop
+endif
+print *, 'PASSED: overwrite slice 1d, stride=1'
+
+call h%write('/int32-1d', [23,34,45], dset_dims=dims, istart=[2], iend=[4])
+
+call h%read('/int32-1d', i1t)
+if (.not.all(i1t==[1,23,34,45])) then
+  write(stderr, *) 'read 1D slice does not match. Got ',i1t
+  error stop
+endif
+print *, 'PASSED: overwrite slice 1d, no stride'
+
+dims2 = [4,4]
+
+call h%create('/int32a-2d', dtype=H5T_NATIVE_INTEGER, dset_dims=dims2)
+print *, 'create and write slice 2d, stride=1'
+call h%write('/int32a-2d', reshape([76,65,54,43], [2,2]), dset_dims=dims2, istart=[2,1], iend=[3,2])
+
+call h%read('/int32a-2d', i2t)
+
+call h%close()
+
+
+end subroutine test_write_slice
+
+
+subroutine test_readwrite_array(filename, ng, nn, pn)
+!! more group
+type(hdf5_file) :: h
+character(*), intent(in) :: filename
+integer, intent(in) :: ng, nn, pn
+
+real(real32), allocatable :: flux(:,:),fo(:)
+character(2) :: pnc,ic
+integer :: i
+
+allocate(flux(nn,ng),fo(nn))
+flux = 1.0
+write(pnc,'(I2)') pn
+
+call h%open(filename, action='rw', mpi=.false.)
+
+do i = 1,ng
+  write(ic,'(I2)') i
+  call h%write('/group'//trim(adjustl(ic))//'/flux_node',flux(:,i))
+enddo
+
+call h%read('/group1/flux_node',fo)
+if (.not.all(fo == flux(:,1))) error stop 'test_read_write: read does not match write'
+
+call h%close()
+
+end subroutine test_readwrite_array
+
+end program