program complexcompound use hdf5 implicit none ! This is the name of the data file we will read. character (len = 9), parameter :: filename = "cc_res.h5" character (len = 7), parameter :: dsetname1 = "ms_data" ! name of the Ecopath multistanza dataset integer(8), parameter :: arraydim0 = 2 integer(hsize_t), DIMENSION(1) :: arraydims = (/arraydim0/) integer(8), parameter :: arraydim1 = 3 integer(hsize_t), DIMENSION(1) :: arraydims1 = (/arraydim1/) ! in-subroutine variable declarations for ms_data integer , parameter :: ms_dim0 = 2 ! number of stanzas integer(hid_t) :: file_id, plist_id, space, dset ! Handles integer :: hdferr integer(hsize_t), dimension(1:1) :: ms_dims = (/ms_dim0/) integer(hid_t) :: s1_tid, s2_tid, s3_tid, s4_tid integer(hid_t) :: dt1_id, dt2_id, dt3_id integer(8) :: sz1, sz2, sz3, sz, offset type(c_ptr) :: f_ptr type data real(4) :: a(2) real(8) :: b(3) integer :: c end type data type(data), target :: wdata(2) wdata(1)%a = (/1.2, 2.2/) wdata(1)%b = (/3.2, 4.2, 5.2/) wdata(1)%c = 6 wdata(2)%a = (/7.2, 8.2/) wdata(2)%b = (/9.2, 10.2, 11.2/) wdata(2)%c = 12 ! initialize FORTRAN interface call h5open_f(hdferr) call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) call h5pset_preserve_f(plist_id, .TRUE., hdferr) ! create file, if it already exists overwrite (H5F_ACC_TRUNC_F) call h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, hdferr) call h5screate_simple_f(1, ms_dims, space, hdferr) ! create 2 arrays "s1_tid" and "s2_tid" call H5Tarray_create_f(H5T_NATIVE_REAL, 1, arraydims, s1_tid, hdferr) call H5Tarray_create_f(H5T_NATIVE_DOUBLE, 1, arraydims1, s2_tid, hdferr) call H5Tcopy_f(H5T_NATIVE_INTEGER, s4_tid, hdferr) ! get size of each array call H5Tget_size_f(s1_tid, sz1, hdferr) call H5Tget_size_f(s2_tid, sz2, hdferr) call H5Tget_size_f(s4_tid, sz3, hdferr) sz = sz1 + sz2 + sz3 ! create the compound datatype "s3_tid" which will embrace the "s1_tid" and "s2_tid" arrays call H5Tcreate_f(H5T_COMPOUND_F, sz, s3_tid, hdferr) ! insert arrays into the compound datatype offset = 0 call H5Tinsert_f(s3_tid, "a", offset, s1_tid, hdferr) offset = offset + sizeof(wdata(1)%a) call H5Tinsert_f(s3_tid, "b", offset, s2_tid, hdferr) offset = offset + sizeof(wdata(1)%b) call H5Tinsert_f(s3_tid, "c", offset, s4_tid, hdferr) ! Create the dataset and write the array data to it. call h5dcreate_f(file_id, dsetname1, s3_tid, space, dset, hdferr) f_ptr = c_loc(wdata(1)) call h5dwrite_f(dset, s3_tid, f_ptr, hdferr) ! call h5tcreate_f(H5T_COMPOUND_F, sz1, dt1_id, hdferr) ! offset = 0 ! call h5tinsert_f(dt1_id, "a", offset, s1_tid, hdferr) ! call h5tcreate_f(H5T_COMPOUND_F, sz2, dt2_id, hdferr) ! offset = 0 ! call h5tinsert_f(dt2_id, "b", offset, s2_tid, hdferr) ! call h5tcreate_f(H5T_COMPOUND_F, sz3, dt3_id, hdferr) ! offset = 0 ! call h5tinsert_f(dt3_id, "c", offset, s4_tid, hdferr) ! call h5dwrite_f(dset, dt1_id, wdata(1)%a, ms_dims, hdferr, xfer_prp = plist_id) ! call h5dwrite_f(dset, dt2_id, wdata(1)%b, ms_dims, hdferr, xfer_prp = plist_id) ! call h5dwrite_f(dset, dt3_id, wdata(1)%c, ms_dims, hdferr, xfer_prp = plist_id) call h5dclose_f(dset, hdferr) call h5tclose_f(s3_tid, hdferr) call h5sclose_f(space, hdferr) call h5pclose_f(plist_id, hdferr) call h5fclose_f(file_id, hdferr) end program complexcompound