1C 2C Copyright (C) by Argonne National Laboratory 3C See COPYRIGHT in top-level directory 4C 5 6 subroutine uop( cin, cout, count, datatype ) 7 implicit none 8 include 'mpif.h' 9 integer cin(*), cout(*) 10 integer count, datatype 11 integer i 12 13 if (datatype .ne. MPI_INTEGER) then 14 write(6,*) 'Invalid datatype passed to user_op()' 15 return 16 endif 17 18 do i=1, count 19 cout(i) = cin(i) + cout(i) 20 enddo 21 end 22C 23 program main 24 implicit none 25 include 'mpif.h' 26 integer inbuf(2), outbuf(2) 27 integer ans, rank, size, comm 28 integer errs, ierr 29 integer sumop 30 external uop 31 32 errs = 0 33 34 call mtest_init( ierr ) 35C 36C A simple test of exscan 37 comm = MPI_COMM_WORLD 38 39 call mpi_comm_rank( comm, rank, ierr ) 40 call mpi_comm_size( comm, size, ierr ) 41 42 inbuf(1) = rank 43 inbuf(2) = -rank 44 call mpi_exscan( inbuf, outbuf, 2, MPI_INTEGER, MPI_SUM, comm, 45 & ierr ) 46C this process has the sum of i from 0 to rank-1, which is 47C (rank)(rank-1)/2 and -i 48 ans = (rank * (rank - 1))/2 49 if (rank .gt. 0) then 50 if (outbuf(1) .ne. ans) then 51 errs = errs + 1 52 print *, rank, ' Expected ', ans, ' got ', outbuf(1) 53 endif 54 if (outbuf(2) .ne. -ans) then 55 errs = errs + 1 56 print *, rank, ' Expected ', -ans, ' got ', outbuf(1) 57 endif 58 endif 59C 60C Try a user-defined operation 61C 62 call mpi_op_create( uop, .true., sumop, ierr ) 63 inbuf(1) = rank 64 inbuf(2) = -rank 65 call mpi_exscan( inbuf, outbuf, 2, MPI_INTEGER, sumop, comm, 66 & ierr ) 67C this process has the sum of i from 0 to rank-1, which is 68C (rank)(rank-1)/2 and -i 69 ans = (rank * (rank - 1))/2 70 if (rank .gt. 0) then 71 if (outbuf(1) .ne. ans) then 72 errs = errs + 1 73 print *, rank, ' sumop: Expected ', ans, ' got ', outbuf(1) 74 endif 75 if (outbuf(2) .ne. -ans) then 76 errs = errs + 1 77 print *, rank, ' sumop: Expected ', -ans, ' got ', outbuf(1) 78 endif 79 endif 80 call mpi_op_free( sumop, ierr ) 81 82C 83C Try a user-defined operation (and don't claim it is commutative) 84C 85 call mpi_op_create( uop, .false., sumop, ierr ) 86 inbuf(1) = rank 87 inbuf(2) = -rank 88 call mpi_exscan( inbuf, outbuf, 2, MPI_INTEGER, sumop, comm, 89 & ierr ) 90C this process has the sum of i from 0 to rank-1, which is 91C (rank)(rank-1)/2 and -i 92 ans = (rank * (rank - 1))/2 93 if (rank .gt. 0) then 94 if (outbuf(1) .ne. ans) then 95 errs = errs + 1 96 print *, rank, ' sumop2: Expected ', ans, ' got ', outbuf(1) 97 endif 98 if (outbuf(2) .ne. -ans) then 99 errs = errs + 1 100 print *, rank, ' sumop2: Expected ', -ans, ' got ',outbuf(1) 101 endif 102 endif 103 call mpi_op_free( sumop, ierr ) 104 105 call mtest_finalize( errs ) 106 end 107