1 C -*- Mode: Fortran; -*-
3 C (C) 2003 by Argonne National Laboratory.
4 C See COPYRIGHT in top-level directory.
6 subroutine uop( cin, cout, count, datatype )
9 integer cin(*), cout(*)
10 integer count, datatype
13 ! if (datatype .ne. MPI_INTEGER) then
14 ! write(6,*) 'Invalid datatype passed to user_op()'
19 cout(i) = cin(i) + cout(i)
26 integer inbuf(2), outbuf(2)
27 integer ans, rank, size, comm
34 call mtest_init( ierr )
36 C A simple test of exscan
39 call mpi_comm_rank( comm, rank, ierr )
40 call mpi_comm_size( comm, size, ierr )
44 call mpi_exscan( inbuf, outbuf, 2, MPI_INTEGER, MPI_SUM, comm,
46 C this process has the sum of i from 0 to rank-1, which is
47 C (rank)(rank-1)/2 and -i
48 ans = (rank * (rank - 1))/2
50 if (outbuf(1) .ne. ans) then
52 print *, rank, ' Expected ', ans, ' got ', outbuf(1)
54 if (outbuf(2) .ne. -ans) then
56 print *, rank, ' Expected ', -ans, ' got ', outbuf(1)
60 C Try a user-defined operation
62 call mpi_op_create( uop, .true., sumop, ierr )
65 call mpi_exscan( inbuf, outbuf, 2, MPI_INTEGER, sumop, comm,
67 C this process has the sum of i from 0 to rank-1, which is
68 C (rank)(rank-1)/2 and -i
69 ans = (rank * (rank - 1))/2
71 if (outbuf(1) .ne. ans) then
73 print *, rank, ' sumop: Expected ', ans, ' got ', outbuf(1)
75 if (outbuf(2) .ne. -ans) then
77 print *, rank, ' sumop: Expected ', -ans, ' got ', outbuf(1)
80 call mpi_op_free( sumop, ierr )
83 C Try a user-defined operation (and don't claim it is commutative)
85 call mpi_op_create( uop, .false., sumop, ierr )
88 call mpi_exscan( inbuf, outbuf, 2, MPI_INTEGER, sumop, comm,
90 C this process has the sum of i from 0 to rank-1, which is
91 C (rank)(rank-1)/2 and -i
92 ans = (rank * (rank - 1))/2
94 if (outbuf(1) .ne. ans) then
96 print *, rank, ' sumop2: Expected ', ans, ' got ', outbuf(1)
98 if (outbuf(2) .ne. -ans) then
100 print *, rank, ' sumop2: Expected ', -ans, ' got ',outbuf(1)
103 call mpi_op_free( sumop, ierr )
105 call mtest_finalize( errs )
106 call mpi_finalize( ierr )