PROGRAM main
    USE double
    USE mpi
    IMPLICIT NONE
    INTEGER :: myrank, iorank, error

    CALL MPI_Init(error)
    CALL MPI_Comm_rank(MPI_COMM_WORLD,myrank,error)
    CALL Ioprocess(MPI_COMM_WORLD,iorank)
    IF (iorank == MPI_UNDEFINED) THEN
        WRITE (*,"('Rank ',I0,' thinks no process can do I/O')") myrank
    ELSE
        WRITE (*,"('Rank ',I0,' thinks the I/O process is ',I0)") &
            myrank,iorank
    ENDIF
    CALL MPI_Finalize(error)

CONTAINS

    SUBROUTINE Ioprocess (comm, rank)
        INTEGER, INTENT(IN) :: comm
        INTEGER, INTENT(OUT) :: rank
        INTEGER :: myrank, error1, error2
        INTEGER(KIND=MPI_ADDRESS_KIND) :: result
        LOGICAL :: flag
        
        CALL MPI_Comm_rank(comm,myrank,error1)
        CALL MPI_Comm_get_attr(MPI_COMM_SELF,MPI_IO,result,flag,error2)
        IF (error1 /= MPI_SUCCESS .OR. error2 /= MPI_SUCCESS .OR.    &
                .NOT. flag) THEN
            myrank = HUGE(myrank)
        ELSE IF (result == MPI_ANY_SOURCE) THEN
            myrank = 0
        ELSE IF (result < 0 .OR. result == MPI_PROC_NULL) THEN
            myrank = HUGE(myrank)
        END IF
        CALL MPI_Allreduce(myrank,rank,1,MPI_INTEGER,MPI_MIN,comm,error1)
        IF (rank == HUGE(rank) .OR. error1 /= MPI_SUCCESS)    &
             rank = MPI_UNDEFINED
    END SUBROUTINE Ioprocess

END PROGRAM main
