! This file created from test/mpi/f77/coll/red_scat_blockf.f with f77tof90

! -*- Mode: Fortran; -*- 

!

! (C) 2012 by Argonne National Laboratory.

!     See COPYRIGHT in top-level directory.

!

! A simple test for Fortran support of Reduce_scatter_block

! with or withoutMPI_IN_PLACE.

!

       program main

       use mpi

       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

! 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