Skip to content

Commit 8bb78bb

Browse files
scivisionscivision
committed
enhance stability/speed of rank/shape check
1 parent 0681dd5 commit 8bb78bb

File tree

4 files changed

+49
-40
lines changed

4 files changed

+49
-40
lines changed

‎VERSION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1 +1 @@
1-
4.1.3
1+
4.1.4

‎src/interface.f90‎

Lines changed: 27 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,7 @@ module h5fortran
1818
implicit none (type, external)
1919
private
2020
public :: hdf5_file, hdf5_close, h5write, h5read, h5exist, is_hdf5, h5write_attr, h5read_attr, &
21-
check, hdf_shape_check, hdf_get_slice, hdf_wrapup, & !< for submodules only
21+
check, hdf_shape_check, hdf_rank_check, hdf_get_slice, hdf_wrapup, & !< for submodules only
2222
HSIZE_T, HID_T, H5T_NATIVE_DOUBLE, H5T_NATIVE_REAL, H5T_NATIVE_INTEGER !< HDF5 types for end users
2323

2424
!> main type
@@ -1367,49 +1367,50 @@ subroutine hdf_get_slice(self, dname, did, sid, mem_sid, i0, i1, i2)
13671367
end subroutine hdf_get_slice
13681368

13691369

1370-
subroutine hdf_shape_check(self, dname, dims)
1370+
subroutine hdf_rank_check(self, dname, dims)
1371+
13711372
class(hdf5_file), intent(in) :: self
13721373
character(*), intent(in) :: dname
1373-
class(*), intent(in) :: dims(:)
1374+
integer(HSIZE_T), intent(in) :: dims(:)
13741375

1375-
integer :: ierr
1376-
integer(SIZE_T) :: dsize
1377-
integer(HSIZE_T), dimension(size(dims)):: ddims, vdims
1378-
integer :: dtype, drank
1376+
integer :: ierr, drank
13791377

1380-
if(.not.self%is_open) error stop 'h5fortran:shape: file handle is not open'
1378+
if(.not.self%is_open) error stop 'h5fortran:rank_check: file handle is not open'
13811379

13821380
if (.not.self%exist(dname)) error stop 'ERROR: ' // dname // ' does not exist in ' // self%filename
13831381

1384-
1385-
!> allow user to specify int4 or int8 dims
1386-
select type (dims)
1387-
type is (integer(int32))
1388-
vdims = int(dims, int64)
1389-
type is (integer(hsize_t))
1390-
vdims = dims
1391-
class default
1392-
error stop 'ERROR:h5fortran:shape_check: wrong type for dims: ' // dname // ' in ' // self%filename
1393-
end select
1394-
13951382
!> check for matching rank, else bad reads can occur--doesn't always crash without this check
13961383
call h5ltget_dataset_ndims_f(self%lid, dname, drank, ierr)
1397-
if (ierr/=0) error stop 'ERROR:h5fortran:shape_check: get_dataset_ndim ' // dname // ' read ' // self%filename
1398-
1384+
if (ierr/=0) error stop 'ERROR:h5fortran:rank_check: get_dataset_ndim ' // dname // ' read ' // self%filename
13991385

1400-
if (drank /= size(vdims)) then
1401-
write(stderr,'(A,I0,A,I0)') 'ERROR:h5fortran:shape_check: rank mismatch ' // dname // ' = ',drank,' variable rank =', size(vdims)
1386+
if (drank /= size(dims)) then
1387+
write(stderr,'(A,I0,A,I0)') 'ERROR:h5fortran:rank_check: rank mismatch ' // dname // ' = ',drank,' variable rank =', size(dims)
14021388
error stop
14031389
endif
14041390

1391+
end subroutine hdf_rank_check
1392+
1393+
1394+
subroutine hdf_shape_check(self, dname, dims)
1395+
class(hdf5_file), intent(in) :: self
1396+
character(*), intent(in) :: dname
1397+
integer(HSIZE_T), intent(in) :: dims(:)
1398+
1399+
integer :: ierr
1400+
integer(SIZE_T) :: type_size
1401+
integer(HSIZE_T), dimension(size(dims)):: ddims
1402+
integer :: type_class
1403+
1404+
call hdf_rank_check(self, dname, dims)
1405+
14051406
!> check for matching size, else bad reads can occur.
14061407

1407-
call h5ltget_dataset_info_f(self%lid, dname, ddims, dtype, dsize, ierr)
1408+
call h5ltget_dataset_info_f(self%lid, dname, ddims, type_class, type_size, ierr)
14081409
if (ierr/=0) error stop 'ERROR:h5fortran:shape_check: get_dataset_info ' // dname // ' read ' // self%filename
14091410

14101411

1411-
if(.not. all(vdims == ddims)) then
1412-
write(stderr,*) 'ERROR:h5fortran:shape_check: shape mismatch ' // dname // ' = ',ddims,' variable shape =', vdims
1412+
if(any(int(dims, int64) /= ddims)) then
1413+
write(stderr,*) 'ERROR:h5fortran:shape_check: shape mismatch ' // dname // ' = ',ddims,' variable shape =', dims
14131414
error stop
14141415
endif
14151416

