#include "unused_dummy.inc"
!> Easier Fortran90 interface to the MPI Message Passing Library.
!>
!>     (c) Copyright 1991 to 1998 by Michael A. Beer, William D. Dorland,
!>     P. B. Snyder, Q. P. Liu, and Gregory W. Hammett. ALL RIGHTS RESERVED.
!>
!> @note mp_mpi_r8.f90 is a version of mp_mpi.f90 to use when compiling
!> with -r8 (where the default real type is taken to be 8 bytes).  Just
!> replaced all occurances of MPI_REAL with MPI_DOUBLE_PRECISION and
!> MPI_COMPLEX with MPI_DOUBLE_COMPLEX.
module mp
  use, intrinsic :: iso_fortran_env, only : error_unit
#ifdef MPI
# ifndef MPIINC
  use mpi
# endif
#endif
  implicit none

  private

  public :: init_mp, finish_mp
  public :: mp_initialized, timer_local, time_message
  public :: get_mp_times, reset_mp_times
  public :: broadcast, sum_reduce, nb_sum_reduce, sum_allreduce, nb_sum_allreduce
  public :: sum_allreduce_sub, nb_sum_allreduce_sub
  public :: broadcast_sub, sum_reduce_sub, nb_sum_reduce_sub
  public :: max_reduce, max_allreduce, nb_max_allreduce
  public :: min_reduce, min_allreduce, min_allreduce_sub
  public :: maxloc_allreduce
  public :: nproc, iproc, proc0, job
  public :: send, ssend, receive
  public :: send_init, recv_init, start_comm, free_request !For persistent comms
  public :: barrier
  public :: comm_type
  public :: waitany
  public :: mp_comm_self
  public :: mp_undefined, mp_status_size
! JH> new abort method
  public :: mp_abort
! <JH
! MAB> needed by Trinity
  public :: scope, allprocs, subprocs
  public :: all_to_group, group_to_all
! <MAB
 !MRH needed by Multigs2
  public :: multigs2procs
  public :: land_allreduce
  ! EGH: logical used when underusing procs
  public :: included
  public :: split
  public :: free_comm
  public :: wait
  public :: waitall, testall
  public :: nbsend
  public :: nbrecv
  public :: nproc_comm
  public :: rank_comm
  public :: allgatherv, allgather, nb_allgatherv
  public :: init_jobs
  public :: mp_comm
  public :: mp_info, mp_comm_null
!AJ
  public :: initialise_requests
  public :: mp_request_null

  public :: use_nproc
  public :: split_all
  public :: unsplit_all
  public :: get_proc_name
  public :: set_default_error_file_unit

  ! <EGH needed for functional_tests
  public :: grp0

# ifdef MPI
# ifdef MPIINC
! CMR: defined MPIINC for machines where need to include mpif.h
  include 'mpif.h'
#endif
  integer, pointer :: nproc
  integer, target :: ntot_proc, ngroup_proc, mulntot_proc

  integer, pointer :: iproc
  integer, target :: aproc, gproc, mulproc

  logical, pointer :: proc0
  logical, target :: aproc0, gproc0, mulproc0

  integer, parameter :: mp_info = MPI_INFO_NULL
  integer, parameter :: mp_comm_null = MPI_COMM_NULL
  integer, parameter :: mp_request_null = MPI_REQUEST_NULL
  integer, parameter :: mp_comm_self = MPI_COMM_SELF
  integer, parameter :: mp_undefined = MPI_UNDEFINED
  integer, parameter :: mp_status_size = MPI_STATUS_SIZE

  !> Currently active communicator
  integer, pointer :: mp_comm
  !> Communicator for all processors
  integer, target :: comm_all = mp_comm_null
  !> Communicator for ensemble simulations
  integer, target :: comm_group = mp_comm_null
  !> Communicator for multiscale GS2
  integer, target :: comm_multigs2 = mp_comm_null

  integer (kind(MPI_REAL)) :: mpireal, mpicmplx, mpi2real
#ifndef SINGLE_PRECISION
  integer (kind(MPI_REAL)) :: mpicmplx8
#endif
# else
  integer, target :: nproc_actual = 1, iproc_actual = 0
  logical, target :: proc0_actual = .true.
  integer, pointer :: nproc => nproc_actual, iproc => iproc_actual
  logical, pointer :: proc0 => proc0_actual

  integer, target :: mp_comm_actual = -1
  integer, pointer :: mp_comm => mp_comm_actual

  integer, parameter :: mp_info = -1
  integer, parameter :: mp_comm_null = -1
  integer, parameter :: mp_request_null = -1
  integer, parameter :: mp_comm_self = -1
  integer, parameter :: mp_undefined = -1
  integer, parameter :: mp_status_size = 1

# endif
  !> Selectors for different communicator focuses
  integer, parameter :: allprocs = 0, subprocs = 1, multigs2procs = 2

  integer :: job = 0

  ! needed for Trinity -- MAB
  integer, dimension (:), allocatable :: grp0

  !> True if the communicator has been initialised.
  !! Used for unit tests to work out whether to
  !! call mp_abort or stop
  logical :: mp_initialized = .false.

  !> If using nprocs<nprocs available,
  !! this is true for procs that take part
  !! and false for procs that lie idle
  logical :: included = .true.

  !> File unit for the error file for [[mp_abort]]
  integer :: err_unit = error_unit

  !> Timers for mpi routines
  real, dimension(2) :: time_mp_other = 0., time_mp_collectives = 0.
  real, dimension(2) :: time_mp_ptp = 0., time_mp_sync = 0.

  !> A simple object for storing details of a communicator
  type comm_type
     sequence
     integer :: id = mp_comm_null !< The communicator id, used in calls to MPI routines
     integer :: iproc = -1 !< The procs local rank
     integer :: nproc = -1 !< The total number of processors in the communicator
     logical :: proc0 = .false. !< Is iproc equal to 0?
  end type comm_type

  interface wait
     module procedure wait_stat
     module procedure wait_nostat
  end interface

  interface waitall
     module procedure waitall_stat
     module procedure waitall_nostat
  end interface

  interface waitany
     module procedure waitany_stat
     module procedure waitany_nostat
  end interface

  interface testall
     module procedure testall_stat
     module procedure testall_nostat
     module procedure testall_nostat_noflag
  end interface

  interface nbsend
     module procedure nbsend_real_array
     module procedure nbsend_real_array_count
     module procedure nbsend_complex_array
     module procedure nbsend_complex_2d_array
     module procedure nbsend_complex_2d_array_count
     module procedure nbsend_complex_3d_array
     module procedure nbsend_complex_3d_array_count
     module procedure nbsend_complex_array_sub
     module procedure nbsend_complex_array_count
  end interface

  interface nbrecv
     module procedure nbrecv_real_array
     module procedure nbrecv_real_array_count
     module procedure nbrecv_complex_array
     module procedure nbrecv_complex_2d_array
     module procedure nbrecv_complex_2d_array_count
     module procedure nbrecv_complex_3d_array
     module procedure nbrecv_complex_3d_array_count
     module procedure nbrecv_complex_array_sub
     module procedure nbrecv_complex_array_count
  end interface

  interface send_init
     module procedure send_init_complex_array
     module procedure send_init_real_array
  end interface

  interface recv_init
     module procedure recv_init_complex_array
     module procedure recv_init_real_array
  end interface

  interface start_comm
     module procedure start_persist
     module procedure startall_persist
  end interface

  interface free_request
     module procedure free_handle_persist
     module procedure free_handles_persist
  end interface

  interface split
     module procedure split_nokey
     module procedure split_key
     module procedure split_nokey_to_commtype
     module procedure split_key_to_commtype
     module procedure split_nokey_to_commtype_sub
     module procedure split_key_to_commtype_sub
  end interface

  interface free_comm
     module procedure free_comm_id
     module procedure free_comm_type
  end interface

  interface allgather
     module procedure allgather_integer_array_1to1
  end interface allgather

  interface allgatherv
     module procedure allgatherv_complex_array_1to1
     module procedure allgatherv_complex_array_1to3
     module procedure allgatherv_complex_array_1to1_sub
     module procedure allgatherv_complex_array_1to3_sub
  end interface

  interface nb_allgatherv
     module procedure nb_allgatherv_complex_array_1to1
     module procedure nb_allgatherv_complex_array_1to3_sub
  end interface

  interface broadcast
     module procedure broadcast_integer
     module procedure broadcast_integer_array
     module procedure broadcast_integer_2array

     module procedure broadcast_real
     module procedure broadcast_real_array
     module procedure broadcast_real_2array
     module procedure broadcast_real_3array
     module procedure broadcast_real_4array
     module procedure broadcast_real_5array

     module procedure broadcast_complex
     module procedure broadcast_complex_array
#ifndef SINGLE_PRECISION
     ! This is needed for the gs2_gryfx_zonal module
     module procedure broadcast_complex8_array
#endif
     module procedure broadcast_complex_2array
     module procedure broadcast_complex_3array
     module procedure broadcast_complex_4array

     module procedure broadcast_logical
     module procedure broadcast_logical_array
     module procedure broadcast_logical_2array

     module procedure bcastfrom_integer
     module procedure bcastfrom_integer_array

     module procedure bcastfrom_real
     module procedure bcastfrom_real_array

     module procedure bcastfrom_complex
     module procedure bcastfrom_complex_array
     module procedure bcastfrom_complex_2array
     module procedure bcastfrom_complex_3array

     module procedure bcastfrom_logical
     module procedure bcastfrom_logical_array

     module procedure broadcast_character
     module procedure broadcast_character_array
     module procedure bcastfrom_character

  end interface

  interface broadcast_sub
     module procedure bcastfrom_complex_array_sub
     module procedure bcastfrom_complex_2array_sub
     module procedure bcastfrom_complex_3array_sub
     module procedure bcastfrom_complex_4array_sub
  end interface

  interface sum_reduce_sub
     module procedure sum_reduce_complex_array_sub
     module procedure sum_reduce_complex_2array_sub
     module procedure sum_reduce_complex_3array_sub
     module procedure sum_reduce_complex_4array_sub
  end interface

  interface nb_sum_reduce_sub
     module procedure nb_sum_reduce_complex_array_sub
     module procedure nb_sum_reduce_complex_4array_sub
  end interface

  interface sum_reduce
     module procedure sum_reduce_logical

     module procedure sum_reduce_integer
     module procedure sum_reduce_integer_array
     module procedure sum_reduce_integer_2array

     module procedure sum_reduce_real
     module procedure sum_reduce_real_array
     module procedure sum_reduce_real_2array
     module procedure sum_reduce_real_3array
     module procedure sum_reduce_real_4array
     module procedure sum_reduce_real_5array

     module procedure sum_reduce_complex
     module procedure sum_reduce_complex_array
     module procedure sum_reduce_complex_2array
     module procedure sum_reduce_complex_3array
     module procedure sum_reduce_complex_4array
     module procedure sum_reduce_complex_5array
  end interface

  interface nb_sum_reduce
     module procedure nb_sum_reduce_complex
     module procedure nb_sum_reduce_complex_array
     module procedure nb_sum_reduce_complex_2array
     module procedure nb_sum_reduce_complex_3array
     module procedure nb_sum_reduce_complex_4array
     module procedure nb_sum_reduce_complex_5array
  end interface

  interface sum_allreduce
     module procedure sum_allreduce_integer
     module procedure sum_allreduce_integer_array
     module procedure sum_allreduce_integer_2array
     module procedure sum_allreduce_integer_3array

     module procedure sum_allreduce_real
     module procedure sum_allreduce_real_array
     module procedure sum_allreduce_real_2array
     module procedure sum_allreduce_real_3array
     module procedure sum_allreduce_real_4array
     module procedure sum_allreduce_real_5array

     module procedure sum_allreduce_complex
     module procedure sum_allreduce_complex_array
     module procedure sum_allreduce_complex_2array
     module procedure sum_allreduce_complex_3array
     module procedure sum_allreduce_complex_4array
     module procedure sum_allreduce_complex_5array
  end interface

  interface nb_sum_allreduce
     module procedure nb_sum_allreduce_integer
     module procedure nb_sum_allreduce_complex_array
     module procedure nb_sum_allreduce_complex_3array
     module procedure nb_sum_allreduce_complex_4array
     module procedure nb_sum_allreduce_complex_5array
  end interface

  interface sum_allreduce_sub
     module procedure sum_allreduce_sub_integer
     module procedure sum_allreduce_sub_integer_array

     module procedure sum_allreduce_sub_real
     module procedure sum_allreduce_sub_real_array
     module procedure sum_allreduce_sub_real_2array
     module procedure sum_allreduce_sub_real_3array
     module procedure sum_allreduce_sub_real_4array
     module procedure sum_allreduce_sub_real_5array

     module procedure sum_allreduce_sub_complex
     module procedure sum_allreduce_sub_complex_array
     module procedure sum_allreduce_sub_complex_2array
     module procedure sum_allreduce_sub_complex_3array
     module procedure sum_allreduce_sub_complex_4array
     module procedure sum_allreduce_sub_complex_5array
  end interface

  interface nb_sum_allreduce_sub
     module procedure nb_sum_allreduce_sub_complex_2array
     module procedure nb_sum_allreduce_sub_complex_4array
  end interface

  interface max_reduce
     module procedure max_reduce_integer
     module procedure max_reduce_integer_array

     module procedure max_reduce_real
     module procedure max_reduce_real_array
  end interface

  interface max_allreduce
     module procedure max_allreduce_integer
     module procedure max_allreduce_integer_array

     module procedure max_allreduce_real
     module procedure max_allreduce_real_array
  end interface

  interface nb_max_allreduce
     module procedure nb_max_allreduce_integer
     module procedure nb_max_allreduce_integer_array
     module procedure nb_max_allreduce_real
     module procedure nb_max_allreduce_real_array
  end interface

  interface min_reduce
     module procedure min_reduce_integer
     module procedure min_reduce_integer_array

     module procedure min_reduce_real
     module procedure min_reduce_real_array
  end interface

  interface min_allreduce
     module procedure min_allreduce_integer
     module procedure min_allreduce_integer_array

     module procedure min_allreduce_real
     module procedure min_allreduce_real_array
  end interface

  interface min_allreduce_sub
     module procedure min_allreduce_sub_integer
  end interface

! MRH
  interface maxloc_allreduce
     module procedure maxloc_allreduce_real
     module procedure maxloc_allreduce_real_array
  end interface

  interface land_allreduce
     module procedure land_allreduce_single_element
  end interface
! MRH
  interface send
     module procedure send_integer
     module procedure send_integer_array

     module procedure send_real
     module procedure send_real_array
     module procedure send_real_4d_array
     module procedure send_real_5d_array

     module procedure send_complex
     module procedure send_complex_array
     module procedure send_complex_2d_array
     module procedure send_complex_3d_array

     module procedure nonblocking_send_complex_array

     module procedure send_logical
     module procedure send_logical_array

     module procedure send_character
  end interface

  interface receive
     module procedure receive_integer
     module procedure receive_integer_array

     module procedure receive_real
     module procedure receive_real_array
     module procedure receive_real_4d_array
     module procedure receive_real_5d_array

     module procedure receive_complex
     module procedure receive_complex_array
     module procedure receive_complex_2array
     module procedure receive_complex_3d_array
     module procedure nonblocking_receive_complex_array

     module procedure receive_logical
     module procedure receive_logical_array

     module procedure receive_character
  end interface

! MAB> needed for Trinity
! synchronous sends
  interface ssend
     module procedure ssend_character

     module procedure ssend_integer
     module procedure ssend_integer_array

     module procedure ssend_real
     module procedure ssend_real_array

     module procedure ssend_complex
     module procedure ssend_complex_array
     module procedure ssend_complex_2array

     module procedure ssend_logical
     module procedure ssend_logical_array
  end interface

! send stuff from global proc0 to group proc0s
  interface all_to_group
     module procedure all_to_group_real
     module procedure all_to_group_real_array
  end interface

! send stuff from group proc0s to global proc0
  interface group_to_all
     module procedure group_to_all_real
     module procedure group_to_all_real_array
  end interface
! <MAB

  interface barrier
     module procedure barrier_nocomm
     module procedure barrier_comm
  end interface
