Skip to content

Commit 26d709f

Browse files
committed
attributes,istart,iend: unify API with h5fortran
1 parent c09111a commit 26d709f

21 files changed

+930
-358
lines changed

benchmark/test/slab_mpi_read.f90

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -36,7 +36,7 @@ program read_slab_mpi
3636
integer(int64), allocatable :: t_elapsed(:)
3737

3838
integer(HSIZE_T), allocatable :: dims_full(:)
39-
integer(HSIZE_T), dimension(rank(A3)) :: istart, iend
39+
integer, dimension(rank(A3)) :: istart, iend
4040

4141
call mpi_init(ierr)
4242
if(ierr/=0) error stop "mpi_init"

benchmark/test/slab_mpi_write.f90

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@ program write_slab_mpi
3434

3535
integer :: ierr, dx2, i, i0, i1
3636

37-
integer(HSIZE_T), dimension(rank(S3)) :: istart, iend
37+
integer, dimension(rank(S3)) :: istart, iend
3838

3939
integer :: Nmpi, mpi_id
4040
integer, parameter :: mpi_root_id = 0

src/CMakeLists.txt

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -4,11 +4,13 @@ hdf5_compression_flag()
44
configure_file(hdf5_config.f90.in hdf5_config.f90 @ONLY)
55

