allow whole array write from root

Author: scivision

src/tests/unit/CMakeLists.txt

@@ -5,19 +5,27 @@ max_gcd(${MPI_MAX} ${MPIEXEC_MAX_NUMPROCS} Nmpi)
 
 message(STATUS "Unit tests using ${Nmpi} processes")
 
+# --- coverage
+
 if(ENABLE_COVERAGE)
 setup_target_for_coverage_gcovr_html(
 NAME coverage
 EXECUTABLE ${CMAKE_CTEST_COMMAND}
 )
 endif()
 
+# --- test utils
+
+add_library(test_utils OBJECT utils.f90)
+
+# --- unit tests
+
 set(test_names cast deflate_write deflate_props deflate_read destructor exist layout shape string)
 
 foreach(t IN LISTS test_names)
 
   add_executable(test_${t} test_${t}.f90)
-  target_link_libraries(test_${t} PRIVATE h5mpi HDF5::HDF5 MPI::MPI_Fortran)
+  target_link_libraries(test_${t} PRIVATE h5mpi test_utils HDF5::HDF5 MPI::MPI_Fortran)
 
   add_test(NAME ${t}
   COMMAND ${MPIEXEC_EXECUTABLE} ${MPIEXEC_NUMPROC_FLAG} ${Nmpi} $<TARGET_FILE:test_${t}>

src/tests/unit/test_cast.f90

@@ -22,10 +22,9 @@ program test_cast
 call mpi_comm_rank(MPI_COMM_WORLD, mpi_id, ierr)
 if (ierr /= 0) error stop "mpi_comm_rank"
 
-if(mpi_id == 0) then
-  call test_cast_write(fn)
-  print "(A)", "OK: cast write"
-endif
+
+call test_cast_write(fn)
+if(mpi_id == 0) print "(A)", "OK: cast write"
 
 call test_cast_read(fn)
 if(mpi_id == 0) print "(A)", "OK: cast read"
@@ -43,7 +42,7 @@ subroutine test_cast_write(fn)
 
 type(hdf5_file) :: h
 
-call h%open(fn, action='w', mpi=.false.)
+call h%open(fn, action='w', mpi=.true.)
 
 !> test values
 call h%write('/scalar_int32', 42_int32)

src/tests/unit/test_exist.f90

@@ -13,7 +13,6 @@ program exist_tests
 external :: mpi_finalize
 
 integer :: ierr, mpi_id
-character(*), parameter :: fn = "test_destruct.h5"
 
 
 call mpi_init(ierr)

src/tests/unit/utils.f90

@@ -0,0 +1,19 @@
+module test_utils
+
+implicit none (type, external)
+
+contains
+
+subroutine unlink(filename)
+
+character(*), intent(in) :: filename
+integer :: u
+
+open(newunit=u, file=filename, status='unknown')
+close(u, status='delete')
+
+
+end subroutine unlink
+
+
+end module test_utils

src/write/write.f90

@@ -34,7 +34,6 @@
 if(exists) then
   if (.not.present(istart)) then
     if (is_scalar) then
-      !! scalar
       call hdf_rank_check(self, dname, size(mem_dims))
     else
       call hdf_shape_check(self, dname, mem_dims)
@@ -50,10 +49,6 @@
   call h5dget_space_f(dset_id, filespace, ierr)
   if(ierr /= 0) error stop 'ERROR:h5fortran:create could not get dataset ' // dname // ' in ' // self%filename
 
-  if(self%use_mpi .and. is_scalar .and. self%mpi_id > 0) call h5sselect_none_f(filespace, ierr)
-  !! for MPI collective scalar writes, only root worker can write.
-  !! otherwise race condition would result
-
   return
 endif
 
@@ -70,10 +65,10 @@
 if(compact .and. dcpl == H5P_DEFAULT_F .and. product(dset_dims) * 8 < 60000)  then
 !! 64000 byte limit, here we assumed 8 bytes / element
   call h5pcreate_f(H5P_DATASET_CREATE_F, dcpl, ierr)
-  if (check(ierr, self%filename)) error stop "ERROR:h5fortran:hdf_create:h5pcreate: " // dname
+  if (ierr /= 0) error stop "ERROR:h5fortran:hdf_create:h5pcreate: " // dname
 
   call h5pset_layout_f(dcpl, H5D_COMPACT_F, ierr)
-  if (check(ierr, self%filename)) error stop "ERROR:h5fortran:hdf_create:h5pset_layout: " // dname
+  if (ierr /= 0) error stop "ERROR:h5fortran:hdf_create:h5pset_layout: " // dname
 endif
 endif
 
@@ -85,10 +80,6 @@
 endif
 if (ierr/=0) error stop "ERROR:h5fortran:hdf_create:h5screate:filespace " // dname // " " // self%filename
 
-if(self%use_mpi .and. is_scalar .and. self%mpi_id > 0) call h5sselect_none_f(filespace, ierr)
-!! for MPI collective scalar writes, only root worker can write.
-!! otherwise race condition would result
-
 !> create dataset
 call h5dcreate_f(self%file_id, dname, dtype, space_id=filespace, dset_id=dset_id, hdferr=ierr, dcpl_id=dcpl)
 if (ierr/=0) error stop "ERROR:h5fortran:hdf_create:h5dcreate: " // dname // " " // self%filename

src/write/writer.in.f90

@@ -41,6 +41,13 @@
     filespace=file_space_id, memspace=mem_space_id, dset_id=dset_id, compact=compact)
 
 if(self%use_mpi) then
+  if(self%mpi_id > 0) then
+    call h5sselect_none_f(file_space_id, ier)
+    if(ier /= 0) error stop "ERROR:h5fortran:write:h5sselect_none: selecting no write failed for worker. " // dname
+    !! for MPI collective scalar writes, only root worker can write.
+    !! otherwise race condition would result
+  endif
+
   xfer_id = mpi_collective(dname)
 endif
 

src/write/writer_template.f90

@@ -5,6 +5,7 @@
 xfer_id = H5P_DEFAULT_F
 
 mem_dims = shape(value, HSIZE_T)
+
 if(present(dset_dims)) then
   select type (dset_dims)
   type is (integer(HSIZE_T))
@@ -14,9 +15,6 @@
   class default
     error stop "write: expecting dset_dims to be integer"
   end select
-elseif(self%use_mpi) then
-  error stop "h5mpi:write: must specify dset_dims if using MPI"
-  !! FIXME: there may be a way to do indepedent write rather than simply fail
 else
   dims_dset = mem_dims
 endif
@@ -41,7 +39,15 @@
 compact=compact)
 
 if(self%use_mpi) then
-  call mpi_hyperslab(mem_dims, dims_dset, dset_id, file_space_id, mem_space_id, istart=istart, iend=iend)
+  if(present(dset_dims)) then
+    call mpi_hyperslab(mem_dims, dims_dset, dset_id, file_space_id, mem_space_id, istart=istart, iend=iend)
+  elseif(self%mpi_id > 0) then
+    call h5sselect_none_f(file_space_id, ier)
+    if(ier /= 0) error stop "ERROR:h5fortran:writer:h5sselect_none: selecting no write failed for worker. " // dname
+    !! for MPI collective scalar or whole array writes, only root worker can write.
+    !! otherwise race condition would result
+  endif
+
   xfer_id = mpi_collective(dname)
 endif