program main
        include 'mpif.h'


        integer NUM_DIMS
        parameter (NUM_DIMS=2)

        integer ierr
        integer errors, toterrors
        integer comm_temp, comm_cart, new_comm
        integer size, rank, i
        logical periods(NUM_DIMS)
        integer dims(NUM_DIMS)
        integer coords(NUM_DIMS)
        integer new_coords(NUM_DIMS)
        logical remain_dims(NUM_DIMS)
        integer newnewrank
        logical reorder
        integer topo_status
        integer ndims
        integer new_rank

        integer source, dest

        errors=0
        call MPI_INIT (ierr)

        call MPI_COMM_RANK( MPI_COMM_WORLD, rank, ierr)
        call MPI_COMM_SIZE (MPI_COMM_WORLD, size, ierr )

c
c    Clear dims array and get dims for topology 
c
        do 100 i=1,NUM_DIMS
                dims(i)=0
                periods(i)= .false.
100     continue
        call MPI_DIMS_CREATE( size, NUM_DIMS, dims, ierr)

c
c     Make a new communicator with a topology 
c
        reorder = .true.
        call MPI_CART_CREATE( MPI_COMM_WORLD, 2, dims, periods,  
     $          reorder, comm_temp, ierr)
        call MPI_COMM_DUP (comm_temp, comm_cart, ierr)

c
c     Determine the status of the new communicator 
c
        call MPI_TOPO_TEST (comm_cart, topo_status, ierr)
        IF (topo_status .ne. MPI_CART) then
           print *, "Topo_status is not MPI_CART"
           errors=errors+1
        ENDIF

c
c     How many dims do we have? 
c
        call MPI_CARTDIM_GET( comm_cart, ndims, ierr)
        if (ndims .ne. NUM_DIMS ) then
           print *, "ndims (", ndims, ") is not NUM_DIMS (", NUMDIMS,
     $          ")" 
           errors = errors+1
        ENDIF

c
c     Get the topology, does it agree with what we put in? 
c
        do 500 i=1,NUM_DIMS
                dims(i)=0
                periods(i)=.false.
500     continue
        call MPI_CART_GET( comm_cart, NUM_DIMS, dims, periods, coords,
     $       ierr) 
c
c     Does the mapping from coords to rank work? 
c
        call MPI_CART_RANK( comm_cart, coords, new_rank, ierr)
        if (new_rank .ne. rank ) then
           print *, "New_rank = ", new_rank, " is not rank (", rank, ")"
           errors=errors+1
        endif

c
c     Does the mapping from rank to coords work 
c
        call MPI_CART_COORDS( comm_cart, rank, NUM_DIMS, new_coords ,
     $       ierr) 
        do 600 i=1,NUM_DIMS
                if (coords(i) .ne. new_coords(i)) then
                   print *, "coords(",i,") = ", coords(i), " not = ",
     $                  new_coords(i) 
                   errors=errors + 1
                endif
600     continue

c
c     Let's shift in each dimension and see how it works!  
c     Because it's late and I'm tired, I'm not making this 
c     automatically test itself.                          
c
        do 700 i=1,NUM_DIMS
           call MPI_CART_SHIFT( comm_cart, (i-1), 1, source, dest, ierr)
c           print *, '[', rank, '] shifting 1 in the ', (i-1), 
c     $                 ' dimension'
c           print *, '[', rank, ']     source = ', source, 
c     $                 ' dest = ', dest
                
700     continue

c
c     Subdivide 
c
        remain_dims(1)=.false.
        do 800 i=2,NUM_DIMS
                remain_dims(i)=.true.
800     continue
        call MPI_CART_SUB( comm_cart, remain_dims, new_comm, ierr)

c
c     Determine the status of the new communicator 
c
        call MPI_TOPO_TEST( new_comm, topo_status, ierr )
        if (topo_status .ne. MPI_CART ) then
           print *, "Topo_status of new comm is not MPI_CART"
           errors=errors+1
        endif

c
c     How many dims do we have? 
c
        call MPI_CARTDIM_GET( new_comm, ndims, ierr)
        if (ndims .ne. NUM_DIMS-1 ) then
           print *, "ndims (", ndims, ") is not NUM_DIMS-1"
           errors = errors+1
        endif

c
c     Get the topology, does it agree with what we put in? 
c
        do 900 i=1,NUM_DIMS-1
                dims(i)=0
                periods(i)=.false.
900     continue
        call MPI_CART_GET( new_comm, ndims, dims, periods, coords, ierr)
    
c
c     Does the mapping from coords to rank work? 
c
        call MPI_COMM_RANK( new_comm, newnewrank, ierr)
        call MPI_CART_RANK( new_comm, coords, new_rank, ierr)
        if (new_rank .ne. newnewrank ) then
           print *, "New rank (", new_rank, ") is not newnewrank"
           errors=errors+1
        endif

c
c     Does the mapping from rank to coords work 
c
        call MPI_CART_COORDS( new_comm, new_rank, NUM_DIMS-1, new_coords
     $       ,  ierr)
        do 1000 i=1,NUM_DIMS-1
                if (coords(i) .ne. new_coords(i)) then
                   print *, "coords(",i,") = ", coords(i),
     $                  " != new_coords (", new_coords(i), ")"
                   errors=errors+1
                endif
1000    continue

c
c     We're at the end 
c
        call MPI_COMM_FREE( new_comm, ierr)
        call MPI_COMM_FREE( comm_temp, ierr)
        call MPI_COMM_FREE( comm_cart, ierr)
        
c       call Test_Waitforall_( )

        call MPI_ALLREDUCE( errors, toterrors, 1, MPI_INTEGER,
     1                      MPI_SUM, MPI_COMM_WORLD, ierr )
        if (rank .eq. 0) then
           if (toterrors .eq. 0) then
              print *, ' No Errors'
           else
              print *, ' Done with ', toterrors, ' ERRORS!'
           endif
        endif
        call MPI_FINALIZE(ierr)
c          print *, '[', rank, '] done with ', errors, ' ERRORS!'

        end