      subroutine coress(m,n,ncentr,icontr,inddyy,iloc,coord,charge,
     &                  overlap,core,zeta,px,py,pz,eta,base,etarr,ss,
     &                  sscond,pxcx,pycy,pzcz,u)

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)

      dimension icontr(*),inddyy(*),iloc(*)

      dimension coord(3,*),charge(*),overlap(*),core(*),zeta(*),
     &          px(*),py(*),pz(*),eta(*),base(*),etarr(*),ss(*),
     &          sscond(*),pxcx(*),pycy(*),pzcz(*),u(*)

      data zero,thrhlf,two,three,pi/0.0d0,1.5d0,
     &                              2.0d0,3.0d0,3.1415926535898d0/

      do 1001 i=1,n
 1001 ss(i)=((pi/zeta(i))**thrhlf)*base(i)

      do 1002 i=1,n
 1002 overlap(inddyy(icontr(i)))=overlap(inddyy(icontr(i)))+ss(i)

      do 1003 i=1,n
 1003 ss(i)=eta(i)*(three-two*etarr(i))*ss(i)

      do 1004 i=1,n
 1004 core(inddyy(icontr(i)))=core(inddyy(icontr(i)))+ss(i)

      do 1005 i=1,n
 1005 sscond(i)=zero

      do 2001 nn=1,ncentr

      ccx=coord(1,nn)
      ccy=coord(2,nn)
      ccz=coord(3,nn)

      twopichrg=two*pi*charge(nn)

      do 2002 i=1,n
      pxcx(i)=px(i)-ccx
      pycy(i)=py(i)-ccy
      pzcz(i)=pz(i)-ccz
 2002 u(i)=zeta(i)*(pxcx(i)*pxcx(i)+pycy(i)*pycy(i)+pzcz(i)*pzcz(i))

      call auggv(1,n,iloc,u,ss,pxcx,pycy,pzcz)

      do 2003 i=1,n
 2003 ss(i)=base(i)*ss(i)*twopichrg/zeta(i)

      do 2004 i=1,n
 2004 sscond(i)=sscond(i)+ss(i)

 2001 continue

      do 2005 i=1,n
 2005 core(inddyy(icontr(i)))=core(inddyy(icontr(i)))-sscond(i)

      return
      end
