mpi_wrapper.F90

module mpi_wrapper

   implicit none

   private

   public :: mype, npes, root, comm, is_rootpe
   public :: mpi_wrapper_initialize, mpi_wrapper_finalize
   public :: mp_reduce_min, mp_reduce_max, mp_reduce_sum
   public :: mp_bcst, mp_alltoall

#include "mpif.h"

   integer, save :: mype = -999
   integer, save :: npes = -999
   integer, save :: root = -999
   integer, save :: comm = -999
   logical, save :: initialized = .false.

   integer :: ierror

   INTERFACE mp_bcst
     MODULE PROCEDURE mp_bcst_i
     MODULE PROCEDURE mp_bcst_r4
     MODULE PROCEDURE mp_bcst_r8
     MODULE PROCEDURE mp_bcst_1d_r4
     MODULE PROCEDURE mp_bcst_1d_r8
     MODULE PROCEDURE mp_bcst_2d_r4
     MODULE PROCEDURE mp_bcst_2d_r8
     MODULE PROCEDURE mp_bcst_3d_r4
     MODULE PROCEDURE mp_bcst_3d_r8
     MODULE PROCEDURE mp_bcst_4d_r4
     MODULE PROCEDURE mp_bcst_4d_r8
     MODULE PROCEDURE mp_bcst_1d_i
     MODULE PROCEDURE mp_bcst_2d_i
     MODULE PROCEDURE mp_bcst_3d_i
     MODULE PROCEDURE mp_bcst_4d_i
   END INTERFACE

   INTERFACE mp_reduce_min
     MODULE PROCEDURE mp_reduce_min_r4
     MODULE PROCEDURE mp_reduce_min_r8
   END INTERFACE

   INTERFACE mp_reduce_max
     MODULE PROCEDURE mp_reduce_max_r4_1d
     MODULE PROCEDURE mp_reduce_max_r4
     MODULE PROCEDURE mp_reduce_max_r8_1d
     MODULE PROCEDURE mp_reduce_max_r8
     MODULE PROCEDURE mp_reduce_max_i
   END INTERFACE

   INTERFACE mp_reduce_sum
     MODULE PROCEDURE mp_reduce_sum_r4
     MODULE PROCEDURE mp_reduce_sum_r4_1d
     MODULE PROCEDURE mp_reduce_sum_r4_1darr
     MODULE PROCEDURE mp_reduce_sum_r4_2darr
     MODULE PROCEDURE mp_reduce_sum_r8
     MODULE PROCEDURE mp_reduce_sum_r8_1d
     MODULE PROCEDURE mp_reduce_sum_r8_1darr
     MODULE PROCEDURE mp_reduce_sum_r8_2darr
     MODULE PROCEDURE mp_reduce_sum_i
     MODULE PROCEDURE mp_reduce_sum_i8
   END INTERFACE

   INTERFACE mp_alltoall
     MODULE PROCEDURE mp_alltoall_r4_1darr
   END INTERFACE

