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.

myreduce.f90

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