Skip to content

Commit 90f76d8

Browse files
scivisionscivision
committed
attributes: unify with h5fortran: deduplicate code
1 parent 62881f3 commit 90f76d8

File tree

9 files changed

+70
-310
lines changed

9 files changed

+70
-310
lines changed

‎src/CMakeLists.txt‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ ${s}/write.f90 ${s}/write_scalar.f90 ${s}/writer.f90
77
${s}/reader_lt.f90 ${s}/writer_lt.f90
88
${s}/interface.f90
99
${s}/attr.f90
10-
${s}/attr_read.f90 ${s}/attr_read_char.f90
10+
${s}/attr_read.f90
1111
${s}/attr_write.f90
1212
${s}/mpi.F90
1313
)

‎src/attr.f90‎

Lines changed: 14 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
use hdf5, only : H5S_SCALAR_F, &
44
H5Aexists_by_name_f, H5Aopen_by_name_f, H5Aclose_f, H5Acreate_by_name_f, H5Adelete_f, H5Aget_space_f, &
55
H5Screate_f, H5Screate_simple_f, H5Sclose_f, &
6-
H5Sget_simple_extent_dims_f, H5Sget_simple_extent_ndims_f, H5Sget_simple_extent_npoints_f, &
6+
H5Sget_simple_extent_dims_f, H5Sget_simple_extent_ndims_f, &
77
H5Tcopy_f, H5Tset_size_f, H5Tclose_f, &
88
H5Dopen_f, H5Dclose_f
99

@@ -12,27 +12,30 @@
1212
contains
1313

1414

15-
subroutine attr_create(self, obj_name, attr_name, dtype, attr_dims, space_id, attr_id, dtype_id, charlen)
15+
subroutine attr_create(self, obj_name, attr_name, dtype, attr_dims, attr_id, dtype_id, charlen)
1616

1717
class(hdf5_file), intent(in) :: self
1818
character(*), intent(in) :: obj_name, attr_name
1919
integer(HID_T), intent(in) :: dtype
2020
integer(HSIZE_T), dimension(:), intent(in) :: attr_dims
21-
integer(HID_T), intent(out) :: space_id, attr_id
22-
integer(HID_T), intent(out), optional :: dtype_id
21+
integer(HID_T), intent(out) :: attr_id, dtype_id
2322
integer, intent(in), optional :: charlen !< length of character scalar
2423

2524
logical :: attr_exists
2625
integer :: ier
27-
integer(HID_T) :: type_id
26+
integer(HID_T) :: space_id
27+
28+
call H5Tcopy_f(dtype, dtype_id, ier)
29+
if(ier /= 0) error stop "ERROR:h5fortran:attr_create:H5Tcopy: " // obj_name // ":" // attr_name // ': ' // self%filename
2830

2931

3032
if(dtype == H5T_NATIVE_CHARACTER) then
31-
if(.not. present(dtype_id)) error stop "ERROR:h5fortran:attr_create: character needs type_id"
3233
if(.not. present(charlen)) error stop "ERROR:h5fortran:attr_create: character type must specify charlen"
34+
35+
call H5Tset_size_f(dtype_id, int(charlen, SIZE_T), ier)
36+
if(ier/=0) error stop "ERROR:h5fortran:attr_create:h5tset_size:char: " // obj_name // ":" // attr_name // ': ' // self%filename
3337
endif
3438

35-
if(.not.self%is_open()) error stop 'ERROR:h5fortran:attr_create: file handle is not open'
3639

