PROGRAM main
    USE double
    USE mpi
    IMPLICIT NONE
    INTEGER, PARAMETER :: procs = 4, root = 0, length = 80
    INTEGER :: nprocs, myrank, mysize,    &
        sizes(procs), offsets(procs), error, i
    CHARACTER(LEN=50) :: filename
    CHARACTER(LEN=length) :: buffer, messages(procs)

    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)
    WRITE (filename,"('Programs/textfile.',I0)") myrank
    OPEN (11,file=TRIM(filename),ACTION='READ',STATUS='OLD')
    READ (11,"(A)") buffer
    mysize = LEN(TRIM(buffer))
    CLOSE (11)
    CALL MPI_Gather(mysize,1,MPI_INTEGER,sizes,1,MPI_INTEGER,   &
        root,MPI_COMM_WORLD,error);
    IF (myrank == root) THEN
        DO i = 1,nprocs
            offsets(i) = length*(i-1)
        END DO
    END IF
    CALL MPI_Gatherv(buffer,mysize,MPI_CHARACTER,    &
        messages,sizes,offsets,MPI_CHARACTER,root,MPI_COMM_WORLD,error);
    IF (myrank == root) THEN
        DO i = 1,nprocs
            WRITE (*,"(A)") messages(i)(1:sizes(i))
        END DO
    END IF
    CALL MPI_Finalize(error)

END PROGRAM main
