C -*- Mode: Fortran; -*- 

C

C (C) 2012 by Argonne National Laboratory.

C     See COPYRIGHT in top-level directory.

C

C A simple test for Fortran support of Reduce_scatter_block

C with or withoutMPI_IN_PLACE.

C

       program main

       implicit none

       include 'mpif.h'

       integer MAX_SIZE

       parameter (MAX_SIZE=1024)

       integer sbuf(MAX_SIZE), rbuf(MAX_SIZE)

       integer comm, rank, size

       integer sumval, ierr, errs, i

       errs = 0

       call mtest_init( ierr )

       comm = MPI_COMM_WORLD

       call mpi_comm_rank( comm, rank, ierr )

       call mpi_comm_size( comm, size, ierr )

       do i = 1, size

           sbuf(i) = rank + (i-1)

       enddo

       call MPI_Reduce_scatter_block(sbuf, rbuf, 1, MPI_INTEGER,

     .                               MPI_SUM, comm, ierr)

       sumval = size * rank + ((size-1) * size)/2

       if ( rbuf(1) .ne. sumval ) then

           errs = errs + 1

           print *, 'Reduce_scatter_block does not get expected value.'

           print *, '[', rank, ']', 'Got ', rbuf(1), ' but expected ',

     .              sumval, '.'

       endif

C Try MPI_IN_PLACE

       do i = 1, size

           rbuf(i) = rank + (i-1)

       enddo

       call MPI_Reduce_scatter_block(MPI_IN_PLACE, rbuf, 1, MPI_INTEGER,

     .                               MPI_SUM, comm, ierr)

       if ( rbuf(1) .ne. sumval ) then

           errs = errs + 1

           print *, 'Reduce_scatter_block does not get expected value.'

           print *, '[', rank, ']', 'Got ', rbuf(1), ' but expected ',

     .              sumval, '.'

       endif

       call mtest_finalize( errs )

       call mpi_finalize( ierr )

       end