PROGRAM test
  ! USE mpi
  IMPLICIT NONE 
  INCLUDE 'mpif.h' 
  
  INTEGER :: blocklen(2), types(2), newtype, real_size, dp_size, myrank, ierr
  INTEGER(KIND=MPI_ADDRESS_KIND) :: disp(2), lb, extent, addr1, addr2
  INTEGER(KIND=MPI_ADDRESS_KIND) :: align_dp_seq, align_dp_bind, align_dp_mpi
 
  type :: seq_r_d
     sequence
     real :: r
     double precision :: d
  end type
 
  type :: seq_d_r
     sequence
     double precision :: d
     real :: r
  end type
 
  type, bind(c) :: bind_r_d
     real :: r
     double precision :: d
  end type
 
  type, bind(c) :: bind_d_r
     double precision :: d
     real :: r
  end type

  type(seq_r_d), target :: seq_rd(4)
  type(seq_d_r), target :: seq_dr(4)
  type(bind_r_d), target :: bind_rd(4)
  type(bind_d_r), target :: bind_dr(4)

  CALL MPI_INIT(ierr) 
  CALL MPI_COMM_RANK(MPI_COMM_WORLD, myrank, ierr) 

  IF(myrank==0) THEN 

    PRINT *
    CALL MPI_TYPE_SIZE(MPI_REAL, real_size, ierr) 
    CALL MPI_TYPE_SIZE(MPI_DOUBLE_PRECISION, dp_size, ierr) 
    PRINT *, 'Size of one Fortran REAL             = ', real_size
    PRINT *, 'Size of one Fortran DOUBLE PRECISION = ', dp_size

    PRINT *
    PRINT *, 'Checking alignment for sequence types:::::::::::::'
    PRINT *
    PRINT *, 'Displacement of second item for sequence type of (real, double):'
    CALL MPI_GET_ADDRESS(seq_rd(1)%r, addr1, ierr) 
    CALL MPI_GET_ADDRESS(seq_rd(1)%d, addr2, ierr) 
    PRINT *, '   The address difference is', addr2-addr1, ' = D.P. alignment in sequence derived types'
    align_dp_seq = addr2 - addr1 
    PRINT *, 'Array stride for sequence of (real, double):'
    CALL MPI_GET_ADDRESS(seq_rd(1), addr1, ierr) 
    CALL MPI_GET_ADDRESS(seq_rd(2), addr2, ierr) 
    PRINT *, '   The address difference is', addr2-addr1
  
    PRINT *
    PRINT *, 'Displacement of second item for sequence type of (double, real):'
    CALL MPI_GET_ADDRESS(seq_dr(1)%d, addr1, ierr) 
    CALL MPI_GET_ADDRESS(seq_dr(1)%r, addr2, ierr) 
    PRINT *, '   The address difference is', addr2-addr1
    PRINT *, 'Array stride for sequence of (double, real):'
    CALL MPI_GET_ADDRESS(seq_dr(1), addr1, ierr) 
    CALL MPI_GET_ADDRESS(seq_dr(2), addr2, ierr) 
    PRINT *, '   The address difference is', addr2-addr1

    PRINT *
    PRINT *, 'Checking alignment for bind(C) types:::::::::::::'
    PRINT *
    PRINT *, 'Displacement of second item for bind(C) type of (real, double):'
    CALL MPI_GET_ADDRESS(bind_rd(1)%r, addr1, ierr) 
    CALL MPI_GET_ADDRESS(bind_rd(1)%d, addr2, ierr) 
    PRINT *, '   The address difference is', addr2-addr1, ' = D.P. alignment in bind(C) derived types'
    align_dp_bind = addr2 - addr1 
    PRINT *, 'Array stride for bind(C) of (real, double):'
    CALL MPI_GET_ADDRESS(bind_rd(1), addr1, ierr) 
    CALL MPI_GET_ADDRESS(bind_rd(2), addr2, ierr) 
    PRINT *, '   The address difference is', addr2-addr1
  
    PRINT *
    PRINT *, 'Displacement of second item for bind(C) type of (double, real):'
    CALL MPI_GET_ADDRESS(bind_dr(1)%d, addr1, ierr) 
    CALL MPI_GET_ADDRESS(bind_dr(1)%r, addr2, ierr) 
    PRINT *, '   The address difference is', addr2-addr1
    PRINT *, 'Array stride for bind(C) of (double, real):'
    CALL MPI_GET_ADDRESS(bind_dr(1), addr1, ierr) 
    CALL MPI_GET_ADDRESS(bind_dr(2), addr2, ierr) 
    PRINT *, '   The address difference is', addr2-addr1
  
    disp(1) = 0
    disp(2) = 8
    blocklen(1) = 1
    blocklen(2) = 1
    types(1) = MPI_DOUBLE_PRECISION
    types(2) = MPI_REAL
    CALL MPI_TYPE_CREATE_STRUCT(2, blocklen, disp, types, newtype, ierr)
    CALL MPI_TYPE_COMMIT(newtype, ierr) 
    CALL MPI_TYPE_GET_EXTENT(newtype, lb, extent, ierr)
    PRINT *
    PRINT *, 'MPI_TYPE_GET_EXTENT of Fortran (double precision, real) is ',extent 
    PRINT *, 'This implies an alignment(MPI_DOUBLE_PRECISION) = ',extent-8 
    align_dp_mpi = extent-8 
    PRINT *, '(according to k_i in MPI-2.2, page 78, line 45 and page 96, line 42)' 
 
    PRINT *
    PRINT *, 'Results, aligments of:'
    PRINT *, '- DOUBLE PRECISION within a SEQUENCE derived type = ',align_dp_seq
    PRINT *, '- DOUBLE PRECISION within a BIND(C)  derived type = ',align_dp_bind
    PRINT *, '- MPI_DOUBLE_PRECISION (= k_i in MPI-2.2 p.78:45) = ',align_dp_mpi
    PRINT *, 'Size of one Fortran REAL             = ', real_size
    PRINT *, 'Size of one Fortran DOUBLE PRECISION = ', dp_size
    PRINT * 

  ENDIF 
 
  CALL MPI_FINALIZE(ierr) 
END 
