add %exist method

Author: scivision

src/interface.f90

@@ -49,15 +49,25 @@ module h5mpi
 
 contains
 
-procedure, public :: open => ph5open, close => ph5close, &
-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, &
-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, write_group
+procedure, public :: open => ph5open
+procedure, public :: close => ph5close
+procedure, public :: write_group
+procedure, public :: create => hdf_create
+procedure, public :: flush => hdf_flush
+procedure, public :: filesize => hdf_filesize
+procedure, public :: ndim => hdf_get_ndim
+procedure, public :: shape => hdf_get_shape
+procedure, public :: layout => hdf_get_layout
+procedure, public :: chunks => hdf_get_chunk
+procedure, public :: exist => hdf_check_exist
+procedure, public :: class => get_class
+procedure, public :: dtype => get_native_dtype
+procedure, public :: deflate => get_deflate
+procedure, public :: is_contig => hdf_is_contig
+procedure, public :: is_chunked => hdf_is_chunked
+procedure, public :: is_compact => hdf_is_compact
+procedure, public :: softlink => create_softlink
+procedure, public :: is_open
 !! procedures without mapping
 
 generic, public :: write => h5write_scalar,ph5write_1d, ph5write_2d, ph5write_3d, ph5write_4d, ph5write_5d, ph5write_6d, ph5write_7d
@@ -269,9 +279,14 @@ end function hdf_get_layout
 module subroutine hdf_get_chunk(self, dname, chunk_size)
 class(hdf5_file), intent(in) :: self
 character(*), intent(in) :: dname
-integer(hsize_t), intent(out) :: chunk_size(:)
+class(*), intent(out) :: chunk_size(:)
 end subroutine hdf_get_chunk
 
+module logical function hdf_check_exist(self, dname)
+class(hdf5_file), intent(in) :: self
+character(*), intent(in) :: dname
+end function hdf_check_exist
+
 end interface
 
 
@@ -610,21 +625,6 @@ function hdf5version() result(v)
 end function hdf5version
 
 
-logical function hdf_exist(self, dname) result(exists)
-class(hdf5_file), intent(in) :: self
-character(*), intent(in) :: dname
-
-integer :: ierr
-
-if(.not. self%is_open()) error stop 'h5fortran:exist: file handle is not open: ' // self%filename
-
-call h5ltpath_valid_f(self%file_id, dname, .true., exists, ierr)
-!! h5lexists_f can false error with groups--just use h5ltpath_valid
-if (ierr/=0) error stop 'h5fortran:check_exist: could not determine status of ' // dname // ' in ' // self%filename
-
-end function hdf_exist
-
-
 subroutine hdf5_close()
 !! this subroutine will close ALL existing file handles
 !! only call it at end of your program

src/read.f90

@@ -224,36 +224,42 @@ end subroutine get_dset_class
 
 integer :: ierr, drank
 integer(HID_T) :: dapl, dset_id
+integer(HSIZE_T) :: cs(size(chunk_size))
 
-if(.not. self%is_open()) error stop 'ERROR:h5fortran:read: file handle is not open'
+cs = -1
 
-chunk_size = -1
-if (.not.self%exist(dname)) then
-  write(stderr, *) 'ERROR:h5fortran:get_chunk: ' // dname // ' does not exist in ' // self%filename
-  ierr = -1
-  return
-endif
+if (.not.self%is_open()) error stop 'ERROR:h5fortran:read: file handle is not open'
+if (.not.self%exist(dname)) error stop 'ERROR:h5fortran:get_chunk: ' // dname // ' does not exist in ' // self%filename
 
-if(.not. self%is_chunked(dname)) return
+if(self%is_chunked(dname)) then
+  call h5ltget_dataset_ndims_f(self%file_id, dname, drank, ierr)
+  if (ierr /= 0) error stop 'ERROR:h5fortran:get_chunk: get rank ' // dname // ' ' // self%filename
 
-call h5ltget_dataset_ndims_f(self%file_id, dname, drank, ierr)
-if (ierr /= 0) error stop 'ERROR:h5fortran:get_chunk: get rank ' // dname // ' ' // self%filename
+  call h5dopen_f(self%file_id, dname, dset_id, ierr)
+  if (ierr /= 0) error stop 'ERROR:h5fortran:get_chunk: open dataset ' // dname // ' ' // self%filename
 
