      subroutine setuppss(m,n,nconts,nshels,mtloca,iprimvc,nprimvc,
     &                    icentvc,icontr,inddyy,cutoff,coord,alpha,
     &                    coeff,zeta,zetaa,zetab,aax,aay,aaz,eta,etarr,
     &                    base,px,py,pz,buffer)

c  this subroutine written by alain st-amant and sor koon goh of the
c  department of chemistry, university of ottawa, ottawa, canada.
c  all rights reserved.  this is part of the DeFT project.

      implicit real*8(a-h,o-z)

      include "mpif.h"

      dimension istat(mpi_status_size)

      dimension nshels(*),mtloca(*),iprimvc(*),nprimvc(*),icentvc(*),
     &          icontr(*),inddyy(*)

      dimension coord(3,*),alpha(*),coeff(*),zeta(*),zetaa(*),zetab(*),
     &          aax(*),aay(*),aaz(*),eta(*),etarr(*),base(*),px(*),
     &          py(*),pz(*),buffer(*)

      data zero,expcut/0.0d0,50.0d0/

      call mpi_comm_rank(mpi_comm_world,myid,ierr)
      call mpi_comm_size(mpi_comm_world,numprocs,ierr)

      n=0

      if(myid.eq.0) then
                          isent=0

                          do 1001 islave=0,numprocs-1

                          ia=nconts-isent
                          ib=numprocs-islave

                          nloop=ia/ib
                          if(mod(ia,ib).ne.0) nloop=nloop+1

                          call mpi_bsend(isent+1,1,mpi_integer,islave,
     &                                   islave,mpi_comm_world,ierr)

                          call mpi_bsend(nloop,1,mpi_integer,islave,
     &                                   islave,mpi_comm_world,ierr)

 1001                     isent=isent+nloop
                    endif

      call mpi_recv(iloop,1,mpi_integer,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierr)

      call mpi_recv(nloop,1,mpi_integer,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierr)

      do 1002 i=iloop,iloop+nloop-1
      do 1002 j=1,i

      icnptr=(i*(i-1)/2)+j

      nconta=nshels(i)
      ncontb=nshels(j)

      matlca=mtloca(nconta)
      matlcb=mtloca(ncontb)

      i1=matlca
      i2=(i1*(i1-1))/2
      i3=matlcb
      i4=i2+i3

      inddyy(icnptr)=i4

      iprima=iprimvc(nconta)
      iprimb=iprimvc(ncontb)

      nprima=iprima+nprimvc(nconta)-1
      nprimb=iprimb+nprimvc(ncontb)-1

      icenta=icentvc(nconta)
      icentb=icentvc(ncontb)

      ax=coord(1,icenta)
      ay=coord(2,icenta)
      az=coord(3,icenta)

      bx=coord(1,icentb)
      by=coord(2,icentb)
      bz=coord(3,icentb)

      caxbx=ax-bx
      cayby=ay-by
      cazbz=az-bz

      rr=caxbx*caxbx+cayby*cayby+cazbz*cazbz

      if(rr.gt.(cutoff**2)) goto 1002

      do 1003 ii=iprima,nprima
      do 1003 jj=iprimb,nprimb

      test=rr*alpha(ii)*alpha(jj)/(alpha(ii)+alpha(jj))

      if(test.lt.expcut) then
                               n=n+1

                               icontr(n)=icnptr

                               zetaa(n)=alpha(ii)
                               zetab(n)=alpha(jj)

                               zeta(n)=zetaa(n)+zetab(n)

                               factor=coeff(ii)*coeff(jj)

                               aax(n)=ax
                               aay(n)=ay
                               aaz(n)=az

                               px(n)=(zetaa(n)*ax+zetab(n)*bx)/zeta(n)
                               py(n)=(zetaa(n)*ay+zetab(n)*by)/zeta(n)
                               pz(n)=(zetaa(n)*az+zetab(n)*bz)/zeta(n)

                               eta(n)=zetaa(n)*zetab(n)/zeta(n)

                               etarr(n)=eta(n)*rr

                               base(n)=factor*exp(-etarr(n))
                         endif
 1003 continue
 1002 continue

      do 1004 i=1,nconts
      do 1004 j=1,i

      i1=mtloca(nshels(i))
      i2=(i1*(i1-1))/2
      i3=mtloca(nshels(j))
      i4=i2+i3

 1004 inddyy((i*(i-1)/2)+j)=i4

      call mpi_bsend(n,1,mpi_integer,0,01,mpi_comm_world,ierr)

      call mpi_bsend(icontr,n,mpi_integer,0,02,mpi_comm_world,ierr)

      call stringcopy(n,buffer(0*n+1),zeta)
      call stringcopy(n,buffer(1*n+1),base)
      call stringcopy(n,buffer(2*n+1),eta)
      call stringcopy(n,buffer(3*n+1),etarr)
      call stringcopy(n,buffer(4*n+1),px)
      call stringcopy(n,buffer(5*n+1),py)
      call stringcopy(n,buffer(6*n+1),pz)

      call mpi_bsend(buffer,7*n,mpi_real8,0,03,mpi_comm_world,ierr)

      if(myid.eq.0) then

                    n=0

                    do 1005 i=0,numprocs-1

                    call mpi_recv(nsub,1,mpi_integer,
     &                            i,01,mpi_comm_world,istat,ierr)

                    call mpi_recv(icontr(n+1),nsub,mpi_integer,
     &                            i,02,mpi_comm_world,istat,ierr)

                    call mpi_recv(buffer,7*nsub,mpi_real8,
     &                            i,03,mpi_comm_world,istat,ierr)

                    call stringcopy(nsub,zeta(n+1),buffer(0*nsub+1))
                    call stringcopy(nsub,base(n+1),buffer(1*nsub+1))
                    call stringcopy(nsub,eta(n+1),buffer(2*nsub+1))
                    call stringcopy(nsub,etarr(n+1),buffer(3*nsub+1))
                    call stringcopy(nsub,px(n+1),buffer(4*nsub+1))
                    call stringcopy(nsub,py(n+1),buffer(5*nsub+1))
                    call stringcopy(nsub,pz(n+1),buffer(6*nsub+1))

                    n=n+nsub

 1005               continue

                    endif

      call mpi_bcast(n,1,mpi_integer,0,mpi_comm_world,ierr)

      return
      end
