1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
!************************************************************
!
! This example shows how to create intermediate groups with
! a single call to H5Gcreate.
!
!************************************************************/
MODULE g_intermediate
USE HDF5
USE ISO_C_BINDING
IMPLICIT NONE
CONTAINS
!************************************************************
!
! Operator function for H5Ovisit. This function prints the
! name and type of the object passed to it.
!
!************************************************************
INTEGER FUNCTION op_func(loc_id, name, info, cptr) bind(C)
USE HDF5
USE ISO_C_BINDING
IMPLICIT NONE
INTEGER(HID_T), VALUE :: loc_id
CHARACTER(LEN=1), DIMENSION(1:50) :: name ! We must have LEN=1 for bind(C) strings
! in order to be standard compliant
TYPE(H5O_info_t) :: info
CHARACTER(LEN=50) :: name_string = ' '
TYPE(C_PTR) :: cptr
INTEGER :: i
DO i = 1, 50
IF(name(i)(1:1).EQ.C_NULL_CHAR) EXIT ! Read up to the C NULL termination
name_string(i:i) = name(i)(1:1)
ENDDO
WRITE(*,"('/')",ADVANCE="NO") ! Print root group in object path
!
! Check if the current object is the root group, and if not print
! the full path name and type.
!
IF(name(1)(1:1) .EQ. '.')THEN ! Root group, do not print '.'
WRITE(*,"(' (Group)')")
ELSE
IF(info%type.EQ.H5O_TYPE_GROUP_F)THEN
WRITE(*,'(A," (Group)")') TRIM(name_string)
ELSE IF(info%type.EQ.H5O_TYPE_DATASET_F)THEN
WRITE(*,'(A," (Dataset)")') TRIM(name_string)
ELSE IF(info%type.EQ.H5O_TYPE_NAMED_DATATYPE_F)THEN
WRITE(*,'(A," (Datatype)")') TRIM(name_string)
ELSE
WRITE(*,'(A," (Unknown)")') TRIM(name_string)
ENDIF
ENDIF
op_func = 0 ! return successful
END FUNCTION op_func
END MODULE g_intermediate
!************************************************************
!
! Operator function to be called by H5Ovisit.
!
!************************************************************
PROGRAM main
USE HDF5
USE ISO_C_BINDING
USE g_intermediate
IMPLICIT NONE
CHARACTER(LEN=22), PARAMETER :: filename = "h5ex_g_intermediate.h5"
INTEGER(HID_T) :: file
INTEGER(HID_T) :: group
INTEGER(HID_T) :: lcpl
INTEGER :: status
TYPE(C_FUNPTR) :: funptr
TYPE(C_PTR) :: f_ptr
INTEGER :: ret_value
!
! Initialize FORTRAN interface.
!
CALL H5open_f(status)
file = H5I_INVALID_HID_F
group = H5I_INVALID_HID_F
lcpl = H5I_INVALID_HID_F
!
! Create a new file using the default properties.
!
CALL H5Fcreate_f(filename, H5F_ACC_TRUNC_F, file, status)
!
! Create link creation property list and set it to allow creation
! of intermediate groups.
!
CALL H5Pcreate_f(H5P_LINK_CREATE_F, lcpl, status)
CALL H5Pset_create_inter_group_f(lcpl, 1, status)
!
! Create the group /G1/G2/G3. Note that /G1 and /G1/G2 do not
! exist yet. This call would cause an error if we did not use the
! previously created property list.
!
CALL H5Gcreate_f(file, "/G1/G2/G3", group, status, lcpl_id=lcpl)
!
! Print all the objects in the files to show that intermediate
! groups have been created. See h5ex_g_visit_f for more information
! on how to use H5Ovisit_f.
!
WRITE(*,'(A)') "Objects in the file:"
funptr = C_FUNLOC(op_func)
f_ptr = C_NULL_PTR
CALL H5Ovisit_f(file, H5_INDEX_NAME_F, H5_ITER_NATIVE_F, funptr, f_ptr, ret_value, status)
!
! Close and release resources.
!
CALL H5Pclose_f(lcpl, status)
CALL H5Gclose_f(group, status)
CALL H5Fclose_f(file, status)
END PROGRAM main
|
