PROGRAM Main
    USE MPI
    IMPLICIT NONE
    INTEGER :: comm, error
    INTEGER, PARAMETER :: dims(2) = (/ 3, 5 /)
    LOGICAL, PARAMETER :: periodic(2) = .FALSE.

    CALL MPI_Init(error)
    CALL MPI_Cart_create(MPI_COMM_WORLD,2,dims,periodic,.TRUE.,comm,error)
    CALL Display(2,comm)
    CALL MPI_Finalize(error)

CONTAINS

    SUBROUTINE Display (ndims, comm)
        IMPLICIT NONE
        INTEGER, INTENT(IN) :: ndims, comm
        INTEGER :: topo, rank_a, rank_b, n, dims(2), coords(2), error
        LOGICAL :: periodicities(2)
        CHARACTER(LEN=*), PARAMETER :: format =    &
            '("Rank ",I2," is rank ",I2," in dims ",I0,",",I0,    &
                &" and periodic ",L1,",",L1,", with coords ",I0,",",I0)'

        CALL MPI_Comm_rank(MPI_COMM_WORLD,rank_a,error)
        IF (comm == MPI_COMM_NULL) THEN
            PRINT '("Rank ",I2," is not involved")', rank_a
        ELSE
            CALL MPI_Topo_test(comm,topo,error)
            IF (topo /= MPI_CART) THEN
                PRINT *, "The topology is not Cartesian"
                CALL MPI_Abort(MPI_COMM_WORLD,1,error)
            END IF
            CALL MPI_Cartdim_get(comm,n,error)
            IF (n /= ndims) THEN
                PRINT *, "The topology is not 2-D"
                CALL MPI_Abort(MPI_COMM_WORLD,1,error)
            END IF
            CALL MPI_Comm_rank(comm,rank_b,error)
            CALL MPI_Cart_get(comm,ndims,dims,periodicities,coords,error)
            PRINT format, rank_a, rank_b, dims, periodicities, coords
        END IF
    END SUBROUTINE Display

END PROGRAM Main