Branch data 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 : 642004 : subroutine xcpbe(exci,npts,nspden,option,order,rho_updn,vxci,ndvxci,nd2vxci, & !Mandatory Arguments
133 : 228378 : & 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 : 321002 : real(dp),allocatable :: rho_updnm1_3(:,:),rhoarr(:),rhom1_3(:),zetm(:)
222 : 321002 : 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 : 321002 : d_wc=mu-b_wc
237 [ + + ]: 321002 : 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 [ + + + - : 321002 : 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 [ - + ]: 321002 : 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 [ + + - + ]: 321002 : 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 [ + + + + : 321002 : 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 [ + + - + ]: 321002 : 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 [ + + - + ]: 321002 : 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 [ + + ]: 321002 : if(initialized==0)then
295 : 424 : twom1_3=two**(-third)
296 : 424 : sixpi2_1_3=(six*pi**2)**third
297 : 424 : sixpi2m1_3=one/sixpi2_1_3
298 : 424 : threefourth_divpi=three_quarters*piinv
299 : 424 : gamma=(one-log(two))*piinv**2
300 : 424 : gamma_inv=one/gamma
301 : 424 : beta_gamma=beta*gamma_inv
302 : 424 : factf_zeta= one / ( two**(four/three)-two )
303 : 424 : factfp_zeta= four_thirds * factf_zeta * alpha_zeta2
304 : 424 : coeff_tt= one/ (four*four*piinv*(three*pi**2)**third)
305 : : ! coeff_tt= two * sqrt(four*piinv*(three*pi**2)**third)
306 : 424 : sq_rsfac=sqrt(rsfac)
307 : 424 : sq_rsfac_inv=one/sq_rsfac
308 : 424 : 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 : 321002 : 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 [ - + ]: 321002 : 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 [ + + ]: 321002 : if(option==5)then
336 : 492 : kappa=kappa_revpbe
337 : 492 : mu_divkappa=mu_divkappa_revpbe
338 : : end if
339 [ + + ]: 321002 : 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 [ + + ]: 321002 : if(order**2 >1)then
409 : 51626 : factfpp_zeta= third * factfp_zeta * alpha_zeta2
410 : : end if
411 : :
412 : :
413 [ - + + - : 963006 : ABI_MALLOC(rhoarr,(npts))
+ - + - -
+ - + ]
414 [ - + + - : 642004 : ABI_MALLOC(rhom1_3,(npts))
- + - + ]
415 [ - + + - : 963006 : ABI_MALLOC(rho_updnm1_3,(npts,2))
+ - + - -
+ - + ]
416 [ - + + - : 642004 : ABI_MALLOC(zetm,(npts))
- + - + ]
417 [ - + + - : 642004 : ABI_MALLOC(zetmm1_3,(npts))
- + - + ]
418 [ - + + - : 642004 : ABI_MALLOC(zetp,(npts))
- + - + ]
419 [ - + + - : 642004 : ABI_MALLOC(zetpm1_3,(npts))
- + - + ]
420 : :
421 [ + + ]: 810321 : do ispden=1,nspden
422 : 810321 : call invcb(rho_updn(:,ispden),rho_updnm1_3(:,ispden),npts)
423 : : end do
424 : :
425 : :
426 [ + + ]: 321002 : if(nspden==1)then
427 [ + + ]: 401829813 : rhoarr(:)=two*rho_updn(:,1)
428 [ + + ]: 401829813 : rhom1_3(:)=twom1_3*rho_updnm1_3(:,1)
429 [ + + ]: 401829813 : rho_updnm1_3(:,2)=rho_updnm1_3(:,1)
430 : : else
431 [ + + ]: 221270578 : rhoarr(:)=rho_updn(:,1)+rho_updn(:,2)
432 : 168317 : call invcb(rhoarr,rhom1_3,npts)
433 [ + + ]: 221270578 : do ipts=1,npts
434 : 221102261 : rhotmot=rhom1_3(ipts)
435 : 221102261 : rhotot_inv=rhotmot*rhotmot*rhotmot
436 : 221102261 : zeta=(rho_updn(ipts,1)-rho_updn(ipts,2))*rhotot_inv
437 : 221102261 : zetp(ipts)=1.0_dp+zeta*alpha_zeta
438 : 221270578 : zetm(ipts)=1.0_dp-zeta*alpha_zeta
439 : : end do
440 : 168317 : call invcb(zetp,zetpm1_3,npts)
441 : 168317 : 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 [ + + + + : 10518115 : 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 [ + + ]: 321002 : if (nspden==1) then
492 : : ! we separate different cases, depending on order
493 [ + + ]: 152685 : if (order**2<=1) then
494 : : ! we separate different cases, depending on option
495 [ + + + + : 122898 : 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 [ + + ]: 196599094 : do ipts=1,npts
999 : :
1000 : 196520176 : rhotot=rhoarr(ipts)
1001 : 196520176 : rhotmot=rhom1_3(ipts)
1002 : 196520176 : rhotot_inv=rhotmot*rhotmot*rhotmot
1003 : 196520176 : rhotmo6=sqrt(rhotmot)
1004 : 196520176 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
1005 : : ! -----------------------------------------------------------------------
1006 : : ! First take care of the exchange part of the functional
1007 : :
1008 : 196520176 : exc=zero
1009 : : ! loop over the spin
1010 : 196520176 : ispden=1
1011 : 196520176 : rho =rho_updn(ipts,ispden)
1012 : 196520176 : rhomot=rho_updnm1_3(ipts,ispden)
1013 : 196520176 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
1014 : : ! Perdew_Wang 91 LSD
1015 : 196520176 : vxci(ipts,ispden)=four_thirds*ex_lsd
1016 : 196520176 : 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 : 196520176 : exc=exc*2
1021 : 196520176 : exci(ipts)=exc*rhotot_inv
1022 : : ! -----------------------------------------------------------------------------
1023 : : ! Then takes care of the LSD correlation part of the functional
1024 : :
1025 : :
1026 : 196520176 : rs=rsfac*rhotmot
1027 : 196520176 : sqr_rs=sq_rsfac*rhotmo6
1028 : 196520176 : rsm1_2=sq_rsfac_inv*rhoto6
1029 : :
1030 : : ! Formulas A6-A8 of PW92LSD
1031 : 196520176 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
1032 : 196520176 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs)
1033 : 196520176 : ec0_q1p=ec0_aa*(ec0_b1*rsm1_2+2._dp*ec0_b2+3._dp*ec0_b3*sqr_rs+4._dp*ec0_b4*rs)
1034 : 196520176 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
1035 : : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
1036 : 196520176 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
1037 : 196520176 : ecrs0=ec0_q0*ec0_log
1038 : 196520176 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
1039 : :
1040 : 196520176 : ecrs=ecrs0
1041 : 196520176 : decrs_drs=decrs0_drs
1042 : 196520176 : decrs_dzeta=0.0_dp
1043 : 196520176 : zeta=0.0_dp
1044 : :
1045 : : ! Add LSD correlation functional to GGA exchange functional
1046 : 196520176 : exci(ipts)=exci(ipts)+ecrs
1047 : 196599094 : 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 [ + - ]: 168317 : else if(nspden==2) then
4089 : :
4090 : : ! we separate different cases depending on order
4091 : :
4092 [ + + ]: 168317 : if (order**2<=1) then
4093 : :
4094 [ + + ]: 152215709 : do ipts=1,npts
4095 : :
4096 : 152069231 : rhotot=rhoarr(ipts)
4097 : 152069231 : rhotmot=rhom1_3(ipts)
4098 : 152069231 : rhotot_inv=rhotmot*rhotmot*rhotmot
4099 : 152069231 : rhotmo6=sqrt(rhotmot)
4100 : 152069231 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
4101 : : ! -----------------------------------------------------------------------
4102 : : ! First take care of the exchange part of the functional
4103 : :
4104 : 152069231 : exc=zero
4105 [ + + ]: 152069231 : if (present(dvxcdgr)) dvxcdgr(ipts,3)=zero
4106 [ + + ]: 456207693 : do ispden=1,nspden
4107 : 304138462 : rho =rho_updn(ipts,ispden)
4108 : 304138462 : rhomot=rho_updnm1_3(ipts,ispden)
4109 [ + + ]: 304138462 : ex_lsd= - threefourth_divpi * sixpi2_1_3*rhomot*rhomot*rho
4110 : 152069231 : if(option==1 .or. option==-1 .or. option==3)then
4111 : : ! Perdew_Wang 91 LSD
4112 : 234680546 : vxci(ipts,ispden)=four_thirds*ex_lsd
4113 [ - + ]: 234680546 : if(present(dvxcdgr)) dvxcdgr(ipts,ispden)=0.0_dp
4114 : 234680546 : exc=exc+ex_lsd*rho
4115 : : else
4116 : 69457916 : rho_inv=rhomot*rhomot*rhomot
4117 : 69457916 : coeffss=quarter*sixpi2m1_3*sixpi2m1_3*rho_inv*rho_inv*rhomot*rhomot
4118 : 69457916 : ss=grho2_updn(ipts,ispden)*coeffss
4119 [ + + ]: 69457916 : 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 [ + + ]: 68582396 : if(option/=6)then ! This is Perdew-Burke-Ernzerhof GGA, exchange part
4129 : 68198396 : divss=one/(one+mu_divkappa*ss)
4130 : 68198396 : dfxdss= mu*divss*divss
4131 : 68198396 : 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 : 69457916 : fx = one+kappa*(one-divss)
4139 : 69457916 : ex_gga= ex_lsd*fx
4140 : 69457916 : dssdn=-eight*third*ss*rho_inv
4141 : 69457916 : dfxdn = dfxdss*dssdn
4142 : 69457916 : 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 : 69457916 : dssdg =two*coeffss
4145 : 69457916 : dfxdg=dfxdss*dssdg
4146 : 69457916 : dvxcdgr(ipts,ispden)=ex_lsd*rho*dfxdg
4147 : 69457916 : exc=exc+ex_gga*rho
4148 : : end if
4149 : :
4150 : : end do
4151 : 152069231 : exci(ipts)=exc*rhotot_inv
4152 [ + + ]: 152069231 : if(exexch_==1)cycle
4153 : :
4154 : : ! -----------------------------------------------------------------------------
4155 : : ! Then takes care of the LSD correlation part of the functional
4156 : :
4157 [ + + ]: 151988909 : if(option>0)then
4158 : :
4159 : 150549247 : rs=rsfac*rhotmot
4160 : 150549247 : sqr_rs=sq_rsfac*rhotmo6
4161 : 150549247 : rsm1_2=sq_rsfac_inv*rhoto6
4162 : :
4163 : : ! Formulas A6-A8 of PW92LSD
4164 : 150549247 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
4165 [ + - ]: 150549247 : if(option/=3 .and. option/=4)then
4166 : 150549247 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs)
4167 : 150549247 : 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 : 150549247 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
4174 : : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
4175 : 150549247 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
4176 : 150549247 : ecrs0=ec0_q0*ec0_log
4177 : 150549247 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
4178 : :
4179 : 150549247 : mac_q0=-2.0_dp*mac_aa*(1.0_dp+mac_a1*rs)
4180 : 150549247 : mac_q1=2.0_dp*mac_aa*(mac_b1*sqr_rs+mac_b2*rs+mac_b3*rs*sqr_rs+mac_b4*rs*rs)
4181 : 150549247 : mac_q1p=mac_aa*(mac_b1*rsm1_2+2._dp*mac_b2+3._dp*mac_b3*sqr_rs+4._dp*mac_b4*rs)
4182 : 150549247 : mac_den=1.0_dp/(mac_q1*mac_q1+mac_q1)
4183 : 150549247 : mac_log=-log( mac_q1*mac_q1*mac_den )
4184 : 150549247 : macrs=mac_q0*mac_log
4185 : 150549247 : dmacrs_drs= -2.0_dp*mac_aa*mac_a1*mac_log - mac_q0*mac_q1p*mac_den
4186 : :
4187 : 150549247 : zeta=(rho_updn(ipts,1)-rho_updn(ipts,2))*rhotot_inv
4188 : 150549247 : ec1_q0=-2.0_dp*ec1_aa*(1.0_dp+ec1_a1*rs)
4189 [ + - ]: 150549247 : if(option/=3 .and. option/=4)then
4190 : 150549247 : ec1_q1=2.0_dp*ec1_aa*(ec1_b1*sqr_rs+ec1_b2*rs+ec1_b3*rs*sqr_rs+ec1_b4*rs*rs)
4191 : 150549247 : 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 : 150549247 : ec1_den=1.0_dp/(ec1_q1*ec1_q1+ec1_q1)
4197 : : ! ec1_log=log( 1.0_dp + 1.0_dp / ec1_q1 )
4198 : 150549247 : ec1_log=-log( ec1_q1*ec1_q1*ec1_den )
4199 : 150549247 : ecrs1=ec1_q0*ec1_log
4200 : 150549247 : 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 : 150549247 : zetp_1_3=(1.0_dp+zeta*alpha_zeta)*zetpm1_3(ipts)**2
4205 : 150549247 : 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 : 150549247 : & (1.0_dp-zeta*alpha_zeta2)*zetm_1_3 - 2.0_dp ) * factf_zeta
4209 : 150549247 : fp_zeta=( zetp_1_3 - zetm_1_3 ) * factfp_zeta
4210 : 150549247 : zeta4=zeta**4
4211 : :
4212 : 150549247 : gcrs=ecrs1-ecrs0+macrs*fsec_inv
4213 : : ! ecrs=ecrs0+f_zeta*(-macrs*(1.0_dp-zeta4)*fsec_inv+(ecrs1-ecrs0)*zeta4)
4214 : 150549247 : ecrs=ecrs0+f_zeta*(zeta4*gcrs-macrs*fsec_inv)
4215 : :
4216 : 150549247 : 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 : 150549247 : decrs_drs=decrs0_drs+f_zeta*(zeta4*dgcrs_drs-dmacrs_drs*fsec_inv)
4220 : 150549247 : dfzeta4_dzeta=4.0_dp*zeta**3*f_zeta+fp_zeta*zeta4
4221 : 150549247 : decrs_dzeta=dfzeta4_dzeta*gcrs-fp_zeta*macrs*fsec_inv
4222 : :
4223 : : ! Add LSD correlation functional to GGA exchange functional
4224 : 150549247 : exci(ipts)=exci(ipts)+ecrs
4225 : 150549247 : vxcadd=ecrs-rs*third*decrs_drs-zeta*decrs_dzeta
4226 : 150549247 : vxci(ipts,1)=vxci(ipts,1)+vxcadd+decrs_dzeta
4227 : 150549247 : 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 [ + + + + : 150549247 : 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 : 33208974 : & zetmm1_3(ipts)*(1.0_dp-zeta*alpha_zeta) )*0.5_dp
4242 : 33208974 : phip_zeta=(zetpm1_3(ipts)-zetmm1_3(ipts))*third*alpha_zeta
4243 : 33208974 : phi_zeta_inv=1.0_dp/phi_zeta
4244 : 33208974 : phi_logder=phip_zeta*phi_zeta_inv
4245 : 33208974 : phi3_zeta=phi_zeta*phi_zeta*phi_zeta
4246 : 33208974 : gamphi3inv=gamma_inv*phi_zeta_inv*phi_zeta_inv*phi_zeta_inv
4247 : :
4248 : : ! From ec to bb
4249 : 33208974 : bb=ecrs*gamphi3inv
4250 : 33208974 : dbb_drs=decrs_drs*gamphi3inv
4251 : 33208974 : dbb_dzeta=gamphi3inv*(decrs_dzeta-three*ecrs*phi_logder)
4252 : : ! From bb to cc
4253 : 33208974 : exp_pbe=exp(-bb)
4254 : 33208974 : cc=one/(exp_pbe-one)
4255 : 33208974 : dcc_dbb=cc*cc*exp_pbe
4256 : 33208974 : dcc_drs=dcc_dbb*dbb_drs
4257 : 33208974 : dcc_dzeta=dcc_dbb*dbb_dzeta
4258 : :
4259 : : ! From cc to aa
4260 : 33208974 : coeff_aa=beta*gamma_inv*phi_zeta_inv*phi_zeta_inv
4261 : 33208974 : aa=coeff_aa*cc
4262 : 33208974 : daa_drs=coeff_aa*dcc_drs
4263 : 33208974 : daa_dzeta=-two*aa*phi_logder+coeff_aa*dcc_dzeta
4264 : : ! Introduce tt : do not assume that the spin-dependent gradients are collinear
4265 : 33208974 : grrho2=grho2_updn(ipts,3)
4266 : 33208974 : 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 : 33208974 : tt=half*grrho2*dtt_dg
4269 : :
4270 : : ! Get xx from aa and tt
4271 : 33208974 : xx=aa*tt
4272 : 33208974 : dxx_drs=daa_drs*tt
4273 : 33208974 : dxx_dzeta=daa_dzeta*tt
4274 : 33208974 : dxx_dtt=aa
4275 : : ! From xx to pade
4276 : 33208974 : pade_den=one/(one+xx*(one+xx))
4277 : 33208974 : pade=(one+xx)*pade_den
4278 : 33208974 : dpade_dxx=-xx*(two+xx)*pade_den**2
4279 : 33208974 : dpade_drs=dpade_dxx*dxx_drs
4280 : 33208974 : dpade_dtt=dpade_dxx*dxx_dtt
4281 : 33208974 : dpade_dzeta=dpade_dxx*dxx_dzeta
4282 : :
4283 : : ! From pade to qq
4284 : 33208974 : coeff_qq=tt*phi_zeta_inv*phi_zeta_inv
4285 : 33208974 : qq=coeff_qq*pade
4286 : 33208974 : dqq_drs=coeff_qq*dpade_drs
4287 : 33208974 : dqq_dtt=pade*phi_zeta_inv*phi_zeta_inv+coeff_qq*dpade_dtt
4288 : 33208974 : dqq_dzeta=coeff_qq*(dpade_dzeta-two*pade*phi_logder)
4289 : :
4290 : : ! From qq to rr
4291 : 33208974 : arg_rr=one+beta*gamma_inv*qq
4292 : 33208974 : div_rr=one/arg_rr
4293 : 33208974 : rr=gamma*log(arg_rr)
4294 : 33208974 : drr_dqq=beta*div_rr
4295 : 33208974 : drr_drs=drr_dqq*dqq_drs
4296 : 33208974 : drr_dtt=drr_dqq*dqq_dtt
4297 : 33208974 : drr_dzeta=drr_dqq*dqq_dzeta
4298 : :
4299 : : ! From rr to hh
4300 : 33208974 : hh=phi3_zeta*rr
4301 : 33208974 : dhh_drs=phi3_zeta*drr_drs
4302 : 33208974 : dhh_dtt=phi3_zeta*drr_dtt
4303 : 33208974 : dhh_dzeta=phi3_zeta*(drr_dzeta+three*rr*phi_logder)
4304 : :
4305 : : ! The GGA correlation energy is added
4306 : 33208974 : 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 : 33208974 : drhohh_drho=hh-third*rs*dhh_drs-zeta*dhh_dzeta-seven*third*tt*dhh_dtt
4312 : 33208974 : vxci(ipts,1)=vxci(ipts,1)+drhohh_drho+dhh_dzeta
4313 : 33208974 : 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 : 33208974 : 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 [ + + ]: 69054869 : do ipts=1,npts
4339 : :
4340 : 69033030 : rhotot=rhoarr(ipts)
4341 : 69033030 : rhotmot=rhom1_3(ipts)
4342 : 69033030 : rhotot_inv=rhotmot*rhotmot*rhotmot
4343 : 69033030 : rhotmo6=sqrt(rhotmot)
4344 : 69033030 : rhoto6=rhotot*rhotmot*rhotmot*rhotmo6
4345 : : ! -----------------------------------------------------------------------
4346 : : ! First take care of the exchange part of the functional
4347 : :
4348 : 69033030 : exc=zero
4349 [ + + ]: 69033030 : if (present(dvxcdgr)) dvxcdgr(ipts,3)=zero
4350 [ + + ]: 207099090 : do ispden=1,nspden
4351 : 138066060 : rho =rho_updn(ipts,ispden)
4352 : 138066060 : rhomot=rho_updnm1_3(ipts,ispden)
4353 [ + + ]: 138066060 : 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 : 101075646 : vxci(ipts,ispden)=four_thirds*ex_lsd
4357 [ - + ]: 101075646 : if(present(dvxcdgr)) dvxcdgr(ipts,ispden)=0.0_dp
4358 : 101075646 : 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 : 69033030 : 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 : 101075646 : & threefourth_divpi*sixpi2_1_3*rhomot*rhomot
4399 : 101075646 : dvxci(ipts,2)=zero
4400 [ + + ]: 101075646 : 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 : 69033030 : exci(ipts)=exc*rhotot_inv
4437 : : ! -----------------------------------------------------------------------------
4438 : : ! Then takes care of the LSD correlation part of the functional
4439 : :
4440 [ + + ]: 69054869 : if(option>0)then
4441 : :
4442 : 65971230 : rs=rsfac*rhotmot
4443 : 65971230 : sqr_rs=sq_rsfac*rhotmo6
4444 : 65971230 : rsm1_2=sq_rsfac_inv*rhoto6
4445 : :
4446 : : ! Formulas A6-A8 of PW92LSD
4447 : 65971230 : ec0_q0=-2.0_dp*ec0_aa*(1.0_dp+ec0_a1*rs)
4448 [ + - ]: 65971230 : if(option/=3 .and. option/=4)then
4449 : 65971230 : ec0_q1=2.0_dp*ec0_aa*(ec0_b1*sqr_rs+ec0_b2*rs+ec0_b3*rs*sqr_rs+ec0_b4*rs*rs)
4450 : 65971230 : 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 : 65971230 : ec0_den=1.0_dp/(ec0_q1*ec0_q1+ec0_q1)
4457 : : ! ec0_log=log( 1.0_dp + 1.0_dp / ec0_q1 )
4458 : 65971230 : ec0_log=-log( ec0_q1*ec0_q1*ec0_den )
4459 : 65971230 : ecrs0=ec0_q0*ec0_log
4460 : 65971230 : decrs0_drs= -2.0_dp*ec0_aa*ec0_a1*ec0_log - ec0_q0*ec0_q1p *ec0_den
4461 : 65971230 : 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 : 65971230 : & +ec0_q0*ec0_q1p**2*ec0_den**2*(2._dp*ec0_q1+1.0_dp)
4465 [ + + ]: 65971230 : 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 : 65971230 : mac_q0=-2.0_dp*mac_aa*(1.0_dp+mac_a1*rs)
4477 : 65971230 : mac_q1=2.0_dp*mac_aa*(mac_b1*sqr_rs+mac_b2*rs+mac_b3*rs*sqr_rs+mac_b4*rs*rs)
4478 : 65971230 : mac_q1p=mac_aa*(mac_b1*rsm1_2+2._dp*mac_b2+3._dp*mac_b3*sqr_rs+4._dp*mac_b4*rs)
4479 : 65971230 : mac_den=1.0_dp/(mac_q1*mac_q1+mac_q1)
4480 : 65971230 : mac_log=-log( mac_q1*mac_q1*mac_den )
4481 : 65971230 : macrs=mac_q0*mac_log
4482 : 65971230 : dmacrs_drs= -2.0_dp*mac_aa*mac_a1*mac_log - mac_q0*mac_q1p*mac_den
4483 : :
4484 : 65971230 : zeta=(rho_updn(ipts,1)-rho_updn(ipts,2))*rhotot_inv
4485 : 65971230 : ec1_q0=-2.0_dp*ec1_aa*(1.0_dp+ec1_a1*rs)
4486 [ + - ]: 65971230 : if(option/=3 .and. option/=4)then
4487 : 65971230 : ec1_q1=2.0_dp*ec1_aa*(ec1_b1*sqr_rs+ec1_b2*rs+ec1_b3*rs*sqr_rs+ec1_b4*rs*rs)
4488 : 65971230 : 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 : 65971230 : ec1_den=1.0_dp/(ec1_q1*ec1_q1+ec1_q1)
4494 : : ! ec1_log=log( 1.0_dp + 1.0_dp / ec1_q1 )
4495 : 65971230 : ec1_log=-log( ec1_q1*ec1_q1*ec1_den )
4496 : 65971230 : ecrs1=ec1_q0*ec1_log
4497 : 65971230 : 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 : 65971230 : zetp_1_3=(1.0_dp+zeta*alpha_zeta)*zetpm1_3(ipts)**2
4502 : 65971230 : 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 : 65971230 : & (1.0_dp-zeta*alpha_zeta2)*zetm_1_3 - 2.0_dp ) * factf_zeta
4506 : 65971230 : fp_zeta=( zetp_1_3 - zetm_1_3 ) * factfp_zeta
4507 : 65971230 : zeta4=zeta**4
4508 : :
4509 : 65971230 : gcrs=ecrs1-ecrs0+macrs*fsec_inv
4510 : : ! ecrs=ecrs0+f_zeta*(-macrs*(1.0_dp-zeta4)*fsec_inv+(ecrs1-ecrs0)*zeta4)
4511 : 65971230 : ecrs=ecrs0+f_zeta*(zeta4*gcrs-macrs*fsec_inv)
4512 : :
4513 : 65971230 : 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 : 65971230 : decrs_drs=decrs0_drs+f_zeta*(zeta4*dgcrs_drs-dmacrs_drs*fsec_inv)
4517 : 65971230 : dfzeta4_dzeta=4.0_dp*zeta**3*f_zeta+fp_zeta*zeta4
4518 : 65971230 : decrs_dzeta=dfzeta4_dzeta*gcrs-fp_zeta*macrs*fsec_inv
4519 : :
4520 : 65971230 : 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 : 65971230 : & +ec1_q0*ec1_q1p**2*ec1_den**2*(2._dp*ec1_q1+1.0_dp)
4525 : :
4526 : :
4527 : 65971230 : 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 : 65971230 : & +mac_q0*mac_q1p**2*mac_den**2*(2._dp*mac_q1+1.0_dp)
4531 : :
4532 : 65971230 : d2gcrs_drs2=d2ecrs1_drs2-d2ecrs0_drs2+d2macrs_drs2*fsec_inv
4533 : 65971230 : 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 : 65971230 : & + zeta4 *fpp_zeta
4537 : :
4538 : : d2ecrs_drs2=d2ecrs0_drs2+&
4539 : 65971230 : & f_zeta*(zeta4*d2gcrs_drs2-d2macrs_drs2*fsec_inv)
4540 : 65971230 : d2ecrs_drsdzeta=dfzeta4_dzeta*dgcrs_drs-fp_zeta*dmacrs_drs*fsec_inv
4541 : 65971230 : 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 : 65971230 : exci(ipts)=exci(ipts)+ecrs
4546 : 65971230 : vxcadd=ecrs-rs*third*decrs_drs-zeta*decrs_dzeta
4547 : : ! decrs_drup=vxcadd+decrs_dzeta
4548 : : ! decrs_drdn=vxcadd-decrs_dzeta
4549 : 65971230 : vxci(ipts,1)=vxci(ipts,1)+vxcadd+decrs_dzeta
4550 : 65971230 : vxci(ipts,2)=vxci(ipts,2)+vxcadd-decrs_dzeta
4551 : :
4552 : :
4553 : :
4554 : 65971230 : dvcrs_drs=third*(2._dp*decrs_drs-rs*d2ecrs_drs2)
4555 : : ! And d(vxc)/d(rho)=(-rs/(3*rho))*d(vxc)/d(rs)
4556 : 65971230 : 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 : 65971230 : & 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 : 65971230 : & 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 : 65971230 : & d2ecrs_dzeta2*(-1._dp-zeta)**2*rhotot_inv
4566 : :
4567 : :
4568 : :
4569 : :
4570 [ + + ]: 65971230 : 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 [ + + ]: 65971230 : if(option==1 .or. option==3)then
4752 : 50537823 : dvxci(ipts,1)=dvxci(ipts,1)+d2ecrs_drup2
4753 : 50537823 : dvxci(ipts,2)=dvxci(ipts,2)+d2ecrs_drdndrup
4754 : 50537823 : dvxci(ipts,3)=dvxci(ipts,3)+d2ecrs_drdn2
4755 : :
4756 [ + + ]: 50537823 : 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 [ + + + - : 65971230 : 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 [ - + ]: 321002 : ABI_FREE(rhoarr)
5134 [ - + ]: 321002 : ABI_FREE(rhom1_3)
5135 [ - + ]: 321002 : ABI_FREE(rho_updnm1_3)
5136 [ - + ]: 321002 : ABI_FREE(zetm)
5137 [ - + ]: 321002 : ABI_FREE(zetmm1_3)
5138 [ - + ]: 321002 : ABI_FREE(zetp)
5139 [ - + ]: 321002 : 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 [ + + + + : 546864 : 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 : : !!***
|
