Line data Source code
1 : !!****m* ABINIT/m_xcpbe
2 : !! NAME
3 : !! m_xcpbe
4 : !!
5 : !! FUNCTION
6 : !! Treat XC functionals closely linked with the Perdew-Wang 92 LSD and the PBE GGA.
7 : !!
8 : !! COPYRIGHT
9 : !! Copyright (C) 1998-2026 ABINIT group (XG,MF,LG,CE,AB)
10 : !! This file is distributed under the terms of the
11 : !! GNU General Public License, see ~abinit/COPYING
12 : !! or http://www.gnu.org/copyleft/gpl.txt .
13 : !!
14 : !! SOURCE
15 :
16 : #if defined HAVE_CONFIG_H
17 : #include "config.h"
18 : #endif
19 :
20 : #include "abi_common.h"
21 :
22 : module m_xcpbe
23 :
24 : use defs_basis
25 : use m_abicore
26 : use m_errors
27 : use m_special_funcs, only : tildeAx,tildeBx,tildeBc
28 : use m_xclda, only : fxc_ksdt,fec_ksdt
29 : use m_numeric_tools, only : invcb
30 :
31 : implicit none
32 :
33 : private
34 : !!***
35 :
36 : public :: xcpbe
37 : public :: xckdt16 ! KDT16 (TGGA) finite-temperature xc functional
38 : !!***
39 :
40 : contains
41 : !!***
42 :
43 : !!****f* ABINIT/xcpbe
44 : !! NAME
45 : !! xcpbe
46 : !!
47 : !! FUNCTION
48 : !! Treat XC functionals closely linked with the Perdew-Wang 92 LSD and the PBE GGA.
49 : !!
50 : !! For a series of values of the density and, if GGA, the square of the
51 : !! gradient of the density, return the associated Exc energy,
52 : !! potential, and, in case of response-function, functions needed
53 : !! to build the XC kernel.
54 : !!
55 : !! If option==2, Exchange-correlation functional from Perdew-Burke-Ernzerhof,
56 : !! Phys.Rev.Lett. 77, 3866 (1996) [[cite:Perdew1996]].
57 : !! If option==1, Reduces to Perdew-Wang LSD , PRB45,13244 (1992) [[cite:Perdew1992]].
58 : !! If option==-1 or -2, take only exchange part of PW (-1) or PBE (-2) functionals.
59 : !! If option==-4, C09x exchange functional of V. R. Cooper, PRB 81, 161104(R) (2010) [[cite:Cooper2010]].
60 : !! If option==3 or 4, take exchange plus RPA correlation
61 : !! part of LSD PW (3) or GGA PBE (4) functionals.
62 : !! If option==5, revPBE functional of Zhang and Yang, PRL 80, 890 (1998) [[cite:Zhang1998]]
63 : !! If option==6, RPBE functional of Hammer, Hansen and Norskov, PRB 59, 7413 (1999) [[cite:Hammer1999]]
64 : !! If option==7, WC functional of Wu and Cohen, PRB 73, 235116 (2006) [[cite:Wu2006]]
65 : !!
66 : !! INPUTS
67 : !! exexch= choice of local exact exchange. Active if exexch=1
68 : !! npts= number of points to be computed
69 : !! nspden=1 for unpolarized, 2 for spin-polarized
70 : !! grho2_updn(npts,2*nspden-1)=square of the gradient of the spin-up,
71 : !! and, if nspden==2, spin-down, and total density (Hartree/Bohr**2),
72 : !! only used if gradient corrected functional (option=2,-2,-4 and 4 or beyond)
73 : !! option= see above
74 : !! order=its absolute value gives the maximal derivative of Exc to be computed.
75 : !! rho_updn(npts,nspden)=spin-up and spin-down density (Hartree/bohr**3)
76 : !! ndvxci= size of dvxci(npts,ndvxci)
77 : !! nd2vxci=size of d2vxci(npts,nd2vxci)
78 : !!
79 : !! OUTPUT
80 : !! d2vxci=third derivative of the xc energy with respect to the density, only
81 : !! only if local-density approximation
82 : !! calculated if order==3
83 : !! In case of local energy functional (option=1,-1 or 3):
84 : !! d2vxci(npts,nd2vxc)= (Hartree*bohr^3)
85 : !! if(nspden=1): d2vxci(:,1)=-(2/3)*dvxci/d$\rho$
86 : !! (dvxci is the second derivative, see below)
87 : !! if(nspden=2): d2vxci(:,1)=3rd order derivative of XC energy with respect to rhouprhouprhoup,
88 : !! d2vxci(:,2)=3rd order derivative of XC energy with respect to rhouprhouprhodn
89 : !! d2vxci(:,3)=3rd order derivative of XC energy with respect to rhodnrhouprhodn
90 : !! d2vxci(:,4)=3rd order derivative of XC energy with respect to rhodnrhodnrhodn
91 : !! dvxcdgr(npts,3)=partial derivative of the exchange-correlation
92 : !! energy (exci*$\rho$) with respect to the spin-up (dvxcdgr(:,1)),
93 : !! spin-down (dvxcdgr(:,2)), or total spin (dvxcdgr(:,3)) gradients of the density
94 : !! divided by the norm of the gradient (the definition changed in v3.3)
95 : !!
96 : !! dvxci=partial second derivatives of the xc energy, only if abs(order)>1
97 : !! In case of local energy functional (option=1,-1 or 3):
98 : !! dvxci(npts,1+nspden)= (Hartree*bohr^3)
99 : !! if(nspden=1 .and. order==2): dvxci(:,1)=dvxc/d$\rho$ , dvxc(:,2) empty
100 : !! if(nspden=1 .and. order==-2): also compute dvxci(:,2)=dvxc($\uparrow$)/d$\rho(\downarrow)$
101 : !! if(nspden=2): dvxci(:,1)=dvxc($\uparrow$)/d$\rho(\uparrow)$,
102 : !! dvxci(:,2)=dvxc($\uparrow$)/d$\rho(\downarrow)$,
103 : !! dvxci(:,3)=dvxc($\downarrow$)/d$\rho(\downarrow)$
104 : !! In case of gradient corrected functional (option=2,-2, 4, 5, 6, -4):
105 : !! dvxci(npts,15)=
106 : !! dvxci(:,1)= d2Ex/drho_up drho_up
107 : !! dvxci(:,2)= d2Ex/drho_dn drho_dn
108 : !! dvxci(:,3)= dEx/d(abs(grad(rho_up))) / abs(grad(rho_up))
109 : !! dvxci(:,4)= dEx/d(abs(grad(rho_dn))) / abs(grad(rho_dn))
110 : !! dvxci(:,5)= d2Ex/d(abs(grad(rho_up))) drho_up / abs(grad(rho_up))
111 : !! dvxci(:,6)= d2Ex/d(abs(grad(rho_dn))) drho_dn / abs(grad(rho_dn))
112 : !! dvxci(:,7)= 1/abs(grad(rho_up)) * d/drho_up (dEx/d(abs(grad(rho_up))) /abs(grad(rho_up)))
113 : !! dvxci(:,8)= 1/abs(grad(rho_dn)) * d/drho_dn (dEx/d(abs(grad(rho_dn))) /abs(grad(rho_dn)))
114 : !! dvxci(:,9)= d2Ec/drho_up drho_up
115 : !! dvxci(:,10)=d2Ec/drho_up drho_dn
116 : !! dvxci(:,11)=d2Ec/drho_dn drho_dn
117 : !! dvxci(:,12)=dEc/d(abs(grad(rho))) / abs(grad(rho))
118 : !! dvxci(:,13)=d2Ec/d(abs(grad(rho))) drho_up / abs(grad(rho))
119 : !! dvxci(:,14)=d2Ec/d(abs(grad(rho))) drho_dn / abs(grad(rho))
120 : !! dvxci(:,15)=1/abs(grad(rho)) * d/drho (dEc/d(abs(grad(rho))) /abs(grad(rho)))
121 : !!
122 : !! exci(npts)=exchange-correlation energy density (hartree)
123 : !! vxci(npts,nspden)=partial derivative of the exchange-correlation energy (exci*$\rho$)
124 : !! with respect to the spin-down (vxci(:,1)) and spin-up (vxci(:,2) densities
125 : !! Normalization: Exc=$\int (exc(r)*\rho (r) d^3 r)$ for $\rho$(r)=electron density.
126 : !!
127 : !! TODO
128 : !! WARNING: option=4 not yet implemented.
129 : !!
130 : !! SOURCE
131 :
132 635724 : subroutine xcpbe(exci,npts,nspden,option,order,rho_updn,vxci,ndvxci,nd2vxci, & !Mandatory Arguments
133 226730 : & d2vxci,dvxcdgr,dvxci,exexch,grho2_updn) !Optional Arguments
134 :
135 : !Arguments ------------------------------------
136 : !scalars
137 : integer,intent(in) :: ndvxci,nd2vxci,npts,nspden,option,order
138 : integer,intent(in),optional :: exexch
139 : !arrays
140 : real(dp),intent(in) :: rho_updn(npts,nspden)
141 : real(dp),intent(in),optional :: grho2_updn(npts,2*nspden-1)
142 : real(dp),intent(out) :: exci(npts),vxci(npts,nspden)
143 : real(dp),intent(out),optional :: d2vxci(npts,nd2vxci),dvxcdgr(npts,3)
144 : real(dp),intent(out),optional :: dvxci(npts,ndvxci)
145 :
146 : !Local variables-------------------------------
147 : ! The "accurate" value of mu is taken from the PBE code.
148 : ! The value of mu_c09 is taken from the paper (see above) in order to recover
149 : ! the GEA behaviour of the enhancement factor for small values of s rather than
150 : ! the LSD linear response limit used in revPBE.
151 : !scalars
152 : integer,save :: initialized=0
153 : integer :: exexch_,ipts,ispden
154 : real(dp),parameter :: alpha_c09=0.0483_dp
155 : !GMR (to match Libxc one should comment the next line and uncomment the following )
156 : real(dp),parameter :: alpha_zeta2=1.0_dp-1.0e-6_dp,alpha_zeta=1.0_dp-1.0e-6_dp
157 : !real(dp),parameter :: alpha_zeta2=1.0_dp,alpha_zeta=1.0_dp
158 : !GMR
159 : !GMR (to match Libxc one should comment the next line and uncomment the following )
160 : real(dp),parameter :: b_wc=0.123456790123_dp,beta=0.066725_dp
161 : !real(dp),parameter :: b_wc=0.123456790123_dp,beta=0.06672455060314922_dp
162 : !GMR
163 : real(dp),parameter :: beta_inv=1.0_dp/beta,c_wc=0.00793746933516_dp
164 : !GMR (to match Libxc one should comment the next line and uncomment the following two)
165 : real(dp),parameter :: fsec_inv=1.0_dp/1.709921_dp,kappa_pbe=0.804_dp
166 : !real(dp),parameter :: fsec_inv=1.0_dp/1.709920934161365617563962776245_dp
167 : !real(dp),parameter :: kappa_pbe=0.804_dp
168 : !GMR
169 : real(dp),parameter :: kappa_revpbe=1.245_dp,mu=0.2195149727645171_dp
170 : real(dp),parameter :: kappa_c09=1.245_dp, mu_c09=0.0617_dp
171 : real(dp),parameter :: mu_divkappa_pbe=mu/kappa_pbe
172 : real(dp),parameter :: mu_divkappa_revpbe=mu/kappa_revpbe
173 : real(dp),parameter :: rsfac=0.6203504908994000_dp,tolgrad=tol10
174 : real(dp),save :: beta_gamma,coeff_tt,factf_zeta,factfp_zeta,gamma,gamma_inv
175 : real(dp),save :: sixpi2_1_3,sixpi2m1_3,sq_rsfac,sq_rsfac_inv,threefourth_divpi,twom1_3
176 : real(dp) :: aa,arg_rr,bb,cc,coeff_aa,alphs2,alphmu,coeff_qq,coeffss,d2aa_drs2,d2aa_drsdzeta
177 : real(dp) :: d2aa_dzeta2,d2bb_drs2,d2bb_drsdzeta,d2bb_dzeta2,d2cc_dbb2
178 : real(dp) :: d2cc_drs2,d2cc_drsdzeta,d2cc_dzeta2,d2ecrs0_drs2,d2ecrs1_drs2
179 : real(dp) :: d2ecrs_drdn2,d2ecrs_drdndrup,d2ecrs_drho2,d2ecrs_drs2
180 : real(dp) :: d2ecrs_drsdzeta,d2ecrs_drup2,d2ecrs_dzeta2,d2fxdg2,d2fxdn2
181 : real(dp) :: d2fxdndg,d2fxdss2,d2fzeta4_dzeta2,d2gcrs_drs2,d2hh_drs2
182 : real(dp) :: d2hh_drsdtt,d2hh_drsdzeta,d2hh_dtt2,d2hh_dttdzeta,d2hh_dzeta2
183 : real(dp) :: d2macrs_drs2,d2pade_drs2,d2pade_drsdtt,d2pade_drsdzeta,d2pade_dtt2
184 : real(dp) :: d2pade_dttdzeta,d2pade_dxx2,d2pade_dzeta2,d2qq_drs2,d2qq_drsdtt
185 : real(dp) :: d2qq_drsdzeta,d2qq_dtt2,d2qq_dttdzeta,d2qq_dzeta2,d2rhohh_drho2
186 : real(dp) :: d2rhohh_drhodg,d2rr_dqq2,d2rr_drs2,d2rr_drsdtt,d2rr_drsdzeta
187 : real(dp) :: d2rr_dtt2,d2rr_dttdzeta,d2rr_dzeta2,d2rs_dn2,d2ssdn2,d2ssdndg
188 : real(dp) :: d2vcrs_drs2,d2xx_drs2,d2xx_drsdtt,d2xx_drsdzeta,d2xx_dttdzeta
189 : real(dp) :: d2xx_dzeta2,d3ecrs0_drs3,d3ecrs_drup3,d3ecrs_drup2drdn
190 : real(dp) :: d3ecrs_drupdrdn2,d3ecrs_drdn3,d3ecrs_dzeta3
191 : real(dp) :: d3ecrs_drs2dzeta,d3ecrs_dzeta2drs,d3ecrs1_drs3,d3gcrs_drs3
192 : real(dp) :: d3ecrs_drs3,d3macrs_drs3
193 : real(dp) :: d_wc,daa_drs,daa_dzeta,dbb_drs,dbb_dzeta
194 : real(dp) :: dcc_dbb,dcc_drs,dcc_dzeta,decrs0_drs,decrs1_drs,decrs_drs
195 : real(dp) :: decrs_dzeta,dfxdg,dfxdn,dfxdss,dfzeta4_dzeta,dgcrs_drs
196 : real(dp) :: dhh_drs,dhh_dtt,dhh_dzeta,div_rr,divss,dmacrs_drs,dpade_drs
197 : real(dp) :: dpade_dtt,dpade_dxx,dpade_dzeta,dqq_drs,dqq_dtt,dqq_dzeta
198 : real(dp) :: drhohh_drho,drr_dqq,drr_drs,drr_dtt,drr_dzeta,drs_dn,dssdg,dssdn
199 : real(dp) :: dtt_dg,dvcrs_drs,dxx_drs,dxx_dtt,dxx_dzeta,ec0_a1,ec0_aa,ec0_b1
200 : real(dp) :: ec0_b2,ec0_b3,ec0_b4,ec0_den,ec0_f1,ec0_f2,ec0_log,ec0_q0,ec0_q1
201 : real(dp) :: ec0_q1p,ec0_q1pp,ec0_q1ppp,ec1_a1,ec1_aa,ec1_b1,ec1_b2,ec1_b3
202 : real(dp) :: ec1_b4,ec1_den,ec1_f1,ec1_f2,ec1_log,ec1_q0,ec1_q1,ec1_q1p,ec1_q1pp
203 : real(dp) :: ec1_q1ppp,ecrs,ecrs0,factfppp_zeta
204 : real(dp) :: ecrs1,ex_gga,ex_lsd,exc,exp_pbe,expss,f_zeta,factfpp_zeta
205 : real(dp) :: fp_zeta,fpp_zeta,fppp_zeta,fx,gamphi3inv,gcrs,grrho2,hh,kappa
206 : real(dp) :: mac_a1,mac_aa,mac_b1,mac_b2,mac_b3,mac_b4,mac_den,mac_f1,mac_f2,mac_log,mac_q0
207 : real(dp) :: mac_q1,mac_q1ppp
208 : real(dp) :: mac_q1p,mac_q1pp,macrs,mu_divkappa,p1_wc,p2_wc,pade,pade_den
209 : real(dp) :: phi3_zeta,phi_logder,phi_zeta,phi_zeta_inv,phip_zeta,phipp_zeta,qq
210 : real(dp) :: rho,rho_inv,rhomot
211 : real(dp) :: rhotmo6,rhotmot,rhoto6,rhotot,rhotot_inv,rr,rs,rsm1_2,sqr_rs
212 : real(dp) :: sqr_sqr_rs,ss,tt,vxcadd,xx,zeta,zeta4,zetm_1_3,zetp_1_3
213 : real(dp) :: a1fa,a2fa,b1fa,b2fa,c1fa,c2fa,e1fa,e2fa,f1fa,f2fa,g1fa,g2fa,h1fa,h2fa
214 : real(dp) :: i1fa,i2fa,m1fa,m2fa,n1fa,n2fa
215 : real(dp) :: sp1_up3,sp1_up2dn,sp1_updn2,sp1_dn3
216 : real(dp) :: sp2_up3,sp2_up2dn,sp2_updn2,sp2_dn3
217 : real(dp) :: sp3_up3,sp3_up2dn,sp3_updn2,sp3_dn3
218 : real(dp) :: d3ecrs_sp0,d3ecrs_sp1,d3ecrs_sp2,d3ecrs_sp3
219 : character(len=500) :: message
220 : !arrays
221 317862 : real(dp),allocatable :: rho_updnm1_3(:,:),rhoarr(:),rhom1_3(:),zetm(:)
222 317862 : real(dp),allocatable :: zetmm1_3(:),zetp(:),zetpm1_3(:)
223 : !no_abirules
224 : !integer :: debug
225 : !real(dp) :: delta,factor,grr,rho_dn,rho_dnm,rho_dnp,rho_up,rho_upm,rho_upp,zeta_mean
226 : !real(dp), allocatable :: wecrsz(:,:),d1wecrsz(:,:),d2wecrsz(:,:),d3wecrsz(:,:)
227 : !real(dp) :: d3ecrs_drho3,d3ecrs_drhodndrho2,d3ecrs_drhoupdrho2
228 : !real(dp) :: ec1_q0p,mac_q0p,sigma1,sigma2,sigma3
229 :
230 : ! *************************************************************************
231 :
232 : !DEBUG
233 : !write(std_out,*)' xcpbe : enter'
234 : !ENDDEBUG
235 :
236 317862 : d_wc=mu-b_wc
237 317862 : exexch_=0;if(present(exexch)) exexch_=exexch
238 :
239 : !DEBUG
240 : !allocate(wecrsz(npts,8),d1wecrsz(npts,8),d2wecrsz(npts,8),d3wecrsz(npts,8))
241 : !ENDDEBUG
242 :
243 317862 : if (option<=-4 .or. option==0 .or. option==4 .or. option>=8 ) then
244 742 : write(message, '(a,a,a,a,i12,a)' ) ch10,&
245 742 : & ' xcpbe : BUG -',ch10,&
246 1484 : & ' Option must be 1, 2, 3, 5, 6, 7, 8, -1 or -2 ; argument was ',option,'.'
247 : ! ABI_BUG(message)
248 : end if
249 :
250 : !Checks the compatibility between the presence of dvxci and ndvxci
251 317862 : if(ndvxci /=0 .neqv. present(dvxci))then
252 0 : message = ' If ndvxci/=0 there must the optional argument dvxci'
253 0 : ABI_BUG(message)
254 : end if
255 :
256 : !Checks the compatibility between the inputs and the presence of the optional arguments
257 317862 : if(ndvxci /= 0 .and. abs(order) <= 1)then
258 : write(message, '(3a,i8,a)' )&
259 0 : & 'The order does not require the presence of dvxci',ch10,&
260 0 : & 'that is allowed when |order|>1, while we have',order,'.'
261 0 : ABI_BUG(message)
262 : end if
263 :
264 317862 : if(ndvxci /= 0 .and. (&
265 : & ((option == 1 .or. option == -1 .or. option == 3) .and. ndvxci /= nspden + 1)&
266 : & .or. (option == -2 .and. ndvxci /= 8)&
267 : & .or. ((option == 2 .or. option == 5 .or. option == 6 .or. option == 7 .or. option == 8) .and. ndvxci /= 15)&
268 : & ))then
269 : write(message, '(12a,4(a,i5))' )&
270 0 : & ' The option is not consistent with the value of ndvxci',ch10,&
271 0 : & ' Allowed values are:',ch10,&
272 0 : & ' ndvxci option',ch10,&
273 0 : & ' nspden+1 1,-1,3',ch10,&
274 0 : & ' 8 -2',ch10,&
275 0 : & ' 15 2, 5,6,7',ch10,&
276 0 : & ' While we have: ndvxc=',ndvxci,', option=',option,', nspden=',nspden,', order=',order
277 0 : ABI_BUG(message)
278 : end if
279 :
280 317862 : if ((option == 1 .or. option == -1 .or. option ==3) .and. (present(grho2_updn) .or. present(dvxcdgr))) then
281 : write(message, '(a,a,a,i6,a)' )&
282 0 : & 'The option chosen does not need the presence',ch10,&
283 0 : & 'of the gradient, or of the array dvxcdgr in the input, needed if option/=1,-1,3 , while we have',option,'.'
284 0 : ABI_BUG(message)
285 : end if
286 :
287 317862 : if (order /= 3 .and. present(d2vxci)) then
288 : write(message, '(a,a,a,i6,a)' )&
289 0 : & 'The order chosen does not need the presence',ch10,&
290 0 : & 'of the array d2vxci, needed if order=3 , while we have',order,'.'
291 0 : ABI_BUG(message)
292 : end if
293 :
294 317862 : if(initialized==0)then
295 420 : twom1_3=two**(-third)
296 420 : sixpi2_1_3=(six*pi**2)**third
297 420 : sixpi2m1_3=one/sixpi2_1_3
298 420 : threefourth_divpi=three_quarters*piinv
299 420 : gamma=(one-log(two))*piinv**2
300 420 : gamma_inv=one/gamma
301 420 : beta_gamma=beta*gamma_inv
302 420 : factf_zeta= one / ( two**(four/three)-two )
303 420 : factfp_zeta= four_thirds * factf_zeta * alpha_zeta2
304 420 : coeff_tt= one/ (four*four*piinv*(three*pi**2)**third)
305 : ! coeff_tt= two * sqrt(four*piinv*(three*pi**2)**third)
306 420 : sq_rsfac=sqrt(rsfac)
307 420 : sq_rsfac_inv=one/sq_rsfac
308 420 : initialized=1
309 : end if
310 :
311 : !Parameters for the Perdew-Wang 92 LSD as well as LSD-RPA,
312 : !see Table I of Phys.Rev.B 45,13244 (1992) [[cite:Perdew1992]]
313 : !GMR (to match Libxc one should comment the next line and uncomment the following two)
314 317862 : ec0_aa=0.031091_dp ; ec1_aa=0.015545_dp ; mac_aa=0.016887_dp
315 : !ec0_aa=0.0310907_dp ; ec1_aa=0.01554535_dp ; mac_aa=0.0168869_dp
316 : !GMR
317 317862 : if(option/=3 .and. option/=4)then
318 : ec0_a1=0.21370_dp ; ec1_a1=0.20548_dp ; mac_a1=0.11125_dp
319 : ec0_b1=7.5957_dp ; ec1_b1=14.1189_dp ; mac_b1=10.357_dp
320 : ec0_b2=3.5876_dp ; ec1_b2=6.1977_dp ; mac_b2=3.6231_dp
321 : ec0_b3=1.6382_dp ; ec1_b3=3.3662_dp ; mac_b3=0.88026_dp
322 : ec0_b4=0.49294_dp ; ec1_b4=0.62517_dp ; mac_b4=0.49671_dp
323 : else ! RPA values
324 0 : ec0_a1=0.082477_dp ; ec1_a1=0.035374_dp ; mac_a1=0.028829_dp
325 0 : ec0_b1=5.1486_dp ; ec1_b1=6.4869_dp ; mac_b1=10.357_dp
326 0 : ec0_b2=1.6483_dp ; ec1_b2=1.3083_dp ; mac_b2=3.6231_dp
327 0 : ec0_b3=0.23647_dp ; ec1_b3=0.11518_dp ; mac_b3=0.479_dp
328 0 : ec0_b4=0.20614_dp ; ec1_b4=0.082349_dp ; mac_b4=0.112279_dp
329 : end if
330 :
331 : if(option/=5 .and. option/=-4)then
332 : kappa=kappa_pbe
333 : mu_divkappa=mu_divkappa_pbe
334 : end if
335 317862 : if(option==5)then
336 492 : kappa=kappa_revpbe
337 492 : mu_divkappa=mu_divkappa_revpbe
338 : end if
339 317862 : if(option==-4)then
340 742 : kappa=kappa_c09
341 : end if
342 : !DEBUG
343 : !Finite-difference debugging, do not take away
344 : !Note : here work with collinear gradients. Might be generalized ...
345 : !debug=2 ! Choose 1 (rho grads) or 2 (grho grads)
346 : !if(order==3)debug=1
347 : !factor=1.0_dp
348 : !zeta_mean=0.98_dp
349 : !!zeta_mean=zero
350 : !delta=0.000025*factor
351 : !delta=0.0000125*factor
352 : !if(debug/=0)then
353 : !do ipts=1,npts-4,5
354 : !rho=ipts*0.01_dp*factor
355 : !rho_up=rho*(1.0_dp+zeta_mean)*0.5_dp
356 : !rho_dn=rho*(1.0_dp-zeta_mean)*0.5_dp
357 : !rho_upp=rho_up+delta
358 : !rho_upm=rho_up-delta
359 : !rho_dnp=rho_dn+delta
360 : !rho_dnm=rho_dn-delta
361 : !! Here, vary rho
362 : !if(debug==1)then
363 : !rho_updn(ipts ,1)=rho_up ; rho_updn(ipts ,2)=rho_dn
364 : !rho_updn(ipts+1,1)=rho_upp; rho_updn(ipts+1,2)=rho_dn
365 : !rho_updn(ipts+2,1)=rho_upm; rho_updn(ipts+2,2)=rho_dn
366 : !rho_updn(ipts+3,1)=rho_up ; rho_updn(ipts+3,2)=rho_dnp
367 : !rho_updn(ipts+4,1)=rho_up ; rho_updn(ipts+4,2)=rho_dnm
368 : !grho2_updn(ipts:ipts+4,1)=(0.2_dp*factor)**2 ! grad2 of spin up density
369 : !grho2_updn(ipts:ipts+4,2)=(0.2_dp*factor)**2 ! grad2 of spin down density
370 : !grho2_updn(ipts:ipts+4,3)=(0.3_dp*factor)**2 ! grad2 of total density
371 : !else
372 : !! Here, vary grho (interchange rho and grho)
373 : !grho2_updn(ipts ,1)=rho_up**2 ; grho2_updn(ipts ,2)=rho_dn**2
374 : !grho2_updn(ipts+1,1)=rho_upp**2; grho2_updn(ipts+1,2)=rho_dn**2
375 : !grho2_updn(ipts+2,1)=rho_upm**2; grho2_updn(ipts+2,2)=rho_dn**2
376 : !grho2_updn(ipts+3,1)=rho_up**2 ; grho2_updn(ipts+3,2)=rho_dnp**2
377 : !grho2_updn(ipts+4,1)=rho_up**2 ; grho2_updn(ipts+4,2)=rho_dnm**2
378 : !grho2_updn(ipts ,3)=(ipts*0.01_dp*factor)**2
379 : !grho2_updn(ipts+1,3)=(ipts*0.01_dp*factor+delta)**2
380 : !grho2_updn(ipts+2,3)=(ipts*0.01_dp*factor-delta)**2
381 : !grho2_updn(ipts+3,3)=(ipts*0.01_dp*factor+delta)**2 ! identical to ipts+1
382 : !grho2_updn(ipts+4,3)=(ipts*0.01_dp*factor-delta)**2 ! identical to ipts+2
383 : !rho_updn(ipts:ipts+4,1)=0.2_dp*factor*(1.0_dp+zeta_mean)*0.5_dp ! spin up density
384 : !rho_updn(ipts:ipts+4,2)=0.2_dp*factor*(1.0_dp-zeta_mean)*0.5_dp ! spin down density
385 : !end if
386 : !end do
387 : !end if
388 : !Usual option :
389 : !nspden=2 ; order=2
390 : !GGA
391 : !nspden=2 ; order=1
392 : !Might take also, although finite difference later is meaningless
393 : !nspden=1 ; order=-2
394 : !Here, alternative specification, in terms of defined rs and zeta
395 : !do ipts=1,5
396 : !if(ipts==1)then ;rs=0.01_dp ; zeta=0.98_dp ; endif
397 : !if(ipts==2)then ;rs=0.01_dp+delta ; zeta=0.98_dp ; endif
398 : !if(ipts==3)then ;rs=0.01_dp-delta ; zeta=0.98_dp ; endif
399 : !if(ipts==4)then ;rs=0.01_dp ; zeta=0.98_dp+delta ; endif
400 : !if(ipts==5)then ;rs=0.01_dp ; zeta=0.98_dp-delta ; endif
401 : !rho=(rsfac/rs)**3
402 : !rho_up=rho*(1.0_dp+zeta)*0.5_dp
403 : !rho_dn=rho*(1.0_dp-zeta)*0.5_dp
404 : !rho_updn(ipts ,1)=rho_up ; rho_updn(ipts ,2)=rho_dn
405 : !enddo
406 : !ENDDEBUG
407 :
408 317862 : if(order**2 >1)then
409 50438 : factfpp_zeta= third * factfp_zeta * alpha_zeta2
410 : end if
411 :
412 :
413 953586 : ABI_MALLOC(rhoarr,(npts))
414 635724 : ABI_MALLOC(rhom1_3,(npts))
415 953586 : ABI_MALLOC(rho_updnm1_3,(npts,2))
416 635724 : ABI_MALLOC(zetm,(npts))
417 635724 : ABI_MALLOC(zetmm1_3,(npts))
418 635724 : ABI_MALLOC(zetp,(npts))
419 635724 : ABI_MALLOC(zetpm1_3,(npts))
420 :
421 800903 : do ispden=1,nspden
422 800903 : call invcb(rho_updn(:,ispden),rho_updnm1_3(:,ispden),npts)
423 : end do
424 :
425 :
426 317862 : if(nspden==1)then
427 401829111 : rhoarr(:)=two*rho_updn(:,1)
428 401829111 : rhom1_3(:)=twom1_3*rho_updnm1_3(:,1)
429 401829111 : rho_updnm1_3(:,2)=rho_updnm1_3(:,1)
430 : else
431 214781358 : rhoarr(:)=rho_updn(:,1)+rho_updn(:,2)
432 165179 : call invcb(rhoarr,rhom1_3,npts)
433 214781358 : do ipts=1,npts
434 214616179 : rhotmot=rhom1_3(ipts)
435 214616179 : rhotot_inv=rhotmot*rhotmot*rhotmot
436 214616179 : zeta=(rho_updn(ipts,1)-rho_updn(ipts,2))*rhotot_inv
437 214616179 : zetp(ipts)=1.0_dp+zeta*alpha_zeta
438 214781358 : zetm(ipts)=1.0_dp-zeta*alpha_zeta
439 : end do
440 165179 : call invcb(zetp,zetpm1_3,npts)
441 165179 : call invcb(zetm,zetmm1_3,npts)
442 : end if
443 :
444 :
445 : !fab: eliminate the following restriction
446 :
447 : !if (order==3 .and. nspden == 1) d2vxci(:,:)=0._dp
448 :
449 :
450 10514975 : if (order==3) d2vxci(:,:)=0._dp
451 :
452 : !!!Loop unrolling summary
453 : !Completely unrolled for spin non-polarized case
454 : !To be optimized for spin-polarized cases
455 : !The loops are unrolled as follows:
456 : !nspden=1 (line 433)
457 : !order^2<=1 (line 460)
458 : !option=2,5 (line 462)
459 : !option=6,7 (line 630)
460 : !option=-1 (line 825)
461 : !option=-2 (line 853)
462 : !option=1 (line 904)
463 : !option=3 (line 963)
464 : !order=3 (line 1024)
465 : !option=2,5
466 : !option=6,7
467 : !option=-1
468 : !option=-2
469 : !option=1
470 : !option=3
471 : !order=-2 (line 1983)
472 : !option=2,5
473 : !option=6,7
474 : !option=-1
475 : !option=-2
476 : !option=1
477 : !option=3
478 : !order^2>1 (line 2875)
479 : !option=2,5
480 : !option=6,7
481 : !option=-1
482 : !option=-2
483 : !option=1
484 : !option=3
485 : !nspden=2 (line 3750)
486 : !order^2<=1 (line 3754)
487 : !order^2>1 (with if statements inside distinguishing between order=3 or -2) (line 4000)
488 : !!!End loop unrolling summary
489 :
490 : !we separate different cases, depending on nspden
491 317862 : if (nspden==1) then
492 : ! we separate different cases, depending on order
493 152683 : if (order**2<=1) then
494 : ! we separate different cases, depending on option
495 122896 : if(option==2 .or. option==5)then
496 :
497 92746789 : do ipts=1,npts
498 :
499 92707036 : rhotot=rhoarr(ipts)
500 92707036 : rhotmot=rhom1_3(ipts)
501 92707036 : rhotot_inv=rhotmot*rhotmot*rhotmot
502 92707036 : rhotmo6=sqrt(rhotmot)
503 92707036 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
504 : ! -----------------------------------------------------------------------
505 : ! First take care of the exchange part of the functional
506 :
507 92707036 : exc=zero
508 92707036 : dvxcdgr(ipts,3)=zero
509 : ! loop over the spin
510 92707036 : ispden=1
511 92707036 : rho =rho_updn(ipts,ispden)
512 92707036 : rhomot=rho_updnm1_3(ipts,ispden)
513 92707036 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
514 : ! Perdew-Burke-Ernzerhof GGA, exchange part
515 92707036 : rho_inv=rhomot*rhomot*rhomot
516 92707036 : coeffss=quarter*sixpi2m1_3*sixpi2m1_3*rho_inv*rho_inv*rhomot*rhomot
517 92707036 : ss=grho2_updn(ipts,ispden)*coeffss
518 92707036 : divss=one/(one+mu_divkappa*ss)
519 92707036 : dfxdss= mu*divss*divss
520 92707036 : d2fxdss2=-mu*two*mu_divkappa*divss*divss*divss
521 92707036 : fx = one+kappa*(one-divss)
522 92707036 : ex_gga= ex_lsd*fx
523 92707036 : dssdn=-eight*third*ss*rho_inv
524 92707036 : dfxdn = dfxdss*dssdn
525 92707036 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
526 : ! The new definition (v3.3) includes the division by the norm of the gradient
527 92707036 : dssdg =two*coeffss
528 92707036 : dfxdg=dfxdss*dssdg
529 92707036 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
530 92707036 : exc=exc+ex_gga*rho
531 :
532 : ! end of loop over the spin
533 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
534 92707036 : exc=exc*2
535 92707036 : exci(ipts)=exc*rhotot_inv
536 92707036 : if(exexch_==1) cycle
537 : ! -----------------------------------------------------------------------------
538 : ! Then takes care of the LSD correlation part of the functional
539 :
540 :
541 92707036 : rs=rsfac*rhotmot
542 92707036 : sqr_rs=sq_rsfac*rhotmo6
543 92707036 : rsm1_2=sq_rsfac_inv*rhoto6
544 :
545 : ! Formulas A6-A8 of PW92LSD
546 92707036 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
547 92707036 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs)
548 92707036 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+4._dp*ec0_b4*rs)
549 92707036 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
550 : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
551 92707036 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
552 92707036 : ecrs0=ec0_q0*ec0_log
553 92707036 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
554 :
555 92707036 : ecrs=ecrs0
556 92707036 : decrs_drs=decrs0_drs
557 92707036 : decrs_dzeta=0.0_dp
558 92707036 : zeta=0.0_dp
559 :
560 : ! Add LSD correlation functional to GGA exchange functional
561 92707036 : exci(ipts)=exci(ipts)+ecrs
562 92707036 : vxci(ipts,1)=vxci(ipts,1)+ecrs-rs*third*decrs_drs
563 :
564 :
565 : ! -----------------------------------------------------------------------------
566 : ! Eventually add the GGA correlation part of the PBE functional
567 : ! Note : the computation of the potential in the spin-unpolarized
568 : ! case could be optimized much further. Other optimizations are left to do.
569 :
570 92707036 : phi_zeta=1.0_dp
571 92707036 : phip_zeta=0.0_dp
572 92707036 : phi_zeta_inv=1.0_dp
573 92707036 : phi_logder=0.0_dp
574 92707036 : phi3_zeta=1.0_dp
575 92707036 : gamphi3inv=gamma_inv
576 92707036 : phipp_zeta=-two*ninth*alpha_zeta*alpha_zeta
577 :
578 : ! From ec to bb
579 92707036 : bb=ecrs*gamphi3inv
580 92707036 : dbb_drs=decrs_drs*gamphi3inv
581 92707036 : dbb_dzeta=gamphi3inv*(decrs_dzeta-three*ecrs*phi_logder)
582 :
583 : ! From bb to cc
584 92707036 : exp_pbe=exp(-bb)
585 92707036 : cc=one/(exp_pbe-one)
586 92707036 : dcc_dbb=cc*cc*exp_pbe
587 92707036 : dcc_drs=dcc_dbb*dbb_drs
588 92707036 : dcc_dzeta=dcc_dbb*dbb_dzeta
589 :
590 : ! From cc to aa
591 92707036 : coeff_aa=beta*gamma_inv*phi_zeta_inv*phi_zeta_inv
592 92707036 : aa=coeff_aa*cc
593 92707036 : daa_drs=coeff_aa*dcc_drs
594 92707036 : daa_dzeta=-two*aa*phi_logder+coeff_aa*dcc_dzeta
595 :
596 : ! Introduce tt : do not assume that the spin-dependent gradients are collinear
597 92707036 : grrho2=four*grho2_updn(ipts,1)
598 92707036 : dtt_dg=two*rhotot_inv*rhotot_inv*rhotmot*coeff_tt
599 : ! Note that tt is (the t variable of PBE divided by phi) squared
600 92707036 : tt=half*grrho2*dtt_dg
601 :
602 : ! Get xx from aa and tt
603 92707036 : xx=aa*tt
604 92707036 : dxx_drs=daa_drs*tt
605 92707036 : dxx_dzeta=daa_dzeta*tt
606 92707036 : dxx_dtt=aa
607 :
608 : ! From xx to pade
609 92707036 : pade_den=one/(one+xx*(one+xx))
610 92707036 : pade=(one+xx)*pade_den
611 92707036 : dpade_dxx=-xx*(two+xx)*pade_den**2
612 92707036 : dpade_drs=dpade_dxx*dxx_drs
613 92707036 : dpade_dtt=dpade_dxx*dxx_dtt
614 92707036 : dpade_dzeta=dpade_dxx*dxx_dzeta
615 :
616 : ! From pade to qq
617 92707036 : coeff_qq=tt*phi_zeta_inv*phi_zeta_inv
618 92707036 : qq=coeff_qq*pade
619 92707036 : dqq_drs=coeff_qq*dpade_drs
620 92707036 : dqq_dtt=pade*phi_zeta_inv*phi_zeta_inv+coeff_qq*dpade_dtt
621 92707036 : dqq_dzeta=coeff_qq*(dpade_dzeta-two*pade*phi_logder)
622 :
623 : ! From qq to rr
624 92707036 : arg_rr=one+beta*gamma_inv*qq
625 92707036 : div_rr=one/arg_rr
626 92707036 : rr=gamma*log(arg_rr)
627 92707036 : drr_dqq=beta*div_rr
628 92707036 : drr_drs=drr_dqq*dqq_drs
629 92707036 : drr_dtt=drr_dqq*dqq_dtt
630 92707036 : drr_dzeta=drr_dqq*dqq_dzeta
631 :
632 : ! From rr to hh
633 92707036 : hh=phi3_zeta*rr
634 92707036 : dhh_drs=phi3_zeta*drr_drs
635 92707036 : dhh_dtt=phi3_zeta*drr_dtt
636 92707036 : dhh_dzeta=phi3_zeta*(drr_dzeta+three*rr*phi_logder)
637 :
638 : ! The GGA correlation energy is added
639 92707036 : exci(ipts)=exci(ipts)+hh
640 :
641 : ! Change of variables : from (rs,zeta,tt) to (rhoup,rhodn,grrho)
642 :
643 : ! From hh to the derivative of the energy wrt the density
644 92707036 : drhohh_drho=hh-third*rs*dhh_drs-zeta*dhh_dzeta-seven*third*tt*dhh_dtt
645 92707036 : vxci(ipts,1)=vxci(ipts,1)+drhohh_drho
646 :
647 : ! From hh to the derivative of the energy wrt to the gradient of the
648 : ! density, divided by the gradient of the density
649 : ! (The v3.3 definition includes the division by the norm of the gradient)
650 92707036 : dvxcdgr(ipts,3)=rhotot*dtt_dg*dhh_dtt
651 :
652 : ! End condition of GGA
653 :
654 : ! Correlation has been added
655 : ! -----------------------------------------------------------------------------
656 :
657 : ! vxci(ipts,2)=vxci(ipts,1)
658 92746789 : dvxcdgr(ipts,2)=dvxcdgr(ipts,1)
659 :
660 : end do
661 : else if((option==6) .or. (option==7)) then
662 :
663 3449693 : do ipts=1,npts
664 :
665 3448704 : rhotot=rhoarr(ipts)
666 3448704 : rhotmot=rhom1_3(ipts)
667 3448704 : rhotot_inv=rhotmot*rhotmot*rhotmot
668 3448704 : rhotmo6=sqrt(rhotmot)
669 3448704 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
670 : ! -----------------------------------------------------------------------
671 : ! First take care of the exchange part of the functional
672 :
673 3448704 : exc=zero
674 3448704 : dvxcdgr(ipts,3)=zero
675 : ! loop over the spin
676 3448704 : ispden=1
677 3448704 : rho =rho_updn(ipts,ispden)
678 3448704 : rhomot=rho_updnm1_3(ipts,ispden)
679 3448704 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
680 : ! Perdew-Burke-Ernzerhof GGA, exchange part
681 3448704 : rho_inv=rhomot*rhomot*rhomot
682 3448704 : coeffss=quarter*sixpi2m1_3*sixpi2m1_3*rho_inv*rho_inv*rhomot*rhomot
683 3448704 : ss=grho2_updn(ipts,ispden)*coeffss
684 :
685 : ! This is RPBE modification
686 3448704 : if (option==6) then
687 1333632 : divss=exp(-mu_divkappa*ss)
688 1333632 : dfxdss= mu*divss
689 1333632 : d2fxdss2=-mu*mu_divkappa*divss
690 :
691 1333632 : fx = one+kappa*(one-divss)
692 1333632 : ex_gga= ex_lsd*fx
693 1333632 : dssdn=-eight*third*ss*rho_inv
694 1333632 : dfxdn = dfxdss*dssdn
695 1333632 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
696 : ! The new definition (v3.3) includes the division by the norm of the gradient
697 1333632 : dssdg =two*coeffss
698 1333632 : dfxdg=dfxdss*dssdg
699 1333632 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
700 1333632 : exc=exc+ex_gga*rho
701 : ! This is the Wu and Cohen modification
702 : else
703 2115072 : expss=exp(-ss)
704 2115072 : p1_wc=b_wc+(mu-b_wc)*(one-ss)*expss+two*c_wc*ss/(one+c_wc*ss*ss)
705 : p2_wc=d_wc*(ss-two)*expss+two*c_wc/(one+c_wc*ss*ss)-&
706 2115072 : & four*c_wc*c_wc*ss*ss/((one+c_wc*ss*ss)*(one+c_wc*ss*ss))
707 2115072 : divss=one/(one+(b_wc*ss+d_wc*ss*expss+log(one+c_wc*ss*ss))/kappa)
708 2115072 : dfxdss=p1_wc*divss*divss
709 2115072 : d2fxdss2=p2_wc*divss*divss-two*divss*divss*divss*p1_wc*p1_wc/kappa
710 :
711 2115072 : fx = one+kappa*(one-divss)
712 2115072 : ex_gga= ex_lsd*fx
713 2115072 : dssdn=-eight*third*ss*rho_inv
714 2115072 : dfxdn = dfxdss*dssdn
715 2115072 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
716 : ! The new definition (v3.3) includes the division by the norm of the gradient
717 2115072 : dssdg =two*coeffss
718 2115072 : dfxdg=dfxdss*dssdg
719 2115072 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
720 2115072 : exc=exc+ex_gga*rho
721 : end if
722 :
723 : ! end of loop over the spin
724 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
725 3448704 : exc=exc*2
726 3448704 : exci(ipts)=exc*rhotot_inv
727 3448704 : if(exexch_==1) cycle
728 : ! -----------------------------------------------------------------------------
729 : ! Then takes care of the LSD correlation part of the functional
730 :
731 :
732 3448704 : rs=rsfac*rhotmot
733 3448704 : sqr_rs=sq_rsfac*rhotmo6
734 3448704 : rsm1_2=sq_rsfac_inv*rhoto6
735 :
736 : ! Formulas A6-A8 of PW92LSD
737 3448704 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
738 3448704 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs)
739 3448704 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+4._dp*ec0_b4*rs)
740 3448704 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
741 : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
742 3448704 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
743 3448704 : ecrs0=ec0_q0*ec0_log
744 3448704 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
745 :
746 3448704 : ecrs=ecrs0
747 3448704 : decrs_drs=decrs0_drs
748 3448704 : decrs_dzeta=0.0_dp
749 3448704 : zeta=0.0_dp
750 :
751 : ! Add LSD correlation functional to GGA exchange functional
752 3448704 : exci(ipts)=exci(ipts)+ecrs
753 3448704 : vxci(ipts,1)=vxci(ipts,1)+ecrs-rs*third*decrs_drs
754 :
755 :
756 : ! -----------------------------------------------------------------------------
757 : ! Eventually add the GGA correlation part of the PBE functional
758 : ! Note : the computation of the potential in the spin-unpolarized
759 : ! case could be optimized much further. Other optimizations are left to do.
760 :
761 3448704 : phi_zeta=1.0_dp
762 3448704 : phip_zeta=0.0_dp
763 3448704 : phi_zeta_inv=1.0_dp
764 3448704 : phi_logder=0.0_dp
765 3448704 : phi3_zeta=1.0_dp
766 3448704 : gamphi3inv=gamma_inv
767 3448704 : phipp_zeta=-two*ninth*alpha_zeta*alpha_zeta
768 :
769 : ! From ec to bb
770 3448704 : bb=ecrs*gamphi3inv
771 3448704 : dbb_drs=decrs_drs*gamphi3inv
772 3448704 : dbb_dzeta=gamphi3inv*(decrs_dzeta-three*ecrs*phi_logder)
773 :
774 : ! From bb to cc
775 3448704 : exp_pbe=exp(-bb)
776 3448704 : cc=one/(exp_pbe-one)
777 3448704 : dcc_dbb=cc*cc*exp_pbe
778 3448704 : dcc_drs=dcc_dbb*dbb_drs
779 3448704 : dcc_dzeta=dcc_dbb*dbb_dzeta
780 :
781 : ! From cc to aa
782 3448704 : coeff_aa=beta*gamma_inv*phi_zeta_inv*phi_zeta_inv
783 3448704 : aa=coeff_aa*cc
784 3448704 : daa_drs=coeff_aa*dcc_drs
785 3448704 : daa_dzeta=-two*aa*phi_logder+coeff_aa*dcc_dzeta
786 :
787 : ! Introduce tt : do not assume that the spin-dependent gradients are collinear
788 3448704 : grrho2=four*grho2_updn(ipts,1)
789 3448704 : dtt_dg=two*rhotot_inv*rhotot_inv*rhotmot*coeff_tt
790 : ! Note that tt is (the t variable of PBE divided by phi) squared
791 3448704 : tt=half*grrho2*dtt_dg
792 :
793 : ! Get xx from aa and tt
794 3448704 : xx=aa*tt
795 3448704 : dxx_drs=daa_drs*tt
796 3448704 : dxx_dzeta=daa_dzeta*tt
797 3448704 : dxx_dtt=aa
798 :
799 : ! From xx to pade
800 3448704 : pade_den=one/(one+xx*(one+xx))
801 3448704 : pade=(one+xx)*pade_den
802 3448704 : dpade_dxx=-xx*(two+xx)*pade_den**2
803 3448704 : dpade_drs=dpade_dxx*dxx_drs
804 3448704 : dpade_dtt=dpade_dxx*dxx_dtt
805 3448704 : dpade_dzeta=dpade_dxx*dxx_dzeta
806 :
807 : ! From pade to qq
808 3448704 : coeff_qq=tt*phi_zeta_inv*phi_zeta_inv
809 3448704 : qq=coeff_qq*pade
810 3448704 : dqq_drs=coeff_qq*dpade_drs
811 3448704 : dqq_dtt=pade*phi_zeta_inv*phi_zeta_inv+coeff_qq*dpade_dtt
812 3448704 : dqq_dzeta=coeff_qq*(dpade_dzeta-two*pade*phi_logder)
813 :
814 : ! From qq to rr
815 3448704 : arg_rr=one+beta*gamma_inv*qq
816 3448704 : div_rr=one/arg_rr
817 3448704 : rr=gamma*log(arg_rr)
818 3448704 : drr_dqq=beta*div_rr
819 3448704 : drr_drs=drr_dqq*dqq_drs
820 3448704 : drr_dtt=drr_dqq*dqq_dtt
821 3448704 : drr_dzeta=drr_dqq*dqq_dzeta
822 :
823 : ! From rr to hh
824 3448704 : hh=phi3_zeta*rr
825 3448704 : dhh_drs=phi3_zeta*drr_drs
826 3448704 : dhh_dtt=phi3_zeta*drr_dtt
827 3448704 : dhh_dzeta=phi3_zeta*(drr_dzeta+three*rr*phi_logder)
828 :
829 : ! The GGA correlation energy is added
830 3448704 : exci(ipts)=exci(ipts)+hh
831 :
832 : ! Change of variables : from (rs,zeta,tt) to (rhoup,rhodn,grrho)
833 :
834 : ! From hh to the derivative of the energy wrt the density
835 3448704 : drhohh_drho=hh-third*rs*dhh_drs-zeta*dhh_dzeta-seven*third*tt*dhh_dtt
836 3448704 : vxci(ipts,1)=vxci(ipts,1)+drhohh_drho
837 :
838 : ! From hh to the derivative of the energy wrt to the gradient of the
839 : ! density, divided by the gradient of the density
840 : ! (The v3.3 definition includes the division by the norm of the gradient)
841 3448704 : dvxcdgr(ipts,3)=rhotot*dtt_dg*dhh_dtt
842 :
843 : ! End condition of GGA
844 :
845 : ! Correlation has been added
846 : ! -----------------------------------------------------------------------------
847 :
848 : ! vxci(ipts,2)=vxci(ipts,1)
849 3449693 : dvxcdgr(ipts,2)=dvxcdgr(ipts,1)
850 :
851 : end do
852 :
853 :
854 : else if (option==-1) then
855 :
856 786630 : do ipts=1,npts
857 :
858 786432 : rhotot=rhoarr(ipts)
859 786432 : rhotmot=rhom1_3(ipts)
860 786432 : rhotot_inv=rhotmot*rhotmot*rhotmot
861 786432 : rhotmo6=sqrt(rhotmot)
862 786432 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
863 : ! -----------------------------------------------------------------------
864 : ! First take care of the exchange part of the functional
865 :
866 786432 : exc=zero
867 : ! loop over the spin
868 786432 : ispden=1
869 786432 : rho =rho_updn(ipts,ispden)
870 786432 : rhomot=rho_updnm1_3(ipts,ispden)
871 786432 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
872 : ! Perdew_Wang 91 LSD
873 786432 : vxci(ipts,ispden)=four_thirds*ex_lsd
874 786432 : exc=exc+ex_lsd*rho
875 :
876 : ! end of loop over the spin
877 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
878 786432 : exc=exc*2
879 786630 : exci(ipts)=exc*rhotot_inv
880 : end do
881 :
882 : else if(option==-2) then
883 :
884 :
885 4607222 : do ipts=1,npts
886 :
887 4604924 : rhotot=rhoarr(ipts)
888 4604924 : rhotmot=rhom1_3(ipts)
889 4604924 : rhotot_inv=rhotmot*rhotmot*rhotmot
890 4604924 : rhotmo6=sqrt(rhotmot)
891 4604924 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
892 : ! -----------------------------------------------------------------------
893 : ! First take care of the exchange part of the functional
894 :
895 4604924 : exc=zero
896 4604924 : dvxcdgr(ipts,3)=zero
897 : ! loop over the spin
898 4604924 : ispden=1
899 4604924 : rho =rho_updn(ipts,ispden)
900 4604924 : rhomot=rho_updnm1_3(ipts,ispden)
901 4604924 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
902 : ! Perdew-Burke-Ernzerhof GGA, exchange part
903 4604924 : rho_inv=rhomot*rhomot*rhomot
904 4604924 : coeffss=quarter*sixpi2m1_3*sixpi2m1_3*rho_inv*rho_inv*rhomot*rhomot
905 4604924 : ss=grho2_updn(ipts,ispden)*coeffss
906 4604924 : divss=one/(one+mu_divkappa*ss)
907 4604924 : dfxdss= mu*divss*divss
908 4604924 : d2fxdss2=-mu*two*mu_divkappa*divss*divss*divss
909 4604924 : fx = one+kappa*(one-divss)
910 4604924 : ex_gga= ex_lsd*fx
911 4604924 : dssdn=-eight*third*ss*rho_inv
912 4604924 : dfxdn = dfxdss*dssdn
913 4604924 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
914 : ! The new definition (v3.3) includes the division by the norm of the gradient
915 4604924 : dssdg =two*coeffss
916 4604924 : dfxdg=dfxdss*dssdg
917 4604924 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
918 4604924 : exc=exc+ex_gga*rho
919 :
920 : ! end of loop over the spin
921 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
922 4604924 : exc=exc*2
923 4604924 : exci(ipts)=exc*rhotot_inv
924 :
925 : ! Correlation has been added
926 : ! -----------------------------------------------------------------------------
927 :
928 : ! vxci(ipts,2)=vxci(ipts,1)
929 4607222 : dvxcdgr(ipts,2)=dvxcdgr(ipts,1)
930 :
931 : end do
932 :
933 :
934 : else if(option==-4) then
935 :
936 :
937 2937998 : do ipts=1,npts
938 :
939 2937256 : rhotot=rhoarr(ipts)
940 2937256 : rhotmot=rhom1_3(ipts)
941 2937256 : rhotot_inv=rhotmot*rhotmot*rhotmot
942 2937256 : rhotmo6=sqrt(rhotmot)
943 2937256 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
944 : ! -----------------------------------------------------------------------
945 : ! First take care of the exchange part of the functional
946 :
947 2937256 : exc=zero
948 2937256 : dvxcdgr(ipts,3)=zero
949 : ! loop over the spin
950 2937256 : ispden=1
951 2937256 : rho =rho_updn(ipts,ispden)
952 2937256 : rhomot=rho_updnm1_3(ipts,ispden)
953 2937256 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
954 : ! VALENTINO R. COOPER C09x GGA, This is an exchange term proposed
955 : ! to use together with vdw-DF (see above).
956 2937256 : rho_inv=rhomot*rhomot*rhomot
957 2937256 : coeffss=quarter*sixpi2m1_3*sixpi2m1_3*rho_inv*rho_inv*rhomot*rhomot
958 : ! the quarter that is lacking is compensated by the grho2_updn in the
959 : ! next line.
960 2937256 : ss=grho2_updn(ipts,ispden)*coeffss
961 2937256 : alphs2=alpha_c09*ss
962 : ! jmb : overflow if alphs2 > 100
963 : if (alphs2 > 100.0 ) alphs2=100.0
964 2937256 : alphmu=alpha_c09*mu_c09
965 : dfxdss= mu_c09*exp(-alphs2)*(one-alphs2)+&
966 2937256 : & kappa*alpha_c09*exp(-alphs2/two)/two
967 : d2fxdss2=-alphmu*exp(-alphs2)*(two-alphs2)-&
968 2937256 : & kappa*(alpha_c09**two)*exp(alphs2/two)/four
969 2937256 : fx = one+mu_c09*ss*exp(-alphs2)+kappa*(one-exp(-alphs2/two))
970 2937256 : ex_gga= ex_lsd*fx
971 2937256 : dssdn=-eight*third*ss*rho_inv
972 2937256 : dfxdn = dfxdss*dssdn
973 2937256 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
974 : !
975 : ! The new definition (v3.3) includes the division by the norm of the gradient
976 2937256 : dssdg =two*coeffss
977 2937256 : dfxdg=dfxdss*dssdg
978 2937256 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg !here also
979 2937256 : exc=exc+ex_gga*rho
980 :
981 : ! end of loop over the spin
982 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
983 2937256 : exc=exc*2
984 2937256 : exci(ipts)=exc*rhotot_inv
985 :
986 : ! Correlation has been added
987 : ! -----------------------------------------------------------------------------
988 :
989 : ! vxci(ipts,2)=vxci(ipts,1)
990 2937998 : dvxcdgr(ipts,2)=dvxcdgr(ipts,1)
991 :
992 : end do
993 :
994 :
995 : else if(option==1)then
996 :
997 :
998 196598392 : do ipts=1,npts
999 :
1000 196519476 : rhotot=rhoarr(ipts)
1001 196519476 : rhotmot=rhom1_3(ipts)
1002 196519476 : rhotot_inv=rhotmot*rhotmot*rhotmot
1003 196519476 : rhotmo6=sqrt(rhotmot)
1004 196519476 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
1005 : ! -----------------------------------------------------------------------
1006 : ! First take care of the exchange part of the functional
1007 :
1008 196519476 : exc=zero
1009 : ! loop over the spin
1010 196519476 : ispden=1
1011 196519476 : rho =rho_updn(ipts,ispden)
1012 196519476 : rhomot=rho_updnm1_3(ipts,ispden)
1013 196519476 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
1014 : ! Perdew_Wang 91 LSD
1015 196519476 : vxci(ipts,ispden)=four_thirds*ex_lsd
1016 196519476 : exc=exc+ex_lsd*rho
1017 :
1018 : ! end of loop over the spin
1019 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
1020 196519476 : exc=exc*2
1021 196519476 : exci(ipts)=exc*rhotot_inv
1022 : ! -----------------------------------------------------------------------------
1023 : ! Then takes care of the LSD correlation part of the functional
1024 :
1025 :
1026 196519476 : rs=rsfac*rhotmot
1027 196519476 : sqr_rs=sq_rsfac*rhotmo6
1028 196519476 : rsm1_2=sq_rsfac_inv*rhoto6
1029 :
1030 : ! Formulas A6-A8 of PW92LSD
1031 196519476 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
1032 196519476 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs)
1033 196519476 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+4._dp*ec0_b4*rs)
1034 196519476 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
1035 : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
1036 196519476 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
1037 196519476 : ecrs0=ec0_q0*ec0_log
1038 196519476 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
1039 :
1040 196519476 : ecrs=ecrs0
1041 196519476 : decrs_drs=decrs0_drs
1042 196519476 : decrs_dzeta=0.0_dp
1043 196519476 : zeta=0.0_dp
1044 :
1045 : ! Add LSD correlation functional to GGA exchange functional
1046 196519476 : exci(ipts)=exci(ipts)+ecrs
1047 196598392 : vxci(ipts,1)=vxci(ipts,1)+ecrs-rs*third*decrs_drs
1048 :
1049 : ! Correlation has been added
1050 : ! -----------------------------------------------------------------------------
1051 :
1052 : end do
1053 :
1054 : else if (option==3) then
1055 0 : do ipts=1,npts
1056 :
1057 0 : rhotot=rhoarr(ipts)
1058 0 : rhotmot=rhom1_3(ipts)
1059 0 : rhotot_inv=rhotmot*rhotmot*rhotmot
1060 0 : rhotmo6=sqrt(rhotmot)
1061 0 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
1062 : ! -----------------------------------------------------------------------
1063 : ! First take care of the exchange part of the functional
1064 :
1065 0 : exc=zero
1066 : ! loop over the spin
1067 0 : ispden=1
1068 0 : rho =rho_updn(ipts,ispden)
1069 0 : rhomot=rho_updnm1_3(ipts,ispden)
1070 0 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
1071 : ! Perdew_Wang 91 LSD
1072 0 : vxci(ipts,ispden)=four_thirds*ex_lsd
1073 0 : exc=exc+ex_lsd*rho
1074 :
1075 : ! end of loop over the spin
1076 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
1077 0 : exc=exc*2
1078 0 : exci(ipts)=exc*rhotot_inv
1079 : ! -----------------------------------------------------------------------------
1080 : ! Then takes care of the LSD correlation part of the functional
1081 :
1082 :
1083 0 : rs=rsfac*rhotmot
1084 0 : sqr_rs=sq_rsfac*rhotmo6
1085 0 : rsm1_2=sq_rsfac_inv*rhoto6
1086 :
1087 : ! Formulas A6-A8 of PW92LSD
1088 0 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
1089 0 : sqr_sqr_rs=max(1.e-15_dp,sqrt(sqr_rs))
1090 0 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs/sqr_sqr_rs)
1091 0 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+3.5_dp*ec0_b4*rs/sqr_sqr_rs)
1092 0 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
1093 : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
1094 0 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
1095 0 : ecrs0=ec0_q0*ec0_log
1096 0 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
1097 :
1098 0 : ecrs=ecrs0
1099 0 : decrs_drs=decrs0_drs
1100 0 : decrs_dzeta=0.0_dp
1101 0 : zeta=0.0_dp
1102 :
1103 : ! Add LSD correlation functional to GGA exchange functional
1104 0 : exci(ipts)=exci(ipts)+ecrs
1105 0 : vxci(ipts,1)=vxci(ipts,1)+ecrs-rs*third*decrs_drs
1106 :
1107 : ! Correlation has been added
1108 : ! -----------------------------------------------------------------------------
1109 :
1110 : end do
1111 :
1112 :
1113 : end if
1114 :
1115 29787 : else if (order==3) then
1116 : ! separate cases with respect to option
1117 629 : if(option==2 .or. option==5) then
1118 :
1119 0 : do ipts=1,npts
1120 :
1121 0 : rhotot=rhoarr(ipts)
1122 0 : rhotmot=rhom1_3(ipts)
1123 0 : rhotot_inv=rhotmot*rhotmot*rhotmot
1124 0 : rhotmo6=sqrt(rhotmot)
1125 0 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
1126 : ! -----------------------------------------------------------------------
1127 : ! First take care of the exchange part of the functional
1128 :
1129 0 : exc=zero
1130 0 : dvxcdgr(ipts,3)=zero
1131 : ! loop over the spin
1132 0 : ispden=1
1133 0 : rho =rho_updn(ipts,ispden)
1134 0 : rhomot=rho_updnm1_3(ipts,ispden)
1135 0 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
1136 : ! Perdew-Burke-Ernzerhof GGA, exchange part
1137 0 : rho_inv=rhomot*rhomot*rhomot
1138 0 : coeffss=quarter*sixpi2m1_3*sixpi2m1_3*rho_inv*rho_inv*rhomot*rhomot
1139 0 : ss=grho2_updn(ipts,ispden)*coeffss
1140 0 : divss=one/(one+mu_divkappa*ss)
1141 0 : dfxdss= mu*divss*divss
1142 0 : d2fxdss2=-mu*two*mu_divkappa*divss*divss*divss
1143 0 : fx = one+kappa*(one-divss)
1144 0 : ex_gga= ex_lsd*fx
1145 0 : dssdn=-eight*third*ss*rho_inv
1146 0 : dfxdn = dfxdss*dssdn
1147 0 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
1148 : ! The new definition (v3.3) includes the division by the norm of the gradient
1149 0 : dssdg =two*coeffss
1150 0 : dfxdg=dfxdss*dssdg
1151 0 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
1152 0 : exc=exc+ex_gga*rho
1153 :
1154 : ! Perdew-Burke-Ernzerhof GGA, exchange part
1155 : ! Components 3 or 4
1156 0 : dvxci(ipts,2+ispden)=dvxcdgr(ipts,ispden)
1157 : ! Components 1 or 2
1158 0 : d2ssdn2=-11.0_dp*third*dssdn*rho_inv
1159 0 : d2fxdn2=d2fxdss2*dssdn**2+dfxdss*d2ssdn2
1160 : dvxci(ipts,ispden)=third*rho_inv*vxci(ipts,ispden)+&
1161 0 : & ex_lsd*(seven*third*dfxdn+rho*d2fxdn2)
1162 : ! Components 5 or 6
1163 0 : d2ssdndg=-eight*third*dssdg*rho_inv
1164 0 : d2fxdndg=d2fxdss2*dssdn*dssdg+dfxdss*d2ssdndg
1165 0 : dvxci(ipts,4+ispden)=ex_lsd*(four_thirds*dfxdg+rho*d2fxdndg)
1166 : ! Components 7 or 8
1167 0 : d2fxdg2=d2fxdss2*dssdg**2
1168 0 : dvxci(ipts,6+ispden)=ex_lsd*rho*d2fxdg2
1169 : ! For the time being, treat non-spin-polarized like spin-polarized
1170 0 : dvxci(ipts,2)=dvxci(ipts,1)
1171 0 : dvxci(ipts,4)=dvxci(ipts,3)
1172 0 : dvxci(ipts,6)=dvxci(ipts,5)
1173 0 : dvxci(ipts,8)=dvxci(ipts,7)
1174 :
1175 : ! end of loop over the spin
1176 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
1177 0 : exc=exc*2
1178 0 : exci(ipts)=exc*rhotot_inv
1179 : ! -----------------------------------------------------------------------------
1180 : ! Then takes care of the LSD correlation part of the functional
1181 :
1182 :
1183 0 : rs=rsfac*rhotmot
1184 0 : sqr_rs=sq_rsfac*rhotmo6
1185 0 : rsm1_2=sq_rsfac_inv*rhoto6
1186 :
1187 : ! Formulas A6-A8 of PW92LSD
1188 0 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
1189 0 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs)
1190 0 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+4._dp*ec0_b4*rs)
1191 0 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
1192 : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
1193 0 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
1194 0 : ecrs0=ec0_q0*ec0_log
1195 0 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
1196 0 : ec0_q1pp=0.5_dp*ec0_aa*(-ec0_b1*rsm1_2**3+3._dp*ec0_b3*rsm1_2+8._dp*ec0_b4)
1197 : d2ecrs0_drs2= 4.0_dp*ec0_aa*ec0_a1*ec0_q1p*ec0_den &
1198 : & -ec0_q0*ec0_q1pp*ec0_den &
1199 0 : & +ec0_q0*ec0_q1p**2*ec0_den**2*(2._dp*ec0_q1+1.0_dp)
1200 0 : ec0_q1ppp = 0.75_dp*ec0_aa*(rsm1_2**5)*(ec0_b1-ec0_b3*rs)
1201 0 : ec0_f1 = 1._dp/(ec0_q1*ec0_q1*(1._dp + ec0_q1))
1202 0 : ec0_f2 = 1._dp/(ec0_q1*(1+ec0_q1))
1203 : d3ecrs0_drs3 = 6._dp*ec0_q1p*ec0_f1*(-2._dp*ec0_aa*ec0_a1*ec0_q1p + &
1204 : & ec0_q0*ec0_q1pp) - &
1205 : & ec0_f2*(-6._dp*ec0_aa*ec0_a1*ec0_q1pp + ec0_q0*ec0_q1ppp + &
1206 : & ec0_f2*(3._dp*ec0_q1p*(-2._dp*ec0_aa*ec0_a1*ec0_q1p + ec0_q0*ec0_q1pp) + &
1207 0 : & ec0_f2*2._dp*ec0_q0*(ec0_q1p**3)*(1._dp + 3._dp*ec0_q1*(1._dp + ec0_q1))))
1208 :
1209 0 : mac_q0=-2.0_dp*mac_aa*(1.0_dp+mac_a1*rs)
1210 0 : mac_q1=2.0_dp*mac_aa*(mac_b1*sqr_rs+mac_b2*rs+mac_b3*rs*sqr_rs+mac_b4*rs*rs)
1211 0 : mac_q1p=mac_aa*(mac_b1*rsm1_2+2._dp*mac_b2+3._dp*mac_b3*sqr_rs+4._dp*mac_b4*rs)
1212 0 : mac_den=1.0_dp/(mac_q1*mac_q1+mac_q1)
1213 0 : mac_log=-log( mac_q1*mac_q1*mac_den )
1214 0 : macrs=mac_q0*mac_log
1215 0 : dmacrs_drs= -2.0_dp*mac_aa*mac_a1*mac_log - mac_q0*mac_q1p*mac_den
1216 :
1217 0 : ecrs=ecrs0
1218 0 : decrs_drs=decrs0_drs
1219 0 : decrs_dzeta=0.0_dp
1220 0 : d2ecrs_drs2=d2ecrs0_drs2
1221 0 : d2ecrs_dzeta2=alpha_zeta**2*(-macrs)
1222 0 : d2ecrs_drsdzeta=zero
1223 0 : zeta=0.0_dp
1224 :
1225 :
1226 : ! Add LSD correlation functional to GGA exchange functional
1227 0 : exci(ipts)=exci(ipts)+ecrs
1228 0 : vxci(ipts,1)=vxci(ipts,1)+ecrs-rs*third*decrs_drs
1229 :
1230 0 : dvcrs_drs=third*(2._dp*decrs_drs-rs*d2ecrs_drs2)
1231 : ! And d(vxc)/d(rho)=(-rs/(3*rho))*d(vxc)/d(rs)
1232 0 : d2ecrs_drho2= -rs**4*(four_pi*third)*third*dvcrs_drs
1233 0 : dvxci(ipts,9)=d2ecrs_drho2
1234 0 : dvxci(ipts,10)=d2ecrs_drho2
1235 0 : dvxci(ipts,11)=d2ecrs_drho2
1236 :
1237 : ! -----------------------------------------------------------------------------
1238 : ! Eventually add the GGA correlation part of the PBE functional
1239 : ! Note : the computation of the potential in the spin-unpolarized
1240 : ! case could be optimized much further. Other optimizations are left to do.
1241 :
1242 0 : phi_zeta=1.0_dp
1243 0 : phip_zeta=0.0_dp
1244 0 : phi_zeta_inv=1.0_dp
1245 0 : phi_logder=0.0_dp
1246 0 : phi3_zeta=1.0_dp
1247 0 : gamphi3inv=gamma_inv
1248 0 : phipp_zeta=-two*ninth*alpha_zeta*alpha_zeta
1249 :
1250 : ! From ec to bb
1251 0 : bb=ecrs*gamphi3inv
1252 0 : dbb_drs=decrs_drs*gamphi3inv
1253 0 : dbb_dzeta=gamphi3inv*(decrs_dzeta-three*ecrs*phi_logder)
1254 0 : d2bb_drs2=d2ecrs_drs2*gamphi3inv
1255 0 : d2bb_drsdzeta=gamphi3inv*(d2ecrs_drsdzeta-three*decrs_drs*phi_logder)
1256 : d2bb_dzeta2=gamphi3inv*(d2ecrs_dzeta2-six*decrs_dzeta*phi_logder+&
1257 0 : & 12.0_dp*ecrs*phi_logder*phi_logder-three*ecrs*phi_zeta_inv*phipp_zeta)
1258 :
1259 : ! From bb to cc
1260 0 : exp_pbe=exp(-bb)
1261 0 : cc=one/(exp_pbe-one)
1262 0 : dcc_dbb=cc*cc*exp_pbe
1263 0 : dcc_drs=dcc_dbb*dbb_drs
1264 0 : dcc_dzeta=dcc_dbb*dbb_dzeta
1265 0 : d2cc_dbb2=cc*cc*exp_pbe*(two*cc*exp_pbe-one)
1266 0 : d2cc_drs2=d2cc_dbb2*dbb_drs*dbb_drs+dcc_dbb*d2bb_drs2
1267 0 : d2cc_drsdzeta=d2cc_dbb2*dbb_drs*dbb_dzeta+dcc_dbb*d2bb_drsdzeta
1268 0 : d2cc_dzeta2=d2cc_dbb2*dbb_dzeta*dbb_dzeta+dcc_dbb*d2bb_dzeta2
1269 :
1270 : ! From cc to aa
1271 0 : coeff_aa=beta*gamma_inv*phi_zeta_inv*phi_zeta_inv
1272 0 : aa=coeff_aa*cc
1273 0 : daa_drs=coeff_aa*dcc_drs
1274 0 : daa_dzeta=-two*aa*phi_logder+coeff_aa*dcc_dzeta
1275 0 : d2aa_drs2=coeff_aa*d2cc_drs2
1276 0 : d2aa_drsdzeta=-two*daa_drs*phi_logder+coeff_aa*d2cc_drsdzeta
1277 : d2aa_dzeta2=aa*(-two*phi_zeta_inv*phipp_zeta+six*phi_logder*phi_logder)+&
1278 0 : & coeff_aa*(-four*dcc_dzeta*phi_logder+d2cc_dzeta2)
1279 :
1280 : ! Introduce tt : do not assume that the spin-dependent gradients are collinear
1281 0 : grrho2=four*grho2_updn(ipts,1)
1282 0 : dtt_dg=two*rhotot_inv*rhotot_inv*rhotmot*coeff_tt
1283 : ! Note that tt is (the t variable of PBE divided by phi) squared
1284 0 : tt=half*grrho2*dtt_dg
1285 :
1286 : ! Get xx from aa and tt
1287 0 : xx=aa*tt
1288 0 : dxx_drs=daa_drs*tt
1289 0 : dxx_dzeta=daa_dzeta*tt
1290 0 : dxx_dtt=aa
1291 0 : d2xx_drs2=d2aa_drs2*tt
1292 0 : d2xx_drsdzeta=d2aa_drsdzeta*tt
1293 0 : d2xx_drsdtt=daa_drs
1294 0 : d2xx_dttdzeta=daa_dzeta
1295 0 : d2xx_dzeta2=d2aa_dzeta2*tt
1296 :
1297 : ! From xx to pade
1298 0 : pade_den=one/(one+xx*(one+xx))
1299 0 : pade=(one+xx)*pade_den
1300 0 : dpade_dxx=-xx*(two+xx)*pade_den**2
1301 0 : dpade_drs=dpade_dxx*dxx_drs
1302 0 : dpade_dtt=dpade_dxx*dxx_dtt
1303 0 : dpade_dzeta=dpade_dxx*dxx_dzeta
1304 0 : d2pade_dxx2=two*(-one+xx*xx*(three+xx))*pade_den*pade_den*pade_den
1305 0 : d2pade_drs2=d2pade_dxx2*dxx_drs*dxx_drs+dpade_dxx*d2xx_drs2
1306 0 : d2pade_drsdtt=d2pade_dxx2*dxx_drs*dxx_dtt+dpade_dxx*d2xx_drsdtt
1307 0 : d2pade_drsdzeta=d2pade_dxx2*dxx_drs*dxx_dzeta+dpade_dxx*d2xx_drsdzeta
1308 0 : d2pade_dtt2=d2pade_dxx2*dxx_dtt*dxx_dtt
1309 0 : d2pade_dttdzeta=d2pade_dxx2*dxx_dtt*dxx_dzeta+dpade_dxx*d2xx_dttdzeta
1310 0 : d2pade_dzeta2=d2pade_dxx2*dxx_dzeta*dxx_dzeta+dpade_dxx*d2xx_dzeta2
1311 :
1312 : ! From pade to qq
1313 0 : coeff_qq=tt*phi_zeta_inv*phi_zeta_inv
1314 0 : qq=coeff_qq*pade
1315 0 : dqq_drs=coeff_qq*dpade_drs
1316 0 : dqq_dtt=pade*phi_zeta_inv*phi_zeta_inv+coeff_qq*dpade_dtt
1317 0 : dqq_dzeta=coeff_qq*(dpade_dzeta-two*pade*phi_logder)
1318 0 : d2qq_drs2=coeff_qq*d2pade_drs2
1319 0 : d2qq_drsdtt=phi_zeta_inv*phi_zeta_inv*(dpade_drs+tt*d2pade_drsdtt)
1320 0 : d2qq_drsdzeta=coeff_qq*(d2pade_drsdzeta-two*dpade_drs*phi_logder)
1321 0 : d2qq_dtt2=phi_zeta_inv*phi_zeta_inv*(two*dpade_dtt+tt*d2pade_dtt2)
1322 : d2qq_dttdzeta=phi_zeta_inv*phi_zeta_inv*(dpade_dzeta-two*pade*phi_logder)+&
1323 0 : & coeff_qq*(d2pade_dttdzeta-two*dpade_dtt*phi_logder)
1324 : d2qq_dzeta2=coeff_qq*( d2pade_dzeta2-four*dpade_dzeta*phi_logder &
1325 : & +six*pade*phi_logder*phi_logder &
1326 0 : & -two*pade*phi_zeta_inv*phipp_zeta)
1327 :
1328 : ! From qq to rr
1329 0 : arg_rr=one+beta*gamma_inv*qq
1330 0 : div_rr=one/arg_rr
1331 0 : rr=gamma*log(arg_rr)
1332 0 : drr_dqq=beta*div_rr
1333 0 : drr_drs=drr_dqq*dqq_drs
1334 0 : drr_dtt=drr_dqq*dqq_dtt
1335 0 : drr_dzeta=drr_dqq*dqq_dzeta
1336 0 : d2rr_dqq2=-div_rr**2*beta*beta*gamma_inv
1337 0 : d2rr_drs2=d2rr_dqq2*dqq_drs*dqq_drs+drr_dqq*d2qq_drs2
1338 0 : d2rr_drsdtt=d2rr_dqq2*dqq_drs*dqq_dtt+drr_dqq*d2qq_drsdtt
1339 0 : d2rr_drsdzeta=d2rr_dqq2*dqq_drs*dqq_dzeta+drr_dqq*d2qq_drsdzeta
1340 0 : d2rr_dtt2=d2rr_dqq2*dqq_dtt*dqq_dtt+drr_dqq*d2qq_dtt2
1341 0 : d2rr_dttdzeta=d2rr_dqq2*dqq_dtt*dqq_dzeta+drr_dqq*d2qq_dttdzeta
1342 0 : d2rr_dzeta2=d2rr_dqq2*dqq_dzeta*dqq_dzeta+drr_dqq*d2qq_dzeta2
1343 :
1344 : ! From rr to hh
1345 0 : hh=phi3_zeta*rr
1346 0 : dhh_drs=phi3_zeta*drr_drs
1347 0 : dhh_dtt=phi3_zeta*drr_dtt
1348 0 : dhh_dzeta=phi3_zeta*(drr_dzeta+three*rr*phi_logder)
1349 0 : d2hh_drs2=phi3_zeta*d2rr_drs2
1350 0 : d2hh_drsdtt=phi3_zeta*d2rr_drsdtt
1351 0 : d2hh_drsdzeta=phi3_zeta*(d2rr_drsdzeta+three*drr_drs*phi_logder)
1352 0 : d2hh_dtt2=phi3_zeta*d2rr_dtt2
1353 0 : d2hh_dttdzeta=phi3_zeta*(d2rr_dttdzeta+three*drr_dtt*phi_logder)
1354 : d2hh_dzeta2=phi3_zeta*(six*rr*phi_logder*phi_logder+&
1355 : & six*phi_logder*drr_dzeta+d2rr_dzeta2) &
1356 0 : & +three*phi_zeta*phi_zeta*rr*phipp_zeta
1357 :
1358 :
1359 : ! The GGA correlation energy is added
1360 0 : exci(ipts)=exci(ipts)+hh
1361 :
1362 : ! Change of variables : from (rs,zeta,tt) to (rhoup,rhodn,grrho)
1363 :
1364 :
1365 :
1366 : ! From hh to the derivative of the energy wrt the density
1367 0 : drhohh_drho=hh-third*rs*dhh_drs-zeta*dhh_dzeta-seven*third*tt*dhh_dtt
1368 0 : vxci(ipts,1)=vxci(ipts,1)+drhohh_drho
1369 :
1370 : ! From hh to the derivative of the energy wrt to the gradient of the
1371 : ! density, divided by the gradient of the density
1372 : ! (The v3.3 definition includes the division by the norm of the gradient)
1373 0 : dvxcdgr(ipts,3)=rhotot*dtt_dg*dhh_dtt
1374 :
1375 : d2rhohh_drho2=rhotot_inv*&
1376 : & (-two*ninth*rs*dhh_drs +seven*four*ninth*tt*dhh_dtt &
1377 : & +ninth*rs*rs*d2hh_drs2+zeta*zeta*d2hh_dzeta2+(seven*third*tt)**2*d2hh_dtt2 &
1378 : & +two*third*rs*zeta*d2hh_drsdzeta+two*seven*ninth*rs*tt*d2hh_drsdtt &
1379 0 : & +two*seven*third*tt*zeta*d2hh_dttdzeta)
1380 : d2rhohh_drhodg=dtt_dg*(-four*third*dhh_dtt-third*rs*d2hh_drsdtt &
1381 0 : & -zeta*d2hh_dttdzeta-seven*third*tt*d2hh_dtt2)
1382 :
1383 : ! Component 12 : first derivative with respect to the gradient
1384 : ! of the density, div by the grad of the density
1385 0 : dvxci(ipts,12)=dvxcdgr(ipts,3)
1386 : ! Components 9, 10 and 11 : second derivatives with respect to the spin-density
1387 : ! Note that there is already a contribution from LSDA
1388 : dvxci(ipts,9)=dvxci(ipts,9)+d2rhohh_drho2+rhotot_inv* &
1389 : & ( d2hh_dzeta2*(one-two*zeta) &
1390 0 : & -two*third*rs*d2hh_drsdzeta-14.0_dp*third*tt*d2hh_dttdzeta)
1391 0 : dvxci(ipts,10)=dvxci(ipts,10)+d2rhohh_drho2-rhotot_inv*d2hh_dzeta2
1392 : dvxci(ipts,11)=dvxci(ipts,11)+d2rhohh_drho2+rhotot_inv* &
1393 : & ( d2hh_dzeta2*(one+two*zeta) &
1394 0 : & +two*third*rs*d2hh_drsdzeta+14.0_dp*third*tt*d2hh_dttdzeta)
1395 : ! Components 13 and 14 : second derivatives with respect to spin density
1396 : ! and gradient, divided by the gradient
1397 0 : dvxci(ipts,13)=d2rhohh_drhodg+dtt_dg*d2hh_dttdzeta
1398 0 : dvxci(ipts,14)=d2rhohh_drhodg-dtt_dg*d2hh_dttdzeta
1399 : ! Component 15 : derivative of the (derivative wrt the gradient div by the grad),
1400 : ! divided by the grad
1401 0 : dvxci(ipts,15)=rhotot*d2hh_dtt2*dtt_dg*dtt_dg
1402 :
1403 :
1404 : ! End condition of GGA
1405 :
1406 : ! Correlation has been added
1407 : ! -----------------------------------------------------------------------------
1408 :
1409 : ! vxci(ipts,2)=vxci(ipts,1)
1410 0 : dvxcdgr(ipts,2)=dvxcdgr(ipts,1)
1411 :
1412 : end do
1413 : else if ((option==6) .or. (option==7)) then
1414 :
1415 0 : do ipts=1,npts
1416 :
1417 0 : rhotot=rhoarr(ipts)
1418 0 : rhotmot=rhom1_3(ipts)
1419 0 : rhotot_inv=rhotmot*rhotmot*rhotmot
1420 0 : rhotmo6=sqrt(rhotmot)
1421 0 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
1422 : ! -----------------------------------------------------------------------
1423 : ! First take care of the exchange part of the functional
1424 :
1425 0 : exc=zero
1426 0 : dvxcdgr(ipts,3)=zero
1427 : ! loop over the spin
1428 0 : ispden=1
1429 0 : rho =rho_updn(ipts,ispden)
1430 0 : rhomot=rho_updnm1_3(ipts,ispden)
1431 0 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
1432 : ! Perdew-Burke-Ernzerhof GGA, exchange part
1433 0 : rho_inv=rhomot*rhomot*rhomot
1434 0 : coeffss=quarter*sixpi2m1_3*sixpi2m1_3*rho_inv*rho_inv*rhomot*rhomot
1435 0 : ss=grho2_updn(ipts,ispden)*coeffss
1436 :
1437 0 : if (option==6) then
1438 0 : divss=exp(-mu_divkappa*ss)
1439 0 : dfxdss= mu*divss
1440 0 : d2fxdss2=-mu*mu_divkappa*divss
1441 :
1442 0 : fx = one+kappa*(one-divss)
1443 0 : ex_gga= ex_lsd*fx
1444 0 : dssdn=-eight*third*ss*rho_inv
1445 0 : dfxdn = dfxdss*dssdn
1446 0 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
1447 : ! The new definition (v3.3) includes the division by the norm of the gradient
1448 0 : dssdg =two*coeffss
1449 0 : dfxdg=dfxdss*dssdg
1450 0 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
1451 0 : exc=exc+ex_gga*rho
1452 : ! This is the Wu and Cohen modification
1453 : else
1454 0 : expss=exp(-ss)
1455 0 : p1_wc=b_wc+(mu-b_wc)*(one-ss)*expss+two*c_wc*ss/(one+c_wc*ss*ss)
1456 : p2_wc=d_wc*(ss-two)*expss+two*c_wc/(one+c_wc*ss*ss)-&
1457 0 : & four*c_wc*c_wc*ss*ss/((one+c_wc*ss*ss)*(one+c_wc*ss*ss))
1458 0 : divss=one/(one+(b_wc*ss+d_wc*ss*expss+log(one+c_wc*ss*ss))/kappa)
1459 0 : dfxdss=p1_wc*divss*divss
1460 0 : d2fxdss2=p2_wc*divss*divss-two*divss*divss*divss*p1_wc*p1_wc/kappa
1461 :
1462 0 : fx = one+kappa*(one-divss)
1463 0 : ex_gga= ex_lsd*fx
1464 0 : dssdn=-eight*third*ss*rho_inv
1465 0 : dfxdn = dfxdss*dssdn
1466 0 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
1467 : ! The new definition (v3.3) includes the division by the norm of the gradient
1468 0 : dssdg =two*coeffss
1469 0 : dfxdg=dfxdss*dssdg
1470 0 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
1471 0 : exc=exc+ex_gga*rho
1472 : end if
1473 :
1474 : ! Perdew-Burke-Ernzerhof GGA, exchange part
1475 : ! Components 3 or 4
1476 0 : dvxci(ipts,2+ispden)=dvxcdgr(ipts,ispden)
1477 : ! Components 1 or 2
1478 0 : d2ssdn2=-11.0_dp*third*dssdn*rho_inv
1479 0 : d2fxdn2=d2fxdss2*dssdn**2+dfxdss*d2ssdn2
1480 : dvxci(ipts,ispden)=third*rho_inv*vxci(ipts,ispden)+&
1481 0 : & ex_lsd*(seven*third*dfxdn+rho*d2fxdn2)
1482 : ! Components 5 or 6
1483 0 : d2ssdndg=-eight*third*dssdg*rho_inv
1484 0 : d2fxdndg=d2fxdss2*dssdn*dssdg+dfxdss*d2ssdndg
1485 0 : dvxci(ipts,4+ispden)=ex_lsd*(four_thirds*dfxdg+rho*d2fxdndg)
1486 : ! Components 7 or 8
1487 0 : d2fxdg2=d2fxdss2*dssdg**2
1488 0 : dvxci(ipts,6+ispden)=ex_lsd*rho*d2fxdg2
1489 : ! For the time being, treat non-spin-polarized like spin-polarized
1490 0 : dvxci(ipts,2)=dvxci(ipts,1)
1491 0 : dvxci(ipts,4)=dvxci(ipts,3)
1492 0 : dvxci(ipts,6)=dvxci(ipts,5)
1493 0 : dvxci(ipts,8)=dvxci(ipts,7)
1494 :
1495 : ! end of loop over the spin
1496 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
1497 0 : exc=exc*2
1498 0 : exci(ipts)=exc*rhotot_inv
1499 : ! -----------------------------------------------------------------------------
1500 : ! Then takes care of the LSD correlation part of the functional
1501 :
1502 :
1503 0 : rs=rsfac*rhotmot
1504 0 : sqr_rs=sq_rsfac*rhotmo6
1505 0 : rsm1_2=sq_rsfac_inv*rhoto6
1506 :
1507 : ! Formulas A6-A8 of PW92LSD
1508 0 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
1509 0 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs)
1510 0 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+4._dp*ec0_b4*rs)
1511 0 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
1512 : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
1513 0 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
1514 0 : ecrs0=ec0_q0*ec0_log
1515 0 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
1516 0 : ec0_q1pp=0.5_dp*ec0_aa*(-ec0_b1*rsm1_2**3+3._dp*ec0_b3*rsm1_2+8._dp*ec0_b4)
1517 : d2ecrs0_drs2= 4.0_dp*ec0_aa*ec0_a1*ec0_q1p*ec0_den &
1518 : & -ec0_q0*ec0_q1pp*ec0_den &
1519 0 : & +ec0_q0*ec0_q1p**2*ec0_den**2*(2._dp*ec0_q1+1.0_dp)
1520 0 : ec0_q1ppp = 0.75_dp*ec0_aa*(rsm1_2**5)*(ec0_b1-ec0_b3*rs)
1521 0 : ec0_f1 = 1._dp/(ec0_q1*ec0_q1*(1._dp + ec0_q1))
1522 0 : ec0_f2 = 1._dp/(ec0_q1*(1+ec0_q1))
1523 : d3ecrs0_drs3 = 6._dp*ec0_q1p*ec0_f1*(-2._dp*ec0_aa*ec0_a1*ec0_q1p + &
1524 : & ec0_q0*ec0_q1pp) - &
1525 : & ec0_f2*(-6._dp*ec0_aa*ec0_a1*ec0_q1pp + ec0_q0*ec0_q1ppp + &
1526 : & ec0_f2*(3._dp*ec0_q1p*(-2._dp*ec0_aa*ec0_a1*ec0_q1p + ec0_q0*ec0_q1pp) + &
1527 0 : & ec0_f2*2._dp*ec0_q0*(ec0_q1p**3)*(1._dp + 3._dp*ec0_q1*(1._dp + ec0_q1))))
1528 :
1529 0 : mac_q0=-2.0_dp*mac_aa*(1.0_dp+mac_a1*rs)
1530 0 : mac_q1=2.0_dp*mac_aa*(mac_b1*sqr_rs+mac_b2*rs+mac_b3*rs*sqr_rs+mac_b4*rs*rs)
1531 0 : mac_q1p=mac_aa*(mac_b1*rsm1_2+2._dp*mac_b2+3._dp*mac_b3*sqr_rs+4._dp*mac_b4*rs)
1532 0 : mac_den=1.0_dp/(mac_q1*mac_q1+mac_q1)
1533 0 : mac_log=-log( mac_q1*mac_q1*mac_den )
1534 0 : macrs=mac_q0*mac_log
1535 0 : dmacrs_drs= -2.0_dp*mac_aa*mac_a1*mac_log - mac_q0*mac_q1p*mac_den
1536 :
1537 0 : ecrs=ecrs0
1538 0 : decrs_drs=decrs0_drs
1539 0 : decrs_dzeta=0.0_dp
1540 0 : d2ecrs_drs2=d2ecrs0_drs2
1541 0 : d2ecrs_dzeta2=alpha_zeta**2*(-macrs)
1542 0 : d2ecrs_drsdzeta=zero
1543 0 : zeta=0.0_dp
1544 :
1545 :
1546 : ! Add LSD correlation functional to GGA exchange functional
1547 0 : exci(ipts)=exci(ipts)+ecrs
1548 0 : vxci(ipts,1)=vxci(ipts,1)+ecrs-rs*third*decrs_drs
1549 :
1550 0 : dvcrs_drs=third*(2._dp*decrs_drs-rs*d2ecrs_drs2)
1551 : ! And d(vxc)/d(rho)=(-rs/(3*rho))*d(vxc)/d(rs)
1552 0 : d2ecrs_drho2= -rs**4*(four_pi*third)*third*dvcrs_drs
1553 0 : dvxci(ipts,9)=d2ecrs_drho2
1554 0 : dvxci(ipts,10)=d2ecrs_drho2
1555 0 : dvxci(ipts,11)=d2ecrs_drho2
1556 :
1557 : ! -----------------------------------------------------------------------------
1558 : ! Eventually add the GGA correlation part of the PBE functional
1559 : ! Note : the computation of the potential in the spin-unpolarized
1560 : ! case could be optimized much further. Other optimizations are left to do.
1561 :
1562 0 : phi_zeta=1.0_dp
1563 0 : phip_zeta=0.0_dp
1564 0 : phi_zeta_inv=1.0_dp
1565 0 : phi_logder=0.0_dp
1566 0 : phi3_zeta=1.0_dp
1567 0 : gamphi3inv=gamma_inv
1568 0 : phipp_zeta=-two*ninth*alpha_zeta*alpha_zeta
1569 :
1570 : ! From ec to bb
1571 0 : bb=ecrs*gamphi3inv
1572 0 : dbb_drs=decrs_drs*gamphi3inv
1573 0 : dbb_dzeta=gamphi3inv*(decrs_dzeta-three*ecrs*phi_logder)
1574 0 : d2bb_drs2=d2ecrs_drs2*gamphi3inv
1575 0 : d2bb_drsdzeta=gamphi3inv*(d2ecrs_drsdzeta-three*decrs_drs*phi_logder)
1576 : d2bb_dzeta2=gamphi3inv*(d2ecrs_dzeta2-six*decrs_dzeta*phi_logder+&
1577 0 : & 12.0_dp*ecrs*phi_logder*phi_logder-three*ecrs*phi_zeta_inv*phipp_zeta)
1578 :
1579 : ! From bb to cc
1580 0 : exp_pbe=exp(-bb)
1581 0 : cc=one/(exp_pbe-one)
1582 0 : dcc_dbb=cc*cc*exp_pbe
1583 0 : dcc_drs=dcc_dbb*dbb_drs
1584 0 : dcc_dzeta=dcc_dbb*dbb_dzeta
1585 0 : d2cc_dbb2=cc*cc*exp_pbe*(two*cc*exp_pbe-one)
1586 0 : d2cc_drs2=d2cc_dbb2*dbb_drs*dbb_drs+dcc_dbb*d2bb_drs2
1587 0 : d2cc_drsdzeta=d2cc_dbb2*dbb_drs*dbb_dzeta+dcc_dbb*d2bb_drsdzeta
1588 0 : d2cc_dzeta2=d2cc_dbb2*dbb_dzeta*dbb_dzeta+dcc_dbb*d2bb_dzeta2
1589 :
1590 : ! From cc to aa
1591 0 : coeff_aa=beta*gamma_inv*phi_zeta_inv*phi_zeta_inv
1592 0 : aa=coeff_aa*cc
1593 0 : daa_drs=coeff_aa*dcc_drs
1594 0 : daa_dzeta=-two*aa*phi_logder+coeff_aa*dcc_dzeta
1595 0 : d2aa_drs2=coeff_aa*d2cc_drs2
1596 0 : d2aa_drsdzeta=-two*daa_drs*phi_logder+coeff_aa*d2cc_drsdzeta
1597 : d2aa_dzeta2=aa*(-two*phi_zeta_inv*phipp_zeta+six*phi_logder*phi_logder)+&
1598 0 : & coeff_aa*(-four*dcc_dzeta*phi_logder+d2cc_dzeta2)
1599 :
1600 : ! Introduce tt : do not assume that the spin-dependent gradients are collinear
1601 0 : grrho2=four*grho2_updn(ipts,1)
1602 0 : dtt_dg=two*rhotot_inv*rhotot_inv*rhotmot*coeff_tt
1603 : ! Note that tt is (the t variable of PBE divided by phi) squared
1604 0 : tt=half*grrho2*dtt_dg
1605 :
1606 : ! Get xx from aa and tt
1607 0 : xx=aa*tt
1608 0 : dxx_drs=daa_drs*tt
1609 0 : dxx_dzeta=daa_dzeta*tt
1610 0 : dxx_dtt=aa
1611 0 : d2xx_drs2=d2aa_drs2*tt
1612 0 : d2xx_drsdzeta=d2aa_drsdzeta*tt
1613 0 : d2xx_drsdtt=daa_drs
1614 0 : d2xx_dttdzeta=daa_dzeta
1615 0 : d2xx_dzeta2=d2aa_dzeta2*tt
1616 :
1617 : ! From xx to pade
1618 0 : pade_den=one/(one+xx*(one+xx))
1619 0 : pade=(one+xx)*pade_den
1620 0 : dpade_dxx=-xx*(two+xx)*pade_den**2
1621 0 : dpade_drs=dpade_dxx*dxx_drs
1622 0 : dpade_dtt=dpade_dxx*dxx_dtt
1623 0 : dpade_dzeta=dpade_dxx*dxx_dzeta
1624 0 : d2pade_dxx2=two*(-one+xx*xx*(three+xx))*pade_den*pade_den*pade_den
1625 0 : d2pade_drs2=d2pade_dxx2*dxx_drs*dxx_drs+dpade_dxx*d2xx_drs2
1626 0 : d2pade_drsdtt=d2pade_dxx2*dxx_drs*dxx_dtt+dpade_dxx*d2xx_drsdtt
1627 0 : d2pade_drsdzeta=d2pade_dxx2*dxx_drs*dxx_dzeta+dpade_dxx*d2xx_drsdzeta
1628 0 : d2pade_dtt2=d2pade_dxx2*dxx_dtt*dxx_dtt
1629 0 : d2pade_dttdzeta=d2pade_dxx2*dxx_dtt*dxx_dzeta+dpade_dxx*d2xx_dttdzeta
1630 0 : d2pade_dzeta2=d2pade_dxx2*dxx_dzeta*dxx_dzeta+dpade_dxx*d2xx_dzeta2
1631 :
1632 : ! From pade to qq
1633 0 : coeff_qq=tt*phi_zeta_inv*phi_zeta_inv
1634 0 : qq=coeff_qq*pade
1635 0 : dqq_drs=coeff_qq*dpade_drs
1636 0 : dqq_dtt=pade*phi_zeta_inv*phi_zeta_inv+coeff_qq*dpade_dtt
1637 0 : dqq_dzeta=coeff_qq*(dpade_dzeta-two*pade*phi_logder)
1638 0 : d2qq_drs2=coeff_qq*d2pade_drs2
1639 0 : d2qq_drsdtt=phi_zeta_inv*phi_zeta_inv*(dpade_drs+tt*d2pade_drsdtt)
1640 0 : d2qq_drsdzeta=coeff_qq*(d2pade_drsdzeta-two*dpade_drs*phi_logder)
1641 0 : d2qq_dtt2=phi_zeta_inv*phi_zeta_inv*(two*dpade_dtt+tt*d2pade_dtt2)
1642 : d2qq_dttdzeta=phi_zeta_inv*phi_zeta_inv*(dpade_dzeta-two*pade*phi_logder)+&
1643 0 : & coeff_qq*(d2pade_dttdzeta-two*dpade_dtt*phi_logder)
1644 : d2qq_dzeta2=coeff_qq*( d2pade_dzeta2-four*dpade_dzeta*phi_logder &
1645 : & +six*pade*phi_logder*phi_logder &
1646 0 : & -two*pade*phi_zeta_inv*phipp_zeta)
1647 :
1648 : ! From qq to rr
1649 0 : arg_rr=one+beta*gamma_inv*qq
1650 0 : div_rr=one/arg_rr
1651 0 : rr=gamma*log(arg_rr)
1652 0 : drr_dqq=beta*div_rr
1653 0 : drr_drs=drr_dqq*dqq_drs
1654 0 : drr_dtt=drr_dqq*dqq_dtt
1655 0 : drr_dzeta=drr_dqq*dqq_dzeta
1656 0 : d2rr_dqq2=-div_rr**2*beta*beta*gamma_inv
1657 0 : d2rr_drs2=d2rr_dqq2*dqq_drs*dqq_drs+drr_dqq*d2qq_drs2
1658 0 : d2rr_drsdtt=d2rr_dqq2*dqq_drs*dqq_dtt+drr_dqq*d2qq_drsdtt
1659 0 : d2rr_drsdzeta=d2rr_dqq2*dqq_drs*dqq_dzeta+drr_dqq*d2qq_drsdzeta
1660 0 : d2rr_dtt2=d2rr_dqq2*dqq_dtt*dqq_dtt+drr_dqq*d2qq_dtt2
1661 0 : d2rr_dttdzeta=d2rr_dqq2*dqq_dtt*dqq_dzeta+drr_dqq*d2qq_dttdzeta
1662 0 : d2rr_dzeta2=d2rr_dqq2*dqq_dzeta*dqq_dzeta+drr_dqq*d2qq_dzeta2
1663 :
1664 : ! From rr to hh
1665 0 : hh=phi3_zeta*rr
1666 0 : dhh_drs=phi3_zeta*drr_drs
1667 0 : dhh_dtt=phi3_zeta*drr_dtt
1668 0 : dhh_dzeta=phi3_zeta*(drr_dzeta+three*rr*phi_logder)
1669 0 : d2hh_drs2=phi3_zeta*d2rr_drs2
1670 0 : d2hh_drsdtt=phi3_zeta*d2rr_drsdtt
1671 0 : d2hh_drsdzeta=phi3_zeta*(d2rr_drsdzeta+three*drr_drs*phi_logder)
1672 0 : d2hh_dtt2=phi3_zeta*d2rr_dtt2
1673 0 : d2hh_dttdzeta=phi3_zeta*(d2rr_dttdzeta+three*drr_dtt*phi_logder)
1674 : d2hh_dzeta2=phi3_zeta*(six*rr*phi_logder*phi_logder+&
1675 : & six*phi_logder*drr_dzeta+d2rr_dzeta2) &
1676 0 : & +three*phi_zeta*phi_zeta*rr*phipp_zeta
1677 :
1678 :
1679 : ! The GGA correlation energy is added
1680 0 : exci(ipts)=exci(ipts)+hh
1681 :
1682 : ! Change of variables : from (rs,zeta,tt) to (rhoup,rhodn,grrho)
1683 :
1684 : ! From hh to the derivative of the energy wrt the density
1685 0 : drhohh_drho=hh-third*rs*dhh_drs-zeta*dhh_dzeta-seven*third*tt*dhh_dtt
1686 0 : vxci(ipts,1)=vxci(ipts,1)+drhohh_drho
1687 :
1688 : ! From hh to the derivative of the energy wrt to the gradient of the
1689 : ! density, divided by the gradient of the density
1690 : ! (The v3.3 definition includes the division by the norm of the gradient)
1691 0 : dvxcdgr(ipts,3)=rhotot*dtt_dg*dhh_dtt
1692 :
1693 : d2rhohh_drho2=rhotot_inv*&
1694 : & (-two*ninth*rs*dhh_drs +seven*four*ninth*tt*dhh_dtt &
1695 : & +ninth*rs*rs*d2hh_drs2+zeta*zeta*d2hh_dzeta2+(seven*third*tt)**2*d2hh_dtt2 &
1696 : & +two*third*rs*zeta*d2hh_drsdzeta+two*seven*ninth*rs*tt*d2hh_drsdtt &
1697 0 : & +two*seven*third*tt*zeta*d2hh_dttdzeta)
1698 : d2rhohh_drhodg=dtt_dg*(-four*third*dhh_dtt-third*rs*d2hh_drsdtt &
1699 0 : & -zeta*d2hh_dttdzeta-seven*third*tt*d2hh_dtt2)
1700 :
1701 : ! Component 12 : first derivative with respect to the gradient
1702 : ! of the density, div by the grad of the density
1703 0 : dvxci(ipts,12)=dvxcdgr(ipts,3)
1704 : ! Components 9, 10 and 11 : second derivatives with respect to the spin-density
1705 : ! Note that there is already a contribution from LSDA
1706 : dvxci(ipts,9)=dvxci(ipts,9)+d2rhohh_drho2+rhotot_inv* &
1707 : & ( d2hh_dzeta2*(one-two*zeta) &
1708 0 : & -two*third*rs*d2hh_drsdzeta-14.0_dp*third*tt*d2hh_dttdzeta)
1709 0 : dvxci(ipts,10)=dvxci(ipts,10)+d2rhohh_drho2-rhotot_inv*d2hh_dzeta2
1710 : dvxci(ipts,11)=dvxci(ipts,11)+d2rhohh_drho2+rhotot_inv* &
1711 : & ( d2hh_dzeta2*(one+two*zeta) &
1712 0 : & +two*third*rs*d2hh_drsdzeta+14.0_dp*third*tt*d2hh_dttdzeta)
1713 : ! Components 13 and 14 : second derivatives with respect to spin density
1714 : ! and gradient, divided by the gradient
1715 0 : dvxci(ipts,13)=d2rhohh_drhodg+dtt_dg*d2hh_dttdzeta
1716 0 : dvxci(ipts,14)=d2rhohh_drhodg-dtt_dg*d2hh_dttdzeta
1717 : ! Component 15 : derivative of the (derivative wrt the gradient div by the grad),
1718 : ! divided by the grad
1719 0 : dvxci(ipts,15)=rhotot*d2hh_dtt2*dtt_dg*dtt_dg
1720 :
1721 :
1722 : ! End condition of GGA
1723 :
1724 :
1725 : ! Correlation has been added
1726 : ! -----------------------------------------------------------------------------
1727 :
1728 : ! vxci(ipts,2)=vxci(ipts,1)
1729 0 : dvxcdgr(ipts,2)=dvxcdgr(ipts,1)
1730 : end do
1731 :
1732 : else if (option==-1) then
1733 :
1734 0 : do ipts=1,npts
1735 :
1736 0 : rhotot=rhoarr(ipts)
1737 0 : rhotmot=rhom1_3(ipts)
1738 0 : rhotot_inv=rhotmot*rhotmot*rhotmot
1739 0 : rhotmo6=sqrt(rhotmot)
1740 0 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
1741 : ! -----------------------------------------------------------------------
1742 : ! First take care of the exchange part of the functional
1743 :
1744 0 : exc=zero
1745 : ! loop over the spin
1746 0 : ispden=1
1747 0 : rho =rho_updn(ipts,ispden)
1748 0 : rhomot=rho_updnm1_3(ipts,ispden)
1749 0 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
1750 : ! Perdew_Wang 91 LSD
1751 0 : vxci(ipts,ispden)=four_thirds*ex_lsd
1752 0 : exc=exc+ex_lsd*rho
1753 : ! Perdew_Wang 91 LSD
1754 : dvxci(ipts,2*ispden-1)=-four_thirds*third*&
1755 0 : & threefourth_divpi*sixpi2_1_3*rhomot*rhomot
1756 0 : dvxci(ipts,2)=zero
1757 : ! If non-spin-polarized, first component of dvxci is second
1758 : ! derivative with respect to TOTAL density.
1759 0 : dvxci(ipts,1)=dvxci(ipts,1)*half
1760 : if(order==3)then
1761 : ! Compute the second derivative of vx
1762 : ! vx^(2) = -2*vx^(1)/(3*rhotot)
1763 0 : d2vxci(ipts,1) = -2._dp*dvxci(ipts,1)/(3._dp*rhotot)
1764 : end if
1765 : ! end of loop over the spin
1766 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
1767 0 : exc=exc*2
1768 0 : exci(ipts)=exc*rhotot_inv
1769 : ! -----------------------------------------------------------------------------
1770 : ! Then takes care of the LSD correlation part of the functional
1771 :
1772 : ! Correlation has been added
1773 : ! -----------------------------------------------------------------------------
1774 :
1775 : end do
1776 : else if (option==-2) then
1777 :
1778 0 : do ipts=1,npts
1779 :
1780 0 : rhotot=rhoarr(ipts)
1781 0 : rhotmot=rhom1_3(ipts)
1782 0 : rhotot_inv=rhotmot*rhotmot*rhotmot
1783 0 : rhotmo6=sqrt(rhotmot)
1784 0 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
1785 : ! -----------------------------------------------------------------------
1786 : ! First take care of the exchange part of the functional
1787 :
1788 0 : exc=zero
1789 0 : dvxcdgr(ipts,3)=zero
1790 : ! loop over the spin
1791 0 : ispden=1
1792 0 : rho =rho_updn(ipts,ispden)
1793 0 : rhomot=rho_updnm1_3(ipts,ispden)
1794 0 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
1795 : ! Perdew-Burke-Ernzerhof GGA, exchange part
1796 0 : rho_inv=rhomot*rhomot*rhomot
1797 0 : coeffss=quarter*sixpi2m1_3*sixpi2m1_3*rho_inv*rho_inv*rhomot*rhomot
1798 0 : ss=grho2_updn(ipts,ispden)*coeffss
1799 0 : divss=one/(one+mu_divkappa*ss)
1800 0 : dfxdss= mu*divss*divss
1801 0 : d2fxdss2=-mu*two*mu_divkappa*divss*divss*divss
1802 0 : fx = one+kappa*(one-divss)
1803 0 : ex_gga= ex_lsd*fx
1804 0 : dssdn=-eight*third*ss*rho_inv
1805 0 : dfxdn = dfxdss*dssdn
1806 0 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
1807 : ! The new definition (v3.3) includes the division by the norm of the gradient
1808 0 : dssdg =two*coeffss
1809 0 : dfxdg=dfxdss*dssdg
1810 0 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
1811 0 : exc=exc+ex_gga*rho
1812 :
1813 : ! Perdew-Burke-Ernzerhof GGA, exchange part
1814 : ! Components 3 or 4
1815 0 : dvxci(ipts,2+ispden)=dvxcdgr(ipts,ispden)
1816 : ! Components 1 or 2
1817 0 : d2ssdn2=-11.0_dp*third*dssdn*rho_inv
1818 0 : d2fxdn2=d2fxdss2*dssdn**2+dfxdss*d2ssdn2
1819 : dvxci(ipts,ispden)=third*rho_inv*vxci(ipts,ispden)+&
1820 0 : & ex_lsd*(seven*third*dfxdn+rho*d2fxdn2)
1821 : ! Components 5 or 6
1822 0 : d2ssdndg=-eight*third*dssdg*rho_inv
1823 0 : d2fxdndg=d2fxdss2*dssdn*dssdg+dfxdss*d2ssdndg
1824 0 : dvxci(ipts,4+ispden)=ex_lsd*(four_thirds*dfxdg+rho*d2fxdndg)
1825 : ! Components 7 or 8
1826 0 : d2fxdg2=d2fxdss2*dssdg**2
1827 0 : dvxci(ipts,6+ispden)=ex_lsd*rho*d2fxdg2
1828 : ! For the time being, treat non-spin-polarized like spin-polarized
1829 0 : dvxci(ipts,2)=dvxci(ipts,1)
1830 0 : dvxci(ipts,4)=dvxci(ipts,3)
1831 0 : dvxci(ipts,6)=dvxci(ipts,5)
1832 0 : dvxci(ipts,8)=dvxci(ipts,7)
1833 :
1834 : ! end of loop over the spin
1835 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
1836 0 : exc=exc*2
1837 0 : exci(ipts)=exc*rhotot_inv
1838 : ! -----------------------------------------------------------------------------
1839 : ! Then takes care of the LSD correlation part of the functional
1840 :
1841 : ! Correlation has been added
1842 : ! -----------------------------------------------------------------------------
1843 :
1844 : ! vxci(ipts,2)=vxci(ipts,1)
1845 0 : dvxcdgr(ipts,2)=dvxcdgr(ipts,1)
1846 :
1847 : end do
1848 :
1849 :
1850 : else if(option==-4) then
1851 :
1852 :
1853 0 : do ipts=1,npts
1854 :
1855 0 : rhotot=rhoarr(ipts)
1856 0 : rhotmot=rhom1_3(ipts)
1857 0 : rhotot_inv=rhotmot*rhotmot*rhotmot
1858 0 : rhotmo6=sqrt(rhotmot)
1859 0 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
1860 : ! -----------------------------------------------------------------------
1861 : ! First take care of the exchange part of the functional
1862 :
1863 0 : exc=zero
1864 0 : dvxcdgr(ipts,3)=zero
1865 : ! loop over the spin
1866 0 : ispden=1
1867 0 : rho =rho_updn(ipts,ispden)
1868 0 : rhomot=rho_updnm1_3(ipts,ispden)
1869 0 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
1870 : ! VALENTINO R. COOPER C09x GGA, This is an exchange term proposed
1871 : ! to use together with vdw-DF (see above).
1872 0 : rho_inv=rhomot*rhomot*rhomot
1873 0 : coeffss=quarter*sixpi2m1_3*sixpi2m1_3*rho_inv*rho_inv*rhomot*rhomot
1874 : ! the quarter that is lacking is compensated by the grho2_updn in the
1875 : ! next line.
1876 0 : ss=grho2_updn(ipts,ispden)*coeffss
1877 0 : alphs2=alpha_c09*ss
1878 0 : alphmu=alpha_c09*mu_c09
1879 : dfxdss= mu_c09*exp(-alphs2)*(one-alphs2)+&
1880 0 : & kappa*alpha_c09*exp(-alphs2/two)/two
1881 : d2fxdss2=-alphmu*exp(-alphs2)*(two-alphs2)-&
1882 0 : & kappa*(alpha_c09**two)*exp(alphs2/two)/four
1883 0 : fx = one+mu_c09*ss*exp(-alphs2)+kappa*(one-exp(-alphs2/two))
1884 0 : ex_gga= ex_lsd*fx
1885 0 : dssdn=-eight*third*ss*rho_inv
1886 0 : dfxdn = dfxdss*dssdn
1887 0 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
1888 : ! The new definition (v3.3) includes the division by the norm of the gradient
1889 0 : dssdg =two*coeffss
1890 0 : dfxdg=dfxdss*dssdg
1891 0 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
1892 0 : exc=exc+ex_gga*rho
1893 :
1894 : ! Cooper C09x GGA exchange
1895 : ! Components 3 or 4
1896 0 : dvxci(ipts,2+ispden)=dvxcdgr(ipts,ispden)
1897 : ! Components 1 or 2
1898 0 : d2ssdn2=-11.0_dp*third*dssdn*rho_inv
1899 0 : d2fxdn2=d2fxdss2*dssdn**2+dfxdss*d2ssdn2
1900 : dvxci(ipts,ispden)=third*rho_inv*vxci(ipts,ispden)+&
1901 0 : & ex_lsd*(seven*third*dfxdn+rho*d2fxdn2)
1902 : ! Components 5 or 6
1903 0 : d2ssdndg=-eight*third*dssdg*rho_inv
1904 0 : d2fxdndg=d2fxdss2*dssdn*dssdg+dfxdss*d2ssdndg
1905 0 : dvxci(ipts,4+ispden)=ex_lsd*(four_thirds*dfxdg+rho*d2fxdndg)
1906 : ! Components 7 or 8
1907 0 : d2fxdg2=d2fxdss2*dssdg**2
1908 0 : dvxci(ipts,6+ispden)=ex_lsd*rho*d2fxdg2
1909 : ! For the time being, treat non-spin-polarized like spin-polarized
1910 0 : dvxci(ipts,2)=dvxci(ipts,1)
1911 0 : dvxci(ipts,4)=dvxci(ipts,3)
1912 0 : dvxci(ipts,6)=dvxci(ipts,5)
1913 0 : dvxci(ipts,8)=dvxci(ipts,7)
1914 :
1915 : ! end of loop over the spin
1916 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
1917 0 : exc=exc*2
1918 0 : exci(ipts)=exc*rhotot_inv
1919 : ! -----------------------------------------------------------------------------
1920 : ! Then takes care of the LSD correlation part of the functional
1921 :
1922 : ! Correlation has been added
1923 : ! -----------------------------------------------------------------------------
1924 :
1925 : ! vxci(ipts,2)=vxci(ipts,1)
1926 0 : dvxcdgr(ipts,2)=dvxcdgr(ipts,1)
1927 :
1928 : end do
1929 :
1930 :
1931 : else if(option==1) then
1932 :
1933 781853 : do ipts=1,npts
1934 :
1935 :
1936 781224 : rhotot=rhoarr(ipts)
1937 781224 : rhotmot=rhom1_3(ipts)
1938 781224 : rhotot_inv=rhotmot*rhotmot*rhotmot
1939 781224 : rhotmo6=sqrt(rhotmot)
1940 781224 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
1941 : ! -----------------------------------------------------------------------
1942 : ! First take care of the exchange part of the functional
1943 :
1944 781224 : exc=zero
1945 : ! loop over the spin
1946 781224 : ispden=1
1947 781224 : rho =rho_updn(ipts,ispden)
1948 781224 : rhomot=rho_updnm1_3(ipts,ispden)
1949 781224 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
1950 : ! Perdew_Wang 91 LSD
1951 781224 : vxci(ipts,ispden)=four_thirds*ex_lsd
1952 781224 : exc=exc+ex_lsd*rho
1953 :
1954 : ! Perdew_Wang 91 LSD
1955 : dvxci(ipts,2*ispden-1)=-four_thirds*third*&
1956 781224 : & threefourth_divpi*sixpi2_1_3*rhomot*rhomot
1957 781224 : dvxci(ipts,2)=zero
1958 : ! If non-spin-polarized, first component of dvxci is second
1959 : ! derivative with respect to TOTAL density.
1960 781224 : dvxci(ipts,1)=dvxci(ipts,1)*half
1961 : if(order==3)then
1962 : ! Compute the second derivative of vx
1963 : ! vx^(2) = -2*vx^(1)/(3*rhotot)
1964 781224 : d2vxci(ipts,1) = -2._dp*dvxci(ipts,1)/(3._dp*rhotot)
1965 : end if
1966 : ! end of loop over the spin
1967 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
1968 781224 : exc=exc*2
1969 781224 : exci(ipts)=exc*rhotot_inv
1970 : ! -----------------------------------------------------------------------------
1971 : ! Then takes care of the LSD correlation part of the functional
1972 :
1973 781224 : rs=rsfac*rhotmot
1974 781224 : sqr_rs=sq_rsfac*rhotmo6
1975 781224 : rsm1_2=sq_rsfac_inv*rhoto6
1976 :
1977 : ! Formulas A6-A8 of PW92LSD
1978 781224 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
1979 781224 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs)
1980 781224 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+4._dp*ec0_b4*rs)
1981 781224 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
1982 : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
1983 781224 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
1984 781224 : ecrs0=ec0_q0*ec0_log
1985 781224 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
1986 781224 : ec0_q1pp=0.5_dp*ec0_aa*(-ec0_b1*rsm1_2**3+3._dp*ec0_b3*rsm1_2+8._dp*ec0_b4)
1987 : d2ecrs0_drs2= 4.0_dp*ec0_aa*ec0_a1*ec0_q1p*ec0_den &
1988 : & -ec0_q0*ec0_q1pp*ec0_den &
1989 781224 : & +ec0_q0*ec0_q1p**2*ec0_den**2*(2._dp*ec0_q1+1.0_dp)
1990 781224 : ec0_q1ppp = 0.75_dp*ec0_aa*(rsm1_2**5)*(ec0_b1-ec0_b3*rs)
1991 781224 : ec0_f1 = 1._dp/(ec0_q1*ec0_q1*(1._dp + ec0_q1))
1992 781224 : ec0_f2 = 1._dp/(ec0_q1*(1+ec0_q1))
1993 : d3ecrs0_drs3 = 6._dp*ec0_q1p*ec0_f1*(-2._dp*ec0_aa*ec0_a1*ec0_q1p + &
1994 : & ec0_q0*ec0_q1pp) - &
1995 : & ec0_f2*(-6._dp*ec0_aa*ec0_a1*ec0_q1pp + ec0_q0*ec0_q1ppp + &
1996 : & ec0_f2*(3._dp*ec0_q1p*(-2._dp*ec0_aa*ec0_a1*ec0_q1p + ec0_q0*ec0_q1pp) + &
1997 781224 : & ec0_f2*2._dp*ec0_q0*(ec0_q1p**3)*(1._dp + 3._dp*ec0_q1*(1._dp + ec0_q1))))
1998 :
1999 781224 : mac_q0=-2.0_dp*mac_aa*(1.0_dp+mac_a1*rs)
2000 781224 : mac_q1=2.0_dp*mac_aa*(mac_b1*sqr_rs+mac_b2*rs+mac_b3*rs*sqr_rs+mac_b4*rs*rs)
2001 781224 : mac_q1p=mac_aa*(mac_b1*rsm1_2+2._dp*mac_b2+3._dp*mac_b3*sqr_rs+4._dp*mac_b4*rs)
2002 781224 : mac_den=1.0_dp/(mac_q1*mac_q1+mac_q1)
2003 781224 : mac_log=-log( mac_q1*mac_q1*mac_den )
2004 781224 : macrs=mac_q0*mac_log
2005 781224 : dmacrs_drs= -2.0_dp*mac_aa*mac_a1*mac_log - mac_q0*mac_q1p*mac_den
2006 :
2007 781224 : ecrs=ecrs0
2008 781224 : decrs_drs=decrs0_drs
2009 781224 : decrs_dzeta=0.0_dp
2010 781224 : d2ecrs_drs2=d2ecrs0_drs2
2011 781224 : d2ecrs_dzeta2=alpha_zeta**2*(-macrs)
2012 781224 : d2ecrs_drsdzeta=zero
2013 781224 : zeta=0.0_dp
2014 :
2015 :
2016 : ! Add LSD correlation functional to GGA exchange functional
2017 781224 : exci(ipts)=exci(ipts)+ecrs
2018 781224 : vxci(ipts,1)=vxci(ipts,1)+ecrs-rs*third*decrs_drs
2019 :
2020 781224 : dvcrs_drs=third*(2._dp*decrs_drs-rs*d2ecrs_drs2)
2021 : ! And d(vxc)/d(rho)=(-rs/(3*rho))*d(vxc)/d(rs)
2022 781224 : d2ecrs_drho2= -rs**4*(four_pi*third)*third*dvcrs_drs
2023 781224 : dvxci(ipts,1)=dvxci(ipts,1)+d2ecrs_drho2
2024 781224 : d2vcrs_drs2 = third*(d2ecrs_drs2 - rs*d3ecrs0_drs3)
2025 781224 : drs_dn = -1._dp*four_pi*ninth*rs**4
2026 781224 : d2rs_dn2 = 64._dp*pi*pi*(rs**7)/81._dp
2027 629 : if(order==3)then
2028 : d2vxci(ipts,1) = d2vxci(ipts,1) + d2vcrs_drs2*drs_dn*drs_dn + &
2029 781224 : & dvcrs_drs*d2rs_dn2
2030 :
2031 :
2032 :
2033 :
2034 :
2035 : end if
2036 :
2037 : ! -----------------------------------------------------------------------------
2038 : ! Eventually add the GGA correlation part of the PBE functional
2039 : ! Note : the computation of the potential in the spin-unpolarized
2040 : ! case could be optimized much further. Other optimizations are left to do.
2041 :
2042 :
2043 : ! Correlation has been added
2044 : ! -----------------------------------------------------------------------------
2045 : end do
2046 : else if (option==3) then
2047 :
2048 0 : do ipts=1,npts
2049 :
2050 0 : rhotot=rhoarr(ipts)
2051 0 : rhotmot=rhom1_3(ipts)
2052 0 : rhotot_inv=rhotmot*rhotmot*rhotmot
2053 0 : rhotmo6=sqrt(rhotmot)
2054 0 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
2055 : ! -----------------------------------------------------------------------
2056 : ! First take care of the exchange part of the functional
2057 :
2058 0 : exc=zero
2059 : ! loop over the spin
2060 0 : ispden=1
2061 0 : rho =rho_updn(ipts,ispden)
2062 0 : rhomot=rho_updnm1_3(ipts,ispden)
2063 0 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
2064 : ! Perdew_Wang 91 LSD
2065 0 : vxci(ipts,ispden)=four_thirds*ex_lsd
2066 0 : exc=exc+ex_lsd*rho
2067 :
2068 :
2069 : ! Perdew_Wang 91 LSD
2070 : dvxci(ipts,2*ispden-1)=-four_thirds*third*&
2071 0 : & threefourth_divpi*sixpi2_1_3*rhomot*rhomot
2072 0 : dvxci(ipts,2)=zero
2073 : ! If non-spin-polarized, first component of dvxci is second
2074 : ! derivative with respect to TOTAL density.
2075 0 : dvxci(ipts,1)=dvxci(ipts,1)*half
2076 : if(order==3)then
2077 : ! Compute the second derivative of vx
2078 : ! vx^(2) = -2*vx^(1)/(3*rhotot)
2079 0 : d2vxci(ipts,1) = -2._dp*dvxci(ipts,1)/(3._dp*rhotot)
2080 : end if
2081 : ! end of loop over the spin
2082 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
2083 0 : exc=exc*2
2084 0 : exci(ipts)=exc*rhotot_inv
2085 : ! -----------------------------------------------------------------------------
2086 : ! Then takes care of the LSD correlation part of the functional
2087 :
2088 0 : rs=rsfac*rhotmot
2089 0 : sqr_rs=sq_rsfac*rhotmo6
2090 0 : rsm1_2=sq_rsfac_inv*rhoto6
2091 :
2092 : ! Formulas A6-A8 of PW92LSD
2093 0 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
2094 0 : sqr_sqr_rs=max(1.e-15_dp,sqrt(sqr_rs))
2095 0 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs/sqr_sqr_rs)
2096 0 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+3.5_dp*ec0_b4*rs/sqr_sqr_rs)
2097 0 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
2098 : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
2099 0 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
2100 0 : ecrs0=ec0_q0*ec0_log
2101 0 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
2102 0 : ec0_q1pp=0.5_dp*ec0_aa*(-ec0_b1*rsm1_2**3+3._dp*ec0_b3*rsm1_2+8._dp*ec0_b4)
2103 : d2ecrs0_drs2= 4.0_dp*ec0_aa*ec0_a1*ec0_q1p*ec0_den &
2104 : & -ec0_q0*ec0_q1pp*ec0_den &
2105 0 : & +ec0_q0*ec0_q1p**2*ec0_den**2*(2._dp*ec0_q1+1.0_dp)
2106 0 : ec0_q1ppp = 0.75_dp*ec0_aa*(rsm1_2**5)*(ec0_b1-ec0_b3*rs)
2107 0 : ec0_f1 = 1._dp/(ec0_q1*ec0_q1*(1._dp + ec0_q1))
2108 0 : ec0_f2 = 1._dp/(ec0_q1*(1+ec0_q1))
2109 : d3ecrs0_drs3 = 6._dp*ec0_q1p*ec0_f1*(-2._dp*ec0_aa*ec0_a1*ec0_q1p + &
2110 : & ec0_q0*ec0_q1pp) - &
2111 : & ec0_f2*(-6._dp*ec0_aa*ec0_a1*ec0_q1pp + ec0_q0*ec0_q1ppp + &
2112 : & ec0_f2*(3._dp*ec0_q1p*(-2._dp*ec0_aa*ec0_a1*ec0_q1p + ec0_q0*ec0_q1pp) + &
2113 0 : & ec0_f2*2._dp*ec0_q0*(ec0_q1p**3)*(1._dp + 3._dp*ec0_q1*(1._dp + ec0_q1))))
2114 :
2115 0 : mac_q0=-2.0_dp*mac_aa*(1.0_dp+mac_a1*rs)
2116 0 : mac_q1=2.0_dp*mac_aa*(mac_b1*sqr_rs+mac_b2*rs+mac_b3*rs*sqr_rs+mac_b4*rs*rs)
2117 0 : mac_q1p=mac_aa*(mac_b1*rsm1_2+2._dp*mac_b2+3._dp*mac_b3*sqr_rs+4._dp*mac_b4*rs)
2118 0 : mac_den=1.0_dp/(mac_q1*mac_q1+mac_q1)
2119 0 : mac_log=-log( mac_q1*mac_q1*mac_den )
2120 0 : macrs=mac_q0*mac_log
2121 0 : dmacrs_drs= -2.0_dp*mac_aa*mac_a1*mac_log - mac_q0*mac_q1p*mac_den
2122 :
2123 0 : ecrs=ecrs0
2124 0 : decrs_drs=decrs0_drs
2125 0 : decrs_dzeta=0.0_dp
2126 0 : d2ecrs_drs2=d2ecrs0_drs2
2127 0 : d2ecrs_dzeta2=alpha_zeta**2*(-macrs)
2128 0 : d2ecrs_drsdzeta=zero
2129 0 : zeta=0.0_dp
2130 :
2131 :
2132 : ! Add LSD correlation functional to GGA exchange functional
2133 0 : exci(ipts)=exci(ipts)+ecrs
2134 0 : vxci(ipts,1)=vxci(ipts,1)+ecrs-rs*third*decrs_drs
2135 :
2136 0 : dvcrs_drs=third*(2._dp*decrs_drs-rs*d2ecrs_drs2)
2137 : ! And d(vxc)/d(rho)=(-rs/(3*rho))*d(vxc)/d(rs)
2138 0 : d2ecrs_drho2= -rs**4*(four_pi*third)*third*dvcrs_drs
2139 :
2140 0 : dvxci(ipts,1)=dvxci(ipts,1)+d2ecrs_drho2
2141 0 : d2vcrs_drs2 = third*(d2ecrs_drs2 - rs*d3ecrs0_drs3)
2142 0 : drs_dn = -1._dp*four_pi*ninth*rs**4
2143 0 : d2rs_dn2 = 64._dp*pi*pi*(rs**7)/81._dp
2144 0 : if(order==3)then
2145 : d2vxci(ipts,1) = d2vxci(ipts,1) + d2vcrs_drs2*drs_dn*drs_dn + &
2146 0 : & dvcrs_drs*d2rs_dn2
2147 :
2148 :
2149 :
2150 : end if
2151 :
2152 :
2153 : end do
2154 :
2155 : end if
2156 :
2157 29158 : else if(order==-2) then
2158 65 : if(option==2 .or. option==5) then
2159 0 : do ipts=1,npts
2160 :
2161 0 : rhotot=rhoarr(ipts)
2162 0 : rhotmot=rhom1_3(ipts)
2163 0 : rhotot_inv=rhotmot*rhotmot*rhotmot
2164 0 : rhotmo6=sqrt(rhotmot)
2165 0 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
2166 : ! -----------------------------------------------------------------------
2167 : ! First take care of the exchange part of the functional
2168 :
2169 0 : exc=zero
2170 0 : dvxcdgr(ipts,3)=zero
2171 : ! loop over the spin
2172 0 : ispden=1
2173 0 : rho =rho_updn(ipts,ispden)
2174 0 : rhomot=rho_updnm1_3(ipts,ispden)
2175 0 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
2176 : ! Perdew-Burke-Ernzerhof GGA, exchange part
2177 0 : rho_inv=rhomot*rhomot*rhomot
2178 0 : coeffss=quarter*sixpi2m1_3*sixpi2m1_3*rho_inv*rho_inv*rhomot*rhomot
2179 0 : ss=grho2_updn(ipts,ispden)*coeffss
2180 0 : divss=one/(one+mu_divkappa*ss)
2181 0 : dfxdss= mu*divss*divss
2182 0 : d2fxdss2=-mu*two*mu_divkappa*divss*divss*divss
2183 0 : fx = one+kappa*(one-divss)
2184 0 : ex_gga= ex_lsd*fx
2185 0 : dssdn=-eight*third*ss*rho_inv
2186 0 : dfxdn = dfxdss*dssdn
2187 0 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
2188 : ! The new definition (v3.3) includes the division by the norm of the gradient
2189 0 : dssdg =two*coeffss
2190 0 : dfxdg=dfxdss*dssdg
2191 0 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
2192 0 : exc=exc+ex_gga*rho
2193 :
2194 : ! Perdew-Burke-Ernzerhof GGA, exchange part
2195 : ! Components 3 or 4
2196 0 : dvxci(ipts,2+ispden)=dvxcdgr(ipts,ispden)
2197 : ! Components 1 or 2
2198 0 : d2ssdn2=-11.0_dp*third*dssdn*rho_inv
2199 0 : d2fxdn2=d2fxdss2*dssdn**2+dfxdss*d2ssdn2
2200 : dvxci(ipts,ispden)=third*rho_inv*vxci(ipts,ispden)+&
2201 0 : & ex_lsd*(seven*third*dfxdn+rho*d2fxdn2)
2202 : ! Components 5 or 6
2203 0 : d2ssdndg=-eight*third*dssdg*rho_inv
2204 0 : d2fxdndg=d2fxdss2*dssdn*dssdg+dfxdss*d2ssdndg
2205 0 : dvxci(ipts,4+ispden)=ex_lsd*(four_thirds*dfxdg+rho*d2fxdndg)
2206 : ! Components 7 or 8
2207 0 : d2fxdg2=d2fxdss2*dssdg**2
2208 0 : dvxci(ipts,6+ispden)=ex_lsd*rho*d2fxdg2
2209 : ! For the time being, treat non-spin-polarized like spin-polarized
2210 0 : dvxci(ipts,2)=dvxci(ipts,1)
2211 0 : dvxci(ipts,4)=dvxci(ipts,3)
2212 0 : dvxci(ipts,6)=dvxci(ipts,5)
2213 0 : dvxci(ipts,8)=dvxci(ipts,7)
2214 : ! end of loop over the spin
2215 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
2216 0 : exc=exc*2
2217 0 : exci(ipts)=exc*rhotot_inv
2218 : ! -----------------------------------------------------------------------------
2219 : ! Then takes care of the LSD correlation part of the functional
2220 :
2221 :
2222 0 : rs=rsfac*rhotmot
2223 0 : sqr_rs=sq_rsfac*rhotmo6
2224 0 : rsm1_2=sq_rsfac_inv*rhoto6
2225 :
2226 : ! Formulas A6-A8 of PW92LSD
2227 0 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
2228 0 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs)
2229 0 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+4._dp*ec0_b4*rs)
2230 0 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
2231 : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
2232 0 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
2233 0 : ecrs0=ec0_q0*ec0_log
2234 0 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
2235 0 : ec0_q1pp=0.5_dp*ec0_aa*(-ec0_b1*rsm1_2**3+3._dp*ec0_b3*rsm1_2+8._dp*ec0_b4)
2236 : d2ecrs0_drs2= 4.0_dp*ec0_aa*ec0_a1*ec0_q1p*ec0_den &
2237 : & -ec0_q0*ec0_q1pp*ec0_den &
2238 0 : & +ec0_q0*ec0_q1p**2*ec0_den**2*(2._dp*ec0_q1+1.0_dp)
2239 :
2240 0 : mac_q0=-2.0_dp*mac_aa*(1.0_dp+mac_a1*rs)
2241 0 : mac_q1=2.0_dp*mac_aa*(mac_b1*sqr_rs+mac_b2*rs+mac_b3*rs*sqr_rs+mac_b4*rs*rs)
2242 0 : mac_q1p=mac_aa*(mac_b1*rsm1_2+2._dp*mac_b2+3._dp*mac_b3*sqr_rs+4._dp*mac_b4*rs)
2243 0 : mac_den=1.0_dp/(mac_q1*mac_q1+mac_q1)
2244 0 : mac_log=-log( mac_q1*mac_q1*mac_den )
2245 0 : macrs=mac_q0*mac_log
2246 0 : dmacrs_drs= -2.0_dp*mac_aa*mac_a1*mac_log - mac_q0*mac_q1p*mac_den
2247 :
2248 0 : ecrs=ecrs0
2249 0 : decrs_drs=decrs0_drs
2250 0 : decrs_dzeta=0.0_dp
2251 0 : d2ecrs_drs2=d2ecrs0_drs2
2252 0 : d2ecrs_dzeta2=alpha_zeta**2*(-macrs)
2253 0 : d2ecrs_drsdzeta=zero
2254 0 : zeta=0.0_dp
2255 :
2256 :
2257 : ! Add LSD correlation functional to GGA exchange functional
2258 0 : exci(ipts)=exci(ipts)+ecrs
2259 0 : vxci(ipts,1)=vxci(ipts,1)+ecrs-rs*third*decrs_drs
2260 :
2261 0 : dvcrs_drs=third*(2._dp*decrs_drs-rs*d2ecrs_drs2)
2262 : ! And d(vxc)/d(rho)=(-rs/(3*rho))*d(vxc)/d(rs)
2263 0 : d2ecrs_drho2= -rs**4*(four_pi*third)*third*dvcrs_drs
2264 0 : dvxci(ipts,9)=d2ecrs_drho2
2265 0 : dvxci(ipts,10)=d2ecrs_drho2
2266 0 : dvxci(ipts,11)=d2ecrs_drho2
2267 :
2268 : ! -----------------------------------------------------------------------------
2269 : ! Eventually add the GGA correlation part of the PBE functional
2270 : ! Note : the computation of the potential in the spin-unpolarized
2271 : ! case could be optimized much further. Other optimizations are left to do.
2272 :
2273 0 : phi_zeta=1.0_dp
2274 0 : phip_zeta=0.0_dp
2275 0 : phi_zeta_inv=1.0_dp
2276 0 : phi_logder=0.0_dp
2277 0 : phi3_zeta=1.0_dp
2278 0 : gamphi3inv=gamma_inv
2279 0 : phipp_zeta=-two*ninth*alpha_zeta*alpha_zeta
2280 :
2281 : ! From ec to bb
2282 0 : bb=ecrs*gamphi3inv
2283 0 : dbb_drs=decrs_drs*gamphi3inv
2284 0 : dbb_dzeta=gamphi3inv*(decrs_dzeta-three*ecrs*phi_logder)
2285 0 : d2bb_drs2=d2ecrs_drs2*gamphi3inv
2286 0 : d2bb_drsdzeta=gamphi3inv*(d2ecrs_drsdzeta-three*decrs_drs*phi_logder)
2287 : d2bb_dzeta2=gamphi3inv*(d2ecrs_dzeta2-six*decrs_dzeta*phi_logder+&
2288 0 : & 12.0_dp*ecrs*phi_logder*phi_logder-three*ecrs*phi_zeta_inv*phipp_zeta)
2289 :
2290 : ! From bb to cc
2291 0 : exp_pbe=exp(-bb)
2292 0 : cc=one/(exp_pbe-one)
2293 0 : dcc_dbb=cc*cc*exp_pbe
2294 0 : dcc_drs=dcc_dbb*dbb_drs
2295 0 : dcc_dzeta=dcc_dbb*dbb_dzeta
2296 0 : d2cc_dbb2=cc*cc*exp_pbe*(two*cc*exp_pbe-one)
2297 0 : d2cc_drs2=d2cc_dbb2*dbb_drs*dbb_drs+dcc_dbb*d2bb_drs2
2298 0 : d2cc_drsdzeta=d2cc_dbb2*dbb_drs*dbb_dzeta+dcc_dbb*d2bb_drsdzeta
2299 0 : d2cc_dzeta2=d2cc_dbb2*dbb_dzeta*dbb_dzeta+dcc_dbb*d2bb_dzeta2
2300 :
2301 : ! From cc to aa
2302 0 : coeff_aa=beta*gamma_inv*phi_zeta_inv*phi_zeta_inv
2303 0 : aa=coeff_aa*cc
2304 0 : daa_drs=coeff_aa*dcc_drs
2305 0 : daa_dzeta=-two*aa*phi_logder+coeff_aa*dcc_dzeta
2306 0 : d2aa_drs2=coeff_aa*d2cc_drs2
2307 0 : d2aa_drsdzeta=-two*daa_drs*phi_logder+coeff_aa*d2cc_drsdzeta
2308 : d2aa_dzeta2=aa*(-two*phi_zeta_inv*phipp_zeta+six*phi_logder*phi_logder)+&
2309 0 : & coeff_aa*(-four*dcc_dzeta*phi_logder+d2cc_dzeta2)
2310 :
2311 : ! Introduce tt : do not assume that the spin-dependent gradients are collinear
2312 0 : grrho2=four*grho2_updn(ipts,1)
2313 0 : dtt_dg=two*rhotot_inv*rhotot_inv*rhotmot*coeff_tt
2314 : ! Note that tt is (the t variable of PBE divided by phi) squared
2315 0 : tt=half*grrho2*dtt_dg
2316 :
2317 : ! Get xx from aa and tt
2318 0 : xx=aa*tt
2319 0 : dxx_drs=daa_drs*tt
2320 0 : dxx_dzeta=daa_dzeta*tt
2321 0 : dxx_dtt=aa
2322 0 : d2xx_drs2=d2aa_drs2*tt
2323 0 : d2xx_drsdzeta=d2aa_drsdzeta*tt
2324 0 : d2xx_drsdtt=daa_drs
2325 0 : d2xx_dttdzeta=daa_dzeta
2326 0 : d2xx_dzeta2=d2aa_dzeta2*tt
2327 :
2328 : ! From xx to pade
2329 0 : pade_den=one/(one+xx*(one+xx))
2330 0 : pade=(one+xx)*pade_den
2331 0 : dpade_dxx=-xx*(two+xx)*pade_den**2
2332 0 : dpade_drs=dpade_dxx*dxx_drs
2333 0 : dpade_dtt=dpade_dxx*dxx_dtt
2334 0 : dpade_dzeta=dpade_dxx*dxx_dzeta
2335 0 : d2pade_dxx2=two*(-one+xx*xx*(three+xx))*pade_den*pade_den*pade_den
2336 0 : d2pade_drs2=d2pade_dxx2*dxx_drs*dxx_drs+dpade_dxx*d2xx_drs2
2337 0 : d2pade_drsdtt=d2pade_dxx2*dxx_drs*dxx_dtt+dpade_dxx*d2xx_drsdtt
2338 0 : d2pade_drsdzeta=d2pade_dxx2*dxx_drs*dxx_dzeta+dpade_dxx*d2xx_drsdzeta
2339 0 : d2pade_dtt2=d2pade_dxx2*dxx_dtt*dxx_dtt
2340 0 : d2pade_dttdzeta=d2pade_dxx2*dxx_dtt*dxx_dzeta+dpade_dxx*d2xx_dttdzeta
2341 0 : d2pade_dzeta2=d2pade_dxx2*dxx_dzeta*dxx_dzeta+dpade_dxx*d2xx_dzeta2
2342 :
2343 : ! From pade to qq
2344 0 : coeff_qq=tt*phi_zeta_inv*phi_zeta_inv
2345 0 : qq=coeff_qq*pade
2346 0 : dqq_drs=coeff_qq*dpade_drs
2347 0 : dqq_dtt=pade*phi_zeta_inv*phi_zeta_inv+coeff_qq*dpade_dtt
2348 0 : dqq_dzeta=coeff_qq*(dpade_dzeta-two*pade*phi_logder)
2349 0 : d2qq_drs2=coeff_qq*d2pade_drs2
2350 0 : d2qq_drsdtt=phi_zeta_inv*phi_zeta_inv*(dpade_drs+tt*d2pade_drsdtt)
2351 0 : d2qq_drsdzeta=coeff_qq*(d2pade_drsdzeta-two*dpade_drs*phi_logder)
2352 0 : d2qq_dtt2=phi_zeta_inv*phi_zeta_inv*(two*dpade_dtt+tt*d2pade_dtt2)
2353 : d2qq_dttdzeta=phi_zeta_inv*phi_zeta_inv*(dpade_dzeta-two*pade*phi_logder)+&
2354 0 : & coeff_qq*(d2pade_dttdzeta-two*dpade_dtt*phi_logder)
2355 : d2qq_dzeta2=coeff_qq*( d2pade_dzeta2-four*dpade_dzeta*phi_logder &
2356 : & +six*pade*phi_logder*phi_logder &
2357 0 : & -two*pade*phi_zeta_inv*phipp_zeta)
2358 :
2359 : ! From qq to rr
2360 0 : arg_rr=one+beta*gamma_inv*qq
2361 0 : div_rr=one/arg_rr
2362 0 : rr=gamma*log(arg_rr)
2363 0 : drr_dqq=beta*div_rr
2364 0 : drr_drs=drr_dqq*dqq_drs
2365 0 : drr_dtt=drr_dqq*dqq_dtt
2366 0 : drr_dzeta=drr_dqq*dqq_dzeta
2367 0 : d2rr_dqq2=-div_rr**2*beta*beta*gamma_inv
2368 0 : d2rr_drs2=d2rr_dqq2*dqq_drs*dqq_drs+drr_dqq*d2qq_drs2
2369 0 : d2rr_drsdtt=d2rr_dqq2*dqq_drs*dqq_dtt+drr_dqq*d2qq_drsdtt
2370 0 : d2rr_drsdzeta=d2rr_dqq2*dqq_drs*dqq_dzeta+drr_dqq*d2qq_drsdzeta
2371 0 : d2rr_dtt2=d2rr_dqq2*dqq_dtt*dqq_dtt+drr_dqq*d2qq_dtt2
2372 0 : d2rr_dttdzeta=d2rr_dqq2*dqq_dtt*dqq_dzeta+drr_dqq*d2qq_dttdzeta
2373 0 : d2rr_dzeta2=d2rr_dqq2*dqq_dzeta*dqq_dzeta+drr_dqq*d2qq_dzeta2
2374 :
2375 : ! From rr to hh
2376 0 : hh=phi3_zeta*rr
2377 0 : dhh_drs=phi3_zeta*drr_drs
2378 0 : dhh_dtt=phi3_zeta*drr_dtt
2379 0 : dhh_dzeta=phi3_zeta*(drr_dzeta+three*rr*phi_logder)
2380 0 : d2hh_drs2=phi3_zeta*d2rr_drs2
2381 0 : d2hh_drsdtt=phi3_zeta*d2rr_drsdtt
2382 0 : d2hh_drsdzeta=phi3_zeta*(d2rr_drsdzeta+three*drr_drs*phi_logder)
2383 0 : d2hh_dtt2=phi3_zeta*d2rr_dtt2
2384 0 : d2hh_dttdzeta=phi3_zeta*(d2rr_dttdzeta+three*drr_dtt*phi_logder)
2385 : d2hh_dzeta2=phi3_zeta*(six*rr*phi_logder*phi_logder+&
2386 : & six*phi_logder*drr_dzeta+d2rr_dzeta2) &
2387 0 : & +three*phi_zeta*phi_zeta*rr*phipp_zeta
2388 :
2389 : ! The GGA correlation energy is added
2390 0 : exci(ipts)=exci(ipts)+hh
2391 :
2392 : ! Change of variables : from (rs,zeta,tt) to (rhoup,rhodn,grrho)
2393 :
2394 : ! From hh to the derivative of the energy wrt the density
2395 0 : drhohh_drho=hh-third*rs*dhh_drs-zeta*dhh_dzeta-seven*third*tt*dhh_dtt
2396 0 : vxci(ipts,1)=vxci(ipts,1)+drhohh_drho
2397 :
2398 : ! From hh to the derivative of the energy wrt to the gradient of the
2399 : ! density, divided by the gradient of the density
2400 : ! (The v3.3 definition includes the division by the norm of the gradient)
2401 0 : dvxcdgr(ipts,3)=rhotot*dtt_dg*dhh_dtt
2402 :
2403 : d2rhohh_drho2=rhotot_inv*&
2404 : & (-two*ninth*rs*dhh_drs +seven*four*ninth*tt*dhh_dtt &
2405 : & +ninth*rs*rs*d2hh_drs2+zeta*zeta*d2hh_dzeta2+(seven*third*tt)**2*d2hh_dtt2 &
2406 : & +two*third*rs*zeta*d2hh_drsdzeta+two*seven*ninth*rs*tt*d2hh_drsdtt &
2407 0 : & +two*seven*third*tt*zeta*d2hh_dttdzeta)
2408 : d2rhohh_drhodg=dtt_dg*(-four*third*dhh_dtt-third*rs*d2hh_drsdtt &
2409 0 : & -zeta*d2hh_dttdzeta-seven*third*tt*d2hh_dtt2)
2410 :
2411 : ! Component 12 : first derivative with respect to the gradient
2412 : ! of the density, div by the grad of the density
2413 0 : dvxci(ipts,12)=dvxcdgr(ipts,3)
2414 : ! Components 9, 10 and 11 : second derivatives with respect to the spin-density
2415 : ! Note that there is already a contribution from LSDA
2416 : dvxci(ipts,9)=dvxci(ipts,9)+d2rhohh_drho2+rhotot_inv* &
2417 : & ( d2hh_dzeta2*(one-two*zeta) &
2418 0 : & -two*third*rs*d2hh_drsdzeta-14.0_dp*third*tt*d2hh_dttdzeta)
2419 0 : dvxci(ipts,10)=dvxci(ipts,10)+d2rhohh_drho2-rhotot_inv*d2hh_dzeta2
2420 : dvxci(ipts,11)=dvxci(ipts,11)+d2rhohh_drho2+rhotot_inv* &
2421 : & ( d2hh_dzeta2*(one+two*zeta) &
2422 0 : & +two*third*rs*d2hh_drsdzeta+14.0_dp*third*tt*d2hh_dttdzeta)
2423 : ! Components 13 and 14 : second derivatives with respect to spin density
2424 : ! and gradient, divided by the gradient
2425 0 : dvxci(ipts,13)=d2rhohh_drhodg+dtt_dg*d2hh_dttdzeta
2426 0 : dvxci(ipts,14)=d2rhohh_drhodg-dtt_dg*d2hh_dttdzeta
2427 : ! Component 15 : derivative of the (derivative wrt the gradient div by the grad),
2428 : ! divided by the grad
2429 0 : dvxci(ipts,15)=rhotot*d2hh_dtt2*dtt_dg*dtt_dg
2430 :
2431 :
2432 : ! End condition of GGA
2433 :
2434 :
2435 : ! Correlation has been added
2436 : ! -----------------------------------------------------------------------------
2437 :
2438 : ! vxci(ipts,2)=vxci(ipts,1)
2439 0 : dvxcdgr(ipts,2)=dvxcdgr(ipts,1)
2440 :
2441 : end do
2442 :
2443 : else if ((option==6) .or. (option==7)) then
2444 0 : do ipts=1,npts
2445 :
2446 0 : rhotot=rhoarr(ipts)
2447 0 : rhotmot=rhom1_3(ipts)
2448 0 : rhotot_inv=rhotmot*rhotmot*rhotmot
2449 0 : rhotmo6=sqrt(rhotmot)
2450 0 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
2451 : ! -----------------------------------------------------------------------
2452 : ! First take care of the exchange part of the functional
2453 :
2454 0 : exc=zero
2455 0 : dvxcdgr(ipts,3)=zero
2456 : ! loop over the spin
2457 0 : ispden=1
2458 0 : rho =rho_updn(ipts,ispden)
2459 0 : rhomot=rho_updnm1_3(ipts,ispden)
2460 0 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
2461 : ! Perdew-Burke-Ernzerhof GGA, exchange part
2462 0 : rho_inv=rhomot*rhomot*rhomot
2463 0 : coeffss=quarter*sixpi2m1_3*sixpi2m1_3*rho_inv*rho_inv*rhomot*rhomot
2464 0 : ss=grho2_updn(ipts,ispden)*coeffss
2465 :
2466 0 : if (option==6) then
2467 0 : divss=exp(-mu_divkappa*ss)
2468 0 : dfxdss= mu*divss
2469 0 : d2fxdss2=-mu*mu_divkappa*divss
2470 :
2471 0 : fx = one+kappa*(one-divss)
2472 0 : ex_gga= ex_lsd*fx
2473 0 : dssdn=-eight*third*ss*rho_inv
2474 0 : dfxdn = dfxdss*dssdn
2475 0 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
2476 : ! The new definition (v3.3) includes the division by the norm of the gradient
2477 0 : dssdg =two*coeffss
2478 0 : dfxdg=dfxdss*dssdg
2479 0 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
2480 0 : exc=exc+ex_gga*rho
2481 : ! This is the Wu and Cohen modification
2482 : else
2483 0 : expss=exp(-ss)
2484 0 : p1_wc=b_wc+(mu-b_wc)*(one-ss)*expss+two*c_wc*ss/(one+c_wc*ss*ss)
2485 : p2_wc=d_wc*(ss-two)*expss+two*c_wc/(one+c_wc*ss*ss)-&
2486 0 : & four*c_wc*c_wc*ss*ss/((one+c_wc*ss*ss)*(one+c_wc*ss*ss))
2487 0 : divss=one/(one+(b_wc*ss+d_wc*ss*expss+log(one+c_wc*ss*ss))/kappa)
2488 0 : dfxdss=p1_wc*divss*divss
2489 0 : d2fxdss2=p2_wc*divss*divss-two*divss*divss*divss*p1_wc*p1_wc/kappa
2490 :
2491 0 : fx = one+kappa*(one-divss)
2492 0 : ex_gga= ex_lsd*fx
2493 0 : dssdn=-eight*third*ss*rho_inv
2494 0 : dfxdn = dfxdss*dssdn
2495 0 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
2496 : ! The new definition (v3.3) includes the division by the norm of the gradient
2497 0 : dssdg =two*coeffss
2498 0 : dfxdg=dfxdss*dssdg
2499 0 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
2500 0 : exc=exc+ex_gga*rho
2501 : end if
2502 :
2503 : ! Perdew-Burke-Ernzerhof GGA, exchange part
2504 : ! Components 3 or 4
2505 0 : dvxci(ipts,2+ispden)=dvxcdgr(ipts,ispden)
2506 : ! Components 1 or 2
2507 0 : d2ssdn2=-11.0_dp*third*dssdn*rho_inv
2508 0 : d2fxdn2=d2fxdss2*dssdn**2+dfxdss*d2ssdn2
2509 : dvxci(ipts,ispden)=third*rho_inv*vxci(ipts,ispden)+&
2510 0 : & ex_lsd*(seven*third*dfxdn+rho*d2fxdn2)
2511 : ! Components 5 or 6
2512 0 : d2ssdndg=-eight*third*dssdg*rho_inv
2513 0 : d2fxdndg=d2fxdss2*dssdn*dssdg+dfxdss*d2ssdndg
2514 0 : dvxci(ipts,4+ispden)=ex_lsd*(four_thirds*dfxdg+rho*d2fxdndg)
2515 : ! Components 7 or 8
2516 0 : d2fxdg2=d2fxdss2*dssdg**2
2517 0 : dvxci(ipts,6+ispden)=ex_lsd*rho*d2fxdg2
2518 : ! For the time being, treat non-spin-polarized like spin-polarized
2519 0 : dvxci(ipts,2)=dvxci(ipts,1)
2520 0 : dvxci(ipts,4)=dvxci(ipts,3)
2521 0 : dvxci(ipts,6)=dvxci(ipts,5)
2522 0 : dvxci(ipts,8)=dvxci(ipts,7)
2523 : ! end of loop over the spin
2524 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
2525 0 : exc=exc*2
2526 0 : exci(ipts)=exc*rhotot_inv
2527 : ! -----------------------------------------------------------------------------
2528 : ! Then takes care of the LSD correlation part of the functional
2529 :
2530 :
2531 0 : rs=rsfac*rhotmot
2532 0 : sqr_rs=sq_rsfac*rhotmo6
2533 0 : rsm1_2=sq_rsfac_inv*rhoto6
2534 :
2535 : ! Formulas A6-A8 of PW92LSD
2536 0 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
2537 0 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs)
2538 0 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+4._dp*ec0_b4*rs)
2539 0 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
2540 : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
2541 0 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
2542 0 : ecrs0=ec0_q0*ec0_log
2543 0 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
2544 0 : ec0_q1pp=0.5_dp*ec0_aa*(-ec0_b1*rsm1_2**3+3._dp*ec0_b3*rsm1_2+8._dp*ec0_b4)
2545 : d2ecrs0_drs2= 4.0_dp*ec0_aa*ec0_a1*ec0_q1p*ec0_den &
2546 : & -ec0_q0*ec0_q1pp*ec0_den &
2547 0 : & +ec0_q0*ec0_q1p**2*ec0_den**2*(2._dp*ec0_q1+1.0_dp)
2548 :
2549 0 : mac_q0=-2.0_dp*mac_aa*(1.0_dp+mac_a1*rs)
2550 0 : mac_q1=2.0_dp*mac_aa*(mac_b1*sqr_rs+mac_b2*rs+mac_b3*rs*sqr_rs+mac_b4*rs*rs)
2551 0 : mac_q1p=mac_aa*(mac_b1*rsm1_2+2._dp*mac_b2+3._dp*mac_b3*sqr_rs+4._dp*mac_b4*rs)
2552 0 : mac_den=1.0_dp/(mac_q1*mac_q1+mac_q1)
2553 0 : mac_log=-log( mac_q1*mac_q1*mac_den )
2554 0 : macrs=mac_q0*mac_log
2555 0 : dmacrs_drs= -2.0_dp*mac_aa*mac_a1*mac_log - mac_q0*mac_q1p*mac_den
2556 :
2557 0 : ecrs=ecrs0
2558 0 : decrs_drs=decrs0_drs
2559 0 : decrs_dzeta=0.0_dp
2560 0 : d2ecrs_drs2=d2ecrs0_drs2
2561 0 : d2ecrs_dzeta2=alpha_zeta**2*(-macrs)
2562 0 : d2ecrs_drsdzeta=zero
2563 0 : zeta=0.0_dp
2564 :
2565 :
2566 : ! Add LSD correlation functional to GGA exchange functional
2567 0 : exci(ipts)=exci(ipts)+ecrs
2568 0 : vxci(ipts,1)=vxci(ipts,1)+ecrs-rs*third*decrs_drs
2569 :
2570 0 : dvcrs_drs=third*(2._dp*decrs_drs-rs*d2ecrs_drs2)
2571 : ! And d(vxc)/d(rho)=(-rs/(3*rho))*d(vxc)/d(rs)
2572 0 : d2ecrs_drho2= -rs**4*(four_pi*third)*third*dvcrs_drs
2573 0 : dvxci(ipts,9)=d2ecrs_drho2
2574 0 : dvxci(ipts,10)=d2ecrs_drho2
2575 0 : dvxci(ipts,11)=d2ecrs_drho2
2576 :
2577 : ! -----------------------------------------------------------------------------
2578 : ! Eventually add the GGA correlation part of the PBE functional
2579 : ! Note : the computation of the potential in the spin-unpolarized
2580 : ! case could be optimized much further. Other optimizations are left to do.
2581 :
2582 0 : phi_zeta=1.0_dp
2583 0 : phip_zeta=0.0_dp
2584 0 : phi_zeta_inv=1.0_dp
2585 0 : phi_logder=0.0_dp
2586 0 : phi3_zeta=1.0_dp
2587 0 : gamphi3inv=gamma_inv
2588 0 : phipp_zeta=-two*ninth*alpha_zeta*alpha_zeta
2589 :
2590 : ! From ec to bb
2591 0 : bb=ecrs*gamphi3inv
2592 0 : dbb_drs=decrs_drs*gamphi3inv
2593 0 : dbb_dzeta=gamphi3inv*(decrs_dzeta-three*ecrs*phi_logder)
2594 0 : d2bb_drs2=d2ecrs_drs2*gamphi3inv
2595 0 : d2bb_drsdzeta=gamphi3inv*(d2ecrs_drsdzeta-three*decrs_drs*phi_logder)
2596 : d2bb_dzeta2=gamphi3inv*(d2ecrs_dzeta2-six*decrs_dzeta*phi_logder+&
2597 0 : & 12.0_dp*ecrs*phi_logder*phi_logder-three*ecrs*phi_zeta_inv*phipp_zeta)
2598 :
2599 : ! From bb to cc
2600 0 : exp_pbe=exp(-bb)
2601 0 : cc=one/(exp_pbe-one)
2602 0 : dcc_dbb=cc*cc*exp_pbe
2603 0 : dcc_drs=dcc_dbb*dbb_drs
2604 0 : dcc_dzeta=dcc_dbb*dbb_dzeta
2605 0 : d2cc_dbb2=cc*cc*exp_pbe*(two*cc*exp_pbe-one)
2606 0 : d2cc_drs2=d2cc_dbb2*dbb_drs*dbb_drs+dcc_dbb*d2bb_drs2
2607 0 : d2cc_drsdzeta=d2cc_dbb2*dbb_drs*dbb_dzeta+dcc_dbb*d2bb_drsdzeta
2608 0 : d2cc_dzeta2=d2cc_dbb2*dbb_dzeta*dbb_dzeta+dcc_dbb*d2bb_dzeta2
2609 :
2610 : ! From cc to aa
2611 0 : coeff_aa=beta*gamma_inv*phi_zeta_inv*phi_zeta_inv
2612 0 : aa=coeff_aa*cc
2613 0 : daa_drs=coeff_aa*dcc_drs
2614 0 : daa_dzeta=-two*aa*phi_logder+coeff_aa*dcc_dzeta
2615 0 : d2aa_drs2=coeff_aa*d2cc_drs2
2616 0 : d2aa_drsdzeta=-two*daa_drs*phi_logder+coeff_aa*d2cc_drsdzeta
2617 : d2aa_dzeta2=aa*(-two*phi_zeta_inv*phipp_zeta+six*phi_logder*phi_logder)+&
2618 0 : & coeff_aa*(-four*dcc_dzeta*phi_logder+d2cc_dzeta2)
2619 :
2620 : ! Introduce tt : do not assume that the spin-dependent gradients are collinear
2621 0 : grrho2=four*grho2_updn(ipts,1)
2622 0 : dtt_dg=two*rhotot_inv*rhotot_inv*rhotmot*coeff_tt
2623 : ! Note that tt is (the t variable of PBE divided by phi) squared
2624 0 : tt=half*grrho2*dtt_dg
2625 :
2626 : ! Get xx from aa and tt
2627 0 : xx=aa*tt
2628 0 : dxx_drs=daa_drs*tt
2629 0 : dxx_dzeta=daa_dzeta*tt
2630 0 : dxx_dtt=aa
2631 0 : d2xx_drs2=d2aa_drs2*tt
2632 0 : d2xx_drsdzeta=d2aa_drsdzeta*tt
2633 0 : d2xx_drsdtt=daa_drs
2634 0 : d2xx_dttdzeta=daa_dzeta
2635 0 : d2xx_dzeta2=d2aa_dzeta2*tt
2636 :
2637 : ! From xx to pade
2638 0 : pade_den=one/(one+xx*(one+xx))
2639 0 : pade=(one+xx)*pade_den
2640 0 : dpade_dxx=-xx*(two+xx)*pade_den**2
2641 0 : dpade_drs=dpade_dxx*dxx_drs
2642 0 : dpade_dtt=dpade_dxx*dxx_dtt
2643 0 : dpade_dzeta=dpade_dxx*dxx_dzeta
2644 0 : d2pade_dxx2=two*(-one+xx*xx*(three+xx))*pade_den*pade_den*pade_den
2645 0 : d2pade_drs2=d2pade_dxx2*dxx_drs*dxx_drs+dpade_dxx*d2xx_drs2
2646 0 : d2pade_drsdtt=d2pade_dxx2*dxx_drs*dxx_dtt+dpade_dxx*d2xx_drsdtt
2647 0 : d2pade_drsdzeta=d2pade_dxx2*dxx_drs*dxx_dzeta+dpade_dxx*d2xx_drsdzeta
2648 0 : d2pade_dtt2=d2pade_dxx2*dxx_dtt*dxx_dtt
2649 0 : d2pade_dttdzeta=d2pade_dxx2*dxx_dtt*dxx_dzeta+dpade_dxx*d2xx_dttdzeta
2650 0 : d2pade_dzeta2=d2pade_dxx2*dxx_dzeta*dxx_dzeta+dpade_dxx*d2xx_dzeta2
2651 :
2652 : ! From pade to qq
2653 0 : coeff_qq=tt*phi_zeta_inv*phi_zeta_inv
2654 0 : qq=coeff_qq*pade
2655 0 : dqq_drs=coeff_qq*dpade_drs
2656 0 : dqq_dtt=pade*phi_zeta_inv*phi_zeta_inv+coeff_qq*dpade_dtt
2657 0 : dqq_dzeta=coeff_qq*(dpade_dzeta-two*pade*phi_logder)
2658 0 : d2qq_drs2=coeff_qq*d2pade_drs2
2659 0 : d2qq_drsdtt=phi_zeta_inv*phi_zeta_inv*(dpade_drs+tt*d2pade_drsdtt)
2660 0 : d2qq_drsdzeta=coeff_qq*(d2pade_drsdzeta-two*dpade_drs*phi_logder)
2661 0 : d2qq_dtt2=phi_zeta_inv*phi_zeta_inv*(two*dpade_dtt+tt*d2pade_dtt2)
2662 : d2qq_dttdzeta=phi_zeta_inv*phi_zeta_inv*(dpade_dzeta-two*pade*phi_logder)+&
2663 0 : & coeff_qq*(d2pade_dttdzeta-two*dpade_dtt*phi_logder)
2664 : d2qq_dzeta2=coeff_qq*( d2pade_dzeta2-four*dpade_dzeta*phi_logder &
2665 : & +six*pade*phi_logder*phi_logder &
2666 0 : & -two*pade*phi_zeta_inv*phipp_zeta)
2667 :
2668 : ! From qq to rr
2669 0 : arg_rr=one+beta*gamma_inv*qq
2670 0 : div_rr=one/arg_rr
2671 0 : rr=gamma*log(arg_rr)
2672 0 : drr_dqq=beta*div_rr
2673 0 : drr_drs=drr_dqq*dqq_drs
2674 0 : drr_dtt=drr_dqq*dqq_dtt
2675 0 : drr_dzeta=drr_dqq*dqq_dzeta
2676 0 : d2rr_dqq2=-div_rr**2*beta*beta*gamma_inv
2677 0 : d2rr_drs2=d2rr_dqq2*dqq_drs*dqq_drs+drr_dqq*d2qq_drs2
2678 0 : d2rr_drsdtt=d2rr_dqq2*dqq_drs*dqq_dtt+drr_dqq*d2qq_drsdtt
2679 0 : d2rr_drsdzeta=d2rr_dqq2*dqq_drs*dqq_dzeta+drr_dqq*d2qq_drsdzeta
2680 0 : d2rr_dtt2=d2rr_dqq2*dqq_dtt*dqq_dtt+drr_dqq*d2qq_dtt2
2681 0 : d2rr_dttdzeta=d2rr_dqq2*dqq_dtt*dqq_dzeta+drr_dqq*d2qq_dttdzeta
2682 0 : d2rr_dzeta2=d2rr_dqq2*dqq_dzeta*dqq_dzeta+drr_dqq*d2qq_dzeta2
2683 :
2684 : ! From rr to hh
2685 0 : hh=phi3_zeta*rr
2686 0 : dhh_drs=phi3_zeta*drr_drs
2687 0 : dhh_dtt=phi3_zeta*drr_dtt
2688 0 : dhh_dzeta=phi3_zeta*(drr_dzeta+three*rr*phi_logder)
2689 0 : d2hh_drs2=phi3_zeta*d2rr_drs2
2690 0 : d2hh_drsdtt=phi3_zeta*d2rr_drsdtt
2691 0 : d2hh_drsdzeta=phi3_zeta*(d2rr_drsdzeta+three*drr_drs*phi_logder)
2692 0 : d2hh_dtt2=phi3_zeta*d2rr_dtt2
2693 0 : d2hh_dttdzeta=phi3_zeta*(d2rr_dttdzeta+three*drr_dtt*phi_logder)
2694 : d2hh_dzeta2=phi3_zeta*(six*rr*phi_logder*phi_logder+&
2695 : & six*phi_logder*drr_dzeta+d2rr_dzeta2) &
2696 0 : & +three*phi_zeta*phi_zeta*rr*phipp_zeta
2697 :
2698 : ! The GGA correlation energy is added
2699 0 : exci(ipts)=exci(ipts)+hh
2700 :
2701 : ! Change of variables : from (rs,zeta,tt) to (rhoup,rhodn,grrho)
2702 :
2703 : ! From hh to the derivative of the energy wrt the density
2704 0 : drhohh_drho=hh-third*rs*dhh_drs-zeta*dhh_dzeta-seven*third*tt*dhh_dtt
2705 0 : vxci(ipts,1)=vxci(ipts,1)+drhohh_drho
2706 :
2707 : ! From hh to the derivative of the energy wrt to the gradient of the
2708 : ! density, divided by the gradient of the density
2709 : ! (The v3.3 definition includes the division by the norm of the gradient)
2710 0 : dvxcdgr(ipts,3)=rhotot*dtt_dg*dhh_dtt
2711 :
2712 : d2rhohh_drho2=rhotot_inv*&
2713 : & (-two*ninth*rs*dhh_drs +seven*four*ninth*tt*dhh_dtt &
2714 : & +ninth*rs*rs*d2hh_drs2+zeta*zeta*d2hh_dzeta2+(seven*third*tt)**2*d2hh_dtt2 &
2715 : & +two*third*rs*zeta*d2hh_drsdzeta+two*seven*ninth*rs*tt*d2hh_drsdtt &
2716 0 : & +two*seven*third*tt*zeta*d2hh_dttdzeta)
2717 : d2rhohh_drhodg=dtt_dg*(-four*third*dhh_dtt-third*rs*d2hh_drsdtt &
2718 0 : & -zeta*d2hh_dttdzeta-seven*third*tt*d2hh_dtt2)
2719 :
2720 : ! Component 12 : first derivative with respect to the gradient
2721 : ! of the density, div by the grad of the density
2722 0 : dvxci(ipts,12)=dvxcdgr(ipts,3)
2723 : ! Components 9, 10 and 11 : second derivatives with respect to the spin-density
2724 : ! Note that there is already a contribution from LSDA
2725 : dvxci(ipts,9)=dvxci(ipts,9)+d2rhohh_drho2+rhotot_inv* &
2726 : & ( d2hh_dzeta2*(one-two*zeta) &
2727 0 : & -two*third*rs*d2hh_drsdzeta-14.0_dp*third*tt*d2hh_dttdzeta)
2728 0 : dvxci(ipts,10)=dvxci(ipts,10)+d2rhohh_drho2-rhotot_inv*d2hh_dzeta2
2729 : dvxci(ipts,11)=dvxci(ipts,11)+d2rhohh_drho2+rhotot_inv* &
2730 : & ( d2hh_dzeta2*(one+two*zeta) &
2731 0 : & +two*third*rs*d2hh_drsdzeta+14.0_dp*third*tt*d2hh_dttdzeta)
2732 : ! Components 13 and 14 : second derivatives with respect to spin density
2733 : ! and gradient, divided by the gradient
2734 0 : dvxci(ipts,13)=d2rhohh_drhodg+dtt_dg*d2hh_dttdzeta
2735 0 : dvxci(ipts,14)=d2rhohh_drhodg-dtt_dg*d2hh_dttdzeta
2736 : ! Component 15 : derivative of the (derivative wrt the gradient div by the grad),
2737 : ! divided by the grad
2738 0 : dvxci(ipts,15)=rhotot*d2hh_dtt2*dtt_dg*dtt_dg
2739 :
2740 :
2741 : ! End condition of GGA
2742 :
2743 :
2744 : ! Correlation has been added
2745 : ! -----------------------------------------------------------------------------
2746 :
2747 : ! vxci(ipts,2)=vxci(ipts,1)
2748 0 : dvxcdgr(ipts,2)=dvxcdgr(ipts,1)
2749 :
2750 : end do
2751 :
2752 : else if (option==-1) then
2753 0 : do ipts=1,npts
2754 :
2755 0 : rhotot=rhoarr(ipts)
2756 0 : rhotmot=rhom1_3(ipts)
2757 0 : rhotot_inv=rhotmot*rhotmot*rhotmot
2758 0 : rhotmo6=sqrt(rhotmot)
2759 0 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
2760 : ! -----------------------------------------------------------------------
2761 : ! First take care of the exchange part of the functional
2762 :
2763 0 : exc=zero
2764 : ! loop over the spin
2765 0 : ispden=1
2766 0 : rho =rho_updn(ipts,ispden)
2767 0 : rhomot=rho_updnm1_3(ipts,ispden)
2768 0 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
2769 : ! Perdew_Wang 91 LSD
2770 0 : vxci(ipts,ispden)=four_thirds*ex_lsd
2771 0 : exc=exc+ex_lsd*rho
2772 :
2773 : ! Perdew_Wang 91 LSD
2774 : dvxci(ipts,2*ispden-1)=-four_thirds*third*&
2775 0 : & threefourth_divpi*sixpi2_1_3*rhomot*rhomot
2776 0 : dvxci(ipts,2)=zero
2777 : ! If non-spin-polarized, first component of dvxci is second
2778 : ! derivative with respect to TOTAL density.
2779 0 : dvxci(ipts,1)=dvxci(ipts,1)*half
2780 : ! Compute the second derivative of vx
2781 : ! vx^(2) = -2*vx^(1)/(3*rhotot)
2782 : ! end of loop over the spin
2783 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
2784 0 : exc=exc*2
2785 0 : exci(ipts)=exc*rhotot_inv
2786 :
2787 :
2788 : ! Correlation has been added
2789 : ! -----------------------------------------------------------------------------
2790 :
2791 :
2792 : end do
2793 :
2794 : else if (option==-2) then
2795 0 : do ipts=1,npts
2796 :
2797 0 : rhotot=rhoarr(ipts)
2798 0 : rhotmot=rhom1_3(ipts)
2799 0 : rhotot_inv=rhotmot*rhotmot*rhotmot
2800 0 : rhotmo6=sqrt(rhotmot)
2801 0 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
2802 : ! -----------------------------------------------------------------------
2803 : ! First take care of the exchange part of the functional
2804 :
2805 0 : exc=zero
2806 0 : dvxcdgr(ipts,3)=zero
2807 : ! loop over the spin
2808 0 : ispden=1
2809 0 : rho =rho_updn(ipts,ispden)
2810 0 : rhomot=rho_updnm1_3(ipts,ispden)
2811 0 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
2812 : ! Perdew-Burke-Ernzerhof GGA, exchange part
2813 0 : rho_inv=rhomot*rhomot*rhomot
2814 0 : coeffss=quarter*sixpi2m1_3*sixpi2m1_3*rho_inv*rho_inv*rhomot*rhomot
2815 0 : ss=grho2_updn(ipts,ispden)*coeffss
2816 0 : divss=one/(one+mu_divkappa*ss)
2817 0 : dfxdss= mu*divss*divss
2818 0 : d2fxdss2=-mu*two*mu_divkappa*divss*divss*divss
2819 0 : fx = one+kappa*(one-divss)
2820 0 : ex_gga= ex_lsd*fx
2821 0 : dssdn=-eight*third*ss*rho_inv
2822 0 : dfxdn = dfxdss*dssdn
2823 0 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
2824 : ! The new definition (v3.3) includes the division by the norm of the gradient
2825 0 : dssdg =two*coeffss
2826 0 : dfxdg=dfxdss*dssdg
2827 0 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
2828 0 : exc=exc+ex_gga*rho
2829 :
2830 : ! Perdew-Burke-Ernzerhof GGA, exchange part
2831 : ! Components 3 or 4
2832 0 : dvxci(ipts,2+ispden)=dvxcdgr(ipts,ispden)
2833 : ! Components 1 or 2
2834 0 : d2ssdn2=-11.0_dp*third*dssdn*rho_inv
2835 0 : d2fxdn2=d2fxdss2*dssdn**2+dfxdss*d2ssdn2
2836 : dvxci(ipts,ispden)=third*rho_inv*vxci(ipts,ispden)+&
2837 0 : & ex_lsd*(seven*third*dfxdn+rho*d2fxdn2)
2838 : ! Components 5 or 6
2839 0 : d2ssdndg=-eight*third*dssdg*rho_inv
2840 0 : d2fxdndg=d2fxdss2*dssdn*dssdg+dfxdss*d2ssdndg
2841 0 : dvxci(ipts,4+ispden)=ex_lsd*(four_thirds*dfxdg+rho*d2fxdndg)
2842 : ! Components 7 or 8
2843 0 : d2fxdg2=d2fxdss2*dssdg**2
2844 0 : dvxci(ipts,6+ispden)=ex_lsd*rho*d2fxdg2
2845 : ! For the time being, treat non-spin-polarized like spin-polarized
2846 0 : dvxci(ipts,2)=dvxci(ipts,1)
2847 0 : dvxci(ipts,4)=dvxci(ipts,3)
2848 0 : dvxci(ipts,6)=dvxci(ipts,5)
2849 0 : dvxci(ipts,8)=dvxci(ipts,7)
2850 : ! end of loop over the spin
2851 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
2852 0 : exc=exc*2
2853 0 : exci(ipts)=exc*rhotot_inv
2854 : ! -----------------------------------------------------------------------------
2855 : ! Then takes care of the LSD correlation part of the functional
2856 :
2857 :
2858 : ! Correlation has been added
2859 : ! -----------------------------------------------------------------------------
2860 :
2861 : ! vxci(ipts,2)=vxci(ipts,1)
2862 0 : dvxcdgr(ipts,2)=dvxcdgr(ipts,1)
2863 :
2864 : end do
2865 :
2866 : else if(option==-4) then
2867 :
2868 :
2869 0 : do ipts=1,npts
2870 :
2871 0 : rhotot=rhoarr(ipts)
2872 0 : rhotmot=rhom1_3(ipts)
2873 0 : rhotot_inv=rhotmot*rhotmot*rhotmot
2874 0 : rhotmo6=sqrt(rhotmot)
2875 0 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
2876 : ! -----------------------------------------------------------------------
2877 : ! First take care of the exchange part of the functional
2878 :
2879 0 : exc=zero
2880 0 : dvxcdgr(ipts,3)=zero
2881 : ! loop over the spin
2882 0 : ispden=1
2883 0 : rho =rho_updn(ipts,ispden)
2884 0 : rhomot=rho_updnm1_3(ipts,ispden)
2885 0 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
2886 : ! VALENTINO R. COOPER C09x GGA, This is an exchange term proposed
2887 : ! to use together with vdw-DF (see above).
2888 0 : rho_inv=rhomot*rhomot*rhomot
2889 0 : coeffss=quarter*sixpi2m1_3*sixpi2m1_3*rho_inv*rho_inv*rhomot*rhomot
2890 : ! the quarter that is lacking is compensated by the grho2_updn in the
2891 : ! next line.
2892 0 : ss=grho2_updn(ipts,ispden)*coeffss
2893 0 : alphs2=alpha_c09*ss
2894 0 : alphmu=alpha_c09*mu_c09
2895 : dfxdss= mu_c09*exp(-alphs2)*(one-alphs2)+&
2896 0 : & kappa*alpha_c09*exp(-alphs2/two)/two
2897 : d2fxdss2=-alphmu*exp(-alphs2)*(two-alphs2)-&
2898 0 : & kappa*(alpha_c09**two)*exp(alphs2/two)/four
2899 0 : fx = one+mu_c09*ss*exp(-alphs2)+kappa*(one-exp(-alphs2/two))
2900 0 : ex_gga= ex_lsd*fx
2901 0 : dssdn=-eight*third*ss*rho_inv
2902 0 : dfxdn = dfxdss*dssdn
2903 0 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
2904 : ! The new definition (v3.3) includes the division by the norm of the gradient
2905 0 : dssdg =two*coeffss
2906 0 : dfxdg=dfxdss*dssdg
2907 0 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
2908 0 : exc=exc+ex_gga*rho
2909 :
2910 : ! Cooper C09x GGA exchange
2911 : ! Components 3 or 4
2912 0 : dvxci(ipts,2+ispden)=dvxcdgr(ipts,ispden)
2913 : ! Components 1 or 2
2914 0 : d2ssdn2=-11.0_dp*third*dssdn*rho_inv
2915 0 : d2fxdn2=d2fxdss2*dssdn**2+dfxdss*d2ssdn2
2916 : dvxci(ipts,ispden)=third*rho_inv*vxci(ipts,ispden)+&
2917 0 : & ex_lsd*(seven*third*dfxdn+rho*d2fxdn2)
2918 : ! Components 5 or 6
2919 0 : d2ssdndg=-eight*third*dssdg*rho_inv
2920 0 : d2fxdndg=d2fxdss2*dssdn*dssdg+dfxdss*d2ssdndg
2921 0 : dvxci(ipts,4+ispden)=ex_lsd*(four_thirds*dfxdg+rho*d2fxdndg)
2922 : ! Components 7 or 8
2923 0 : d2fxdg2=d2fxdss2*dssdg**2
2924 0 : dvxci(ipts,6+ispden)=ex_lsd*rho*d2fxdg2
2925 : ! For the time being, treat non-spin-polarized like spin-polarized
2926 0 : dvxci(ipts,2)=dvxci(ipts,1)
2927 0 : dvxci(ipts,4)=dvxci(ipts,3)
2928 0 : dvxci(ipts,6)=dvxci(ipts,5)
2929 0 : dvxci(ipts,8)=dvxci(ipts,7)
2930 :
2931 : ! end of loop over the spin
2932 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
2933 0 : exc=exc*2
2934 0 : exci(ipts)=exc*rhotot_inv
2935 : ! -----------------------------------------------------------------------------
2936 : ! Then takes care of the LSD correlation part of the functional
2937 :
2938 : ! Correlation has been added
2939 : ! -----------------------------------------------------------------------------
2940 :
2941 : ! vxci(ipts,2)=vxci(ipts,1)
2942 0 : dvxcdgr(ipts,2)=dvxcdgr(ipts,1)
2943 :
2944 : end do
2945 :
2946 :
2947 : else if (option==1) then
2948 251533 : do ipts=1,npts
2949 :
2950 251468 : rhotot=rhoarr(ipts)
2951 251468 : rhotmot=rhom1_3(ipts)
2952 251468 : rhotot_inv=rhotmot*rhotmot*rhotmot
2953 251468 : rhotmo6=sqrt(rhotmot)
2954 251468 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
2955 : ! -----------------------------------------------------------------------
2956 : ! First take care of the exchange part of the functional
2957 :
2958 251468 : exc=zero
2959 : ! loop over the spin
2960 251468 : ispden=1
2961 251468 : rho =rho_updn(ipts,ispden)
2962 251468 : rhomot=rho_updnm1_3(ipts,ispden)
2963 251468 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
2964 : ! Perdew_Wang 91 LSD
2965 251468 : vxci(ipts,ispden)=four_thirds*ex_lsd
2966 251468 : exc=exc+ex_lsd*rho
2967 :
2968 :
2969 : ! Perdew_Wang 91 LSD
2970 : dvxci(ipts,2*ispden-1)=-four_thirds*third*&
2971 251468 : & threefourth_divpi*sixpi2_1_3*rhomot*rhomot
2972 251468 : dvxci(ipts,2)=zero
2973 : ! If non-spin-polarized, first component of dvxci is second
2974 : ! derivative with respect to TOTAL density.
2975 251468 : dvxci(ipts,1)=dvxci(ipts,1)*half
2976 : ! Compute the second derivative of vx
2977 : ! vx^(2) = -2*vx^(1)/(3*rhotot)
2978 : ! end of loop over the spin
2979 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
2980 251468 : exc=exc*2
2981 251468 : exci(ipts)=exc*rhotot_inv
2982 : ! -----------------------------------------------------------------------------
2983 : ! Then takes care of the LSD correlation part of the functional
2984 :
2985 251468 : rs=rsfac*rhotmot
2986 251468 : sqr_rs=sq_rsfac*rhotmo6
2987 251468 : rsm1_2=sq_rsfac_inv*rhoto6
2988 :
2989 : ! Formulas A6-A8 of PW92LSD
2990 251468 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
2991 :
2992 251468 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs)
2993 251468 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+4._dp*ec0_b4*rs)
2994 251468 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
2995 : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
2996 251468 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
2997 251468 : ecrs0=ec0_q0*ec0_log
2998 251468 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
2999 251468 : ec0_q1pp=0.5_dp*ec0_aa*(-ec0_b1*rsm1_2**3+3._dp*ec0_b3*rsm1_2+8._dp*ec0_b4)
3000 : d2ecrs0_drs2= 4.0_dp*ec0_aa*ec0_a1*ec0_q1p*ec0_den &
3001 : & -ec0_q0*ec0_q1pp*ec0_den &
3002 251468 : & +ec0_q0*ec0_q1p**2*ec0_den**2*(2._dp*ec0_q1+1.0_dp)
3003 :
3004 251468 : mac_q0=-2.0_dp*mac_aa*(1.0_dp+mac_a1*rs)
3005 251468 : mac_q1=2.0_dp*mac_aa*(mac_b1*sqr_rs+mac_b2*rs+mac_b3*rs*sqr_rs+mac_b4*rs*rs)
3006 251468 : mac_q1p=mac_aa*(mac_b1*rsm1_2+2._dp*mac_b2+3._dp*mac_b3*sqr_rs+4._dp*mac_b4*rs)
3007 251468 : mac_den=1.0_dp/(mac_q1*mac_q1+mac_q1)
3008 251468 : mac_log=-log( mac_q1*mac_q1*mac_den )
3009 251468 : macrs=mac_q0*mac_log
3010 251468 : dmacrs_drs= -2.0_dp*mac_aa*mac_a1*mac_log - mac_q0*mac_q1p*mac_den
3011 :
3012 251468 : ecrs=ecrs0
3013 251468 : decrs_drs=decrs0_drs
3014 251468 : decrs_dzeta=0.0_dp
3015 251468 : d2ecrs_drs2=d2ecrs0_drs2
3016 251468 : d2ecrs_dzeta2=alpha_zeta**2*(-macrs)
3017 251468 : d2ecrs_drsdzeta=zero
3018 251468 : zeta=0.0_dp
3019 :
3020 :
3021 : ! Add LSD correlation functional to GGA exchange functional
3022 251468 : exci(ipts)=exci(ipts)+ecrs
3023 251468 : vxci(ipts,1)=vxci(ipts,1)+ecrs-rs*third*decrs_drs
3024 :
3025 251468 : dvcrs_drs=third*(2._dp*decrs_drs-rs*d2ecrs_drs2)
3026 : ! And d(vxc)/d(rho)=(-rs/(3*rho))*d(vxc)/d(rs)
3027 251468 : d2ecrs_drho2= -rs**4*(four_pi*third)*third*dvcrs_drs
3028 :
3029 251468 : dvxci(ipts,1)=dvxci(ipts,1)+d2ecrs_drho2
3030 251533 : dvxci(ipts,2)=dvxci(ipts,2)+d2ecrs_drho2-d2ecrs_dzeta2*rhotot_inv
3031 :
3032 :
3033 : ! Correlation has been added
3034 : ! -----------------------------------------------------------------------------
3035 :
3036 : end do
3037 :
3038 : else if (option==3) then
3039 0 : do ipts=1,npts
3040 :
3041 0 : rhotot=rhoarr(ipts)
3042 0 : rhotmot=rhom1_3(ipts)
3043 0 : rhotot_inv=rhotmot*rhotmot*rhotmot
3044 0 : rhotmo6=sqrt(rhotmot)
3045 0 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
3046 : ! -----------------------------------------------------------------------
3047 : ! First take care of the exchange part of the functional
3048 :
3049 0 : exc=zero
3050 : ! loop over the spin
3051 0 : ispden=1
3052 0 : rho =rho_updn(ipts,ispden)
3053 0 : rhomot=rho_updnm1_3(ipts,ispden)
3054 0 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
3055 : ! Perdew_Wang 91 LSD
3056 0 : vxci(ipts,ispden)=four_thirds*ex_lsd
3057 0 : exc=exc+ex_lsd*rho
3058 :
3059 : ! Perdew_Wang 91 LSD
3060 : dvxci(ipts,2*ispden-1)=-four_thirds*third*&
3061 0 : & threefourth_divpi*sixpi2_1_3*rhomot*rhomot
3062 0 : dvxci(ipts,2)=zero
3063 : ! If non-spin-polarized, first component of dvxci is second
3064 : ! derivative with respect to TOTAL density.
3065 0 : dvxci(ipts,1)=dvxci(ipts,1)*half
3066 : ! Compute the second derivative of vx
3067 : ! vx^(2) = -2*vx^(1)/(3*rhotot)
3068 : ! end of loop over the spin
3069 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
3070 0 : exc=exc*2
3071 0 : exci(ipts)=exc*rhotot_inv
3072 : ! -----------------------------------------------------------------------------
3073 : ! Then takes care of the LSD correlation part of the functional
3074 :
3075 :
3076 0 : rs=rsfac*rhotmot
3077 0 : sqr_rs=sq_rsfac*rhotmo6
3078 0 : rsm1_2=sq_rsfac_inv*rhoto6
3079 :
3080 : ! Formulas A6-A8 of PW92LSD
3081 0 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
3082 0 : sqr_sqr_rs=max(1.e-15_dp,sqrt(sqr_rs))
3083 0 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs/sqr_sqr_rs)
3084 0 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+3.5_dp*ec0_b4*rs/sqr_sqr_rs)
3085 0 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
3086 : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
3087 0 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
3088 0 : ecrs0=ec0_q0*ec0_log
3089 0 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
3090 0 : ec0_q1pp=0.5_dp*ec0_aa*(-ec0_b1*rsm1_2**3+3._dp*ec0_b3*rsm1_2+8._dp*ec0_b4)
3091 : d2ecrs0_drs2= 4.0_dp*ec0_aa*ec0_a1*ec0_q1p*ec0_den &
3092 : & -ec0_q0*ec0_q1pp*ec0_den &
3093 0 : & +ec0_q0*ec0_q1p**2*ec0_den**2*(2._dp*ec0_q1+1.0_dp)
3094 :
3095 0 : mac_q0=-2.0_dp*mac_aa*(1.0_dp+mac_a1*rs)
3096 0 : mac_q1=2.0_dp*mac_aa*(mac_b1*sqr_rs+mac_b2*rs+mac_b3*rs*sqr_rs+mac_b4*rs*rs)
3097 0 : mac_q1p=mac_aa*(mac_b1*rsm1_2+2._dp*mac_b2+3._dp*mac_b3*sqr_rs+4._dp*mac_b4*rs)
3098 0 : mac_den=1.0_dp/(mac_q1*mac_q1+mac_q1)
3099 0 : mac_log=-log( mac_q1*mac_q1*mac_den )
3100 0 : macrs=mac_q0*mac_log
3101 0 : dmacrs_drs= -2.0_dp*mac_aa*mac_a1*mac_log - mac_q0*mac_q1p*mac_den
3102 :
3103 0 : ecrs=ecrs0
3104 0 : decrs_drs=decrs0_drs
3105 0 : decrs_dzeta=0.0_dp
3106 0 : d2ecrs_drs2=d2ecrs0_drs2
3107 0 : d2ecrs_dzeta2=alpha_zeta**2*(-macrs)
3108 0 : d2ecrs_drsdzeta=zero
3109 0 : zeta=0.0_dp
3110 :
3111 :
3112 : ! Add LSD correlation functional to GGA exchange functional
3113 0 : exci(ipts)=exci(ipts)+ecrs
3114 0 : vxci(ipts,1)=vxci(ipts,1)+ecrs-rs*third*decrs_drs
3115 :
3116 0 : dvcrs_drs=third*(2._dp*decrs_drs-rs*d2ecrs_drs2)
3117 : ! And d(vxc)/d(rho)=(-rs/(3*rho))*d(vxc)/d(rs)
3118 0 : d2ecrs_drho2= -rs**4*(four_pi*third)*third*dvcrs_drs
3119 0 : dvxci(ipts,1)=dvxci(ipts,1)+d2ecrs_drho2
3120 0 : dvxci(ipts,2)=dvxci(ipts,2)+d2ecrs_drho2-d2ecrs_dzeta2*rhotot_inv
3121 :
3122 : ! Correlation has been added
3123 : ! -----------------------------------------------------------------------------
3124 :
3125 : end do
3126 :
3127 : end if
3128 :
3129 :
3130 : else if (order**2>1) then
3131 : ! separate cases depending to option
3132 29093 : if(option==2 .or. option==5) then
3133 26222384 : do ipts=1,npts
3134 :
3135 26213795 : rhotot=rhoarr(ipts)
3136 26213795 : rhotmot=rhom1_3(ipts)
3137 26213795 : rhotot_inv=rhotmot*rhotmot*rhotmot
3138 26213795 : rhotmo6=sqrt(rhotmot)
3139 26213795 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
3140 : ! -----------------------------------------------------------------------
3141 : ! First take care of the exchange part of the functional
3142 :
3143 26213795 : exc=zero
3144 26213795 : dvxcdgr(ipts,3)=zero
3145 : ! loop over the spin
3146 26213795 : ispden=1
3147 26213795 : rho =rho_updn(ipts,ispden)
3148 26213795 : rhomot=rho_updnm1_3(ipts,ispden)
3149 26213795 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
3150 : ! Perdew-Burke-Ernzerhof GGA, exchange part
3151 26213795 : rho_inv=rhomot*rhomot*rhomot
3152 26213795 : coeffss=quarter*sixpi2m1_3*sixpi2m1_3*rho_inv*rho_inv*rhomot*rhomot
3153 26213795 : ss=grho2_updn(ipts,ispden)*coeffss
3154 :
3155 26213795 : divss=one/(one+mu_divkappa*ss)
3156 26213795 : dfxdss= mu*divss*divss
3157 26213795 : d2fxdss2=-mu*two*mu_divkappa*divss*divss*divss
3158 :
3159 26213795 : fx = one+kappa*(one-divss)
3160 26213795 : ex_gga= ex_lsd*fx
3161 26213795 : dssdn=-eight*third*ss*rho_inv
3162 26213795 : dfxdn = dfxdss*dssdn
3163 26213795 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
3164 : ! The new definition (v3.3) includes the division by the norm of the gradient
3165 26213795 : dssdg =two*coeffss
3166 26213795 : dfxdg=dfxdss*dssdg
3167 26213795 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
3168 26213795 : exc=exc+ex_gga*rho
3169 :
3170 : ! Perdew-Burke-Ernzerhof GGA, exchange part
3171 : ! Components 3 or 4
3172 26213795 : dvxci(ipts,2+ispden)=dvxcdgr(ipts,ispden)
3173 : ! Components 1 or 2
3174 26213795 : d2ssdn2=-11.0_dp*third*dssdn*rho_inv
3175 26213795 : d2fxdn2=d2fxdss2*dssdn**2+dfxdss*d2ssdn2
3176 : dvxci(ipts,ispden)=third*rho_inv*vxci(ipts,ispden)+&
3177 26213795 : & ex_lsd*(seven*third*dfxdn+rho*d2fxdn2)
3178 : ! Components 5 or 6
3179 26213795 : d2ssdndg=-eight*third*dssdg*rho_inv
3180 26213795 : d2fxdndg=d2fxdss2*dssdn*dssdg+dfxdss*d2ssdndg
3181 26213795 : dvxci(ipts,4+ispden)=ex_lsd*(four_thirds*dfxdg+rho*d2fxdndg)
3182 : ! Components 7 or 8
3183 26213795 : d2fxdg2=d2fxdss2*dssdg**2
3184 26213795 : dvxci(ipts,6+ispden)=ex_lsd*rho*d2fxdg2
3185 : ! For the time being, treat non-spin-polarized like spin-polarized
3186 26213795 : dvxci(ipts,2)=dvxci(ipts,1)
3187 26213795 : dvxci(ipts,4)=dvxci(ipts,3)
3188 26213795 : dvxci(ipts,6)=dvxci(ipts,5)
3189 26213795 : dvxci(ipts,8)=dvxci(ipts,7)
3190 : ! end of loop over the spin
3191 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
3192 26213795 : exc=exc*2
3193 26213795 : exci(ipts)=exc*rhotot_inv
3194 : ! -----------------------------------------------------------------------------
3195 : ! Then takes care of the LSD correlation part of the functional
3196 :
3197 26213795 : rs=rsfac*rhotmot
3198 26213795 : sqr_rs=sq_rsfac*rhotmo6
3199 26213795 : rsm1_2=sq_rsfac_inv*rhoto6
3200 :
3201 : ! Formulas A6-A8 of PW92LSD
3202 26213795 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
3203 26213795 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs)
3204 26213795 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+4._dp*ec0_b4*rs)
3205 26213795 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
3206 : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
3207 26213795 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
3208 26213795 : ecrs0=ec0_q0*ec0_log
3209 26213795 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
3210 26213795 : ec0_q1pp=0.5_dp*ec0_aa*(-ec0_b1*rsm1_2**3+3._dp*ec0_b3*rsm1_2+8._dp*ec0_b4)
3211 : d2ecrs0_drs2= 4.0_dp*ec0_aa*ec0_a1*ec0_q1p*ec0_den &
3212 : & -ec0_q0*ec0_q1pp*ec0_den &
3213 26213795 : & +ec0_q0*ec0_q1p**2*ec0_den**2*(2._dp*ec0_q1+1.0_dp)
3214 26213795 : mac_q0=-2.0_dp*mac_aa*(1.0_dp+mac_a1*rs)
3215 26213795 : mac_q1=2.0_dp*mac_aa*(mac_b1*sqr_rs+mac_b2*rs+mac_b3*rs*sqr_rs+mac_b4*rs*rs)
3216 26213795 : mac_q1p=mac_aa*(mac_b1*rsm1_2+2._dp*mac_b2+3._dp*mac_b3*sqr_rs+4._dp*mac_b4*rs)
3217 26213795 : mac_den=1.0_dp/(mac_q1*mac_q1+mac_q1)
3218 26213795 : mac_log=-log( mac_q1*mac_q1*mac_den )
3219 26213795 : macrs=mac_q0*mac_log
3220 26213795 : dmacrs_drs= -2.0_dp*mac_aa*mac_a1*mac_log - mac_q0*mac_q1p*mac_den
3221 26213795 : ecrs=ecrs0
3222 26213795 : decrs_drs=decrs0_drs
3223 26213795 : decrs_dzeta=0.0_dp
3224 26213795 : d2ecrs_drs2=d2ecrs0_drs2
3225 26213795 : d2ecrs_dzeta2=alpha_zeta**2*(-macrs)
3226 26213795 : d2ecrs_drsdzeta=zero
3227 26213795 : zeta=0.0_dp
3228 :
3229 : ! Add LSD correlation functional to GGA exchange functional
3230 26213795 : exci(ipts)=exci(ipts)+ecrs
3231 26213795 : vxci(ipts,1)=vxci(ipts,1)+ecrs-rs*third*decrs_drs
3232 :
3233 26213795 : dvcrs_drs=third*(2._dp*decrs_drs-rs*d2ecrs_drs2)
3234 : ! And d(vxc)/d(rho)=(-rs/(3*rho))*d(vxc)/d(rs)
3235 26213795 : d2ecrs_drho2= -rs**4*(four_pi*third)*third*dvcrs_drs
3236 26213795 : dvxci(ipts,9)=d2ecrs_drho2
3237 26213795 : dvxci(ipts,10)=d2ecrs_drho2
3238 26213795 : dvxci(ipts,11)=d2ecrs_drho2
3239 :
3240 :
3241 : ! -----------------------------------------------------------------------------
3242 : ! Eventually add the GGA correlation part of the PBE functional
3243 : ! Note : the computation of the potential in the spin-unpolarized
3244 : ! case could be optimized much further. Other optimizations are left to do.
3245 :
3246 26213795 : phi_zeta=1.0_dp
3247 26213795 : phip_zeta=0.0_dp
3248 26213795 : phi_zeta_inv=1.0_dp
3249 26213795 : phi_logder=0.0_dp
3250 26213795 : phi3_zeta=1.0_dp
3251 26213795 : gamphi3inv=gamma_inv
3252 26213795 : phipp_zeta=-two*ninth*alpha_zeta*alpha_zeta
3253 :
3254 : ! From ec to bb
3255 26213795 : bb=ecrs*gamphi3inv
3256 26213795 : dbb_drs=decrs_drs*gamphi3inv
3257 26213795 : dbb_dzeta=gamphi3inv*(decrs_dzeta-three*ecrs*phi_logder)
3258 26213795 : d2bb_drs2=d2ecrs_drs2*gamphi3inv
3259 26213795 : d2bb_drsdzeta=gamphi3inv*(d2ecrs_drsdzeta-three*decrs_drs*phi_logder)
3260 : d2bb_dzeta2=gamphi3inv*(d2ecrs_dzeta2-six*decrs_dzeta*phi_logder+&
3261 26213795 : & 12.0_dp*ecrs*phi_logder*phi_logder-three*ecrs*phi_zeta_inv*phipp_zeta)
3262 :
3263 : ! From bb to cc
3264 26213795 : exp_pbe=exp(-bb)
3265 26213795 : cc=one/(exp_pbe-one)
3266 26213795 : dcc_dbb=cc*cc*exp_pbe
3267 26213795 : dcc_drs=dcc_dbb*dbb_drs
3268 26213795 : dcc_dzeta=dcc_dbb*dbb_dzeta
3269 26213795 : d2cc_dbb2=cc*cc*exp_pbe*(two*cc*exp_pbe-one)
3270 26213795 : d2cc_drs2=d2cc_dbb2*dbb_drs*dbb_drs+dcc_dbb*d2bb_drs2
3271 26213795 : d2cc_drsdzeta=d2cc_dbb2*dbb_drs*dbb_dzeta+dcc_dbb*d2bb_drsdzeta
3272 26213795 : d2cc_dzeta2=d2cc_dbb2*dbb_dzeta*dbb_dzeta+dcc_dbb*d2bb_dzeta2
3273 :
3274 : ! From cc to aa
3275 26213795 : coeff_aa=beta*gamma_inv*phi_zeta_inv*phi_zeta_inv
3276 26213795 : aa=coeff_aa*cc
3277 26213795 : daa_drs=coeff_aa*dcc_drs
3278 26213795 : daa_dzeta=-two*aa*phi_logder+coeff_aa*dcc_dzeta
3279 26213795 : d2aa_drs2=coeff_aa*d2cc_drs2
3280 26213795 : d2aa_drsdzeta=-two*daa_drs*phi_logder+coeff_aa*d2cc_drsdzeta
3281 : d2aa_dzeta2=aa*(-two*phi_zeta_inv*phipp_zeta+six*phi_logder*phi_logder)+&
3282 26213795 : & coeff_aa*(-four*dcc_dzeta*phi_logder+d2cc_dzeta2)
3283 :
3284 : ! Introduce tt : do not assume that the spin-dependent gradients are collinear
3285 26213795 : grrho2=four*grho2_updn(ipts,1)
3286 26213795 : dtt_dg=two*rhotot_inv*rhotot_inv*rhotmot*coeff_tt
3287 : ! Note that tt is (the t variable of PBE divided by phi) squared
3288 26213795 : tt=half*grrho2*dtt_dg
3289 :
3290 : ! Get xx from aa and tt
3291 26213795 : xx=aa*tt
3292 26213795 : dxx_drs=daa_drs*tt
3293 26213795 : dxx_dzeta=daa_dzeta*tt
3294 26213795 : dxx_dtt=aa
3295 26213795 : d2xx_drs2=d2aa_drs2*tt
3296 26213795 : d2xx_drsdzeta=d2aa_drsdzeta*tt
3297 26213795 : d2xx_drsdtt=daa_drs
3298 26213795 : d2xx_dttdzeta=daa_dzeta
3299 26213795 : d2xx_dzeta2=d2aa_dzeta2*tt
3300 :
3301 : ! From xx to pade
3302 26213795 : pade_den=one/(one+xx*(one+xx))
3303 26213795 : pade=(one+xx)*pade_den
3304 26213795 : dpade_dxx=-xx*(two+xx)*pade_den**2
3305 26213795 : dpade_drs=dpade_dxx*dxx_drs
3306 26213795 : dpade_dtt=dpade_dxx*dxx_dtt
3307 26213795 : dpade_dzeta=dpade_dxx*dxx_dzeta
3308 26213795 : d2pade_dxx2=two*(-one+xx*xx*(three+xx))*pade_den*pade_den*pade_den
3309 26213795 : d2pade_drs2=d2pade_dxx2*dxx_drs*dxx_drs+dpade_dxx*d2xx_drs2
3310 26213795 : d2pade_drsdtt=d2pade_dxx2*dxx_drs*dxx_dtt+dpade_dxx*d2xx_drsdtt
3311 26213795 : d2pade_drsdzeta=d2pade_dxx2*dxx_drs*dxx_dzeta+dpade_dxx*d2xx_drsdzeta
3312 26213795 : d2pade_dtt2=d2pade_dxx2*dxx_dtt*dxx_dtt
3313 26213795 : d2pade_dttdzeta=d2pade_dxx2*dxx_dtt*dxx_dzeta+dpade_dxx*d2xx_dttdzeta
3314 26213795 : d2pade_dzeta2=d2pade_dxx2*dxx_dzeta*dxx_dzeta+dpade_dxx*d2xx_dzeta2
3315 :
3316 :
3317 : ! From pade to qq
3318 26213795 : coeff_qq=tt*phi_zeta_inv*phi_zeta_inv
3319 26213795 : qq=coeff_qq*pade
3320 26213795 : dqq_drs=coeff_qq*dpade_drs
3321 26213795 : dqq_dtt=pade*phi_zeta_inv*phi_zeta_inv+coeff_qq*dpade_dtt
3322 26213795 : dqq_dzeta=coeff_qq*(dpade_dzeta-two*pade*phi_logder)
3323 26213795 : d2qq_drs2=coeff_qq*d2pade_drs2
3324 26213795 : d2qq_drsdtt=phi_zeta_inv*phi_zeta_inv*(dpade_drs+tt*d2pade_drsdtt)
3325 26213795 : d2qq_drsdzeta=coeff_qq*(d2pade_drsdzeta-two*dpade_drs*phi_logder)
3326 26213795 : d2qq_dtt2=phi_zeta_inv*phi_zeta_inv*(two*dpade_dtt+tt*d2pade_dtt2)
3327 : d2qq_dttdzeta=phi_zeta_inv*phi_zeta_inv*(dpade_dzeta-two*pade*phi_logder)+&
3328 26213795 : & coeff_qq*(d2pade_dttdzeta-two*dpade_dtt*phi_logder)
3329 : d2qq_dzeta2=coeff_qq*( d2pade_dzeta2-four*dpade_dzeta*phi_logder &
3330 : & +six*pade*phi_logder*phi_logder &
3331 26213795 : & -two*pade*phi_zeta_inv*phipp_zeta)
3332 :
3333 : ! From qq to rr
3334 26213795 : arg_rr=one+beta*gamma_inv*qq
3335 26213795 : div_rr=one/arg_rr
3336 26213795 : rr=gamma*log(arg_rr)
3337 26213795 : drr_dqq=beta*div_rr
3338 26213795 : drr_drs=drr_dqq*dqq_drs
3339 26213795 : drr_dtt=drr_dqq*dqq_dtt
3340 26213795 : drr_dzeta=drr_dqq*dqq_dzeta
3341 26213795 : d2rr_dqq2=-div_rr**2*beta*beta*gamma_inv
3342 26213795 : d2rr_drs2=d2rr_dqq2*dqq_drs*dqq_drs+drr_dqq*d2qq_drs2
3343 26213795 : d2rr_drsdtt=d2rr_dqq2*dqq_drs*dqq_dtt+drr_dqq*d2qq_drsdtt
3344 26213795 : d2rr_drsdzeta=d2rr_dqq2*dqq_drs*dqq_dzeta+drr_dqq*d2qq_drsdzeta
3345 26213795 : d2rr_dtt2=d2rr_dqq2*dqq_dtt*dqq_dtt+drr_dqq*d2qq_dtt2
3346 26213795 : d2rr_dttdzeta=d2rr_dqq2*dqq_dtt*dqq_dzeta+drr_dqq*d2qq_dttdzeta
3347 26213795 : d2rr_dzeta2=d2rr_dqq2*dqq_dzeta*dqq_dzeta+drr_dqq*d2qq_dzeta2
3348 :
3349 : ! From rr to hh
3350 26213795 : hh=phi3_zeta*rr
3351 26213795 : dhh_drs=phi3_zeta*drr_drs
3352 26213795 : dhh_dtt=phi3_zeta*drr_dtt
3353 26213795 : dhh_dzeta=phi3_zeta*(drr_dzeta+three*rr*phi_logder)
3354 26213795 : d2hh_drs2=phi3_zeta*d2rr_drs2
3355 26213795 : d2hh_drsdtt=phi3_zeta*d2rr_drsdtt
3356 26213795 : d2hh_drsdzeta=phi3_zeta*(d2rr_drsdzeta+three*drr_drs*phi_logder)
3357 26213795 : d2hh_dtt2=phi3_zeta*d2rr_dtt2
3358 26213795 : d2hh_dttdzeta=phi3_zeta*(d2rr_dttdzeta+three*drr_dtt*phi_logder)
3359 : d2hh_dzeta2=phi3_zeta*(six*rr*phi_logder*phi_logder+&
3360 : & six*phi_logder*drr_dzeta+d2rr_dzeta2) &
3361 26213795 : & +three*phi_zeta*phi_zeta*rr*phipp_zeta
3362 :
3363 :
3364 : ! The GGA correlation energy is added
3365 26213795 : exci(ipts)=exci(ipts)+hh
3366 :
3367 : ! Change of variables : from (rs,zeta,tt) to (rhoup,rhodn,grrho)
3368 :
3369 :
3370 : ! From hh to the derivative of the energy wrt the density
3371 26213795 : drhohh_drho=hh-third*rs*dhh_drs-zeta*dhh_dzeta-seven*third*tt*dhh_dtt
3372 26213795 : vxci(ipts,1)=vxci(ipts,1)+drhohh_drho
3373 :
3374 : ! From hh to the derivative of the energy wrt to the gradient of the
3375 : ! density, divided by the gradient of the density
3376 : ! (The v3.3 definition includes the division by the norm of the gradient)
3377 26213795 : dvxcdgr(ipts,3)=rhotot*dtt_dg*dhh_dtt
3378 :
3379 : d2rhohh_drho2=rhotot_inv*&
3380 : & (-two*ninth*rs*dhh_drs +seven*four*ninth*tt*dhh_dtt &
3381 : & +ninth*rs*rs*d2hh_drs2+zeta*zeta*d2hh_dzeta2+(seven*third*tt)**2*d2hh_dtt2 &
3382 : & +two*third*rs*zeta*d2hh_drsdzeta+two*seven*ninth*rs*tt*d2hh_drsdtt &
3383 26213795 : & +two*seven*third*tt*zeta*d2hh_dttdzeta)
3384 : d2rhohh_drhodg=dtt_dg*(-four*third*dhh_dtt-third*rs*d2hh_drsdtt &
3385 26213795 : & -zeta*d2hh_dttdzeta-seven*third*tt*d2hh_dtt2)
3386 :
3387 : ! Component 12 : first derivative with respect to the gradient
3388 : ! of the density, div by the grad of the density
3389 26213795 : dvxci(ipts,12)=dvxcdgr(ipts,3)
3390 : ! Components 9, 10 and 11 : second derivatives with respect to the spin-density
3391 : ! Note that there is already a contribution from LSDA
3392 : dvxci(ipts,9)=dvxci(ipts,9)+d2rhohh_drho2+rhotot_inv* &
3393 : & ( d2hh_dzeta2*(one-two*zeta) &
3394 26213795 : & -two*third*rs*d2hh_drsdzeta-14.0_dp*third*tt*d2hh_dttdzeta)
3395 26213795 : dvxci(ipts,10)=dvxci(ipts,10)+d2rhohh_drho2-rhotot_inv*d2hh_dzeta2
3396 : dvxci(ipts,11)=dvxci(ipts,11)+d2rhohh_drho2+rhotot_inv* &
3397 : & ( d2hh_dzeta2*(one+two*zeta) &
3398 26213795 : & +two*third*rs*d2hh_drsdzeta+14.0_dp*third*tt*d2hh_dttdzeta)
3399 : ! Components 13 and 14 : second derivatives with respect to spin density
3400 : ! and gradient, divided by the gradient
3401 26213795 : dvxci(ipts,13)=d2rhohh_drhodg+dtt_dg*d2hh_dttdzeta
3402 26213795 : dvxci(ipts,14)=d2rhohh_drhodg-dtt_dg*d2hh_dttdzeta
3403 : ! Component 15 : derivative of the (derivative wrt the gradient div by the grad),
3404 : ! divided by the grad
3405 26213795 : dvxci(ipts,15)=rhotot*d2hh_dtt2*dtt_dg*dtt_dg
3406 :
3407 :
3408 : ! End condition of GGA
3409 :
3410 : ! Correlation has been added
3411 : ! -----------------------------------------------------------------------------
3412 :
3413 : ! vxci(ipts,2)=vxci(ipts,1)
3414 26222384 : dvxcdgr(ipts,2)=dvxcdgr(ipts,1)
3415 :
3416 : end do
3417 :
3418 : else if ((option==6) .or. (option==7)) then
3419 42254 : do ipts=1,npts
3420 :
3421 42240 : rhotot=rhoarr(ipts)
3422 42240 : rhotmot=rhom1_3(ipts)
3423 42240 : rhotot_inv=rhotmot*rhotmot*rhotmot
3424 42240 : rhotmo6=sqrt(rhotmot)
3425 42240 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
3426 : ! -----------------------------------------------------------------------
3427 : ! First take care of the exchange part of the functional
3428 :
3429 42240 : exc=zero
3430 42240 : dvxcdgr(ipts,3)=zero
3431 : ! loop over the spin
3432 42240 : ispden=1
3433 42240 : rho =rho_updn(ipts,ispden)
3434 42240 : rhomot=rho_updnm1_3(ipts,ispden)
3435 42240 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
3436 : ! Perdew-Burke-Ernzerhof GGA, exchange part
3437 42240 : rho_inv=rhomot*rhomot*rhomot
3438 42240 : coeffss=quarter*sixpi2m1_3*sixpi2m1_3*rho_inv*rho_inv*rhomot*rhomot
3439 42240 : ss=grho2_updn(ipts,ispden)*coeffss
3440 :
3441 42240 : if (option==6) then
3442 9600 : divss=exp(-mu_divkappa*ss)
3443 9600 : dfxdss= mu*divss
3444 9600 : d2fxdss2=-mu*mu_divkappa*divss
3445 :
3446 9600 : fx = one+kappa*(one-divss)
3447 9600 : ex_gga= ex_lsd*fx
3448 9600 : dssdn=-eight*third*ss*rho_inv
3449 9600 : dfxdn = dfxdss*dssdn
3450 9600 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
3451 : ! The new definition (v3.3) includes the division by the norm of the gradient
3452 9600 : dssdg =two*coeffss
3453 9600 : dfxdg=dfxdss*dssdg
3454 9600 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
3455 9600 : exc=exc+ex_gga*rho
3456 : ! This is the Wu and Cohen modification
3457 : else
3458 32640 : expss=exp(-ss)
3459 32640 : p1_wc=b_wc+(mu-b_wc)*(one-ss)*expss+two*c_wc*ss/(one+c_wc*ss*ss)
3460 : p2_wc=d_wc*(ss-two)*expss+two*c_wc/(one+c_wc*ss*ss)-&
3461 32640 : & four*c_wc*c_wc*ss*ss/((one+c_wc*ss*ss)*(one+c_wc*ss*ss))
3462 32640 : divss=one/(one+(b_wc*ss+d_wc*ss*expss+log(one+c_wc*ss*ss))/kappa)
3463 32640 : dfxdss=p1_wc*divss*divss
3464 32640 : d2fxdss2=p2_wc*divss*divss-two*divss*divss*divss*p1_wc*p1_wc/kappa
3465 :
3466 32640 : fx = one+kappa*(one-divss)
3467 32640 : ex_gga= ex_lsd*fx
3468 32640 : dssdn=-eight*third*ss*rho_inv
3469 32640 : dfxdn = dfxdss*dssdn
3470 32640 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
3471 : ! The new definition (v3.3) includes the division by the norm of the gradient
3472 32640 : dssdg =two*coeffss
3473 32640 : dfxdg=dfxdss*dssdg
3474 32640 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
3475 32640 : exc=exc+ex_gga*rho
3476 : end if
3477 :
3478 : ! Perdew-Burke-Ernzerhof GGA, exchange part
3479 : ! Components 3 or 4
3480 42240 : dvxci(ipts,2+ispden)=dvxcdgr(ipts,ispden)
3481 : ! Components 1 or 2
3482 42240 : d2ssdn2=-11.0_dp*third*dssdn*rho_inv
3483 42240 : d2fxdn2=d2fxdss2*dssdn**2+dfxdss*d2ssdn2
3484 : dvxci(ipts,ispden)=third*rho_inv*vxci(ipts,ispden)+&
3485 42240 : & ex_lsd*(seven*third*dfxdn+rho*d2fxdn2)
3486 : ! Components 5 or 6
3487 42240 : d2ssdndg=-eight*third*dssdg*rho_inv
3488 42240 : d2fxdndg=d2fxdss2*dssdn*dssdg+dfxdss*d2ssdndg
3489 42240 : dvxci(ipts,4+ispden)=ex_lsd*(four_thirds*dfxdg+rho*d2fxdndg)
3490 : ! Components 7 or 8
3491 42240 : d2fxdg2=d2fxdss2*dssdg**2
3492 42240 : dvxci(ipts,6+ispden)=ex_lsd*rho*d2fxdg2
3493 : ! For the time being, treat non-spin-polarized like spin-polarized
3494 42240 : dvxci(ipts,2)=dvxci(ipts,1)
3495 42240 : dvxci(ipts,4)=dvxci(ipts,3)
3496 42240 : dvxci(ipts,6)=dvxci(ipts,5)
3497 42240 : dvxci(ipts,8)=dvxci(ipts,7)
3498 : ! end of loop over the spin
3499 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
3500 42240 : exc=exc*2
3501 42240 : exci(ipts)=exc*rhotot_inv
3502 : ! -----------------------------------------------------------------------------
3503 : ! Then takes care of the LSD correlation part of the functional
3504 :
3505 :
3506 42240 : rs=rsfac*rhotmot
3507 42240 : sqr_rs=sq_rsfac*rhotmo6
3508 42240 : rsm1_2=sq_rsfac_inv*rhoto6
3509 :
3510 : ! Formulas A6-A8 of PW92LSD
3511 42240 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
3512 42240 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs)
3513 42240 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+4._dp*ec0_b4*rs)
3514 42240 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
3515 : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
3516 42240 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
3517 42240 : ecrs0=ec0_q0*ec0_log
3518 42240 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
3519 42240 : ec0_q1pp=0.5_dp*ec0_aa*(-ec0_b1*rsm1_2**3+3._dp*ec0_b3*rsm1_2+8._dp*ec0_b4)
3520 : d2ecrs0_drs2= 4.0_dp*ec0_aa*ec0_a1*ec0_q1p*ec0_den &
3521 : & -ec0_q0*ec0_q1pp*ec0_den &
3522 42240 : & +ec0_q0*ec0_q1p**2*ec0_den**2*(2._dp*ec0_q1+1.0_dp)
3523 42240 : mac_q0=-2.0_dp*mac_aa*(1.0_dp+mac_a1*rs)
3524 42240 : mac_q1=2.0_dp*mac_aa*(mac_b1*sqr_rs+mac_b2*rs+mac_b3*rs*sqr_rs+mac_b4*rs*rs)
3525 42240 : mac_q1p=mac_aa*(mac_b1*rsm1_2+2._dp*mac_b2+3._dp*mac_b3*sqr_rs+4._dp*mac_b4*rs)
3526 42240 : mac_den=1.0_dp/(mac_q1*mac_q1+mac_q1)
3527 42240 : mac_log=-log( mac_q1*mac_q1*mac_den )
3528 42240 : macrs=mac_q0*mac_log
3529 42240 : dmacrs_drs= -2.0_dp*mac_aa*mac_a1*mac_log - mac_q0*mac_q1p*mac_den
3530 42240 : ecrs=ecrs0
3531 42240 : decrs_drs=decrs0_drs
3532 42240 : decrs_dzeta=0.0_dp
3533 42240 : d2ecrs_drs2=d2ecrs0_drs2
3534 42240 : d2ecrs_dzeta2=alpha_zeta**2*(-macrs)
3535 42240 : d2ecrs_drsdzeta=zero
3536 42240 : zeta=0.0_dp
3537 :
3538 : ! Add LSD correlation functional to GGA exchange functional
3539 42240 : exci(ipts)=exci(ipts)+ecrs
3540 42240 : vxci(ipts,1)=vxci(ipts,1)+ecrs-rs*third*decrs_drs
3541 :
3542 42240 : dvcrs_drs=third*(2._dp*decrs_drs-rs*d2ecrs_drs2)
3543 : ! And d(vxc)/d(rho)=(-rs/(3*rho))*d(vxc)/d(rs)
3544 42240 : d2ecrs_drho2= -rs**4*(four_pi*third)*third*dvcrs_drs
3545 42240 : dvxci(ipts,9)=d2ecrs_drho2
3546 42240 : dvxci(ipts,10)=d2ecrs_drho2
3547 42240 : dvxci(ipts,11)=d2ecrs_drho2
3548 :
3549 :
3550 : ! -----------------------------------------------------------------------------
3551 : ! Eventually add the GGA correlation part of the PBE functional
3552 : ! Note : the computation of the potential in the spin-unpolarized
3553 : ! case could be optimized much further. Other optimizations are left to do.
3554 :
3555 42240 : phi_zeta=1.0_dp
3556 42240 : phip_zeta=0.0_dp
3557 42240 : phi_zeta_inv=1.0_dp
3558 42240 : phi_logder=0.0_dp
3559 42240 : phi3_zeta=1.0_dp
3560 42240 : gamphi3inv=gamma_inv
3561 42240 : phipp_zeta=-two*ninth*alpha_zeta*alpha_zeta
3562 :
3563 : ! From ec to bb
3564 42240 : bb=ecrs*gamphi3inv
3565 42240 : dbb_drs=decrs_drs*gamphi3inv
3566 42240 : dbb_dzeta=gamphi3inv*(decrs_dzeta-three*ecrs*phi_logder)
3567 42240 : d2bb_drs2=d2ecrs_drs2*gamphi3inv
3568 42240 : d2bb_drsdzeta=gamphi3inv*(d2ecrs_drsdzeta-three*decrs_drs*phi_logder)
3569 : d2bb_dzeta2=gamphi3inv*(d2ecrs_dzeta2-six*decrs_dzeta*phi_logder+&
3570 42240 : & 12.0_dp*ecrs*phi_logder*phi_logder-three*ecrs*phi_zeta_inv*phipp_zeta)
3571 :
3572 : ! From bb to cc
3573 42240 : exp_pbe=exp(-bb)
3574 42240 : cc=one/(exp_pbe-one)
3575 42240 : dcc_dbb=cc*cc*exp_pbe
3576 42240 : dcc_drs=dcc_dbb*dbb_drs
3577 42240 : dcc_dzeta=dcc_dbb*dbb_dzeta
3578 42240 : d2cc_dbb2=cc*cc*exp_pbe*(two*cc*exp_pbe-one)
3579 42240 : d2cc_drs2=d2cc_dbb2*dbb_drs*dbb_drs+dcc_dbb*d2bb_drs2
3580 42240 : d2cc_drsdzeta=d2cc_dbb2*dbb_drs*dbb_dzeta+dcc_dbb*d2bb_drsdzeta
3581 42240 : d2cc_dzeta2=d2cc_dbb2*dbb_dzeta*dbb_dzeta+dcc_dbb*d2bb_dzeta2
3582 :
3583 : ! From cc to aa
3584 42240 : coeff_aa=beta*gamma_inv*phi_zeta_inv*phi_zeta_inv
3585 42240 : aa=coeff_aa*cc
3586 42240 : daa_drs=coeff_aa*dcc_drs
3587 42240 : daa_dzeta=-two*aa*phi_logder+coeff_aa*dcc_dzeta
3588 42240 : d2aa_drs2=coeff_aa*d2cc_drs2
3589 42240 : d2aa_drsdzeta=-two*daa_drs*phi_logder+coeff_aa*d2cc_drsdzeta
3590 : d2aa_dzeta2=aa*(-two*phi_zeta_inv*phipp_zeta+six*phi_logder*phi_logder)+&
3591 42240 : & coeff_aa*(-four*dcc_dzeta*phi_logder+d2cc_dzeta2)
3592 :
3593 : ! Introduce tt : do not assume that the spin-dependent gradients are collinear
3594 42240 : grrho2=four*grho2_updn(ipts,1)
3595 42240 : dtt_dg=two*rhotot_inv*rhotot_inv*rhotmot*coeff_tt
3596 : ! Note that tt is (the t variable of PBE divided by phi) squared
3597 42240 : tt=half*grrho2*dtt_dg
3598 :
3599 : ! Get xx from aa and tt
3600 42240 : xx=aa*tt
3601 42240 : dxx_drs=daa_drs*tt
3602 42240 : dxx_dzeta=daa_dzeta*tt
3603 42240 : dxx_dtt=aa
3604 42240 : d2xx_drs2=d2aa_drs2*tt
3605 42240 : d2xx_drsdzeta=d2aa_drsdzeta*tt
3606 42240 : d2xx_drsdtt=daa_drs
3607 42240 : d2xx_dttdzeta=daa_dzeta
3608 42240 : d2xx_dzeta2=d2aa_dzeta2*tt
3609 :
3610 : ! From xx to pade
3611 42240 : pade_den=one/(one+xx*(one+xx))
3612 42240 : pade=(one+xx)*pade_den
3613 42240 : dpade_dxx=-xx*(two+xx)*pade_den**2
3614 42240 : dpade_drs=dpade_dxx*dxx_drs
3615 42240 : dpade_dtt=dpade_dxx*dxx_dtt
3616 42240 : dpade_dzeta=dpade_dxx*dxx_dzeta
3617 42240 : d2pade_dxx2=two*(-one+xx*xx*(three+xx))*pade_den*pade_den*pade_den
3618 42240 : d2pade_drs2=d2pade_dxx2*dxx_drs*dxx_drs+dpade_dxx*d2xx_drs2
3619 42240 : d2pade_drsdtt=d2pade_dxx2*dxx_drs*dxx_dtt+dpade_dxx*d2xx_drsdtt
3620 42240 : d2pade_drsdzeta=d2pade_dxx2*dxx_drs*dxx_dzeta+dpade_dxx*d2xx_drsdzeta
3621 42240 : d2pade_dtt2=d2pade_dxx2*dxx_dtt*dxx_dtt
3622 42240 : d2pade_dttdzeta=d2pade_dxx2*dxx_dtt*dxx_dzeta+dpade_dxx*d2xx_dttdzeta
3623 42240 : d2pade_dzeta2=d2pade_dxx2*dxx_dzeta*dxx_dzeta+dpade_dxx*d2xx_dzeta2
3624 :
3625 :
3626 : ! From pade to qq
3627 42240 : coeff_qq=tt*phi_zeta_inv*phi_zeta_inv
3628 42240 : qq=coeff_qq*pade
3629 42240 : dqq_drs=coeff_qq*dpade_drs
3630 42240 : dqq_dtt=pade*phi_zeta_inv*phi_zeta_inv+coeff_qq*dpade_dtt
3631 42240 : dqq_dzeta=coeff_qq*(dpade_dzeta-two*pade*phi_logder)
3632 42240 : d2qq_drs2=coeff_qq*d2pade_drs2
3633 42240 : d2qq_drsdtt=phi_zeta_inv*phi_zeta_inv*(dpade_drs+tt*d2pade_drsdtt)
3634 42240 : d2qq_drsdzeta=coeff_qq*(d2pade_drsdzeta-two*dpade_drs*phi_logder)
3635 42240 : d2qq_dtt2=phi_zeta_inv*phi_zeta_inv*(two*dpade_dtt+tt*d2pade_dtt2)
3636 : d2qq_dttdzeta=phi_zeta_inv*phi_zeta_inv*(dpade_dzeta-two*pade*phi_logder)+&
3637 42240 : & coeff_qq*(d2pade_dttdzeta-two*dpade_dtt*phi_logder)
3638 : d2qq_dzeta2=coeff_qq*( d2pade_dzeta2-four*dpade_dzeta*phi_logder &
3639 : & +six*pade*phi_logder*phi_logder &
3640 42240 : & -two*pade*phi_zeta_inv*phipp_zeta)
3641 :
3642 : ! From qq to rr
3643 42240 : arg_rr=one+beta*gamma_inv*qq
3644 42240 : div_rr=one/arg_rr
3645 42240 : rr=gamma*log(arg_rr)
3646 42240 : drr_dqq=beta*div_rr
3647 42240 : drr_drs=drr_dqq*dqq_drs
3648 42240 : drr_dtt=drr_dqq*dqq_dtt
3649 42240 : drr_dzeta=drr_dqq*dqq_dzeta
3650 42240 : d2rr_dqq2=-div_rr**2*beta*beta*gamma_inv
3651 42240 : d2rr_drs2=d2rr_dqq2*dqq_drs*dqq_drs+drr_dqq*d2qq_drs2
3652 42240 : d2rr_drsdtt=d2rr_dqq2*dqq_drs*dqq_dtt+drr_dqq*d2qq_drsdtt
3653 42240 : d2rr_drsdzeta=d2rr_dqq2*dqq_drs*dqq_dzeta+drr_dqq*d2qq_drsdzeta
3654 42240 : d2rr_dtt2=d2rr_dqq2*dqq_dtt*dqq_dtt+drr_dqq*d2qq_dtt2
3655 42240 : d2rr_dttdzeta=d2rr_dqq2*dqq_dtt*dqq_dzeta+drr_dqq*d2qq_dttdzeta
3656 42240 : d2rr_dzeta2=d2rr_dqq2*dqq_dzeta*dqq_dzeta+drr_dqq*d2qq_dzeta2
3657 :
3658 : ! From rr to hh
3659 42240 : hh=phi3_zeta*rr
3660 42240 : dhh_drs=phi3_zeta*drr_drs
3661 42240 : dhh_dtt=phi3_zeta*drr_dtt
3662 42240 : dhh_dzeta=phi3_zeta*(drr_dzeta+three*rr*phi_logder)
3663 42240 : d2hh_drs2=phi3_zeta*d2rr_drs2
3664 42240 : d2hh_drsdtt=phi3_zeta*d2rr_drsdtt
3665 42240 : d2hh_drsdzeta=phi3_zeta*(d2rr_drsdzeta+three*drr_drs*phi_logder)
3666 42240 : d2hh_dtt2=phi3_zeta*d2rr_dtt2
3667 42240 : d2hh_dttdzeta=phi3_zeta*(d2rr_dttdzeta+three*drr_dtt*phi_logder)
3668 : d2hh_dzeta2=phi3_zeta*(six*rr*phi_logder*phi_logder+&
3669 : & six*phi_logder*drr_dzeta+d2rr_dzeta2) &
3670 42240 : & +three*phi_zeta*phi_zeta*rr*phipp_zeta
3671 :
3672 :
3673 : ! The GGA correlation energy is added
3674 42240 : exci(ipts)=exci(ipts)+hh
3675 :
3676 : ! Change of variables : from (rs,zeta,tt) to (rhoup,rhodn,grrho)
3677 :
3678 :
3679 : ! From hh to the derivative of the energy wrt the density
3680 42240 : drhohh_drho=hh-third*rs*dhh_drs-zeta*dhh_dzeta-seven*third*tt*dhh_dtt
3681 42240 : vxci(ipts,1)=vxci(ipts,1)+drhohh_drho
3682 :
3683 : ! From hh to the derivative of the energy wrt to the gradient of the
3684 : ! density, divided by the gradient of the density
3685 : ! (The v3.3 definition includes the division by the norm of the gradient)
3686 42240 : dvxcdgr(ipts,3)=rhotot*dtt_dg*dhh_dtt
3687 :
3688 : d2rhohh_drho2=rhotot_inv*&
3689 : & (-two*ninth*rs*dhh_drs +seven*four*ninth*tt*dhh_dtt &
3690 : & +ninth*rs*rs*d2hh_drs2+zeta*zeta*d2hh_dzeta2+(seven*third*tt)**2*d2hh_dtt2 &
3691 : & +two*third*rs*zeta*d2hh_drsdzeta+two*seven*ninth*rs*tt*d2hh_drsdtt &
3692 42240 : & +two*seven*third*tt*zeta*d2hh_dttdzeta)
3693 : d2rhohh_drhodg=dtt_dg*(-four*third*dhh_dtt-third*rs*d2hh_drsdtt &
3694 42240 : & -zeta*d2hh_dttdzeta-seven*third*tt*d2hh_dtt2)
3695 :
3696 : ! Component 12 : first derivative with respect to the gradient
3697 : ! of the density, div by the grad of the density
3698 42240 : dvxci(ipts,12)=dvxcdgr(ipts,3)
3699 : ! Components 9, 10 and 11 : second derivatives with respect to the spin-density
3700 : ! Note that there is already a contribution from LSDA
3701 : dvxci(ipts,9)=dvxci(ipts,9)+d2rhohh_drho2+rhotot_inv* &
3702 : & ( d2hh_dzeta2*(one-two*zeta) &
3703 42240 : & -two*third*rs*d2hh_drsdzeta-14.0_dp*third*tt*d2hh_dttdzeta)
3704 42240 : dvxci(ipts,10)=dvxci(ipts,10)+d2rhohh_drho2-rhotot_inv*d2hh_dzeta2
3705 : dvxci(ipts,11)=dvxci(ipts,11)+d2rhohh_drho2+rhotot_inv* &
3706 : & ( d2hh_dzeta2*(one+two*zeta) &
3707 42240 : & +two*third*rs*d2hh_drsdzeta+14.0_dp*third*tt*d2hh_dttdzeta)
3708 : ! Components 13 and 14 : second derivatives with respect to spin density
3709 : ! and gradient, divided by the gradient
3710 42240 : dvxci(ipts,13)=d2rhohh_drhodg+dtt_dg*d2hh_dttdzeta
3711 42240 : dvxci(ipts,14)=d2rhohh_drhodg-dtt_dg*d2hh_dttdzeta
3712 : ! Component 15 : derivative of the (derivative wrt the gradient div by the grad),
3713 : ! divided by the grad
3714 42240 : dvxci(ipts,15)=rhotot*d2hh_dtt2*dtt_dg*dtt_dg
3715 :
3716 :
3717 : ! End condition of GGA
3718 :
3719 : ! Correlation has been added
3720 : ! -----------------------------------------------------------------------------
3721 :
3722 : ! vxci(ipts,2)=vxci(ipts,1)
3723 42254 : dvxcdgr(ipts,2)=dvxcdgr(ipts,1)
3724 :
3725 : end do
3726 :
3727 : else if (option==-1) then
3728 0 : do ipts=1,npts
3729 :
3730 0 : rhotot=rhoarr(ipts)
3731 0 : rhotmot=rhom1_3(ipts)
3732 0 : rhotot_inv=rhotmot*rhotmot*rhotmot
3733 0 : rhotmo6=sqrt(rhotmot)
3734 0 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
3735 : ! -----------------------------------------------------------------------
3736 : ! First take care of the exchange part of the functional
3737 :
3738 0 : exc=zero
3739 : ! loop over the spin
3740 0 : ispden=1
3741 0 : rho =rho_updn(ipts,ispden)
3742 0 : rhomot=rho_updnm1_3(ipts,ispden)
3743 0 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
3744 : ! Perdew_Wang 91 LSD
3745 0 : vxci(ipts,ispden)=four_thirds*ex_lsd
3746 0 : exc=exc+ex_lsd*rho
3747 :
3748 : ! Perdew_Wang 91 LSD
3749 : dvxci(ipts,2*ispden-1)=-four_thirds*third*&
3750 0 : & threefourth_divpi*sixpi2_1_3*rhomot*rhomot
3751 0 : dvxci(ipts,2)=zero
3752 : ! If non-spin-polarized, first component of dvxci is second
3753 : ! derivative with respect to TOTAL density.
3754 0 : dvxci(ipts,1)=dvxci(ipts,1)*half
3755 : ! Compute the second derivative of vx
3756 : ! vx^(2) = -2*vx^(1)/(3*rhotot)
3757 : ! end of loop over the spin
3758 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
3759 0 : exc=exc*2
3760 0 : exci(ipts)=exc*rhotot_inv
3761 : ! -----------------------------------------------------------------------------
3762 : ! Then takes care of the LSD correlation part of the functional
3763 :
3764 : end do
3765 :
3766 : else if (option==-2) then
3767 4158971 : do ipts=1,npts
3768 :
3769 4157876 : rhotot=rhoarr(ipts)
3770 4157876 : rhotmot=rhom1_3(ipts)
3771 4157876 : rhotot_inv=rhotmot*rhotmot*rhotmot
3772 4157876 : rhotmo6=sqrt(rhotmot)
3773 4157876 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
3774 : ! -----------------------------------------------------------------------
3775 : ! First take care of the exchange part of the functional
3776 :
3777 4157876 : exc=zero
3778 4157876 : dvxcdgr(ipts,3)=zero
3779 : ! loop over the spin
3780 4157876 : ispden=1
3781 4157876 : rho =rho_updn(ipts,ispden)
3782 4157876 : rhomot=rho_updnm1_3(ipts,ispden)
3783 4157876 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
3784 : ! Perdew-Burke-Ernzerhof GGA, exchange part
3785 4157876 : rho_inv=rhomot*rhomot*rhomot
3786 4157876 : coeffss=quarter*sixpi2m1_3*sixpi2m1_3*rho_inv*rho_inv*rhomot*rhomot
3787 4157876 : ss=grho2_updn(ipts,ispden)*coeffss
3788 4157876 : divss=one/(one+mu_divkappa*ss)
3789 4157876 : dfxdss= mu*divss*divss
3790 4157876 : d2fxdss2=-mu*two*mu_divkappa*divss*divss*divss
3791 4157876 : fx = one+kappa*(one-divss)
3792 4157876 : ex_gga= ex_lsd*fx
3793 4157876 : dssdn=-eight*third*ss*rho_inv
3794 4157876 : dfxdn = dfxdss*dssdn
3795 4157876 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
3796 : ! The new definition (v3.3) includes the division by the norm of the gradient
3797 4157876 : dssdg =two*coeffss
3798 4157876 : dfxdg=dfxdss*dssdg
3799 4157876 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
3800 4157876 : exc=exc+ex_gga*rho
3801 :
3802 : ! Perdew-Burke-Ernzerhof GGA, exchange part
3803 : ! Components 3 or 4
3804 4157876 : dvxci(ipts,2+ispden)=dvxcdgr(ipts,ispden)
3805 : ! Components 1 or 2
3806 4157876 : d2ssdn2=-11.0_dp*third*dssdn*rho_inv
3807 4157876 : d2fxdn2=d2fxdss2*dssdn**2+dfxdss*d2ssdn2
3808 : dvxci(ipts,ispden)=third*rho_inv*vxci(ipts,ispden)+&
3809 4157876 : & ex_lsd*(seven*third*dfxdn+rho*d2fxdn2)
3810 : ! Components 5 or 6
3811 4157876 : d2ssdndg=-eight*third*dssdg*rho_inv
3812 4157876 : d2fxdndg=d2fxdss2*dssdn*dssdg+dfxdss*d2ssdndg
3813 4157876 : dvxci(ipts,4+ispden)=ex_lsd*(four_thirds*dfxdg+rho*d2fxdndg)
3814 : ! Components 7 or 8
3815 4157876 : d2fxdg2=d2fxdss2*dssdg**2
3816 4157876 : dvxci(ipts,6+ispden)=ex_lsd*rho*d2fxdg2
3817 : ! For the time being, treat non-spin-polarized like spin-polarized
3818 4157876 : dvxci(ipts,2)=dvxci(ipts,1)
3819 4157876 : dvxci(ipts,4)=dvxci(ipts,3)
3820 4157876 : dvxci(ipts,6)=dvxci(ipts,5)
3821 4157876 : dvxci(ipts,8)=dvxci(ipts,7)
3822 : ! end of loop over the spin
3823 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
3824 4157876 : exc=exc*2
3825 4157876 : exci(ipts)=exc*rhotot_inv
3826 : ! -----------------------------------------------------------------------------
3827 : ! Then takes care of the LSD correlation part of the functional
3828 :
3829 : ! Correlation has been added
3830 : ! -----------------------------------------------------------------------------
3831 :
3832 : ! vxci(ipts,2)=vxci(ipts,1)
3833 4158971 : dvxcdgr(ipts,2)=dvxcdgr(ipts,1)
3834 :
3835 : end do
3836 :
3837 :
3838 : else if(option==-4) then
3839 :
3840 :
3841 0 : do ipts=1,npts
3842 :
3843 0 : rhotot=rhoarr(ipts)
3844 0 : rhotmot=rhom1_3(ipts)
3845 0 : rhotot_inv=rhotmot*rhotmot*rhotmot
3846 0 : rhotmo6=sqrt(rhotmot)
3847 0 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
3848 : ! -----------------------------------------------------------------------
3849 : ! First take care of the exchange part of the functional
3850 :
3851 0 : exc=zero
3852 0 : dvxcdgr(ipts,3)=zero
3853 : ! loop over the spin
3854 0 : ispden=1
3855 0 : rho =rho_updn(ipts,ispden)
3856 0 : rhomot=rho_updnm1_3(ipts,ispden)
3857 0 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
3858 : ! VALENTINO R. COOPER C09x GGA, This is an exchange term proposed
3859 : ! to use together with vdw-DF (see above).
3860 0 : rho_inv=rhomot*rhomot*rhomot
3861 0 : coeffss=quarter*sixpi2m1_3*sixpi2m1_3*rho_inv*rho_inv*rhomot*rhomot
3862 : ! the quarter that is lacking is compensated by the grho2_updn in the
3863 : ! next line.
3864 0 : ss=grho2_updn(ipts,ispden)*coeffss
3865 0 : alphs2=alpha_c09*ss
3866 0 : alphmu=alpha_c09*mu_c09
3867 : dfxdss= mu_c09*exp(-alphs2)*(one-alphs2)+&
3868 0 : & kappa*alpha_c09*exp(-alphs2/two)/two
3869 : d2fxdss2=-alphmu*exp(-alphs2)*(two-alphs2)-&
3870 0 : & kappa*(alpha_c09**two)*exp(alphs2/two)/four
3871 0 : fx = one+mu_c09*ss*exp(-alphs2)+kappa*(one-exp(-alphs2/two))
3872 0 : ex_gga= ex_lsd*fx
3873 0 : dssdn=-eight*third*ss*rho_inv
3874 0 : dfxdn = dfxdss*dssdn
3875 0 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
3876 : ! The new definition (v3.3) includes the division by the norm of the gradient
3877 0 : dssdg =two*coeffss
3878 0 : dfxdg=dfxdss*dssdg
3879 0 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
3880 0 : exc=exc+ex_gga*rho
3881 :
3882 : ! Cooper C09x GGA exchange
3883 : ! Components 3 or 4
3884 0 : dvxci(ipts,2+ispden)=dvxcdgr(ipts,ispden)
3885 : ! Components 1 or 2
3886 0 : d2ssdn2=-11.0_dp*third*dssdn*rho_inv
3887 0 : d2fxdn2=d2fxdss2*dssdn**2+dfxdss*d2ssdn2
3888 : dvxci(ipts,ispden)=third*rho_inv*vxci(ipts,ispden)+&
3889 0 : & ex_lsd*(seven*third*dfxdn+rho*d2fxdn2)
3890 : ! Components 5 or 6
3891 0 : d2ssdndg=-eight*third*dssdg*rho_inv
3892 0 : d2fxdndg=d2fxdss2*dssdn*dssdg+dfxdss*d2ssdndg
3893 0 : dvxci(ipts,4+ispden)=ex_lsd*(four_thirds*dfxdg+rho*d2fxdndg)
3894 : ! Components 7 or 8
3895 0 : d2fxdg2=d2fxdss2*dssdg**2
3896 0 : dvxci(ipts,6+ispden)=ex_lsd*rho*d2fxdg2
3897 : ! For the time being, treat non-spin-polarized like spin-polarized
3898 0 : dvxci(ipts,2)=dvxci(ipts,1)
3899 0 : dvxci(ipts,4)=dvxci(ipts,3)
3900 0 : dvxci(ipts,6)=dvxci(ipts,5)
3901 0 : dvxci(ipts,8)=dvxci(ipts,7)
3902 :
3903 : ! end of loop over the spin
3904 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
3905 0 : exc=exc*2
3906 0 : exci(ipts)=exc*rhotot_inv
3907 : ! -----------------------------------------------------------------------------
3908 : ! Then takes care of the LSD correlation part of the functional
3909 :
3910 : ! Correlation has been added
3911 : ! -----------------------------------------------------------------------------
3912 :
3913 : ! vxci(ipts,2)=vxci(ipts,1)
3914 0 : dvxcdgr(ipts,2)=dvxcdgr(ipts,1)
3915 :
3916 : end do
3917 :
3918 :
3919 : else if (option==1) then
3920 69245392 : do ipts=1,npts
3921 :
3922 69225997 : rhotot=rhoarr(ipts)
3923 69225997 : rhotmot=rhom1_3(ipts)
3924 69225997 : rhotot_inv=rhotmot*rhotmot*rhotmot
3925 69225997 : rhotmo6=sqrt(rhotmot)
3926 69225997 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
3927 : ! -----------------------------------------------------------------------
3928 : ! First take care of the exchange part of the functional
3929 :
3930 69225997 : exc=zero
3931 : ! loop over the spin
3932 69225997 : ispden=1
3933 69225997 : rho =rho_updn(ipts,ispden)
3934 69225997 : rhomot=rho_updnm1_3(ipts,ispden)
3935 69225997 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
3936 : ! Perdew_Wang 91 LSD
3937 69225997 : vxci(ipts,ispden)=four_thirds*ex_lsd
3938 69225997 : exc=exc+ex_lsd*rho
3939 :
3940 : ! Perdew_Wang 91 LSD
3941 : dvxci(ipts,2*ispden-1)=-four_thirds*third*&
3942 69225997 : & threefourth_divpi*sixpi2_1_3*rhomot*rhomot
3943 69225997 : dvxci(ipts,2)=zero
3944 : ! If non-spin-polarized, first component of dvxci is second
3945 : ! derivative with respect to TOTAL density.
3946 69225997 : dvxci(ipts,1)=dvxci(ipts,1)*half
3947 : ! Compute the second derivative of vx
3948 : ! vx^(2) = -2*vx^(1)/(3*rhotot)
3949 : ! end of loop over the spin
3950 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
3951 69225997 : exc=exc*2
3952 69225997 : exci(ipts)=exc*rhotot_inv
3953 : ! -----------------------------------------------------------------------------
3954 : ! Then takes care of the LSD correlation part of the functional
3955 :
3956 :
3957 69225997 : rs=rsfac*rhotmot
3958 69225997 : sqr_rs=sq_rsfac*rhotmo6
3959 69225997 : rsm1_2=sq_rsfac_inv*rhoto6
3960 :
3961 : ! Formulas A6-A8 of PW92LSD
3962 69225997 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
3963 69225997 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs)
3964 69225997 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+4._dp*ec0_b4*rs)
3965 69225997 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
3966 : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
3967 69225997 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
3968 69225997 : ecrs0=ec0_q0*ec0_log
3969 69225997 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
3970 69225997 : ec0_q1pp=0.5_dp*ec0_aa*(-ec0_b1*rsm1_2**3+3._dp*ec0_b3*rsm1_2+8._dp*ec0_b4)
3971 : d2ecrs0_drs2= 4.0_dp*ec0_aa*ec0_a1*ec0_q1p*ec0_den &
3972 : & -ec0_q0*ec0_q1pp*ec0_den &
3973 69225997 : & +ec0_q0*ec0_q1p**2*ec0_den**2*(2._dp*ec0_q1+1.0_dp)
3974 69225997 : mac_q0=-2.0_dp*mac_aa*(1.0_dp+mac_a1*rs)
3975 69225997 : mac_q1=2.0_dp*mac_aa*(mac_b1*sqr_rs+mac_b2*rs+mac_b3*rs*sqr_rs+mac_b4*rs*rs)
3976 69225997 : mac_q1p=mac_aa*(mac_b1*rsm1_2+2._dp*mac_b2+3._dp*mac_b3*sqr_rs+4._dp*mac_b4*rs)
3977 69225997 : mac_den=1.0_dp/(mac_q1*mac_q1+mac_q1)
3978 69225997 : mac_log=-log( mac_q1*mac_q1*mac_den )
3979 69225997 : macrs=mac_q0*mac_log
3980 69225997 : dmacrs_drs= -2.0_dp*mac_aa*mac_a1*mac_log - mac_q0*mac_q1p*mac_den
3981 69225997 : ecrs=ecrs0
3982 69225997 : decrs_drs=decrs0_drs
3983 69225997 : decrs_dzeta=0.0_dp
3984 69225997 : d2ecrs_drs2=d2ecrs0_drs2
3985 69225997 : d2ecrs_dzeta2=alpha_zeta**2*(-macrs)
3986 69225997 : d2ecrs_drsdzeta=zero
3987 69225997 : zeta=0.0_dp
3988 :
3989 : ! Add LSD correlation functional to GGA exchange functional
3990 69225997 : exci(ipts)=exci(ipts)+ecrs
3991 69225997 : vxci(ipts,1)=vxci(ipts,1)+ecrs-rs*third*decrs_drs
3992 :
3993 69225997 : dvcrs_drs=third*(2._dp*decrs_drs-rs*d2ecrs_drs2)
3994 : ! And d(vxc)/d(rho)=(-rs/(3*rho))*d(vxc)/d(rs)
3995 69225997 : d2ecrs_drho2= -rs**4*(four_pi*third)*third*dvcrs_drs
3996 :
3997 69245392 : dvxci(ipts,1)=dvxci(ipts,1)+d2ecrs_drho2
3998 :
3999 : end do
4000 : else if (option==3) then
4001 0 : do ipts=1,npts
4002 :
4003 0 : rhotot=rhoarr(ipts)
4004 0 : rhotmot=rhom1_3(ipts)
4005 0 : rhotot_inv=rhotmot*rhotmot*rhotmot
4006 0 : rhotmo6=sqrt(rhotmot)
4007 0 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
4008 : ! -----------------------------------------------------------------------
4009 : ! First take care of the exchange part of the functional
4010 :
4011 0 : exc=zero
4012 : ! loop over the spin
4013 0 : ispden=1
4014 0 : rho =rho_updn(ipts,ispden)
4015 0 : rhomot=rho_updnm1_3(ipts,ispden)
4016 0 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
4017 : ! Perdew_Wang 91 LSD
4018 0 : vxci(ipts,ispden)=four_thirds*ex_lsd
4019 0 : exc=exc+ex_lsd*rho
4020 :
4021 : ! Perdew_Wang 91 LSD
4022 : dvxci(ipts,2*ispden-1)=-four_thirds*third*&
4023 0 : & threefourth_divpi*sixpi2_1_3*rhomot*rhomot
4024 0 : dvxci(ipts,2)=zero
4025 : ! If non-spin-polarized, first component of dvxci is second
4026 : ! derivative with respect to TOTAL density.
4027 0 : dvxci(ipts,1)=dvxci(ipts,1)*half
4028 : ! Compute the second derivative of vx
4029 : ! vx^(2) = -2*vx^(1)/(3*rhotot)
4030 : ! end of loop over the spin
4031 : ! If non spin-polarized, treat spin down contribution now, similar to spin up
4032 0 : exc=exc*2
4033 0 : exci(ipts)=exc*rhotot_inv
4034 : ! -----------------------------------------------------------------------------
4035 : ! Then takes care of the LSD correlation part of the functional
4036 :
4037 :
4038 0 : rs=rsfac*rhotmot
4039 0 : sqr_rs=sq_rsfac*rhotmo6
4040 0 : rsm1_2=sq_rsfac_inv*rhoto6
4041 :
4042 : ! Formulas A6-A8 of PW92LSD
4043 0 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
4044 0 : sqr_sqr_rs=max(1.e-15_dp,sqrt(sqr_rs))
4045 0 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs/sqr_sqr_rs)
4046 0 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+3.5_dp*ec0_b4*rs/sqr_sqr_rs)
4047 0 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
4048 : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
4049 0 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
4050 0 : ecrs0=ec0_q0*ec0_log
4051 0 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
4052 0 : ec0_q1pp=0.5_dp*ec0_aa*(-ec0_b1*rsm1_2**3+3._dp*ec0_b3*rsm1_2+8._dp*ec0_b4)
4053 : d2ecrs0_drs2= 4.0_dp*ec0_aa*ec0_a1*ec0_q1p*ec0_den &
4054 : & -ec0_q0*ec0_q1pp*ec0_den &
4055 0 : & +ec0_q0*ec0_q1p**2*ec0_den**2*(2._dp*ec0_q1+1.0_dp)
4056 0 : mac_q0=-2.0_dp*mac_aa*(1.0_dp+mac_a1*rs)
4057 0 : mac_q1=2.0_dp*mac_aa*(mac_b1*sqr_rs+mac_b2*rs+mac_b3*rs*sqr_rs+mac_b4*rs*rs)
4058 0 : mac_q1p=mac_aa*(mac_b1*rsm1_2+2._dp*mac_b2+3._dp*mac_b3*sqr_rs+4._dp*mac_b4*rs)
4059 0 : mac_den=1.0_dp/(mac_q1*mac_q1+mac_q1)
4060 0 : mac_log=-log( mac_q1*mac_q1*mac_den )
4061 0 : macrs=mac_q0*mac_log
4062 0 : dmacrs_drs= -2.0_dp*mac_aa*mac_a1*mac_log - mac_q0*mac_q1p*mac_den
4063 0 : ecrs=ecrs0
4064 0 : decrs_drs=decrs0_drs
4065 0 : decrs_dzeta=0.0_dp
4066 0 : d2ecrs_drs2=d2ecrs0_drs2
4067 0 : d2ecrs_dzeta2=alpha_zeta**2*(-macrs)
4068 0 : d2ecrs_drsdzeta=zero
4069 0 : zeta=0.0_dp
4070 :
4071 : ! Add LSD correlation functional to GGA exchange functional
4072 0 : exci(ipts)=exci(ipts)+ecrs
4073 0 : vxci(ipts,1)=vxci(ipts,1)+ecrs-rs*third*decrs_drs
4074 :
4075 0 : dvcrs_drs=third*(2._dp*decrs_drs-rs*d2ecrs_drs2)
4076 : ! And d(vxc)/d(rho)=(-rs/(3*rho))*d(vxc)/d(rs)
4077 0 : d2ecrs_drho2= -rs**4*(four_pi*third)*third*dvcrs_drs
4078 0 : dvxci(ipts,1)=dvxci(ipts,1)+d2ecrs_drho2
4079 :
4080 : end do
4081 : end if
4082 :
4083 : end if
4084 :
4085 :
4086 : ! fab: here it starts the spin polarized case
4087 :
4088 165179 : else if(nspden==2) then
4089 :
4090 : ! we separate different cases depending on order
4091 :
4092 165179 : if (order**2<=1) then
4093 :
4094 150275949 : do ipts=1,npts
4095 :
4096 150131421 : rhotot=rhoarr(ipts)
4097 150131421 : rhotmot=rhom1_3(ipts)
4098 150131421 : rhotot_inv=rhotmot*rhotmot*rhotmot
4099 150131421 : rhotmo6=sqrt(rhotmot)
4100 150131421 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
4101 : ! -----------------------------------------------------------------------
4102 : ! First take care of the exchange part of the functional
4103 :
4104 150131421 : exc=zero
4105 150131421 : if (present(dvxcdgr)) dvxcdgr(ipts,3)=zero
4106 450394263 : do ispden=1,nspden
4107 300262842 : rho =rho_updn(ipts,ispden)
4108 300262842 : rhomot=rho_updnm1_3(ipts,ispden)
4109 300262842 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
4110 150131421 : if(option==1 .or. option==-1 .or. option==3)then
4111 : ! Perdew_Wang 91 LSD
4112 232615762 : vxci(ipts,ispden)=four_thirds*ex_lsd
4113 232615762 : if(present(dvxcdgr)) dvxcdgr(ipts,ispden)=0.0_dp
4114 232615762 : exc=exc+ex_lsd*rho
4115 : else
4116 67647080 : rho_inv=rhomot*rhomot*rhomot
4117 67647080 : coeffss=quarter*sixpi2m1_3*sixpi2m1_3*rho_inv*rho_inv*rhomot*rhomot
4118 67647080 : ss=grho2_updn(ipts,ispden)*coeffss
4119 67647080 : if(option==7) then ! This is WC
4120 875520 : expss=exp(-ss)
4121 875520 : p1_wc=b_wc+(mu-b_wc)*(one-ss)*expss+two*c_wc*ss/(one+c_wc*ss*ss)
4122 : p2_wc=d_wc*(ss-two)*expss+two*c_wc/(one+c_wc*ss*ss)-&
4123 875520 : & four*c_wc*c_wc*ss*ss/((one+c_wc*ss*ss)*(one+c_wc*ss*ss))
4124 875520 : divss=one/(one+(b_wc*ss+d_wc*ss*expss+log(one+c_wc*ss*ss))/kappa)
4125 875520 : dfxdss=p1_wc*divss*divss
4126 875520 : d2fxdss2=p2_wc*divss*divss-two*divss*divss*divss*p1_wc*p1_wc/kappa
4127 : else
4128 66771560 : if(option/=6)then ! This is Perdew-Burke-Ernzerhof GGA, exchange part
4129 66387560 : divss=one/(one+mu_divkappa*ss)
4130 66387560 : dfxdss= mu*divss*divss
4131 66387560 : d2fxdss2=-mu*two*mu_divkappa*divss*divss*divss
4132 : else ! This is RPBE modification
4133 384000 : divss=exp(-mu_divkappa*ss)
4134 384000 : dfxdss= mu*divss
4135 384000 : d2fxdss2=-mu*mu_divkappa*divss
4136 : end if
4137 : end if
4138 67647080 : fx = one+kappa*(one-divss)
4139 67647080 : ex_gga= ex_lsd*fx
4140 67647080 : dssdn=-eight*third*ss*rho_inv
4141 67647080 : dfxdn = dfxdss*dssdn
4142 67647080 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
4143 : ! The new definition (v3.3) includes the division by the norm of the gradient
4144 67647080 : dssdg =two*coeffss
4145 67647080 : dfxdg=dfxdss*dssdg
4146 67647080 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
4147 67647080 : exc=exc+ex_gga*rho
4148 : end if
4149 :
4150 : end do
4151 150131421 : exci(ipts)=exc*rhotot_inv
4152 150131421 : if(exexch_==1)cycle
4153 :
4154 : ! -----------------------------------------------------------------------------
4155 : ! Then takes care of the LSD correlation part of the functional
4156 :
4157 150049149 : if(option>0)then
4158 :
4159 148611437 : rs=rsfac*rhotmot
4160 148611437 : sqr_rs=sq_rsfac*rhotmo6
4161 148611437 : rsm1_2=sq_rsfac_inv*rhoto6
4162 :
4163 : ! Formulas A6-A8 of PW92LSD
4164 148611437 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
4165 148611437 : if(option/=3 .and. option/=4)then
4166 148611437 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs)
4167 148611437 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+4._dp*ec0_b4*rs)
4168 : else
4169 0 : sqr_sqr_rs=max(1.e-15_dp,sqrt(sqr_rs))
4170 0 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs/sqr_sqr_rs)
4171 0 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+3.5_dp*ec0_b4*rs/sqr_sqr_rs)
4172 : end if
4173 148611437 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
4174 : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
4175 148611437 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
4176 148611437 : ecrs0=ec0_q0*ec0_log
4177 148611437 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
4178 :
4179 148611437 : mac_q0=-2.0_dp*mac_aa*(1.0_dp+mac_a1*rs)
4180 148611437 : mac_q1=2.0_dp*mac_aa*(mac_b1*sqr_rs+mac_b2*rs+mac_b3*rs*sqr_rs+mac_b4*rs*rs)
4181 148611437 : mac_q1p=mac_aa*(mac_b1*rsm1_2+2._dp*mac_b2+3._dp*mac_b3*sqr_rs+4._dp*mac_b4*rs)
4182 148611437 : mac_den=1.0_dp/(mac_q1*mac_q1+mac_q1)
4183 148611437 : mac_log=-log( mac_q1*mac_q1*mac_den )
4184 148611437 : macrs=mac_q0*mac_log
4185 148611437 : dmacrs_drs= -2.0_dp*mac_aa*mac_a1*mac_log - mac_q0*mac_q1p*mac_den
4186 :
4187 148611437 : zeta=(rho_updn(ipts,1)-rho_updn(ipts,2))*rhotot_inv
4188 148611437 : ec1_q0=-2.0_dp*ec1_aa*(1.0_dp+ec1_a1*rs)
4189 148611437 : if(option/=3 .and. option/=4)then
4190 148611437 : ec1_q1=2.0_dp*ec1_aa*(ec1_b1*sqr_rs+ec1_b2*rs+ec1_b3*rs*sqr_rs+ec1_b4*rs*rs)
4191 148611437 : ec1_q1p=ec1_aa*(ec1_b1*rsm1_2+2._dp*ec1_b2+3._dp*ec1_b3*sqr_rs+4._dp*ec1_b4*rs)
4192 : else
4193 0 : ec1_q1=2.0_dp*ec1_aa*(ec1_b1*sqr_rs+ec1_b2*rs+ec1_b3*rs*sqr_rs+ec1_b4*rs*rs/sqr_sqr_rs)
4194 0 : ec1_q1p=ec1_aa*(ec1_b1*rsm1_2+2._dp*ec1_b2+3._dp*ec1_b3*sqr_rs+3.5_dp*ec1_b4*rs/sqr_sqr_rs)
4195 : end if
4196 148611437 : ec1_den=1.0_dp/(ec1_q1*ec1_q1+ec1_q1)
4197 : ! ec1_log=log( 1.0_dp + 1.0_dp / ec1_q1 )
4198 148611437 : ec1_log=-log( ec1_q1*ec1_q1*ec1_den )
4199 148611437 : ecrs1=ec1_q0*ec1_log
4200 148611437 : decrs1_drs= -2.0_dp*ec1_aa*ec1_a1*ec1_log - ec1_q0*ec1_q1p *ec1_den
4201 :
4202 : ! alpha_zeta is introduced in order to remove singularities for fully
4203 : ! polarized systems.
4204 148611437 : zetp_1_3=(1.0_dp+zeta*alpha_zeta)*zetpm1_3(ipts)**2
4205 148611437 : zetm_1_3=(1.0_dp-zeta*alpha_zeta)*zetmm1_3(ipts)**2
4206 :
4207 : f_zeta=( (1.0_dp+zeta*alpha_zeta2)*zetp_1_3 + &
4208 148611437 : & (1.0_dp-zeta*alpha_zeta2)*zetm_1_3 - 2.0_dp ) * factf_zeta
4209 148611437 : fp_zeta=( zetp_1_3 - zetm_1_3 ) * factfp_zeta
4210 148611437 : zeta4=zeta**4
4211 :
4212 148611437 : gcrs=ecrs1-ecrs0+macrs*fsec_inv
4213 : ! ecrs=ecrs0+f_zeta*(-macrs*(1.0_dp-zeta4)*fsec_inv+(ecrs1-ecrs0)*zeta4)
4214 148611437 : ecrs=ecrs0+f_zeta*(zeta4*gcrs-macrs*fsec_inv)
4215 :
4216 148611437 : dgcrs_drs=decrs1_drs-decrs0_drs+dmacrs_drs*fsec_inv
4217 : ! decrs_drs=decrs0_drs+f_zeta*&
4218 : ! & (-dmacrs_drs*(1.0_dp-zeta4)*fsec_inv+(decrs1_drs-decrs0_drs)*zeta4)
4219 148611437 : decrs_drs=decrs0_drs+f_zeta*(zeta4*dgcrs_drs-dmacrs_drs*fsec_inv)
4220 148611437 : dfzeta4_dzeta=4.0_dp*zeta**3*f_zeta+fp_zeta*zeta4
4221 148611437 : decrs_dzeta=dfzeta4_dzeta*gcrs-fp_zeta*macrs*fsec_inv
4222 :
4223 : ! Add LSD correlation functional to GGA exchange functional
4224 148611437 : exci(ipts)=exci(ipts)+ecrs
4225 148611437 : vxcadd=ecrs-rs*third*decrs_drs-zeta*decrs_dzeta
4226 148611437 : vxci(ipts,1)=vxci(ipts,1)+vxcadd+decrs_dzeta
4227 148611437 : vxci(ipts,2)=vxci(ipts,2)+vxcadd-decrs_dzeta
4228 :
4229 : ! -----------------------------------------------------------------------------
4230 : ! Eventually add the GGA correlation part of the PBE functional
4231 : ! Note : the computation of the potential in the spin-unpolarized
4232 : ! case could be optimized much further. Other optimizations are left to do.
4233 :
4234 148611437 : if(option==2 .or. option==5 .or. option==6 .or. option==7)then
4235 : ! The definition of phi has been slightly changed, because
4236 : ! the original PBE one gives divergent behaviour for fully
4237 : ! polarized points
4238 : ! zetpm1_3=(1.0_dp+zeta*alpha_zeta)**(-third)
4239 : ! zetmm1_3=(1.0_dp-zeta*alpha_zeta)**(-third)
4240 : phi_zeta=( zetpm1_3(ipts)*(1.0_dp+zeta*alpha_zeta)+ &
4241 32303556 : & zetmm1_3(ipts)*(1.0_dp-zeta*alpha_zeta) )*0.5_dp
4242 32303556 : phip_zeta=(zetpm1_3(ipts)-zetmm1_3(ipts))*third*alpha_zeta
4243 32303556 : phi_zeta_inv=1.0_dp/phi_zeta
4244 32303556 : phi_logder=phip_zeta*phi_zeta_inv
4245 32303556 : phi3_zeta=phi_zeta*phi_zeta*phi_zeta
4246 32303556 : gamphi3inv=gamma_inv*phi_zeta_inv*phi_zeta_inv*phi_zeta_inv
4247 :
4248 : ! From ec to bb
4249 32303556 : bb=ecrs*gamphi3inv
4250 32303556 : dbb_drs=decrs_drs*gamphi3inv
4251 32303556 : dbb_dzeta=gamphi3inv*(decrs_dzeta-three*ecrs*phi_logder)
4252 : ! From bb to cc
4253 32303556 : exp_pbe=exp(-bb)
4254 32303556 : cc=one/(exp_pbe-one)
4255 32303556 : dcc_dbb=cc*cc*exp_pbe
4256 32303556 : dcc_drs=dcc_dbb*dbb_drs
4257 32303556 : dcc_dzeta=dcc_dbb*dbb_dzeta
4258 :
4259 : ! From cc to aa
4260 32303556 : coeff_aa=beta*gamma_inv*phi_zeta_inv*phi_zeta_inv
4261 32303556 : aa=coeff_aa*cc
4262 32303556 : daa_drs=coeff_aa*dcc_drs
4263 32303556 : daa_dzeta=-two*aa*phi_logder+coeff_aa*dcc_dzeta
4264 : ! Introduce tt : do not assume that the spin-dependent gradients are collinear
4265 32303556 : grrho2=grho2_updn(ipts,3)
4266 32303556 : dtt_dg=two*rhotot_inv*rhotot_inv*rhotmot*coeff_tt
4267 : ! Note that tt is (the t variable of PBE divided by phi) squared
4268 32303556 : tt=half*grrho2*dtt_dg
4269 :
4270 : ! Get xx from aa and tt
4271 32303556 : xx=aa*tt
4272 32303556 : dxx_drs=daa_drs*tt
4273 32303556 : dxx_dzeta=daa_dzeta*tt
4274 32303556 : dxx_dtt=aa
4275 : ! From xx to pade
4276 32303556 : pade_den=one/(one+xx*(one+xx))
4277 32303556 : pade=(one+xx)*pade_den
4278 32303556 : dpade_dxx=-xx*(two+xx)*pade_den**2
4279 32303556 : dpade_drs=dpade_dxx*dxx_drs
4280 32303556 : dpade_dtt=dpade_dxx*dxx_dtt
4281 32303556 : dpade_dzeta=dpade_dxx*dxx_dzeta
4282 :
4283 : ! From pade to qq
4284 32303556 : coeff_qq=tt*phi_zeta_inv*phi_zeta_inv
4285 32303556 : qq=coeff_qq*pade
4286 32303556 : dqq_drs=coeff_qq*dpade_drs
4287 32303556 : dqq_dtt=pade*phi_zeta_inv*phi_zeta_inv+coeff_qq*dpade_dtt
4288 32303556 : dqq_dzeta=coeff_qq*(dpade_dzeta-two*pade*phi_logder)
4289 :
4290 : ! From qq to rr
4291 32303556 : arg_rr=one+beta*gamma_inv*qq
4292 32303556 : div_rr=one/arg_rr
4293 32303556 : rr=gamma*log(arg_rr)
4294 32303556 : drr_dqq=beta*div_rr
4295 32303556 : drr_drs=drr_dqq*dqq_drs
4296 32303556 : drr_dtt=drr_dqq*dqq_dtt
4297 32303556 : drr_dzeta=drr_dqq*dqq_dzeta
4298 :
4299 : ! From rr to hh
4300 32303556 : hh=phi3_zeta*rr
4301 32303556 : dhh_drs=phi3_zeta*drr_drs
4302 32303556 : dhh_dtt=phi3_zeta*drr_dtt
4303 32303556 : dhh_dzeta=phi3_zeta*(drr_dzeta+three*rr*phi_logder)
4304 :
4305 : ! The GGA correlation energy is added
4306 32303556 : exci(ipts)=exci(ipts)+hh
4307 :
4308 : ! Change of variables : from (rs,zeta,tt) to (rhoup,rhodn,grrho)
4309 :
4310 : ! From hh to the derivative of the energy wrt the density
4311 32303556 : drhohh_drho=hh-third*rs*dhh_drs-zeta*dhh_dzeta-seven*third*tt*dhh_dtt
4312 32303556 : vxci(ipts,1)=vxci(ipts,1)+drhohh_drho+dhh_dzeta
4313 32303556 : vxci(ipts,2)=vxci(ipts,2)+drhohh_drho-dhh_dzeta
4314 :
4315 :
4316 : ! From hh to the derivative of the energy wrt to the gradient of the
4317 : ! density, divided by the gradient of the density
4318 : ! (The v3.3 definition includes the division by the norm of the gradient)
4319 32303556 : dvxcdgr(ipts,3)=rhotot*dtt_dg*dhh_dtt
4320 :
4321 : ! End condition of GGA
4322 : end if
4323 :
4324 : else ! no correlation
4325 :
4326 : ! End condition of including correlation, and not only exchange
4327 : end if
4328 :
4329 : ! Correlation has been added
4330 : ! -----------------------------------------------------------------------------
4331 :
4332 : end do
4333 :
4334 : ! fab: the following is the "else" on order !!!
4335 :
4336 : else
4337 :
4338 64505409 : do ipts=1,npts
4339 :
4340 64484758 : rhotot=rhoarr(ipts)
4341 64484758 : rhotmot=rhom1_3(ipts)
4342 64484758 : rhotot_inv=rhotmot*rhotmot*rhotmot
4343 64484758 : rhotmo6=sqrt(rhotmot)
4344 64484758 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
4345 : ! -----------------------------------------------------------------------
4346 : ! First take care of the exchange part of the functional
4347 :
4348 64484758 : exc=zero
4349 64484758 : if (present(dvxcdgr)) dvxcdgr(ipts,3)=zero
4350 193454274 : do ispden=1,nspden
4351 128969516 : rho =rho_updn(ipts,ispden)
4352 128969516 : rhomot=rho_updnm1_3(ipts,ispden)
4353 128969516 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
4354 : if(option==1 .or. option==-1 .or. option==3)then
4355 : ! Perdew_Wang 91 LSD
4356 91979102 : vxci(ipts,ispden)=four_thirds*ex_lsd
4357 91979102 : if(present(dvxcdgr)) dvxcdgr(ipts,ispden)=0.0_dp
4358 91979102 : exc=exc+ex_lsd*rho
4359 : else
4360 36990414 : rho_inv=rhomot*rhomot*rhomot
4361 36990414 : coeffss=quarter*sixpi2m1_3*sixpi2m1_3*rho_inv*rho_inv*rhomot*rhomot
4362 36990414 : ss=grho2_updn(ipts,ispden)*coeffss
4363 36990414 : if(option==7) then ! This is WC
4364 0 : expss=exp(-ss)
4365 0 : p1_wc=b_wc+(mu-b_wc)*(one-ss)*expss+two*c_wc*ss/(one+c_wc*ss*ss)
4366 : p2_wc=d_wc*(ss-two)*expss+two*c_wc/(one+c_wc*ss*ss)-&
4367 0 : & four*c_wc*c_wc*ss*ss/((one+c_wc*ss*ss)*(one+c_wc*ss*ss))
4368 0 : divss=one/(one+(b_wc*ss+d_wc*ss*expss+log(one+c_wc*ss*ss))/kappa)
4369 0 : dfxdss=p1_wc*divss*divss
4370 0 : d2fxdss2=p2_wc*divss*divss-two*divss*divss*divss*p1_wc*p1_wc/kappa
4371 : else
4372 36990414 : if(option/=6)then ! This is Perdew-Burke-Ernzerhof GGA, exchange part
4373 36990414 : divss=one/(one+mu_divkappa*ss)
4374 36990414 : dfxdss= mu*divss*divss
4375 36990414 : d2fxdss2=-mu*two*mu_divkappa*divss*divss*divss
4376 : else ! This is RPBE modification
4377 0 : divss=exp(-mu_divkappa*ss)
4378 0 : dfxdss= mu*divss
4379 0 : d2fxdss2=-mu*mu_divkappa*divss
4380 : end if
4381 : end if
4382 36990414 : fx = one+kappa*(one-divss)
4383 36990414 : ex_gga= ex_lsd*fx
4384 36990414 : dssdn=-eight*third*ss*rho_inv
4385 36990414 : dfxdn = dfxdss*dssdn
4386 36990414 : vxci(ipts,ispden)=ex_lsd*(four_thirds*fx+rho*dfxdn)
4387 : ! The new definition (v3.3) includes the division by the norm of the gradient
4388 36990414 : dssdg =two*coeffss
4389 36990414 : dfxdg=dfxdss*dssdg
4390 36990414 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
4391 36990414 : exc=exc+ex_gga*rho
4392 : end if
4393 :
4394 64484758 : if(option==1 .or. option==-1 .or. option==3)then
4395 :
4396 : ! Perdew_Wang 91 LSD
4397 : dvxci(ipts,2*ispden-1)=-four_thirds*third*&
4398 91979102 : & threefourth_divpi*sixpi2_1_3*rhomot*rhomot
4399 91979102 : dvxci(ipts,2)=zero
4400 91979102 : if(order==3)then
4401 : ! If non-spin-polarized, first component of dvxci is second
4402 : ! derivative with respect to TOTAL density.
4403 : ! Compute the second derivative of vx
4404 : ! vx^(2) = -2*vx^(1)/(3*rhotot)
4405 :
4406 : ! fab: third order derivatives of the exchange part in the spin polarized case
4407 :
4408 4703856 : d2vxci(ipts,3*ispden-2) = -2._dp*dvxci(ipts,2*ispden-1)*(rhomot*rhomot*rhomot)/3._dp
4409 :
4410 : ! mixed thir order derivatives of the exchange energy with respect to rho of
4411 : ! different spin polarization are zero
4412 4703856 : d2vxci(ipts,2)=zero
4413 4703856 : d2vxci(ipts,3)=zero
4414 :
4415 : end if
4416 :
4417 : else
4418 : ! Perdew-Burke-Ernzerhof GGA, exchange part
4419 : ! Components 3 or 4
4420 36990414 : dvxci(ipts,2+ispden)=dvxcdgr(ipts,ispden)
4421 : ! Components 1 or 2
4422 36990414 : d2ssdn2=-11.0_dp*third*dssdn*rho_inv
4423 36990414 : d2fxdn2=d2fxdss2*dssdn**2+dfxdss*d2ssdn2
4424 : dvxci(ipts,ispden)=third*rho_inv*vxci(ipts,ispden)+&
4425 36990414 : & ex_lsd*(seven*third*dfxdn+rho*d2fxdn2)
4426 : ! Components 5 or 6
4427 36990414 : d2ssdndg=-eight*third*dssdg*rho_inv
4428 36990414 : d2fxdndg=d2fxdss2*dssdn*dssdg+dfxdss*d2ssdndg
4429 36990414 : dvxci(ipts,4+ispden)=ex_lsd*(four_thirds*dfxdg+rho*d2fxdndg)
4430 : ! Components 7 or 8
4431 36990414 : d2fxdg2=d2fxdss2*dssdg**2
4432 36990414 : dvxci(ipts,6+ispden)=ex_lsd*rho*d2fxdg2
4433 : ! For the time being, treat non-spin-polarized like spin-polarized
4434 : end if
4435 : end do
4436 64484758 : exci(ipts)=exc*rhotot_inv
4437 : ! -----------------------------------------------------------------------------
4438 : ! Then takes care of the LSD correlation part of the functional
4439 :
4440 64505409 : if(option>0)then
4441 :
4442 61422958 : rs=rsfac*rhotmot
4443 61422958 : sqr_rs=sq_rsfac*rhotmo6
4444 61422958 : rsm1_2=sq_rsfac_inv*rhoto6
4445 :
4446 : ! Formulas A6-A8 of PW92LSD
4447 61422958 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
4448 61422958 : if(option/=3 .and. option/=4)then
4449 61422958 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs)
4450 61422958 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+4._dp*ec0_b4*rs)
4451 : else
4452 0 : sqr_sqr_rs=max(1.e-15_dp,sqrt(sqr_rs))
4453 0 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs/sqr_sqr_rs)
4454 0 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+3.5_dp*ec0_b4*rs/sqr_sqr_rs)
4455 : end if
4456 61422958 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
4457 : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
4458 61422958 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
4459 61422958 : ecrs0=ec0_q0*ec0_log
4460 61422958 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
4461 61422958 : ec0_q1pp=0.5_dp*ec0_aa*(-ec0_b1*rsm1_2**3+3._dp*ec0_b3*rsm1_2+8._dp*ec0_b4)
4462 : d2ecrs0_drs2= 4.0_dp*ec0_aa*ec0_a1*ec0_q1p*ec0_den &
4463 : & -ec0_q0*ec0_q1pp*ec0_den &
4464 61422958 : & +ec0_q0*ec0_q1p**2*ec0_den**2*(2._dp*ec0_q1+1.0_dp)
4465 61422958 : if (order==3) then
4466 2351928 : ec0_q1ppp = 0.75_dp*ec0_aa*(rsm1_2**5)*(ec0_b1-ec0_b3*rs)
4467 2351928 : ec0_f1 = 1._dp/(ec0_q1*ec0_q1*(1._dp + ec0_q1))
4468 2351928 : ec0_f2 = 1._dp/(ec0_q1*(1+ec0_q1))
4469 : d3ecrs0_drs3 = 6._dp*ec0_q1p*ec0_f1*(-2._dp*ec0_aa*ec0_a1*ec0_q1p + &
4470 : & ec0_q0*ec0_q1pp) - &
4471 : & ec0_f2*(-6._dp*ec0_aa*ec0_a1*ec0_q1pp + ec0_q0*ec0_q1ppp + &
4472 : & ec0_f2*(3._dp*ec0_q1p*(-2._dp*ec0_aa*ec0_a1*ec0_q1p + ec0_q0*ec0_q1pp) + &
4473 2351928 : & ec0_f2*2._dp*ec0_q0*(ec0_q1p**3)*(1._dp + 3._dp*ec0_q1*(1._dp + ec0_q1))))
4474 : end if
4475 :
4476 61422958 : mac_q0=-2.0_dp*mac_aa*(1.0_dp+mac_a1*rs)
4477 61422958 : mac_q1=2.0_dp*mac_aa*(mac_b1*sqr_rs+mac_b2*rs+mac_b3*rs*sqr_rs+mac_b4*rs*rs)
4478 61422958 : mac_q1p=mac_aa*(mac_b1*rsm1_2+2._dp*mac_b2+3._dp*mac_b3*sqr_rs+4._dp*mac_b4*rs)
4479 61422958 : mac_den=1.0_dp/(mac_q1*mac_q1+mac_q1)
4480 61422958 : mac_log=-log( mac_q1*mac_q1*mac_den )
4481 61422958 : macrs=mac_q0*mac_log
4482 61422958 : dmacrs_drs= -2.0_dp*mac_aa*mac_a1*mac_log - mac_q0*mac_q1p*mac_den
4483 :
4484 61422958 : zeta=(rho_updn(ipts,1)-rho_updn(ipts,2))*rhotot_inv
4485 61422958 : ec1_q0=-2.0_dp*ec1_aa*(1.0_dp+ec1_a1*rs)
4486 61422958 : if(option/=3 .and. option/=4)then
4487 61422958 : ec1_q1=2.0_dp*ec1_aa*(ec1_b1*sqr_rs+ec1_b2*rs+ec1_b3*rs*sqr_rs+ec1_b4*rs*rs)
4488 61422958 : ec1_q1p=ec1_aa*(ec1_b1*rsm1_2+2._dp*ec1_b2+3._dp*ec1_b3*sqr_rs+4._dp*ec1_b4*rs)
4489 : else
4490 0 : ec1_q1=2.0_dp*ec1_aa*(ec1_b1*sqr_rs+ec1_b2*rs+ec1_b3*rs*sqr_rs+ec1_b4*rs*rs/sqr_sqr_rs)
4491 0 : ec1_q1p=ec1_aa*(ec1_b1*rsm1_2+2._dp*ec1_b2+3._dp*ec1_b3*sqr_rs+3.5_dp*ec1_b4*rs/sqr_sqr_rs)
4492 : end if
4493 61422958 : ec1_den=1.0_dp/(ec1_q1*ec1_q1+ec1_q1)
4494 : ! ec1_log=log( 1.0_dp + 1.0_dp / ec1_q1 )
4495 61422958 : ec1_log=-log( ec1_q1*ec1_q1*ec1_den )
4496 61422958 : ecrs1=ec1_q0*ec1_log
4497 61422958 : decrs1_drs= -2.0_dp*ec1_aa*ec1_a1*ec1_log - ec1_q0*ec1_q1p *ec1_den
4498 :
4499 : ! alpha_zeta is introduced in order to remove singularities for fully
4500 : ! polarized systems.
4501 61422958 : zetp_1_3=(1.0_dp+zeta*alpha_zeta)*zetpm1_3(ipts)**2
4502 61422958 : zetm_1_3=(1.0_dp-zeta*alpha_zeta)*zetmm1_3(ipts)**2
4503 :
4504 : f_zeta=( (1.0_dp+zeta*alpha_zeta2)*zetp_1_3 + &
4505 61422958 : & (1.0_dp-zeta*alpha_zeta2)*zetm_1_3 - 2.0_dp ) * factf_zeta
4506 61422958 : fp_zeta=( zetp_1_3 - zetm_1_3 ) * factfp_zeta
4507 61422958 : zeta4=zeta**4
4508 :
4509 61422958 : gcrs=ecrs1-ecrs0+macrs*fsec_inv
4510 : ! ecrs=ecrs0+f_zeta*(-macrs*(1.0_dp-zeta4)*fsec_inv+(ecrs1-ecrs0)*zeta4)
4511 61422958 : ecrs=ecrs0+f_zeta*(zeta4*gcrs-macrs*fsec_inv)
4512 :
4513 61422958 : dgcrs_drs=decrs1_drs-decrs0_drs+dmacrs_drs*fsec_inv
4514 : ! decrs_drs=decrs0_drs+f_zeta*&
4515 : ! & (-dmacrs_drs*(1.0_dp-zeta4)*fsec_inv+(decrs1_drs-decrs0_drs)*zeta4)
4516 61422958 : decrs_drs=decrs0_drs+f_zeta*(zeta4*dgcrs_drs-dmacrs_drs*fsec_inv)
4517 61422958 : dfzeta4_dzeta=4.0_dp*zeta**3*f_zeta+fp_zeta*zeta4
4518 61422958 : decrs_dzeta=dfzeta4_dzeta*gcrs-fp_zeta*macrs*fsec_inv
4519 :
4520 61422958 : ec1_q1pp=0.5_dp*ec1_aa*(-ec1_b1*rsm1_2**3+3._dp*ec1_b3*rsm1_2+8._dp*ec1_b4)
4521 :
4522 : d2ecrs1_drs2= 4.0_dp*ec1_aa*ec1_a1*ec1_q1p*ec1_den &
4523 : & -ec1_q0*ec1_q1pp*ec1_den &
4524 61422958 : & +ec1_q0*ec1_q1p**2*ec1_den**2*(2._dp*ec1_q1+1.0_dp)
4525 :
4526 :
4527 61422958 : mac_q1pp=0.5_dp*mac_aa*(-mac_b1*rsm1_2**3+3._dp*mac_b3*rsm1_2+8._dp*mac_b4)
4528 : d2macrs_drs2= 4.0_dp*mac_aa*mac_a1*mac_q1p*mac_den &
4529 : & -mac_q0*mac_q1pp*mac_den &
4530 61422958 : & +mac_q0*mac_q1p**2*mac_den**2*(2._dp*mac_q1+1.0_dp)
4531 :
4532 61422958 : d2gcrs_drs2=d2ecrs1_drs2-d2ecrs0_drs2+d2macrs_drs2*fsec_inv
4533 61422958 : fpp_zeta=(zetpm1_3(ipts)**2+zetmm1_3(ipts)**2) * factfpp_zeta
4534 : d2fzeta4_dzeta2=12.0_dp*zeta**2*f_zeta &
4535 : & + 8.0_dp*zeta**3*fp_zeta &
4536 61422958 : & + zeta4 *fpp_zeta
4537 :
4538 : d2ecrs_drs2=d2ecrs0_drs2+&
4539 61422958 : & f_zeta*(zeta4*d2gcrs_drs2-d2macrs_drs2*fsec_inv)
4540 61422958 : d2ecrs_drsdzeta=dfzeta4_dzeta*dgcrs_drs-fp_zeta*dmacrs_drs*fsec_inv
4541 61422958 : d2ecrs_dzeta2=d2fzeta4_dzeta2*gcrs-fpp_zeta*macrs*fsec_inv
4542 :
4543 : ! End condition of abs(order)>1
4544 : ! Add LSD correlation functional to GGA exchange functional
4545 61422958 : exci(ipts)=exci(ipts)+ecrs
4546 61422958 : vxcadd=ecrs-rs*third*decrs_drs-zeta*decrs_dzeta
4547 : ! decrs_drup=vxcadd+decrs_dzeta
4548 : ! decrs_drdn=vxcadd-decrs_dzeta
4549 61422958 : vxci(ipts,1)=vxci(ipts,1)+vxcadd+decrs_dzeta
4550 61422958 : vxci(ipts,2)=vxci(ipts,2)+vxcadd-decrs_dzeta
4551 :
4552 :
4553 :
4554 61422958 : dvcrs_drs=third*(2._dp*decrs_drs-rs*d2ecrs_drs2)
4555 : ! And d(vxc)/d(rho)=(-rs/(3*rho))*d(vxc)/d(rs)
4556 61422958 : d2ecrs_drho2= -rs**4*(four_pi*third)*third*dvcrs_drs
4557 : d2ecrs_drup2=d2ecrs_drho2+&
4558 : & two*(-third*rs*d2ecrs_drsdzeta)*(1._dp-zeta)*rhotot_inv+ &
4559 61422958 : & d2ecrs_dzeta2*(1._dp-zeta)**2*rhotot_inv
4560 : d2ecrs_drdndrup=d2ecrs_drho2+&
4561 : & 2.0_dp*(-third*rs*d2ecrs_drsdzeta)*(-zeta)*rhotot_inv+ &
4562 61422958 : & d2ecrs_dzeta2*(1._dp-zeta)*(-1._dp-zeta)*rhotot_inv
4563 : d2ecrs_drdn2=d2ecrs_drho2+&
4564 : & 2.0_dp*(-third*rs*d2ecrs_drsdzeta)*(-1._dp-zeta)*rhotot_inv+ &
4565 61422958 : & d2ecrs_dzeta2*(-1._dp-zeta)**2*rhotot_inv
4566 :
4567 :
4568 :
4569 :
4570 61422958 : if (order==3) then
4571 :
4572 :
4573 : ! fab : INGREDIENTS NEEDED
4574 :
4575 2351928 : a1fa=-third*(threefourth_divpi**(third))*((rhotot)**(-4._dp/3._dp))
4576 2351928 : a2fa=(1._dp-zeta)/rhotot
4577 2351928 : b2fa=(-2._dp/3._dp)*((threefourth_divpi)**(third))*((7._dp/3._dp)*(-1._dp+zeta)/((rhotot)**(7._dp/3._dp)))
4578 2351928 : b1fa=a2fa
4579 2351928 : c2fa=((1._dp-zeta)**2)*(-3._dp*(1._dp/((rhotot)**2)))
4580 2351928 : c1fa=((1._dp-zeta)*(1._dp-zeta))/rhotot
4581 2351928 : e2fa=(2._dp/3._dp)*((threefourth_divpi)**(third))*((1._dp-(7._dp/3._dp)*zeta)/((rhotot)**(7._dp/3._dp)))
4582 2351928 : e1fa=-zeta/rhotot
4583 2351928 : f2fa=(2._dp*zeta)*(1._dp/((rhotot)**2))-(3._dp*zeta*zeta)*(1._dp/((rhotot)**2))+1._dp/(((rhotot)**2))
4584 2351928 : f1fa=(zeta*zeta-1._dp)/rhotot
4585 2351928 : g1fa=a1fa
4586 2351928 : g2fa=(-1._dp-zeta)/rhotot
4587 2351928 : h2fa=(2._dp/3._dp)*((threefourth_divpi)**(third))*((-1._dp-(7._dp/3._dp)*zeta)/((rhotot)**(7._dp/3._dp)))
4588 2351928 : h1fa=e1fa
4589 2351928 : i2fa=((-2._dp*zeta)-(3*zeta*zeta)+1)/((rhotot)**2)
4590 2351928 : i1fa=f1fa
4591 2351928 : m2fa=(-2._dp/3._dp)*((threefourth_divpi)**(third))*(((7._dp/3._dp)*(zeta+1._dp))/((rhotot)**(7._dp/3._dp)))
4592 2351928 : m1fa=g2fa
4593 2351928 : n2fa=(-3._dp*(1._dp+zeta)*(1._dp+zeta))/(rhotot*rhotot)
4594 2351928 : n1fa=((-1._dp-zeta)**2)/rhotot
4595 :
4596 :
4597 : ! TERMS APPEARING IN THE THIRD ORDER DERIVATIVES
4598 : ! terms appearing in the third order derivatives of the spin polarized
4599 : ! correlation energy with respect to spin densities
4600 :
4601 :
4602 : ! ec1_q0p=-2.0_dp*ec1_aa*ec1_a1
4603 : ! ec1_q1ppp=(3._dp/4._dp)*ec1_aa*(ec1_b1*(rsm1_2**5)-ec1_b3*(rsm1_2**3))
4604 : ! This must be erroneous ...
4605 : ! d3ecrs1_drs3=(ec1_q1pp*(4._dp*ec1_aa*ec1_a1-ec1_q0p)-ec1_q0*ec1_q1ppp)*ec1_den+ &
4606 : ! & ((-ec1_q1p**2)*(4._dp*ec1_aa*ec1_a1)+ec1_q0*ec1_q1pp*ec1_q1+ec1_q0p*(ec1_q1p**2)+ &
4607 : ! & 2._dp*ec1_q0*ec1_q1p*ec1_q1pp)*(ec1_den**2)*(2._dp*ec1_q1+1._dp)- &
4608 : ! & (2._dp*ec1_q0*(ec1_q1p**3)*((2._dp*ec1_q1+1._dp)**2))*(ec1_den**3)+ &
4609 : ! & (2._dp*ec1_q0*(ec1_q1p**3))*(ec1_den**2)
4610 :
4611 2351928 : ec1_q1ppp = 0.75_dp*ec1_aa*(rsm1_2**5)*(ec1_b1-ec1_b3*rs)
4612 2351928 : ec1_f1 = 1._dp/(ec1_q1*ec1_q1*(1._dp + ec1_q1))
4613 2351928 : ec1_f2 = 1._dp/(ec1_q1*(1+ec1_q1))
4614 : d3ecrs1_drs3 = 6._dp*ec1_q1p*ec1_f1*(-2._dp*ec1_aa*ec1_a1*ec1_q1p + &
4615 : & ec1_q0*ec1_q1pp) - &
4616 : & ec1_f2*(-6._dp*ec1_aa*ec1_a1*ec1_q1pp + ec1_q0*ec1_q1ppp + &
4617 : & ec1_f2*(3._dp*ec1_q1p*(-2._dp*ec1_aa*ec1_a1*ec1_q1p + ec1_q0*ec1_q1pp) + &
4618 2351928 : & ec1_f2*2._dp*ec1_q0*(ec1_q1p**3)*(1._dp + 3._dp*ec1_q1*(1._dp + ec1_q1))))
4619 :
4620 :
4621 : ! mac_q0p=-2.0_dp*mac_aa*mac_a1
4622 : ! mac_q1ppp=(3._dp/4._dp)*mac_aa*(mac_b1*((rsm1_2)**5)-mac_b3*((rsm1_2)**3))
4623 : ! This must be erroneous ...
4624 : ! d3macrs_drs3=(mac_q1pp*(4._dp*mac_aa*mac_a1-mac_q0p)-mac_q0*mac_q1ppp)*mac_den+ &
4625 : ! & ((-mac_q1p**2)*(4._dp*mac_aa*mac_a1)+mac_q0*mac_q1pp*mac_q1+mac_q0p*(mac_q1p**2)+ &
4626 : ! & 2._dp*mac_q0*mac_q1p*mac_q1pp)*(mac_den**2)*(2._dp*mac_q1+1._dp)- &
4627 : ! & (2._dp*mac_q0*(mac_q1p**3)*((2._dp*mac_q1+1._dp)**2))*(mac_den**3)+ &
4628 : ! & (2._dp*mac_q0*(mac_q1p**3))*(mac_den**2)
4629 :
4630 2351928 : mac_q1ppp = 0.75_dp*mac_aa*(rsm1_2**5)*(mac_b1-mac_b3*rs)
4631 2351928 : mac_f1 = 1._dp/(mac_q1*mac_q1*(1._dp + mac_q1))
4632 2351928 : mac_f2 = 1._dp/(mac_q1*(1+mac_q1))
4633 : d3macrs_drs3 = 6._dp*mac_q1p*mac_f1*(-2._dp*mac_aa*mac_a1*mac_q1p + &
4634 : & mac_q0*mac_q1pp) - &
4635 : & mac_f2*(-6._dp*mac_aa*mac_a1*mac_q1pp + mac_q0*mac_q1ppp + &
4636 : & mac_f2*(3._dp*mac_q1p*(-2._dp*mac_aa*mac_a1*mac_q1p + mac_q0*mac_q1pp) + &
4637 2351928 : & mac_f2*2._dp*mac_q0*(mac_q1p**3)*(1._dp + 3._dp*mac_q1*(1._dp + mac_q1))))
4638 :
4639 2351928 : d3gcrs_drs3=d3ecrs1_drs3-d3ecrs0_drs3+d3macrs_drs3*fsec_inv
4640 2351928 : d3ecrs_drs3=d3ecrs0_drs3+f_zeta*(zeta4*d3gcrs_drs3-d3macrs_drs3*fsec_inv)
4641 2351928 : factfppp_zeta=-two*third*factfpp_zeta*alpha_zeta2
4642 2351928 : fppp_zeta=factfppp_zeta*(((zetpm1_3(ipts))**5)-((zetmm1_3(ipts))**5))
4643 :
4644 : d3ecrs_dzeta3=(24._dp*zeta*f_zeta+36._dp*(zeta**2)*fp_zeta+ &
4645 : & 12._dp*(zeta**3)*fpp_zeta+(zeta**4)*fppp_zeta)*gcrs+ &
4646 2351928 : & fppp_zeta*(-macrs)*fsec_inv
4647 :
4648 : d3ecrs_drs2dzeta=dfzeta4_dzeta*(d2gcrs_drs2)+ &
4649 2351928 : & fp_zeta*(-d2macrs_drs2)*fsec_inv
4650 :
4651 : d3ecrs_dzeta2drs=d2fzeta4_dzeta2*dgcrs_drs+ &
4652 2351928 : & fpp_zeta*(-dmacrs_drs)*fsec_inv
4653 :
4654 :
4655 :
4656 :
4657 : ! ***************** all this part has been commented following the suggestion by xavier
4658 :
4659 : ! The following is the calculations of only a part of the third order derivatives.
4660 : ! the term d3ecrs_drho3 is the part which remains in the
4661 : ! non spin polarized limit
4662 : ! THIS CODING IS CORRECT, but the alternative one is also correct ...
4663 :
4664 : ! d3ecrs_drho3=(128._dp*pi*pi/243._dp)*(rs**7)*(decrs_drs)- &
4665 : ! & (48._dp*pi*pi/243._dp)*(rs**8)*d2ecrs_drs2- &
4666 : ! & (16._dp*pi*pi/243._dp)*(rs**9)*d3ecrs_drs3
4667 :
4668 : ! d3ecrs_drhoupdrho2=d3ecrs_drho3+ &
4669 : ! & a2fa*((-8._dp*pi/27._dp)*(rs**4)*d2ecrs_drsdzeta+ &
4670 : ! & (4._dp*pi/27._dp)*(rs**5)*d3ecrs_drs2dzeta)
4671 :
4672 :
4673 : ! d3ecrs_drhodndrho2=d3ecrs_drho3+ &
4674 : ! & g2fa*((-8._dp*pi/27._dp)*(rs**4)*d2ecrs_drsdzeta+ &
4675 : ! & (4._dp*pi/27._dp)*(rs**5)*d3ecrs_drs2dzeta)
4676 :
4677 :
4678 : ! third order derivatives of the exchange-correlation part
4679 :
4680 : ! d3ecrs_drup3=d3ecrs_drhoupdrho2+b2fa*d2ecrs_drsdzeta- &
4681 : ! & (2._dp/3._dp)*rs*b1fa*a1fa*d3ecrs_drs2dzeta- &
4682 : ! & (2._dp/3._dp)*rs*b1fa*b1fa*d3ecrs_dzeta2drs+ &
4683 : ! & c2fa*d2ecrs_dzeta2+c1fa*(a1fa*d3ecrs_dzeta2drs+a2fa*d3ecrs_dzeta3)
4684 :
4685 :
4686 : ! d3ecrs_drup2drdn=d3ecrs_drhoupdrho2+e2fa*d2ecrs_drsdzeta- &
4687 : ! & (2._dp/3._dp)*rs*e1fa*a1fa*d3ecrs_drs2dzeta- &
4688 : ! & (2._dp/3._dp)*rs*e1fa*b1fa*d3ecrs_dzeta2drs+ &
4689 : ! & f2fa*d2ecrs_dzeta2+f1fa*(a1fa*d3ecrs_dzeta2drs+a2fa*d3ecrs_dzeta3)
4690 :
4691 : ! d3ecrs_drupdrdn2=d3ecrs_drhodndrho2+h2fa*d2ecrs_drsdzeta- &
4692 : ! & (2._dp/3._dp)*rs*h1fa*g1fa*d3ecrs_drs2dzeta- &
4693 : ! & (2._dp/3._dp)*rs*h1fa*g2fa*d3ecrs_dzeta2drs+ &
4694 : ! & i2fa*d2ecrs_dzeta2+i1fa*(g1fa*d3ecrs_dzeta2drs+g2fa*d3ecrs_dzeta3)
4695 :
4696 :
4697 : ! d3ecrs_drdn3=d3ecrs_drhodndrho2+m2fa*d2ecrs_drsdzeta- &
4698 : ! & (2._dp/3._dp)*rs*m1fa*g1fa*d3ecrs_drs2dzeta- &
4699 : ! & (2._dp/3._dp)*rs*m1fa*g2fa*d3ecrs_dzeta2drs+ &
4700 : ! & n2fa*d2ecrs_dzeta2+n1fa*(g1fa*d3ecrs_dzeta2drs+g2fa*d3ecrs_dzeta3)
4701 :
4702 :
4703 : ! ********* suggested by xavier (now corrected, XG100524)
4704 :
4705 2351928 : sp1_up3=three-three*zeta
4706 2351928 : sp1_up2dn=one-three*zeta
4707 2351928 : sp1_updn2=-one-three*zeta
4708 2351928 : sp1_dn3=-three-three*zeta
4709 :
4710 2351928 : sp2_up3=three-six*zeta+three*zeta*zeta
4711 2351928 : sp2_up2dn=-one-two*zeta+three*zeta*zeta
4712 2351928 : sp2_updn2=-one+two*zeta+three*zeta*zeta
4713 2351928 : sp2_dn3=three+six*zeta+three*zeta*zeta
4714 :
4715 2351928 : sp3_up3=(one-zeta)**3
4716 2351928 : sp3_up2dn=-one+zeta+zeta**2-zeta**3
4717 2351928 : sp3_updn2=one+zeta-zeta**2-zeta**3
4718 2351928 : sp3_dn3=-(one+zeta)**3
4719 :
4720 2351928 : d3ecrs_sp0=(eight*rs*decrs_drs-three*rs*rs*d2ecrs_drs2-rs*rs*rs*d3ecrs_drs3)/(rhotot*rhotot*27.0_dp)
4721 2351928 : d3ecrs_sp1=(four*rs*d2ecrs_drsdzeta+rs*rs*d3ecrs_drs2dzeta)/(rhotot*rhotot*nine)
4722 2351928 : d3ecrs_sp2=(-three*d2ecrs_dzeta2-rs*d3ecrs_dzeta2drs)/(rhotot*rhotot*three)
4723 2351928 : d3ecrs_sp3=d3ecrs_dzeta3/(rhotot*rhotot)
4724 :
4725 2351928 : d3ecrs_drup3=d3ecrs_sp0+d3ecrs_sp1*sp1_up3+d3ecrs_sp2*sp2_up3+d3ecrs_sp3*sp3_up3
4726 2351928 : d3ecrs_drup2drdn=d3ecrs_sp0+d3ecrs_sp1*sp1_up2dn+d3ecrs_sp2*sp2_up2dn+d3ecrs_sp3*sp3_up2dn
4727 2351928 : d3ecrs_drupdrdn2=d3ecrs_sp0+d3ecrs_sp1*sp1_updn2+d3ecrs_sp2*sp2_updn2+d3ecrs_sp3*sp3_updn2
4728 2351928 : d3ecrs_drdn3=d3ecrs_sp0+d3ecrs_sp1*sp1_dn3+d3ecrs_sp2*sp2_dn3+d3ecrs_sp3*sp3_dn3
4729 :
4730 : ! **** end of the section suggested by xavier...
4731 :
4732 :
4733 : ! fab: this is the end of the if over order==3
4734 :
4735 :
4736 : end if
4737 :
4738 : ! fab: I think the following lines are wrong..indeed we are in the case option>0, so option cannot be -1
4739 : ! I comment them and I put the if only for option 1 and 3
4740 :
4741 : ! if(option==1 .or. option==-1 .or. option==3)then
4742 : ! dvxci(ipts,1)=dvxci(ipts,1)+d2ecrs_drup2
4743 : ! dvxci(ipts,2)=dvxci(ipts,2)+d2ecrs_drdndrup
4744 : ! dvxci(ipts,3)=dvxci(ipts,3)+d2ecrs_drdn2
4745 :
4746 :
4747 : ! fab: however, here the thing seems a bit strange...option=3 doesn't seem to be completely implemented
4748 : ! (the second derivatives of ec1_q and ec0_q are the derived only in correspondance of the first derivative in the case option !=3 and !=4)
4749 : ! so..I think that here the case "or option==3 should be cancelled
4750 :
4751 61422958 : if(option==1 .or. option==3)then
4752 45989551 : dvxci(ipts,1)=dvxci(ipts,1)+d2ecrs_drup2
4753 45989551 : dvxci(ipts,2)=dvxci(ipts,2)+d2ecrs_drdndrup
4754 45989551 : dvxci(ipts,3)=dvxci(ipts,3)+d2ecrs_drdn2
4755 :
4756 45989551 : if(order==3) then
4757 : ! third order derivatives of the spin polarized exchange+correlation energy
4758 2351928 : d2vxci(ipts,1)=d2vxci(ipts,1)+d3ecrs_drup3
4759 2351928 : d2vxci(ipts,2)=d2vxci(ipts,2)+d3ecrs_drup2drdn
4760 2351928 : d2vxci(ipts,3)=d2vxci(ipts,3)+d3ecrs_drupdrdn2
4761 2351928 : d2vxci(ipts,4)=d2vxci(ipts,4)+d3ecrs_drdn3
4762 : ! DEBUG
4763 : ! wecrsz(ipts,1)=ecrs
4764 : ! wecrsz(ipts,1)=ecrs*rhotot
4765 : ! wecrsz(ipts,2)=rs
4766 : ! wecrsz(ipts,2)=rho_updn(ipts,1)
4767 : ! wecrsz(ipts,3)=zeta
4768 : ! wecrsz(ipts,3)=rho_updn(ipts,2)
4769 : ! wecrsz(ipts,5)=ecrs0
4770 : ! wecrsz(ipts,6)=gcrs
4771 : ! wecrsz(ipts,7)=macrs
4772 : ! wecrsz(ipts,8)=ecrs1
4773 : ! d1wecrsz(ipts,1)=decrs_drs
4774 : ! d1wecrsz(ipts,1)=decrs_drup
4775 : ! d1wecrsz(ipts,2)=decrs_dzeta
4776 : ! d1wecrsz(ipts,2)=decrs_drdn
4777 : ! d1wecrsz(ipts,5)=decrs0_drs
4778 : ! d1wecrsz(ipts,6)=dgcrs_drs
4779 : ! d1wecrsz(ipts,7)=dmacrs_drs
4780 : ! d1wecrsz(ipts,8)=decrs1_drs
4781 : ! d2wecrsz(ipts,1)=d2ecrs_drs2
4782 : ! d2wecrsz(ipts,1)=d2ecrs_drup2
4783 : ! d2wecrsz(ipts,2)=d2ecrs_drsdzeta
4784 : ! d2wecrsz(ipts,2)=d2ecrs_drdndrup
4785 : ! d2wecrsz(ipts,3)=d2ecrs_dzeta2
4786 : ! d2wecrsz(ipts,3)=d2ecrs_drdn2
4787 : ! d2wecrsz(ipts,5)=d2ecrs0_drs2
4788 : ! d2wecrsz(ipts,6)=d2gcrs_drs2
4789 : ! d2wecrsz(ipts,7)=d2macrs_drs2
4790 : ! d2wecrsz(ipts,8)=d2ecrs1_drs2
4791 : ! d3wecrsz(ipts,1)=d3ecrs_drs3
4792 : ! d3wecrsz(ipts,1)=d3ecrs_drup3
4793 : ! d3wecrsz(ipts,2)=d3ecrs_drs2dzeta
4794 : ! d3wecrsz(ipts,2)=d3ecrs_drup2drdn
4795 : ! d3wecrsz(ipts,3)=d3ecrs_dzeta2drs
4796 : ! d3wecrsz(ipts,3)=d3ecrs_drupdrdn2
4797 : ! d3wecrsz(ipts,4)=d3ecrs_dzeta3
4798 : ! d3wecrsz(ipts,4)=d3ecrs_drdn3
4799 : ! d3wecrsz(ipts,5)=d3ecrs0_drs3
4800 : ! d3wecrsz(ipts,6)=d3gcrs_drs3
4801 : ! d3wecrsz(ipts,7)=d3macrs_drs3
4802 : ! d3wecrsz(ipts,8)=d3ecrs1_drs3
4803 : ! ENDDEBUG
4804 : end if
4805 :
4806 :
4807 : else
4808 15433407 : dvxci(ipts,9)=d2ecrs_drup2
4809 15433407 : dvxci(ipts,10)=d2ecrs_drdndrup
4810 15433407 : dvxci(ipts,11)=d2ecrs_drdn2
4811 : end if
4812 :
4813 :
4814 :
4815 :
4816 : ! -----------------------------------------------------------------------------
4817 : ! Eventually add the GGA correlation part of the PBE functional
4818 : ! Note : the computation of the potential in the spin-unpolarized
4819 : ! case could be optimized much further. Other optimizations are left to do.
4820 :
4821 61422958 : if(option==2 .or. option==5 .or. option==6 .or. option==7)then
4822 : ! The definition of phi has been slightly changed, because
4823 : ! the original PBE one gives divergent behaviour for fully
4824 : ! polarized points
4825 : ! zetpm1_3=(1.0_dp+zeta*alpha_zeta)**(-third)
4826 : ! zetmm1_3=(1.0_dp-zeta*alpha_zeta)**(-third)
4827 : phi_zeta=( zetpm1_3(ipts)*(1.0_dp+zeta*alpha_zeta)+ &
4828 15433407 : & zetmm1_3(ipts)*(1.0_dp-zeta*alpha_zeta) )*0.5_dp
4829 15433407 : phip_zeta=(zetpm1_3(ipts)-zetmm1_3(ipts))*third*alpha_zeta
4830 15433407 : phi_zeta_inv=1.0_dp/phi_zeta
4831 15433407 : phi_logder=phip_zeta*phi_zeta_inv
4832 15433407 : phi3_zeta=phi_zeta*phi_zeta*phi_zeta
4833 15433407 : gamphi3inv=gamma_inv*phi_zeta_inv*phi_zeta_inv*phi_zeta_inv
4834 : phipp_zeta=-alpha_zeta*alpha_zeta*ninth*&
4835 : & (zetpm1_3(ipts)*zetpm1_3(ipts)*zetpm1_3(ipts)*zetpm1_3(ipts) + &
4836 15433407 : & zetmm1_3(ipts)*zetmm1_3(ipts)*zetmm1_3(ipts)*zetmm1_3(ipts) )
4837 :
4838 : ! From ec to bb
4839 15433407 : bb=ecrs*gamphi3inv
4840 15433407 : dbb_drs=decrs_drs*gamphi3inv
4841 15433407 : dbb_dzeta=gamphi3inv*(decrs_dzeta-three*ecrs*phi_logder)
4842 15433407 : d2bb_drs2=d2ecrs_drs2*gamphi3inv
4843 15433407 : d2bb_drsdzeta=gamphi3inv*(d2ecrs_drsdzeta-three*decrs_drs*phi_logder)
4844 : d2bb_dzeta2=gamphi3inv*(d2ecrs_dzeta2-six*decrs_dzeta*phi_logder+&
4845 15433407 : & 12.0_dp*ecrs*phi_logder*phi_logder-three*ecrs*phi_zeta_inv*phipp_zeta)
4846 :
4847 : ! From bb to cc
4848 15433407 : exp_pbe=exp(-bb)
4849 15433407 : cc=one/(exp_pbe-one)
4850 15433407 : dcc_dbb=cc*cc*exp_pbe
4851 15433407 : dcc_drs=dcc_dbb*dbb_drs
4852 15433407 : dcc_dzeta=dcc_dbb*dbb_dzeta
4853 15433407 : d2cc_dbb2=cc*cc*exp_pbe*(two*cc*exp_pbe-one)
4854 15433407 : d2cc_drs2=d2cc_dbb2*dbb_drs*dbb_drs+dcc_dbb*d2bb_drs2
4855 15433407 : d2cc_drsdzeta=d2cc_dbb2*dbb_drs*dbb_dzeta+dcc_dbb*d2bb_drsdzeta
4856 15433407 : d2cc_dzeta2=d2cc_dbb2*dbb_dzeta*dbb_dzeta+dcc_dbb*d2bb_dzeta2
4857 :
4858 : ! From cc to aa
4859 15433407 : coeff_aa=beta*gamma_inv*phi_zeta_inv*phi_zeta_inv
4860 15433407 : aa=coeff_aa*cc
4861 15433407 : daa_drs=coeff_aa*dcc_drs
4862 15433407 : daa_dzeta=-two*aa*phi_logder+coeff_aa*dcc_dzeta
4863 15433407 : d2aa_drs2=coeff_aa*d2cc_drs2
4864 15433407 : d2aa_drsdzeta=-two*daa_drs*phi_logder+coeff_aa*d2cc_drsdzeta
4865 : d2aa_dzeta2=aa*(-two*phi_zeta_inv*phipp_zeta+six*phi_logder*phi_logder)+&
4866 15433407 : & coeff_aa*(-four*dcc_dzeta*phi_logder+d2cc_dzeta2)
4867 :
4868 : ! Introduce tt : do not assume that the spin-dependent gradients are collinear
4869 15433407 : grrho2=grho2_updn(ipts,3)
4870 15433407 : dtt_dg=two*rhotot_inv*rhotot_inv*rhotmot*coeff_tt
4871 : ! Note that tt is (the t variable of PBE divided by phi) squared
4872 15433407 : tt=half*grrho2*dtt_dg
4873 :
4874 : ! Get xx from aa and tt
4875 15433407 : xx=aa*tt
4876 15433407 : dxx_drs=daa_drs*tt
4877 15433407 : dxx_dzeta=daa_dzeta*tt
4878 15433407 : dxx_dtt=aa
4879 15433407 : d2xx_drs2=d2aa_drs2*tt
4880 15433407 : d2xx_drsdzeta=d2aa_drsdzeta*tt
4881 15433407 : d2xx_drsdtt=daa_drs
4882 15433407 : d2xx_dttdzeta=daa_dzeta
4883 15433407 : d2xx_dzeta2=d2aa_dzeta2*tt
4884 :
4885 : ! From xx to pade
4886 15433407 : pade_den=one/(one+xx*(one+xx))
4887 15433407 : pade=(one+xx)*pade_den
4888 15433407 : dpade_dxx=-xx*(two+xx)*pade_den**2
4889 15433407 : dpade_drs=dpade_dxx*dxx_drs
4890 15433407 : dpade_dtt=dpade_dxx*dxx_dtt
4891 15433407 : dpade_dzeta=dpade_dxx*dxx_dzeta
4892 15433407 : d2pade_dxx2=two*(-one+xx*xx*(three+xx))*pade_den*pade_den*pade_den
4893 15433407 : d2pade_drs2=d2pade_dxx2*dxx_drs*dxx_drs+dpade_dxx*d2xx_drs2
4894 15433407 : d2pade_drsdtt=d2pade_dxx2*dxx_drs*dxx_dtt+dpade_dxx*d2xx_drsdtt
4895 15433407 : d2pade_drsdzeta=d2pade_dxx2*dxx_drs*dxx_dzeta+dpade_dxx*d2xx_drsdzeta
4896 15433407 : d2pade_dtt2=d2pade_dxx2*dxx_dtt*dxx_dtt
4897 15433407 : d2pade_dttdzeta=d2pade_dxx2*dxx_dtt*dxx_dzeta+dpade_dxx*d2xx_dttdzeta
4898 15433407 : d2pade_dzeta2=d2pade_dxx2*dxx_dzeta*dxx_dzeta+dpade_dxx*d2xx_dzeta2
4899 :
4900 : ! From pade to qq
4901 15433407 : coeff_qq=tt*phi_zeta_inv*phi_zeta_inv
4902 15433407 : qq=coeff_qq*pade
4903 15433407 : dqq_drs=coeff_qq*dpade_drs
4904 15433407 : dqq_dtt=pade*phi_zeta_inv*phi_zeta_inv+coeff_qq*dpade_dtt
4905 15433407 : dqq_dzeta=coeff_qq*(dpade_dzeta-two*pade*phi_logder)
4906 15433407 : d2qq_drs2=coeff_qq*d2pade_drs2
4907 15433407 : d2qq_drsdtt=phi_zeta_inv*phi_zeta_inv*(dpade_drs+tt*d2pade_drsdtt)
4908 15433407 : d2qq_drsdzeta=coeff_qq*(d2pade_drsdzeta-two*dpade_drs*phi_logder)
4909 15433407 : d2qq_dtt2=phi_zeta_inv*phi_zeta_inv*(two*dpade_dtt+tt*d2pade_dtt2)
4910 : d2qq_dttdzeta=phi_zeta_inv*phi_zeta_inv*(dpade_dzeta-two*pade*phi_logder)+&
4911 15433407 : & coeff_qq*(d2pade_dttdzeta-two*dpade_dtt*phi_logder)
4912 : d2qq_dzeta2=coeff_qq*( d2pade_dzeta2-four*dpade_dzeta*phi_logder &
4913 : & +six*pade*phi_logder*phi_logder &
4914 15433407 : & -two*pade*phi_zeta_inv*phipp_zeta)
4915 :
4916 : ! From qq to rr
4917 15433407 : arg_rr=one+beta*gamma_inv*qq
4918 15433407 : div_rr=one/arg_rr
4919 15433407 : rr=gamma*log(arg_rr)
4920 15433407 : drr_dqq=beta*div_rr
4921 15433407 : drr_drs=drr_dqq*dqq_drs
4922 15433407 : drr_dtt=drr_dqq*dqq_dtt
4923 15433407 : drr_dzeta=drr_dqq*dqq_dzeta
4924 15433407 : d2rr_dqq2=-div_rr**2*beta*beta*gamma_inv
4925 15433407 : d2rr_drs2=d2rr_dqq2*dqq_drs*dqq_drs+drr_dqq*d2qq_drs2
4926 15433407 : d2rr_drsdtt=d2rr_dqq2*dqq_drs*dqq_dtt+drr_dqq*d2qq_drsdtt
4927 15433407 : d2rr_drsdzeta=d2rr_dqq2*dqq_drs*dqq_dzeta+drr_dqq*d2qq_drsdzeta
4928 15433407 : d2rr_dtt2=d2rr_dqq2*dqq_dtt*dqq_dtt+drr_dqq*d2qq_dtt2
4929 15433407 : d2rr_dttdzeta=d2rr_dqq2*dqq_dtt*dqq_dzeta+drr_dqq*d2qq_dttdzeta
4930 15433407 : d2rr_dzeta2=d2rr_dqq2*dqq_dzeta*dqq_dzeta+drr_dqq*d2qq_dzeta2
4931 :
4932 : ! From rr to hh
4933 15433407 : hh=phi3_zeta*rr
4934 15433407 : dhh_drs=phi3_zeta*drr_drs
4935 15433407 : dhh_dtt=phi3_zeta*drr_dtt
4936 15433407 : dhh_dzeta=phi3_zeta*(drr_dzeta+three*rr*phi_logder)
4937 15433407 : d2hh_drs2=phi3_zeta*d2rr_drs2
4938 15433407 : d2hh_drsdtt=phi3_zeta*d2rr_drsdtt
4939 15433407 : d2hh_drsdzeta=phi3_zeta*(d2rr_drsdzeta+three*drr_drs*phi_logder)
4940 15433407 : d2hh_dtt2=phi3_zeta*d2rr_dtt2
4941 15433407 : d2hh_dttdzeta=phi3_zeta*(d2rr_dttdzeta+three*drr_dtt*phi_logder)
4942 : d2hh_dzeta2=phi3_zeta*(six*rr*phi_logder*phi_logder+&
4943 : & six*phi_logder*drr_dzeta+d2rr_dzeta2) &
4944 15433407 : & +three*phi_zeta*phi_zeta*rr*phipp_zeta
4945 :
4946 : ! The GGA correlation energy is added
4947 15433407 : exci(ipts)=exci(ipts)+hh
4948 :
4949 : ! Change of variables : from (rs,zeta,tt) to (rhoup,rhodn,grrho)
4950 :
4951 :
4952 : ! From hh to the derivative of the energy wrt the density
4953 15433407 : drhohh_drho=hh-third*rs*dhh_drs-zeta*dhh_dzeta-seven*third*tt*dhh_dtt
4954 15433407 : vxci(ipts,1)=vxci(ipts,1)+drhohh_drho+dhh_dzeta
4955 15433407 : vxci(ipts,2)=vxci(ipts,2)+drhohh_drho-dhh_dzeta
4956 :
4957 :
4958 : ! From hh to the derivative of the energy wrt to the gradient of the
4959 : ! density, divided by the gradient of the density
4960 : ! (The v3.3 definition includes the division by the norm of the gradient)
4961 15433407 : dvxcdgr(ipts,3)=rhotot*dtt_dg*dhh_dtt
4962 :
4963 : d2rhohh_drho2=rhotot_inv*&
4964 : & (-two*ninth*rs*dhh_drs +seven*four*ninth*tt*dhh_dtt &
4965 : & +ninth*rs*rs*d2hh_drs2+zeta*zeta*d2hh_dzeta2+(seven*third*tt)**2*d2hh_dtt2 &
4966 : & +two*third*rs*zeta*d2hh_drsdzeta+two*seven*ninth*rs*tt*d2hh_drsdtt &
4967 15433407 : & +two*seven*third*tt*zeta*d2hh_dttdzeta)
4968 : d2rhohh_drhodg=dtt_dg*(-four*third*dhh_dtt-third*rs*d2hh_drsdtt &
4969 15433407 : & -zeta*d2hh_dttdzeta-seven*third*tt*d2hh_dtt2)
4970 :
4971 : ! Component 12 : first derivative with respect to the gradient
4972 : ! of the density, div by the grad of the density
4973 15433407 : dvxci(ipts,12)=dvxcdgr(ipts,3)
4974 : ! Components 9, 10 and 11 : second derivatives with respect to the spin-density
4975 : ! Note that there is already a contribution from LSDA
4976 : dvxci(ipts,9)=dvxci(ipts,9)+d2rhohh_drho2+rhotot_inv* &
4977 : & ( d2hh_dzeta2*(one-two*zeta) &
4978 15433407 : & -two*third*rs*d2hh_drsdzeta-14.0_dp*third*tt*d2hh_dttdzeta)
4979 15433407 : dvxci(ipts,10)=dvxci(ipts,10)+d2rhohh_drho2-rhotot_inv*d2hh_dzeta2
4980 : dvxci(ipts,11)=dvxci(ipts,11)+d2rhohh_drho2+rhotot_inv* &
4981 : & ( d2hh_dzeta2*(one+two*zeta) &
4982 15433407 : & +two*third*rs*d2hh_drsdzeta+14.0_dp*third*tt*d2hh_dttdzeta)
4983 : ! Components 13 and 14 : second derivatives with respect to spin density
4984 : ! and gradient, divided by the gradient
4985 15433407 : dvxci(ipts,13)=d2rhohh_drhodg+dtt_dg*d2hh_dttdzeta
4986 15433407 : dvxci(ipts,14)=d2rhohh_drhodg-dtt_dg*d2hh_dttdzeta
4987 : ! Component 15 : derivative of the (derivative wrt the gradient div by the grad),
4988 : ! divided by the grad
4989 15433407 : dvxci(ipts,15)=rhotot*d2hh_dtt2*dtt_dg*dtt_dg
4990 :
4991 : ! End condition of GGA
4992 : end if
4993 :
4994 : else ! no correlation
4995 :
4996 3061800 : if(ndvxci > 8)then
4997 : ! Must zero the correlation part of the xc kernel
4998 0 : dvxci(:,9:15)=zero
4999 : end if
5000 :
5001 : ! End condition of including correlation, and not only exchange
5002 : end if
5003 :
5004 : ! Correlation has been added
5005 : ! -----------------------------------------------------------------------------
5006 :
5007 : end do
5008 : end if
5009 :
5010 : ! fab: this should be the else on nspden
5011 : else
5012 : ! Disallowed value for nspden
5013 : write(message, '(a,a,a,i12,a)' )&
5014 0 : & ' Argument nspden must be 1 or 2; ',ch10,&
5015 0 : & ' Value provided as argument was ',nspden,'.'
5016 0 : ABI_BUG(message)
5017 : end if
5018 :
5019 : !DEBUG
5020 : !Finite-difference debugging, do not take away
5021 : !if(debug/=0)then
5022 : !do ipts=1,5,5
5023 :
5024 : !rho=rho_updn(ipts,1)+rho_updn(ipts,2)
5025 : !write(std_out,'(a,i5,a,2es16.8)' ) ' Point number',ipts,' with rhoup,rhodn=',rho_updn(ipts,1),rho_updn(ipts,2)
5026 : !write(std_out,'(a,i5,a,2es16.8)' ) ' Point number',ipts+1,' with rhoup,rhodn=',rho_updn(ipts+1,1),rho_updn(ipts+1,2)
5027 : !write(std_out,'(a,i5,a,2es16.8)' ) ' Point number',ipts+2,' with rhoup,rhodn=',rho_updn(ipts+2,1),rho_updn(ipts+2,2)
5028 : !write(std_out,'(a,i5,a,2es16.8)' ) ' Point number',ipts+3,' with rhoup,rhodn=',rho_updn(ipts+3,1),rho_updn(ipts+3,2)
5029 : !write(std_out,'(a,i5,a,2es16.8)' ) ' Point number',ipts+4,' with rhoup,rhodn=',rho_updn(ipts+4,1),rho_updn(ipts+4,2)
5030 :
5031 : !! For rho
5032 : !if(debug==1)then
5033 : !write(std_out,'(a)' )' Direct values :'
5034 : !write(std_out,'(3es16.8)' )exci(ipts)*rho,vxci(ipts,1),vxci(ipts,2)
5035 : !else
5036 : !! For grho2
5037 : !write(std_out,'(4es16.8)' )exci(ipts)*rho,dvxcdgr(ipts,1),&
5038 : !& dvxcdgr(ipts,2),dvxcdgr(ipts,3)
5039 : !end if
5040 :
5041 : !write(std_out,'(4es16.8)' )dvxci(ipts,1:3) ! For LDA
5042 : !write(std_out,'(a)' )' 3rd-order '
5043 : !write(std_out,'(4es16.8)' )d2vxci(ipts,1:4) ! For LDA
5044 :
5045 : !write(std_out,'(4es16.8)' )dvxci(ipts,1:4) ! For exchange
5046 : !write(std_out,'(4es16.8)' )dvxci(ipts,5:8) ! For exchange
5047 : !write(std_out,'(4es16.8)' )dvxci(ipts,9:12) ! For correlation
5048 : !write(std_out,'(4es16.8)' )dvxci(ipts,13:15) ! For correlation
5049 :
5050 : !if(debug==1)then
5051 : !! For rho
5052 : !write(std_out,'(a)' )' Finite-difference values :'
5053 : !write(std_out,'(3es16.8)' )exci(ipts)*rho,&
5054 : !& ( exci(ipts+1)*(rho+delta) - exci(ipts+2)*(rho-delta) )/2._dp/delta,&
5055 : !& ( exci(ipts+3)*(rho+delta) - exci(ipts+4)*(rho-delta) )/2._dp/delta
5056 : !write(std_out,'(3es16.8)' )&
5057 : !& ( vxci(ipts+1,1) - vxci(ipts+2,1) )/2._dp/delta,&
5058 : !& ( vxci(ipts+3,1) - vxci(ipts+4,1) )/2._dp/delta,&
5059 : !& ( vxci(ipts+3,2) - vxci(ipts+4,2) )/2._dp/delta
5060 : !!This is for order 3
5061 : !write(std_out,'(a)' )' 3rd-order by two methods, giving components 1, 2, 3, then on the next line 2, 3, 4 '
5062 : !write(std_out,'(3es16.8)' )&
5063 : !& ( dvxci(ipts+1,1) - dvxci(ipts+2,1) )/2._dp/delta,&
5064 : !& ( dvxci(ipts+1,2) - dvxci(ipts+2,2) )/2._dp/delta,&
5065 : !& ( dvxci(ipts+1,3) - dvxci(ipts+2,3) )/2._dp/delta
5066 : !write(std_out,'(3es16.8)' )&
5067 : !& ( dvxci(ipts+3,1) - dvxci(ipts+4,1) )/2._dp/delta,&
5068 : !& ( dvxci(ipts+3,2) - dvxci(ipts+4,2) )/2._dp/delta,&
5069 : !& ( dvxci(ipts+3,3) - dvxci(ipts+4,3) )/2._dp/delta
5070 :
5071 : !write(std_out,*)
5072 : !write(std_out,*)' Now for ecrs and derivatives '
5073 : !write(std_out,'(a)' )' ecrs, rs, zeta ='
5074 : !write(std_out,'(3es16.8)' )wecrsz(ipts,1:3)
5075 : !write(std_out,'(3es16.8)' )wecrsz(ipts+1,1:3)
5076 : !write(std_out,'(3es16.8)' )wecrsz(ipts+2,1:3)
5077 : !write(std_out,'(3es16.8)' )wecrsz(ipts+3,1:3)
5078 : !write(std_out,'(3es16.8)' )wecrsz(ipts+4,1:3)
5079 : !write(std_out,'(a)' )' ecrs derivatives :'
5080 : !write(std_out,'(3es16.8)' )d1wecrsz(ipts,1:2)
5081 : !write(std_out,'(3es16.8)' )d2wecrsz(ipts,1:3)
5082 : !write(std_out,'(4es16.8)' )d3wecrsz(ipts,1:4)
5083 : !write(std_out,'(a)' )' Finite-differences :'
5084 : !write(std_out,'(3es16.8)' )&
5085 : !& ( wecrsz(ipts+1,1) - wecrsz(ipts+2,1) )/( wecrsz(ipts+1,2) - wecrsz(ipts+2,2) ),&
5086 : !& ( wecrsz(ipts+3,1) - wecrsz(ipts+4,1) )/( wecrsz(ipts+3,3) - wecrsz(ipts+4,3) )
5087 : !write(std_out,'(3es16.8)' )&
5088 : !& ( d1wecrsz(ipts+1,1) - d1wecrsz(ipts+2,1) )/( wecrsz(ipts+1,2) - wecrsz(ipts+2,2) ),&
5089 : !& ( d1wecrsz(ipts+1,2) - d1wecrsz(ipts+2,2) )/( wecrsz(ipts+1,2) - wecrsz(ipts+2,2) )
5090 : !write(std_out,'(3es16.8)' )&
5091 : !& ( d1wecrsz(ipts+3,1) - d1wecrsz(ipts+4,1) )/( wecrsz(ipts+3,3) - wecrsz(ipts+4,3) ),&
5092 : !& ( d1wecrsz(ipts+3,2) - d1wecrsz(ipts+4,2) )/( wecrsz(ipts+3,3) - wecrsz(ipts+4,3) )
5093 : !write(std_out,'(a)' )' Finite-differences, 3rd order :'
5094 : !write(std_out,'(3es16.8)' )&
5095 : !& ( d2wecrsz(ipts+1,1) - d2wecrsz(ipts+2,1) )/( wecrsz(ipts+1,2) - wecrsz(ipts+2,2) ),&
5096 : !& ( d2wecrsz(ipts+1,2) - d2wecrsz(ipts+2,2) )/( wecrsz(ipts+1,2) - wecrsz(ipts+2,2) ),&
5097 : !& ( d2wecrsz(ipts+1,3) - d2wecrsz(ipts+2,3) )/( wecrsz(ipts+1,2) - wecrsz(ipts+2,2) )
5098 : !write(std_out,'(3es16.8)' )&
5099 : !& ( d2wecrsz(ipts+3,1) - d2wecrsz(ipts+4,1) )/( wecrsz(ipts+3,3) - wecrsz(ipts+4,3) ),&
5100 : !& ( d2wecrsz(ipts+3,2) - d2wecrsz(ipts+4,2) )/( wecrsz(ipts+3,3) - wecrsz(ipts+4,3) ),&
5101 : !& ( d2wecrsz(ipts+3,3) - d2wecrsz(ipts+4,3) )/( wecrsz(ipts+3,3) - wecrsz(ipts+4,3) )
5102 :
5103 :
5104 : !!This is for GGA
5105 :
5106 : !write(std_out,'(4es16.8)' )&
5107 : !& ( dvxcdgr(ipts+1,1) - dvxcdgr(ipts+2,1) )/2._dp/delta,&
5108 : !& ( dvxcdgr(ipts+3,2) - dvxcdgr(ipts+4,2) )/2._dp/delta,&
5109 : !& ( dvxcdgr(ipts+1,3) - dvxcdgr(ipts+2,3) )/2._dp/delta,&
5110 : !& ( dvxcdgr(ipts+3,3) - dvxcdgr(ipts+4,3) )/2._dp/delta
5111 : !else
5112 : !! For grho2 (should distinguish exchange and correlation ...)
5113 : !grr=sqrt(grho2_updn(ipts,1)) ! Analysis of exchange
5114 : !grr=sqrt(grho2_updn(ipts,3)) ! Analysis of correlation
5115 : !write(std_out,'(3es16.8)' )exci(ipts)*rho,&
5116 : !& ( exci(ipts+1)*rho - exci(ipts+2)*rho )/2._dp/delta/grr,&
5117 : !& ( exci(ipts+3)*rho - exci(ipts+4)*rho )/2._dp/delta/grr
5118 : !write(std_out,'(3es16.8)' )&
5119 : !& ( vxci(ipts+1,1) - vxci(ipts+2,1) )/2._dp/delta/grr,&
5120 : !& ( vxci(ipts+3,1) - vxci(ipts+4,1) )/2._dp/delta/grr,&
5121 : !& ( vxci(ipts+3,2) - vxci(ipts+4,2) )/2._dp/delta/grr
5122 : !write(std_out,'(4es16.8)' )&
5123 : !& ( dvxcdgr(ipts+1,1) - dvxcdgr(ipts+2,1) )/2._dp/delta/grr,&
5124 : !& ( dvxcdgr(ipts+3,2) - dvxcdgr(ipts+4,2) )/2._dp/delta/grr,&
5125 : !& ( dvxcdgr(ipts+1,3) - dvxcdgr(ipts+2,3) )/2._dp/delta/grr,&
5126 : !& ( dvxcdgr(ipts+3,3) - dvxcdgr(ipts+4,3) )/2._dp/delta/grr
5127 : !end if
5128 : !end do
5129 : !stop
5130 : !end if
5131 : !ENDDEBUG
5132 :
5133 317862 : ABI_FREE(rhoarr)
5134 317862 : ABI_FREE(rhom1_3)
5135 317862 : ABI_FREE(rho_updnm1_3)
5136 317862 : ABI_FREE(zetm)
5137 317862 : ABI_FREE(zetmm1_3)
5138 317862 : ABI_FREE(zetp)
5139 317862 : ABI_FREE(zetpm1_3)
5140 :
5141 : !DEBUG
5142 : !deallocate(wecrsz,d1wecrsz,d2wecrsz,d3wecrsz)
5143 : !ENDDEBUG
5144 :
5145 : !DEBUG
5146 : !write(std_out,*)' xcpbe : exit'
5147 : !write(std_out,*)' nspden=',nspden
5148 : !if(order==2)stop
5149 : !ENDDEBUG
5150 :
5151 542076 : end subroutine xcpbe
5152 : !!***
5153 :
5154 : !!****f* ABINIT/xckdt16
5155 : !! NAME
5156 : !! xckdt16
5157 : !!
5158 : !! FUNCTION
5159 : !! Treat TGGA temperature-dependant exchange-correlation functional KDT16,
5160 : !! return the associated Exc energy, potential, and, in case of response-function,
5161 : !! functions needed to build the XC kernel.
5162 : !!
5163 : !! NOTES
5164 : !! Karasiev-Dufty-Trickey (KDT16) TGGA xc-functional
5165 : !! V.V. Karasiev, J.W. Dufty, and S.B. Trickey, PRL 120(7), 076401 (2018) [[cite:Karasiev2018]]
5166 : !! ixc=60 means KDT16 xc (PBE TGGA parametrization)
5167 : !! ixc=61 means KDT16 xc (PBEsol TGGA parametrization)
5168 : !! ixc=62 means KDT16 xc (PBEmol TGGA parametrization)
5169 : !!
5170 : !! INPUTS
5171 : !! grho2_updn(npts,2*nspden-1)=square of the gradient of the spin-up,
5172 : !! and, if nspden==2, spin-down, and total density (Hartree/Bohr**2),
5173 : !! only used if gradient corrected functional (option=2,-2,-4 and 4 or beyond)
5174 : !! ixc=index of the XC functional
5175 : !! npts= number of points to be computed
5176 : !! nspden=1 for unpolarized, 2 for spin-polarized
5177 : !! rhor=value of electronic density at each point
5178 : !! rspts(npt)=Wigner-Seitz radii at each point
5179 : !! el_temp=electronic temperature (hartree)
5180 : !!
5181 : !! OUTPUT
5182 : !! dvxcdgr(npts,3)=partial derivative of the exchange-correlation
5183 : !! energy (exci*$\rho$) with respect to the spin-up (dvxcdgr(:,1)),
5184 : !! spin-down (dvxcdgr(:,2)), or total spin (dvxcdgr(:,3)) gradients of the density
5185 : !! divided by the norm of the gradient (the definition changed in v3.3)
5186 : !! exci(npts)=exchange-correlation free energy density (hartree)
5187 : !! tsxci(npts)=exchange-correlation entropy energy density (hartree)
5188 : !! vxci(npts,nspden)=input xc potential
5189 : !!
5190 : !! SOURCE
5191 57 : subroutine xckdt16(dvxcdgr,exci,tsxci,grho2_updn,ixc,npts,nspden,order,&
5192 57 : & rhor,rspts,el_temp,vxci,&
5193 : & dvxci) ! optional arguments
5194 : !scalars
5195 : integer,intent(in) :: ixc,npts,nspden,order
5196 : !arrays
5197 : real(dp),intent(in) :: grho2_updn(npts,2*nspden-1)
5198 : real(dp),intent(in) :: rhor(npts),rspts(npts),el_temp
5199 : real(dp),intent(out) :: dvxcdgr(npts,3),exci(npts),tsxci(npts),vxci(npts,nspden)
5200 : real(dp),intent(out),optional :: dvxci(npts)
5201 : !Local variables-------------------------------
5202 : !scalars
5203 : integer :: ipt,i
5204 : real(dp) :: tfac,rs,rho,tempf,tred
5205 : real(dp) :: grho,degauss
5206 : real(dp) :: fxclda,tsxclda,vxclda,einxclda
5207 : real(dp) :: fx,v1x,v2x,einx,tsx
5208 : real(dp) :: fc,v1c,v2c,einc,tsc
5209 : real(dp) :: drho
5210 : !character(len=500) :: message
5211 : !arrays
5212 : real(dp) :: vxctmp(5)
5213 :
5214 : ! *************************************************************************
5215 :
5216 57 : tfac=(3._dp*pi**2)**(2._dp/3._dp)/2._dp
5217 57 : degauss = el_temp*2._dp ! setup temperature (in Ry)
5218 : !Loop over grid points
5219 29815 : do ipt=1,npts
5220 29758 : rs=rspts(ipt)
5221 29758 : rho=rhor(ipt) !0.75_dp/pi/(rs**3)
5222 29758 : tempf=tfac*rho**(2._dp/3._dp) !(3._dp*pi**2*rho)**(2._dp/3._dp)/2._dp
5223 29758 : tred=el_temp/tempf
5224 29758 : grho=grho2_updn(ipt,1)*4.d0 ! this array must have grad2_rho_up even in
5225 : ! the spin-unpolarized case, such that
5226 : ! grad2_rho=4*grad2_rho_up=4*grad2_rho_dn
5227 29758 : call fxc_ksdt(fxclda,vxclda,einxclda,tsxclda,rs,tred,0)
5228 29758 : if(ixc.eq.60) then
5229 29758 : call fex_kdt16(rho,grho,5,fx,v1x,v2x,einx,tsx,degauss)
5230 29758 : call fec_kdt16(rho,grho,1,fc,v1c,v2c,einc,tsc,degauss)
5231 : ! elseif(ixc.eq.61) then ! These parametrizations are not yet active.
5232 : ! call fex_kdt16(rho,grho,6,fx,v1x,v2x,einx,tsx,degauss)
5233 : ! call fec_kdt16(rho,grho,2,fc,v1c,v2c,einc,tsc,degauss)
5234 : ! elseif(ixc.eq.62) then ! These parametrizations are not yet active.
5235 : ! call fex_kdt16(rho,grho,7,fx,v1x,v2x,einx,tsx,degauss)
5236 : ! call fec_kdt16(rho,grho,3,fc,v1c,v2c,einc,tsc,degauss)
5237 : endif
5238 29758 : exci(ipt)=(fx+fc)+fxclda
5239 29758 : tsxci(ipt)=(tsx+tsc)+tsxclda ! total exchange-correlation entropy energy: S_xc[n] = kTS_xc[n]/kT
5240 29758 : vxci(ipt,1)=(v1x+v1c)+vxclda
5241 29758 : dvxcdgr(ipt,3)=(v2x+v2c) !d(exc*rho)/d|gradRho|*1/|gradRho|
5242 29758 : dvxcdgr(ipt,1)=zero !dvxcdgr(ipt,3)*4.d0 ! d(exc*rho)/d|gradRho_up|*1/|gradRho_up|
5243 29815 : dvxcdgr(ipt,2)=zero !dvxcdgr(ipt,1) ! d(exc*rho)/d|gradRho_dn|*1/|gradRho_dn|
5244 : enddo
5245 : !for order==2, use numerical derivative
5246 57 : if(order==2) then
5247 : ! Loop over grid points
5248 7007 : do ipt=1,npts
5249 7000 : drho=0.01_dp*rhor(ipt)
5250 42000 : do i=1,5
5251 35000 : rho=rhor(ipt)+drho*dble(i-3)
5252 35000 : rs=(0.75_dp/pi/rho)**(1._dp/3._dp) ! density
5253 35000 : tempf=tfac*rho**(2._dp/3._dp) !(3._dp*pi**2*rho)**(2._dp/3._dp)/2._dp
5254 35000 : tred=el_temp/tempf
5255 35000 : if(ixc.eq.60) then
5256 35000 : call fex_kdt16(rho,grho,5,fx,v1x,v2x,einx,tsx,degauss)
5257 35000 : call fec_kdt16(rho,grho,1,fc,v1c,v2c,einc,tsc,degauss)
5258 : end if
5259 42000 : vxctmp(i)=v1x+v1c
5260 : enddo
5261 7000 : dvxci(ipt)=vxctmp(1)-8._dp*vxctmp(2)+8._dp*vxctmp(4)-vxctmp(5)
5262 7000 : dvxci(ipt)=dvxci(ipt)/(12._dp*drho)
5263 : ! In case something went wrong, set dvxc to zero.
5264 7007 : if( dvxci(ipt)/=dvxci(ipt) ) then
5265 0 : dvxci(ipt)=0._dp
5266 : ! write(message, '(a,2d12.5)' )&
5267 : !& 'dvxc = NaN: rs,tred=',rs,tred
5268 : ! ABI_WARNING(message)
5269 7000 : elseif(dvxci(ipt)>huge(1._dp)) then
5270 0 : dvxci(ipt)=0._dp
5271 : ! write(message, '(a,2d12.5)' )&
5272 : !& 'dvxc = Inf: rs,tred=',rs,tred
5273 : ! ABI_WARNING(message)
5274 : endif
5275 : enddo
5276 : endif
5277 57 : end subroutine xckdt16
5278 : !!***
5279 :
5280 : !!****f* ABINIT/fex_kdt16
5281 : !! NAME
5282 : !! fex_kdt16
5283 : !!
5284 : !! FUNCTION
5285 : !! Returns TGGA exchange free energy, internal energy and entropy energy of xc functional KDT16
5286 : !!
5287 : !! NOTES
5288 : !! Karasiev GGA X (without TLDA exchange): see subroutine enfact1_kdt16
5289 : !! V.V. Karasiev, J.W. Dufty, and S.B. Trickey, PRL 120(7), 076401 (2018) [[cite:Karasiev2018]]
5290 : !!
5291 : !! INPUTS
5292 : !! rho=density at this point
5293 : !! grho=gradient of the density at this point
5294 : !! iflag=flag selector integer
5295 : !! degauss=setup temperature (Rydberg)
5296 : !!
5297 : !! OUTPUT
5298 : !! fx=exchange free energy per electron
5299 : !! v1x=first part of the exchange potnetial
5300 : !! v2x=second part of the exchange potential
5301 : !! einx=exchange internal energy per electron
5302 : !! tsx=exchange entropy energy per electron
5303 : !!
5304 : !! SOURCE
5305 129516 : subroutine fex_kdt16(rho,grho,iflag,fx,v1x,v2x,einx,tsx,degauss)
5306 : !Arguments ------------------------------------
5307 : !scalars
5308 : integer,intent(in) :: iflag
5309 : real(dp),intent(in) :: rho,grho,degauss
5310 : real(dp),intent(out) :: fx,v1x,v2x,einx,tsx
5311 : !Local variables ------------------------------
5312 : !scalars
5313 : real(dp) :: rs,tF,t,dtdn
5314 : real(dp) :: kf,agrho,s1,s2,ds2dn,ds2dg_agrho,dsg
5315 : real(dp) :: Ax,dAx,d2Ax
5316 : real(dp) :: Bx,dBx,d2Bx
5317 : real(dp) :: BAx,dBAx,d2BAx
5318 : real(dp) :: s2x,ds2xdt,ds2xdn
5319 : real(dp) :: ex0,vx0,fxunif,dfxunif,sx,FFx,dFFxds2x
5320 : real(dp) :: f_slater,alpha_slater
5321 : real(dp), parameter :: twothird = 2._dp*third
5322 : real(dp), parameter :: fourthird = 4._dp*third
5323 : real(dp), parameter :: eightthird = 8._dp*third
5324 : real(dp), parameter :: c1 = 0.75_dp / pi
5325 : real(dp), parameter :: c2 = 3.093667726280136_dp
5326 : real(dp), parameter :: pi34 = 0.6203504908994d0
5327 :
5328 : ! *************************************************************************
5329 :
5330 64758 : rs = pi34 / rho**third
5331 64758 : tF = (3._dp*pi**2*rho)**twothird/2._dp !tF=Fermi temperature for spin-unpol case
5332 64758 : t = degauss/2.0_dp/tF !reduced temperature
5333 64758 : dtdn = -twothird*t!/rho ! n*(dt/dn)
5334 64758 : agrho = sqrt (grho)
5335 64758 : kf = c2 * rho**third ! (3*pi^2*rho)^(1/3)
5336 64758 : dsg = 0.5_dp / kf ! n*ds/d(gn)
5337 64758 : s1 = agrho * dsg / rho ! s
5338 64758 : s2 = s1 * s1 ! s^2
5339 64758 : ds2dn = -eightthird*s2 ! n*ds^2/dn
5340 : !ds2dg = agrho/(2._dp*rho*kf**2) ! n*ds^2/d(gn)
5341 64758 : ds2dg_agrho = 1._dp/(2._dp*rho*kf**2) ! n*ds^2/d(gn)
5342 : !
5343 : ! Call t-dependent functions
5344 : !
5345 64758 : call tildeAx(t,Ax,dAx,d2Ax)
5346 64758 : call tildeBx(t,Bx,dBx,d2Bx)
5347 : !
5348 64758 : BAx = Bx/Ax
5349 64758 : dBAx = dBx/Ax - Bx*dAx/Ax**2
5350 : d2BAx = d2Bx/Ax - dBx*dAx/Ax**2 & ! derivative of first term in above line
5351 64758 : - dBx*dAx/Ax**2 - Bx*d2Ax/Ax**2 + 2._dp*Bx*dAx*dAx/Ax**3 ! derivative of second term
5352 : !
5353 64758 : s2x = s2*BAx
5354 64758 : ds2xdt = s2*dBAx
5355 : ds2xdn = ds2dn*BAx & ! n*(d(s2x)/dn)=d(s2x)/d(s^2) * n*d(s^2)/dn
5356 64758 : + ds2xdt*dtdn ! +d(s2x)/dt * n*dt/dn
5357 : !
5358 : ! Energy
5359 : !
5360 64758 : f_slater=-0.687247939924714d0
5361 64758 : alpha_slater=twothird
5362 64758 : ex0=f_slater*alpha_slater/rs
5363 64758 : vx0=four/three*f_slater*alpha_slater/rs
5364 :
5365 64758 : if(iflag.le.4) call enfact1_kdt16(iflag,s2x,FFx,dFFxds2x)
5366 64758 : if(iflag.ge.5) call enfact2_kdt16(iflag-4,s2x,FFx,dFFxds2x)
5367 64758 : fxunif = ex0*Ax ! LDA exchange free-energy per electron
5368 64758 : fx = fxunif*FFx ! GGA exchange free-energy per electron
5369 : ! fx=fxunif*Fx without "n" factor
5370 : ! sx = -dfx/dt*1/T_F = -d(fxunif*Fx)/dt*1/T_F
5371 : ! = -{ex0*(dAx/dt)*Fx+fxunif*dFx/d(s2x)*d(s2x)/dt}*1/T_F
5372 64758 : sx = -(ex0*dAx*FFx + fxunif*dFFxds2x*ds2xdt)/tF ! entropy per electron
5373 64758 : einx = fx + t*tF*sx ! internal energy per electron
5374 64758 : tsx = t*tF*sx ! T*entropy per electron
5375 : ! Potential=
5376 : ! = d/dn(n*fxunif*Fx(s2x))=fxunif*Fx + n*(dfxunif/dn)*Fx + n*fxunif*(dFx/d2sx)*(ds2x/dn)
5377 : ! Pay attention: "*n" factor is included in dtdn, ds2dn, ds2dg, ds2xdn terms (see above).
5378 64758 : dfxunif = fxunif*third + ex0*dAx*dtdn !n*(dfxunif/dn)=fxunif*(1/3) + e_x^0*(dAx/dt)* n*(dt/dn)
5379 64758 : v1x = fx + dfxunif*FFx + fxunif*dFFxds2x*ds2xdn ! d/dn(n*fxunif*FFx(s2x) see above
5380 64758 : v2x = fxunif*dFFxds2x*ds2dg_agrho*BAx !d(n*fxunif*Fx(s2x))/d(gn)*1/(gn)=
5381 : ! =fxunif*d(Fx(s2x))/d(s2x) *n*ds2/d(gn) *Bx/Ax)*1/(gn)
5382 64758 : end subroutine fex_kdt16
5383 : !!***
5384 :
5385 : !!****f* ABINIT/enfact1_kdt16
5386 : !! NAME
5387 : !! enfact1_kdt16
5388 : !!
5389 : !! FUNCTION
5390 : !! Returns Finite-T GGA KDT16 enhancement factor and its derivative
5391 : !!
5392 : !! NOTES
5393 : !! Finite-T GGA enhancement factor and its derivative
5394 : !! Karasiev GGA X (without TLDA exchange):
5395 : !! iflag=1 mu=0.21951 (as in PBE), Fmax=1.804
5396 : !! iflag=2 mu=10/81=0.12345679012345679012d0 (as in PBEsol), Fmax=1.804
5397 : !! iflag=3 mu=0.27583 (as in PBEmol), Fmax=1.804
5398 : !! iflag=4 mu=8/81=0.09876543209876543209 (finite-T X GE, see Geldart), Fmax=1.804
5399 : !! V.V. Karasiev, J.W. Dufty, and S.B. Trickey, PRL 120(7), 076401 (2018) [[cite:Karasiev2018]]
5400 : !!
5401 : !! INPUTS
5402 : !! iflag=flag selector integer
5403 : !! s2x=variable
5404 : !! Fx=enhancement factor
5405 : !! dFxds2x=derivative of Fx w.r.t. s2x
5406 : !!
5407 : !! OUTPUT
5408 : !! fx=exchange free energy per electron
5409 : !! v1x=first part of the exchange potnetial
5410 : !! v2x=second part of the exchange potential
5411 : !! einx=exchange internal energy per electron
5412 : !! tsx=exchange entropy energy per electron
5413 : !!
5414 : !! SOURCE
5415 0 : subroutine enfact1_kdt16(iflag,s2x,Fx,dFxds2x)
5416 : !Arguments ------------------------------------
5417 : !scalars
5418 : integer,intent(in) :: iflag
5419 : real(dp),intent(in) :: s2x
5420 : real(dp),intent(out) :: Fx,dFxds2x
5421 : !Local variables ------------------------------
5422 : !scalars
5423 : real(dp),parameter :: threehalf=three/two
5424 : real(dp) :: alpha,expe,den, dden,nom,dnom
5425 : !arrays
5426 : real(dp) :: Fxmax(4),mu(4),gamma(4)
5427 :
5428 : ! *************************************************************************
5429 :
5430 : ! PBE PBEsol PBEmol Geldart
5431 : data Fxmax /1.804_dp, 1.804_dp , 1.804_dp, 1.804_dp /
5432 : data mu /0.21951_dp, 0.12345679012345679012_dp, 0.27583_dp, 0.09876543209876543209_dp/
5433 : data gamma /0.1_dp , 0.05_dp , 0.1_dp, 0.05_dp /
5434 0 : alpha = mu(iflag)**2/(Fxmax(iflag)**2-one)
5435 0 : if(s2x.lt.zero) then
5436 0 : expe = exp(gamma(iflag)*s2x)
5437 0 : nom = one+mu(iflag)*s2x*expe
5438 0 : dnom = mu(iflag)*expe + mu(iflag)*s2x*gamma(iflag)*expe
5439 0 : den = sqrt(one+alpha*s2x**2)
5440 0 : dden = alpha*s2x/den
5441 : else
5442 0 : nom = one+mu(iflag)*s2x
5443 0 : dnom = mu(iflag)
5444 0 : den = sqrt(one+alpha*s2x**2)
5445 0 : dden = alpha*s2x/den
5446 : endif
5447 0 : Fx = nom/den - one !remove LDA term (subtract 1) to make it compatible with WE
5448 0 : dFxds2x = dnom/den - nom*dden/den**2
5449 0 : end subroutine enfact1_kdt16
5450 : !!***
5451 :
5452 : !!****f* ABINIT/enfact2_kdt16
5453 : !! NAME
5454 : !! enfact2_kdt16
5455 : !!
5456 : !! FUNCTION
5457 : !! Returns Finite-T GGA KDT16 enhancement factor and its derivative
5458 : !!
5459 : !! NOTES
5460 : !! Finite-T GGA enhancement factor and its derivative
5461 : !! Karasiev GGA X, finite-T PBE form (without TLDA exchange):
5462 : !! iflag=1 mu=0.21951 (as in PBE), Fmax=1.804
5463 : !! iflag=2 mu=10/81=0.12345679012345679012d0 (as in PBEsol), Fmax=1.804
5464 : !! iflag=3 mu=0.27583 (as in PBEmol), Fmax=1.804
5465 : !! iflag=4 mu=8/81=0.09876543209876543209 (finite-T X GE, see Geldart), Fmax=1.804
5466 : !! V.V. Karasiev, J.W. Dufty, and S.B. Trickey, PRL 120(7), 076401 (2018) [[cite:Karasiev2018]]
5467 : !!
5468 : !! INPUTS
5469 : !! iflag=flag selector integer
5470 : !! s2x=variable
5471 : !! Fx=enhancement factor
5472 : !! dFxds2x=derivative of Fx w.r.t. s2x
5473 : !!
5474 : !! OUTPUT
5475 : !! fx=exchange free energy per electron
5476 : !! v1x=first part of the exchange potnetial
5477 : !! v2x=second part of the exchange potential
5478 : !! einx=exchange internal energy per electron
5479 : !! tsx=exchange entropy energy per electron
5480 : !!
5481 : !! SOURCE
5482 64758 : subroutine enfact2_kdt16(iflag,s2x,Fx,dFxds2x)
5483 : !Arguments ------------------------------------
5484 : !scalars
5485 : integer,intent(in) :: iflag
5486 : real(dp),intent(in) :: s2x
5487 : real(dp),intent(out) :: Fx,dFxds2x
5488 : !Local variables ------------------------------
5489 : !scalars
5490 : real(dp),parameter :: threehalf = three/two
5491 : real(dp) :: aa1
5492 : !arrays
5493 : real(DP) :: kappa(4),mu(4)
5494 :
5495 : ! *************************************************************************
5496 :
5497 : ! PBE PBEsol PBEmol Geldart
5498 : data kappa /0.804_dp, 0.804_dp , 0.804_dp, 0.804_dp /
5499 : data mu /0.21951_dp, 0.12345679012345679012_dp, 0.27583_dp, 0.09876543209876543209_dp/
5500 64758 : aa1 = mu(iflag)/kappa(iflag)
5501 64758 : Fx = mu(iflag)*s2x/(one+aa1*abs(s2x)) !remove LDA term (subtract 1) to make it compatible with WE
5502 64758 : dFxds2x = mu(iflag)/(one+aa1*abs(s2x))**2
5503 64758 : end subroutine enfact2_kdt16
5504 : !!***
5505 :
5506 : !!****f* ABINIT/fec_kdt16
5507 : !! NAME
5508 : !! fec_kdt16
5509 : !!
5510 : !! FUNCTION
5511 : !! Returns TGGA correlation free energy, internal energy and entropy energy of xc functional KDT16
5512 : !!
5513 : !! NOTES
5514 : !! finite-T PBE correlation (without LDA part)
5515 : !! it returns energy fc, einc and tsc densities,
5516 : !! the LDA fex_ksdt and fec_ksdt return energies per electron.
5517 : !! iflag=1: PBE with Bc(rs,t) from Pade fit
5518 : !! iflag=2: PBEsol with Bc(rs,t) from Pade fit
5519 : !! iflag=3: PBEmol with Bc(rs,t) from Pade fit
5520 : !! iflag=4: PBEgel with Bc(rs,t) from Pade fit !<-- for the moment we use the same beta as in PBEsol
5521 : !! iflag=5: PBE with Bc(rs,t)=1
5522 : !! iflag=6: PBEsol with Bc(rs,t)=1
5523 : !! iflag=7: PBEmol with Bc(rs,t)=1
5524 : !! iflag=8: PBEgel with Bc(rs,t)=1 !<-- for the moment we use the same beta as in PBEsol
5525 : !! iflag=9: PBE with BcII(rs,t) from Pade fit
5526 : !! iflag=10: PBEsol with BcII(rs,t) from Pade fit
5527 : !! iflag=11: PBEmol with BcII(rs,t) from Pade fit
5528 : !! iflag=12: PBEgel with BcII(rs,t) from Pade fit !<-- for the moment we use the same beta as in PBEsol
5529 : !! V.V. Karasiev, J.W. Dufty, and S.B. Trickey, PRL 120(7), 076401 (2018) [[cite:Karasiev2018]]
5530 : !!
5531 : !! INPUTS
5532 : !! rho=density at this point
5533 : !! grho=gradient of the density at this point
5534 : !! iflag=flag selector integer
5535 : !! degauss=setup temperature (Rydberg)
5536 : !!
5537 : !! OUTPUT
5538 : !! fc=correlation free energy per electron
5539 : !! v1c=first part of the correlation potnetial
5540 : !! v2c=second part of the correlation potential
5541 : !! einc=correlation internal energy per electron
5542 : !! tsc=correlation entropy energy per electron
5543 : !!
5544 : !! SOURCE
5545 64758 : subroutine fec_kdt16(rho,grho,iflag,fc,v1c,v2c,einc,tsc,degauss)
5546 : !Arguments ------------------------------------
5547 : !scalars
5548 : integer,intent(in) :: iflag
5549 : real(dp),intent(in) :: rho,grho,degauss
5550 : real(dp),intent(out):: fc,v1c,v2c,einc,tsc
5551 : !Local variables ------------------------------
5552 : !scalars
5553 : real(dp),parameter :: ga=0.031091d0
5554 : real(dp),parameter :: pi34=0.6203504908994d0
5555 : real(dp),parameter :: xkf=1.919158292677513d0,xks=1.128379167095513d0
5556 : real(dp),parameter :: twothird=two/three
5557 : real(dp) :: fc_lda,einc_lda,tsc_lda,vc_lda
5558 : real(dp) :: Bc,dBcdrs,dBcdt
5559 : real(dp) :: t,dtdn,tF,tilde_ds1dqc,tilde_qc
5560 : real(dp) :: kf,ks,rs,drsdn
5561 : real(dp) :: qc,dqcdn,dqcdt
5562 : real(dp) :: expe,af,dadf
5563 : real(dp) :: y,xy,dxy,s1,ds1dqc,ds1da
5564 : real(dp) :: h0
5565 : !arrays
5566 : real(dp) :: be(12)
5567 :
5568 : ! *************************************************************************
5569 :
5570 : ! pbe pbesol pbemol pbegel
5571 : data be / 0.066725d0, 0.046d0, 0.08384d0, 0.046d0, &
5572 : 0.066725d0, 0.046d0, 0.08384d0, 0.046d0, &
5573 : 0.066725d0, 0.046d0, 0.08384d0, 0.046d0/
5574 :
5575 64758 : rs = pi34 / rho**third
5576 : !drsdn = -third*rs/rho
5577 64758 : drsdn = -third*rs !n*d(rs)/dn
5578 64758 : tF = (3._dp*pi**2*rho)**twothird/2._dp !tF=Fermi temperature for spin-unpol case
5579 64758 : t = degauss/2.0_dp/tF
5580 : !dtdn = -twothird*t/rho ! (dt/dn)
5581 64758 : dtdn = -twothird*t ! n*(dt/dn)
5582 : ! LDA f_c, einternal_c and T*s_c energies per electron
5583 64758 : call fec_ksdt (rs,fc_lda,einc_lda,tsc_lda,vc_lda,degauss)
5584 : ! added temporarily for tests
5585 : !call pw (rs, 1, fc_lda, vc_lda)
5586 : !einc_lda = fc_lda
5587 : !tsc_lda = 0._dp
5588 : !
5589 64758 : if(iflag.le.8) call tildeBc(iflag,rs,t,Bc,dBcdrs,dBcdt) !iflag=1,2,..8
5590 : !if(iflag.gt.8) call tildeBcII(iflag,rs,t,Bc,dBcdrs,dBcdt) !iflag=9,10,..12
5591 :
5592 64758 : kf = xkf/rs
5593 64758 : ks = xks*sqrt(kf)
5594 64758 : qc = sqrt(grho)/(2.d0*ks*rho) * sqrt(Bc)
5595 : !dqcdn = -(7._dp/6._dp)*qc/rho - 0.5_dp*sqrt(grho)/(2.d0*ks*rho)/sqrt(Bc) * dBcdrs*drsdn !d(qc)/dn
5596 : !dqcdn = -(7._dp/6._dp)*qc - 0.5_dp*sqrt(grho)/(2.d0*ks*rho)/sqrt(Bc) * dBcdrs*drsdn !n*d(qc)/dn
5597 : !dqcdt = - 0.5_dp*sqrt(grho)/(2.d0*ks*rho)/sqrt(Bc) * dBcdt ! d(qc)/dt
5598 64758 : dqcdn = -(7._dp/6._dp)*qc + 0.5_dp*qc/Bc * dBcdrs*drsdn !n*d(qc)/dn
5599 64758 : dqcdt = + 0.5_dp*qc/Bc * dBcdt ! d(qc)/dt
5600 64758 : expe = exp(-fc_lda/ga)
5601 64758 : af = be(iflag)/ga/(expe-1.d0) !A(fc_lda)
5602 64758 : dadf = expe*af**2/be(iflag) !dA(fc_lda)/d(fc_lda)
5603 64758 : y = af*qc*qc
5604 64758 : xy = (1.d0 + y) / (1.d0 + y + y * y)
5605 64758 : dxy = -y*(2._dp + y)/(1._dp + y + y*y)**2 !d(xy)/dy
5606 64758 : s1 = 1.d0 + be(iflag)/ga*qc*qc*xy
5607 64758 : ds1dqc = be(iflag)/ga*2._dp*qc*xy + be(iflag)/ga*qc*qc*dxy * 2._dp*af*qc !d(s1)/d(qc)
5608 64758 : ds1da = be(iflag)/ga*qc*qc*dxy * qc*qc !d(s1)/dA
5609 64758 : h0 = ga*log(s1)
5610 64758 : fc = rho * h0 ! energy density !17-APR-2016: commented in ABINIT version
5611 : !fc = h0 ! energy per electron, 17-APR-2016: ABINIT version
5612 : !v1c=d(n*H)/dn=H + n*(dH/ds1)*(ds1/dA)*(dA/d(fc_lda))*(d(fc_lda)/dn) + n*(dH/ds1)*(ds1/d(qc))*{(d(qc)/dn) + (d(qc)/dt)*(dt/dn)}
5613 : ! = H + (dH/ds1)*(ds1/dA)*(dA/d(fc_lda))*(vc_lda - fc_lda) + (dH/ds1)*(ds1/d(qc))*{(n*d(qc)/dn) + (d(qc)/dt)*(n*dt/dn)}
5614 : !
5615 : ! where we used the following: n*d(fc_lda)/dn = vc_lda - fc_lda
5616 : ! fc_lda is the energy per electron
5617 : !
5618 64758 : v1c = h0 + (ga/s1)*ds1da*dadf*(vc_lda - fc_lda) + (ga/s1)*ds1dqc*(dqcdn + dqcdt*dtdn)
5619 : !A. Blanchet: fixing indeterminate form by introducing tilde_qc and tilde_ds1dqc (when grho == 0)
5620 : !v2c = rho * (ga/s1) * ds1dqc * qc/grho
5621 64758 : tilde_qc = 1._dp/(2.d0*ks*rho) * sqrt(Bc) ! tilde_qc == qc /sqrt(grho)
5622 64758 : tilde_ds1dqc = be(iflag)/ga*2._dp*tilde_qc*xy + be(iflag)/ga*qc*qc*dxy * 2._dp*af*tilde_qc ! tilde_ds1dqc = ds1dqc/sqrt(grho)
5623 64758 : v2c = rho * (ga/s1) * tilde_ds1dqc * tilde_qc
5624 : ! first version:
5625 : !tsc = rho*(ga/s1) * ds1da * dadf * tsc_lda - rho*(ga/s1) * t*dqcdt
5626 : !
5627 : ! LDA quantities per particle:
5628 : ! sc_lda = -d(fc_lda)/dt)/T_F
5629 : ! tsc_lda = -t*d(fc_lda)/dt)
5630 : ! GGA entropy and T*s_c density (not per particle)
5631 : ! sc = -d(n*H)/dt*(1/T_F) = -n*(dH/ds1)*(ds1/dA)*(dA/d(fc_lda))*(d(fc_lda)/dt)/T_F - n*(dH/ds1)*(ds1/d(qc))*(d(qc)/dt)/T_F
5632 : ! T*sc=t*T_F*sc = -t*d(n*H)/dt = +n*(dH/ds1)*(ds1/dA)*(dA/d(fc_lda))*(-t*d(fc_lda)/dt) - t*n*(dH/ds1)*(ds1/d(qc))*(d(qc)/dt)
5633 64758 : tsc = rho*(ga/s1)*ds1da*dadf*tsc_lda - t*rho*(ga/s1)*ds1dqc*dqcdt !17-APR-2016: commented in ABINIT version
5634 : !tsc = (ga/s1)*ds1da*dadf*tsc_lda - t* (ga/s1)*ds1dqc*dqcdt ! energy per electron, 17-APR-2016: ABINIT version
5635 64758 : einc = fc + tsc
5636 : ! convert energy density to energy per electron
5637 64758 : fc = fc / rho
5638 64758 : einc = einc / rho
5639 64758 : tsc = tsc / rho
5640 64758 : end subroutine fec_kdt16
5641 : !!***
5642 :
5643 : end module m_xcpbe
5644 : !!***
|
