!
! 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 
     
 

