1! This is the F2003 version of the h5_compound.c example source code.
2! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
3! Copyright by The HDF Group.                                               *
4! Copyright by the Board of Trustees of the University of Illinois.         *
5! All rights reserved.                                                      *
6!                                                                           *
7! This file is part of HDF5.  The full HDF5 copyright notice, including     *
8! terms governing use, modification, and redistribution, is contained in    *
9! the COPYING file, which can be found at the root of the source code       *
10! distribution tree, or in https://support.hdfgroup.org/ftp/HDF5/releases.  *
11! If you do not have access to either file, you may request a copy from     *
12! help@hdfgroup.org.                                                        *
13! * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
14!
15! This example shows how to create a compound data type,
16! write an array which has the compound data type to the file,
17! and read back fields' subsets.
18!
19
20PROGRAM main
21  USE hdf5
22  USE ISO_C_BINDING
23  IMPLICIT NONE
24
25! KIND parameters
26
27  INTEGER, PARAMETER :: int_k1 = SELECTED_INT_KIND(1)  ! This should map to INTEGER*1 on most modern processors
28  INTEGER, PARAMETER :: int_k2 = SELECTED_INT_KIND(4)  ! This should map to INTEGER*2 on most modern processors
29  INTEGER, PARAMETER :: int_k4 = SELECTED_INT_KIND(8)  ! This should map to INTEGER*4 on most modern processors
30  INTEGER, PARAMETER :: int_k8 = SELECTED_INT_KIND(16) ! This should map to INTEGER*8 on most modern processors
31
32  INTEGER, PARAMETER :: r_k4 = SELECTED_REAL_KIND(5)  ! This should map to REAL*4 on most modern processors
33  INTEGER, PARAMETER :: r_k8 = SELECTED_REAL_KIND(10) ! This should map to REAL*8 on most modern processors
34
35! FILES
36
37  CHARACTER(LEN=*), PARAMETER :: H5FILE_NAME = "SDScompound.h5"
38  CHARACTER(LEN=*), PARAMETER :: DATASETNAME = "ArrayOfStructures"
39
40  INTEGER, PARAMETER :: LENGTH = 10
41  INTEGER, PARAMETER :: RANK = 1
42
43!----------------------------------------------------------------
44! First derived-type and dataset
45  TYPE s1_t
46     CHARACTER(LEN=1), DIMENSION(1:13) :: chr
47     INTEGER(KIND=int_k1) :: a
48     REAL(KIND=r_k4) :: b
49     REAL(KIND=r_k8) :: c
50  END TYPE s1_t
51
52  TYPE(s1_t), TARGET :: s1(LENGTH)
53  INTEGER(hid_t) :: s1_tid     ! File datatype identifier
54
55!----------------------------------------------------------------
56! Second derived-type (subset of s1_t)  and dataset
57  TYPE s2_t
58     CHARACTER(LEN=1), DIMENSION(1:13) :: chr
59     REAL(KIND=r_k8) :: c
60     INTEGER(KIND=int_k1) :: a
61  END TYPE s2_t
62
63  type(s2_t), target :: s2(LENGTH)
64  integer(hid_t) :: s2_tid    ! Memory datatype handle
65
66!----------------------------------------------------------------
67! Third "derived-type" (will be used to read float field of s1)
68  INTEGER(hid_t) :: s3_tid   ! Memory datatype handle
69  REAL(KIND=r_k4), TARGET :: s3(LENGTH)
70
71  INTEGER :: i
72  INTEGER(hid_t) :: file, dataset, space
73  !type(H5F_fileid_type) :: file
74  !type(H5D_dsetid_type) :: dataset
75  !type(H5S_spaceid_type) :: space
76  INTEGER(hsize_t) :: DIM(1) = (/LENGTH/)   ! Dataspace dimensions
77  INTEGER(SIZE_T) :: type_size  ! Size of the datatype
78  INTEGER(SIZE_T) :: offset, sizeof_compound
79  INTEGER :: hdferr
80  TYPE(C_PTR) :: f_ptr
81
82  INTEGER(SIZE_T) :: type_sizei  ! Size of the integer datatype
83  INTEGER(SIZE_T) :: type_sizer  ! Size of the real datatype
84  INTEGER(SIZE_T) :: type_sized  ! Size of the double datatype
85  INTEGER(hid_t) :: tid3      ! /* Nested Array Datatype ID	*/
86  INTEGER(HSIZE_T), DIMENSION(1) :: tdims1=(/13/)
87  !
88  ! Initialize FORTRAN interface.
89  !
90
91  CALL h5open_f(hdferr)
92
93  !
94  ! Initialize the data
95  !
96  DO i = 0, LENGTH-1
97     s1(i+1)%chr(1)(1:1) = 'a'
98     s1(i+1)%chr(2)(1:1) = 'b'
99     s1(i+1)%chr(3)(1:1) = 'c'
100     s1(i+1)%chr(4:12)(1:1) = ' '
101     s1(i+1)%chr(13)(1:1) = 'd'
102     s1(i+1)%a = i
103     s1(i+1)%b = i*i
104     s1(i+1)%c = 1./REAL(i+1)
105  END DO
106  !
107  ! Create the data space.
108  !
109  !
110  CALL H5Screate_simple_f(RANK, dim, space, hdferr)
111
112  !
113  ! Create the file.
114  !
115  CALL H5Fcreate_f(H5FILE_NAME, H5F_ACC_TRUNC_F, file, hdferr)
116
117  !
118  ! Create the memory data type.
119  !
120  CALL H5Tcreate_f(H5T_COMPOUND_F, H5OFFSETOF(C_LOC(s1(1)), C_LOC(s1(2))), s1_tid, hdferr)
121
122  CALL h5tarray_create_f(H5T_NATIVE_CHARACTER, 1, tdims1, tid3, hdferr)
123
124  CALL H5Tinsert_f(s1_tid, "chr_name", H5OFFSETOF(C_LOC(s1(1)),C_LOC(s1(1)%chr)),tid3, hdferr)
125  CALL H5Tinsert_f(s1_tid, "a_name", H5OFFSETOF(C_LOC(s1(1)),C_LOC(s1(1)%a)), h5kind_to_type(int_k1,H5_INTEGER_KIND), hdferr)
126  CALL H5Tinsert_f(s1_tid, "c_name", H5OFFSETOF(C_LOC(s1(1)),C_LOC(s1(1)%c)), h5kind_to_type(r_k8,H5_REAL_KIND), hdferr)
127  CALL H5Tinsert_f(s1_tid, "b_name", H5OFFSETOF(C_LOC(s1(1)),C_LOC(s1(1)%b)), h5kind_to_type(r_k4,H5_REAL_KIND), hdferr)
128
129  !
130  ! Create the dataset.
131  !
132  CALL H5Dcreate_f(file, DATASETNAME, s1_tid, space, dataset, hdferr)
133
134  !
135  ! Write data to the dataset
136  !
137
138  f_ptr = C_LOC(s1(1))
139  CALL H5Dwrite_f(dataset, s1_tid, f_ptr, hdferr)
140
141  !
142  ! Release resources
143  !
144  CALL H5Tclose_f(s1_tid, hdferr)
145  CALL H5Sclose_f(space, hdferr)
146  CALL H5Dclose_f(dataset, hdferr)
147  CALL H5Fclose_f(file, hdferr)
148
149  !
150  ! Open the file and the dataset.
151  !
152
153  CALL H5Fopen_f(H5FILE_NAME, H5F_ACC_RDONLY_F, file, hdferr)
154
155  CALL H5Dopen_f(file, DATASETNAME, dataset,hdferr)
156
157  !
158  ! Create a data type for s2
159  !
160  CALL H5Tcreate_f(H5T_COMPOUND_F,  H5OFFSETOF(C_LOC(s2(1)), C_LOC(s2(2))), s2_tid, hdferr)
161
162  CALL H5Tinsert_f(s2_tid, "chr_name", H5OFFSETOF(C_LOC(s2(1)),C_LOC(s2(1)%chr)), tid3, hdferr)
163  CALL H5Tinsert_f(s2_tid, "c_name", H5OFFSETOF(C_LOC(s2(1)),C_LOC(s2(1)%c)), h5kind_to_type(r_k8,H5_REAL_KIND), hdferr)
164  CALL H5Tinsert_f(s2_tid, "a_name", H5OFFSETOF(C_LOC(s2(1)),C_LOC(s2(1)%a)), h5kind_to_type(int_k1,H5_INTEGER_KIND), hdferr)
165
166  !
167  ! Read two fields c and a from s1 dataset. Fields in the file
168  ! are found by their names "c_name" and "a_name".
169  s2(:)%c=-1; s2(:)%a=-1;
170
171
172  f_ptr = C_LOC(s2(1))
173  CALL H5Dread_f(dataset, s2_tid, f_ptr, hdferr)
174
175  !
176  ! Display the fields
177  !
178  DO i = 1, length
179     WRITE(*,'(/,A,/,999(A,1X))') "Field chr :", s2(i)%chr(1:13)(1:1)
180  ENDDO
181  WRITE(*,'(/,A,/,999(F8.4,1X))') "Field c :", s2(:)%c
182  WRITE(*,'(/,A,/,999(I0,1X))') "Field a :", s2(:)%a
183  !
184  ! Create a data type for s3.
185  !
186  CALL H5Tcreate_f(H5T_COMPOUND_F, H5OFFSETOF(C_LOC(s3(1)),C_LOC(s3(2))),s3_tid, hdferr)
187
188  CALL H5Tinsert_f(s3_tid, "b_name", 0_size_t, h5kind_to_type(r_k4,H5_REAL_KIND), hdferr)
189  !
190  ! Read field b from s1 dataset. Field in the file is found by its name.
191  !
192  s3(:)=-1
193  f_ptr = C_LOC(s3(1))
194  CALL H5Dread_f(dataset, s3_tid, f_ptr, hdferr)
195  !
196  ! Display the field
197  !
198  WRITE(*,'(/,A,/,999(F8.4,1X))') "Field b :",s3(:)
199  !
200  ! Release resources
201  !
202  CALL H5Tclose_f(s2_tid, hdferr)
203  CALL H5Tclose_f(s3_tid, hdferr)
204  CALL H5Dclose_f(dataset, hdferr)
205  CALL H5Fclose_f(file, hdferr)
206
207END PROGRAM main
208