-call h5dopen_f(self%file_id, dname, dset_id, ierr)
-if (ierr /= 0) error stop 'ERROR:h5fortran:get_chunk: open dataset ' // dname // ' ' // self%filename
+  call h5dget_create_plist_f(dset_id, dapl, ierr)
+  if (ierr /= 0) error stop 'ERROR:h5fortran:get_chunk: get property list ID ' // dname // ' ' // self%filename
 
-call h5dget_create_plist_f(dset_id, dapl, ierr)
-if (ierr /= 0) error stop 'ERROR:h5fortran:get_chunk: get property list ID ' // dname // ' ' // self%filename
+  call h5dclose_f(dset_id, ierr)
+  if (ierr /= 0) error stop 'ERROR:h5fortran:get_chunk: close dataset: ' // dname // ' ' // self%filename
 
-call h5dclose_f(dset_id, ierr)
-if (ierr /= 0) error stop 'ERROR:h5fortran:get_chunk: close dataset: ' // dname // ' ' // self%filename
+  call h5pget_chunk_f(dapl, drank, cs, ierr)
+  if (ierr /= drank) error stop 'ERROR:h5fortran:get_chunk:h5pget_chunk ' // dname // ' ' // self%filename
+  !! yes ierr == drank is success for this call
 
-call h5pget_chunk_f(dapl, drank, chunk_size, ierr)
-if (ierr /= drank) error stop 'ERROR:h5fortran:get_chunk:h5pget_chunk ' // dname // ' ' // self%filename
-!! yes ierr == drank is success for this call
+  call h5pclose_f(dapl, ierr)
+  if (ierr /= 0) error stop 'ERROR:h5fortran:get_chunk: close property list ' // dname // ' ' // self%filename
+endif
 
-call h5pclose_f(dapl, ierr)
-if (ierr /= 0) error stop 'ERROR:h5fortran:get_chunk: close property list ' // dname // ' ' // self%filename
+select type (chunk_size)
+type is (integer(HSIZE_T))
+  chunk_size = cs
+type is (integer(int32))
+  chunk_size = int(cs)
+class default
+  error stop 'ERROR:h5fortran:get_chunk: unknown type for chunk_size'
+end select
 
 end procedure hdf_get_chunk
 
@@ -286,4 +292,18 @@ end subroutine get_dset_class
 
 end procedure hdf_get_layout
 
+
+module procedure hdf_check_exist
+
+integer :: ierr
+
+if(.not. self%is_open()) error stop 'ERROR:h5fortran:exist: file handle is not open: ' // self%filename
+
+call h5ltpath_valid_f(self%file_id, dname, .true., hdf_check_exist, ierr)
+!! h5lexists_f can false error with groups--just use h5ltpath_valid
+
+if (ierr/=0) error stop 'ERROR:h5fortran:check_exist: could not determine status of ' // dname // ' in ' // self%filename
+
+end procedure hdf_check_exist
+
 end submodule hdf5_read

src/writer_template.inc

@@ -61,7 +61,7 @@ type is (integer(int32))
 type is (integer(int64))
   call h5dwrite_f(dset_id, dtype, value, dims_dset, ier, file_space_id=file_space_id, mem_space_id=mem_space_id, xfer_prp=xfer_id)
 class default
-  error stop "unknown variable type for " // dname
+  error stop "ERROR:h5fortran:writer: unknown variable type for " // dname
 end select
 if (ier /= 0) error stop 'ERROR:h5fortran:h5dwrite: could not write ' // dname // ' to ' // self%filename
 

test/test_deflate_props.f90

@@ -25,10 +25,10 @@ program test_deflate_props
 if(ierr/=0) error stop "mpi_comm_rank"
 
 call test_read_deflate_props(fn1, N, mpi_id)
-if(mpi_id==0) print *,'OK: HDF5 read deflate properties'
+if(mpi_id == 0) print *,'OK: HDF5 read deflate properties'
 
 call test_get_deflate(fn1)
