! ! This is just a concept demonstration :-) ! This is an example of the parallel Fortran HDF5 program for 4 processes. ! Program creates a dataset that is one dimensional array of ! structures { ! character*2 ! integer ! double precision ! real ! } ! Data is written by fields. Each process writes one field. Then real field ! is read by 4 processes each reading its own hyperslab. ! PROGRAM COMPOUNDEXAMPLE USE HDF5 ! Required module include 'mpif.h' IMPLICIT NONE CHARACTER(LEN=11), PARAMETER :: filename = "compound.h5" ! File name CHARACTER(LEN=8), PARAMETER :: dsetname = "Compound" ! Dataset name INTEGER, PARAMETER :: dimsize = 16 ! Size of the dataset, any size that ! is multiple of 4 will work. ! ! Necessary MPI definitions ! INTEGER :: mpierror ! MPI error flag INTEGER :: comm ! MPI communicator object INTEGER :: info ! MPI info object INTEGER :: mpi_size, mpi_rank ! ! Program variables ! INTEGER(HID_T) :: file_id ! File identifier INTEGER(HID_T) :: dset_id ! Dataset identifier INTEGER(HID_T) :: dspace_id ! Dataspace identifier INTEGER(HID_T) :: dtype_id ! Compound datatype identifier INTEGER(HID_T) :: dt1_id ! Memory datatype identifier (for character field) INTEGER(HID_T) :: dt2_id ! Memory datatype identifier (for integer field) INTEGER(HID_T) :: dt3_id ! Memory datatype identifier (for double precision field) INTEGER(HID_T) :: dt4_id ! Memory datatype identifier (for real field) INTEGER(HID_T) :: dt5_id ! Memory datatype identifier INTEGER(HID_T) :: plist_id ! Dataset trasfer property INTEGER(HID_T) :: plac_id ! File access property INTEGER(SIZE_T) :: typesize INTEGER(HSIZE_T), DIMENSION(1) :: dims = (/dimsize/) ! Dataset dimensions INTEGER :: rank = 1 ! Dataset rank INTEGER :: error ! Error flag INTEGER(SIZE_T) :: type_size ! Size of the datatype INTEGER(SIZE_T) :: type_sizec ! Size of the character datatype INTEGER(SIZE_T) :: type_sizei ! Size of the integer datatype INTEGER(SIZE_T) :: type_sized ! Size of the double precision datatype INTEGER(SIZE_T) :: type_sizer ! Size of the real datatype INTEGER(SIZE_T) :: offset ! Member's offset CHARACTER(LEN=2), DIMENSION(dimsize) :: char_member CHARACTER(LEN=2), DIMENSION(dimsize) :: char_member_out ! Buffer to read data out INTEGER, DIMENSION(dimsize) :: int_member DOUBLE PRECISION, DIMENSION(dimsize) :: double_member REAL, DIMENSION(dimsize) :: real_member INTEGER :: i INTEGER(HSIZE_T), DIMENSION(1) :: data_dims ! ! MPI initialization calls ! comm = MPI_COMM_WORLD info = MPI_INFO_NULL CALL MPI_INIT(mpierror) CALL MPI_COMM_SIZE(comm, mpi_size, mpierror) CALL MPI_COMM_RANK(comm, mpi_rank, mpierror) ! ! Check that exactly 4 processes were given; exit otherswise. ! if (mpi_size .ne. 4) then if (mpi_rank .eq. 0) then write(*,*) "Number of processes should be 4 instead of ", mpi_size write(*,*) "Exiting..." endif goto 1000 endif data_dims(1) = dimsize ! ! Each process initializes its own data ! do i = 1, dimsize if (mpi_rank .eq. 0) then char_member(i)(1:1) = char(65+i) char_member(i)(2:2) = char(65+i) endif if (mpi_rank .eq. 1) then int_member(i) = i endif if (mpi_rank .eq. 2) then double_member(i) = 2.* i endif if (mpi_rank .eq. 3) then real_member(i) = 3. * i endif enddo ! ! All processes initialize FORTRAN interface, create a file, compound datatype, ! create a dataset with the compound datatype, create memory datatypes. ! Those are collective calls. Writing will be done with the default property ! (INDEPENDENT) ! CALL h5open_f(error) ! ! Set parallel access to the file ! CALL h5pcreate_f(H5P_FILE_ACCESS_F, plac_id, error) CALL h5pset_fapl_mpio_f(plac_id, comm, info, error) ! ! Set dataset transfer property to preserve partially initialized fields ! during write/read to/from dataset with compound datatype. ! CALL h5pcreate_f(H5P_DATASET_XFER_F, plist_id, error) CALL h5pset_preserve_f(plist_id, .TRUE., error) CALL h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, error) ! CALL h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_INDEPENDENT_F, error) ! ! Create a new file using parallel access property. ! CALL h5fcreate_f(filename, H5F_ACC_TRUNC_F, file_id, error, access_prp = plac_id) ! ! Create the dataspace. ! CALL h5screate_simple_f(rank, dims, dspace_id, error) ! ! Create compound datatype. ! ! First calculate total size by calculating sizes of each member ! CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, error) typesize = 2 CALL h5tset_size_f(dt5_id, typesize, error) CALL h5tget_size_f(dt5_id, type_sizec, error) CALL h5tget_size_f(H5T_NATIVE_INTEGER, type_sizei, error) CALL h5tget_size_f(H5T_NATIVE_DOUBLE, type_sized, error) CALL h5tget_size_f(H5T_NATIVE_REAL, type_sizer, error) type_size = type_sizec + type_sizei + type_sized + type_sizer CALL h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, error) ! ! Insert memebers ! ! CHARACTER*2 memeber ! offset = 0 CALL h5tinsert_f(dtype_id, "char_field", offset, dt5_id, error) ! ! INTEGER member ! offset = offset + type_sizec ! Offset of the second memeber is 2 CALL h5tinsert_f(dtype_id, "integer_field", offset, H5T_NATIVE_INTEGER, error) ! ! DOUBLE PRECISION member ! offset = offset + type_sizei ! Offset of the third memeber is 6 CALL h5tinsert_f(dtype_id, "double_field", offset, H5T_NATIVE_DOUBLE, error) ! ! REAL member ! offset = offset + type_sized ! Offset of the last member is 14 CALL h5tinsert_f(dtype_id, "real_field", offset, H5T_NATIVE_REAL, error) ! ! Create the dataset with compound datatype. ! CALL h5dcreate_f(file_id, dsetname, dtype_id, dspace_id, & dset_id, error) ! ! Create memory types. We have to create a compound datatype ! for each member we want to write. ! CALL h5tcreate_f(H5T_COMPOUND_F, type_sizec, dt1_id, error) offset = 0 CALL h5tinsert_f(dt1_id, "char_field", offset, dt5_id, error) ! CALL h5tcreate_f(H5T_COMPOUND_F, type_sizei, dt2_id, error) offset = 0 CALL h5tinsert_f(dt2_id, "integer_field", offset, H5T_NATIVE_INTEGER, error) ! CALL h5tcreate_f(H5T_COMPOUND_F, type_sized, dt3_id, error) offset = 0 CALL h5tinsert_f(dt3_id, "double_field", offset, H5T_NATIVE_DOUBLE, error) ! CALL h5tcreate_f(H5T_COMPOUND_F, type_sizer, dt4_id, error) offset = 0 CALL h5tinsert_f(dt4_id, "real_field", offset, H5T_NATIVE_REAL, error) ! ! Each process writes its own data ! ! if (mpi_rank .eq. 3) then CALL h5dwrite_f(dset_id, dt4_id, real_member, data_dims, error, xfer_prp = plist_id) endif if (mpi_rank .eq. 0) then CALL h5dwrite_f(dset_id, dt1_id, char_member, data_dims, error, xfer_prp = plist_id) endif if (mpi_rank .eq. 2) then CALL h5dwrite_f(dset_id, dt3_id, double_member, data_dims, error, xfer_prp = plist_id) endif if (mpi_rank .eq. 1) then CALL h5dwrite_f(dset_id, dt2_id, int_member, data_dims, error, xfer_prp = plist_id) endif ! ! End access to the dataset and release resources used by it. ! CALL h5dclose_f(dset_id, error) ! ! Terminate access to the data space. ! CALL h5sclose_f(dspace_id, error) ! ! Terminate access to the datatype ! CALL h5tclose_f(dtype_id, error) CALL h5tclose_f(dt1_id, error) CALL h5tclose_f(dt2_id, error) CALL h5tclose_f(dt3_id, error) CALL h5tclose_f(dt4_id, error) CALL h5tclose_f(dt5_id, error) CALL h5pclose_f(plist_id, error) CALL h5pclose_f(plac_id, error) ! ! Close the file. ! CALL h5fclose_f(file_id, error) 1000 continue CALL MPI_FINALIZE(mpierror) END PROGRAM COMPOUNDEXAMPLE