      subroutine perdew_partial(dnstya,dnstyb,dnstyt,gmodt,bval,
     &                          dbdrhoa,dbdrhob,dbdgama,dbdgamb,dbdgamc)

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 perdew1,perdew2/0.001667d0,0.002568d0/
      data perdew3,perdew4,perdew5/10000.0d0,0.11d0,1.745d0/
      data alpha,beta,gamma,delta/0.023266d0,7.389d-6,8.723d0,0.472d0/
      data zero,one,two,three,four/0.0d0,1.0d0,2.0d0,3.0d0,4.0d0/
      data five,six,seven,dnine,thirteen/5.0d0,6.0d0,7.0d0,9.0d0,13.0d0/
      data third,twothirds/0.33333333333333d0,0.66666666666667d0/
      data fourthirds,fivethirds/1.33333333333333d0,1.66666666666667d0/
      data seventhirds/2.33333333333333d0/
      data cutoff/80.0d0/
      data pi/3.1415926535898d0/

      zeta=(dnstya-dnstyb)/dnstyt

      if(zeta.gt.+one) zeta=+one
      if(zeta.lt.-one) zeta=-one

      factor1=sqrt(((one+zeta)/two)**fivethirds
     &            +((one-zeta)/two)**fivethirds)

      factor2=(((one+zeta)/two)**twothirds)
     &       -(((one-zeta)/two)**twothirds)

      d=(two**third)*factor1

      d_1=(one/d)

      dd_1dzeta=-(five/six)*factor2/((two**fourthirds)*(factor1**3))

      dd_1drhoa=+dd_1dzeta*two*dnstyb/(dnstyt**2)
      dd_1drhob=-dd_1dzeta*two*dnstya/(dnstyt**2)

      r=(three/(four*pi*dnstyt))**third

      factor1=perdew2+alpha*r+beta*r*r
      factor2=one+gamma*r+delta*r*r+perdew3*beta*r*r*r
      factor3=alpha+two*beta*r
      factor4=gamma+two*delta*r+three*perdew3*beta*r*r

      cn=perdew1+(factor1/factor2)

      dcndr=(factor3/factor2)-((factor1*factor4)/(factor2**2))

      drdrho=((-four*pi)/dnine)*(three/(four*pi*dnstyt))**fourthirds

      dcdrho=dcndr*drdrho

      rho_43=(one/(dnstyt**fourthirds))

      drho_43drho=(-four/three)*rho_43/dnstyt

      grad2=gmodt**2

      dgrad2dgamaa=one
      dgrad2dgambb=one
      dgrad2dgamab=two

      cinfinity=perdew1+perdew2

      factor1=(one/dnstyt**(seven/six))

      phi=perdew5*perdew4*(cinfinity/cn)*gmodt*factor1

      e_phi=zero
      if(e_phi.lt.cutoff) e_phi=exp(-phi)

      dcn_1drho=(-one/(cn**2))*dcdrho

      drho_76drho=(-seven/six)/(dnstyt**(thirteen/six))

      factor2=-e_phi*perdew5*perdew4*cinfinity*gmodt

      factor3=factor2*factor1*dcn_1drho
      factor4=factor2*(one/cn)*drho_76drho

      dephidrho=factor3+factor4

      factor2=-e_phi*perdew5*perdew4*(cinfinity/cn)*factor1

      dgmodtdgamaa=one/(two*gmodt)
      dgmodtdgambb=one/(two*gmodt)
      dgmodtdgamab=one/gmodt

      dephidgamaa=factor2*dgmodtdgamaa
      dephidgambb=factor2*dgmodtdgambb
      dephidgamab=factor2*dgmodtdgamab

      bval=bval+d_1*e_phi*cn*grad2/(dnstyt**seventhirds)

      factor1a=dd_1drhoa*e_phi*cn*grad2*rho_43
      factor1b=dd_1drhob*e_phi*cn*grad2*rho_43

      factor2=d_1*dephidrho*cn*grad2*rho_43

      factor3=d_1*e_phi*dcdrho*grad2*rho_43

      factor4=d_1*e_phi*cn*grad2*drho_43drho

      dbdrhoa=dbdrhoa+factor1a+factor2+factor3+factor4
      dbdrhob=dbdrhob+factor1b+factor2+factor3+factor4

      factor1aa=d_1*cn*rho_43*e_phi*dgrad2dgamaa
      factor1bb=d_1*cn*rho_43*e_phi*dgrad2dgambb
      factor1ab=d_1*cn*rho_43*e_phi*dgrad2dgamab

      factor2aa=d_1*cn*rho_43*grad2*dephidgamaa
      factor2bb=d_1*cn*rho_43*grad2*dephidgambb
      factor2ab=d_1*cn*rho_43*grad2*dephidgamab

      dbdgama=dbdgama+factor1aa+factor2aa
      dbdgamb=dbdgamb+factor1bb+factor2bb
      dbdgamc=dbdgamc+factor1ab+factor2ab

      return
      end
