unify: add %create() and stride= indexing

Author: scivision

src/interface.f90

@@ -39,7 +39,7 @@ module h5mpi
 procedure, public :: open => h5open
 procedure, public :: close => h5close
 procedure, public :: write_group
-procedure, public :: create => hdf_create
+procedure, public :: create => hdf_create_user
 procedure, public :: flush => hdf_flush
 procedure, public :: filesize => hdf_filesize
 procedure, public :: ndim => hdf_get_ndim
@@ -102,6 +102,18 @@ module h5mpi
 public :: H5T_INTEGER_F, H5T_FLOAT_F, H5T_STRING_F
 
 interface !< write.f90
+
+module subroutine hdf_create_user(self, dname, dtype, dset_dims, mem_dims, chunk_size, compact, charlen)
+class(hdf5_file), intent(in) :: self
+character(*), intent(in) :: dname
+integer(HID_T), intent(in) :: dtype
+integer, dimension(:), intent(in) :: dset_dims
+integer, dimension(:), intent(in), optional :: mem_dims
+integer, intent(in), dimension(:), optional :: chunk_size  !< (:) instead of size(dims) due to intel fortran quirk
+logical, intent(in), optional :: compact
+integer, intent(in), optional :: charlen
+end subroutine
+
 module subroutine hdf_create(self, dname, dtype, mem_dims, dset_dims, &
   filespace_id, memspace, dset_id, dtype_id, &
   istart, iend, stride, chunk_size, compact, charlen)

src/utils.f90

@@ -39,16 +39,17 @@
 
 module procedure h5open
 
-character(len=2) :: laction
+character(:), allocatable :: laction
 integer :: ier
 integer(HID_T) :: fapl !< file access property list
+integer :: file_mode
 
 if(self%is_open()) then
   write(stderr,*) 'h5fortran:open: file handle already open: '//self%filename
   return
 endif
 
-laction = 'rw'
+laction = 'r'
 if (present(action)) laction = action
 
 self%filename = filename
@@ -103,34 +104,41 @@
 
 if(self%use_mpi) then
   !! collective: setup for MPI access
-  call h5pcreate_f(H5P_FILE_ACCESS_F, fapl, ier)
+  call H5Pcreate_f(H5P_FILE_ACCESS_F, fapl, ier)
   if(ier /= 0) error stop "ERROR:h5fortran:open:h5pcreate could not collective open property for " // filename
-  call h5pset_fapl_mpio_f(fapl, mpi_h5comm, mpi_h5info, ier)
+  call H5Pset_fapl_mpio_f(fapl, mpi_h5comm, mpi_h5info, ier)
   if(ier /= 0) error stop "ERROR:h5fortran:open:h5pset_fapl_mpio could not collective open file for " // filename
 else
   fapl = H5P_DEFAULT_F
 endif
 
 select case(laction)
 case('r')
-  if(.not. is_hdf5(filename)) error stop "ERROR:h5fortran:open: file does not exist: "//filename
-  call h5fopen_f(filename, H5F_ACC_RDONLY_F, self%file_id, ier, access_prp=fapl)
+  file_mode = H5F_ACC_RDONLY_F
 case('r+')
-  if(.not. is_hdf5(filename)) error stop "ERROR:h5fortran:open: file does not exist: "//filename
-  call h5fopen_f(filename, H5F_ACC_RDWR_F, self%file_id, ier, access_prp=fapl)
+  file_mode = H5F_ACC_RDWR_F
 case('rw', 'a')
   if(is_hdf5(filename)) then
-    call h5fopen_f(filename, H5F_ACC_RDWR_F, self%file_id, ier, access_prp=fapl)
+    file_mode = H5F_ACC_RDWR_F
   else
-    call h5fcreate_f(filename, H5F_ACC_TRUNC_F, self%file_id, ier, access_prp=fapl)
+    file_mode = H5F_ACC_TRUNC_F
   endif
 case ('w')