66
# main library
7-
add_library(h5mpi interface.f90
8-
utils.f90 attributes.f90
7+
add_library(h5mpi
8+
utils.f90
99
${CMAKE_CURRENT_BINARY_DIR}/hdf5_config.f90
10-
read.f90 reader.f90 read_scalar.f90
11-
write.f90 writer.f90 write_scalar.f90
10+
read.f90 read_scalar.f90 reader.f90
11+
write.f90 write_scalar.f90 writer.f90
12+
interface.f90
13+
attr.f90 attr_read.f90 attr_write.f90
1214
)
1315
target_link_libraries(h5mpi PRIVATE HDF5::HDF5 MPI::MPI_Fortran)
1416
set_target_properties(h5mpi PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/include)

src/attr.f90

Lines changed: 173 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,173 @@
1+
submodule (h5mpi) attr_smod
2+
3+
use hdf5, only : H5S_SCALAR_F, &
4+
H5Aexists_by_name_f, H5Aopen_by_name_f, H5Aclose_f, H5Acreate_by_name_f, H5Adelete_f, &
5+
H5Screate_f, H5Screate_simple_f, H5Sclose_f, &
6+
H5Tcopy_f, H5Tset_size_f, H5Tclose_f, &
7+
H5Dopen_f, H5Dclose_f
8+
9+
use h5lt, only : h5ltget_attribute_ndims_f, h5ltget_attribute_info_f
10+
11+
implicit none (type, external)
12+
13+
contains
14+
15+
16+
subroutine attr_rank_check(self, obj_name, attr_name, mrank, vector_scalar)
17+
!! check for matching rank, else bad reads can occur--doesn't always crash without this check
18+
19+
class(hdf5_file), intent(in) :: self
20+
character(*), intent(in) :: obj_name, attr_name
21+
integer, intent(in) :: mrank
22+
logical, intent(out), optional :: vector_scalar
23+
24+
integer(HSIZE_T) :: attr_dims(1)
25+
integer(SIZE_T) :: attr_bytes
26+
integer :: ierr, attr_rank, attr_type
27+
logical :: attr_exists
28+
29+
if(present(vector_scalar)) vector_scalar = .false.
30+
31+
if(.not.self%is_open()) error stop 'ERROR:h5fortran:attr_rank_check: file handle is not open'
32+
33+
call H5Aexists_by_name_f(self%file_id, obj_name, attr_name, attr_exists, ierr)
34+
if(ierr /= 0) error stop "ERROR:h5fortran:attr_rank_check:H5Aexists_by_name_f failed: " // obj_name // ":" // attr_name
35+
if(.not.attr_exists) error stop 'ERROR:h5fortran:attr_rank_check: attribute not exist: ' // obj_name // ":" // attr_name
36+
37+
!> check for matching rank, else bad reads can occur--doesn't always crash without this check
38+
call h5ltget_attribute_ndims_f(self%file_id, obj_name, attr_name, attr_rank, ierr)
39+
if (ierr /= 0) error stop 'ERROR:h5fortran:attr_rank__check:get_attribute_ndims: ' // obj_name // ":" // attr_name
40+
41+
42+
if (attr_rank == mrank) return
43+
44+
if (present(vector_scalar) .and. attr_rank == 1 .and. mrank == 0) then
45+
!! check if vector of length 1
46+
call h5ltget_attribute_info_f(self%file_id, obj_name, attr_name, attr_dims, attr_type, attr_bytes, ierr)
47+
if (ierr/=0) error stop 'ERROR:h5fortran:attr_rank_check:get_dataset_info ' // obj_name // ":" // attr_name
48+
if (attr_dims(1) == 1) then
49+
vector_scalar = .true.
50+
return
51+
endif
52+
endif
53+
54+
write(stderr,'(A,I0,A,I0)') 'ERROR:h5fortran:attr_rank_check: rank mismatch ' // obj_name // ":" // attr_name // &
55+
' = ', attr_rank,' variable rank =', mrank
56+
error stop
57+
58+
end subroutine attr_rank_check
59+
60+
61+
subroutine attr_shape_check(self, obj_name, attr_name, dims)
62+
class(hdf5_file), intent(in) :: self
63+
character(*), intent(in) :: obj_name, attr_name
64+
integer(HSIZE_T), intent(in) :: dims(:)
65+
66+
integer :: attr_type, ierr
67+
integer(SIZE_T) :: attr_bytes
68+
integer(HSIZE_T), dimension(size(dims)):: attr_dims
69+
70+
call attr_rank_check(self, obj_name, attr_name, size(dims))
71+
72+
!> check for matching size, else bad reads can occur.
73+
call h5ltget_attribute_info_f(self%file_id, obj_name, attr_name, attr_dims, attr_type, attr_bytes, ierr)
74+
if (ierr /= 0) error stop 'ERROR:h5fortran:attr_shape_check:get_attribute_info' // obj_name // ':' // attr_name
75+
76+
if(.not. all(dims == attr_dims)) then
77+
write(stderr,*) 'ERROR:h5fortran:attr_shape_check: ' // obj_name // ':' // attr_name //': ', attr_dims,' /= ', dims
78+
error stop
79+
endif
80+
81+
end subroutine attr_shape_check
82+
83+
84+
subroutine attr_create(self, obj_name, attr_name, dtype, attr_dims, space_id, attr_id, dtype_id, charlen)
85+
86+
class(hdf5_file), intent(in) :: self
87+
character(*), intent(in) :: obj_name, attr_name
88+
integer(HID_T), intent(in) :: dtype
89+
integer(HSIZE_T), dimension(:), intent(in) :: attr_dims
90+
integer(HID_T), intent(out) :: space_id, attr_id
91+
integer(HID_T), intent(out), optional :: dtype_id
92+
integer, intent(in), optional :: charlen !< length of character scalar
93+
94+
logical :: attr_exists
95+
integer :: ier
96+
integer(HID_T) :: type_id
97+
98+
99+
if(dtype == H5T_NATIVE_CHARACTER) then
100+
if(.not. present(dtype_id)) error stop "ERROR:h5fortran:attr_create: character needs type_id"
101+
if(.not. present(charlen)) error stop "ERROR:h5fortran:attr_create: character type must specify charlen"
102+
endif
103+
104+
if(.not.self%is_open()) error stop 'ERROR:h5fortran:attr_create: file handle is not open'
105+
106+
call H5Aexists_by_name_f(self%file_id, obj_name, attr_name, attr_exists, ier)
107+
if(ier /= 0) error stop "ERROR:h5fortran:attr_create:H5Aexists_by_name: " // obj_name // ":" // attr_name // ": " // self%filename
108+
109+
if(attr_exists) then
110+
!! unlike datasets, H5Awrite_f doesn't seem to handle overwrites. Errors result like "H5Oattribute.c line 918 in H5O__attr_write(): can't locate open attribute?"
111+
!! since attribute writes are whole dataset, so we workaround by deleting attribute and creating a new attribute of the same name.
112+
113+
!! FIXME: assumes object is a dataset. How to detect this automatically?
114+
!! For now, user can manually delete attribute first if not a dataset.
115+
116+
call attr_delete(self, obj_name, attr_name)
117+
endif
118+
119+
!> create attribute dataspace
120+
if(size(attr_dims) == 0) then
121+
call H5Screate_f(H5S_SCALAR_F, space_id, ier)
122+
else
123+
call H5Screate_simple_f(size(attr_dims), attr_dims, space_id, ier)
124+
endif
125+
if (ier /= 0) error stop "ERROR:h5fortran:attr_create:h5screate:filespace " // obj_name // ":" // attr_name // ": " // self%filename
126+
127+
if(dtype == H5T_NATIVE_CHARACTER) then
128+
call h5tcopy_f(dtype, type_id, ier)
129+
if(ier /= 0) error stop "ERROR:h5fortran:attr_create:h5tcopy:character: " // obj_name // ":" // attr_name // ': ' // self%filename
130+
131+
call h5tset_size_f(type_id, int(charlen, SIZE_T), ier)
132+
if(ier/=0) error stop "ERROR:h5fortran:attr_create:h5tset_size:char: " // obj_name // ":" // attr_name // ': ' // self%filename
133+
dtype_id = type_id
134+
else
135+
type_id = dtype
136+
endif
137+
138+
call H5Acreate_by_name_f(self%file_id, obj_name, attr_name, type_id, space_id, attr_id, ier)
139+
if(ier/=0) error stop "ERROR:h5fortran:attr_create:H5Acreate_by_name: " // obj_name // ":" // attr_name // ": " // self%filename
140+
141+
end subroutine attr_create
142+
143+
144+
module procedure attr_delete
145+
!! assumes object is a dataset
146+
147+
integer(HID_T) :: dset_id
148+
integer :: ier
149+
150+
call H5Dopen_f(self%file_id, obj_name, dset_id, ier)
151+
if (ier /= 0) error stop "ERROR:h5fortran:attr_delete:H5Dopen: " // obj_name // ": " // self%filename
152+
153+
call H5Adelete_f(dset_id, attr_name, ier)
154+
if(ier /= 0) error stop "ERROR:h5fortran:attr_delete:H5Adelete: " // obj_name // ":" // attr_name // ": " // self%filename
155+
156+
call H5Dclose_f(dset_id, ier)
157+
if (ier /= 0) error stop "ERROR:h5fortran:attr_delete:H5Dclose: " // obj_name // ": " // self%filename
158+
159+
end procedure attr_delete
160+
161+
162+
module procedure attr_exist
163+
164+
integer :: ier
165+
166+
call H5Aexists_by_name_f(self%file_id, obj_name, attr_name, attr_exist, ier)
167+
if(ier /= 0) error stop "ERROR:h5fortran:attr_create:H5Aexists_by_name: " // obj_name // ":" // attr_name // ": " // self%filename
168+
169+
170+
end procedure attr_exist
171+
172+
173+
end submodule attr_smod

0 commit comments

Comments
 (0)