PROGRAM main
    USE double
    USE mpi
    IMPLICIT NONE
    INTEGER, PARAMETER :: procs = 4, root = 3, tag = 456
    INTEGER :: nprocs, myrank, error
    INTEGER, DIMENSION(procs,procs) :: source
    INTEGER, DIMENSION(procs) :: one, two

    source = 0.0_DP
    one = 0.0_DP
    two = 0.0_DP
    CALL MPI_Init(error)
    CALL MPI_Comm_size(MPI_COMM_WORLD,nprocs,error)
    IF (nprocs /= procs) THEN
        PRINT *, 'Invalid number of processes'
        CALL MPI_Abort(MPI_COMM_WORLD,1,error)
    END IF

    CALL MPI_Comm_rank(MPI_COMM_WORLD,myrank,error)
    IF (myrank == root) THEN
        OPEN (11,FILE="Programs/integers.input",ACTION="READ")
        READ (11,*) source
        CLOSE(11)
    END IF

    CALL MPI_Scatter(source,procs,MPI_INTEGER,    &
        one,procs,MPI_INTEGER,root,MPI_COMM_WORLD,error)
    WRITE (*,"('Processor ',I0,' first data',100(1X,I0))") myrank,one
    CALL Alltoall(one,1,MPI_INTEGER,two,1,MPI_INTEGER,    &
        MPI_COMM_WORLD,error)
    WRITE (*,"('Processor ',I0,' second data',100(1X,I0))") myrank,two
    CALL MPI_Finalize(error)

CONTAINS

! Calling ALLOCATE every time isn't efficient, but this is just an
! example of the MPI use.

    SUBROUTINE Alltoall (sendbuf, sendcount, sendtype,    &
            recvbuf, recvcount, recvtype, comm, error)
        INTEGER, INTENT(IN) :: sendcount, sendtype, recvcount,    &
            recvtype, comm
        INTEGER, DIMENSION(sendcount,0:*), INTENT(IN) :: sendbuf
        INTEGER, DIMENSION(recvcount,0:*), INTENT(OUT) :: recvbuf
        INTEGER, INTENT(OUT) :: error
        INTEGER :: nprocs, n
        INTEGER, ALLOCATABLE, DIMENSION(:) :: requests
        INTEGER, ALLOCATABLE, DIMENSION(:,:) :: statuses

        CALL MPI_Comm_size(MPI_COMM_WORLD,nprocs,error)
        ALLOCATE(requests(0:2*nprocs-1),    &
            statuses(MPI_STATUS_SIZE,0:2*nprocs-1))
        DO n = 0,nprocs-1
            CALL MPI_Isend(sendbuf(1,n),sendcount,sendtype,n,    &
                tag,comm,requests(n),error)
            CALL MPI_Irecv(recvbuf(1,n),recvcount,recvtype,n,    &
                tag,comm,requests(n+nprocs),error)
        END DO
        CALL MPI_Waitall(2*nprocs,requests,statuses,error)
        DEALLOCATE(requests,statuses)
        error = MPI_SUCCESS
    END SUBROUTINE Alltoall

END PROGRAM main
