      subroutine becke_partial(dnstya,dnstyb,gmoda,gmodb,bval,
     &                         dbdrhoa,dbdrhob,dbdgama,dbdgamb)

c  this subroutine written by alain st-amant 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)

      data tol,beta/1.0d-15,0.0042d0/
      data zero,one,two/0.0d0,1.0d0,2.0d0/
      data three,four,six/3.0d0,4.0d0,6.0d0/
      data third,fourthirds/0.33333333333333d0,1.33333333333333d0/
      data pi/3.1415926535898d0/

      if(dnstya.gt.tol) then
                              xa=gmoda/(dnstya**fourthirds)
                        else
                              xa=zero
                        endif

      if(dnstyb.gt.tol) then
                              xb=gmodb/(dnstyb**fourthirds)
                        else
                              xb=zero
                        endif

      sinhxa=log(xa+sqrt(xa*xa+one))
      sinhxb=log(xb+sqrt(xb*xb+one))

      gxa=(-three/two)*((three/(four*pi))**third)
      gxb=(-three/two)*((three/(four*pi))**third)

      factora=one+six*beta*xa*sinhxa
      factorb=one+six*beta*xb*sinhxb

      gxa=gxa-beta*xa*xa/factora
      gxb=gxb-beta*xb*xb/factorb

      temp=((dnstya**fourthirds)*gxa)+((dnstyb**fourthirds)*gxb)

      if((dnstya+dnstyb).gt.tol) then
                                       temp=temp/(dnstya+dnstyb)
                                 else
                                       temp=zero
                                 endif

      bval=bval+temp

      topa=six*beta*beta*xa*xa*((xa/sqrt(xa*xa+one))-sinhxa)-two*beta*xa
      topb=six*beta*beta*xb*xb*((xb/sqrt(xb*xb+one))-sinhxb)-two*beta*xb

      dgdxa=topa/(factora*factora)
      dgdxb=topb/(factorb*factorb)

      dbdrhoa=dbdrhoa+(four/three)*(dnstya**third)*(gxa-xa*dgdxa)
      dbdrhob=dbdrhob+(four/three)*(dnstyb**third)*(gxb-xb*dgdxb)

      if(abs(gmoda).gt.tol) dbdgama=dbdgama+(one/two)*(one/gmoda)*dgdxa
      if(abs(gmodb).gt.tol) dbdgamb=dbdgamb+(one/two)*(one/gmodb)*dgdxb

      return
      end
