      program main
      include 'mpif.h'
      parameter(n=100)
      integer i,j,istart,iend,istart2,iend2,dst,src
      double precision a(n,n),x(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)
         do j=1, n
            a(i,j)=dble(i+j)
         end do
      end do
      do j=1, nprocs-1
         dst=mod(myrank+j,nprocs)
         src=mod(myrank-j+nprocs,nprocs)
         istart2=n*src/nprocs+1
         iend2=n*(src+1)/nprocs
         call mpi_sendrecv(x(istart),iend-istart+1,
     *                     MPI_DOUBLE_PRECISION,dst,100,
     *                     x(istart2),iend2-istart2+1,
     *                     MPI_DOUBLE_PRECISION,src,100,
     *                     MPI_COMM_WORLD,istat,ierr)
      end do
      do i=istart, iend
         y(i)=0.0d0
         do j=1, n
            y(i)=y(i)+a(i,j)*x(j)
         end do
      end do
      err=0.0d0 
      do i=istart, iend
         ans=dble(i*n*(n+1)/2+n*(n+1)*(2*n+1)/6)
         err=err+abs(y(i)-ans)
      end do
      call mpi_allreduce(err,err1,1,MPI_DOUBLE_PRECISION,MPI_SUM,
     *                   MPI_COMM_WORLD,ierr)
      if (myrank.eq.0) write(6,*) 'error =', err1
      call mpi_finalize(ierr)
      stop
      end
