program cartesian

implicit none

  INCLUDE "mpif.h"

  INTEGER :: world_rank, row_rank, col_rank, cart_rank
  INTEGER :: nprocs, row_size, col_size
  INTEGER :: dims(2), coords(2)
  LOGICAL :: period(2), sub_coords(2)
  INTEGER :: src_rank, dst_rank
  INTEGER :: sum, temp
  REAL :: avg

  INTEGER :: cart_grid, cart_row, cart_col, status, ierr

  !$ MPI Initialization
  CALL MPI_Init(ierr)
  CALL MPI_Comm_size(MPI_COMM_WORLD, nprocs, ierr)
  CALL MPI_Comm_rank(MPI_COMM_WORLD, world_rank, ierr)

  !$ Cartesian grid creation
  dims(1) = 0
  dims(2) = 0
  period(1) = .true.
  period(2) = .true.

  ... call MPI_Dims_create to get grid dimensions
  ... call MPI_Cart_create to create new topology

  !$ Local world_rank initialization and comparison to global world_rank
  ... call MPI_Comm_rank to get cartesian rank

  WRITE (*,'(a,i1,a,i1,a)') 'I am world_rank ', world_rank, ' in MPI_COMM_WORLD and world_rank ', &
                               & cart_rank , ' in the cartesian communicator'

  !$ Coordinates creation and neighbour communication
  ... call MPI_Cart_coords to get process coordinates

  !$ Communication south
  sum = world_rank
  ... call MPI_Cart_shift to prepare south-ward communication
  ... call MPI_Sendrecv to send world_rank and get temp from neighbour
  sum = sum + temp

  !$ Communication north
  ... call MPI_Cart_shift to prepare north-ward communication
  ... call MPI_Sendrecv to send world_rank and get temp from neighbour
    sum = sum + temp

  !$ Communication east
  ... call MPI_Cart_shift to prepare east-ward communication
  ... call MPI_Sendrecv to send world_rank and get temp from neighbour
  sum = sum + temp

  !$ Communication west
  ... call MPI_Cart_shift to prepare west-ward communication
  ... call MPI_Sendrecv to send world_rank and get temp from neighbour
  sum = sum + temp

  !$ Neighbour's average
  avg = REAL(sum)/5
  WRITE (*,'(a,i2,a,i1,a,i1,a,f6.2)') 'Cart rank ', cart_rank, ' (', coords(1), ', ', coords(2), &
       '), neighbours average: ', avg

  !$ Row sub-communicator creation
  sum = 0
  ... call MPI_Cart_sub to create row sub-spaces
  ... call MPI_Comm_size and MPI_Comm_rank to get size and rank in sub-space

  !$ Row sub-communicator's average calculation
  ... call MPI_Reduce to sum-up world ranks in sub-space

  if (row_rank.eq.0) then
    avg = REAL(sum) /row_size
    WRITE (*,'(a,i1,a,f6.2)') 'Row ',coords(1),' row average: ',avg
  endif

  !$ Column sub-communicator creation
  sum = 0
  ... call MPI_Cart_sub to create column sub-spaces
  ... call MPI_Comm_size and MPI_Comm_rank to get size and rank in sub-space

  !$ Column sub-communicator's average calculation
  ... call MPI_Reduce to sum-up world ranks in sub-space

  if (col_rank.eq.0) then
    avg = REAL(sum) / col_size
    WRITE (*,'(a,i1,a,f6.2)') 'Column ',coords(2),' column average: ',avg
  endif

  !$ Finalization operations
  CALL MPI_Comm_free(cart_grid, ierr)
  CALL MPI_Comm_free(cart_col, ierr)
  CALL MPI_Comm_free(cart_row, ierr)
  CALL MPI_Finalize(ierr)

end program cartesian