      subroutine mpi_init(ierror)
      implicit real*8(a-h,o-z)
      integer ierror
      ierror=0
      return
      end





      subroutine mpi_finalize(ierror)
      implicit real*8(a-h,o-z)
      integer ierror
      ierror=0
      return
      end





      subroutine mpi_comm_rank(mpi_comm_world,myid,ierror)
      implicit real*8(a-h,o-z)
      integer mpi_comm_world,myid,ierror
      mpi_comm_world=0
      myid=0
      ierror=0
      return
      end





      subroutine mpi_comm_size(mpi_comm_world,numprocs,ierror)
      implicit real*8(a-h,o-z)
      integer mpi_comm_world,numprocs,ierror
      numprocs=1
      ierror=0
      return
      end





      subroutine mpi_buffer_attach(a,icount,ierror)
      implicit real*8(a-h,o-z)
      include "params.h"
      integer icount,ierror
      common/mpii/ibuffer(nibuffer),iis,iir,irs,irr
      common/mpir/buffer(nrbuffer)
      iis=0
      iir=0
      irs=0
      irr=0
      ierror=0
      return
      end





      subroutine mpi_buffer_detach(a,icount,ierror)
      implicit real*8(a-h,o-z)
      integer icount,ierror
      ierror=0
      return
      end





      subroutine mpi_reduce(a,a_sum,n,ntype,mpi_sum,node,mpi_comm_world,
     &                      ierror)
      implicit real*8(a-h,o-z)
      integer n,ntype,mpi_sum,node,mpi_comm_world,ierror
      if(ntype.eq.1) then
                           call rcopy(a_sum,a,n)
                     else
                           call icopy(a_sum,a,n)
                     endif
      ierror=0
      return
      end
      subroutine rcopy(a_sum,a,n)
      implicit real*8(a-h,o-z)
      integer n
      dimension a(*),a_sum(*)
      do 1001 i=1,n
 1001 a_sum(i)=a(i)
      return
      end
      subroutine icopy(ia_sum,ia,n)
      implicit real*8(a-h,o-z)
      integer n,ia(*),ia_sum(*)
      do 1001 i=1,n
 1001 ia_sum(i)=ia(i)
      return
      end





      subroutine mpi_bcast(a,n,ntype,node,mpi_comm_world,ierror)
      implicit real*8(a-h,o-z)
      integer n,ntype,node,mpi_comm_world,ierror
      ierror=0
      return
      end





      subroutine mpi_bsend(a,n,ntype,islave,itag,mpi_comm_world,ierror)
      implicit real*8(a-h,o-z)
      include "params.h"
      integer n,ntype,islave,itag,mpi_comm_world,ierror
      common/mpii/ibuffer(nibuffer),iis,iir,irs,irr
      common/mpir/buffer(nrbuffer)
      if(ntype.eq.1) then
                           call send_buffer_real(a,n)
                     else
                           call send_buffer_integer(a,n)
                     endif
      ierror=0
      return
      end
      subroutine send_buffer_real(a,n)
      implicit real*8(a-h,o-z)
      include "params.h"
      integer n
      dimension a(*)
      common/mpii/ibuffer(nibuffer),iis,iir,irs,irr
      common/mpir/buffer(nrbuffer)
      do 1001 i=1,n
 1001 buffer(irs+i)=a(i)
      irs=irs+n
      if(irs.gt.nrbuffer) stop 'out of space in mpi buffer (reals)'
      return
      end
      subroutine send_buffer_integer(ia,n)
      implicit real*8(a-h,o-z)
      include "params.h"
      integer n,ia(*)
      common/mpii/ibuffer(nibuffer),iis,iir,irs,irr
      common/mpir/buffer(nrbuffer)
      do 1001 i=1,n
 1001 ibuffer(iis+i)=ia(i)
      iis=iis+n
      if(iis.gt.nibuffer) stop 'out of space in mpi buffer (integers)'
      return
      end





      subroutine mpi_recv(a,n,ntype,isource,itag,mpi_comm_world,istat,
     &                    ierror)
      implicit real*8(a-h,o-z)
      include "params.h"
      integer n,ntype,isource,itag,mpi_comm_world,istat(*),ierror
      common/mpii/ibuffer(nibuffer),iis,iir,irs,irr
      common/mpir/buffer(nrbuffer)
      if(ntype.eq.1) then
                           call receive_buffer_real(a,n)
                     else
                           call receive_buffer_integer(a,n)
                     endif
      ierror=0
      return
      end
      subroutine receive_buffer_real(a,n)
      implicit real*8(a-h,o-z)
      include "params.h"
      integer n
      dimension a(*)
      common/mpii/ibuffer(nibuffer),iis,iir,irs,irr
      common/mpir/buffer(nrbuffer)
      do 1001 i=1,n
 1001 a(i)=buffer(irr+i)
      irr=irr+n
      if(irr.eq.irs) then
                           irs=0
                           irr=0
                     endif
      return
      end
      subroutine receive_buffer_integer(ia,n)
      implicit real*8(a-h,o-z)
      include "params.h"
      integer n,ia(*)
      common/mpii/ibuffer(nibuffer),iis,iir,irs,irr
      common/mpir/buffer(nrbuffer)
      do 1001 i=1,n
 1001 ia(i)=ibuffer(iir+i)
      iir=iir+n
      if(iir.eq.iis) then
                           iis=0
                           iir=0
                     endif
      return
      end