‎src/read/reader.f90‎

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,7 @@
1414
integer :: ier
1515
character(len(value)) :: buf
1616

17-
call hdf_shape_check(self, dname, shape(value))
17+
call hdf_rank_check(self, dname, shape(value, HSIZE_T))
1818

1919
call h5ltread_dataset_string_f(self%lid, dname, buf, ier)
2020
value = buf
@@ -35,7 +35,7 @@
3535
integer(hid_t) :: ds_id, space_id, native_dtype
3636
integer :: ier
3737

38-
call hdf_shape_check(self, dname, shape(value))
38+
call hdf_rank_check(self, dname, shape(value, HSIZE_T))
3939

4040
space_id = 0
4141

@@ -81,7 +81,7 @@
8181
integer(hid_t) :: ds_id, space_id, native_dtype
8282
integer :: ier
8383

84-
call hdf_shape_check(self, dname, shape(value))
84+
call hdf_rank_check(self, dname, shape(value, HSIZE_T))
8585

8686
space_id = 0
8787

@@ -126,7 +126,7 @@
126126
integer(hid_t) :: ds_id, space_id, native_dtype
127127
integer :: ier
128128

129-
call hdf_shape_check(self, dname, shape(value))
129+
call hdf_rank_check(self, dname, shape(value, HSIZE_T))
130130

131131
space_id = 0
132132

@@ -171,7 +171,7 @@
171171
integer(hid_t) :: ds_id, space_id, native_dtype
172172
integer :: ier
173173

174-
call hdf_shape_check(self, dname, shape(value))
174+
call hdf_rank_check(self, dname, shape(value, HSIZE_T))
175175

176176
space_id = 0
177177

@@ -220,7 +220,7 @@
220220
ds_id = 0 !< sentinel
221221
space_id = H5S_ALL_F
222222
mem_space_id = H5S_ALL_F
223-
dims = shape(value)
223+
dims = shape(value, HSIZE_T)
224224

225225
if(present(istart) .and. present(iend)) then
226226
if (present(stride)) then
@@ -343,7 +343,7 @@
343343
ds_id = 0 !< sentinel
344344
space_id = H5S_ALL_F
345345
mem_space_id = H5S_ALL_F
346-
dims = shape(value)
346+
dims = shape(value, HSIZE_T)
347347

348348
if(present(istart) .and. present(iend)) then
349349
if (present(stride)) then
@@ -466,7 +466,7 @@
466466
ds_id = 0 !< sentinel
467467
space_id = H5S_ALL_F
468468
mem_space_id = H5S_ALL_F
469-
dims = shape(value)
469+
dims = shape(value, HSIZE_T)
470470

471471
if(present(istart) .and. present(iend)) then
472472
if (present(stride)) then
@@ -588,7 +588,7 @@
588588
ds_id = 0 !< sentinel
589589
space_id = H5S_ALL_F
590590
mem_space_id = H5S_ALL_F
591-
dims = shape(value)
591+
dims = shape(value, HSIZE_T)
592592

593593
if(present(istart) .and. present(iend)) then
594594
if (present(stride)) then
@@ -679,7 +679,7 @@
679679
ds_id = 0 !< sentinel
680680
space_id = H5S_ALL_F
681681
mem_space_id = H5S_ALL_F
682-
dims = shape(value)
682+
dims = shape(value, HSIZE_T)
683683

684684
if(present(istart) .and. present(iend)) then
685685
if (present(stride)) then
@@ -770,7 +770,7 @@
770770
ds_id = 0 !< sentinel
771771
space_id = H5S_ALL_F
772772
mem_space_id = H5S_ALL_F
773-
dims = shape(value)
773+
dims = shape(value, HSIZE_T)
774774

775775
if(present(istart) .and. present(iend)) then
776776
if (present(stride)) then
@@ -861,7 +861,7 @@
861861
ds_id = 0 !< sentinel
862862
space_id = H5S_ALL_F
863863
mem_space_id = H5S_ALL_F
864-
dims = shape(value)
864+
dims = shape(value, HSIZE_T)
865865

866866
if(present(istart) .and. present(iend)) then
867867
if (present(stride)) then

‎src/write/write.f90‎

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -32,8 +32,16 @@
3232
if(self%debug) print *,'h5fortran:TRACE:create:exists: ' // dname, exists
3333

3434
if(exists) then
35-
if (.not.present(istart)) call hdf_shape_check(self, dname, dims)
35+
if (.not.present(istart)) then
36+
if (size(dims) == 0) then
37+
!! scalar
38+
call hdf_rank_check(self, dname, dims)
39+
else
40+
call hdf_shape_check(self, dname, dims)
41+
endif
42+
endif
3643
!! FIXME: read and write slice shape not checked; but should check in future versions
44+
3745
!> open dataset
3846
call h5dopen_f(self%lid, dname, ds_id, ierr)
3947
if (ierr /= 0) error stop 'ERROR:h5fortran:create: could not open ' // dname // ' in ' // self%filename

0 commit comments

Comments
 (0)