! michal_ex.f90
include "mpiSim.f90"
program test
include "useSim.f90"
!Posted by Michal at comp.parallel.mpi on 11 May 2007
!- Creates 4, 1D array (of double precision reals): array1, array2,
!array3 and array4. array1 and array2 are the same size as each other,
!and array3 and array4 are the same size of each other
!- Get the addresses for the arrays using MPI_GET_ADDRESS, and prints
!them to the screen
!- Create 2 structures using the addresses. One for array1 and array3,
!and the other for array 2 and array 4. Thus each structure contains
!(potentially) different sized arrays
!- Via an MPI_SENDRECV sends the "array1 and array3" structure to
!"array2 and array4" structure.
!
!If all arrays are of size 10, then the program runs as expected. Also,
!the addresses of the arrays are around 33000.
!
!If all arrays are of size 100000, then the program runs as expected.
!The addresses of all the arrays are around 47906427276288
!
!However, if array1 and array2 are of size 10, while array3 and array4
!are around 100000, then the program exits with a segmentation fault at
!MPI_SENDRECV. The address of the small arrays are around 33000, and
!the addresses of the large arrays are around 47906427276288.
!********************************************************
!  INTEGER, PARAMETER :: mpiReal = MPI_DOUBLE_PRECISION
  INTEGER, PARAMETER :: num = SELECTED_REAL_KIND(Kind(1.d0))
  INTEGER :: err
  INTEGER :: status(MPI_STATUS_SIZE)
  ! For struct creation
  INTEGER, PARAMETER :: numTypes = 2
  INTEGER, DIMENSION(2) :: blockLengths
  INTEGER(KIND=MPI_ADDRESS_KIND), DIMENSION(2):: displacements
  INTEGER, DIMENSION(2) :: oldTypes
  INTEGER :: newType1, newType2
  ! Data
  INTEGER, PARAMETER :: n = 100000
  Real(Kind=num), DIMENSION(:), ALLOCATABLE :: array1
  Real(Kind=num), DIMENSION(:), ALLOCATABLE :: array2
  ! Data
  INTEGER, PARAMETER :: n2 = 100000
  Real(Kind=num), DIMENSION(:), ALLOCATABLE :: array3
  Real(Kind=num), DIMENSION(:), ALLOCATABLE :: array4
  ! Addresses of data
! INTEGER(KIND=MPI_ADDRESS_KIND) :: address1
! INTEGER(KIND=MPI_ADDRESS_KIND) :: address2
! INTEGER(KIND=MPI_ADDRESS_KIND) :: address3
! INTEGER(KIND=MPI_ADDRESS_KIND) :: address4
  INTEGER :: address1
  INTEGER :: address2
  INTEGER :: address3
  INTEGER :: address4
  CALL MPI_INIT(err)
  WRITE(*,*) "Kind of address integer:", MPI_ADDRESS_KIND
  ! Allocate data

  ALLOCATE(array1(n))
  ALLOCATE(array2(n))
  ALLOCATE(array3(n2))
  ALLOCATE(array4(n2))
  ! Initialise data
  array1 = 1.0_num
  array2 = 2.0_num
  array3 = 3.0_num
  array4 = 4.0_num
  ! Get address of data
  CALL MPI_GET_ADDRESS(array1, address1, err)
  CALL MPI_GET_ADDRESS(array2, address2, err)
  CALL MPI_GET_ADDRESS(array3, address3, err)
  CALL MPI_GET_ADDRESS(array4, address4, err)
  WRITE(*,*) "Addresses", address1, address2, address3, address4
  ! Find displacments relative to address1
  displacements(1) = address1 - address1
  displacements(2) = address3 - address1
! If relative to MPI_BOTTOM
!!$  displacements(1) = address1
!!$  displacements(2) = address3
  blockLengths(1) = n
  blockLengths(2) = n2
  oldTypes(1) = DPSim
  oldTypes(2) = DPSim
  CALL MPI_TYPE_STRUCT(2, blockLengths, displacements, oldTypes &
       , newType1, err)
  ! Find displacments relative to address1
  displacements(1) = address2 - address1
  displacements(2) = address4 - address1
! If relative to MPI_BOTTOM
!!$  displacements(1) = address2
!!$  displacements(2) = address4
  CALL MPI_TYPE_STRUCT(2, blockLengths, displacements, oldTypes &
       , newType2, err)
  CALL MPI_TYPE_COMMIT(newType1, err)
  CALL MPI_TYPE_COMMIT(newType2, err)
  CALL MPI_SENDRECV(array1, 1, newType2, 0, 0, array2, 1, newType1, 0, &
                    0, MPI_COMM_WORLD, status, err)
  WRITE(*,*) "Outputs: ", SUM(array1)/(n), SUM(array2)/(n), &
             SUM(array3)/(n2), SUM(array4)/(n2)
  CALL MPI_FINALIZE(err)
END PROGRAM test