3740
call H5Aexists_by_name_f(self%file_id, obj_name, attr_name, attr_exists, ier)
3841
if(ier /= 0) error stop "ERROR:h5fortran:attr_create:H5Aexists_by_name: " // obj_name // ":" // attr_name // ": " // self%filename
@@ -55,20 +58,12 @@ subroutine attr_create(self, obj_name, attr_name, dtype, attr_dims, space_id, at
5558
endif
5659
if (ier /= 0) error stop "ERROR:h5fortran:attr_create:h5screate:filespace " // obj_name // ":" // attr_name // ": " // self%filename
5760

58-
if(dtype == H5T_NATIVE_CHARACTER) then
59-
call h5tcopy_f(dtype, type_id, ier)
60-
if(ier /= 0) error stop "ERROR:h5fortran:attr_create:h5tcopy:character: " // obj_name // ":" // attr_name // ': ' // self%filename
61-
62-
call h5tset_size_f(type_id, int(charlen, SIZE_T), ier)
63-
if(ier/=0) error stop "ERROR:h5fortran:attr_create:h5tset_size:char: " // obj_name // ":" // attr_name // ': ' // self%filename
64-
dtype_id = type_id
65-
else
66-
type_id = dtype
67-
endif
68-
69-
call H5Acreate_by_name_f(self%file_id, obj_name, attr_name, type_id, space_id, attr_id, ier)
61+
call H5Acreate_by_name_f(self%file_id, obj_name, attr_name, dtype_id, space_id, attr_id, ier)
7062
if(ier/=0) error stop "ERROR:h5fortran:attr_create:H5Acreate_by_name: " // obj_name // ":" // attr_name // ": " // self%filename
7163

64+
call H5Sclose_f(space_id, ier)
65+
if(ier /= 0) error stop "ERROR:h5fortran:writeattr:H5Sclose " // obj_name // ":" // attr_name // " in " // self%filename
66+
7267
end subroutine attr_create
7368

7469

‎src/attr_read.f90‎

Lines changed: 5 additions & 80 deletions
Original file line numberDiff line numberDiff line change
@@ -3,92 +3,17 @@
33
use, intrinsic :: iso_c_binding, only : C_CHAR, C_NULL_CHAR, C_F_POINTER
44

55
use hdf5, only : H5Aread_f, H5Aget_type_f, &
6-
H5Tis_variable_str_f, H5Tget_class_f, H5Tget_native_type_f, H5Tget_size_f, H5Tget_strpad_f, &
7-
H5T_DIR_ASCEND_F
8-
use h5lt, only: h5ltget_attribute_float_f, h5ltget_attribute_double_f, h5ltget_attribute_int_f
6+
H5Tget_class_f, H5Tget_native_type_f, H5Tget_size_f, H5Tget_strpad_f, &
7+
H5T_DIR_ASCEND_F, &
8+
H5S_ALL_F
99

1010
implicit none (type, external)
1111

12-
interface
13-
module subroutine readattr_char_scalar(self, obj_name, attr_name, attr_id, space_id, A)
14-
class(hdf5_file), intent(in) :: self
15-
character(*), intent(in) :: obj_name, attr_name
16-
integer(HID_T), intent(in) :: attr_id, space_id
17-
character(*), intent(inout) :: A
18-
end subroutine
19-
20-
end interface
21-
2212
contains
2313

2414
module procedure readattr_scalar
25-
26-
integer(HSIZE_T) :: attr_dims(0)
27-
integer(HID_T) :: attr_id, space_id
28-
integer :: attr_class, ier
29-
logical :: is_scalar, attr_exists
30-
31-
if(.not.self%is_open()) error stop 'ERROR:h5fortran:attr_read: file handle is not open'
32-
33-
call H5Aexists_by_name_f(self%file_id, obj_name, attr_name, attr_exists, ier)
34-
if(ier /= 0) error stop "ERROR:h5fortran:attr_read:H5Aexists_by_name " // obj_name // ":" // attr_name // " : " // self%filename
35-
if(.not.attr_exists) then
36-
error stop 'ERROR:h5fortran:attr_read: attribute not exist: ' // obj_name // ":" // attr_name // " : " // self%filename
37-
endif
38-
39-
call H5Aopen_by_name_f(self%file_id, obj_name, attr_name, attr_id, ier)
40-
if(ier/=0) error stop 'ERROR:h5fortran:readattr:H5Aopen ' // obj_name // ":" // attr_name // " : " // self%filename
41-
42-
call H5Aget_space_f(attr_id, space_id, ier)
43-
if(ier/=0) error stop 'ERROR:h5fortran:readattr:H5Aget_space ' // obj_name // ":" // attr_name
44-
45-
call hdf_rank_check(self, obj_name // ":" // attr_name, space_id, rank(A), is_scalar)
46-
47-
call get_obj_class(self, obj_name // ":" // attr_name, attr_id, attr_class)
48-
49-
!> cast the dataset read from disk to the variable type presented by user h5f%readattr("/my_dataset", x, "y")
50-
!> We only cast when needed to save memory.
51-
!! select case doesn't allow H5T_*
52-
if(attr_class == H5T_FLOAT_F) then
53-
select type(A)
54-
type is (real(real64))
55-
call H5Aread_f(attr_id, H5T_NATIVE_DOUBLE, A, attr_dims, ier)
56-
type is (real(real32))
57-
call H5Aread_f(attr_id, H5T_NATIVE_REAL, A, attr_dims, ier)
58-
class default
59-
error stop 'ERROR:h5fortran:readattr: real disk dataset ' // obj_name // ':' // attr_name // ' needs real memory variable'
60-
end select
61-
elseif(attr_class == H5T_INTEGER_F) then
62-
select type(A)
63-
type is (integer(int32))
64-
call H5Aread_f(attr_id, H5T_NATIVE_INTEGER, A, attr_dims, ier)
65-
type is (integer(int64))
66-
call H5Aread_f(attr_id, H5T_STD_I64LE, A, attr_dims, ier)
67-
class default
68-
error stop 'ERROR:h5fortran:readattr: integer disk dataset ' // obj_name // ':' // attr_name // ' needs integer memory variable'
69-
end select
70-
elseif(attr_class == H5T_STRING_F) then
71-
select type(A)
72-
type is (character(*)) !< kind=c_char too
73-
call readattr_char_scalar(self, obj_name, attr_name, attr_id, space_id, A)
74-
class default
75-
error stop 'ERROR:h5fortran:readattr: string dataset ' // obj_name // ':' // attr_name // ' needs character memory variable'
76-
end select
77-
else
78-
error stop 'ERROR:h5fortran:attr_read: non-handled datatype--please reach out to developers.'
79-
end if
80-
if(ier/=0) error stop 'ERROR:h5fortran:readattr: reading ' // obj_name // ':' // attr_name // ' from ' // self%filename
81-
82-
call H5Aclose_f(attr_id, ier)
83-
if(ier /= 0) error stop "ERROR:h5fortran:readattr_scalar:H5Aclose: " // obj_name // ':' // attr_name // " in " // self%filename
84-
85-
call H5Sclose_f(space_id, ier)
86-
if(ier /= 0) error stop "ERROR:h5fortran:readattr_scalar:H5Sclose: " // obj_name // ':' // attr_name // " in " // self%filename
87-
88-
end procedure readattr_scalar
89-
90-
91-
15+
include 'attr_read.inc'
16+
end procedure
9217

9318
module procedure readattr_1d
9419
include 'attr_read.inc'

‎src/attr_read.inc‎

Lines changed: 16 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
integer :: ier, attr_class
22
integer(HID_T) :: attr_id, space_id
33
integer(HSIZE_T) :: attr_dims(rank(A))
4+
logical :: is_scalar
45

56
attr_dims = shape(A, HSIZE_T)
67

@@ -10,38 +11,41 @@ if(ier /= 0) error stop "ERROR:h5fortran:readattr:H5Aopen_by_name: " // obj_name
1011
call H5Aget_space_f(attr_id, space_id, ier)
1112
if(ier /= 0) error stop "ERROR:h5fortran:readattr:H5Aget_space: " // obj_name // ":" // attr_name // ":" // self%filename
1213

13-
call hdf_shape_check(self, obj_name // ":" // attr_name, space_id, attr_dims)
14+
if(rank(A) == 0) then
15+
call hdf_rank_check(self, obj_name // ":" // attr_name, space_id, rank(A), is_scalar)
16+
else
17+
call hdf_shape_check(self, obj_name // ":" // attr_name, space_id, attr_dims)
18+
endif
1419

1520
call get_obj_class(self, obj_name // ":" // attr_name, attr_id, attr_class)
1621

17-
!> cast the dataset read from disk to the variable type presented by user h5f%readattr("/my_dataset", x, "y")
18-
!> We only cast when needed to save memory.
22+
!> cast the dataset read from disk to the variable type presented by user h5f%read("/my_dataset", x, "y")
1923
!! select case doesn't allow H5T_*
20-
if(attr_class == H5T_FLOAT_F) then
24+
if(attr_class == H5T_FLOAT_F .OR. attr_class == H5T_INTEGER_F) then
2125
select type(A)
2226
type is (real(real64))
2327
call H5Aread_f(attr_id, H5T_NATIVE_DOUBLE, A, attr_dims, ier)
2428
type is (real(real32))
2529
call H5Aread_f(attr_id, H5T_NATIVE_REAL, A, attr_dims, ier)
26-
class default
27-
error stop 'ERROR:h5fortran:readattr: real disk dataset ' // obj_name // ':' // attr_name // ' needs real memory variable'
28-
end select
29-
elseif(attr_class == H5T_INTEGER_F) then
30-
select type(A)
3130
type is (integer(int32))
3231
call H5Aread_f(attr_id, H5T_NATIVE_INTEGER, A, attr_dims, ier)
3332
type is (integer(int64))
3433
call H5Aread_f(attr_id, H5T_STD_I64LE, A, attr_dims, ier)
3534
class default
36-
error stop 'ERROR:h5fortran:readattr: integer disk dataset ' // obj_name // ':' // attr_name // ' needs integer memory variable'
35+
error stop 'ERROR:h5fortran:readattr: numeric dataset ' // obj_name // ':' // attr_name // ' needs real or integer variable'
3736
end select
3837
elseif(attr_class == H5T_STRING_F) then
39-
error stop "ERROR:h5fortran:readattr: attribute character arrays (non-singleton) not yet supported by h5fortran."
38+
select type(A)
39+
type is (character(*)) !< kind=c_char too
40+
call read_char(self, obj_name//":"//attr_name, A, attr_id, H5S_ALL_F, space_id)
41+
class default
42+
error stop 'ERROR:h5fortran:readattr: string dataset ' // obj_name // ':' // attr_name // ' needs character memory variable'
43+
end select
4044
else
4145
error stop "ERROR:h5fortran:readattr: unknown attribute type for " // obj_name // ':' // attr_name
4246
endif
4347
44-
if (ier /= 0) error stop "ERROR:h5fortran:readattr: " // obj_name // " in " // self%filename
48+
if(ier /= 0) error stop 'ERROR:h5fortran:readattr: reading ' // obj_name // ':' // attr_name // ":" // self%filename
4549
4650
call H5Aclose_f(attr_id, ier)
4751
if(ier /= 0) error stop "ERROR:h5fortran:readattr:H5Aclose: " // obj_name // ":" // attr_name // ":" // self%filename

‎src/attr_read_char.f90‎

Lines changed: 0 additions & 139 deletions
This file was deleted.

0 commit comments

Comments
 (0)