-  call h5fcreate_f(filename, H5F_ACC_TRUNC_F, self%file_id, ier, access_prp=fapl)
+  file_mode = H5F_ACC_TRUNC_F
 case default
   error stop 'ERROR:h5fortran:open Unsupported action ' // laction // ' for ' // filename
 end select
 
-if (ier /= 0) error stop "ERROR:h5fortran:open: HDF5 file open failed: "//filename
+if (file_mode == H5F_ACC_RDONLY_F .or. file_mode == H5F_ACC_RDWR_F) then
+  if(.not. is_hdf5(filename)) error stop "ERROR:h5fortran:open: not an HDF5 file: "//filename
+  call H5Fopen_f(filename, file_mode, self%file_id, ier, access_prp=fapl)
+  if (ier /= 0) error stop "ERROR:h5fortran:open:H5Fopen: " // filename
+elseif(file_mode == H5F_ACC_TRUNC_F) then
+  call H5Fcreate_f(filename, file_mode, self%file_id, ier, access_prp=fapl)
+  if (ier /= 0) error stop "ERROR:h5fortran:open:H5Fcreate: " // filename
+else
+  error stop "ERROR:h5fortran:open: Unsupported file mode: " // filename
+endif
 
 if(fapl /= H5P_DEFAULT_F) then
   call h5pclose_f(fapl, ier)
@@ -302,27 +310,30 @@
 
 !> check that all necessary filters to access dataset are available on the system.
 call h5dget_create_plist_f(dset_id, dcpl, ierr)
-if (ierr/=0) error stop "h5fortran:mpi_hyperslab:h5dget_create_plist: " // dset_name
+if (ierr/=0) error stop "ERROR:h5fortran:mpi_hyperslab:h5dget_create_plist: " // dset_name
 
 call h5pall_filters_avail_f(dcpl, filters_OK, ierr)
-if (ierr/=0) error stop "h5fortran:mpi_hyperslab:h5pall_filters_avail: " // dset_name
+if (ierr/=0) error stop "ERROR:h5fortran:mpi_hyperslab:h5pall_filters_avail: " // dset_name
 if (.not. filters_OK) then
   error stop "h5fortran: filter(s) missing necessary for dataset " // dset_name // " in parallel with MPI. This is " // &
     "typically caused by missing DEFLATE compression with HDF5-MPI."
 endif
 
 call h5pclose_f(dcpl, ierr)
-if(ierr/=0) error stop "h5fortran:mpi_hyperslab:h5pclose: " // dset_name
+if(ierr/=0) error stop "ERROR:h5fortran:mpi_hyperslab:h5pclose: " // dset_name
+
+istride = 1
+if(present(stride)) istride = int(stride, HSIZE_T)
 
 if(filespace == H5S_ALL_F) then
   !> create dataspace
   call h5screate_simple_f(rank=size(dset_dims), dims=dset_dims, space_id=filespace, hdferr=ierr)
-  if (ierr/=0) error stop "h5fortran:mpi_hyperslab:h5screate_simple:filespace " // dset_name
+  if (ierr/=0) error stop "ERROR:h5fortran:mpi_hyperslab:h5screate_simple:filespace " // dset_name
 endif
 
 !> Select hyperslab in the file.
 call h5dget_space_f(dset_id, filespace, ierr)
-if (ierr/=0) error stop "h5fortran:mpi_hyperslab:h5dget_space: " // dset_name
+if (ierr/=0) error stop "ERROR:h5fortran:mpi_hyperslab:h5dget_space: " // dset_name
 
 
 ! blk(1) = 1
@@ -332,9 +343,6 @@
 i0 = istart - 1
 c_mem_dims = iend - i0
 
-istride = 1
-if(present(stride)) istride = int(stride, HSIZE_T)
-
 if(any(c_mem_dims /= mem_dims)) then
   write(stderr,*) "ERROR:h5fortran:mpi_hyperslab: memory size /= dataset size: check variable slice (index). " // &
     " Dset_dims:", dset_dims, "C Mem_dims", c_mem_dims
