PROGRAM main
    USE double
    USE mpi
    IMPLICIT NONE
    INTEGER, PARAMETER :: root = 1, tag = 123
    INTEGER :: nprocs, myrank, total, sizes(4), mysize, error, i, n
    CHARACTER(LEN=1024) :: buffer
    INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status
    REAL(KIND=DP), DIMENSION(:), ALLOCATABLE :: source, result

    CALL MPI_Init(error)
    CALL MPI_Buffer_attach(buffer,1024,error)
    CALL MPI_Comm_size(MPI_COMM_WORLD,nprocs,error)
    IF (nprocs /= 4) 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/mixed.input",ACTION="READ")
        READ (11,*) sizes
        total = SUM(sizes)
        ALLOCATE(source(total))
        READ (11,*) source
        CLOSE(11)
    END IF

! Note that there are many ways of doing the scatter using point-to-point.
    IF (myrank == root) THEN
        n = 1
        DO i = 1,4
            CALL MPI_Bsend(source(n),sizes(i),    &
                MPI_DOUBLE_PRECISION,i-1,tag,MPI_COMM_WORLD,error)
            n = n+sizes(i)
        END DO
    END IF
    CALL MPI_Probe(root,tag,MPI_COMM_WORLD,status,error)
    CALL MPI_Get_count(status,MPI_DOUBLE_PRECISION,mysize,error)
    ALLOCATE(result(mysize))
    CALL MPI_Recv(result,mysize,MPI_DOUBLE_PRECISION,root,tag,    &
        MPI_COMM_WORLD,status,error)
    WRITE (*,"('Processor ',I0,' now has data',100(1X,F0.3))") myrank,result
    i = 1024
    CALL MPI_Buffer_detach(buffer,i,error)
    CALL MPI_Finalize(error)
END PROGRAM main
