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