Skip to content

Commit 95b0f71

Browse files
scivisionscivision
committed
break up source files
1 parent f08669c commit 95b0f71

File tree

6 files changed

+243
-228
lines changed

6 files changed

+243
-228
lines changed

‎README.md

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -167,7 +167,7 @@ On HPC, we suggest using the HDF5 library provided by the HPC system for best pe
167167
* variable length dataset writing
168168

169169
We didn't use `type(c_ptr)` and `c_loc()` internally for datasets as we observed problems when the actual argument is sliced on read/write.
170-
The current h5fortran impementation (Fortran `select type` for H5Dwrite/H5Dread) does work with sliced actual arguments.
170+
The current h5fortran implementation (Fortran `select type` for H5Dwrite/H5Dread) does work with sliced actual arguments.
171171

172172
HDF5 Fortran 2003
173173
[features](https://docs.hdfgroup.org/archive/support/HDF5/doc/fortran/NewFeatures_F2003.pdf)

‎src/CMakeLists.txt

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
set(s ${CMAKE_CURRENT_SOURCE_DIR})
22

33
target_sources(h5fortran PRIVATE
4-
${s}/utils.f90
4+
${s}/utils.f90 ${s}/datatype.f90 ${s}/deflate.f90
55
${s}/read.f90 ${s}/read_scalar.f90 ${s}/read_ascii.f90 ${s}/reader.f90
66
${s}/write.f90 ${s}/write_scalar.f90 ${s}/writer.f90
77
${s}/reader_lt.f90 ${s}/writer_lt.f90

‎src/datatype.f90

Lines changed: 125 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,125 @@
1+
submodule (h5fortran:hdf5_read) h5f_datatype
2+
3+
implicit none
4+
5+
contains
6+
7+
8+
module procedure get_class
9+
10+
integer(HID_T) :: dset_id
11+
integer :: ier
12+
13+
call H5Dopen_f(self%file_id, dname, dset_id, ier)
14+
call estop(ier, "get_class:H5Dopen", self%filename, dname)
15+
16+
call get_obj_class(self, dname, dset_id, get_class)
17+
18+
call H5Dclose_f(dset_id, ier)
19+
call estop(ier, "get_class:H5Dclose", self%filename, dname)
20+
21+
end procedure get_class
22+
23+
24+
module procedure get_obj_class
25+
26+
integer :: ier, obj_type
27+
integer(HID_T) :: obj_dtype, native_dtype
28+
29+
call H5Iget_type_f(obj_id, obj_type, ier)
30+
call estop(ier, "get_obj_class:H5Iget_type", self%filename, obj_name)
31+
32+
if(obj_type == H5I_DATASET_F) then
33+
call H5Dget_type_f(obj_id, obj_dtype, ier)
34+
elseif(obj_type == H5I_ATTR_F) then
35+
call H5Aget_type_f(obj_id, obj_dtype, ier)
36+
else
37+
error stop "ERROR:h5fortran:get_obj_class: only datasets and attributes have datatype " // obj_name // " " // self%filename
38+
endif
39+
call estop(ier, "get_obj_class:H5[A,D]get_type", self%filename, obj_name)
40+
41+
call H5Tget_native_type_f(obj_dtype, H5T_DIR_ASCEND_F, native_dtype, ier)
42+
call estop(ier, "get_obj_class:H5Tget_native_type", self%filename, obj_name)
43+
44+
!> compose datatype inferred
45+
call H5Tget_class_f(native_dtype, class, ier)
46+
call estop(ier, "get_obj_class:H5Tget_class", self%filename, obj_name)
47+
48+
if(present(size_bytes)) then
49+
call H5Tget_size_f(native_dtype, size_bytes, ier)
50+
call estop(ier, "get_obj_class:H5Tget_size", self%filename, obj_name)
51+
endif
52+
53+
call H5Tclose_f(native_dtype, ier)
54+
call estop(ier, "get_obj_class:H5Tclose", self%filename, obj_name)
55+
56+
if(present(pad_type)) then
57+
if(class /= H5T_STRING_F) error stop "ERROR:h5fortran:get_class: pad_type only for string"
58+
59+
call H5Tget_strpad_f(obj_dtype, pad_type, ier)
60+
call estop(ier, "get_obj_class:H5Tget_strpad", self%filename, obj_name)
61+
endif
62+
63+
call H5Tclose_f(obj_dtype, ier)
64+
call estop(ier, "get_obj_class:H5Tclose", self%filename, obj_name)
65+
66+
end procedure get_obj_class
67+
68+
69+
module procedure get_native_dtype
70+
!! get the dataset variable type:
71+
!! {H5T_NATIVE_REAL, H5T_NATIVE_DOUBLE, H5T_NATIVE_INTEGER, H5T_NATIVE_CHARACTER, H5T_STD_I64LE}
72+
73+
integer :: class, ier
74+
! integer :: order, machine_order
75+
integer(size_t) :: size_bytes
76+
integer(HID_T) :: o_id
77+
78+
if(present(obj_id)) then
79+
o_id = obj_id
80+
else
81+
!! assume dataset
82+
call H5Dopen_f(self%file_id, dname, o_id, ier)
83+
call estop(ier, "get_native_dtype:H5Dopen", self%filename, dname)
84+
endif
85+
86+
call get_obj_class(self, dname, o_id, class, size_bytes=size_bytes)
87+
88+
if(.not.present(obj_id)) then
89+
call H5Dclose_f(o_id, ier)
90+
call estop(ier, "get_native_dtype:H5Dclose", self%filename, dname)
91+
endif
92+
93+
!> endianness and within type casting is handled by HDF5
94+
! call h5tget_order_f(native_dtype, order, ier)
95+
! if(ier/=0) error stop 'ERROR:h5fortran:reader: get endianness ' // dname // ' from ' // self%filename
96+
! !> check dataset endianness matches machine (in future, could swap endianness if needed)
97+
! call h5tget_order_f(H5T_NATIVE_INTEGER, machine_order, ier)
98+
! if(order /= machine_order) error stop 'ERROR:h5fortran:read: endianness /= machine native: ' &
99+
! // dname // ' from ' // self%filename
100+
101+
if(class == H5T_INTEGER_F) then
102+
if(size_bytes == 4) then
103+
get_native_dtype = H5T_NATIVE_INTEGER
104+
elseif(size_bytes == 8) then
105+
get_native_dtype = H5T_STD_I64LE
106+
else
107+
error stop "ERROR:h5fortran:get_native_dtype: expected 32-bit or 64-bit integer:" // dname // ' from ' // self%filename
108+
endif
109+
elseif(class == H5T_FLOAT_F) then
110+
if(size_bytes == 4) then
111+
get_native_dtype = H5T_NATIVE_REAL
112+
elseif(size_bytes == 8) then
113+
get_native_dtype = H5T_NATIVE_DOUBLE
114+
else
115+
error stop "ERROR:h5fortran:get_native_dtype: expected 32-bit or 64-bit real:" // dname // ' from ' // self%filename
116+
endif
117+
elseif(class == H5T_STRING_F) then
118+
get_native_dtype = H5T_NATIVE_CHARACTER
119+
else
120+
error stop "ERROR:h5fortran:get_native_dtype: non-handled datatype: " // dname // " from " // self%filename
121+
endif
122+
123+
end procedure get_native_dtype
124+
125+
end submodule h5f_datatype

‎src/deflate.f90

Lines changed: 115 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,115 @@
1+
submodule (h5fortran:hdf5_read) h5f_deflate
2+
3+
use hdf5, only : H5Z_FILTER_DEFLATE_F
4+
5+
implicit none
6+
7+
contains
8+
9+
module procedure hdf_get_chunk
10+
11+
integer :: ier, drank
12+
integer(HID_T) :: dapl, dset_id, space_id
13+
integer(HSIZE_T) :: cs(size(chunk_size))
14+
15+
cs = -1
16+
17+
if (.not.self%exist(dname)) error stop 'ERROR:h5fortran:get_chunk: ' // dname // ' does not exist in ' // self%filename
18+
19+
if(self%is_chunked(dname)) then
20+
call H5Dopen_f(self%file_id, dname, dset_id, ier)
21+
call estop(ier, "get_chunk:H5Dopen", self%filename, dname)
22+
23+
call H5Dget_space_f(dset_id, space_id, ier)
24+
call estop(ier, "get_chunk:H5Dget_space", self%filename, dname)
25+
call H5Sget_simple_extent_ndims_f(space_id, drank, ier)
26+
call estop(ier, "get_chunk:H5Sget_simple_extent_ndims", self%filename, dname)
27+
call H5Sclose_f(space_id, ier)
28+
call estop(ier, "get_chunk:H5Sclose", self%filename, dname)
29+
30+
call h5dget_create_plist_f(dset_id, dapl, ier)
31+
call estop(ier, "get_chunk:H5Dget_create_plist", self%filename, dname)
32+
33+
call h5dclose_f(dset_id, ier)
34+
call estop(ier, "get_chunk:H5Dclose", self%filename, dname)
35+
36+
call h5pget_chunk_f(dapl, drank, cs, ier)
37+
if (ier /= drank) error stop 'ERROR:h5fortran:get_chunk:h5pget_chunk ' // dname // ' ' // self%filename
38+
!! yes ier == drank is success for this call
39+
40+
call h5pclose_f(dapl, ier)
41+
call estop(ier, "get_chunk:H5Pclose", self%filename, dname)
42+
endif
43+
44+
select type (chunk_size)
45+
type is (integer(HSIZE_T))
46+
chunk_size = cs
47+
type is (integer(int32))
48+
chunk_size = int(cs)
49+
class default
50+
error stop 'ERROR:h5fortran:get_chunk: unknown type for chunk_size'
51+
end select
52+
53+
end procedure hdf_get_chunk
54+
55+
56+
module procedure get_deflate
57+
!! h5pget_filter_f doesn't work collectively, will crash on h5fclose_f
58+
!! if(mpi_id==0) with mpi_bcast does not work, same crash.
59+
!! better to use H5Pall_filters_avail_f when mpi=.true.
60+
61+
integer :: i, j, ier
62+
integer :: flags !< bit pattern
63+
integer(HID_T) :: dcpl, dset_id
64+
integer(SIZE_T) :: Naux
65+
integer :: Aux(8) !< arbitrary length
66+
integer :: Nf, filter_id
67+
character(32) :: filter_name
68+
69+
logical :: debug = .false.
70+
71+
72+
get_deflate = .false.
73+
74+
Naux = size(Aux, kind=SIZE_T)
75+
76+
if(.not.self%exist(dname)) error stop "ERROR:h5fortran:get_deflate: " // dname // " does not exist: " // self%filename
77+
call H5Dopen_f(self%file_id, dname, dset_id, ier)
78+
call estop(ier, "get_deflate:H5Dopen", self%filename, dname)
79+
80+
call h5dget_create_plist_f(dset_id, dcpl, ier)
81+
call estop(ier, "get_deflate:H5Dget_create_plist", self%filename, dname)
82+
83+
call H5Dclose_f(dset_id, ier)
84+
call estop(ier, "get_deflate:H5Dclose", self%filename, dname)
85+
86+
call h5pget_nfilters_f(dcpl, Nf, ier)
87+
call estop(ier, "get_deflate:H5Pget_nfilters", self%filename, dname)
88+
89+
filters: do i = 1, Nf
90+
filter_name = ""
91+
92+
call h5pget_filter_f(dcpl, i, &
93+
flags, &
94+
Naux, Aux, &
95+
len(filter_name, SIZE_T), filter_name, &
96+
filter_id, ier)
97+
call estop(ier, "get_deflate:H5Pget_filter", self%filename, dname)
98+
if(filter_id < 0) write(stderr,'(a,i0)') "ERROR:h5fortran:get_deflate:h5pget_filter: index error " // dname, i
99+
100+
if (debug) then
101+
j = index(filter_name, c_null_char)
102+
if(j>0) print *, "TRACE:get_filter: filter name: ", filter_name(:j-1)
103+
endif
104+
105+
get_deflate = filter_id == H5Z_FILTER_DEFLATE_F
106+
if(get_deflate) exit filters
107+
108+
end do filters
109+
110+
call h5pclose_f(dcpl, ier)
111+
112+
end procedure get_deflate
113+
114+
115+
end submodule h5f_deflate

0 commit comments

Comments
 (0)