contains

   logical function is_rootpe()
      if (mype==root) then
         is_rootpe = .true.
      else
         is_rootpe = .false.
      end if
   end function is_rootpe

   subroutine mpi_wrapper_initialize(mpiroot, mpicomm)
      integer, intent(in) :: mpiroot, mpicomm
      if (initialized) return
      root = mpiroot
      comm = mpicomm
      call MPI_COMM_RANK(comm, mype, ierror)
      call MPI_COMM_SIZE(comm, npes, ierror)
      initialized = .true.
   end subroutine mpi_wrapper_initialize

   subroutine mpi_wrapper_finalize()
      if (.not.initialized) return
      mype = -999
      npes = -999
      root = -999
      comm = -999
      initialized = .false.
   end subroutine mpi_wrapper_finalize

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_bcst_i :: Call SPMD broadcast 
!
      subroutine mp_bcst_i(q)
         integer, intent(INOUT)  :: q

         call MPI_BCAST(q, 1, MPI_INTEGER, root, comm, ierror)

      end subroutine mp_bcst_i
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_bcst_r4 :: Call SPMD broadcast 
!
      subroutine mp_bcst_r4(q)
         real(kind=4), intent(INOUT)  :: q

         call MPI_BCAST(q, 1, MPI_REAL, root, comm, ierror)

      end subroutine mp_bcst_r4
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_bcst_r8 :: Call SPMD broadcast 
!
      subroutine mp_bcst_r8(q)
         real(kind=8), intent(INOUT)  :: q

         call MPI_BCAST(q, 1, MPI_DOUBLE_PRECISION, root, comm, ierror)

      end subroutine mp_bcst_r8
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_bcst_1d_r4 :: Call SPMD broadcast 
!
      subroutine mp_bcst_1d_r4(q, idim)
         integer, intent(IN)  :: idim
         real(kind=4), intent(INOUT)  :: q(idim)

         call MPI_BCAST(q, idim, MPI_REAL, root, comm, ierror)

      end subroutine mp_bcst_1d_r4
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_bcst_1d_r8 :: Call SPMD broadcast 
!
      subroutine mp_bcst_1d_r8(q, idim)
         integer, intent(IN)  :: idim
         real(kind=8), intent(INOUT)  :: q(idim)

         call MPI_BCAST(q, idim, MPI_DOUBLE_PRECISION, root, comm, ierror)

      end subroutine mp_bcst_1d_r8
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_bcst_2d_r4 :: Call SPMD broadcast 
!
      subroutine mp_bcst_2d_r4(q, idim, jdim)
         integer, intent(IN)  :: idim, jdim
         real(kind=4), intent(INOUT)  :: q(idim,jdim)

         call MPI_BCAST(q, idim*jdim, MPI_REAL, root, comm, ierror)

      end subroutine mp_bcst_2d_r4
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_bcst_2d_r8 :: Call SPMD broadcast 
!
      subroutine mp_bcst_2d_r8(q, idim, jdim)
         integer, intent(IN)  :: idim, jdim
         real(kind=8), intent(INOUT)  :: q(idim,jdim)

         call MPI_BCAST(q, idim*jdim, MPI_DOUBLE_PRECISION, root, comm, ierror)

      end subroutine mp_bcst_2d_r8
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_bcst_3d_r4 :: Call SPMD broadcast 
!
      subroutine mp_bcst_3d_r4(q, idim, jdim, kdim)
         integer, intent(IN)  :: idim, jdim, kdim
         real(kind=4), intent(INOUT)  :: q(idim,jdim,kdim)

         call MPI_BCAST(q, idim*jdim*kdim, MPI_REAL, root, comm, ierror)

      end subroutine mp_bcst_3d_r4
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_bcst_3d_r8 :: Call SPMD broadcast 
!
      subroutine mp_bcst_3d_r8(q, idim, jdim, kdim)
         integer, intent(IN)  :: idim, jdim, kdim
         real(kind=8), intent(INOUT)  :: q(idim,jdim,kdim)

         call MPI_BCAST(q, idim*jdim*kdim, MPI_DOUBLE_PRECISION, root, comm, ierror)

      end subroutine mp_bcst_3d_r8
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!       
!     mp_bcst_4d_r4 :: Call SPMD broadcast 
!
      subroutine mp_bcst_4d_r4(q, idim, jdim, kdim, ldim)
         integer, intent(IN)  :: idim, jdim, kdim, ldim
         real(kind=4), intent(INOUT)  :: q(idim,jdim,kdim,ldim)

         call MPI_BCAST(q, idim*jdim*kdim*ldim, MPI_REAL, root, comm, ierror)
     
      end subroutine mp_bcst_4d_r4
