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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
|
!************************************************************
!
! This example shows how to recursively traverse a file
! using H5Ovisit. The program prints all of
! the objects in the file specified in FILE. The default
! file used by this example implements the structure described
! in the User's Guide, chapter 4, figure 26.
!
!************************************************************
MODULE g_visit
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
name_string(:) = " "
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
!************************************************************
!
! Operator function for H5Lvisit_f. This function simply
! retrieves the info for the object the current link points
! to, and calls the operator function for H5Ovisit_f.
!
! ************************************************************/
INTEGER FUNCTION op_func_L(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(H5L_info_t) :: info
TYPE(C_PTR) :: cptr
CHARACTER(LEN=50) :: name_string
INTEGER :: i
INTEGER :: status;
TYPE(H5O_info_t) :: infobuf
TYPE(C_PTR) :: ptr
name_string(:) = " "
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
!
! Get type of the object and display its name and type.
! The name of the object is passed to this function by
! the Library.
!
CALL H5Oget_info_by_name_f(loc_id, name_string, infobuf, status);
op_func_L = op_func(loc_id, name_string, infobuf, cptr)
END FUNCTION op_func_L
END MODULE g_visit
PROGRAM main
USE HDF5
USE ISO_C_BINDING
USE g_visit
IMPLICIT NONE
CHARACTER(LEN=15), PARAMETER :: filename = "h5ex_g_visit.h5"
INTEGER(HID_T) :: file ! Handle
INTEGER :: status
TYPE(C_FUNPTR) :: funptr
TYPE(C_PTR) :: ptr
INTEGER :: ret_value
!
! Initialize FORTRAN interface.
!
CALL h5open_f(status)
CALL H5Fopen_f(filename, H5F_ACC_RDONLY_F, file, status)
!
! Begin iteration using H5Ovisit
!
WRITE(*,'(A)') "Objects in the file:"
funptr = C_FUNLOC(op_func)
ptr = C_NULL_PTR
CALL H5Ovisit_f(file, H5_INDEX_NAME_F, H5_ITER_NATIVE_F, funptr, ptr, ret_value, status)
!
! Repeat the same process using H5Lvisit
!
WRITE(*,'(/,A)') "Links in the file:"
funptr = C_FUNLOC(op_func_L)
ptr = C_NULL_PTR
CALL H5Lvisit_f(file, H5_INDEX_NAME_F, H5_ITER_NATIVE_F, funptr, ptr, ret_value, status)
!
! Close and release resources.
!
CALL H5Fclose_f(file, status)
END PROGRAM main
|
