1 C -*- Mode: Fortran; -*-
3 C (C) 2009 by Argonne National Laboratory.
4 C See COPYRIGHT in top-level directory.
7 C Test Fortran MPI_Reduce_local with MPI_OP_SUM and with user-defined operation.
9 subroutine user_op( invec, outvec, count, datatype )
12 integer invec(*), outvec(*)
13 integer count, datatype
16 if (datatype .ne. MPI_INTEGER) then
17 write(6,*) 'Invalid datatype passed to user_op()'
22 outvec(ii) = invec(ii) * 2 + outvec(ii)
31 parameter (max_buf_size=65000)
32 integer vin(max_buf_size), vout(max_buf_size)
43 do while (count .le. max_buf_size )
48 call mpi_reduce_local( vin, vout, count,
49 & MPI_INTEGER, MPI_SUM, ierr )
50 C Check if the result is correct
52 if ( vin(ii) .ne. ii ) then
55 if ( vout(ii) .ne. 2*ii ) then
59 if ( count .gt. 0 ) then
66 call mpi_op_create( user_op, .false., myop, ierr )
69 do while (count .le. max_buf_size)
74 call mpi_reduce_local( vin, vout, count,
75 & MPI_INTEGER, myop, ierr )
76 C Check if the result is correct
78 if ( vin(ii) .ne. ii ) then
81 if ( vout(ii) .ne. 3*ii ) then
85 if ( count .gt. 0 ) then
92 call mpi_op_free( myop, ierr )
94 call mtest_finalize(errs)
95 call mpi_finalize(ierr)