!     
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!       
!     mp_bcst_4d_r8 :: Call SPMD broadcast 
!
      subroutine mp_bcst_4d_r8(q, idim, jdim, kdim, ldim)
         integer, intent(IN)  :: idim, jdim, kdim, ldim
         real(kind=8), intent(INOUT)  :: q(idim,jdim,kdim,ldim)

         call MPI_BCAST(q, idim*jdim*kdim*ldim, MPI_DOUBLE_PRECISION, root, comm, ierror)
     
      end subroutine mp_bcst_4d_r8
!     
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_bcst_3d_i :: Call SPMD broadcast
!
      subroutine mp_bcst_3d_i(q, idim, jdim, kdim)
         integer, intent(IN)  :: idim, jdim, kdim
         integer, intent(INOUT)  :: q(idim,jdim,kdim)

         call MPI_BCAST(q, idim*jdim*kdim, MPI_INTEGER, root, comm, ierror)

      end subroutine mp_bcst_3d_i
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_bcst_1d_i :: Call SPMD broadcast
!
      subroutine mp_bcst_1d_i(q, idim)
         integer, intent(IN)  :: idim
         integer, intent(INOUT)  :: q(idim)

         call MPI_BCAST(q, idim, MPI_INTEGER, root, comm, ierror)

      end subroutine mp_bcst_1d_i
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_bcst_2d_i :: Call SPMD broadcast
!
      subroutine mp_bcst_2d_i(q, idim, jdim)
         integer, intent(IN)  :: idim, jdim
         integer, intent(INOUT)  :: q(idim,jdim)

         call MPI_BCAST(q, idim*jdim, MPI_INTEGER, root, comm, ierror)

      end subroutine mp_bcst_2d_i
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_bcst_4d_i :: Call SPMD broadcast
!
      subroutine mp_bcst_4d_i(q, idim, jdim, kdim, ldim)
         integer, intent(IN)  :: idim, jdim, kdim, ldim
         integer, intent(INOUT)  :: q(idim,jdim,kdim,ldim)

         call MPI_BCAST(q, idim*jdim*kdim*ldim, MPI_INTEGER, root, comm, ierror)

      end subroutine mp_bcst_4d_i
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!       
!     mp_reduce_max_r4_1d :: Call SPMD REDUCE_MAX 
!
      subroutine mp_reduce_max_r4_1d(mymax,npts)
         integer, intent(IN)  :: npts
         real(kind=4), intent(INOUT)  :: mymax(npts)
        
         real(kind=4) :: gmax(npts)
        
         call MPI_ALLREDUCE( mymax, gmax, npts, MPI_REAL, MPI_MAX, &
                             comm, ierror )
      
         mymax = gmax
        
      end subroutine mp_reduce_max_r4_1d
!     
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!       
!     mp_reduce_max_r8_1d :: Call SPMD REDUCE_MAX 
!
      subroutine mp_reduce_max_r8_1d(mymax,npts)
         integer, intent(IN)  :: npts
         real(kind=8), intent(INOUT)  :: mymax(npts)
        
         real(kind=8) :: gmax(npts)
        
         call MPI_ALLREDUCE( mymax, gmax, npts, MPI_DOUBLE_PRECISION, MPI_MAX, &
                             comm, ierror )
      
         mymax = gmax
        
      end subroutine mp_reduce_max_r8_1d
