1
2! Copyright (C) 2006 Zhigang Wu and R. E. Cohen.
3! This file is distributed under the terms of the GNU Lesser General Public
4! License. See the file COPYING for license details.
5
6subroutine xc_wc06(n,rho,grho,g2rho,g3rho,ex,ec,vx,vc)
7implicit none
8! arguments
9integer, intent(in) :: n
10real(8), intent(in) :: rho(n),grho(n),g2rho(n),g3rho(n)
11real(8), intent(out) :: ex(n),ec(n),vx(n),vc(n)
12! local variables
13integer i
14real(8), parameter :: pi=3.1415926535897932385d0
15real(8), parameter :: thrd=1.d0/3.d0
16! default PBE beta
17real(8), parameter :: beta=0.06672455060314922d0
18real(8) r,grho_,g2rho_,g3rho_
19real(8) kf,s,u,v,rs,z,g
20real(8) ks,ksg,t,uu,vv,ww
21do i=1,n
22  r=rho(i)
23  if (r.gt.1.d-12) then
24    grho_=grho(i)
25    g2rho_=g2rho(i)
26    g3rho_=g3rho(i)
27    kf=(r*3.d0*pi**2)**thrd
28    s=grho_/(2.d0*kf*r)
29    u=g3rho_/((r**2)*(2.d0*kf)**3)
30    v=g2rho_/(r*(2.d0*kf)**2)
31! Wu-Cohen exchange
32    call x_wc06(r,s,u,v,ex(i),vx(i))
33! Perdew-Burke-Ernzerhof correlation
34    rs=(3.d0/(4.d0*pi*r))**thrd
35    z=0.d0
36    g=1.d0
37    ks=sqrt(4.d0*kf/pi)
38    ksg=2.d0*ks*g
39    t=grho_/(ksg*r)
40    uu=g3rho_/((r**2)*ksg**3)
41    vv=g2rho_/(r*ksg**2)
42    ww=0.d0
43    call c_pbe(beta,rs,z,t,uu,vv,ww,ec(i),vc(i),vc(i))
44  else
45    ex(i)=0.d0
46    ec(i)=0.d0
47    vx(i)=0.d0
48    vc(i)=0.d0
49  end if
50end do
51end subroutine
52
53