@@ -343,7 +351,7 @@
 
 ! print *, 'TRACE:mpi_hyperslab: ' // dset_name //': istart', i0, 'C mem_dims: ', c_mem_dims, 'mem_dims', mem_dims
 
-if(any(c_mem_dims < 1)) error stop "h5mpi:hyperslab:non-positive hyperslab: " // dset_name
+if(any(c_mem_dims < 1)) error stop "ERROR:h5mpi:hyperslab:non-positive hyperslab: " // dset_name
 
 call h5sselect_hyperslab_f(filespace, H5S_SELECT_SET_F, &
 start=i0, &
@@ -352,11 +360,11 @@
 hdferr=ierr)
 ! block=blk  !< would this help performance?
 
-if (ierr/=0) error stop "g5fortran:mpi_hyperslab:h5sselect_hyperslab: " // dset_name
+if (ierr/=0) error stop "ERROR:h5fortran:mpi_hyperslab:h5sselect_hyperslab: " // dset_name
 
 !> create memory dataspace
 call h5screate_simple_f(rank=size(c_mem_dims), dims=c_mem_dims, space_id=memspace, hdferr=ierr)
-if (ierr/=0) error stop "h5fortran:mpi_hyperslab:h5screate_simple:memspace " // dset_name
+if (ierr/=0) error stop "ERROR:h5fortran:mpi_hyperslab:h5screate_simple:memspace " // dset_name
 
 end procedure mpi_hyperslab
 
@@ -367,10 +375,10 @@
 
 !! Create property list for collective dataset operations
 call h5pcreate_f(H5P_DATASET_XFER_F, xfer_id, ierr)
-if (ierr/=0) error stop "h5pcreate dataset xfer: " // dname
+if (ierr/=0) error stop "ERROR:h5fortran:h5pcreate dataset xfer: " // dname
 
 call h5pset_dxpl_mpio_f(xfer_id, H5FD_MPIO_COLLECTIVE_F, ierr)
-if (ierr/=0) error stop "h5pset_dxpl_mpio collective: " // dname
+if (ierr/=0) error stop "ERROR:h5fortran:h5pset_dxpl_mpio collective: " // dname
 
 ! For independent dataset operations
 ! call h5pset_dxpl_mpio_f(xfer_id, H5FD_MPIO_INDEPENDENT_F, ierr)

src/write.f90

@@ -21,6 +21,40 @@
 contains
 
 
+module procedure hdf_create_user
+!! for user %create() method
+
+integer(HID_T) :: file_space_id, mem_space_id, dset_id, dtype_id
+integer(HSIZE_T), dimension(size(dset_dims)) :: mdims, ddims
+integer :: ierr
+
+ddims = int(dset_dims, HSIZE_T)
+
+if(present(mem_dims)) then
+  mdims = int(mem_dims, HSIZE_T)
+else
+  mdims = ddims
+endif
+
+call hdf_create(self, dname, dtype, mem_dims=mdims, dset_dims=ddims, &
+  filespace_id=file_space_id, memspace=mem_space_id, dset_id=dset_id, dtype_id=dtype_id, compact=compact, &
+  charlen=charlen)
+
+call h5dclose_f(dset_id, ierr)
+if(ierr /= 0) error stop "ERROR:h5fortran:write:create_user: closing dataset: " // dname // " in " // self%filename
+
+if(file_space_id /= H5S_ALL_F) call h5sclose_f(file_space_id, ierr)
+if(ierr /= 0) error stop "ERROR:h5fortran:write:create_user: closing file dataspace: " // dname // " in " // self%filename
+
+if(mem_space_id /= H5S_ALL_F) call h5sclose_f(mem_space_id, ierr)
+if(ierr /= 0) error stop "ERROR:h5fortran:write:create_user: closing memory dataspace: " // dname // " in " // self%filename
+
+if(dtype == H5T_NATIVE_CHARACTER) call h5tclose_f(dtype_id, ierr)
+if(ierr /= 0) error stop "ERROR:h5fortran:write:create_user: closing datatype: " // dname // " in " // self%filename
+
+end procedure hdf_create_user
+
+
 module procedure hdf_create
 
 logical :: exists