!     
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_reduce_max_r4 :: Call SPMD REDUCE_MAX 
!
      subroutine mp_reduce_max_r4(mymax)
         real(kind=4), intent(INOUT)  :: mymax

         real(kind=4) :: gmax

         call MPI_ALLREDUCE( mymax, gmax, 1, MPI_REAL, MPI_MAX, &
                             comm, ierror )

         mymax = gmax

      end subroutine mp_reduce_max_r4

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_reduce_max_r8 :: Call SPMD REDUCE_MAX 
!
      subroutine mp_reduce_max_r8(mymax)
         real(kind=8), intent(INOUT)  :: mymax

         real(kind=8) :: gmax

         call MPI_ALLREDUCE( mymax, gmax, 1, MPI_DOUBLE_PRECISION, MPI_MAX, &
                             comm, ierror )

         mymax = gmax

      end subroutine mp_reduce_max_r8

      subroutine mp_reduce_min_r4(mymin)
         real(kind=4), intent(INOUT)  :: mymin

         real(kind=4) :: gmin

         call MPI_ALLREDUCE( mymin, gmin, 1, MPI_REAL, MPI_MIN, &
                             comm, ierror )

         mymin = gmin

      end subroutine mp_reduce_min_r4

      subroutine mp_reduce_min_r8(mymin)
         real(kind=8), intent(INOUT)  :: mymin

         real(kind=8) :: gmin

         call MPI_ALLREDUCE( mymin, gmin, 1, MPI_DOUBLE_PRECISION, MPI_MIN, &
                             comm, ierror )

         mymin = gmin

      end subroutine mp_reduce_min_r8
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_bcst_4d_i :: Call SPMD REDUCE_MAX 
!
      subroutine mp_reduce_max_i(mymax)
         integer, intent(INOUT)  :: mymax

         integer :: gmax

         call MPI_ALLREDUCE( mymax, gmax, 1, MPI_INTEGER, MPI_MAX, &
                             comm, ierror )

         mymax = gmax

      end subroutine mp_reduce_max_i
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_reduce_sum_r4 :: Call SPMD REDUCE_SUM 
!
      subroutine mp_reduce_sum_r4(mysum)
         real(kind=4), intent(INOUT)  :: mysum

         real(kind=4) :: gsum

         call MPI_ALLREDUCE( mysum, gsum, 1, MPI_REAL, MPI_SUM, &
                             comm, ierror )

         mysum = gsum

      end subroutine mp_reduce_sum_r4
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_reduce_sum_r8 :: Call SPMD REDUCE_SUM 
!
      subroutine mp_reduce_sum_r8(mysum)
         real(kind=8), intent(INOUT)  :: mysum

         real(kind=8) :: gsum

         call MPI_ALLREDUCE( mysum, gsum, 1, MPI_DOUBLE_PRECISION, MPI_SUM, &
                             comm, ierror )

         mysum = gsum

      end subroutine mp_reduce_sum_r8
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------


