      include "mpif.h"
! each process has an array of 10 doubles: ain(10)
      double precision ain(10), aout(10)
      integer ind(10)
      double precision in(2,10), out(2,10)
      integer i, myrank, root, ierr

      root = 0
      call mpi_init(ierr)
      call mpi_comm_rank(mpi_comm_world, myrank)

      do i=1,10
        ain(i) = dsin(myrank*i)
      enddo

      do i=1,10
        print '(2i5,f10.5)',myrank, i, ain(i)
      enddo

      do i=1,10
        in(1,i) = ain(i)
        in(2,i) = myrank ! myrank is coerced to a double
      enddo

      call mpi_reduce(in, out, 10, MPI_2DOUBLE_PRECISION, MPI_MAXLOC,
     &                 root, mpi_comm_world, ierr)

! At this point, the answer resides at process root

      if (myrank .eq. root) then
! read ranks out
        do i=1,10
          aout(i) = out(1,i)
          ind(i) = out(2,i) ! rank is coerced back to an integer
        enddo

        do i=1,10
          print *,'i',i,' ind', ind(i), ' value', aout(i)
        enddo

      endif
      call mpi_finalize(ierr)
      stop
      end
