! -*- mode: F90 ; mode: font-lock ; column-number-mode: true  -*-
program mpi_ring
  use mpi_f08
  implicit none

  integer :: my_rank, num_procs
  type(MPI_status)  :: send_status,recv_status
  type(MPI_request) :: send_request,recv_request
  integer :: left_rank, right_rank, left_tag, right_tag, send_tag
  integer :: i,ierror

  real, dimension (1:2) :: r0,r_left,r_right,dr
  real :: local_energy, energy

  logical :: debug=.false.

  !initialise MPI world
  call MPI_init(ierror)
  if (ierror/=MPI_success) stop 'Error in MPI_init'

  !get size (total number of processors) within MPI world
  call MPI_comm_size(MPI_comm_world,num_procs,ierror)
  if (ierror/=MPI_success) stop 'Error in MPI_comm_size'
  if (num_procs/=4) stop 'Error - wrong number of processors - hardwired for 4'

  !get my rank on each different processor within MPI world (0 to num_procs-1)
  call MPI_comm_rank(MPI_comm_world,my_rank,ierror)
  if (ierror/=MPI_success) stop 'Error in MPI_comm_rank'

  !initialise data on all processors
  r_left=0.0
  r_right=0.0
  local_energy=0.0
  energy=0.0

  select case (my_rank)
  case (0)
     r0(:)=(/0.0,0.0/)
  case (1)
     r0(:)=(/1.0,1.0/)
  case (2)
     r0(:)=(/0.5,0.5/)
  case (3)
     r0(:)=(/0.2,0.7/)
  case default
     stop 'Error - wrong number of processors - hardwired for 4'
  end select

  !report to user?
  if (debug) then
     do i=0,num_procs-1
        if (i==my_rank) then
           print *,'On processor',my_rank,'r0=',r0(:)
        end if
        call MPI_barrier(MPI_comm_world,ierror)
        if (ierror/=MPI_success) stop 'Error in MPI_barrier in initial r0 print'
     end do
  end if

  !sort out send and receive ranks using periodic BCs
  right_rank=my_rank+1
  if (right_rank>=num_procs) right_rank=right_rank-num_procs
  left_rank =my_rank-1
  if (left_rank<0) left_rank=left_rank+num_procs
  left_tag=17
  right_tag=17
  send_tag=17

  !report to user?
  if (debug) then
     do i=0,num_procs-1
        if (i==my_rank) then
           print *,'On processor',my_rank,'right_rank=',right_rank,'left_rank=',left_rank
        end if
        call MPI_barrier(MPI_comm_world,ierror)
        if (ierror/=MPI_success) stop 'Error in MPI_barrier in initial rank print'
     end do
  end if

  !Clockwise comms:
  !send to the left ...
  call MPI_isend(r0(1),2,MPI_real,left_rank,send_tag,MPI_COMM_WORLD,send_request,ierror)
  if (ierror/=MPI_success) stop 'Error in MPI_issend clockwise'
  !and receive from the right ...
  call MPI_irecv(r_right(1),2,MPI_real,right_rank,right_tag,MPI_COMM_WORLD,recv_request,ierror)
  if (ierror/=MPI_success) stop 'Error in MPI_irecv clockwise'
  !cautious approach - wait for all clockwise comms to complete
  call MPI_wait(send_request,send_status,ierror)
  if (ierror/=MPI_success) stop 'Error in MPI_wait clockwise'
  call MPI_wait(recv_request,send_status,ierror)
  if (ierror/=MPI_success) stop 'Error in MPI_wait clockwise'

  !calculate contribution to local energy on this node from this pair
  dr=r0-r_right
  local_energy=0.5*dot_product(dr,dr)

  !Anti-Clockwise comms:
  !send to the right ...
  call MPI_isend(r0(1),2,MPI_real,right_rank,send_tag,MPI_COMM_WORLD,send_request,ierror)
  if (ierror/=MPI_success) stop 'Error in MPI_issend anti-clockwise'
  !and receive from the left ...
  call MPI_irecv(r_left(1),2,MPI_real,left_rank,left_tag,MPI_COMM_WORLD,recv_request,ierror)
  if (ierror/=MPI_success) stop 'Error in MPI_irecv anti-clockwise'
  !cautious approach - wait for all anti-clockwise comms to complete
  call MPI_wait(send_request,send_status,ierror)
  if (ierror/=MPI_success) stop 'Error in MPI_wait anti-clockwise'
  call MPI_wait(recv_request,send_status,ierror)
  if (ierror/=MPI_success) stop 'Error in MPI_wait anti-clockwise'

  !calculate contribution to local energy on this node from this pair
  dr=r0-r_left
  local_energy=local_energy+0.5*dot_product(dr,dr)

  !allow for double counting
  local_energy=local_energy/2.0

  !report to user?
  if (debug) then
     do i=0,num_procs-1
        if (i==my_rank) then
           print *,'PE:',my_rank,'r0=',r0
           print *,'PE:',my_rank,'r_left=',r_left
           print *,'PE:',my_rank,'r_right=',r_right
           print *,'PE:',my_rank,'local energy=',local_energy
        end if
        call MPI_barrier(MPI_comm_world,ierror)
        if (ierror/=MPI_success) stop 'Error in MPI_barrier in local_energy print'
     end do
  end if

  !Now reduce local energy to make global energy on root node only
  call MPI_reduce(local_energy,energy,1,MPI_real,MPI_SUM,0,MPI_COMM_WORLD,ierror)
  if (ierror/=MPI_success) stop 'Error in MPI_reduce in global energy calc'


  !Always report final answer to user
  if (my_rank==0) then
     print *,' '
     print *,'Overall total energy=',energy
     print *,' '
  end if

  call mpi_finalize(ierror)

end program mpi_ring