!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
! !
!
!     mp_reduce_sum_r4_1darr :: Call SPMD REDUCE_SUM
!
      subroutine mp_reduce_sum_r4_1darr(mysum, npts)
         integer, intent(in)  :: npts
         real(kind=4), intent(inout)  :: mysum(npts)
         real(kind=4)                 :: gsum(npts)

         gsum = 0.0
         call MPI_ALLREDUCE( mysum, gsum, npts, MPI_REAL, MPI_SUM, &
                             comm, ierror )

         mysum = gsum

      end subroutine mp_reduce_sum_r4_1darr
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
! !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
! !
!
!     mp_reduce_sum_r4_2darr :: Call SPMD REDUCE_SUM
!
      subroutine mp_reduce_sum_r4_2darr(mysum, npts1,npts2)
         integer, intent(in)  :: npts1,npts2
         real(kind=4), intent(inout)  :: mysum(npts1,npts2)
         real(kind=4)                 :: gsum(npts1,npts2)

         gsum = 0.0
         call MPI_ALLREDUCE( mysum, gsum, npts1*npts2, MPI_REAL, MPI_SUM, &
                             comm, ierror )

         mysum = gsum

      end subroutine mp_reduce_sum_r4_2darr
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
! !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_reduce_sum_r4_1d :: Call SPMD REDUCE_SUM 
!
      subroutine mp_reduce_sum_r4_1d(mysum, sum1d, npts)
         integer, intent(in)  :: npts
         real(kind=4), intent(in)     :: sum1d(npts)
         real(kind=4), intent(INOUT)  :: mysum

         real(kind=4) :: gsum
         integer :: i

         mysum = 0.0
         do i=1,npts
            mysum = mysum + sum1d(i)
         enddo 

         call MPI_ALLREDUCE( mysum, gsum, 1, MPI_DOUBLE_PRECISION, MPI_SUM, &
                             comm, ierror )

         mysum = gsum

      end subroutine mp_reduce_sum_r4_1d
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_reduce_sum_r8_1d :: Call SPMD REDUCE_SUM 
!
      subroutine mp_reduce_sum_r8_1d(mysum, sum1d, npts)
         integer, intent(in)  :: npts
         real(kind=8), intent(in)     :: sum1d(npts)
         real(kind=8), intent(INOUT)  :: mysum

         real(kind=8) :: gsum
         integer :: i

         mysum = 0.0
         do i=1,npts
            mysum = mysum + sum1d(i)
         enddo 

         call MPI_ALLREDUCE( mysum, gsum, 1, MPI_DOUBLE_PRECISION, MPI_SUM, &
                             comm, ierror )

         mysum = gsum

      end subroutine mp_reduce_sum_r8_1d
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
! !
!
!     mp_reduce_sum_r8_1darr :: Call SPMD REDUCE_SUM
!
      subroutine mp_reduce_sum_r8_1darr(mysum, npts)
         integer, intent(in)  :: npts
         real(kind=8), intent(inout)  :: mysum(npts)
         real(kind=8)                 :: gsum(npts)

         gsum = 0.0

         call MPI_ALLREDUCE( mysum, gsum, npts, MPI_DOUBLE_PRECISION, &
                             MPI_SUM,                                 &
                             comm, ierror )

         mysum = gsum

      end subroutine mp_reduce_sum_r8_1darr
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
! !

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
! !
!
!     mp_reduce_sum_r8_2darr :: Call SPMD REDUCE_SUM
!
      subroutine mp_reduce_sum_r8_2darr(mysum, npts1,npts2)
         integer, intent(in)  :: npts1,npts2
         real(kind=8), intent(inout)  :: mysum(npts1,npts2)
         real(kind=8)                 :: gsum(npts1,npts2)

         gsum = 0.0

         call MPI_ALLREDUCE( mysum, gsum, npts1*npts2,      &
                             MPI_DOUBLE_PRECISION, MPI_SUM, &
                             comm, ierror )

         mysum = gsum

      end subroutine mp_reduce_sum_r8_2darr
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
! !

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_reduce_sum_i :: Call SPMD REDUCE_SUM 
!
      subroutine mp_reduce_sum_i(mysum)
         integer, intent(INOUT)  :: mysum

         integer :: gsum

         call MPI_ALLREDUCE( mysum, gsum, 1, MPI_INTEGER, MPI_SUM, &
                             comm, ierror )

         mysum = gsum

      end subroutine mp_reduce_sum_i
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------



!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv

!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv !
!
!     mp_reduce_sum_i8 :: Call SPMD REDUCE_SUM 
!
      subroutine mp_reduce_sum_i8(mysum)
         integer*8, intent(INOUT)  :: mysum

         integer*8 :: gsum

         call MPI_ALLREDUCE( mysum, gsum, 1, MPI_INTEGER8, MPI_SUM, &
                             comm, ierror )

         mysum = gsum

      end subroutine mp_reduce_sum_i8
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ !
!-------------------------------------------------------------------------------



!-------------------------------------------------------------------------------
! vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
! !
!
!     mp_reduce_sum_r8_2darr :: Call SPMD REDUCE_SUM
!
      subroutine mp_alltoall_r4_1darr(sbuf, ssize, sdispl, rbuf, rsize, rdispl)
         real(kind=4), intent(in)    :: sbuf(:)
         real(kind=4), intent(inout) :: rbuf(:)
         integer, intent(in) :: ssize(:),  rsize(:)
         integer, intent(in) :: sdispl(:), rdispl(:)

         call MPI_ALLTOALLV( sbuf, ssize, sdispl, MPI_REAL, &
                             rbuf, rsize, rdispl, MPI_REAL, &
                             comm, ierror )

      end subroutine mp_alltoall_r4_1darr
!
! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
! !

end module mpi_wrapper