From 95617866b105ea00faa50c39e7a27b9a4734d697 Mon Sep 17 00:00:00 2001 From: Grzegorz Kowal Date: Wed, 3 Nov 2021 22:39:33 -0300 Subject: [PATCH] MPITOOLS: Use MPI_IN_PLACE in all MPI_Allreduce(). Signed-off-by: Grzegorz Kowal --- sources/mpitools.F90 | 80 +++++++++++++------------------------------- 1 file changed, 23 insertions(+), 57 deletions(-) diff --git a/sources/mpitools.F90 b/sources/mpitools.F90 index 2904421..db25200 100644 --- a/sources/mpitools.F90 +++ b/sources/mpitools.F90 @@ -359,65 +359,51 @@ module mpitools ! ! Arguments: ! -! ibuf - the logical buffer; +! flag - the input logical flag; ! !=============================================================================== ! - logical function check_status(ibuf) result(obuf) + logical function check_status(flag) -! include external procedures and variables -! use iso_fortran_env, only : error_unit -! local variables are not implicit by default -! implicit none -! subroutine arguments -! - logical, intent(in) :: ibuf - + logical, intent(in) :: flag #ifdef MPI -! local variables -! + integer :: ierror -! local parameters -! character(len=*), parameter :: loc = 'MPITOOLS::check_status()' #endif /* MPI */ ! !------------------------------------------------------------------------------- ! -#ifdef MPI call start_timer(imc) #ifdef PROFILE call start_timer(imm) #endif /* PROFILE */ - call MPI_Allreduce(ibuf, obuf, 1, & + check_status = flag + +#ifdef MPI + call MPI_Allreduce(MPI_IN_PLACE, check_status, 1, & MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierror) if (ierror /= MPI_SUCCESS) then write(error_unit,"('[', a, ']: ', a)") trim(loc), & "MPI_Allreduce of logical buffer failed!" end if +#endif /* MPI */ #ifdef PROFILE call stop_timer(imm) #endif /* PROFILE */ - call stop_timer(imc) -#else /* MPI */ -! no MPI, so just copy the input to output -! - obuf = ibuf -#endif /* MPI */ !------------------------------------------------------------------------------- ! end function check_status -! #ifdef MPI ! !=============================================================================== @@ -611,8 +597,7 @@ module mpitools real(kind=8), dimension(:), intent(inout) :: buf - integer :: ierror - real(kind=8), dimension(size(buf)) :: tmp + integer :: ierror character(len=*), parameter :: loc = 'MPITOOLS::reduce_minimum_double_array()' ! @@ -623,7 +608,7 @@ module mpitools call start_timer(imm) #endif /* PROFILE */ - call MPI_Allreduce(buf, tmp, size(buf), & + call MPI_Allreduce(MPI_IN_PLACE, buf, size(buf), & MPI_REAL8, MPI_MIN, MPI_COMM_WORLD, ierror) #ifdef PROFILE @@ -635,8 +620,6 @@ module mpitools "MPI_Allreduce of a real array failed!" end if - buf(:) = tmp(:) - call stop_timer(imc) !------------------------------------------------------------------------------- @@ -666,7 +649,6 @@ module mpitools integer, intent(inout) :: buf integer :: ierror - integer :: tmp character(len=*), parameter :: loc = 'MPITOOLS::reduce_maximum_integer()' ! @@ -677,7 +659,7 @@ module mpitools call start_timer(imm) #endif /* PROFILE */ - call MPI_Allreduce(buf, tmp, 1, & + call MPI_Allreduce(MPI_IN_PLACE, buf, 1, & MPI_INTEGER, MPI_MAX, MPI_COMM_WORLD, ierror) #ifdef PROFILE @@ -689,8 +671,6 @@ module mpitools "MPI_Allreduce of an integer value failed!" end if - buf = tmp - call stop_timer(imc) !------------------------------------------------------------------------------- @@ -720,8 +700,7 @@ module mpitools real(kind=8), intent(inout) :: buf - integer :: ierror - real(kind=8) :: tmp + integer :: ierror character(len=*), parameter :: loc = 'MPITOOLS::reduce_maximum_double()' ! @@ -732,7 +711,8 @@ module mpitools call start_timer(imm) #endif /* PROFILE */ - call MPI_Allreduce(buf, tmp, 1, MPI_REAL8, MPI_MAX, MPI_COMM_WORLD, ierror) + call MPI_Allreduce(MPI_IN_PLACE, buf, 1, & + MPI_REAL8, MPI_MAX, MPI_COMM_WORLD, ierror) #ifdef PROFILE call stop_timer(imm) @@ -743,8 +723,6 @@ module mpitools "MPI_Allreduce of a real value failed!" end if - buf = tmp - call stop_timer(imc) !------------------------------------------------------------------------------- @@ -774,8 +752,7 @@ module mpitools real(kind=8), dimension(:), intent(inout) :: buf - integer :: ierror - real(kind=8), dimension(size(buf)) :: tmp + integer :: ierror character(len=*), parameter :: loc = 'MPITOOLS::reduce_maximum_double_array()' ! @@ -786,7 +763,7 @@ module mpitools call start_timer(imm) #endif /* PROFILE */ - call MPI_Allreduce(buf, tmp, size(buf), & + call MPI_Allreduce(MPI_IN_PLACE, buf, size(buf), & MPI_REAL8, MPI_MAX, MPI_COMM_WORLD, ierror) #ifdef PROFILE @@ -798,8 +775,6 @@ module mpitools "MPI_Allreduce of a real array failed!" end if - buf(:) = tmp(:) - call stop_timer(imc) !------------------------------------------------------------------------------- @@ -828,8 +803,7 @@ module mpitools integer, dimension(:), intent(inout) :: buf - integer :: ierror - integer, dimension(size(buf)) :: tmp + integer :: ierror character(len=*), parameter :: loc = 'MPITOOLS::reduce_sum_integer_array()' ! @@ -840,7 +814,7 @@ module mpitools call start_timer(imm) #endif /* PROFILE */ - call MPI_Allreduce(buf, tmp, size(buf), & + call MPI_Allreduce(MPI_IN_PLACE, buf, size(buf), & MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, ierror) #ifdef PROFILE @@ -852,8 +826,6 @@ module mpitools "MPI_Allreduce of an integer array failed!" end if - buf(:) = tmp(:) - call stop_timer(imc) !------------------------------------------------------------------------------- @@ -882,8 +854,7 @@ module mpitools real(kind=8), dimension(:), intent(inout) :: buf - integer :: ierror - real(kind=8), dimension(size(buf)) :: tmp + integer :: ierror character(len=*), parameter :: loc = 'MPITOOLS::reduce_sum_double_array()' ! @@ -894,7 +865,7 @@ module mpitools call start_timer(imm) #endif /* PROFILE */ - call MPI_Allreduce(buf, tmp, size(buf), & + call MPI_Allreduce(MPI_IN_PLACE, buf, size(buf), & MPI_REAL8, MPI_SUM, MPI_COMM_WORLD, ierror) #ifdef PROFILE @@ -906,8 +877,6 @@ module mpitools "MPI_Allreduce of a real array failed!" end if - buf(:) = tmp(:) - call stop_timer(imc) !------------------------------------------------------------------------------- @@ -936,8 +905,7 @@ module mpitools complex(kind=8), dimension(:,:), intent(inout) :: buf - integer :: ierror - complex(kind=8), dimension(size(buf,1),size(buf,2)) :: tmp + integer :: ierror character(len=*), parameter :: loc = 'MPITOOLS::reduce_sum_complex_array()' ! @@ -948,7 +916,7 @@ module mpitools call start_timer(imm) #endif /* PROFILE */ - call MPI_Allreduce(buf, tmp, size(buf), & + call MPI_Allreduce(MPI_IN_PLACE, buf, size(buf), & MPI_DOUBLE_COMPLEX, MPI_SUM, MPI_COMM_WORLD, ierror) #ifdef PROFILE @@ -960,8 +928,6 @@ module mpitools "MPI_Allreduce of a complex array failed!" end if - buf(:,:) = tmp(:,:) - call stop_timer(imc) !-------------------------------------------------------------------------------