contains
  !/ Timer related routines

  !> Returns current requested timer values
  subroutine get_mp_times(total_time, overheads_time, collectives_time, ptp_time, sync_time)
    implicit none
    real, intent(out), optional :: total_time, overheads_time, collectives_time, ptp_time, sync_time

    if (present(total_time)) then
       total_time = time_mp_other(1) + time_mp_collectives(1) + &
            time_mp_ptp(1) + time_mp_sync(1)
    end if

    if (present(overheads_time)) overheads_time = time_mp_other(1)
    if (present(collectives_time)) collectives_time = time_mp_collectives(1)
    if (present(ptp_time)) ptp_time = time_mp_ptp(1)
    if (present(sync_time)) sync_time = time_mp_sync(1)
  end subroutine get_mp_times

  !> Resets mp timers to zero
  subroutine reset_mp_times
    implicit none
    time_mp_other = 0.
    time_mp_collectives = 0.
    time_mp_ptp = 0.
    time_mp_sync = 0.
  end subroutine reset_mp_times

  !> Returns CPU time in seconds
  function timer_local()
# ifdef OPENMP
!$    use omp_lib, only: omp_get_wtime
# endif
    real :: timer_local

    timer_local=0.

# ifdef OPENMP
    timer_local=omp_get_wtime()
# else
# if defined MPI && !defined MPIINC && !defined SINGLE_PRECISION
    timer_local=mpi_wtime()
# else
    ! this routine is F95 standard
    call cpu_time(timer_local)
# endif
# endif
  end function timer_local

  !> This routine counts elapsed time between two calls.
  !> The two elements in `targ` will be populated by time_message
  !> and correspond to the cumulative time and the time at the last
  !> call to time_message for this entry or zero depending on if
  !> the second element is zero or non-zero. Essentially the second
  !> element acts both as a store for the time at a call and a flag
  !> which flip-flops, to work out if we're currently timing or not.
  subroutine time_message(lprint,targ,chmessage)
    use warning_helpers, only: is_zero
    implicit none
    character (len=*), intent(in) :: chmessage
    logical, intent(in) :: lprint
    real, intent(in out) :: targ(2) ! tsum and told
    real :: tnew
    real, parameter :: small_number=1.e-10

    tnew=timer_local()

    if (is_zero(targ(2))) then
       !>RN targ(2) must be non-zero at initialization.
       if (is_zero(tnew)) tnew = small_number
       targ(2) = tnew
    else
       targ(1)=targ(1)+tnew-targ(2)
       if (lprint) print *, chmessage,': ',tnew-targ(2),' seconds'
       targ(2)=0.
    end if
  end subroutine time_message

  !/ MPI related routines

  !> FIXME : Add documentation
  subroutine get_proc_name(nm)
    implicit none
#ifdef MPI
    character*(MPI_MAX_PROCESSOR_NAME), intent(out) :: nm
    integer :: ierr, len
#else
    character(len=5), intent(out) :: nm
#endif
#ifdef MPI
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    call mpi_get_processor_name(nm,len,ierr)
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
#else
    nm="local"
#endif
  end subroutine get_proc_name

  !> Initialise the MPI library, communicators, and related variables
  subroutine init_mp (comm_in, multigs2, err_unit_in)
#ifdef MPI
    use constants, only: pi, kind_rs, kind_rd
#ifdef SHMEM
    use shm_mpi3
#endif
#endif
    use optionals, only : get_option_with_default
    implicit none
    !> Communicator to use instead of `MPI_COMM_WORLD`. If present and
    !> set to `MPI_COMM_NULL`, gets set to `MPI_COMM_WORLD`
    integer, intent (inout), optional :: comm_in
    !> If true, initialise multiscale communicator and variables
    logical, intent (in), optional :: multigs2
    !> Unit of open file to write any error messages to. Defaults to stderr
    integer, intent (in), optional :: err_unit_in
# ifdef MPI
    integer :: ierror, err_unit_local
#ifdef OPENMP
    integer :: provided
#endif
    logical :: is_initialised, is_multiscale

    err_unit_local = get_option_with_default(err_unit_in, err_unit)
    call mpi_initialized (is_initialised, ierror)
#ifdef OPENMP
    if (.not. is_initialised) then
       call mpi_init_thread(MPI_THREAD_MULTIPLE, provided, ierror)
       if(provided .ne. MPI_THREAD_MULTIPLE) then
          write(err_unit_local,*) 'Problem with MPI_INIT_THREAD, stopping'
          stop
       end if
    end if
#else
    if (.not. is_initialised) call mpi_init (ierror)
#endif

    is_multiscale = get_option_with_default(multigs2, .false.)

    if (is_multiscale) then
      call init_comm(comm_multigs2, mulntot_proc, mulproc, mulproc0, comm_in)
    else
      call init_comm(comm_all, ntot_proc, aproc, aproc0, comm_in)
    end if

    if (is_multiscale) then
      call scope(multigs2procs)
    else
      call scope(allprocs)
#ifdef SHMEM
      call shm_init(comm_all)
#endif
    end if

#ifndef SINGLE_PRECISION
    mpicmplx8 = MPI_COMPLEX
#endif
    if ( (kind(pi)==kind_rs) .and. (kind_rs/=kind_rd) ) then
       mpireal = MPI_REAL
       mpi2real = MPI_2REAL
       mpicmplx = MPI_COMPLEX
    else if (kind(pi)==kind_rd) then
       mpireal = MPI_DOUBLE_PRECISION
       mpi2real = MPI_2DOUBLE_PRECISION
       mpicmplx = MPI_DOUBLE_COMPLEX
    else
       write (err_unit_local, *) 'ERROR: precision mismatch in mpi'
       error stop 'ERROR: precision mismatch in mpi'
    end if

# else
    UNUSED_DUMMY(comm_in); UNUSED_DUMMY(multigs2); UNUSED_DUMMY(err_unit_in)
# endif
    mp_initialized = .true.
  end subroutine init_mp

#ifdef MPI
  !> Initialise a communicator and associated variables
  !>
  !> Defaults to using `MPI_COMM_WORLD`, but can be set to another
  !> communicator `comm_in`.
  subroutine init_comm(comm, total_procs, rank, is_rank0, comm_in)
    !> Communicator to initialise
    integer, intent(out) :: comm
    !> Total number of processors in communicator
    integer, intent(out) :: total_procs
    !> This processor's rank
    integer, intent(out) :: rank
    !> True if this processor's rank is zero
    logical, intent(out) :: is_rank0
    !> Communicator to use instead of `MPI_COMM_WORLD`: if this is
    !> `MPI_COMM_NULL`, this is also initialised to `MPI_COMM_WORLD`
    integer, intent(inout), optional :: comm_in

    integer :: ierror

    if (present(comm_in)) then
      if (comm_in == mp_comm_null) then
        comm_in = mpi_comm_world
      end if
      comm = comm_in
    else
      comm = mpi_comm_world
    end if

!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER

    call mpi_comm_size(comm, total_procs, ierror)
    call mpi_comm_rank(comm, rank, ierror)
    is_rank0 = (rank == 0)

!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
  end subroutine init_comm
#endif

  !> How many procs are in passed communicator
  subroutine nproc_comm(comm,nproc)
    integer, intent(in) :: comm
    integer, intent(out) :: nproc
#ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    call mpi_comm_size(comm,nproc,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
#else
    UNUSED_DUMMY(comm)
    nproc = 1
#endif
  end subroutine nproc_comm

  !> What is rank of current proc in passed communicator
  subroutine rank_comm(comm,rank)
    integer, intent(in) :: comm
    integer, intent(out) :: rank
#ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    call mpi_comm_rank(comm,rank,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
#else
    UNUSED_DUMMY(comm)
    rank = 0
#endif
  end subroutine rank_comm

  !> Switch the module communicator (and size/rank variables) between different scopes.
  subroutine scope (focus)
    !> Which scope to use. Should be one of [[allprocs]], [[multigs2procs]],
    !> [[subprocs]]. Other values are equivalent to [[subprocs]]
    integer, intent (in) :: focus
# ifdef MPI
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    if (focus == allprocs) then
       mp_comm => comm_all
       nproc => ntot_proc
       iproc => aproc
       proc0 => aproc0
    else if (focus == multigs2procs) then
       mp_comm => comm_multigs2
       nproc => mulntot_proc
       iproc => mulproc
       proc0 => mulproc0
    else
       mp_comm => comm_group
       nproc => ngroup_proc
       iproc => gproc
       proc0 => gproc0
    end if
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
# else
    UNUSED_DUMMY(focus)
# endif
  end subroutine scope

  !> Finalise MPI library if it hasn't been finalised already
  subroutine finish_mp
#ifdef MPI
# ifdef SHMEM
    use shm_mpi3, only : shm_clean
# endif
    implicit none
    integer :: ierror
    logical :: fin
# ifdef SHMEM
    call shm_clean
# endif
    call mpi_finalized (fin, ierror)
    if(.not.fin) call mpi_finalize (ierror)
#endif
    mp_initialized = .false.
  end subroutine finish_mp

! ************** allgathers *****************************
  !> A subroutine to do a allgatherv operation, sending recvcnts(iproc)
  !! data from the iproc'th processor to all others starting at arr(start).
  subroutine allgather_integer_array_1to1(arr,count,out,recvcnts)
    implicit none
    integer, dimension(:), intent(in) :: arr  !< The data to gather
    integer, intent(in) :: count !< How much data to gather, <=SIZE(arr)
    integer, dimension(:), intent(out) :: out !< The gathered data
    integer, intent(in) :: recvcnts !< Array detailing how much data to expect from each proc
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER

    !Do the gather
    call mpi_allgather(arr,count,MPI_INTEGER,out,recvcnts,&
         MPI_INTEGER,mp_comm,ierror)

!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    out = reshape(arr, shape(out))
    UNUSED_DUMMY(count); UNUSED_DUMMY(recvcnts)
#endif
  end subroutine allgather_integer_array_1to1

  !> A subroutine to do a allgatherv operation, sending recvcnts(iproc)
  !! data from the iproc'th processor to all others starting at arr(start).
  subroutine allgatherv_complex_array_1to1(arr,count,out,recvcnts,displs)
    implicit none
    complex, dimension(:), intent(in) :: arr  !< The data to gather
    integer, intent(in) :: count !< How much data to gather, <=SIZE(arr)
    complex, dimension(:), intent(out) :: out !< The gathered data
    integer, dimension(:), intent(in) :: recvcnts !< Array detailing how much data to expect from each proc
    integer, dimension(:), intent(in) :: displs !< Array detailing offset in array where gathered data is to be stored
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER

    !Do the gather
    call mpi_allgatherv(arr,count,mpicmplx,out,recvcnts,displs,&
         mpicmplx,mp_comm,ierror)

!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    out = reshape(arr, shape(out))
    UNUSED_DUMMY(count); UNUSED_DUMMY(recvcnts); UNUSED_DUMMY(displs)
#endif
  end subroutine allgatherv_complex_array_1to1

  !> A subroutine to do a allgatherv operation, sending recvcnts(iproc)
  !! data from the iproc'th processor to all others starting at arr(start).
  subroutine nb_allgatherv_complex_array_1to1(arr,count,out,recvcnts,displs,request)
    implicit none
    complex, dimension(:), intent(in) :: arr  !< The data to gather
    integer, intent(in) :: count !< How much data to gather, <=SIZE(arr)
    complex, dimension(:), intent(out) :: out !< The gathered data
    integer, dimension(:), intent(in) :: recvcnts !< Array detailing how much data to expect from each proc
    integer, dimension(:), intent(in) :: displs !< Array detailing offset in array where gathered data is to be stored
    integer, intent(out) :: request
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER

    !Do the gather
    call mpi_iallgatherv(arr,count,mpicmplx,out,recvcnts,displs,&
         mpicmplx,mp_comm,request,ierror)

!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    call allgatherv_complex_array_1to1(arr,count,out,recvcnts,displs)
    request = mp_request_null
