Skip to content

Instantly share code, notes, and snippets.

@plampite
Created May 7, 2022 18:25
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save plampite/9708f6cba05a73d2ec4425a42ee89764 to your computer and use it in GitHub Desktop.
Save plampite/9708f6cba05a73d2ec4425a42ee89764 to your computer and use it in GitHub Desktop.
A Fortran example of a reduce step in MPI implemented trough simple mpi_send/recv calls. Useful when using mpi_type_create_struct and mpi_op create might be unconvenient or impossible.
program myreduce
!Program to show a simple implementation of mpi_reduce, with only mpi_send/recv
!Useful for cases where one would need mpi_type_create_struct and mpi_op_create to achieve the same result
!Here it is tested against the simple MPI intrinsic MPI_SUM on a single real variable
use, intrinsic :: iso_fortran_env, only : int32, real64
use mpi
implicit none
integer(int32) :: i, nstep, pp2, ppd, nproc, myid, mpi_err, mpi_stat(mpi_status_size)
real(real64) :: x, xr1, xr2, xr
!Initialize MPI
call mpi_init(mpi_err)
call mpi_comm_size(mpi_comm_world,nproc,mpi_err)
call mpi_comm_rank(mpi_comm_world,myid,mpi_err)
!The local variable we want to reduce
call random_number(x)
!The reduce by the actual mpi_reduce, used as reference (MPI_SUM to match the example below)
call mpi_reduce(x,xr1,1,mpi_double_precision,mpi_sum,0,mpi_comm_world,mpi_err)
!Determine the number of steps in the algorithm (log_2(nproc)) and pp2, the largest power of 2 <= nproc
nstep = int(log(real(nproc,real64))/log(2.0_real64),int32)
pp2 = 2**nstep
!Initiallze variables
ppd = pp2
xr2 = x
!Step 1) All the processes with id>pp2 will send their data to processes with id<pp2, which will reduce the result
if (nproc>pp2) then
if (myid+1>pp2) then
call mpi_send(xr2,1,mpi_double_precision,myid-pp2,0,mpi_comm_world,mpi_err)
endif
if (myid+1<=nproc-pp2) then
call mpi_recv(xr,1,mpi_double_precision,myid+pp2,0,mpi_comm_world,mpi_stat,mpi_err)
xr2 = xr2 + xr !insert your reduce here
endif
endif
!Step 2) We are left with pp2 (a power of 2 number of) processes. We can iterate nstep times, each time the higher
!half of processes will send their data to the corresponding lower half, which will reduce it. At each iteration the
!number of involved processes is halved until proc 0 will be the only one holding the fully reduced result at the end
do i = 1, nstep
ppd = ppd/2
if (myid+1>ppd.and.myid+1<=2*ppd) then
call mpi_send(xr2,1,mpi_double_precision,myid-ppd,i,mpi_comm_world,mpi_err)
endif
if (myid+1<=ppd) then
call mpi_recv(xr,1,mpi_double_precision,myid+ppd,i,mpi_comm_world,mpi_stat,mpi_err)
xr2 = xr2 + xr !insert your reduce here
endif
enddo
!Check the end result against the MPI one
if (myid==0) write(*,'(a,g0)') "DIFF: ", (xr1-xr2)
!Finalize MPI
call mpi_finalize(mpi_err)
endprogram myreduce
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment