program main

!-- Create a Cartesian 2D topology and print out the
!   coordinate parameters of each process.

!--Include the mpi header file
      use mpi
      implicit none

      integer i,ierr,rank,my_rank,numprocs,itag,ierror
      integer status(MPI_STATUS_SIZE)
      integer irc

      parameter (ndims=3)    !dimension of the cartesian grid
      integer ndims,dims(ndims)
      integer COMM_CART
      logical periods(ndims),reorder
      integer coords(ndims)

!--Initialize MPI
      call MPI_INIT( ierr )

!--Who am I? --- get my rank=my_rank
      call MPI_COMM_RANK( MPI_COMM_WORLD, my_rank, ierr )

!--How many processes in the global group?
      call MPI_COMM_SIZE( MPI_COMM_WORLD, numprocs, ierr )

!--Create a cartesian topology: must try p=8: 1x2x4
       !dims(1:ndims)=2    ! 2x2 grid of sub-domains
       dims(1)=2    ! 2x2 grid of sub-domains
       dims(2)=2    ! 2x2 grid of sub-domains
       dims(3)=4    ! 2x2 grid of sub-domains
      periods(1)=.true.  ! periodic bdry. cond. along x
      periods(2)=.false. ! non-periodic bdry. cond. along y
      periods(3)=.false. ! non-periodic bdry. cond. along y

      call MPI_CART_CREATE(MPI_COMM_WORLD,ndims,dims,periods, &
                           reorder,COMM_CART,ierror)

!           ----------------------------------------------------------------
!          | MPI_CART_CREATE will provide a 2D cartesian array of processes |
!   ======>| of dimensions 2x2.                                             |
!          | Each process rank is associated with a given sub-domain.       |
!           ---------------------------------------------------------------- 

! --Find and print the coordinate parameters of each process in the 
!   Cartesian topology.

   if (my_rank == 0) then
      print *,"ID[",my_rank,"]:  nprocs = ",numprocs
      print *,"ID[",my_rank,"]:  dims= [",dims,"]"
    do i=1,numprocs
     rank=i-1
     call MPI_CART_COORDS(COMM_CART,rank,3,coords,ierror)
     write(*,fmt='("COORDS of PROC[",i4,"]:  [",3(i4),"]")')  rank,coords
    end do
   end if

!--Finilize MPI
      call MPI_FINALIZE(irc)

      stop
      end