teshsuite/smpi/mpich3-test/f77/coll/exscanf.f

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