#endif
  end subroutine nb_allgatherv_complex_array_1to1

  !> A subroutine to do a allgatherv operation, sending recvcnts(iproc)
  !! data from the iproc'th processor to all others starting at arr(start).
  subroutine allgatherv_complex_array_1to3(arr,count,out,recvcnts,displs)
    implicit none
    complex, dimension(:), intent(in) :: arr  !< The data to gather
    integer, intent(in) :: count !< How much data to gather, <=SIZE(arr)
    complex, dimension(:,:,:), intent(out) :: out !< The gathered data
    integer, dimension(:), intent(in) :: recvcnts !< Array detailing how much data to expect from each proc
    integer, dimension(:), intent(in) :: displs !< Array detailing offset in array where gathered data is to be stored
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    !Do the gather
    call mpi_allgatherv(arr,count,mpicmplx,out,recvcnts,displs,&
         mpicmplx,mp_comm,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    out = reshape(arr, shape(out))
    UNUSED_DUMMY(count); UNUSED_DUMMY(recvcnts); UNUSED_DUMMY(displs)
#endif
  end subroutine allgatherv_complex_array_1to3

  !> A subroutine to do a allgatherv operation, sending recvcnts(iproc)
  !! data from the iproc'th processor to all others starting at arr(start).
  subroutine allgatherv_complex_array_1to1_sub(arr,count,out,recvcnts,displs,sub_comm)
    implicit none
    complex, dimension(:), intent(in) :: arr  !< The data to gather
    integer, intent(in) :: count !< How much data to gather, <=SIZE(arr)
    complex, dimension(:), intent(out) :: out !< The gathered data
    integer, dimension(:), intent(in) :: recvcnts !< Array detailing how much data to expect from each proc
    integer, dimension(:), intent(in) :: displs !< Array detailing offset in array where gathered data is to be stored
    integer, intent(in) :: sub_comm !< Sub-communicator handle
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    !Do the gather
    call mpi_allgatherv(arr,count,mpicmplx,out,recvcnts,displs,&
         mpicmplx,sub_comm,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    out = reshape(arr, shape(out))
    UNUSED_DUMMY(count); UNUSED_DUMMY(recvcnts); UNUSED_DUMMY(displs); UNUSED_DUMMY(sub_comm)
#endif
  end subroutine allgatherv_complex_array_1to1_sub

  !> A subroutine to do a allgatherv operation, sending recvcnts(iproc)
  !! data from the iproc'th processor to all others starting at arr(start).
  subroutine allgatherv_complex_array_1to3_sub(arr,count,out,recvcnts,displs,sub_comm)
    implicit none
    complex, dimension(:), intent(in) :: arr  !< The data to gather
    integer, intent(in) :: count !< How much data to gather, <=SIZE(arr)
    complex, dimension(:,:,:), intent(out) :: out !< The gathered data
    integer, dimension(:), intent(in) :: recvcnts !< Array detailing how much data to expect from each proc
    integer, dimension(:), intent(in) :: displs !< Array detailing offset in array where gathered data is to be stored
    integer, intent(in) :: sub_comm !< Sub-communicator handle
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    !Do the gather
    call mpi_allgatherv(arr,count,mpicmplx,out,recvcnts,displs,&
         mpicmplx,sub_comm,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
#else
    out = reshape(arr, shape(out))
    UNUSED_DUMMY(count); UNUSED_DUMMY(recvcnts); UNUSED_DUMMY(displs); UNUSED_DUMMY(sub_comm)
#endif
  end subroutine allgatherv_complex_array_1to3_sub

  !> A subroutine to do a non-blocking allgatherv operation, sending recvcnts(iproc)
  !! data from the iproc'th processor to all others starting at arr(start).
  subroutine nb_allgatherv_complex_array_1to3_sub(arr,count,out,recvcnts,displs,sub_comm,request)
    implicit none
    complex, dimension(:), intent(in) :: arr  !< The data to gather
    integer, intent(in) :: count !< How much data to gather, <=SIZE(arr)
    complex, dimension(:,:,:), intent(out) :: out !< The gathered data
    integer, dimension(:), intent(in) :: recvcnts !< Array detailing how much data to expect from each proc
    integer, dimension(:), intent(in) :: displs !< Array detailing offset in array where gathered data is to be stored
    integer, intent(in) :: sub_comm !< Sub-communicator handle
    integer, intent(out) :: request !< FIXME : Add documentation
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    !Do the gather
    call mpi_iallgatherv(arr,count,mpicmplx,out,recvcnts,displs,&
         mpicmplx,sub_comm,request,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
#else
    call allgatherv_complex_array_1to3_sub(arr,count,out,recvcnts,displs,sub_comm)
    request = mp_request_null
#endif
  end subroutine nb_allgatherv_complex_array_1to3_sub


! ************** comm utils *****************************
  !> A routine to free the communicator with id comm
  subroutine free_comm_id (comm)
    implicit none
    integer, intent(inout) :: comm !< Communicator id
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    call mpi_comm_free(comm,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
# endif
    comm = mp_comm_null
  end subroutine free_comm_id

  !> A routine to free the communicator represented by comm
  subroutine free_comm_type (comm)
    implicit none
    type(comm_type), intent(inout) :: comm !< Communicator object
#ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    call mpi_comm_free(comm%id,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
#endif
    comm%id = mp_comm_null
    comm%iproc = -1
    comm%nproc = -1
    comm%proc0 = .false.
  end subroutine free_comm_type

  !> This function splits mp_comm into two pieces,
  !! one with nprocs_new procs, and one with all the
  !! remainder. For the remainder, included is set
  !! to false. This means that the remainder will lie
  !! idle.
  subroutine use_nproc(nprocs_new)
    implicit none
    integer, intent(in) :: nprocs_new
    integer :: colour
    included = (iproc < nprocs_new)
    colour = 1
    if (included) colour = 0
    call split_all(colour)
  end subroutine use_nproc

  !> FIXME : Add documentation
  subroutine unsplit_all(old_comm)
    implicit none
    integer, intent(in) :: old_comm
#ifdef MPI
    integer :: ierror
    call free_comm_id(comm_all)
    comm_all = old_comm
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    call mpi_comm_size (comm_all, ntot_proc, ierror)
    call mpi_comm_rank (comm_all, aproc, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    aproc0 = aproc == 0
    included = .true.
    call scope (allprocs)
#else
    UNUSED_DUMMY(old_comm)
#endif
  end subroutine unsplit_all

  !> A routine to split the global communicator into sub-groups
  !! based on each procs specific colour "col". mp_comm is then overwritten
  !! to be the new split communicator
  !! This is different to job fork, which has the group and global communicators.
  !! The global communicator is replaced.
  !! This action can be undone with unsplit_all
  !! If the old mp_comm is not mpi_comm_world, you should make sure you have
  !! saved its value somewhere before calling this so that its value
  !! can be saved.
  subroutine split_all (col)
    implicit none
    integer, intent(inout) :: col !< Processors colour
#ifdef MPI
    integer :: ierror, new_comm
!    if (scope == subprocs) then
!      write (*,*) 'Can only call split_all with global scope'
!      call mpi_abort(comm_all, 1, ierror)
!    end if
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    !Split the comm group, note we use a constant key of 0 across all procs
    !meaning that the rank order is the same in the old and new communicators
    call mpi_comm_split(comm_all,col,aproc,new_comm,ierror)
    comm_all = new_comm
    call mpi_comm_size (comm_all, ntot_proc, ierror)
    call mpi_comm_rank (comm_all, aproc, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    aproc0 = aproc == 0
    call scope (allprocs)
#else
    UNUSED_DUMMY(col)
#endif
  end subroutine split_all

  !> A routine to split the mp_comm communicator into sub-groups
  !! based on each procs specific colour "col". The sub communicator's
  !! handle is passed back in new_comm
  !!
  !! In future we may wish to make split an interface to allow for
  !! user specific keys (to reorder processor ranks) and to specify
  !! a different communicator to split
  subroutine split_nokey (col,new_comm)
    implicit none
    integer, intent(inout) :: col !< Processors colour
    integer, intent(out) :: new_comm !< The new sub communicator's handle
#ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    !Split the comm group, note we use a constant key of 0 across all procs
    !meaning that the rank order is the same in the old and new communicators
    call mpi_comm_split(mp_comm,col,0,new_comm,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
#else
    UNUSED_DUMMY(col)
    new_comm=-1
#endif
  end subroutine split_nokey

  !> A routine to split the mp_comm communicator into sub-groups
  !! based on each procs specific colour "col" and ranked by key. The sub communicator's
  !! handle is passed back in new_comm
  subroutine split_key (col,key,new_comm)
    implicit none
    integer, intent(in) :: col !< Processors colour
    integer, intent(in) :: key !< Processors key, used to determine rank
    integer, intent(out) :: new_comm !< The new sub communicator's handle
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    !Split the comm group
    call mpi_comm_split(mp_comm,col,key,new_comm,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
# else
    UNUSED_DUMMY(col); UNUSED_DUMMY(key)
    new_comm = -1
# endif
  end subroutine split_key

  !> A routine to split the mp_comm communicator into sub-groups
  !! based on each procs specific colour "col". The sub communicator's
  !! handle is passed back in new_comm
  subroutine split_nokey_to_commtype (col,new_comm)
    implicit none
    integer, intent(in) :: col !< Processors colour
    type(comm_type), intent(out) :: new_comm !< The new sub communicator's handle
# ifdef MPI
    integer :: ierror
# endif
    integer :: comm_id, nproc, iproc
# ifdef MPI
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    !Split the comm group, note we use a constant key of 0 across all procs
    !meaning that the rank order is the same in the old and new communicators
    call mpi_comm_split(mp_comm,col,0,comm_id,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    !If the resulting communicator is the null communicator then
    !just return the default type with the appropriate id.
    if(comm_id == mp_comm_null) then
       new_comm%id = comm_id
       return
    end if
# else
    UNUSED_DUMMY(col)
    comm_id = mp_comm_null
# endif
    new_comm%id=comm_id
    call nproc_comm(comm_id,nproc)
    new_comm%nproc=nproc
    call rank_comm(comm_id,iproc)
    new_comm%iproc=iproc
    new_comm%proc0=iproc.eq.0
  end subroutine split_nokey_to_commtype

  !> A routine to split the mp_comm communicator into sub-groups
  !! based on each procs specific colour "col" and ranked by key. The sub communicator's
  !! handle is passed back in new_comm
  subroutine split_key_to_commtype (col,key,new_comm)
    implicit none
    integer, intent(in) :: col !< Processors colour
    integer, intent(in) :: key !< Processors key, used to determine rank
    type(comm_type), intent(out) :: new_comm !< The new sub communicator's handle
# ifdef MPI
    integer :: ierror
# endif
    integer :: comm_id, nproc
# ifdef MPI
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    !Split the comm group
    call mpi_comm_split(mp_comm,col,key,comm_id,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    !If the resulting communicator is the null communicator then
    !just return the default type with the appropriate id.
    if(comm_id == mp_comm_null) then
       new_comm%id = comm_id
       return
    end if
# else
    UNUSED_DUMMY(col); UNUSED_DUMMY(key)
    comm_id = mp_comm_null
# endif
    new_comm%id=comm_id
    call nproc_comm(comm_id,nproc)
    new_comm%nproc=nproc
    call rank_comm(comm_id,nproc)
    new_comm%iproc=nproc
    new_comm%proc0=new_comm%iproc.eq.0
  end subroutine split_key_to_commtype

  !> A routine to split a subcommunicator into sub-groups
  !! based on each procs specific colour "col". The sub communicator's
  !! handle is passed back in new_comm
  subroutine split_nokey_to_commtype_sub (col,new_comm,sub)
    implicit none
    integer, intent(in) :: col !< Processors colour
    type(comm_type), intent(out) :: new_comm !< The new sub communicator's handle
    integer, intent(in) :: sub
# ifdef MPI
    integer :: ierror
# endif
    integer :: comm_id, nproc, iproc
    !Split the comm group, note we use a constant key of 0 across all procs
    !meaning that the rank order is the same in the old and new communicators
# ifdef MPI
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    call mpi_comm_split(sub,col,0,comm_id,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    !If the resulting communicator is the null communicator then
    !just return the default type with the appropriate id.
    if(comm_id == mp_comm_null) then
       new_comm%id = comm_id
       return
    end if
# else
    UNUSED_DUMMY(col); UNUSED_DUMMY(sub)
    comm_id = mp_comm_null
# endif
    new_comm%id=comm_id
    call nproc_comm(comm_id,nproc)
    new_comm%nproc=nproc
    call rank_comm(comm_id,iproc)
    new_comm%iproc=iproc
    new_comm%proc0=iproc.eq.0
  end subroutine split_nokey_to_commtype_sub

  !> A routine to split a subcommunicator into sub-groups
  !! based on each procs specific colour "col" and ranked by key. The sub communicator's
  !! handle is passed back in new_comm
  subroutine split_key_to_commtype_sub (col,key,new_comm,sub)
    implicit none
    integer, intent(in) :: col !< Processors colour
    integer, intent(in) :: key !< Processors key, used to determine rank
    type(comm_type), intent(out) :: new_comm !< The new sub communicator's handle
    integer, intent(in) :: sub !< Subcommunicator to split
# ifdef MPI
    integer :: ierror
# endif
    integer :: comm_id, nproc
# ifdef MPI
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    !Split the comm group
    call mpi_comm_split(sub,col,key,comm_id,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER

    !If the resulting communicator is the null communicator then
    !just return the default type with the appropriate id.
    if(comm_id == mp_comm_null) then
       new_comm%id = comm_id
       return
    end if
# else
    UNUSED_DUMMY(col); UNUSED_DUMMY(key); UNUSED_DUMMY(sub)
    comm_id = mp_comm_null
# endif
    new_comm%id=comm_id
    call nproc_comm(comm_id,nproc)
    new_comm%nproc=nproc
    call rank_comm(comm_id,nproc)
    new_comm%iproc=nproc
    new_comm%proc0=new_comm%iproc.eq.0
  end subroutine split_key_to_commtype_sub

! ************** broadcasts *****************************

  !> FIXME : Add documentation
  subroutine broadcast_character (char)
    implicit none
    character(*), intent (in out) :: char
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (char, len(char), MPI_CHARACTER, 0, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(char)
# endif
  end subroutine broadcast_character

  !> FIXME : Add documentation
  !!
  !! An array of characters, each of same length
  subroutine broadcast_character_array (char)
    implicit none
    character(len = *), dimension(:), intent (in out) :: char
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (char, size(char) * len(char(1)), MPI_CHARACTER, 0, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    if (.false.) write(*,*) char
# endif
  end subroutine broadcast_character_array

  !> FIXME : Add documentation
  subroutine broadcast_integer (i)
    implicit none
    integer, intent (in out) :: i
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (i, 1, MPI_INTEGER, 0, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(i)
# endif
  end subroutine broadcast_integer

  !> FIXME : Add documentation
  subroutine broadcast_integer_array (i)
    implicit none
    integer, dimension (:), intent (in out) :: i
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (i, size(i), MPI_INTEGER, 0, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(i)
# endif
  end subroutine broadcast_integer_array

  !> FIXME : Add documentation
  subroutine broadcast_integer_2array (i)
    implicit none
    integer, dimension (:,:), intent (in out) :: i
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (i, size(i), MPI_INTEGER, 0, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(i)
# endif
  end subroutine broadcast_integer_2array

  !> FIAME : Add documentation
  subroutine broadcast_real (a)
    implicit none
    real, intent (in out) :: a
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (a, 1, mpireal, 0, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
# endif
  end subroutine broadcast_real

  !> FIAME : Add documentation
  subroutine broadcast_real_array (a)
    implicit none
    real, dimension (:), intent (in out) :: a
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (a, size(a), mpireal, 0, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
# endif
  end subroutine broadcast_real_array

  !> FIXME : Add documentation
  subroutine broadcast_real_2array(a)
    implicit none
    real, dimension(:,:), intent (in out) :: a
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (a, size(a), mpireal, 0, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
# endif
  end subroutine broadcast_real_2array

  !> FIAME : Add documentation
  subroutine broadcast_real_3array(a)
    implicit none
    real, dimension(:,:,:), intent (in out) :: a
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (a, size(a), mpireal, 0, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
# endif
  end subroutine broadcast_real_3array

  !> FIXME : Add documentation
  subroutine broadcast_real_4array(a)
    implicit none
    real, dimension(:,:,:,:), intent (in out) :: a
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (a, size(a), mpireal, 0, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
# endif
  end subroutine broadcast_real_4array

  !> FIXME : Add documentation
  subroutine broadcast_real_5array(a)
    implicit none
    real, dimension(:,:,:,:,:), intent (in out) :: a
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (a, size(a), mpireal, 0, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
# endif
  end subroutine broadcast_real_5array

  !> FIXME : Add documentation
  subroutine broadcast_complex (z)
    implicit none
    complex, intent (in out) :: z
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (z, 1, mpicmplx, 0, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
# endif
  end subroutine broadcast_complex

  !> FIXME : Add documentation
  subroutine broadcast_complex_array (z)
    implicit none
    complex, dimension (:), intent (in out) :: z
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (z, size(z), mpicmplx, 0, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
# endif
  end subroutine broadcast_complex_array

#ifndef SINGLE_PRECISION
  !> FIXME : Add documentation
  subroutine broadcast_complex8_array (z)
    use constants, only: kind_rs
    implicit none
    complex (kind=kind_rs), dimension (:), intent (in out) :: z
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (z, size(z), mpicmplx8, 0, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
# endif
  end subroutine broadcast_complex8_array
#endif

  !> FIXME : Add documentation
  subroutine broadcast_complex_2array (z)
    implicit none
    complex, dimension (:,:), intent (in out) :: z
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (z, size(z), mpicmplx, 0, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
# endif
  end subroutine broadcast_complex_2array

  !> FIXME : Add documentation
  subroutine broadcast_complex_3array (z)
    implicit none
    complex, dimension (:,:,:), intent (in out) :: z
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (z, size(z), mpicmplx, 0, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
# endif
  end subroutine broadcast_complex_3array

  !> FIXME : Add documentation
  subroutine broadcast_complex_4array (z)
    implicit none
    complex, dimension (:,:,:,:), intent (in out) :: z
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (z, size(z), mpicmplx, 0, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
# endif
  end subroutine broadcast_complex_4array

  !> FIXME : Add documentation
  subroutine broadcast_logical (f)
    implicit none
    logical, intent (in out) :: f
# ifdef MPI
    integer :: ierror,rc
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (f, 1, MPI_LOGICAL, 0, mp_comm, ierror)
    if (ierror .ne. MPI_SUCCESS) &
      call MPI_ABORT(MPI_COMM_WORLD, rc, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(f)
# endif
  end subroutine broadcast_logical

  !> FIXME : Add documentation
  subroutine broadcast_logical_array (f)
    implicit none
    logical, dimension (:), intent (in out) :: f
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (f, size(f), MPI_LOGICAL, 0, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(f)
# endif
  end subroutine broadcast_logical_array

  !> FIXME : Add documentation
  subroutine broadcast_logical_2array (f)
    implicit none
    logical, dimension (:,:), intent (in out) :: f
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (f, size(f), MPI_LOGICAL, 0, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(f)
# endif
  end subroutine broadcast_logical_2array

  !> FIXME : Add documentation
  subroutine bcastfrom_logical (f, src)
    implicit none
    logical, intent (in out) :: f
    integer, intent (in) :: src
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (f, 1, MPI_LOGICAL, src, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(f)
    if (src /= 0) call mp_abort ("broadcast from")
# endif
  end subroutine bcastfrom_logical

  !> FIXME : Add documentation
  subroutine bcastfrom_logical_array (f, src)
    implicit none
    logical, dimension (:), intent (in out) :: f
    integer, intent (in) :: src
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (f, size(f), MPI_LOGICAL, src, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(f)
    if (src /= 0) call mp_abort ("broadcast from")
# endif
  end subroutine bcastfrom_logical_array

  !> FIXME : Add documentation
  subroutine bcastfrom_character (c, src)
    implicit none
    character(*), intent (in out) :: c
    integer, intent (in) :: src
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (c, len(c), MPI_CHARACTER, src, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(c)
    if (src /= 0) call mp_abort ("broadcast from")
# endif
  end subroutine bcastfrom_character

  !> FIXME : Add documentation
  subroutine bcastfrom_integer (i, src)
    implicit none
    integer, intent (in out) :: i
    integer, intent (in) :: src
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (i, 1, MPI_INTEGER, src, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(i)
    if (src /= 0) call mp_abort ("broadcast from")
# endif
  end subroutine bcastfrom_integer

  !> FIXME : Add documentation
  subroutine bcastfrom_integer_array (i, src)
    implicit none
    integer, dimension (:), intent (in out) :: i
    integer, intent (in) :: src
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (i, size(i), MPI_INTEGER, src, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(i)
    if (src /= 0) call mp_abort ("broadcast from")
# endif
  end subroutine bcastfrom_integer_array

  !> FIXME : Add documentation
  subroutine bcastfrom_real (a, src)
    implicit none
    real, intent (in out) :: a
    integer, intent (in) :: src
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (a, 1, mpireal, src, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
    if (src /= 0) call mp_abort ("broadcast from")
# endif
  end subroutine bcastfrom_real

  !> FIXME : Add documentation
  subroutine bcastfrom_real_array (a, src)
    implicit none
    real, dimension (:), intent (in out) :: a
    integer, intent (in) :: src
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (a, size(a), mpireal, src, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
    if (src /= 0) call mp_abort ("broadcast from")
# endif
  end subroutine bcastfrom_real_array

  !> FIXME : Add documentation
  subroutine bcastfrom_complex (z, src)
    implicit none
    complex, intent (in out) :: z
    integer, intent (in) :: src
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (z, 1, mpicmplx, src, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
    if (src /= 0) call mp_abort ("broadcast from")
# endif
  end subroutine bcastfrom_complex

  !> FIXME : Add documentation
  subroutine bcastfrom_complex_array (z, src)
    implicit none
    complex, dimension (:), intent (in out) :: z
    integer, intent (in) :: src
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (z, size(z), mpicmplx, src, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
    if (src /= 0) call mp_abort ("broadcast from")
# endif
  end subroutine bcastfrom_complex_array

  !> FIXME : Add documentation
  subroutine bcastfrom_complex_2array (z, src)
    implicit none
    complex, dimension (:,:), intent (in out) :: z
    integer, intent (in) :: src
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (z, size(z), mpicmplx, src, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
    if (src /= 0) call mp_abort ("broadcast from")
# endif
  end subroutine bcastfrom_complex_2array

  !> FIXME : Add documentation
  subroutine bcastfrom_complex_3array (z, src)
    implicit none
    complex, dimension (:,:,:), intent (in out) :: z
    integer, intent (in) :: src
# ifdef MPI
    integer :: ierror
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
    call mpi_bcast (z, size(z), mpicmplx, src, mp_comm, ierror)
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
# else
    UNUSED_DUMMY(z)
    if (src /= 0) call mp_abort ("broadcast from")
# endif
  end subroutine bcastfrom_complex_3array

!******************BROADCAST SUB*************************

  !> FIXME : Add documentation
  subroutine bcastfrom_complex_array_sub (z, src, sub)
    implicit none
    complex, dimension (:), intent (in out) :: z
    integer, intent (in) :: src
    integer, intent (in) :: sub
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (z, size(z), mpicmplx, src, sub, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z); UNUSED_DUMMY(sub)
    if (src /= 0) call mp_abort ("broadcast from sub")
# endif
  end subroutine bcastfrom_complex_array_sub

  !> FIXME : Add documentation
  subroutine bcastfrom_complex_2array_sub (z, src, sub)
    implicit none
    complex, dimension (:,:), intent (in out) :: z
    integer, intent (in) :: src
    integer, intent (in) :: sub
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (z, size(z), mpicmplx, src, sub, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z); UNUSED_DUMMY(sub)
    if (src /= 0) call mp_abort ("broadcast from sub")
# endif
  end subroutine bcastfrom_complex_2array_sub

  !> FIXME : Add documentation
  subroutine bcastfrom_complex_3array_sub (z, src, sub)
    implicit none
    complex, dimension (:,:,:), intent (in out) :: z
    integer, intent (in) :: src
    integer, intent (in) :: sub
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (z, size(z), mpicmplx, src, sub, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z); UNUSED_DUMMY(sub)
    if (src /= 0) call mp_abort ("broadcast from sub")
# endif
  end subroutine bcastfrom_complex_3array_sub

  !> FIXME : Add documentation
  subroutine bcastfrom_complex_4array_sub (z, src, sub)
    implicit none
    complex, dimension (:,:,:,:), intent (in out) :: z
    integer, intent (in) :: src
    integer, intent (in) :: sub
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_bcast (z, size(z), mpicmplx, src, sub, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z); UNUSED_DUMMY(sub)
    if (src /= 0) call mp_abort ("broadcast from sub")
# endif
  end subroutine bcastfrom_complex_4array_sub

! ************** reductions ***********************

  !> FIXME : Add documentation
  subroutine sum_reduce_integer (i, dest)
    implicit none
    integer, intent (in out) :: i
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest)then
       call mpi_reduce &
            (MPI_IN_PLACE, i, 1, MPI_INTEGER, MPI_SUM, dest, mp_comm, ierror)
    else
       call mpi_reduce &
            (i, i, 1, MPI_INTEGER, MPI_SUM, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(i)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine sum_reduce_integer

  !> FIXME : Add documentation
  subroutine sum_reduce_integer_array (i, dest)
    implicit none
    integer, dimension (:), intent (in out) :: i
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest)then
       call mpi_reduce &
            (MPI_IN_PLACE, i, size(i), MPI_INTEGER, MPI_SUM, dest, mp_comm, ierror)
    else
       call mpi_reduce &
            (i, i, size(i), MPI_INTEGER, MPI_SUM, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(i)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine sum_reduce_integer_array

  !> FIXME : Add documentation
  subroutine sum_reduce_integer_2array (a, dest)
    implicit none
    integer, dimension (:,:), intent (in out) :: a
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest)then
       call mpi_reduce &
         (MPI_IN_PLACE, a, size(a), MPI_INTEGER, MPI_SUM, dest, mp_comm, ierror)
    else
       call mpi_reduce &
         (a, a, size(a), MPI_INTEGER, MPI_SUM, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine sum_reduce_integer_2array

  !> FIXME : Add documentation
  subroutine sum_reduce_logical (a, dest)
    implicit none
    logical, intent (in out) :: a
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest)then
       call mpi_reduce &
            (MPI_IN_PLACE, a, 1, MPI_LOGICAL, MPI_LOR, dest, mp_comm, ierror)
    else
       call mpi_reduce &
            (a, a, 1, MPI_LOGICAL, MPI_LOR, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine sum_reduce_logical

  !> FIXME : Add documentation
  subroutine sum_reduce_real (a, dest)
    implicit none
    real, intent (in out) :: a
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest)then
       call mpi_reduce &
            (MPI_IN_PLACE, a, 1, mpireal, MPI_SUM, dest, mp_comm, ierror)
    else
       call mpi_reduce &
            (a, a, 1, mpireal, MPI_SUM, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine sum_reduce_real

  !> FIXME : Add documentation
  subroutine sum_reduce_real_array (a, dest)
    implicit none
    real, dimension (:), intent (in out) :: a
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest)then
       call mpi_reduce &
         (MPI_IN_PLACE, a, size(a), mpireal, MPI_SUM, dest, mp_comm, ierror)
    else
       call mpi_reduce &
         (a, a, size(a), mpireal, MPI_SUM, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine sum_reduce_real_array

  !> FIXME : Add documentation
  subroutine sum_reduce_real_2array (a, dest)
    implicit none
    real, dimension (:,:), intent (in out) :: a
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest)then
       call mpi_reduce &
         (MPI_IN_PLACE, a, size(a), mpireal, MPI_SUM, dest, mp_comm, ierror)
    else
       call mpi_reduce &
         (a, a, size(a), mpireal, MPI_SUM, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine sum_reduce_real_2array

  !> FIXME : Add documentation
  subroutine sum_reduce_real_3array (a, dest)
    implicit none
    real, dimension (:,:,:), intent (in out) :: a
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest)then
       call mpi_reduce &
         (MPI_IN_PLACE, a, size(a), mpireal, MPI_SUM, dest, mp_comm, ierror)
    else
       call mpi_reduce &
         (a, a, size(a), mpireal, MPI_SUM, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine sum_reduce_real_3array

  !> FIXME : Add documentation
  subroutine sum_reduce_real_4array (a, dest)
    implicit none
    real, dimension (:,:,:,:), intent (in out) :: a
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest)then
       call mpi_reduce &
         (MPI_IN_PLACE, a, size(a), mpireal, MPI_SUM, dest, mp_comm, ierror)
    else
       call mpi_reduce &
         (a, a, size(a), mpireal, MPI_SUM, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine sum_reduce_real_4array

  !> FIXME : Add documentation
  subroutine sum_reduce_real_5array (a, dest)
    implicit none
    real, dimension (:,:,:,:,:), intent (in out) :: a
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest)then
       call mpi_reduce &
         (MPI_IN_PLACE, a, size(a), mpireal, MPI_SUM, dest, mp_comm, ierror)
    else
       call mpi_reduce &
         (a, a, size(a), mpireal, MPI_SUM, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine sum_reduce_real_5array

  !> FIXME : Add documentation
  subroutine sum_reduce_complex (z, dest)
    implicit none
    complex, intent (in out) :: z
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest) then
       call mpi_reduce &
            (MPI_IN_PLACE, z, 1, mpicmplx, MPI_SUM, dest, mp_comm, ierror)
    else
       call mpi_reduce &
            (z, z, 1, mpicmplx, MPI_SUM, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine sum_reduce_complex

  !> FIXME : Add documentation
  subroutine sum_reduce_complex_array (z, dest)
    implicit none
    complex, dimension (:), intent (in out) :: z
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest) then
       call mpi_reduce &
            (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, dest, mp_comm, ierror)
    else
       call mpi_reduce &
            (z, z, size(z), mpicmplx, MPI_SUM, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine sum_reduce_complex_array

  !> FIXME : Add documentation
  subroutine sum_reduce_complex_2array (z, dest)
    implicit none
    complex, dimension (:,:), intent (in out) :: z
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest) then
       call mpi_reduce &
            (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, dest, mp_comm, ierror)
    else
       call mpi_reduce &
            (z, z, size(z), mpicmplx, MPI_SUM, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine sum_reduce_complex_2array

  !> FIXME : Add documentation
  subroutine sum_reduce_complex_3array (z, dest)
    implicit none
    complex, dimension (:,:,:), intent (in out) :: z
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest) then
       call mpi_reduce &
            (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, dest, mp_comm, ierror)
    else
       call mpi_reduce &
            (z, z, size(z), mpicmplx, MPI_SUM, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine sum_reduce_complex_3array

  !> FIXME : Add documentation
  subroutine sum_reduce_complex_4array (z, dest)
    implicit none
    complex, dimension (:,:,:,:), intent (in out) :: z
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest) then
       call mpi_reduce &
            (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, dest, mp_comm, ierror)
    else
       call mpi_reduce &
            (z, z, size(z), mpicmplx, MPI_SUM, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine sum_reduce_complex_4array

  !> FIXME : Add documentation
  subroutine sum_reduce_complex_5array (z, dest)
    implicit none
    complex, dimension (:,:,:,:,:), intent (in out) :: z
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if (iproc.eq.dest) then
       call mpi_reduce &
            (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, dest, mp_comm, ierror)
    else
       call mpi_reduce &
            (z, z, size(z), mpicmplx, MPI_SUM, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine sum_reduce_complex_5array

!******************NON-BLOCKING SUM REDUCE*************************

  !> FIXME : Add documentation
  subroutine nb_sum_reduce_complex (z, dest, request)
    implicit none
    complex, intent (in out) :: z
    integer, intent (in) :: dest
    integer, intent (out) :: request
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest) then
       call mpi_ireduce &
            (MPI_IN_PLACE, z, 1, mpicmplx, MPI_SUM, dest, mp_comm, request, ierror)
    else
       call mpi_ireduce &
            (z, z, 1, mpicmplx, MPI_SUM, dest, mp_comm, request, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    call sum_reduce(z, dest)
    request = mp_request_null
# endif
  end subroutine nb_sum_reduce_complex

  !> FIXME : Add documentation
  subroutine nb_sum_reduce_complex_array (z, dest, request)
    implicit none
    complex, dimension (:), intent (in out) :: z
    integer, intent (in) :: dest
    integer, intent (out) :: request
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest) then
       call mpi_ireduce &
            (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, dest, mp_comm, request, ierror)
    else
       call mpi_ireduce &
            (z, z, size(z), mpicmplx, MPI_SUM, dest, mp_comm, request, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    call sum_reduce(z, dest)
    request = mp_request_null
# endif
  end subroutine nb_sum_reduce_complex_array

  !> FIXME : Add documentation
  subroutine nb_sum_reduce_complex_2array (z, dest, request)
    implicit none
    complex, dimension (:,:), intent (in out) :: z
    integer, intent (in) :: dest
    integer, intent (out) :: request
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest) then
       call mpi_ireduce &
            (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, dest, mp_comm, request, ierror)
    else
       call mpi_ireduce &
            (z, z, size(z), mpicmplx, MPI_SUM, dest, mp_comm, request, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    call sum_reduce(z, dest)
    request = mp_request_null
# endif
  end subroutine nb_sum_reduce_complex_2array

  !> FIXME : Add documentation
  subroutine nb_sum_reduce_complex_3array (z, dest, request)
    implicit none
    complex, dimension (:,:,:), intent (in out) :: z
    integer, intent (in) :: dest
    integer, intent (out) :: request
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest) then
       call mpi_ireduce &
            (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, dest, mp_comm, request, ierror)
    else
       call mpi_ireduce &
            (z, z, size(z), mpicmplx, MPI_SUM, dest, mp_comm, request, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    call sum_reduce_complex_3array(z, dest)
    request = mp_request_null
# endif
  end subroutine nb_sum_reduce_complex_3array

  !> FIXME : Add documentation
  subroutine nb_sum_reduce_complex_4array (z, dest, request)
    implicit none
    complex, dimension (:,:,:,:), intent (in out) :: z
    integer, intent (in) :: dest
    integer, intent (out) :: request
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest) then
       call mpi_ireduce &
            (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, dest, mp_comm, request, ierror)
    else
       call mpi_ireduce &
            (z, z, size(z), mpicmplx, MPI_SUM, dest, mp_comm, request, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    call sum_reduce_complex_4array(z, dest)
    request = mp_request_null
# endif
  end subroutine nb_sum_reduce_complex_4array

  !> FIXME : Add documentation
  subroutine nb_sum_reduce_complex_5array (z, dest, request)
    implicit none
    complex, dimension (:,:,:,:,:), intent (in out) :: z
    integer, intent (in) :: dest
    integer, intent (out) :: request
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if (iproc.eq.dest) then
       call mpi_ireduce &
            (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, dest, mp_comm, request, ierror)
    else
       call mpi_ireduce &
            (z, z, size(z), mpicmplx, MPI_SUM, dest, mp_comm, request, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    call sum_reduce(z, dest)
    request = mp_request_null
# endif
  end subroutine nb_sum_reduce_complex_5array


!******************SUM REDUCE SUB*************************

  !> FIXME : Add documentation
  subroutine sum_reduce_complex_array_sub (z, dest, sub)
    implicit none
    complex, dimension (:), intent (in out) :: z
    integer, intent (in) :: dest
    type(comm_type), intent(in) :: sub
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(sub%iproc.eq.dest) then
       call mpi_reduce &
            (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, dest, sub%id, ierror)
    else
       call mpi_reduce &
            (z, z, size(z), mpicmplx, MPI_SUM, dest, sub%id, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z); UNUSED_DUMMY(sub)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine sum_reduce_complex_array_sub

  !> FIXME : Add documentation
  subroutine sum_reduce_complex_2array_sub (z, dest, sub)
    implicit none
    complex, dimension (:,:), intent (in out) :: z
    integer, intent (in) :: dest
    type(comm_type), intent(in) :: sub
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(sub%iproc.eq.dest) then
       call mpi_reduce &
            (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, dest, sub%id, ierror)
    else
       call mpi_reduce &
            (z, z, size(z), mpicmplx, MPI_SUM, dest, sub%id, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z); UNUSED_DUMMY(sub)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine sum_reduce_complex_2array_sub

  !> FIXME : Add documentation
  subroutine sum_reduce_complex_3array_sub (z, dest, sub)
    implicit none
    complex, dimension (:,:,:), intent (in out) :: z
    integer, intent (in) :: dest
    type(comm_type), intent(in) :: sub
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(sub%iproc.eq.dest) then
       call mpi_reduce &
            (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, dest, sub%id, ierror)
    else
       call mpi_reduce &
            (z, z, size(z), mpicmplx, MPI_SUM, dest, sub%id, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z); UNUSED_DUMMY(sub)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine sum_reduce_complex_3array_sub

  !> FIXME : Add documentation
  subroutine sum_reduce_complex_4array_sub (z, dest, sub)
    implicit none
    complex, dimension (:,:,:,:), intent (in out) :: z
    integer, intent (in) :: dest
    type(comm_type), intent(in) :: sub
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(sub%iproc.eq.dest) then
       call mpi_reduce &
            (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, dest, sub%id, ierror)
    else
       call mpi_reduce &
            (z, z, size(z), mpicmplx, MPI_SUM, dest, sub%id, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z); UNUSED_DUMMY(sub)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine sum_reduce_complex_4array_sub

!******************NON-BLOCKING SUM REDUCE SUB*************************

  !> FIXME : Add documentation
  subroutine nb_sum_reduce_complex_array_sub (z, dest, sub, request)
    implicit none
    complex, dimension (:), intent (in out) :: z
    integer, intent (in) :: dest
    type(comm_type), intent(in) :: sub
    integer, intent (out) :: request
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(sub%iproc.eq.dest) then
       call mpi_ireduce &
            (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, dest, sub%id, request, ierror)
    else
       call mpi_ireduce &
            (z, z, size(z), mpicmplx, MPI_SUM, dest, sub%id, request, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    call sum_reduce_complex_array_sub(z, dest, sub)
    request = mp_request_null
# endif
  end subroutine nb_sum_reduce_complex_array_sub

  !> FIXME : Add documentation
  subroutine nb_sum_reduce_complex_4array_sub (z, dest, sub, request)
    implicit none
    complex, dimension (:,:,:,:), intent (in out) :: z
    integer, intent (in) :: dest
    type(comm_type), intent(in) :: sub
    integer, intent (out) :: request
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(sub%iproc.eq.dest) then
       call mpi_ireduce &
            (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, dest, sub%id, request, ierror)
    else
       call mpi_ireduce &
            (z, z, size(z), mpicmplx, MPI_SUM, dest, sub%id, request, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    call sum_reduce_complex_4array_sub(z, dest, sub)
    request = mp_request_null
# endif
  end subroutine nb_sum_reduce_complex_4array_sub


!******************SUM ALLREDUCE*************************

  !> FIXME : Add documentation
  subroutine sum_allreduce_integer (i)
    implicit none
    integer, intent (in out) :: i
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, i, 1, MPI_INTEGER, MPI_SUM, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(i)
# endif
  end subroutine sum_allreduce_integer

  !> FIXME : Add documentation
  subroutine sum_allreduce_integer_array (i)
    implicit none
    integer, dimension (:), intent (in out) :: i
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, i, size(i), MPI_INTEGER, MPI_SUM, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(i)
# endif
  end subroutine sum_allreduce_integer_array

  !> FIXME : Add documentation
  subroutine sum_allreduce_integer_2array (i)
    implicit none
    integer, dimension (:,:), intent (in out) :: i
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, i, size(i), MPI_INTEGER, MPI_SUM, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(i)
# endif
  end subroutine sum_allreduce_integer_2array

  !> FIXME : Add documentation
  subroutine sum_allreduce_integer_3array (i)
    implicit none
    integer, dimension (:,:,:), intent (in out) :: i
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, i, size(i), MPI_INTEGER, MPI_SUM, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(i)
# endif
  end subroutine sum_allreduce_integer_3array

  !> FIXME : Add documentation
  subroutine sum_allreduce_real (a)
    implicit none
    real, intent (in out) :: a
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, a, 1, mpireal, MPI_SUM, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
# endif
  end subroutine sum_allreduce_real

  !> FIXME : Add documentation
  subroutine sum_allreduce_real_array (a)
    implicit none
    real, dimension (:), intent (in out) :: a
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, a, size(a), mpireal, MPI_SUM, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
# endif
  end subroutine sum_allreduce_real_array

  !> FIXME : Add documentation
  subroutine sum_allreduce_real_2array (a)
    implicit none
    real, dimension (:,:), intent (in out) :: a
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, a, size(a), mpireal, MPI_SUM, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
# endif
  end subroutine sum_allreduce_real_2array

  !> FIXME : Add documentation
  subroutine sum_allreduce_real_3array (a)
    implicit none
    real, dimension (:,:,:), intent (in out) :: a
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, a, size(a), mpireal, MPI_SUM, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
# endif
  end subroutine sum_allreduce_real_3array

  !> FIXME : Add documentation
  subroutine sum_allreduce_real_4array (a)
    implicit none
    real, dimension (:,:,:,:), intent (in out) :: a
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, a, size(a), mpireal, MPI_SUM, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
# endif
  end subroutine sum_allreduce_real_4array

  !> FIXME : Add documentation
  subroutine sum_allreduce_real_5array (a)
    implicit none
    real, dimension (:,:,:,:,:), intent (in out) :: a
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, a, size(a), mpireal, MPI_SUM, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
# endif
  end subroutine sum_allreduce_real_5array

  !> FIXME : Add documentation
  subroutine sum_allreduce_complex (z)
    implicit none
    complex, intent (in out) :: z
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, z, 1, mpicmplx, MPI_SUM, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
# endif
  end subroutine sum_allreduce_complex

  !> FIXME : Add documentation
  subroutine sum_allreduce_complex_array (z)
    implicit none
    complex, dimension (:), intent (in out) :: z
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
# endif
  end subroutine sum_allreduce_complex_array

  !> FIXME : Add documentation
  subroutine sum_allreduce_complex_2array (z)
    implicit none
    complex, dimension (:,:), intent (in out) :: z
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
# endif
  end subroutine sum_allreduce_complex_2array

  !> FIXME : Add documentation
  subroutine sum_allreduce_complex_3array (z)
    implicit none
    complex, dimension (:,:,:), intent (in out) :: z
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
# endif
  end subroutine sum_allreduce_complex_3array

  !> FIXME : Add documentation
  subroutine sum_allreduce_complex_4array (z)
    implicit none
    complex, dimension (:,:,:,:), intent (in out) :: z
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
# endif
  end subroutine sum_allreduce_complex_4array

  !> FIXME : Add documentation
  subroutine sum_allreduce_complex_5array (z)
    implicit none
    complex, dimension (:,:,:,:,:), intent (in out) :: z
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z)
# endif
  end subroutine sum_allreduce_complex_5array
  !/Sub-communicator allreduce

  !> FIXME : Add documentation
  subroutine sum_allreduce_sub_integer (i,sub_comm)
    implicit none
    integer, intent (in out) :: i
    integer, intent(in) :: sub_comm
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, i, 1, MPI_INTEGER, MPI_SUM, sub_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(sub_comm); UNUSED_DUMMY(i)
# endif
  end subroutine sum_allreduce_sub_integer

  !> FIXME : Add documentation
  subroutine sum_allreduce_sub_integer_array (i,sub_comm)
    implicit none
    integer, dimension (:), intent (in out) :: i
    integer, intent(in) :: sub_comm
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, i, size(i), MPI_INTEGER, MPI_SUM, sub_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(sub_comm); UNUSED_DUMMY(i)
# endif
  end subroutine sum_allreduce_sub_integer_array

  !> FIXME : Add documentation
  subroutine sum_allreduce_sub_real (a,sub_comm)
    implicit none
    real, intent (in out) :: a
    integer, intent(in) :: sub_comm
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, a, 1, mpireal, MPI_SUM, sub_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(sub_comm); UNUSED_DUMMY(a)
# endif
  end subroutine sum_allreduce_sub_real

  !> FIXME : Add documentation
  subroutine sum_allreduce_sub_real_array (a,sub_comm)
    implicit none
    real, dimension (:), intent (in out) :: a
    integer, intent(in) :: sub_comm
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, a, size(a), mpireal, MPI_SUM, sub_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(sub_comm); UNUSED_DUMMY(a)
# endif
  end subroutine sum_allreduce_sub_real_array

  !> FIXME : Add documentation
  subroutine sum_allreduce_sub_real_2array (a,sub_comm)
    implicit none
    real, dimension (:,:), intent (in out) :: a
    integer, intent(in) :: sub_comm
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, a, size(a), mpireal, MPI_SUM, sub_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(sub_comm); UNUSED_DUMMY(a)
# endif
  end subroutine sum_allreduce_sub_real_2array

  !> FIXME : Add documentation
  subroutine sum_allreduce_sub_real_3array (a,sub_comm)
    implicit none
    real, dimension (:,:,:), intent (in out) :: a
    integer, intent(in) :: sub_comm
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, a, size(a), mpireal, MPI_SUM, sub_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(sub_comm); UNUSED_DUMMY(a)
# endif
  end subroutine sum_allreduce_sub_real_3array

  !> FIXME : Add documentation
  subroutine sum_allreduce_sub_real_4array (a,sub_comm)
    implicit none
    real, dimension (:,:,:,:), intent (in out) :: a
    integer, intent(in) :: sub_comm
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, a, size(a), mpireal, MPI_SUM, sub_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(sub_comm); UNUSED_DUMMY(a)
# endif
  end subroutine sum_allreduce_sub_real_4array

  !> FIXME : Add documentation
  subroutine sum_allreduce_sub_real_5array (a,sub_comm)
    implicit none
    real, dimension (:,:,:,:,:), intent (in out) :: a
    integer, intent(in) :: sub_comm
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, a, size(a), mpireal, MPI_SUM, sub_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(sub_comm); UNUSED_DUMMY(a)
# endif
  end subroutine sum_allreduce_sub_real_5array

  !> FIXME : Add documentation
  subroutine sum_allreduce_sub_complex (z,sub_comm)
    implicit none
    complex, intent (in out) :: z
    integer, intent(in) :: sub_comm
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, z, 1, mpicmplx, MPI_SUM, sub_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(sub_comm); UNUSED_DUMMY(z)
# endif
  end subroutine sum_allreduce_sub_complex

  !> FIXME : Add documentation
  subroutine sum_allreduce_sub_complex_array (z,sub_comm)
    implicit none
    complex, dimension (:), intent (in out) :: z
    integer, intent(in) :: sub_comm
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, sub_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(sub_comm); UNUSED_DUMMY(z)
# endif
  end subroutine sum_allreduce_sub_complex_array

  !> FIXME : Add documentation
  subroutine sum_allreduce_sub_complex_2array (z,sub_comm)
    implicit none
    complex, dimension (:,:), intent (in out) :: z
    integer, intent(in) :: sub_comm
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, sub_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(sub_comm); UNUSED_DUMMY(z)
# endif
  end subroutine sum_allreduce_sub_complex_2array

  !> FIXME : Add documentation
  subroutine sum_allreduce_sub_complex_3array (z,sub_comm)
    implicit none
    complex, dimension (:,:,:), intent (in out) :: z
    integer, intent(in) :: sub_comm
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, sub_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(sub_comm); UNUSED_DUMMY(z)
# endif
  end subroutine sum_allreduce_sub_complex_3array

  !> FIXME : Add documentation
  subroutine sum_allreduce_sub_complex_4array (z,sub_comm)
    implicit none
    complex, dimension (:,:,:,:), intent (in out) :: z
    integer, intent(in) :: sub_comm
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, sub_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(sub_comm); UNUSED_DUMMY(z)
# endif
  end subroutine sum_allreduce_sub_complex_4array

  !> FIXME : Add documentation
  subroutine sum_allreduce_sub_complex_5array (z,sub_comm)
    implicit none
    complex, dimension (:,:,:,:,:), intent (in out) :: z
    integer, intent(in) :: sub_comm
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, sub_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(sub_comm); UNUSED_DUMMY(z)
# endif
  end subroutine sum_allreduce_sub_complex_5array

!******************NON-BLOCKING SUM ALLREDUCE SUB*************************

  !> FIXME : Add documentation
  subroutine nb_sum_allreduce_sub_complex_2array (z,sub_comm,request)
    implicit none
    complex, dimension (:,:), intent (in out) :: z
    integer, intent(in) :: sub_comm
    integer, intent(out) :: request
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_iallreduce &
         (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, sub_comm, request, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    call sum_allreduce_sub(z, sub_comm)
    request = mp_request_null
# endif
  end subroutine nb_sum_allreduce_sub_complex_2array

  !> FIXME : Add documentation
  subroutine nb_sum_allreduce_sub_complex_4array (z,sub_comm,request)
    implicit none
    complex, dimension (:,:,:,:), intent (in out) :: z
    integer, intent(in) :: sub_comm
    integer, intent(out) :: request
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_iallreduce &
         (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, sub_comm, request, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    call sum_allreduce_sub(z, sub_comm)
    request = mp_request_null
# endif
  end subroutine nb_sum_allreduce_sub_complex_4array

!******************NON-BLOCKING SUM ALLREDUCE*************************

  !> FIXME : Add documentation
  subroutine nb_sum_allreduce_integer (i, request)
    implicit none
    integer, intent (in out) :: i
    integer, intent (out) :: request
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_iallreduce &
         (MPI_IN_PLACE, i, 1, MPI_INTEGER, MPI_SUM, mp_comm, request, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    call sum_allreduce(i)
    request = mp_request_null
# endif
  end subroutine nb_sum_allreduce_integer

  !> FIXME : Add documentation
  subroutine nb_sum_allreduce_complex_array (z, request)
    implicit none
    complex, dimension (:), intent (in out) :: z
    integer, intent (out) :: request
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_iallreduce &
         (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, mp_comm, request, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    call sum_allreduce(z)
    request = mp_request_null
# endif
  end subroutine nb_sum_allreduce_complex_array

  !> FIXME : Add documentation
  subroutine nb_sum_allreduce_complex_3array (z, request)
    implicit none
    complex, dimension (:,:,:), intent (in out) :: z
    integer, intent (out) :: request
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_iallreduce &
         (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, mp_comm, request, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    call sum_allreduce(z)
    request = mp_request_null
# endif
  end subroutine nb_sum_allreduce_complex_3array

  !> FIXME : Add documentation
  subroutine nb_sum_allreduce_complex_4array (z, request)
    implicit none
    complex, dimension (:,:,:,:), intent (in out) :: z
    integer, intent (out) :: request
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_iallreduce &
         (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, mp_comm, request, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    call sum_allreduce(z)
    request = mp_request_null
# endif
  end subroutine nb_sum_allreduce_complex_4array

  !> FIXME : Add documentation
  subroutine nb_sum_allreduce_complex_5array (z, request)
    implicit none
    complex, dimension (:,:,:,:,:), intent (in out) :: z
    integer, intent (out) :: request
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_iallreduce &
         (MPI_IN_PLACE, z, size(z), mpicmplx, MPI_SUM, mp_comm, request, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    call sum_allreduce(z)
    request = mp_request_null
# endif
  end subroutine nb_sum_allreduce_complex_5array

!*******************MAX REDUCE*************************

  !> FIXME : Add documentation
  subroutine max_reduce_integer (i, dest)
    implicit none
    integer, intent (in out) :: i
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest)then
       call mpi_reduce &
            (MPI_IN_PLACE, i, 1, MPI_INTEGER, MPI_MAX, dest, mp_comm, ierror)
    else
       call mpi_reduce &
            (i, i, 1, MPI_INTEGER, MPI_MAX, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(i)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine max_reduce_integer

  !> FIXME : Add documentation
  subroutine max_reduce_integer_array (i, dest)
    implicit none
    integer, dimension (:), intent (in out) :: i
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest)then
       call mpi_reduce &
            (MPI_IN_PLACE, i, size(i), MPI_INTEGER, MPI_MAX, dest, mp_comm, ierror)
    else
       call mpi_reduce &
            (i, i, size(i), MPI_INTEGER, MPI_MAX, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(i)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine max_reduce_integer_array

  !> FIXME : Add documentation
  subroutine max_reduce_real (a, dest)
    implicit none
    real, intent (in out) :: a
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest)then
       call mpi_reduce &
            (MPI_IN_PLACE, a, 1, mpireal, MPI_MAX, dest, mp_comm, ierror)
    else
       call mpi_reduce &
            (a, a, 1, mpireal, MPI_MAX, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine max_reduce_real

  !> FIXME : Add documentation
  subroutine max_reduce_real_array (a, dest)
    implicit none
    real, dimension (:), intent (in out) :: a
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest)then
       call mpi_reduce &
            (MPI_IN_PLACE, a, size(a), mpireal, MPI_MAX, dest, mp_comm, ierror)
    else
       call mpi_reduce &
            (a, a, size(a), mpireal, MPI_MAX, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine max_reduce_real_array

  !> FIXME : Add documentation
  subroutine max_allreduce_integer (i)
    implicit none
    integer, intent (in out) :: i
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, i, 1, MPI_INTEGER, MPI_MAX, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(i)
# endif
  end subroutine max_allreduce_integer

  !> FIXME : Add documentation
  subroutine max_allreduce_integer_array (i)
    implicit none
    integer, dimension (:), intent (in out) :: i
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, i, size(i), MPI_INTEGER, MPI_MAX, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(i)
# endif
  end subroutine max_allreduce_integer_array

  !> FIXME : Add documentation
  subroutine max_allreduce_real (a)
    implicit none
    real, intent (in out) :: a
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, a, 1, mpireal, MPI_MAX, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
# endif
  end subroutine max_allreduce_real

  !> FIXME : Add documentation
  subroutine max_allreduce_real_array (a)
    implicit none
    real, dimension (:), intent (in out) :: a
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, a, size(a), mpireal, MPI_MAX, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
# endif
  end subroutine max_allreduce_real_array

  !> FIXME : Add documentation
  subroutine maxloc_allreduce_real(a,i)
    implicit none
    real, intent (in out) :: a
    integer, intent (in out) :: i
# ifdef MPI
    real, dimension(:,:), allocatable :: ai
    integer :: ierror

    allocate (ai(1,2))
    ai(1,1)=a
    ai(1,2)=real(i,kind=kind(a))
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, ai, 1, mpi2real, MPI_MAXLOC, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    a=ai(1,1)
    i=int(ai(1,2))
    deallocate(ai)
# else
    UNUSED_DUMMY(a) ; UNUSED_DUMMY(i)
# endif
  end subroutine maxloc_allreduce_real

  !> FIXME : Add documentation
  subroutine maxloc_allreduce_real_array (a,i)
    implicit none
    real, dimension (:), intent (in out) :: a
    integer, dimension (:), intent (in out) :: i
# ifdef MPI
    real, dimension(:,:), allocatable :: ai
    integer :: ierror

    allocate (ai(size(a),2))
    ai(:,1)=a(:)
    ai(:,2)=real(i(:),kind=kind(a(1)))
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, ai, size(a), mpi2real, MPI_MAXLOC, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    a(:)=ai(:,1)
    i(:)=int(ai(:,2))
    deallocate(ai)
# else
    UNUSED_DUMMY(a) ; UNUSED_DUMMY(i)
# endif
  end subroutine maxloc_allreduce_real_array

  !> FIXME : Add documentation
  subroutine nb_max_allreduce_integer (i,request)
    implicit none
    integer, intent (in out) :: i
    integer, intent (out) :: request
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_iallreduce &
         (MPI_IN_PLACE, i, 1, MPI_INTEGER, MPI_MAX, mp_comm, request, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    call max_allreduce(i)
    request = mp_request_null
# endif
  end subroutine nb_max_allreduce_integer

  !> FIXME : Add documentation
  subroutine nb_max_allreduce_integer_array (i, request)
    implicit none
    integer, dimension (:), intent (in out) :: i
    integer, intent (out) :: request
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_iallreduce &
         (MPI_IN_PLACE, i, size(i), MPI_INTEGER, MPI_MAX, mp_comm, request, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    call max_allreduce(i)
    request = mp_request_null
# endif
  end subroutine nb_max_allreduce_integer_array

  !> FIXME : Add documentation
  subroutine nb_max_allreduce_real (a, request)
    implicit none
    real, intent (in out) :: a
    integer, intent (out) :: request
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_iallreduce &
         (MPI_IN_PLACE, a, 1, mpireal, MPI_MAX, mp_comm, request, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    call max_allreduce(a)
    request = mp_request_null
# endif
  end subroutine nb_max_allreduce_real

  !> FIXME : Add documentation
  subroutine nb_max_allreduce_real_array (a, request)
    implicit none
    real, dimension (:), intent (in out) :: a
    integer, intent (out) :: request
# ifdef MPI3
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_iallreduce &
         (MPI_IN_PLACE, a, size(a), mpireal, MPI_MAX, mp_comm, request, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    call max_allreduce(a)
    request = mp_request_null
# endif
  end subroutine nb_max_allreduce_real_array

  !> FIXME : Add documentation
  subroutine min_reduce_integer (i, dest)
    implicit none
    integer, intent (in out) :: i
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest)then
       call mpi_reduce &
            (MPI_IN_PLACE, i, 1, MPI_INTEGER, MPI_MIN, dest, mp_comm, ierror)
    else
       call mpi_reduce &
            (i, i, 1, MPI_INTEGER, MPI_MIN, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(i)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine min_reduce_integer

  !> FIXME : Add documentation
  subroutine min_reduce_integer_array (i, dest)
    implicit none
    integer, dimension (:), intent (in out) :: i
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest)then
       call mpi_reduce &
            (MPI_IN_PLACE, i, size(i), MPI_INTEGER, MPI_MIN, dest, mp_comm, ierror)
    else
       call mpi_reduce &
            (i, i, size(i), MPI_INTEGER, MPI_MIN, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(i)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine min_reduce_integer_array

  !> FIXME : Add documentation
  subroutine min_reduce_real (a, dest)
    implicit none
    real, intent (in out) :: a
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest)then
       call mpi_reduce &
            (MPI_IN_PLACE, a, 1, mpireal, MPI_MIN, dest, mp_comm, ierror)
    else
       call mpi_reduce &
            (a, a, 1, mpireal, MPI_MIN, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine min_reduce_real

  !> FIXME : Add documentation
  subroutine min_reduce_real_array (a, dest)
    implicit none
    real, dimension (:), intent (in out) :: a
    integer, intent (in) :: dest
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    if(iproc.eq.dest)then
       call mpi_reduce &
            (MPI_IN_PLACE, a, size(a), mpireal, MPI_MIN, dest, mp_comm, ierror)
    else
       call mpi_reduce &
            (a, a, size(a), mpireal, MPI_MIN, dest, mp_comm, ierror)
    endif
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
    if (dest /= 0) call mp_abort ("reduce to")
# endif
  end subroutine min_reduce_real_array

  !> FIXME : Add documentation
  subroutine min_allreduce_integer (i)
    implicit none
    integer, intent (in out) :: i
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, i, 1, MPI_INTEGER, MPI_MIN, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(i)
# endif
  end subroutine min_allreduce_integer

  !> FIXME : Add documentation
  subroutine min_allreduce_integer_array (i)
    implicit none
    integer, dimension (:), intent (in out) :: i
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, i, size(i), MPI_INTEGER, MPI_MIN, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(i)
# endif
  end subroutine min_allreduce_integer_array

  !> FIXME : Add documentation
  subroutine min_allreduce_real (a)
    implicit none
    real, intent (in out) :: a
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, a, 1, mpireal, MPI_MIN, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
# endif
  end subroutine min_allreduce_real

  !> FIXME : Add documentation
  subroutine min_allreduce_real_array (a)
    implicit none
    real, dimension (:), intent (in out) :: a
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, a, size(a), mpireal, MPI_MIN, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(a)
# endif
  end subroutine min_allreduce_real_array

  !> FIXME : Add documentation
  subroutine min_allreduce_sub_integer (i, sub_comm)
    implicit none
    integer, intent (in out) :: i
    integer, intent(in) :: sub_comm
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, i, 1, MPI_INTEGER, MPI_MIN, sub_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(i); UNUSED_DUMMY(sub_comm)
# endif
  end subroutine min_allreduce_sub_integer

! ****************** LAND ALLREDUCE*******************

  !> FIXME : Add documentation
  subroutine land_allreduce_single_element (l)
    implicit none
    logical, intent (in out) :: l
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
    call mpi_allreduce &
         (MPI_IN_PLACE, l, 1, MPI_LOGICAL, MPI_LAND, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_collectives, ' MPI Collectives')
!$OMP END MASTER
# else
    UNUSED_DUMMY(l)
# endif
  end subroutine land_allreduce_single_element
! ********************* barrier **********************

  !> FIXME : Add documentation
  subroutine barrier_nocomm
# ifdef MPI
    implicit none
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
    call mpi_barrier (mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
# endif
  end subroutine barrier_nocomm

  subroutine barrier_comm(comm)
    implicit none
    integer,intent(in)::comm
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
    call mpi_barrier (comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
# else
    UNUSED_DUMMY(comm)
# endif
  end subroutine barrier_comm

! ********************* sends **********************

  !> FIXME : Add documentation
  subroutine send_integer (i, dest, tag)
    implicit none
    integer, intent (in) :: i
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_send (i, 1, MPI_INTEGER, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(i)
# endif
  end subroutine send_integer

  !> FIXME : Add documentation
  subroutine send_integer_array (i, dest, tag)
    implicit none
    integer, dimension (:), intent (in) :: i
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_send (i, size(i), MPI_INTEGER, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(i)
# endif
  end subroutine send_integer_array

  !> FIXME : Add documentation
  subroutine send_real (a, dest, tag)
    implicit none
    real, intent (in) :: a
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_send (a, 1, mpireal, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(a)
# endif
  end subroutine send_real

  !> FIXME : Add documentation
  subroutine send_real_array (a, dest, tag)
    implicit none
    real, dimension (:), intent (in) :: a
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_send (a, size(a), mpireal, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(a)
# endif
  end subroutine send_real_array

  !> FIXME : Add documentation
  subroutine send_real_4d_array (a, dest, tag)
    implicit none
    real, dimension (:,:,:,:), intent (in) :: a
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_send (a, size(a), mpireal, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(a)
# endif
  end subroutine send_real_4d_array

  !> FIXME : Add documentation
  subroutine send_real_5d_array (a, dest, tag)
    implicit none
    real, dimension (:,:,:,:,:), intent (in) :: a
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_send (a, size(a), mpireal, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(a)
# endif
  end subroutine send_real_5d_array

  !> FIXME : Add documentation
  subroutine send_complex (z, dest, tag)
    implicit none
    complex, intent (in) :: z
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_send (z, 1, mpicmplx, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(z)
# endif
  end subroutine send_complex

  !> FIXME : Add documentation
  subroutine send_complex_array (z, dest, tag)
    implicit none
    complex, dimension (:), intent (in) :: z
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_send (z, size(z), mpicmplx, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(z)
# endif
  end subroutine send_complex_array

  !> FIXME : Add documentation
  subroutine send_complex_2d_array (z, dest, tag)
    implicit none
    complex, dimension (:,:), intent (in) :: z
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_send (z, size(z), mpicmplx, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(z)
# endif
  end subroutine send_complex_2d_array

  !> FIXME : Add documentation
  subroutine send_complex_3d_array (z, dest, tag)
    implicit none
    complex, dimension (:,:,:), intent (in) :: z
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_send (z, size(z), mpicmplx, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(z)
# endif
  end subroutine send_complex_3d_array

  !> FIXME : Add documentation
  subroutine nonblocking_send_complex_array (z, dest, tag, request)
    implicit none
    complex, dimension (:), intent (in) :: z
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
    integer, intent (out) :: request
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_isend (z, size(z), mpicmplx, dest, tagp, mp_comm, request, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(z)
    request = 0
# endif
  end subroutine nonblocking_send_complex_array

  !> FIXME : Add documentation
  subroutine send_logical (f, dest, tag)
    implicit none
    logical, intent (in) :: f
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_send (f, 1, MPI_LOGICAL, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(f)
# endif
  end subroutine send_logical

  !> FIXME : Add documentation
  subroutine send_logical_array (f, dest, tag)
    implicit none
    logical, dimension (:), intent (in) :: f
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_send (f, size(f), MPI_LOGICAL, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(f)
# endif
  end subroutine send_logical_array

  !> FIXME : Add documentation
  subroutine send_character (s, dest, tag)
    implicit none
    character(*), intent (in) :: s
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_send &
         (s, len(s), MPI_CHARACTER, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(s)
# endif
  end subroutine send_character

! MAB> needed for Trinity
! ********************* synchronous sends **********************

  !> FIXME : Add documentation
  subroutine ssend_integer (i, dest, tag)
    implicit none
    integer, intent (in) :: i
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_ssend (i, 1, MPI_INTEGER, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(i)
# endif
  end subroutine ssend_integer

  !> FIXME : Add documentation
  subroutine ssend_integer_array (i, dest, tag)
    implicit none
    integer, dimension (:), intent (in) :: i
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_ssend (i, size(i), MPI_INTEGER, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(i)
# endif
  end subroutine ssend_integer_array

  !> FIXME : Add documentation
  subroutine ssend_real (a, dest, tag)
    implicit none
    real, intent (in) :: a
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_ssend (a, 1, MPI_DOUBLE_PRECISION, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(a)
# endif
  end subroutine ssend_real

  !> FIXME : Add documentation
  subroutine ssend_real_array (a, dest, tag)
    implicit none
    real, dimension (:), intent (in) :: a
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_ssend (a, size(a), MPI_DOUBLE_PRECISION, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(a)
# endif
  end subroutine ssend_real_array

  !> FIXME : Add documentation
  subroutine ssend_complex (z, dest, tag)
    implicit none
    complex, intent (in) :: z
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_ssend (z, 1, MPI_DOUBLE_COMPLEX, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(z)
# endif
  end subroutine ssend_complex

  !> FIXME : Add documentation
  subroutine ssend_complex_array (z, dest, tag)
    implicit none
    complex, dimension (:), intent (in) :: z
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_ssend (z, size(z), MPI_DOUBLE_COMPLEX, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(z)
# endif
  end subroutine ssend_complex_array

  !> FIXME : Add documentation
  subroutine ssend_complex_2array (z, dest, tag)
    implicit none
    complex, dimension (:,:), intent (in) :: z
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_ssend (z, size(z), MPI_DOUBLE_COMPLEX, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(z)
# endif
  end subroutine ssend_complex_2array

  !> FIXME : Add documentation
  subroutine ssend_logical (f, dest, tag)
    implicit none
    logical, intent (in) :: f
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_ssend (f, 1, MPI_LOGICAL, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(f)
# endif
  end subroutine ssend_logical

  !> FIXME : Add documentation
  subroutine ssend_logical_array (f, dest, tag)
    implicit none
    logical, dimension (:), intent (in) :: f
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_ssend (f, size(f), MPI_LOGICAL, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(f)
# endif
  end subroutine ssend_logical_array

  !> FIXME : Add documentation
  subroutine ssend_character (s, dest, tag)
    implicit none
    character(*), intent (in) :: s
    integer, intent (in) :: dest
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_ssend &
         (s, len(s), MPI_CHARACTER, dest, tagp, mp_comm, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(s)
# endif
  end subroutine ssend_character
! <MAB

! ********************* non-blocking sends **********************

  !> Routine for nonblocking send of z to dest. Use
  !! to label message and return handle for later checking.
  subroutine nbsend_real_array(z,dest,tag,handle)
    implicit none
    real, dimension(:), intent(in) :: z
    integer, intent(in) :: dest
    integer, intent(in) :: tag
    integer,intent(out) :: handle
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_isend(z,size(z),mpireal,dest,tag,mp_comm,handle,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(z)
    handle = 0
# endif
  end subroutine nbsend_real_array

  !> Routine for nonblocking send of z (size=count) to dest. Use
  !! tag to label message and return handle for later checking.
  subroutine nbsend_real_array_count(z,count,dest,tag,handle)
    implicit none
    real, dimension(:), intent(in) :: z
    integer, intent(in) :: count
    integer, intent(in) :: dest
    integer, intent(in) :: tag
    integer,intent(out) :: handle
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_isend(z,count,mpireal,dest,tag,mp_comm,handle,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(count); UNUSED_DUMMY(z)
    handle = 0
# endif
  end subroutine nbsend_real_array_count

  !> Routine for nonblocking send of z to dest. Use
  !! tag to label message and return handle for later checking.
  subroutine nbsend_complex_array(z,dest,tag,handle)
    implicit none
    complex, dimension(:), intent(in) :: z
    integer, intent(in) :: dest
    integer, intent(in) :: tag
    integer,intent(out) :: handle
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_isend(z,size(z),mpicmplx,dest,tag,mp_comm,handle,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(z)
    handle = 0
# endif
  end subroutine nbsend_complex_array

  !> Routine for nonblocking send of z to dest. Use
  !! tag to label message and return handle for later checking.
  subroutine nbsend_complex_2d_array(z,dest,tag,handle)
    implicit none
    complex, dimension(:,:), intent(in) :: z
    integer, intent(in) :: dest
    integer, intent(in) :: tag
    integer,intent(out) :: handle
# ifdef MPI
    call nbsend_complex_2d_array_count(z,size(z),dest,tag,handle)
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(z)
    handle = 0
# endif
  end subroutine nbsend_complex_2d_array

  !> Routine for nonblocking send of z to dest. Use
  !! tag to label message and return handle for later checking.
  subroutine nbsend_complex_2d_array_count(z,count,dest,tag,handle)
    implicit none
    complex, dimension(:,:), intent(in) :: z
    integer, intent(in) :: dest
    integer, intent(in) :: tag
    integer, intent(out) :: handle
    integer, intent(in) :: count
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_isend(z,count,mpicmplx,dest,tag,mp_comm,handle,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(count); UNUSED_DUMMY(z)
    handle = 0
# endif
  end subroutine nbsend_complex_2d_array_count

  !> Routine for nonblocking send of z to dest. Use
  !! tag to label message and return handle for later checking.
  subroutine nbsend_complex_3d_array(z,dest,tag,handle)
    implicit none
    complex, dimension(:,:,:), intent(in) :: z
    integer, intent(in) :: dest
    integer, intent(in) :: tag
    integer,intent(out) :: handle
# ifdef MPI
    call nbsend_complex_3d_array_count(z,size(z),dest,tag,handle)
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(z)
    handle = 0
# endif
  end subroutine nbsend_complex_3d_array

  !> Routine for nonblocking send of z to dest. Use
  !! tag to label message and return handle for later checking.
  subroutine nbsend_complex_3d_array_count(z,count,dest,tag,handle)
    implicit none
    complex, dimension(:,:,:), intent(in) :: z
    integer, intent(in) :: dest
    integer, intent(in) :: tag
    integer, intent(out) :: handle
    integer, intent(in) :: count
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_isend(z,count,mpicmplx,dest,tag,mp_comm,handle,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(count); UNUSED_DUMMY(z)
    handle = 0
# endif
  end subroutine nbsend_complex_3d_array_count

  !> Routine for nonblocking send of z to dest. Use
  !! tag to label message and return handle for later checking.
  subroutine nbsend_complex_array_sub(z,dest,tag,sub,handle)
    implicit none
    complex, dimension(:), intent(in) :: z
    integer, intent(in) :: dest
    integer, intent(in) :: tag
    type(comm_type), intent(in) :: sub
    integer,intent(out) :: handle
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_isend(z,size(z),mpicmplx,dest,tag,sub%id,handle,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest) ; UNUSED_DUMMY(tag); UNUSED_DUMMY(z); UNUSED_DUMMY(sub)
    handle = 0
# endif
  end subroutine nbsend_complex_array_sub

  !> Routine for nonblocking send of z (size=count) to dest. Use
  !! tag to label message and return handle for later checking.
  subroutine nbsend_complex_array_count(z,count,dest,tag,handle)
    implicit none
    complex, dimension(:), intent(in) :: z
    integer, intent(in) :: count
    integer, intent(in) :: dest
    integer, intent(in) :: tag
    integer,intent(out) :: handle
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_isend(z,count,mpicmplx,dest,tag,mp_comm,handle,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(dest); UNUSED_DUMMY(tag); UNUSED_DUMMY(count); UNUSED_DUMMY(z)
    handle = 0
# endif
  end subroutine nbsend_complex_array_count

! ********************* persistent sends **********************

  !> Routine to initialise a persistent send operation
  subroutine send_init_complex_array(z,dest,tag,handle)
    implicit none
    complex, dimension(:), intent(in) :: z
    integer, intent(in) :: dest, tag
    integer, intent(inout) :: handle
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_send_init(z,size(z),mpicmplx,dest,tag,mp_comm,handle,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
#else
    UNUSED_DUMMY(dest); UNUSED_DUMMY(tag); UNUSED_DUMMY(z); UNUSED_DUMMY(handle)
#endif
  end subroutine send_init_complex_array

  !> Routine to initialise a persistent send operation
  subroutine send_init_real_array(z,dest,tag,handle)
    implicit none
    real, dimension(:), intent(in) :: z
    integer, intent(in) :: dest, tag
    integer, intent(inout) :: handle
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_send_init(z,size(z),mpireal,dest,tag,mp_comm,handle,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
#else
    UNUSED_DUMMY(dest); UNUSED_DUMMY(tag); UNUSED_DUMMY(z); UNUSED_DUMMY(handle)
#endif
  end subroutine send_init_real_array

! ********************* receives  **********************

  !> FIXME : Add documentation
  subroutine receive_integer (i, src, tag)
    implicit none
    integer, intent (out) :: i
    integer, intent (in) :: src
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    integer, dimension (mp_status_size) :: status
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_recv (i, 1, MPI_INTEGER, src, tagp, mp_comm, &
         status, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    call mp_abort ("receive")
    UNUSED_DUMMY(src); UNUSED_DUMMY(tag)
    i = 0
# endif
  end subroutine receive_integer

  !> FIXME : Add documentation
  subroutine receive_integer_array (i, src, tag)
    implicit none
    integer, dimension (:), intent (out) :: i
    integer, intent (in) :: src
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    integer, dimension (mp_status_size) :: status
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_recv (i, size(i), MPI_INTEGER, src, tagp, mp_comm, &
         status, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    call mp_abort ("receive")
    UNUSED_DUMMY(src); UNUSED_DUMMY(tag)
    i = 0
# endif
  end subroutine receive_integer_array

  !> FIXME : Add documentation
  subroutine receive_real (a, src, tag)
    implicit none
    real, intent (out) :: a
    integer, intent (in) :: src
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    integer, dimension (mp_status_size) :: status
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_recv (a, 1, mpireal, src, tagp, mp_comm, &
         status, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    call mp_abort ("receive")
    UNUSED_DUMMY(src); UNUSED_DUMMY(tag)
    a = 0
# endif
  end subroutine receive_real

  !> FIXME : Add documentation
  subroutine receive_real_array (a, src, tag)
    implicit none
    real, dimension (:), intent (out) :: a
    integer, intent (in) :: src
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    integer, dimension (mp_status_size) :: status
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_recv (a, size(a), mpireal, src, tagp, mp_comm, &
         status, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    call mp_abort ("receive")
    UNUSED_DUMMY(src); UNUSED_DUMMY(tag)
    a = 0
# endif
  end subroutine receive_real_array

  !> FIXME : Add documentation
  subroutine receive_real_4d_array (a, src, tag)
    implicit none
    real, dimension (:,:,:,:), intent (out) :: a
    integer, intent (in) :: src
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    integer, dimension (mp_status_size) :: status
    tagp = 0
    if (present(tag)) tagp = tag
    call mpi_recv (a, size(a), mpireal, src, tagp, mp_comm, &
        status, ierror)
# else
    call mp_abort ("receive")
    UNUSED_DUMMY(src); UNUSED_DUMMY(tag)
    a = 0
# endif
  end subroutine receive_real_4d_array

  !> FIXME : Add documentation
  subroutine receive_real_5d_array (a, src, tag)
    implicit none
    real, dimension (:,:,:,:,:), intent (out) :: a
    integer, intent (in) :: src
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    integer, dimension (mp_status_size) :: status
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_recv (a, size(a), mpireal, src, tagp, mp_comm, &
         status, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    call mp_abort ("receive")
    UNUSED_DUMMY(src); UNUSED_DUMMY(tag)
    a = 0
# endif
  end subroutine receive_real_5d_array

  !> FIXME : Add documentation
  subroutine receive_complex (z, src, tag)
    implicit none
    complex, intent (out) :: z
    integer, intent (in) :: src
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    integer, dimension (mp_status_size) :: status
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_recv (z, 1, mpicmplx, src, tagp, mp_comm, &
         status, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    call mp_abort ("receive")
    UNUSED_DUMMY(src); UNUSED_DUMMY(tag)
    z = 0
# endif
  end subroutine receive_complex

  !> FIXME : Add documentation
  subroutine receive_complex_array (z, src, tag)
    implicit none
    complex, dimension (:), intent (out) :: z
    integer, intent (in) :: src
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    integer, dimension (mp_status_size) :: status
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_recv (z, size(z), mpicmplx, src, tagp, mp_comm, &
         status, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    call mp_abort ("receive")
    UNUSED_DUMMY(src); UNUSED_DUMMY(tag)
    z = 0
# endif
  end subroutine receive_complex_array

  !> FIXME : Add documentation
  subroutine receive_complex_2array (z, src, tag)
    implicit none
    complex, dimension (:,:), intent (out) :: z
    integer, intent (in) :: src
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    integer, dimension (mp_status_size) :: status
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_recv (z, size(z), mpicmplx, src, tagp, mp_comm, &
         status, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    call mp_abort ("receive")
    UNUSED_DUMMY(src); UNUSED_DUMMY(tag)
    z = 0
# endif
  end subroutine receive_complex_2array

  !> FIXME : Add documentation
  subroutine receive_complex_3d_array (z, src, tag)
    implicit none
    complex, dimension (:,:,:), intent (out) :: z
    integer, intent (in) :: src
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    integer, dimension (mp_status_size) :: status
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_recv (z, size(z), mpicmplx, src, tagp, mp_comm, &
         status, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    call mp_abort ("receive")
    UNUSED_DUMMY(src); UNUSED_DUMMY(tag)
    z = 0
# endif
  end subroutine receive_complex_3d_array

  !> FIXME : Add documentation
  subroutine nonblocking_receive_complex_array (z, src, tag, request)
    implicit none
    complex, dimension (:), intent (inout) :: z
    integer, intent (in) :: src
    integer, intent (in), optional :: tag
    integer, intent (out) :: request
# ifdef MPI
    integer :: ierror
    integer :: tagp
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_irecv (z, size(z), mpicmplx, src, tagp, mp_comm, &
         request, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    call mp_abort ("receive")
    UNUSED_DUMMY(z); UNUSED_DUMMY(src); UNUSED_DUMMY(tag)
    request = 0
# endif
  end subroutine nonblocking_receive_complex_array

  !> FIXME : Add documentation
  subroutine receive_logical (f, src, tag)
    implicit none
    logical, intent (out) :: f
    integer, intent (in) :: src
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    integer, dimension (mp_status_size) :: status
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_recv (f, 1, MPI_LOGICAL, src, tagp, mp_comm, &
         status, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    call mp_abort ("receive")
    UNUSED_DUMMY(src); UNUSED_DUMMY(tag)
    f = .false.
# endif
  end subroutine receive_logical

  !> FIXME : Add documentation
  subroutine receive_logical_array (f, src, tag)
    implicit none
    logical, dimension (:), intent (out) :: f
    integer, intent (in) :: src
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    integer, dimension (mp_status_size) :: status
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_recv (f, size(f), MPI_LOGICAL, src, tagp, mp_comm, &
         status, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    call mp_abort ("receive")
    UNUSED_DUMMY(src); UNUSED_DUMMY(tag)
    f = .false.
# endif
  end subroutine receive_logical_array

  !> FIXME : Add documentation
  subroutine receive_character (s, src, tag)
    implicit none
    character(*), intent (out) :: s
    integer, intent (in) :: src
    integer, intent (in), optional :: tag
# ifdef MPI
    integer :: ierror
    integer :: tagp
    integer, dimension (mp_status_size) :: status
    tagp = 0
    if (present(tag)) tagp = tag
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_recv (s, len(s), MPI_CHARACTER, src, tagp, mp_comm, &
         status, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    call mp_abort ("receive")
    UNUSED_DUMMY(src); UNUSED_DUMMY(tag)
    s = ''
# endif
  end subroutine receive_character

! ********************* non-blocking receives **********************

  !> Routine for nonblocking recv of z to dest. Use
  !! tag to label message and return handle for later checking.
  subroutine nbrecv_real_array(z,dest,tag,handle)
    implicit none
    real, dimension(:), intent(out) :: z
    integer, intent(in) :: dest
    integer, intent(in) :: tag
    integer,intent(out) :: handle
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_irecv(z,size(z),mpireal,dest,tag,mp_comm,handle,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    call mp_abort("receive")
    UNUSED_DUMMY(dest); UNUSED_DUMMY(tag)
    handle = 0 ; z = 0
# endif
  end subroutine nbrecv_real_array

  !> Routine for nonblocking recv of z (size=count) to dest. Use
  !! tag to label message and return handle for later checking.
  subroutine nbrecv_real_array_count(z,count,dest,tag,handle)
    implicit none
    real, dimension(:), intent(out) :: z
    integer, intent(in) :: count
    integer, intent(in) :: dest
    integer, intent(in) :: tag
    integer,intent(out) :: handle
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_irecv(z,count,mpireal,dest,tag,mp_comm,handle,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    call mp_abort("receive")
    UNUSED_DUMMY(dest); UNUSED_DUMMY(tag); UNUSED_DUMMY(count)
    handle = 0 ; z = 0
# endif
  end subroutine nbrecv_real_array_count

  !> Routine for nonblocking recv of z to dest. Use
  !! tag to label message and return handle for later checking.
  subroutine nbrecv_complex_array(z,dest,tag,handle)
    implicit none
    complex, dimension(:), intent(out) :: z
    integer, intent(in) :: dest
    integer, intent(in) :: tag
    integer,intent(out) :: handle
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_irecv(z,size(z),mpicmplx,dest,tag,mp_comm,handle,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    call mp_abort("receive")
    UNUSED_DUMMY(dest); UNUSED_DUMMY(tag)
    handle = 0 ; z = 0
# endif
  end subroutine nbrecv_complex_array

  !> Routine for nonblocking recv of z to dest. Use
  !! tag to label message and return handle for later checking.
  subroutine nbrecv_complex_2d_array(z,dest,tag,handle)
    implicit none
    complex, dimension(:,:), intent(out) :: z
    integer, intent(in) :: dest
    integer, intent(in) :: tag
    integer,intent(out) :: handle
# ifdef MPI
    call nbrecv_complex_2d_array_count(z,size(z),dest,tag,handle)
# else
    call mp_abort("receive")
    UNUSED_DUMMY(dest); UNUSED_DUMMY(tag)
    handle = 0 ; z = 0
# endif
  end subroutine nbrecv_complex_2d_array

  !> Routine for nonblocking recv of z to dest. Use
  !! tag to label message and return handle for later checking.
  subroutine nbrecv_complex_2d_array_count(z,count,dest,tag,handle)
    implicit none
    complex, dimension(:,:), intent(out) :: z
    integer, intent(in) :: dest
    integer, intent(in) :: tag
    integer, intent(out) :: handle
    integer, intent(in) :: count
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_irecv(z,count,mpicmplx,dest,tag,mp_comm,handle,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    call mp_abort("receive")
    UNUSED_DUMMY(dest); UNUSED_DUMMY(tag); UNUSED_DUMMY(count)
    handle = 0 ; z = 0
# endif
  end subroutine nbrecv_complex_2d_array_count

  !> Routine for nonblocking recv of z to dest. Use
  !! tag to label message and return handle for later checking.
  subroutine nbrecv_complex_3d_array(z,dest,tag,handle)
    implicit none
    complex, dimension(:,:,:), intent(inout) :: z
    integer, intent(in) :: dest
    integer, intent(in) :: tag
    integer,intent(out) :: handle
# ifdef MPI
    call nbrecv_complex_3d_array_count(z,size(z),dest,tag,handle)
# else
    call mp_abort("receive")
    UNUSED_DUMMY(z); UNUSED_DUMMY(dest); UNUSED_DUMMY(tag)
    handle = 0
# endif
  end subroutine nbrecv_complex_3d_array

  !> Routine for nonblocking recv of z to dest. Use
  !! tag to label message and return handle for later checking.
  subroutine nbrecv_complex_3d_array_count(z,count,dest,tag,handle)
    implicit none
    complex, dimension(:,:,:), intent(inout) :: z
    integer, intent(in) :: dest
    integer, intent(in) :: tag
    integer, intent(out) :: handle
    integer, intent(in) :: count
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_irecv(z,count,mpicmplx,dest,tag,mp_comm,handle,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    call mp_abort("receive")
    UNUSED_DUMMY(z); UNUSED_DUMMY(dest); UNUSED_DUMMY(tag); UNUSED_DUMMY(count)
    handle = 0
# endif
  end subroutine nbrecv_complex_3d_array_count

  !> Routine for nonblocking recv of z to dest. Use
  !! tag to label message and return handle for later checking.
  subroutine nbrecv_complex_array_sub(z,dest,tag,sub,handle)
    implicit none
    complex, dimension(:), intent(out) :: z
    integer, intent(in) :: dest
    integer, intent(in) :: tag
    type(comm_type), intent(in) :: sub
    integer,intent(out) :: handle
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_irecv(z,size(z),mpicmplx,dest,tag,sub%id,handle,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    call mp_abort("receive")
    UNUSED_DUMMY(dest); UNUSED_DUMMY(tag); UNUSED_DUMMY(sub)
    handle = 0 ; z = 0
# endif
  end subroutine nbrecv_complex_array_sub

  !> Routine for nonblocking recv of z (size=count) to dest. Use
  !! tag to label message and return handle for later checking.
  subroutine nbrecv_complex_array_count(z,count,dest,tag,handle)
    implicit none
    complex, dimension(:), intent(out) :: z
    integer, intent(in) :: count
    integer, intent(in) :: dest
    integer, intent(in) :: tag
    integer,intent(out) :: handle
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_irecv(z,count,mpicmplx,dest,tag,mp_comm,handle,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    call mp_abort("receive")
    UNUSED_DUMMY(dest); UNUSED_DUMMY(tag); UNUSED_DUMMY(count)
    handle = 0 ; z = 0
# endif
  end subroutine nbrecv_complex_array_count

! ********************* persistent recvs **********************

  !> Routine to initialise a persistent recv operation
  subroutine recv_init_complex_array(z,dest,tag,handle)
    implicit none
    complex, dimension(:), intent(inout) :: z
    integer, intent(in) :: dest, tag
    integer, intent(out) :: handle
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_recv_init(z,size(z),mpicmplx,dest,tag,mp_comm,handle,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z); UNUSED_DUMMY(dest); UNUSED_DUMMY(tag)
    handle = 0
#endif
  end subroutine recv_init_complex_array

  !> Routine to initialise a persistent recv operation
  subroutine recv_init_real_array(z,dest,tag,handle)
    implicit none
    real, dimension(:), intent(inout) :: z
    integer, intent(in) :: dest, tag
    integer, intent(out) :: handle
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_recv_init(z,size(z),mpireal,dest,tag,mp_comm,handle,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(z); UNUSED_DUMMY(dest); UNUSED_DUMMY(tag)
    handle = 0
#endif
  end subroutine recv_init_real_array

! ******************* non-blocking utilities ********************

  !> A Routine to initialise request arrays properly so they can have null
  !! requests in them and still work problems with waitall and waitany
  subroutine initialise_requests(requests)
    implicit none
    integer, dimension(:), intent(inout) :: requests
    requests = mp_request_null
  end subroutine initialise_requests

! ********************* non-blocking checks **********************

  !> This routine waits for the communication, given by the
  !! message request, to complete. We ignore the status
  !! information
  !!
  !! @note mpi_wait will set the request handle to MPI_NULL (or similar)
  !! when message complete so have to set requests as inout
  subroutine wait_nostat (request)
    implicit none
    integer, intent (inout) :: request
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
    call mpi_wait(request,MPI_STATUS_IGNORE,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
# else
    UNUSED_DUMMY(request)
# endif
  end subroutine wait_nostat

  !> This routine waits for the communication, given by the
  !! message request, to complete. We return the status
  !! information
  subroutine wait_stat (request, status)
    implicit none
    integer, intent (inout) :: request
    integer, dimension(mp_status_size), intent(out) :: status
# ifdef MPI
    !Note mpi_wait will set the request handle to MPI_NULL (or similar)
    !when message complete so have to set requests as inout
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
    call mpi_wait(request,status,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
#else
    UNUSED_DUMMY(request)
    status = 0
# endif
  end subroutine wait_stat

  !> A routine to wait for all count communications, given by the
  !! message handles in requests, to complete. We ignore the status
  !! information
  subroutine waitall_nostat (count, requests)
    implicit none
    integer, intent(in) :: count
    integer, dimension(:), intent (inout) :: requests
    !Note mpi_wait will set the request handle to MPI_NULL (or similar)
    !when message complete so have to set requests as inout
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
    call mpi_waitall(count,requests,MPI_STATUSES_IGNORE,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
# else
    UNUSED_DUMMY(count); UNUSED_DUMMY(requests)
# endif
  end subroutine waitall_nostat

  !> A routine to wait for all count communications, given by the
  !! message handles in requests, to complete. We return the message
  !! statuses
  subroutine waitall_stat (count, requests, status)
    implicit none
    integer, intent(in) :: count
    integer, dimension(:), intent (inout) :: requests
    integer, dimension(mp_status_size,count), intent(out) :: status
# ifdef MPI
    !Note mpi_wait will set the request handle to MPI_NULL (or similar)
    !when message complete so have to set requests as inout
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
    call mpi_waitall(count,requests,status,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
# else
    UNUSED_DUMMY(count); UNUSED_DUMMY(requests)
    status = 0
# endif
  end subroutine waitall_stat

  !> FIXME : Add documentation
  subroutine waitany_stat (count, requests, requestindex, status)
    implicit none
    integer, intent(in) :: count
    integer, dimension(:), intent(inout) :: requests
    integer, intent(out) :: requestindex
    integer, dimension(mp_status_size), intent(out) :: status
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
    call mpi_waitany(count, requests, requestindex, status, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
# else
    UNUSED_DUMMY(count); UNUSED_DUMMY(requests)
    status = 0 ; requestindex = 0
# endif
  end subroutine waitany_stat

  subroutine waitany_nostat(count, requests, requestindex)
    implicit none
    integer, intent(in) :: count
    integer, dimension(:), intent(inout) :: requests
    integer, intent(out) :: requestindex
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
    call mpi_waitany(count, requests, requestindex, MPI_STATUS_IGNORE, ierror)
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
# else
    UNUSED_DUMMY(count); UNUSED_DUMMY(requests)
    requestindex = 0
# endif
  end subroutine waitany_nostat

  !> A routine to test for all count communications, given by the
  !! message handles in requests, to complete. We ignore the status
  !! and flag information
  subroutine testall_nostat_noflag (count, requests)
    implicit none
    integer, intent(in) :: count
    integer, dimension(:), intent (inout) :: requests
    !Note mpi_test will set the request handle to MPI_NULL (or similar)
    !when message complete so have to set requests as inout
# ifdef MPI
    logical :: flag !Should this be integer?
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
    call mpi_testall(count,requests,flag,MPI_STATUSES_IGNORE,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
# else
    UNUSED_DUMMY(count); UNUSED_DUMMY(requests)
# endif
  end subroutine testall_nostat_noflag

  !> A routine to test for all count communications, given by the
  !! message handles in requests, to complete. We ignore the status
  !! information
  subroutine testall_nostat (count, requests, flag)
    implicit none
    integer, intent(in) :: count
    integer, dimension(:), intent (inout) :: requests
    logical, intent(out) :: flag
    !Note mpi_test will set the request handle to MPI_NULL (or similar)
    !when message complete so have to set requests as inout
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
    call mpi_testall(count,requests,flag,MPI_STATUSES_IGNORE,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
# else
    UNUSED_DUMMY(count); UNUSED_DUMMY(requests)
    flag = .false.
# endif
  end subroutine testall_nostat

  !> A routine to test for all count communications, given by the
  !! message handles in requests, to complete. We return the message
  !! statuses and completion flag
  subroutine testall_stat (count, requests, status, flag)
    implicit none
    integer, intent(in) :: count
    integer, dimension(:), intent (inout) :: requests
    integer, dimension(mp_status_size, count), intent(out) :: status
    logical, intent(out) :: flag
# ifdef MPI
    !Note mpi_test will set the request handle to MPI_NULL (or similar)
    !when message complete so have to set requests as inout
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
    call mpi_testall(count,requests,flag,status,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_sync, ' MPI Sync')
!$OMP END MASTER
# else
    UNUSED_DUMMY(count); UNUSED_DUMMY(requests)
    status = 0
    flag = .false.
# endif
  end subroutine testall_stat

! ********************* persistent utilities **********************

  !> Starts a single persistent communication represented by handle
  subroutine start_persist(handle)
    implicit none
    integer, intent(inout) :: handle
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_start(handle,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(handle)
# endif
  end subroutine start_persist

  !> Starts multiple persistent communications represented by handles
  subroutine startall_persist(handles)
    implicit none
    integer, dimension(:), intent(inout) :: handles
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_startall(size(handles),handles,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(handles)
# endif
  end subroutine startall_persist

  !> Frees a single persistent request handle
  subroutine free_handle_persist(handle)
    implicit none
    integer, intent(inout) :: handle
# ifdef MPI
    integer :: ierror
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
    call mpi_request_free(handle,ierror)
!$OMP MASTER
    call time_message(.false., time_mp_ptp, ' MPI Point-to-point')
!$OMP END MASTER
# else
    UNUSED_DUMMY(handle)
# endif
  end subroutine free_handle_persist

  !> Frees multiple persistent request handles
  subroutine free_handles_persist(handles)
    implicit none
    integer, dimension(:), intent(inout) :: handles
    integer :: i
    do i=1,size(handles)
       call free_handle_persist(handles(i))
    enddo
  end subroutine free_handles_persist

! ********************* other routines **********************

  !> FIXME : Add documentation
  subroutine init_jobs (ncolumns, group0, ierr)

    implicit none
# ifdef MPI
!    integer, parameter :: reorder=1
    ! TT: I changed variable definition by assuming integer 1 corresponds to
    ! TT: logical .true. but I'm not sure if reorder is needed.
    ! TT: In any case this subroutine is only called when you use job fork.
    logical, parameter :: reorder=.true.
    integer :: ip, j, comm2d, id2d, nrows
# endif
    integer, intent(in) :: ncolumns
    integer, dimension(0:), intent (out) :: group0
    integer, intent(out) :: ierr
# ifndef MPI
    group0 = 0
    ierr = 0
    if (ncolumns /= 1) call mp_abort ("jobs")
# else
    integer, parameter :: ndim=2
    integer, dimension(ndim) :: dims
    integer, dimension(0:ndim-1) :: coords1d, coords2d
    logical, dimension(0:ndim-1) :: belongs
    logical, dimension(ndim) :: period

    logical :: isroot

    if (.not. allocated(grp0)) allocate (grp0(0:size(group0)-1))

! calculate dimensions  mpi processor grid will have and check that
! ncolumns*nrows = number of processes

! nrows is # of processors per job (or group)
    nrows = ntot_proc/ncolumns
    dims=(/ ncolumns, nrows /)
    if(ntot_proc /= ncolumns*nrows) then
       ierr = 1
       if(aproc0) write(*,*) 'Number of processes must be divisible by number of groups'
       return
    endif
    ngroup_proc = nrows

    ! create 2d cartesian topology for processes

    period=(/ .false., .false. /)  !< no circular shift

    !    call mpi_cart_create(mpi_comm_world, ndim, dims, period, reorder, comm2d, ierr)
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    call mpi_cart_create(comm_all, ndim, dims, period, reorder, comm2d, ierr)
    call mpi_comm_rank(comm2d, id2d, ierr)
    call mpi_cart_coords(comm2d, id2d, ndim, coords2d, ierr)
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
! each processor knows which subgrid it is in from variable mpi_group
    job = coords2d(0)

! create 1d subgrids from 2d processor grid, variable belongs denotes
! whether processor grid is split by column or row

    belongs(1) = .true.    ! this dimension belongs to subgrid
    belongs(0) = .false.

!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    call mpi_cart_sub(comm2d, belongs, comm_group, ierr)
    call mpi_comm_rank(comm_group, gproc, ierr)
    call mpi_cart_coords(comm_group, gproc, 1, coords1d, ierr)
!$OMP MASTER
    call time_message(.false., time_mp_other, ' MPI Overheads')
!$OMP END MASTER
    gproc0 = (gproc == 0)

! find root process of each 1d subgrid and place in array group0 indexed
! from 0 to subgrids-1

! MAB> following two lines were incorrect
!    j=1
!    group0(0) = 0
! replace with
    j = 0
    if (proc0 .and. gproc0) then
       group0(0) = 0
       j = 1
    end if
! <MAB
    do ip = 1, ntot_proc-1
       if (proc0) then
          call receive (isroot, ip)
          if (isroot) then
             group0(j) = ip
             j=j+1
          end if
       else if (ip == aproc) then
          call send (gproc0, 0)
       end if
       call barrier
    end do

!let all processors have the group0 array
    call broadcast (group0)

    grp0 = group0

! TT> brought down here from init_job_name in file_utils.fpp
    call scope (subprocs)
! <TT

# endif
  end subroutine init_jobs

  !> FIXME : Add documentation
  subroutine all_to_group_real (all, group, njobs)
    implicit none
    real, dimension (:), intent (in) :: all
    real, intent (out) :: group
    integer, intent (in) :: njobs
#ifdef MPI
    integer :: ik, tag, idx
    tag = 1000
    do ik = 0, njobs-1
       if (proc0) then
          idx = mod(ik,size(all))
          if (iproc == grp0(ik)) then
             group = all(idx+1)
          else
             call ssend (all(idx+1), grp0(ik), tag)
          end if
       else if (iproc == grp0(ik)) then
          call receive (group, 0, tag)
       end if
    end do
#else
    UNUSED_DUMMY(all); UNUSED_DUMMY(njobs)
    group = 0.
    call mp_abort("all_to_group")
#endif
  end subroutine all_to_group_real

  !> FIXME : Add documentation
  subroutine all_to_group_real_array (all, group, njobs)
    implicit none
    real, dimension (:,:), intent (in) :: all
    real, dimension (:), intent (out) :: group
    integer, intent (in) :: njobs
# ifdef MPI
    integer :: ik, tag, idx
    tag = 1001
    do ik = 0, njobs-1
       if (proc0) then
          idx = mod(ik,size(all,dim=1))
          if (iproc == grp0(ik)) then
             group = all(idx+1,:)
          else
             call ssend (all(idx+1,:), grp0(ik), tag)
          end if
       else if (iproc == grp0(ik)) then
          call receive (group, 0, tag)
       end if
    end do
# else
    UNUSED_DUMMY(all); UNUSED_DUMMY(njobs)
    group = 0.
    call mp_abort ("all_to_group")
# endif
  end subroutine all_to_group_real_array

  !> FIXME : Add documentation
  subroutine group_to_all_real (group, all, njobs)
    implicit none
    real, intent (in) :: group
    real, dimension (:), intent (out) :: all
    integer, intent (in) :: njobs
#ifdef MPI
    integer :: ik, tag, idx
    tag = 1002
    do ik = 0, njobs-1
       if (iproc == grp0(ik)) then
          if (.not. proc0) then
             call ssend (group, 0, tag)
          else
             idx = mod(ik,size(all))
             all(idx+1) = group
          end if
       else if (proc0) then
          idx = mod(ik,size(all))
          call receive (all(idx+1), grp0(ik), tag)
       end if
    end do
# else
    UNUSED_DUMMY(group); UNUSED_DUMMY(njobs)
    all = 0
    call mp_abort("group_to_all")
# endif
  end subroutine group_to_all_real

  !> FIXME : Add documentation
  subroutine group_to_all_real_array (group, all, njobs)
    implicit none
    real, dimension (:), intent (in) :: group
    real, dimension (:,:), intent (out) :: all
    integer, intent (in) :: njobs
# ifdef MPI
    integer :: ik, tag, idx
    tag = 1003
    do ik = 0, njobs-1
       if (iproc == grp0(ik)) then
          if (.not. proc0) then
             call ssend (group, 0, tag)
          else
             idx = mod(ik,size(all))
             all(idx+1,:) = group
          end if
       else if (proc0) then
          idx = mod(ik,size(all))
          call receive (all(idx+1,:), grp0(ik), tag)
       end if
    end do
# else
    UNUSED_DUMMY(group); UNUSED_DUMMY(njobs)
    all = 0
    call mp_abort("group_to_all")
# endif
  end subroutine group_to_all_real_array

  !> Abort the simulation, logging an error message
  subroutine mp_abort (msg, to_screen, err_unit_in)
    use, intrinsic :: iso_fortran_env, only : error_unit
    use optionals, only : get_option_with_default
    implicit none
    !> Error message
    character(len=*), intent (in) :: msg
    !> If true, also print [[msg]] to screen, as well as to the error file
    logical, intent(in), optional :: to_screen
    !> Unit of open file to write any error messages to. Defaults to stderr
    integer, intent (in), optional :: err_unit_in
    integer :: err_unit_local
# ifdef MPI
    integer :: ierror
    integer, parameter :: error_code = MPI_ERR_UNKNOWN
# endif
    if (proc0) then
       err_unit_local = get_option_with_default(err_unit_in, err_unit)
       if (get_option_with_default(to_screen, .false.)) write(*, *) "Error: ", msg
       write (err_unit_local, *) "Error: ", msg
       flush (err_unit_local)
    end if

# ifndef MPI
    error stop "Called mp_abort without MPI."
# else
    call mpi_abort(comm_all, error_code, ierror)
# endif
  end subroutine mp_abort

  !> Set the unit for the error file to use in this module, for example for [[mp_abort]]
  subroutine set_default_error_file_unit(unit)
    !> An open file unit to use as the error file
    integer, intent(in) :: unit
    err_unit = unit
  end subroutine set_default_error_file_unit

end module mp