      program main
      include 'mpif.h'
      parameter(n=100)
      integer i,j,istart,iend
      double precision a(n,n),x(n),yp(n),y(n),ans,err,err1
      integer nprocs,myrank,istat(MPI_STATUS_SIZE),ierr
      call mpi_init(ierr)
      call mpi_comm_size(MPI_COMM_WORLD,nprocs,ierr)
      call mpi_comm_rank(MPI_COMM_WORLD,myrank,ierr)
      istart=n*myrank/nprocs+1
      iend=n*(myrank+1)/nprocs
      do i=istart, iend
         x(i)=dble(i)
      end do
      do i=1, n
         do j=istart, iend
            a(i,j)=dble(i+j)
         end do
      end do
      do i=1, n
         yp(i)=0.0d0
         do j=istart, iend
            yp(i)=yp(i)+a(i,j)*x(j)
         end do
      end do
      call mpi_allreduce(yp,y,n,MPI_DOUBLE_PRECISION,MPI_SUM,
     *                   MPI_COMM_WORLD,ierr)
      if (myrank.eq.0) then
         err=0.0d0 
         do i=1, n
            ans=dble(i*n*(n+1)/2+n*(n+1)*(2*n+1)/6)
            err=err+abs(y(i)-ans)
         end do
         write(6,*) 'error =', err
      end if
      call mpi_finalize(ierr)
      stop
      end
