      subroutine coremm(nreal,ninteger,natoms,nptcharges,nconts,ncontp,
     &                  ncontd,nshels,nshelp,nsheld,mtloca,iprimvc,
     &                  nprimvc,icentvc,iwkvec,cutoff,coord,coordatom,
     &                  coordptcharge,charge,chargatom,chargptcharge,
     &                  alpha,coeff,overlp,core,wkvec)

c  this subroutine written by alain st-amant of the department of
c  pharmaceutical chemistry, university of california, san francisco.
c  all rights reserved.  this is part of the DeFT project.

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

      include "mpif.h"

      dimension g(7)

      dimension jsend(20)

      dimension istat(mpi_status_size)

      dimension nshels(*),nshelp(*),nsheld(*),mtloca(*),iprimvc(*),
     &          nprimvc(*),icentvc(*),iwkvec(*)

      dimension coord(3,*),coordatom(3,*),coordptcharge(3,*),charge(*),
     &          chargatom(*),chargptcharge(*),alpha(*),coeff(*),
     &          overlp(*),core(*),wkvec(*)

      data zero/0.0d0/

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

      ndim=nconts+3*ncontp+6*ncontd
      ndim=ndim*(ndim+1)/2

      do 1001 i=1,ndim
      core(i)=zero
 1001 overlp(i)=zero

      ncentr=natoms+nptcharges

      do 1002 i=1,natoms
      do 1003 j=1,3
 1003 coord(j,i)=coordatom(j,i)
 1002 charge(i)=chargatom(i)

      if(nptcharges.eq.0) goto 1004

      do 1005 i=1,nptcharges
      do 1006 j=1,3
 1006 coord(j,natoms+i)=coordptcharge(j,i)
 1005 charge(natoms+i)=chargptcharge(i)

 1004 continue

      ncposs=nconts*(nconts+1)/2
      ncpopp=ncontp*(ncontp+1)/2
      ncpodd=ncontd*(ncontd+1)/2

      ncpops=ncontp*nconts
      ncpods=ncontd*nconts
      ncpodp=ncontd*ncontp

      npposs=0
      nppops=0
      nppopp=0
      nppods=0
      nppodp=0
      nppodd=0

      do 1007 i=1,nconts
      do 1007 j=1,i
 1007 npposs=npposs+nprimvc(nshels(i))*nprimvc(nshels(j))

      do 1008 i=1,ncontp
      do 1008 j=1,nconts
 1008 nppops=nppops+nprimvc(nshelp(i))*nprimvc(nshels(j))

      do 1009 i=1,ncontp
      do 1009 j=1,i
 1009 nppopp=nppopp+nprimvc(nshelp(i))*nprimvc(nshelp(j))

      do 1010 i=1,ncontd
      do 1010 j=1,nconts
 1010 nppods=nppods+nprimvc(nsheld(i))*nprimvc(nshels(j))

      do 1011 i=1,ncontd
      do 1011 j=1,ncontp
 1011 nppodp=nppodp+nprimvc(nsheld(i))*nprimvc(nshelp(j))

      do 1012 i=1,ncontd
      do 1012 j=1,i
 1012 nppodd=nppodd+nprimvc(nsheld(i))*nprimvc(nsheld(j))

      ja=1
      jb=ja+npposs
      jc=jb+ncposs

      if(jc.gt.ninteger) stop 'coremm ss integer overflow'

      je=1
      jf=je+npposs
      jg=jf+npposs
      jh=jg+npposs
      ji=jh+npposs
      jj=ji+npposs
      jk=jj+npposs
      jl=jk+npposs
      jm=jl+npposs
      jn=jm+npposs
      jo=jn+npposs
      jp=jo+npposs
      jq=jp+npposs
      jr=jq+npposs*7

      if(jr.gt.nreal) stop 'coremm ss real overflow'

      call setuppss(ncposs,n,nconts,nshels,mtloca,iprimvc,nprimvc,
     &              icentvc,iwkvec(ja),iwkvec(jb),cutoff,coord,alpha,
     &              coeff,wkvec(je),wkvec(jf),wkvec(jg),wkvec(jh),
     &              wkvec(ji),wkvec(jj),wkvec(jk),wkvec(jl),wkvec(jm),
     &              wkvec(jn),wkvec(jo),wkvec(jp),wkvec(jq))

      jd=jc+n

      if(jd.gt.ninteger) stop 'coremm ss integer overflow'

      if(myid.eq.0) then
                          call stringcopy(n,wkvec(00*n+1),wkvec(je))
                          call stringcopy(n,wkvec(01*n+1),wkvec(jf))
                          call stringcopy(n,wkvec(02*n+1),wkvec(jg))
                          call stringcopy(n,wkvec(03*n+1),wkvec(jh))
                          call stringcopy(n,wkvec(04*n+1),wkvec(ji))
                          call stringcopy(n,wkvec(05*n+1),wkvec(jj))
                          call stringcopy(n,wkvec(06*n+1),wkvec(jk))
                          call stringcopy(n,wkvec(07*n+1),wkvec(jl))
                          call stringcopy(n,wkvec(08*n+1),wkvec(jm))
                          call stringcopy(n,wkvec(09*n+1),wkvec(jn))
                          call stringcopy(n,wkvec(10*n+1),wkvec(jo))
                          call stringcopy(n,wkvec(11*n+1),wkvec(jp))
                    endif

      je=1
      jf=je+n
      jg=jf+n
      jh=jg+n
      ji=jh+n
      jj=ji+n
      jk=jj+n
      jl=jk+n
      jm=jl+n
      jn=jm+n
      jo=jn+n
      jp=jo+n
      jq=jp+n

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

                          do 1013 islave=0,numprocs-1

                          ia=n-isent
                          ib=numprocs-islave

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

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

                          jsend(01)=ja
                          jsend(02)=je
                          jsend(03)=jf
                          jsend(04)=jg
                          jsend(05)=jh
                          jsend(06)=ji
                          jsend(07)=jj
                          jsend(08)=jk
                          jsend(09)=jl
                          jsend(10)=jm
                          jsend(11)=jn
                          jsend(12)=jo
                          jsend(13)=jp

                          call mpi_bsend(jsend,13,mpi_integer,islave,
     &                                   islave,mpi_comm_world,ierr)

                          call mpi_bsend(iwkvec(ja),nloop,
     &                                   mpi_integer,islave,islave,
     &                                   mpi_comm_world,ierr)

                          call mpi_bsend(wkvec(je),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jk),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jl),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jm),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jn),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jo),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jp),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)

                          ja=ja+nloop

                          je=je+nloop
                          jf=jf+nloop
                          jg=jg+nloop
                          jh=jh+nloop
                          ji=ji+nloop
                          jj=jj+nloop
                          jk=jk+nloop
                          jl=jl+nloop
                          jm=jm+nloop
                          jn=jn+nloop
                          jo=jo+nloop
                          jp=jp+nloop

 1013                     isent=isent+nloop
                    endif

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

      call mpi_recv(jsend,13,mpi_integer,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)

      ja=jsend(01)
      je=jsend(02)
      jf=jsend(03)
      jg=jsend(04)
      ji=jsend(06)
      jj=jsend(07)
      jk=jsend(08)
      jl=jsend(09)
      jm=jsend(10)
      jn=jsend(11)
      jo=jsend(12)
      jp=jsend(13)

      call mpi_recv(iwkvec(ja),nloop,mpi_integer,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)

      call mpi_recv(wkvec(je),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jk),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jl),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jm),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jn),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jo),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jp),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)

      ka=jq+1
      kb=ka+nloop
      kc=kb+nloop 
      kd=kc+nloop
      ke=kd+nloop
      kf=ke+nloop
      kg=kf+nloop

      if(kg.gt.nreal) stop 'coremm ss real overflow'

      call coress(ncposs,nloop,ncentr,iwkvec(ja),iwkvec(jb),iwkvec(jc),
     &            coord,charge,overlp,core,wkvec(je),wkvec(jn),
     &            wkvec(jo),wkvec(jp),wkvec(jk),wkvec(jm),wkvec(jl),
     &            wkvec(ka),wkvec(kb),wkvec(kc),wkvec(kd),wkvec(ke),
     &            wkvec(kf))

      if(ncontp.eq.0) goto 1019

      ja=1
      jb=ja+nppops
      jc=jb+ncpops*3

      if(jc.gt.ninteger) stop 'coremm ps integer overflow'

      je=1
      jf=je+nppops
      jg=jf+nppops
      jh=jg+nppops
      ji=jh+nppops
      jj=ji+nppops
      jk=jj+nppops
      jl=jk+nppops
      jm=jl+nppops
      jn=jm+nppops
      jo=jn+nppops
      jp=jo+nppops
      jq=jp+nppops
      jr=jq+nppops
      js=jr+nppops
      jt=js+nppops
      ju=jt+nppops*10

      if(ju.gt.nreal) stop 'coremm ps real overflow'

      call setuppps(ncpops,n,ncontp,nconts,nshelp,nshels,mtloca,iprimvc,
     &              nprimvc,icentvc,iwkvec(ja),iwkvec(jb),cutoff,coord,
     &              alpha,coeff,wkvec(je),wkvec(jf),wkvec(jg),wkvec(jh),
     &              wkvec(ji),wkvec(jj),wkvec(jk),wkvec(jl),wkvec(jm),
     &              wkvec(jn),wkvec(jo),wkvec(jp),wkvec(jq),wkvec(jr),
     &              wkvec(js),wkvec(jt))

      if(myid.eq.0) then
                          call stringcopy(n,wkvec(00*n+1),wkvec(je))
                          call stringcopy(n,wkvec(01*n+1),wkvec(jf))
                          call stringcopy(n,wkvec(02*n+1),wkvec(jg))
                          call stringcopy(n,wkvec(03*n+1),wkvec(jh))
                          call stringcopy(n,wkvec(04*n+1),wkvec(ji))
                          call stringcopy(n,wkvec(05*n+1),wkvec(jj))
                          call stringcopy(n,wkvec(06*n+1),wkvec(jk))
                          call stringcopy(n,wkvec(07*n+1),wkvec(jl))
                          call stringcopy(n,wkvec(08*n+1),wkvec(jm))
                          call stringcopy(n,wkvec(09*n+1),wkvec(jn))
                          call stringcopy(n,wkvec(10*n+1),wkvec(jo))
                          call stringcopy(n,wkvec(11*n+1),wkvec(jp))
                          call stringcopy(n,wkvec(12*n+1),wkvec(jq))
                          call stringcopy(n,wkvec(13*n+1),wkvec(jr))
                          call stringcopy(n,wkvec(14*n+1),wkvec(js))
                    endif

      je=1
      jf=je+n
      jg=jf+n
      jh=jg+n
      ji=jh+n
      jj=ji+n
      jk=jj+n
      jl=jk+n
      jm=jl+n
      jn=jm+n
      jo=jn+n
      jp=jo+n
      jq=jp+n
      jr=jq+n
      js=jr+n
      jt=js+n

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

                          do 1014 islave=0,numprocs-1

                          ia=n-isent
                          ib=numprocs-islave

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

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

                          jsend(01)=ja
                          jsend(02)=je
                          jsend(03)=jf
                          jsend(04)=jg
                          jsend(05)=jh
                          jsend(06)=ji
                          jsend(07)=jj
                          jsend(08)=jk
                          jsend(09)=jl
                          jsend(10)=jm
                          jsend(11)=jn
                          jsend(12)=jo
                          jsend(13)=jp
                          jsend(14)=jq
                          jsend(15)=jr
                          jsend(16)=js

                          call mpi_bsend(jsend,16,mpi_integer,islave,
     &                                   islave,mpi_comm_world,ierr)

                          call mpi_bsend(iwkvec(ja),nloop,
     &                                   mpi_integer,islave,islave,
     &                                   mpi_comm_world,ierr)

                          call mpi_bsend(wkvec(je),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jk),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jl),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jm),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jn),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jo),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jp),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jq),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jr),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(js),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)

                          ja=ja+nloop

                          je=je+nloop
                          jf=jf+nloop
                          jg=jg+nloop
                          jh=jh+nloop
                          ji=ji+nloop
                          jj=jj+nloop
                          jk=jk+nloop
                          jl=jl+nloop
                          jm=jm+nloop
                          jn=jn+nloop
                          jo=jo+nloop
                          jp=jp+nloop
                          jq=jq+nloop
                          jr=jr+nloop
                          js=js+nloop

 1014                     isent=isent+nloop
                    endif

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

      call mpi_recv(jsend,16,mpi_integer,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)

      ja=jsend(01)
      je=jsend(02)
      jf=jsend(03)
      jg=jsend(04)
      jh=jsend(05)
      ji=jsend(06)
      jj=jsend(07)
      jk=jsend(08)
      jl=jsend(09)
      jm=jsend(10)
      jn=jsend(11)
      jo=jsend(12)
      jp=jsend(13)
      jq=jsend(14)
      jr=jsend(15)
      js=jsend(16)

      call mpi_recv(iwkvec(ja),nloop,mpi_integer,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)

      call mpi_recv(wkvec(je),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jk),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jl),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jm),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jn),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jo),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jp),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jq),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jr),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(js),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)

      ka=jt+1
      kb=ka+nloop
      kc=kb+nloop
      kd=kc+nloop
      ke=kd+nloop*3
      kf=ke+nloop*3
      kg=kf+nloop
      kh=kg+nloop
      ki=kh+nloop
      kj=ki+nloop
      kk=kj+nloop
      kl=kk+nloop*3

      if(kl.gt.nreal) stop 'coremm ps real overflow'

      call coreps(ncpops,nloop,ncentr,iwkvec(ja),iwkvec(jb),iwkvec(jc),
     &            coord,charge,overlp,core,wkvec(je),wkvec(jn),
     &            wkvec(jo),wkvec(jp),wkvec(jq),wkvec(jr),wkvec(js),
     &            wkvec(jk),wkvec(jm),wkvec(jl),wkvec(ka),wkvec(kb),
     &            wkvec(kc),wkvec(kd),wkvec(ke),wkvec(kf),wkvec(kg),
     &            wkvec(kh),wkvec(ki),wkvec(kj))

      ja=1
      jb=ja+ncpopp
      jc=jb+nppopp
      jd=jc+ncpopp*9

      if(jd.gt.ninteger) stop 'coremm pp integer overflow'

      je=1
      jf=je+nppopp
      jg=jf+nppopp
      jh=jg+nppopp
      ji=jh+nppopp
      jj=ji+nppopp
      jk=jj+nppopp
      jl=jk+nppopp
      jm=jl+nppopp
      jn=jm+nppopp
      jo=jn+nppopp
      jp=jo+nppopp
      jq=jp+nppopp
      jr=jq+nppopp
      js=jr+nppopp
      jt=js+nppopp
      ju=jt+nppopp
      jv=ju+nppopp
      jw=jv+nppopp
      jx=jw+ncpopp
      jy=jx+ncpopp
      jz=jy+ncpopp
      j0=jz+ncpopp*13

      if(j0.gt.nreal) stop 'coremm pp real overflow'

      call setupppp(ncpopp,n,ncontp,nshelp,mtloca,iprimvc,nprimvc,
     &              icentvc,iwkvec(ja),iwkvec(jb),iwkvec(jc),cutoff,
     &              coord,alpha,coeff,wkvec(je),wkvec(jf),wkvec(jg),
     &              wkvec(jh),wkvec(ji),wkvec(jj),wkvec(jk),wkvec(jl),
     &              wkvec(jm),wkvec(jn),wkvec(jo),wkvec(jp),wkvec(jq),
     &              wkvec(jr),wkvec(js),wkvec(jt),wkvec(ju),wkvec(jv),
     &              wkvec(jw),wkvec(jx),wkvec(jy),wkvec(jz))

      j1=jd+n

      if(j1.gt.ninteger) stop 'coremm pp integer overflow'

      if(myid.eq.0) then
                          call stringcopy(n,wkvec(00*n+1),wkvec(je))
                          call stringcopy(n,wkvec(01*n+1),wkvec(jf))
                          call stringcopy(n,wkvec(02*n+1),wkvec(jg))
                          call stringcopy(n,wkvec(03*n+1),wkvec(jh))
                          call stringcopy(n,wkvec(04*n+1),wkvec(ji))
                          call stringcopy(n,wkvec(05*n+1),wkvec(jj))
                          call stringcopy(n,wkvec(06*n+1),wkvec(jk))
                          call stringcopy(n,wkvec(07*n+1),wkvec(jl))
                          call stringcopy(n,wkvec(08*n+1),wkvec(jm))
                          call stringcopy(n,wkvec(09*n+1),wkvec(jn))
                          call stringcopy(n,wkvec(10*n+1),wkvec(jo))
                          call stringcopy(n,wkvec(11*n+1),wkvec(jp))
                          call stringcopy(n,wkvec(12*n+1),wkvec(jq))
                          call stringcopy(n,wkvec(13*n+1),wkvec(jr))
                          call stringcopy(n,wkvec(14*n+1),wkvec(js))
                          call stringcopy(n,wkvec(15*n+1),wkvec(jt))
                          call stringcopy(n,wkvec(16*n+1),wkvec(ju))
                          call stringcopy(n,wkvec(17*n+1),wkvec(jv))
                    endif

      call stringcopy(ncpopp,wkvec(18*n+0*ncpopp+1),wkvec(jw))
      call stringcopy(ncpopp,wkvec(18*n+1*ncpopp+1),wkvec(jx))
      call stringcopy(ncpopp,wkvec(18*n+2*ncpopp+1),wkvec(jy))

      je=1
      jf=je+n
      jg=jf+n
      jh=jg+n
      ji=jh+n
      jj=ji+n
      jk=jj+n
      jl=jk+n
      jm=jl+n
      jn=jm+n
      jo=jn+n
      jp=jo+n
      jq=jp+n
      jr=jq+n
      js=jr+n
      jt=js+n
      ju=jt+n
      jv=ju+n
      jw=jv+n
      jx=jw+ncpopp
      jy=jx+ncpopp
      jz=jy+ncpopp

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

                          do 1015 islave=0,numprocs-1

                          ia=n-isent
                          ib=numprocs-islave

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

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

                          jsend(01)=jb
                          jsend(02)=je
                          jsend(03)=jf
                          jsend(04)=jg
                          jsend(05)=jh
                          jsend(06)=ji
                          jsend(07)=jj
                          jsend(08)=jk
                          jsend(09)=jl
                          jsend(10)=jm
                          jsend(11)=jn
                          jsend(12)=jo
                          jsend(13)=jp
                          jsend(14)=jq
                          jsend(15)=jr
                          jsend(16)=js
                          jsend(17)=jt
                          jsend(18)=ju
                          jsend(19)=jv

                          call mpi_bsend(jsend,19,mpi_integer,islave,
     &                                   islave,mpi_comm_world,ierr)

                          call mpi_bsend(iwkvec(jb),nloop,
     &                                   mpi_integer,islave,islave,
     &                                   mpi_comm_world,ierr)

                          call mpi_bsend(wkvec(je),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jk),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jl),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jm),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jn),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jo),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jp),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jq),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jr),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(js),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jt),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(ju),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jv),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)

                          jb=jb+nloop

                          je=je+nloop
                          jf=jf+nloop
                          jg=jg+nloop
                          jh=jh+nloop
                          ji=ji+nloop
                          jj=jj+nloop
                          jk=jk+nloop
                          jl=jl+nloop
                          jm=jm+nloop
                          jn=jn+nloop
                          jo=jo+nloop
                          jp=jp+nloop
                          jq=jq+nloop
                          jr=jr+nloop
                          js=js+nloop
                          jt=jt+nloop
                          ju=ju+nloop
                          jv=jv+nloop

 1015                     isent=isent+nloop
                    endif

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

      call mpi_recv(jsend,19,mpi_integer,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)

      jb=jsend(01)
      je=jsend(02)
      jf=jsend(03)
      jg=jsend(04)
      jh=jsend(05)
      ji=jsend(06)
      jj=jsend(07)
      jk=jsend(08)
      jl=jsend(09)
      jm=jsend(10)
      jn=jsend(11)
      jo=jsend(12)
      jp=jsend(13)
      jq=jsend(14)
      jr=jsend(15)
      js=jsend(16)
      jt=jsend(17)
      ju=jsend(18)
      jv=jsend(19)

      call mpi_recv(iwkvec(jb),nloop,mpi_integer,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)

      call mpi_recv(wkvec(je),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jk),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jl),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jm),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jn),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jo),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jp),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jq),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jr),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(js),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jt),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(ju),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jv),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)

      ka=jz+1
      kb=ka+nloop
      kc=kb+nloop
      kd=kc+nloop
      ke=kd+nloop
      kf=ke+nloop*3
      kg=kf+nloop*3
      kh=kg+nloop*3
      ki=kh+nloop*6
      kj=ki+nloop*9
      kk=kj+nloop*9
      kl=kk+nloop
      km=kl+nloop
      kn=km+nloop
      ko=kn+nloop
      kp=ko+nloop
      kq=kp+nloop
      kr=kq+nloop

      if(kr.gt.nreal) stop 'coremm pp real overflow'

      call corepp(ncpopp,nloop,ncentr,iwkvec(ja),iwkvec(jb),iwkvec(jc),
     &            iwkvec(jd),coord,charge,overlp,core,wkvec(je),
     &            wkvec(jw),wkvec(jx),wkvec(jy),wkvec(jn),wkvec(jo),
     &            wkvec(jp),wkvec(jq),wkvec(jr),wkvec(js),wkvec(jt),
     &            wkvec(ju),wkvec(jv),wkvec(jk),wkvec(jm),wkvec(jl),
     &            wkvec(ka),wkvec(kb),wkvec(kc),wkvec(kd),wkvec(ke),
     &            wkvec(kf),wkvec(kg),wkvec(kh),wkvec(ki),wkvec(kj),
     &            wkvec(kk),wkvec(kl),wkvec(km),wkvec(kn),wkvec(ko),
     &            wkvec(kp),wkvec(kq))

      if(ncontd.eq.0) goto 1019

      ja=1
      jb=ja+nppods
      jc=jb+ncpods*6

      if(jc.gt.ninteger) stop 'coremm ds integer overflow'

      je=1
      jf=je+nppods
      jg=jf+nppods
      jh=jg+nppods
      ji=jh+nppods
      jj=ji+nppods
      jk=jj+nppods
      jl=jk+nppods
      jm=jl+nppods
      jn=jm+nppods
      jo=jn+nppods
      jp=jo+nppods
      jq=jp+nppods
      jr=jq+nppods
      js=jr+nppods
      jt=js+nppods
      ju=jt+nppods*11

      if(jt.gt.nreal) stop 'coremm ds real overflow'

      call setuppds(ncpods,n,ncontd,nconts,nsheld,nshels,mtloca,iprimvc,
     &              nprimvc,icentvc,iwkvec(ja),iwkvec(jb),cutoff,coord,
     &              alpha,coeff,wkvec(je),wkvec(jf),wkvec(jg),wkvec(jh),
     &              wkvec(ji),wkvec(jj),wkvec(jk),wkvec(jl),wkvec(jm),
     &              wkvec(jn),wkvec(jo),wkvec(jp),wkvec(jq),wkvec(jr),
     &              wkvec(js),wkvec(jt))

      jd=jc+n

      if(jd.gt.ninteger) stop 'coremm ds integer overflow'


      if(myid.eq.0) then
                          call stringcopy(n,wkvec(00*n+1),wkvec(je))
                          call stringcopy(n,wkvec(01*n+1),wkvec(jf))
                          call stringcopy(n,wkvec(02*n+1),wkvec(jg))
                          call stringcopy(n,wkvec(03*n+1),wkvec(jh))
                          call stringcopy(n,wkvec(04*n+1),wkvec(ji))
                          call stringcopy(n,wkvec(05*n+1),wkvec(jj))
                          call stringcopy(n,wkvec(06*n+1),wkvec(jk))
                          call stringcopy(n,wkvec(07*n+1),wkvec(jl))
                          call stringcopy(n,wkvec(08*n+1),wkvec(jm))
                          call stringcopy(n,wkvec(09*n+1),wkvec(jn))
                          call stringcopy(n,wkvec(10*n+1),wkvec(jo))
                          call stringcopy(n,wkvec(11*n+1),wkvec(jp))
                          call stringcopy(n,wkvec(12*n+1),wkvec(jq))
                          call stringcopy(n,wkvec(13*n+1),wkvec(jr))
                          call stringcopy(n,wkvec(14*n+1),wkvec(js))
                    endif

      je=1
      jf=je+n
      jg=jf+n
      jh=jg+n
      ji=jh+n
      jj=ji+n
      jk=jj+n
      jl=jk+n
      jm=jl+n
      jn=jm+n
      jo=jn+n
      jp=jo+n
      jq=jp+n
      jr=jq+n
      js=jr+n
      jt=js+n

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

                          do 1016 islave=0,numprocs-1

                          ia=n-isent
                          ib=numprocs-islave

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

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

                          jsend(01)=ja
                          jsend(02)=je
                          jsend(03)=jf
                          jsend(04)=jg
                          jsend(05)=jh
                          jsend(06)=ji
                          jsend(07)=jj
                          jsend(08)=jk
                          jsend(09)=jl
                          jsend(10)=jm
                          jsend(11)=jn
                          jsend(12)=jo
                          jsend(13)=jp
                          jsend(14)=jq
                          jsend(15)=jr
                          jsend(16)=js

                          call mpi_bsend(jsend,16,mpi_integer,islave,
     &                                   islave,mpi_comm_world,ierr)

                          call mpi_bsend(iwkvec(ja),nloop,
     &                                   mpi_integer,islave,islave,
     &                                   mpi_comm_world,ierr)

                          call mpi_bsend(wkvec(je),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jf),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jk),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jl),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jm),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jn),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jo),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jp),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jq),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jr),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(js),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)

                          ja=ja+nloop

                          je=je+nloop
                          jf=jf+nloop
                          jg=jg+nloop
                          jh=jh+nloop
                          ji=ji+nloop
                          jj=jj+nloop
                          jk=jk+nloop
                          jl=jl+nloop
                          jm=jm+nloop
                          jn=jn+nloop
                          jo=jo+nloop
                          jp=jp+nloop
                          jq=jq+nloop
                          jr=jr+nloop
                          js=js+nloop

 1016                     isent=isent+nloop
                    endif

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

      call mpi_recv(jsend,16,mpi_integer,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)

      ja=jsend(01)
      je=jsend(02)
      jf=jsend(03)
      jg=jsend(04)
      jh=jsend(05)
      ji=jsend(06)
      jj=jsend(07)
      jk=jsend(08)
      jl=jsend(09)
      jm=jsend(10)
      jn=jsend(11)
      jo=jsend(12)
      jp=jsend(13)
      jq=jsend(14)
      jr=jsend(15)
      js=jsend(16)

      call mpi_recv(iwkvec(ja),nloop,mpi_integer,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)

      call mpi_recv(wkvec(je),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jf),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jk),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jl),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jm),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jn),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jo),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jp),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jq),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jr),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(js),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)

      ka=jt+1
      kb=ka+nloop
      kc=kb+nloop
      kd=kc+nloop
      ke=kd+nloop
      kf=ke+nloop*3
      kg=kf+nloop*3
      kh=kg+nloop*3
      ki=kh+nloop*6
      kj=ki+nloop*6
      kk=kj+nloop
      kl=kk+nloop
      km=kl+nloop
      kn=km+nloop
      ko=kn+nloop
      kp=ko+nloop
      kq=kp+nloop

      if(kq.gt.nreal) stop 'coremm ds real overflow'

      call coreds(ncpods,nloop,ncentr,iwkvec(ja),iwkvec(jb),iwkvec(jc),
     &            coord,charge,overlp,core,wkvec(je),wkvec(jf),
     &            wkvec(jn),wkvec(jo),wkvec(jp),wkvec(jq),wkvec(jr),
     &            wkvec(js),wkvec(jk),wkvec(jm),wkvec(jl),wkvec(ka),
     &            wkvec(kb),wkvec(kc),wkvec(kd),wkvec(ke),wkvec(kf),
     &            wkvec(kg),wkvec(kh),wkvec(ki),wkvec(kj),wkvec(kk),
     &            wkvec(kl),wkvec(km),wkvec(kn),wkvec(ko),wkvec(kp))

      ja=1
      jb=ja+nppodp
      jc=jb+ncpodp*18

      if(jc.gt.ninteger) stop 'coremm dp integer overflow'

      je=1
      jf=je+nppodp
      jg=jf+nppodp
      jh=jg+nppodp
      ji=jh+nppodp
      jj=ji+nppodp
      jk=jj+nppodp
      jl=jk+nppodp
      jm=jl+nppodp
      jn=jm+nppodp
      jo=jn+nppodp
      jp=jo+nppodp
      jq=jp+nppodp
      jr=jq+nppodp
      js=jr+nppodp
      jt=js+nppodp
      ju=jt+nppodp
      jv=ju+nppodp
      jw=jv+nppodp
      jx=jw+ncpodp
      jy=jx+ncpodp
      jz=jy+ncpodp
      j0=jz+ncpodp*14

      if(j0.gt.nreal) stop 'coremm dp real overflow'

      call setuppdp(ncpodp,n,ncontd,ncontp,nsheld,nshelp,mtloca,iprimvc,
     &              nprimvc,icentvc,iwkvec(ja),iwkvec(jb),cutoff,coord,
     &              alpha,coeff,wkvec(je),wkvec(jf),wkvec(jg),wkvec(jh),
     &              wkvec(ji),wkvec(jj),wkvec(jk),wkvec(jl),wkvec(jm),
     &              wkvec(jn),wkvec(jo),wkvec(jp),wkvec(jq),wkvec(jr),
     &              wkvec(js),wkvec(jt),wkvec(ju),wkvec(jv),wkvec(jw),
     &              wkvec(jx),wkvec(jy),wkvec(jz))

      jd=jc+n

      if(jc.gt.ninteger) stop 'coremm dp integer overflow'

      if(myid.eq.0) then
                          call stringcopy(n,wkvec(00*n+1),wkvec(je))
                          call stringcopy(n,wkvec(01*n+1),wkvec(jf))
                          call stringcopy(n,wkvec(02*n+1),wkvec(jg))
                          call stringcopy(n,wkvec(03*n+1),wkvec(jh))
                          call stringcopy(n,wkvec(04*n+1),wkvec(ji))
                          call stringcopy(n,wkvec(05*n+1),wkvec(jj))
                          call stringcopy(n,wkvec(06*n+1),wkvec(jk))
                          call stringcopy(n,wkvec(07*n+1),wkvec(jl))
                          call stringcopy(n,wkvec(08*n+1),wkvec(jm))
                          call stringcopy(n,wkvec(09*n+1),wkvec(jn))
                          call stringcopy(n,wkvec(10*n+1),wkvec(jo))
                          call stringcopy(n,wkvec(11*n+1),wkvec(jp))
                          call stringcopy(n,wkvec(12*n+1),wkvec(jq))
                          call stringcopy(n,wkvec(13*n+1),wkvec(jr))
                          call stringcopy(n,wkvec(14*n+1),wkvec(js))
                          call stringcopy(n,wkvec(15*n+1),wkvec(jt))
                          call stringcopy(n,wkvec(16*n+1),wkvec(ju))
                          call stringcopy(n,wkvec(17*n+1),wkvec(jv))
                    endif

      call stringcopy(ncpodp,wkvec(18*n+0*ncpodp+1),wkvec(jw))
      call stringcopy(ncpodp,wkvec(18*n+1*ncpodp+1),wkvec(jx))
      call stringcopy(ncpodp,wkvec(18*n+2*ncpodp+1),wkvec(jy))

      je=1
      jf=je+n
      jg=jf+n
      jh=jg+n
      ji=jh+n
      jj=ji+n
      jk=jj+n
      jl=jk+n
      jm=jl+n
      jn=jm+n
      jo=jn+n
      jp=jo+n
      jq=jp+n
      jr=jq+n
      js=jr+n
      jt=js+n
      ju=jt+n
      jv=ju+n
      jw=jv+n
      jx=jw+ncpodp
      jy=jx+ncpodp
      jz=jy+ncpodp

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

                          do 1017 islave=0,numprocs-1

                          ia=n-isent
                          ib=numprocs-islave

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

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

                          jsend(01)=ja
                          jsend(02)=je
                          jsend(03)=jf
                          jsend(04)=jg
                          jsend(05)=jh
                          jsend(06)=ji
                          jsend(07)=jj
                          jsend(08)=jk
                          jsend(09)=jl
                          jsend(10)=jm
                          jsend(11)=jn
                          jsend(12)=jo
                          jsend(13)=jp
                          jsend(14)=jq
                          jsend(15)=jr
                          jsend(16)=js
                          jsend(17)=jt
                          jsend(18)=ju
                          jsend(19)=jv

                          call mpi_bsend(jsend,19,mpi_integer,islave,
     &                                   islave,mpi_comm_world,ierr)

                          call mpi_bsend(iwkvec(ja),nloop,
     &                                   mpi_integer,islave,islave,
     &                                   mpi_comm_world,ierr)

                          call mpi_bsend(wkvec(je),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jf),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jk),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jl),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jm),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jn),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jo),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jp),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jq),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jr),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(js),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jt),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(ju),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jv),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)

                          ja=ja+nloop

                          je=je+nloop
                          jf=jf+nloop
                          jg=jg+nloop
                          jh=jh+nloop
                          ji=ji+nloop
                          jj=jj+nloop
                          jk=jk+nloop
                          jl=jl+nloop
                          jm=jm+nloop
                          jn=jn+nloop
                          jo=jo+nloop
                          jp=jp+nloop
                          jq=jq+nloop
                          jr=jr+nloop
                          js=js+nloop
                          jt=jt+nloop
                          ju=ju+nloop
                          jv=jv+nloop

 1017                     isent=isent+nloop
                    endif

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

      call mpi_recv(jsend,19,mpi_integer,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)

      ja=jsend(01)
      je=jsend(02)
      jf=jsend(03)
      jg=jsend(04)
      jh=jsend(05)
      ji=jsend(06)
      jj=jsend(07)
      jk=jsend(08)
      jl=jsend(09)
      jm=jsend(10)
      jn=jsend(11)
      jo=jsend(12)
      jp=jsend(13)
      jq=jsend(14)
      jr=jsend(15)
      js=jsend(16)
      jt=jsend(17)
      ju=jsend(18)
      jv=jsend(19)

      call mpi_recv(iwkvec(ja),nloop,mpi_integer,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)

      call mpi_recv(wkvec(je),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jf),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jk),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jl),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jm),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jn),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jo),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jp),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jq),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jr),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(js),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jt),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(ju),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jv),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)

      ka=jz+1
      kb=ka+nloop
      kc=kb+nloop
      kd=kc+nloop
      ke=kd+nloop
      kf=ke+nloop
      kg=kf+nloop*3
      kh=kg+nloop*3
      ki=kh+nloop*3
      kj=ki+nloop*3
      kk=kj+nloop*6
      kl=kk+nloop*6
      km=kl+nloop*10
      kn=km+nloop*18
      ko=kn+nloop*18
      kp=ko+nloop
      kq=kp+nloop*3
      kr=kq+nloop
      ks=kr+nloop
      kt=ks+nloop
      ku=kt+nloop
      kv=ku+nloop
      kw=kv+nloop

      if(kw.gt.nreal) stop 'coremm dp real overflow'

      call coredp(ncpodp,nloop,ncentr,iwkvec(ja),iwkvec(jb),iwkvec(jc),
     &            coord,charge,overlp,core,wkvec(je),wkvec(jf),
     &            wkvec(jw),wkvec(jx),wkvec(jy),wkvec(jn),wkvec(jo),
     &            wkvec(jp),wkvec(jq),wkvec(jr),wkvec(js),wkvec(jt),
     &            wkvec(ju),wkvec(jv),wkvec(jk),wkvec(jm),wkvec(jl),
     &            wkvec(ka),wkvec(kb),wkvec(kc),wkvec(kd),wkvec(ke),
     &            wkvec(kf),wkvec(kg),wkvec(kh),wkvec(ki),wkvec(kj),
     &            wkvec(kk),wkvec(kl),wkvec(km),wkvec(kn),wkvec(ko),
     &            wkvec(kp),wkvec(kq),wkvec(kr),wkvec(ks),wkvec(kt),
     &            wkvec(ku),wkvec(kv))

      ja=1
      jb=ja+ncpodd
      jc=jb+nppodd
      jd=jc+ncpodd*36

      if(jd.gt.ninteger) stop 'coremm dd integer overflow'

      je=1
      jf=je+nppodd
      jg=jf+nppodd
      jh=jg+nppodd
      ji=jh+nppodd
      jj=ji+nppodd
      jk=jj+nppodd
      jl=jk+nppodd
      jm=jl+nppodd
      jn=jm+nppodd
      jo=jn+nppodd
      jp=jo+nppodd
      jq=jp+nppodd
      jr=jq+nppodd
      js=jr+nppodd
      jt=js+nppodd
      ju=jt+nppodd
      jv=ju+nppodd
      jw=jv+nppodd
      jx=jw+ncpodd
      jy=jx+ncpodd
      jz=jy+ncpodd
      j0=jz+ncpodd*15

      if(j0.gt.nreal) stop 'coremm dd real overflow'

      call setuppdd(ncpodd,n,ncontd,nsheld,mtloca,iprimvc,nprimvc,
     &              icentvc,iwkvec(ja),iwkvec(jb),iwkvec(jc),cutoff,
     &              coord,alpha,coeff,wkvec(je),wkvec(jf),wkvec(jg),
     &              wkvec(jh),wkvec(ji),wkvec(jj),wkvec(jk),wkvec(jl),
     &              wkvec(jm),wkvec(jn),wkvec(jo),wkvec(jp),wkvec(jq),
     &              wkvec(jr),wkvec(js),wkvec(jt),wkvec(ju),wkvec(jv),
     &              wkvec(jw),wkvec(jx),wkvec(jy),wkvec(jz))

      j1=jd+n

      if(j1.gt.ninteger) stop 'coremm dd integer overflow'

      if(myid.eq.0) then
                          call stringcopy(n,wkvec(00*n+1),wkvec(je))
                          call stringcopy(n,wkvec(01*n+1),wkvec(jf))
                          call stringcopy(n,wkvec(02*n+1),wkvec(jg))
                          call stringcopy(n,wkvec(03*n+1),wkvec(jh))
                          call stringcopy(n,wkvec(04*n+1),wkvec(ji))
                          call stringcopy(n,wkvec(05*n+1),wkvec(jj))
                          call stringcopy(n,wkvec(06*n+1),wkvec(jk))
                          call stringcopy(n,wkvec(07*n+1),wkvec(jl))
                          call stringcopy(n,wkvec(08*n+1),wkvec(jm))
                          call stringcopy(n,wkvec(09*n+1),wkvec(jn))
                          call stringcopy(n,wkvec(10*n+1),wkvec(jo))
                          call stringcopy(n,wkvec(11*n+1),wkvec(jp))
                          call stringcopy(n,wkvec(12*n+1),wkvec(jq))
                          call stringcopy(n,wkvec(13*n+1),wkvec(jr))
                          call stringcopy(n,wkvec(14*n+1),wkvec(js))
                          call stringcopy(n,wkvec(15*n+1),wkvec(jt))
                          call stringcopy(n,wkvec(16*n+1),wkvec(ju))
                          call stringcopy(n,wkvec(17*n+1),wkvec(jv))
                    endif

      call stringcopy(ncpodd,wkvec(18*n+0*ncpodd+1),wkvec(jw))
      call stringcopy(ncpodd,wkvec(18*n+1*ncpodd+1),wkvec(jx))
      call stringcopy(ncpodd,wkvec(18*n+2*ncpodd+1),wkvec(jy))

      je=1
      jf=je+n
      jg=jf+n
      jh=jg+n
      ji=jh+n
      jj=ji+n
      jk=jj+n
      jl=jk+n
      jm=jl+n
      jn=jm+n
      jo=jn+n
      jp=jo+n
      jq=jp+n
      jr=jq+n
      js=jr+n
      jt=js+n
      ju=jt+n
      jv=ju+n
      jw=jv+n
      jx=jw+ncpodd
      jy=jx+ncpodd
      jz=jy+ncpodd

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

                          do 1018 islave=0,numprocs-1

                          ia=n-isent
                          ib=numprocs-islave

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

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

                          jsend(01)=jb
                          jsend(02)=je
                          jsend(03)=jf
                          jsend(04)=jg
                          jsend(05)=jh
                          jsend(06)=ji
                          jsend(07)=jj
                          jsend(08)=jk
                          jsend(09)=jl
                          jsend(10)=jm
                          jsend(11)=jn
                          jsend(12)=jo
                          jsend(13)=jp
                          jsend(14)=jq
                          jsend(15)=jr
                          jsend(16)=js
                          jsend(17)=jt
                          jsend(18)=ju
                          jsend(19)=jv

                          call mpi_bsend(jsend,19,mpi_integer,islave,
     &                                   islave,mpi_comm_world,ierr)

                          call mpi_bsend(iwkvec(jb),nloop,
     &                                   mpi_integer,islave,islave,
     &                                   mpi_comm_world,ierr)

                          call mpi_bsend(wkvec(je),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jf),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jg),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jk),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jl),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jm),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jn),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jo),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jp),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jq),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jr),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(js),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jt),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(ju),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)
                          call mpi_bsend(wkvec(jv),nloop,
     &                                   mpi_real8,islave,islave,
     &                                   mpi_comm_world,ierr)

                          jb=jb+nloop

                          je=je+nloop
                          jf=jf+nloop
                          jg=jg+nloop
                          jh=jh+nloop
                          ji=ji+nloop
                          jj=jj+nloop
                          jk=jk+nloop
                          jl=jl+nloop
                          jm=jm+nloop
                          jn=jn+nloop
                          jo=jo+nloop
                          jp=jp+nloop
                          jq=jq+nloop
                          jr=jr+nloop
                          js=js+nloop
                          jt=jt+nloop
                          ju=ju+nloop
                          jv=jv+nloop

 1018                     isent=isent+nloop
                    endif


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

      call mpi_recv(jsend,19,mpi_integer,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)

      jb=jsend(01)
      je=jsend(02)
      jf=jsend(03)
      jg=jsend(04)
      jh=jsend(05)
      ji=jsend(06)
      jj=jsend(07)
      jk=jsend(08)
      jl=jsend(09)
      jm=jsend(10)
      jn=jsend(11)
      jo=jsend(12)
      jp=jsend(13)
      jq=jsend(14)
      jr=jsend(15)
      js=jsend(16)
      jt=jsend(17)
      ju=jsend(18)
      jv=jsend(19)

      call mpi_recv(iwkvec(jb),nloop,mpi_integer,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)

      call mpi_recv(wkvec(je),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jf),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jg),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jk),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jl),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jm),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jn),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jo),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jp),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jq),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jr),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(js),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jt),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(ju),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)
      call mpi_recv(wkvec(jv),nloop,mpi_real8,mpi_any_source,
     &              mpi_any_tag,mpi_comm_world,istat,ierror)

      ka=jz+1
      kb=ka+nloop
      kc=kb+nloop
      kd=kc+nloop
      ke=kd+nloop
      kf=ke+nloop
      kg=kf+nloop
      kh=kg+nloop*3
      ki=kh+nloop*3
      kj=ki+nloop*3
      kk=kj+nloop*3
      kl=kk+nloop*3
      km=kl+nloop*6
      kn=km+nloop*6
      ko=kn+nloop*6
      kp=ko+nloop*10
      kq=kp+nloop*10
      kr=kq+nloop*15
      ks=kr+nloop*9
      kt=ks+nloop*18
      ku=kt+nloop*18
      kv=ku+nloop*30
      kw=kv+nloop*36
      kx=kw+nloop*36
      ky=kx+nloop
      kz=ky+nloop*3
      la=kz+nloop*6
      lb=la+nloop*9
      lc=lb+nloop
      ld=lc+nloop
      le=ld+nloop
      lf=le+nloop
      lg=lf+nloop
      lh=lg+nloop

      if(lh.gt.nreal) stop 'coremm dd real overflow'

      call coredd(ncpodd,nloop,ncentr,iwkvec(ja),iwkvec(jb),iwkvec(jc),
     &            iwkvec(jd),coord,charge,overlp,core,wkvec(je),
     &            wkvec(jf),wkvec(jg),wkvec(jw),wkvec(jx),wkvec(jy),
     &            wkvec(jn),wkvec(jo),wkvec(jp),wkvec(jq),wkvec(jr),
     &            wkvec(js),wkvec(jt),wkvec(ju),wkvec(jv),wkvec(jk),
     &            wkvec(jm),wkvec(jl),wkvec(ka),wkvec(kb),wkvec(kc),
     &            wkvec(kd),wkvec(ke),wkvec(kf),wkvec(kg),wkvec(kh),
     &            wkvec(ki),wkvec(kj),wkvec(kk),wkvec(kl),wkvec(km),
     &            wkvec(kn),wkvec(ko),wkvec(kp),wkvec(kq),wkvec(kr),
     &            wkvec(ks),wkvec(kt),wkvec(ku),wkvec(kv),wkvec(kw),
     &            wkvec(kx),wkvec(ky),wkvec(kz),wkvec(la),wkvec(lb),
     &            wkvec(lc),wkvec(ld),wkvec(le),wkvec(lf),wkvec(lg))

 1019 continue

      call mpi_reduce(overlp,wkvec,ndim,
     &                mpi_real8,mpi_sum,0,mpi_comm_world,ierr)

      if(myid.eq.0) call stringcopy(ndim,overlp,wkvec)

      call mpi_reduce(core,wkvec,ndim,
     &                mpi_real8,mpi_sum,0,mpi_comm_world,ierr)

      if(myid.eq.0) call stringcopy(ndim,core,wkvec)

      if(myid.eq.0) then
                          call normd(nconts,ncontp,ncontd,
     &                               nshels,nshelp,nsheld,mtloca,core)
                          call normd(nconts,ncontp,ncontd,
     &                               nshels,nshelp,nsheld,mtloca,overlp)
                    endif

      call mpi_bcast(overlp,ndim,mpi_real8,0,mpi_comm_world,ierr)
      call mpi_bcast(core,ndim,mpi_real8,0,mpi_comm_world,ierr)

      return
      end