@@ -241,15 +275,15 @@ subroutine set_deflate(self, dims, dcpl, chunk_size)
 if (self%fletcher32) then
   !! fletcher32 filter adds a checksum to the data
   if (self%use_mpi .and. .not. self%parallel_compression) then
-    write(stderr, '(a)') 'WARNING: h5fortran:set_deflate: fletcher32 parallel filter not supported ' // self%filename
+    if(self%mpi_id == 0) write(stderr, '(a)') 'WARNING: h5fortran:set_deflate: fletcher32 parallel not supported ' // self%filename
   else
     call h5pset_fletcher32_f(dcpl, ierr)
     if (ierr /= 0) error stop "ERROR:h5fortran:set_deflate:h5pset_fletcher32: " // self%filename
   endif
 endif
 
 if (self%use_mpi .and. .not. self%parallel_compression) then
-  write(stderr, '(a)') 'WARNING: h5fortran:set_deflate: deflate parallel filter not supported ' // self%filename
+  if(self%mpi_id == 0) write(stderr, '(a)') 'WARNING: h5fortran:set_deflate: deflate parallel not supported ' // self%filename
   return
 endif
 
@@ -258,7 +292,7 @@ subroutine set_deflate(self, dims, dcpl, chunk_size)
 if(self%shuffle) then
   !! shuffle filter improves compression
   if (self%use_mpi .and. .not. self%parallel_compression) then
-    write(stderr, '(a)') 'WARNING: h5fortran:set_deflate: shuffle parallel filter not supported ' // self%filename
+    if(self%mpi_id == 0) write(stderr, '(a)') 'WARNING: h5fortran:set_deflate: shuffle parallel not supported ' // self%filename
   else
     call h5pset_shuffle_f(dcpl, ierr)
     if (ierr /= 0) error stop "ERROR:h5fortran:set_deflate:h5pset_shuffle: " // self%filename

src/writer.inc

@@ -9,6 +9,9 @@ mem_dims = shape(A, HSIZE_T)
 if(present(dset_dims)) then
   dims_dset = dset_dims
 else
+  if(present(istart) .or. present(iend)) then
+    error stop "ERROR:h5fortran:write: dset_dims required if istart or iend are specified: " // dname // " in " // self%filename
+  endif
   dims_dset = mem_dims
 endif
 
@@ -36,10 +39,12 @@ filespace_id=file_space_id, memspace=mem_space_id, dset_id=dset_id, &
 istart=istart, iend=iend, stride=stride, chunk_size=chunk_size, compact=compact, &
 dtype_id=dtype_id, charlen=charlen)
 
+if((self%use_mpi .and. present(dset_dims)) .or. (present(istart) .and. present(iend))) then
+  call mpi_hyperslab(mem_dims, dims_dset, dset_id, file_space_id, mem_space_id, istart=istart, iend=iend, stride=stride)
+endif
+
 if(self%use_mpi) then
-  if(present(dset_dims)) then
-    call mpi_hyperslab(mem_dims, dims_dset, dset_id, file_space_id, mem_space_id, istart=istart, iend=iend, stride=stride)
-  elseif(self%mpi_id > 0) then
+  if(.not. present(dset_dims) .and. 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.

test/CMakeLists.txt

@@ -50,7 +50,7 @@ target_link_libraries(test_write PRIVATE h5mpi::h5mpi)
 
 add_test(NAME write COMMAND test_write)
 
-set(test_names attributes cast destructor exist groups layout shape
+set(test_names array attributes cast destructor exist groups layout shape
 string string_read
 )