PROGRAM main
    USE double
    USE mpi
    IMPLICIT NONE
    INTEGER, PARAMETER :: size = 5, root = 1, tag = 123
    INTEGER :: nprocs, myrank, error, i
    INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status
    REAL(KIND=DP), DIMENSION(size) :: array

    array = 0.0_DP

    CALL MPI_Init(error)
    CALL MPI_Comm_size(MPI_COMM_WORLD,nprocs,error)
    CALL MPI_Comm_rank(MPI_COMM_WORLD,myrank,error)
    IF (myrank == root) THEN
        OPEN (11,FILE="Programs/reals.input",ACTION="READ")
        READ (11,*) array
        CLOSE(11)
    END IF
    IF (myrank == root) THEN
        DO i = 0,nprocs-1
            IF (i /= myrank)    &
                CALL MPI_Ssend(array,size,MPI_DOUBLE_PRECISION,    &
                    i,tag,MPI_COMM_WORLD,error)
        END DO
    ELSE
        CALL MPI_Recv(array,size,MPI_DOUBLE_PRECISION,    &
            root,tag,MPI_COMM_WORLD,status,error)
    END IF
    WRITE (*,"('Processor ',I0,' now has data',100(1X,F0.3))") myrank,array
    CALL MPI_Finalize(error)
END PROGRAM main