-if (ierr /= 0) print *, 'OK: HDF5 get deflate'
+if(mpi_id == 0) print *, 'OK: HDF5 get deflate'
 
 call mpi_finalize(ierr)
 if (ierr /= 0) error stop "mpi_finalize"

test/test_deflate_write.f90

@@ -20,6 +20,9 @@ program test_deflate
 integer :: ierr, mpi_id, Nmpi
 
 
+logical :: debug = .false.
+
+
 call mpi_init(ierr)
 if (ierr /= 0) error stop "mpi_init"
 
@@ -50,7 +53,6 @@ subroutine test_write_deflate(fn, N, mpi_id, Nmpi)
 type(hdf5_file) :: h5f
 integer(HSIZE_T) :: i0(2), i1(2), dx2
 real(real32), allocatable :: A(:,:)
-logical :: debug = .false.
 
 !> MPI partition
 if(mpi_id == 0) then
@@ -72,7 +74,7 @@ subroutine test_write_deflate(fn, N, mpi_id, Nmpi)
 i1(2) = i0(2) + dx2 - 1
 
 !> write with MPI, compressing if available
-if(debug) print '(a,i0,1x,2i5,2x,2i5)', "#1 partition: mpi_id, i0, i1 ", mpi_id, i0, i1
+if(debug) print '(a,i0,1x,2i5,2x,2i5)', "write_deflate partition: mpi_id, i0, i1 ", mpi_id, i0, i1
 
 call h5f%open(fn, action='w', comp_lvl=1, mpi=.true.)
 call h5f%write('/A', A, N, istart=i0, iend=i1, chunk_size=[5, 50])
@@ -140,14 +142,12 @@ subroutine test_deflate_whole(fn, N)
 call h5f%chunks('/A_autochunk', chunks)
 if(any(chunks < 1)) error stop '#2 auto chunk unexpected chunk size'
 
-call h5f%close()
-
 if(mpi_id == 0) then
   fsize = real(h5f%filesize())
   crat = (2 * N(1) * N(2) * 4 * storage_size(A) / 8) / fsize
   !! 2* since two datasets same size
 
-  print '(A,F6.2,A,I6)','#2 filesize (Mbytes): ', fsize / 1e6, '   compression ratio:', crat
+  print '(A,F6.2,A,f7.1)','#2 filesize (Mbytes): ', fsize / 1e6, '   compression ratio:', crat
 
   if (h5f%parallel_compression) then
     if(crat < MIN_COMP) error stop fn // ' low compression'
@@ -156,6 +156,8 @@ subroutine test_deflate_whole(fn, N)
   endif
 endif
 
+call h5f%close()
+
 end subroutine test_deflate_whole
 
 
@@ -166,8 +168,9 @@ subroutine test_deflate_slice(fn, N)
 
 type(hdf5_file) :: h5f
 integer, allocatable :: A(:,:,:)
-integer(hsize_t) :: crat, chunks(3), dx2, i0(3), i1(3)
-integer :: fsize, mpi_id, Nmpi, M(3)
+integer(hsize_t) :: chunks(3), dx2, i0(3), i1(3)
+integer :: mpi_id, Nmpi, M(3)
+real :: fsize, crat
 
 !> MPI partition
 call mpi_comm_size(MPI_COMM_WORLD, Nmpi, ierr)
@@ -196,13 +199,11 @@ subroutine test_deflate_slice(fn, N)
 call h5f%chunks('/A', chunks)
 if(any(chunks < 1)) error stop '#3 auto chunk unexpected chunk size'
 
-call h5f%close()
-
 if(mpi_id == 0) then
-  inquire(file=fn, size=fsize)
+  fsize = real(h5f%filesize())
   crat = (N(1) * N(2) * storage_size(A) / 8) / fsize
 
-  print '(A,F6.2,A,I6)','#3 filesize (Mbytes): ',fsize / 1e6, '  compression ratio:', crat
+  print '(A,F6.2,A,f7.1)','#3 filesize (Mbytes): ',fsize / 1e6, '  compression ratio:', crat
 
   if (h5f%parallel_compression) then
     if(crat < MIN_COMP) error stop fn // ' low compression'
@@ -211,6 +212,8 @@ subroutine test_deflate_slice(fn, N)
   endif
 endif
 
+call h5f%close()
+
 end subroutine test_deflate_slice