add group write dataset

Author: scivision

src/interface.f90

@@ -57,7 +57,7 @@ module h5mpi
 softlink => create_softlink, &
 layout => hdf_get_layout, chunks => hdf_get_chunk, &
 is_contig => hdf_is_contig, is_chunked => hdf_is_chunked, is_compact => hdf_is_compact, &
-is_open
+is_open, write_group
 !! procedures without mapping
 
 generic, public :: write => h5write_scalar,ph5write_1d, ph5write_2d, ph5write_3d, ph5write_4d, ph5write_5d, ph5write_6d, ph5write_7d
@@ -104,6 +104,10 @@ module subroutine hdf_create(self, dname, dtype, mem_dims, dset_dims, filespace,
 logical, intent(in), optional :: compact
 end subroutine hdf_create
 
+module subroutine write_group(self, group_path)
+class(hdf5_file), intent(in) :: self
+character(*), intent(in) :: group_path   !< full path to group
+end subroutine write_group
 module subroutine create_softlink(self, tgt, link)
 class(hdf5_file), intent(inout) :: self
 character(*), intent(in) :: tgt, &  !< target path to link

src/tests/unit/CMakeLists.txt

@@ -20,7 +20,7 @@ add_library(test_utils OBJECT utils.f90)
 
 # --- unit tests
 
-set(test_names cast deflate_write deflate_props deflate_read destructor exist layout shape string)
+set(test_names cast deflate_write deflate_props deflate_read destructor exist groups layout shape string)
 
 foreach(t IN LISTS test_names)
 

src/tests/unit/test_cast.f90

@@ -29,6 +29,7 @@ program test_cast
 call test_cast_read(fn)
 if(mpi_id == 0) print "(A)", "OK: cast read"
 
+
 call mpi_finalize(ierr)
 if (ierr /= 0) error stop "mpi_finalize"
 

src/tests/unit/test_groups.f90

@@ -0,0 +1,69 @@
+program test_groups
+!! groups test
+use, intrinsic:: iso_fortran_env, only: int32, real32, real64, stderr=>error_unit
+
+use h5mpi, only: hdf5_file
+use mpi, only : mpi_init, MPI_COMM_WORLD, mpi_comm_rank
+
+implicit none (type, external)
+
+external :: mpi_finalize
+
+integer :: ierr, mpi_id
+
+call mpi_init(ierr)
+if (ierr /= 0) error stop "mpi_init"
+
+call mpi_comm_rank(MPI_COMM_WORLD, mpi_id, ierr)
+if (ierr /= 0) error stop "mpi_comm_rank"
+
+
+call test_group('test_groups.h5')
+if(mpi_id == 0) print *,'OK: group variable'
+
+call test_write_existing('overwrite.h5')
+if(mpi_id == 0) print *,'OK: write existing variable'
+
+
+call mpi_finalize(ierr)
+if (ierr /= 0) error stop "mpi_finalize"
+
+
+contains
+
+subroutine test_group(fn)
+
+character(*), intent(in) :: fn
+
+type(hdf5_file) :: h5f
+
+call h5f%open(fn, action='w', mpi=.true.)
+
+call h5f%write('/test/group3/scalar', 1_int32)
+
+call h5f%write('/test/group3/scalar_real', 1._real32)
+
+if(.not. h5f%exist('/test/group3/scalar')) error stop "/test/group3/scalar does not exist: create group failed"
+
+call h5f%close()
+
+end subroutine test_group
+
+
+subroutine test_write_existing(fn)
+type(hdf5_file) :: h5f
+character(*), intent(in) :: fn
+
+call h5f%open(fn, action='w', mpi=.true.)
+call h5f%write('/scalar_int', 42_int32)
+call h5f%write('/int1d', [42_int32, 1_int32])
+call h5f%close()
+
+call h5f%open(fn, action='r+', mpi=.true.)
+call h5f%write('/scalar_int', 100_int32)
+call h5f%write('/int1d', [100_int32, 10_int32])
+call h5f%close()
+
+end subroutine test_write_existing
+
+end program

src/write/write.f90

@@ -2,7 +2,8 @@
 
 use hdf5, only : h5pset_deflate_f, h5pset_fletcher32_f, h5pset_shuffle_f, h5pset_layout_f, &
 h5dwrite_f, &
-h5lcreate_soft_f, &
+h5gcreate_f, h5gclose_f, &
+h5lcreate_soft_f, h5lexists_f, &
 h5screate_f, &
 H5S_SCALAR_F
 
@@ -54,6 +55,9 @@
 
 !> Only new datasets go past this point
 
+call self%write_group(dname)
+!! write_group is needed for any dataset in a group e.g. /hi/there/var
+
 !> compression
 if(size(mem_dims) >= 2) then
   call set_deflate(self, mem_dims, dcpl, chunk_size)
@@ -103,6 +107,45 @@
 end procedure create_softlink
 
 
+module procedure write_group
+
+integer(HID_T)  :: gid
+integer :: ier
+
+integer :: sp, ep, L
+logical :: gexist
+
+if(.not.self%is_open()) error stop 'h5fortran:write_group: file handle is not open'
+
+L = len_trim(group_path)
+if(L < 2) return  !< not a new group
+
+sp = 1
+ep = 0
+
+do
+  ep = index(group_path(sp+1:L), "/")
+
+  ! no subgroup found
+  if (ep == 0) return
+
+  ! check subgroup exists
+  sp = sp + ep
+  call h5lexists_f(self%file_id, group_path(:sp-1), gexist, ier)
+  if (ier /= 0) error stop "ERROR:h5fortran:write_group: check exists group " // group_path // " in " // self%filename
+
+  if(.not.gexist) then
+    call h5gcreate_f(self%file_id, group_path(:sp-1), gid, ier)
+    if (ier /= 0) error stop "ERROR:h5fortran:write_group: create group " // group_path // " in " // self%filename
+
+    call h5gclose_f(gid, ier)
+    if (ier /= 0) error stop "ERROR:h5fortran:write_group: close new group " // group_path // " in " // self%filename
+  endif
+end do
+
+end procedure write_group
+
+
 subroutine set_deflate(self, dims, dcpl, chunk_size)
 class(hdf5_file), intent(in) :: self
 integer(HSIZE_T), intent(in) :: dims(:)