1 ! This file created from test/mpi/f77/coll/uallreducef.f with f77tof90
2 ! -*- Mode: Fortran; -*-
4 ! (C) 2003 by Argonne National Laboratory.
5 ! See COPYRIGHT in top-level directory.
8 ! Test user-defined operations. This tests a simple commutative operation
10 subroutine uop( cin, cout, count, datatype )
12 integer cin(*), cout(*)
13 integer count, datatype
16 ! if (datatype .ne. MPI_INTEGER) then
17 ! print *, 'Invalid datatype (',datatype,') passed to user_op()'
22 cout(i) = cin(i) + cout(i)
30 integer count, sumop, i, size
31 integer, DIMENSION(:), ALLOCATABLE :: vin, vout
36 ALLOCATE(vin(65000), STAT=status)
37 ALLOCATE(vout(65000), STAT=status)
40 call mpi_op_create( uop, .true., sumop, ierr )
43 call mpi_comm_size( comm, size, ierr )
45 do while (count .lt. 65000)
50 call mpi_allreduce( vin, vout, count, MPI_INTEGER, sumop, &
52 ! Check that all results are correct
54 if (vout(i) .ne. i * size) then
56 if (errs .lt. 10) print *, "vout(",i,") = ", vout(i)
62 call mpi_op_free( sumop, ierr )
65 call mtest_finalize(errs)
66 call mpi_finalize(ierr)