gkowal/amun-code
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

MPITOOLS: Use MPI_IN_PLACE in all MPI_Allreduce().

Browse Source 
Signed-off-by: Grzegorz Kowal <grzegorz@amuncode.org>
This commit is contained in:
Grzegorz Kowal 2021-11-03 22:39:33 -03:00
parent 3a056d4ddc
commit 95617866b1
1 changed files with 23 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
sources/mpitools.F90
View File

@ -359,65 +359,51 @@ module mpitools
! !
! Arguments: ! 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 use iso_fortran_env, only : error_unit
! local variables are not implicit by default
!
implicit none implicit none
! subroutine arguments logical, intent(in) :: flag
!
logical, intent(in) :: ibuf
#ifdef MPI #ifdef MPI
! local variables
!
integer :: ierror integer :: ierror
! local parameters
!
character(len=*), parameter :: loc = 'MPITOOLS::check_status()' character(len=*), parameter :: loc = 'MPITOOLS::check_status()'
#endif /* MPI */ #endif /* MPI */
! !
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
#ifdef MPI
call start_timer(imc) call start_timer(imc)
#ifdef PROFILE #ifdef PROFILE
call start_timer(imm) call start_timer(imm)
#endif /* PROFILE */ #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) MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, ierror)
if (ierror /= MPI_SUCCESS) then if (ierror /= MPI_SUCCESS) then
write(error_unit,"('[', a, ']: ', a)") trim(loc), & write(error_unit,"('[', a, ']: ', a)") trim(loc), &
"MPI_Allreduce of logical buffer failed!" "MPI_Allreduce of logical buffer failed!"
end if end if
#endif /* MPI */
#ifdef PROFILE #ifdef PROFILE
call stop_timer(imm) call stop_timer(imm)
#endif /* PROFILE */ #endif /* PROFILE */
call stop_timer(imc) call stop_timer(imc)
#else /* MPI */
! no MPI, so just copy the input to output
!
obuf = ibuf
#endif /* MPI */
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
end function check_status end function check_status
!
#ifdef MPI #ifdef MPI
! !
!=============================================================================== !===============================================================================
@ -611,8 +597,7 @@ module mpitools
real(kind=8), dimension(:), intent(inout) :: buf real(kind=8), dimension(:), intent(inout) :: buf
integer :: ierror integer :: ierror
real(kind=8), dimension(size(buf)) :: tmp
character(len=*), parameter :: loc = 'MPITOOLS::reduce_minimum_double_array()' character(len=*), parameter :: loc = 'MPITOOLS::reduce_minimum_double_array()'
! !
@ -623,7 +608,7 @@ module mpitools
call start_timer(imm) call start_timer(imm)
#endif /* PROFILE */ #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) MPI_REAL8, MPI_MIN, MPI_COMM_WORLD, ierror)
#ifdef PROFILE #ifdef PROFILE
@ -635,8 +620,6 @@ module mpitools
"MPI_Allreduce of a real array failed!" "MPI_Allreduce of a real array failed!"
end if end if
buf(:) = tmp(:)
call stop_timer(imc) call stop_timer(imc)
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
@ -666,7 +649,6 @@ module mpitools
integer, intent(inout) :: buf integer, intent(inout) :: buf
integer :: ierror integer :: ierror
integer :: tmp
character(len=*), parameter :: loc = 'MPITOOLS::reduce_maximum_integer()' character(len=*), parameter :: loc = 'MPITOOLS::reduce_maximum_integer()'
! !
@ -677,7 +659,7 @@ module mpitools
call start_timer(imm) call start_timer(imm)
#endif /* PROFILE */ #endif /* PROFILE */
call MPI_Allreduce(buf, tmp, 1, & call MPI_Allreduce(MPI_IN_PLACE, buf, 1, &
MPI_INTEGER, MPI_MAX, MPI_COMM_WORLD, ierror) MPI_INTEGER, MPI_MAX, MPI_COMM_WORLD, ierror)
#ifdef PROFILE #ifdef PROFILE
@ -689,8 +671,6 @@ module mpitools
"MPI_Allreduce of an integer value failed!" "MPI_Allreduce of an integer value failed!"
end if end if
buf = tmp
call stop_timer(imc) call stop_timer(imc)
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
@ -720,8 +700,7 @@ module mpitools
real(kind=8), intent(inout) :: buf real(kind=8), intent(inout) :: buf
integer :: ierror integer :: ierror
real(kind=8) :: tmp
character(len=*), parameter :: loc = 'MPITOOLS::reduce_maximum_double()' character(len=*), parameter :: loc = 'MPITOOLS::reduce_maximum_double()'
! !
@ -732,7 +711,8 @@ module mpitools
call start_timer(imm) call start_timer(imm)
#endif /* PROFILE */ #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 #ifdef PROFILE
call stop_timer(imm) call stop_timer(imm)
@ -743,8 +723,6 @@ module mpitools
"MPI_Allreduce of a real value failed!" "MPI_Allreduce of a real value failed!"
end if end if
buf = tmp
call stop_timer(imc) call stop_timer(imc)
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
@ -774,8 +752,7 @@ module mpitools
real(kind=8), dimension(:), intent(inout) :: buf real(kind=8), dimension(:), intent(inout) :: buf
integer :: ierror integer :: ierror
real(kind=8), dimension(size(buf)) :: tmp
character(len=*), parameter :: loc = 'MPITOOLS::reduce_maximum_double_array()' character(len=*), parameter :: loc = 'MPITOOLS::reduce_maximum_double_array()'
! !
@ -786,7 +763,7 @@ module mpitools
call start_timer(imm) call start_timer(imm)
#endif /* PROFILE */ #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) MPI_REAL8, MPI_MAX, MPI_COMM_WORLD, ierror)
#ifdef PROFILE #ifdef PROFILE
@ -798,8 +775,6 @@ module mpitools
"MPI_Allreduce of a real array failed!" "MPI_Allreduce of a real array failed!"
end if end if
buf(:) = tmp(:)
call stop_timer(imc) call stop_timer(imc)
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
@ -828,8 +803,7 @@ module mpitools
integer, dimension(:), intent(inout) :: buf integer, dimension(:), intent(inout) :: buf
integer :: ierror integer :: ierror
integer, dimension(size(buf)) :: tmp
character(len=*), parameter :: loc = 'MPITOOLS::reduce_sum_integer_array()' character(len=*), parameter :: loc = 'MPITOOLS::reduce_sum_integer_array()'
! !
@ -840,7 +814,7 @@ module mpitools
call start_timer(imm) call start_timer(imm)
#endif /* PROFILE */ #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) MPI_INTEGER, MPI_SUM, MPI_COMM_WORLD, ierror)
#ifdef PROFILE #ifdef PROFILE
@ -852,8 +826,6 @@ module mpitools
"MPI_Allreduce of an integer array failed!" "MPI_Allreduce of an integer array failed!"
end if end if
buf(:) = tmp(:)
call stop_timer(imc) call stop_timer(imc)
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
@ -882,8 +854,7 @@ module mpitools
real(kind=8), dimension(:), intent(inout) :: buf real(kind=8), dimension(:), intent(inout) :: buf
integer :: ierror integer :: ierror
real(kind=8), dimension(size(buf)) :: tmp
character(len=*), parameter :: loc = 'MPITOOLS::reduce_sum_double_array()' character(len=*), parameter :: loc = 'MPITOOLS::reduce_sum_double_array()'
! !
@ -894,7 +865,7 @@ module mpitools
call start_timer(imm) call start_timer(imm)
#endif /* PROFILE */ #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) MPI_REAL8, MPI_SUM, MPI_COMM_WORLD, ierror)
#ifdef PROFILE #ifdef PROFILE
@ -906,8 +877,6 @@ module mpitools
"MPI_Allreduce of a real array failed!" "MPI_Allreduce of a real array failed!"
end if end if
buf(:) = tmp(:)
call stop_timer(imc) call stop_timer(imc)
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
@ -936,8 +905,7 @@ module mpitools
complex(kind=8), dimension(:,:), intent(inout) :: buf complex(kind=8), dimension(:,:), intent(inout) :: buf
integer :: ierror integer :: ierror
complex(kind=8), dimension(size(buf,1),size(buf,2)) :: tmp
character(len=*), parameter :: loc = 'MPITOOLS::reduce_sum_complex_array()' character(len=*), parameter :: loc = 'MPITOOLS::reduce_sum_complex_array()'
! !
@ -948,7 +916,7 @@ module mpitools
call start_timer(imm) call start_timer(imm)
#endif /* PROFILE */ #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) MPI_DOUBLE_COMPLEX, MPI_SUM, MPI_COMM_WORLD, ierror)
#ifdef PROFILE #ifdef PROFILE
@ -960,8 +928,6 @@ module mpitools
"MPI_Allreduce of a complex array failed!" "MPI_Allreduce of a complex array failed!"
end if end if
buf(:,:) = tmp(:,:)
call stop_timer(imc) call stop_timer(imc)
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------