program example15 include 'mpif.h' integer ierr, rank, i, n parameter (n = 1 000) integer a(n), b(n) integer op external smod5 call MPI_INIT(ierr) call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierr) do i = 1, n a(i) = i + rank end do print *, 'process ', rank, ' a(1) =', a(1) call MPI_OP_CREATE(smod5, .TRUE., op, ierr) call MPI_REDUCE(a, b, n, MPI_INTEGER, op, 0, & MPI_COMM_WORLD, ierr) call MPI_OP_FREE(op, ierr) if(rank .eq. 0) print *, ' b(1) =', b(1) call MPI_FINALIZE(ierr) end integer function smod5(in, inout, l, type) integer l, type integer in(l), inout(l), i do i = 1, l inout(i) = mod(in(i)+inout(i), 5) end do return end