1 ! This file created from test/mpi/f77/coll/reducelocalf.f with f77tof90
2 ! -*- Mode: Fortran; -*-
4 ! (C) 2009 by Argonne National Laboratory.
5 ! See COPYRIGHT in top-level directory.
8 ! Test Fortran MPI_Reduce_local with MPI_OP_SUM and with user-defined operation.
10 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)
30 parameter (max_buf_size=65000)
31 integer vin(max_buf_size), vout(max_buf_size)
42 do while (count .le. max_buf_size )
47 call mpi_reduce_local( vin, vout, count, &
48 & MPI_INTEGER, MPI_SUM, ierr )
49 ! Check if the result is correct
51 if ( vin(ii) .ne. ii ) then
54 if ( vout(ii) .ne. 2*ii ) then
58 if ( count .gt. 0 ) then
65 call mpi_op_create( user_op, .false., myop, ierr )
68 do while (count .le. max_buf_size)
73 call mpi_reduce_local( vin, vout, count, &
74 & MPI_INTEGER, myop, ierr )
75 ! Check if the result is correct
77 if ( vin(ii) .ne. ii ) then
80 if ( vout(ii) .ne. 3*ii ) then
84 if ( count .gt. 0 ) then
91 call mpi_op_free( myop, ierr )
93 call mtest_finalize(errs)
94 call mpi_finalize(ierr)