Merge lp:~nickpapior/libgridxc/fortran-standard into lp:libgridxc
- fortran-standard
- Merge into trunk
Proposed by
Nick Papior
Status: | Merged |
---|---|
Merged at revision: | 45 |
Proposed branch: | lp:~nickpapior/libgridxc/fortran-standard |
Merge into: | lp:libgridxc |
Diff against target: |
8917 lines (+4289/-4316) 14 files modified
docs/deprecated_routines/test_bessph.F90 (+26/-0) src/bessph.F90 (+83/-0) src/bessph.f (+0/-66) src/cellsubs.F90 (+61/-55) src/chkgmx.F90 (+101/-113) src/ggaxc.F90 (+2642/-2701) src/ldaxc.F90 (+706/-709) src/m_io.F90 (+181/-182) src/minvec.F90 (+131/-132) src/precision.F90 (+25/-25) src/radfft.F90 (+118/-121) src/sorting.F90 (+186/-180) src/sys.F90 (+28/-28) version.info (+1/-4) |
To merge this branch: | bzr merge lp:~nickpapior/libgridxc/fortran-standard |
Related bugs: |
Reviewer | Review Type | Date Requested | Status |
---|---|---|---|
Yann Pouillon (community) | Approve | ||
Review via email: mp+337978@code.launchpad.net |
Commit message
Description of the change
I have now moved all codes to the fortran 90 standard.
There are, however still some goto statements which requires some major restructuring of the code. This could potentially be problematic.
Secondly, the m_fft_gpfa code is _very_ difficult to translate to f90 standard. Thus I have left it as is.
@Yann, I have requested your review since you know the limitations of build-systems.
@Alberto/@Jose, feel free to comment on this!
To post a comment you must log in.
Revision history for this message
Nick Papior (nickpapior) wrote : | # |
Revision history for this message
Yann Pouillon (pouillon) wrote : | # |
Great work! I know how tedious this kind of things are.
review:
Approve
Preview Diff
[H/L] Next/Prev Comment, [J/K] Next/Prev File, [N/P] Next/Prev Hunk
1 | === added directory 'docs/deprecated_routines' |
2 | === added file 'docs/deprecated_routines/test_bessph.F90' |
3 | --- docs/deprecated_routines/test_bessph.F90 1970-01-01 00:00:00 +0000 |
4 | +++ docs/deprecated_routines/test_bessph.F90 2018-02-19 19:59:41 +0000 |
5 | @@ -0,0 +1,26 @@ |
6 | +program test_bessph_update |
7 | + |
8 | + ! One should get the bessph.f file from r39 and older |
9 | + use m_bessph_old, only: bessph_old => bessph |
10 | + ! This is the new bessph module |
11 | + use m_bessph |
12 | + |
13 | + integer, parameter :: dp = kind(1.d0) |
14 | + integer :: l, i |
15 | + real(dp) :: x, dx, b1, b2 |
16 | + |
17 | + dx = 0.00001_dp |
18 | + do l = 0, 10 |
19 | + do i = 1, 10000000 |
20 | + x = (i-1) * dx |
21 | + b1 = bessph_old(l, x) |
22 | + b2 = bessph(l, x) |
23 | + |
24 | + if ( abs(b1 - b2) > 1.e-17_dp ) then |
25 | + print *, 'Different: ', l, x, b1, b2 |
26 | + end if |
27 | + |
28 | + end do |
29 | + end do |
30 | + |
31 | +end program test_bessph_update |
32 | |
33 | === renamed file 'src/am05.f90' => 'src/am05.F90' |
34 | === added file 'src/bessph.F90' |
35 | --- src/bessph.F90 1970-01-01 00:00:00 +0000 |
36 | +++ src/bessph.F90 2018-02-19 19:59:41 +0000 |
37 | @@ -0,0 +1,83 @@ |
38 | +!!@LICENSE |
39 | + |
40 | +module m_bessph |
41 | + |
42 | + implicit none |
43 | + |
44 | + private |
45 | + |
46 | + public :: bessph |
47 | + |
48 | +contains |
49 | + |
50 | + function bessph(L,X) result(B) |
51 | + |
52 | + ! RETURNS THE SPHERICAL BESSEL FUNCTION JL(X). |
53 | + ! REF: ABRAMOWITZ AND STEGUN, FORMULAS 10.1.2 AND 10.1.19 |
54 | + ! WRITTEN BY J.SOLER. NOV/89. |
55 | + ! F90 conversion, by Nick Papior, feb/2018 |
56 | + use precision, only: dp |
57 | + use sys, only: die |
58 | + |
59 | + integer, intent(in) :: L |
60 | + real(dp), intent(in) :: X |
61 | + real(dp) :: B |
62 | + |
63 | + integer, parameter :: nterms = 100 |
64 | + real(dp), parameter :: zero = 0.0_dp, one = 1.0_dp, tiny=1.0e-15_dp |
65 | + |
66 | + integer :: i, n |
67 | + real(dp) :: switch, term, x2, y, fnm1, fn, fnp1 |
68 | + character(len=128):: msg |
69 | + |
70 | + if ( abs(x) < max(1, 2*L - 1) ) then |
71 | + ! Use power series |
72 | + TERM = ONE |
73 | + do I = 1 , L |
74 | + TERM = TERM * X/(2*I+1) |
75 | + end do |
76 | + X2 = X * X |
77 | + FN = ZERO |
78 | + do I = 1 , NTERMS |
79 | + FN = FN + TERM |
80 | + TERM = -TERM * X2 / (4._dp * I * (I + L + 0.5_dp)) |
81 | + if ( abs(TERM) < tiny ) exit |
82 | + end do |
83 | + if ( abs(TERM) > tiny ) then |
84 | + write(msg,*) 'BESSPH: SERIES HAS NOT CONVERGED. L,X=',L,X |
85 | + call die(trim(msg)) |
86 | + end if |
87 | + B = FN |
88 | + |
89 | + else |
90 | + |
91 | + ! Use explicit expressions or recurrence relation |
92 | + select case ( L ) |
93 | + case ( 0 ) |
94 | + |
95 | + B = sin(X) / X |
96 | + |
97 | + case ( 1 ) |
98 | + |
99 | + B = (sin(X) / X - cos(X) ) / X |
100 | + |
101 | + case default |
102 | + |
103 | + Y = ONE / X |
104 | + fnm1 = sin(X) * Y |
105 | + fn = (fnm1 - cos(X)) * Y |
106 | + DO N = 1 , L-1 |
107 | + FNP1 = (2 * N + 1) * Y * fn - fnm1 |
108 | + FNM1 = FN |
109 | + FN = FNP1 |
110 | + end do |
111 | + B = fn |
112 | + |
113 | + end select |
114 | + |
115 | + end if |
116 | + |
117 | + end function bessph |
118 | + |
119 | +end module m_bessph |
120 | + |
121 | |
122 | === removed file 'src/bessph.f' |
123 | --- src/bessph.f 2016-05-09 12:15:45 +0000 |
124 | +++ src/bessph.f 1970-01-01 00:00:00 +0000 |
125 | @@ -1,66 +0,0 @@ |
126 | -!!@LICENSE |
127 | - |
128 | - MODULE m_bessph |
129 | - |
130 | - CONTAINS |
131 | - |
132 | - FUNCTION BESSPH (L,X) |
133 | - |
134 | -! RETURNS THE SPHERICAL BESSEL FUNCTION JL(X). |
135 | -! REF: ABRAMOWITZ AND STEGUN, FORMULAS 10.1.2 AND 10.1.19 |
136 | -! WRITTEN BY J.SOLER. NOV/89. |
137 | - |
138 | - use precision, only: dp |
139 | - use sys, only: die |
140 | - |
141 | - integer, intent(in) :: L |
142 | - real(dp), intent(in) :: X |
143 | - real(dp) :: BESSPH |
144 | - |
145 | - integer, parameter :: nterms = 100 |
146 | - real(dp),parameter :: |
147 | - . zero = 0.0_dp, one = 1.0_dp, tiny=1.0e-15_dp |
148 | - |
149 | - integer :: i, n |
150 | - real(dp) :: switch, term, x2, sum, y, fnm1, fn, fnp1 |
151 | - character(len=132):: msg |
152 | - |
153 | - SWITCH=MAX(1,2*L-1) |
154 | - IF (ABS(X).LT.SWITCH) THEN |
155 | -! USE POWER SERIES |
156 | - TERM=ONE |
157 | - DO 10 I=1,L |
158 | - TERM=TERM*X/(2*I+1) |
159 | - 10 CONTINUE |
160 | - X2=X*X |
161 | - SUM=ZERO |
162 | - DO 20 I=1,NTERMS |
163 | - SUM=SUM+TERM |
164 | - TERM=(-TERM)*X2/(2*I*(2*I+2*L+1)) |
165 | - IF (ABS(TERM).LT.TINY) GO TO 30 |
166 | - 20 CONTINUE |
167 | - WRITE(msg,*) 'BESSPH: SERIES HAS NOT CONVERGED. L,X=',L,X |
168 | - call die(trim(msg)) |
169 | - 30 BESSPH=SUM |
170 | - ELSE |
171 | -! USE EXPLICIT EXPRESSIONS OR RECURRENCE RELATION |
172 | - IF (L.EQ.0) THEN |
173 | - BESSPH=SIN(X)/X |
174 | - ELSEIF (L.EQ.1) THEN |
175 | - BESSPH=(SIN(X)/X-COS(X))/X |
176 | - ELSE |
177 | - Y=ONE/X |
178 | - FNM1=SIN(X)*Y |
179 | - FN=(FNM1-COS(X))*Y |
180 | - DO 40 N=1,L-1 |
181 | - FNP1=(2*N+1)*Y*FN-FNM1 |
182 | - FNM1=FN |
183 | - FN=FNP1 |
184 | - 40 CONTINUE |
185 | - BESSPH=FN |
186 | - ENDIF |
187 | - ENDIF |
188 | - END FUNCTION BESSPH |
189 | - |
190 | - END MODULE m_bessph |
191 | - |
192 | |
193 | === renamed file 'src/cellsubs.f' => 'src/cellsubs.F90' |
194 | --- src/cellsubs.f 2016-05-09 12:15:45 +0000 |
195 | +++ src/cellsubs.F90 2018-02-19 19:59:41 +0000 |
196 | @@ -1,58 +1,64 @@ |
197 | !!@LICENSE |
198 | |
199 | - MODULE cellSubs |
200 | - |
201 | - USE precision, only: dp ! Double precision real kind |
202 | - |
203 | - PUBLIC:: |
204 | - . reclat, ! Reciprocal unit cell vectors |
205 | - . volcel ! Volume of the unit cell |
206 | - |
207 | - PRIVATE |
208 | - |
209 | - CONTAINS |
210 | - |
211 | -!-------------------------------------------------------------------- |
212 | - |
213 | - SUBROUTINE RECLAT (A,B,IOPT) |
214 | - |
215 | -C CALCULATES RECIPROCAL LATTICE VECTORS. THEIR PRODUCT WITH DIRECT |
216 | -C LATTICE VECTORS IS 1 IF IOPT=0 OR 2*PI IF IOPT=1 |
217 | - |
218 | - integer :: iopt, i |
219 | - real(dp):: A(3,3),B(3,3), pi, c , ci |
220 | - PI=ACOS(-1.D0) |
221 | - B(1,1)=A(2,2)*A(3,3)-A(3,2)*A(2,3) |
222 | - B(2,1)=A(3,2)*A(1,3)-A(1,2)*A(3,3) |
223 | - B(3,1)=A(1,2)*A(2,3)-A(2,2)*A(1,3) |
224 | - B(1,2)=A(2,3)*A(3,1)-A(3,3)*A(2,1) |
225 | - B(2,2)=A(3,3)*A(1,1)-A(1,3)*A(3,1) |
226 | - B(3,2)=A(1,3)*A(2,1)-A(2,3)*A(1,1) |
227 | - B(1,3)=A(2,1)*A(3,2)-A(3,1)*A(2,2) |
228 | - B(2,3)=A(3,1)*A(1,2)-A(1,1)*A(3,2) |
229 | - B(3,3)=A(1,1)*A(2,2)-A(2,1)*A(1,2) |
230 | - C=1.D0 |
231 | - IF (IOPT.EQ.1) C=2.D0*PI |
232 | - DO 20 I=1,3 |
233 | - CI=C/(A(1,I)*B(1,I)+A(2,I)*B(2,I)+A(3,I)*B(3,I)) |
234 | - B(1,I)=B(1,I)*CI |
235 | - B(2,I)=B(2,I)*CI |
236 | - B(3,I)=B(3,I)*CI |
237 | - 20 CONTINUE |
238 | - END SUBROUTINE RECLAT |
239 | - |
240 | -!-------------------------------------------------------------------- |
241 | - |
242 | - DOUBLE PRECISION FUNCTION VOLCEL( C ) |
243 | - |
244 | -C CALCULATES THE VOLUME OF THE UNIT CELL |
245 | - |
246 | - real(dp) C(3,3) |
247 | - VOLCEL = ( C(2,1)*C(3,2) - C(3,1)*C(2,2) ) * C(1,3) + |
248 | - . ( C(3,1)*C(1,2) - C(1,1)*C(3,2) ) * C(2,3) + |
249 | - . ( C(1,1)*C(2,2) - C(2,1)*C(1,2) ) * C(3,3) |
250 | - VOLCEL = ABS( VOLCEL ) |
251 | - END FUNCTION VOLCEL |
252 | - |
253 | - END MODULE cellSubs |
254 | +module cellSubs |
255 | + |
256 | + use precision, only: dp ! Double precision real kind |
257 | + |
258 | + implicit none |
259 | + |
260 | + private |
261 | + |
262 | + public :: reclat ! Reciprocal unit cell vectors |
263 | + public :: volcel ! Volume of the unit cell |
264 | + |
265 | +contains |
266 | + |
267 | + subroutine reclat(A,B,IOPT) |
268 | + |
269 | + ! CALCULATES RECIPROCAL LATTICE VECTORS. THEIR PRODUCT WITH DIRECT |
270 | + ! LATTICE VECTORS IS 1 IF IOPT=0 OR 2*PI IF IOPT=1 |
271 | + real(dp), intent(in) :: A(3,3) |
272 | + real(dp), intent(out) :: B(3,3) |
273 | + integer, intent(in) :: iopt |
274 | + |
275 | + real(dp), parameter :: PI = 3.14159265358979323846264338327950288419716939937510_dp |
276 | + |
277 | + integer :: i |
278 | + real(dp):: c , ci |
279 | + |
280 | + B(1,1) = A(2,2)*A(3,3)-A(3,2)*A(2,3) |
281 | + B(2,1) = A(3,2)*A(1,3)-A(1,2)*A(3,3) |
282 | + B(3,1) = A(1,2)*A(2,3)-A(2,2)*A(1,3) |
283 | + B(1,2) = A(2,3)*A(3,1)-A(3,3)*A(2,1) |
284 | + B(2,2) = A(3,3)*A(1,1)-A(1,3)*A(3,1) |
285 | + B(3,2) = A(1,3)*A(2,1)-A(2,3)*A(1,1) |
286 | + B(1,3) = A(2,1)*A(3,2)-A(3,1)*A(2,2) |
287 | + B(2,3) = A(3,1)*A(1,2)-A(1,1)*A(3,2) |
288 | + B(3,3) = A(1,1)*A(2,2)-A(2,1)*A(1,2) |
289 | + C=1.D0 |
290 | + if ( IOPT == 1 ) C = 2.D0*PI |
291 | + do I = 1 , 3 |
292 | + CI = C/(A(1,I)*B(1,I)+A(2,I)*B(2,I)+A(3,I)*B(3,I)) |
293 | + B(1,I) = B(1,I)*CI |
294 | + B(2,I) = B(2,I)*CI |
295 | + B(3,I) = B(3,I)*CI |
296 | + end do |
297 | + |
298 | + end subroutine reclat |
299 | + |
300 | + !-------------------------------------------------------------------- |
301 | + |
302 | + function volcel( C ) result(V) |
303 | + ! CALCULATES THE VOLUME OF THE UNIT CELL |
304 | + real(dp), intent(in) :: C(3,3) |
305 | + real(dp) :: V |
306 | + |
307 | + V = ( C(2,1)*C(3,2) - C(3,1)*C(2,2) ) * C(1,3) + & |
308 | + ( C(3,1)*C(1,2) - C(1,1)*C(3,2) ) * C(2,3) + & |
309 | + ( C(1,1)*C(2,2) - C(2,1)*C(1,2) ) * C(3,3) |
310 | + V = ABS( V ) |
311 | + |
312 | + end function volcel |
313 | + |
314 | +end module cellsubs |
315 | |
316 | |
317 | === renamed file 'src/chkgmx.f' => 'src/chkgmx.F90' |
318 | --- src/chkgmx.f 2016-05-09 12:15:45 +0000 |
319 | +++ src/chkgmx.F90 2018-02-19 19:59:41 +0000 |
320 | @@ -1,116 +1,104 @@ |
321 | !!@LICENSE |
322 | |
323 | - MODULE m_chkgmx |
324 | - |
325 | -! Used module procedures |
326 | - use sys, only: die ! Termination routine |
327 | - use m_minvec, only: minvec ! Finds a lattice basis of minimal length |
328 | - use cellsubs, only: reclat ! Finds reciprocal unit cell |
329 | - |
330 | -! Used module parameters and variables |
331 | - use precision, only: dp ! Double precision real kind |
332 | -! use parallel, only: Node ! My processor index |
333 | - |
334 | - implicit none |
335 | - |
336 | -! Public procedures provided: |
337 | - PUBLIC:: |
338 | - . chkgmx, ! Checks that a given cutoff is consistent with a mesh |
339 | - . meshKcut ! Returns the planewave cutoff of a periodic mesh |
340 | - |
341 | -! Public parameters, variables, and arrays: |
342 | -! none |
343 | - |
344 | - PRIVATE ! Nothing is declared public beyond this point |
345 | - |
346 | - CONTAINS |
347 | -!--------------------------------------------------------------------------- |
348 | - |
349 | - SUBROUTINE CHKGMX (K,BG,MESH,G2MAX) |
350 | - |
351 | - implicit none |
352 | - real(dp),intent(in) :: K(3) ! Vector in reciprocal unit cell (BZ) |
353 | - real(dp),intent(in) :: BG(3,3) ! Reciprocal lattice vectors BG(ixyz,ivec) |
354 | - integer, intent(in) :: MESH(3) ! Number of mesh point divisions of each |
355 | - ! real-space lattice vector. |
356 | - real(dp),intent(inout):: G2MAX ! Planewave cutoff, which is reduced to |
357 | - ! the maximum value supported by the mesh |
358 | - ! (without aliasing), if this is smaller. |
359 | - |
360 | - real(dp), parameter :: ZERO=0.0_dp,HALF=0.5_dp, |
361 | - . TINY=1.0e-8_dp,BIG=1.0e20_dp |
362 | - |
363 | - integer :: i, j, i1, i2, i3 |
364 | - real(dp):: bm(3,3), baux(3,3), ctransf(3,3), |
365 | - . g(3), gmod, gmax, g2msh, r |
366 | - |
367 | - DO I=1,3 |
368 | - DO J=1,3 |
369 | - BM(J,I)=BG(J,I)*MESH(I) |
370 | - Baux(J,I)=BG(J,I)*MESH(I) |
371 | - ENDDO |
372 | - ENDDO |
373 | -! |
374 | -! Use Baux to avoid aliasing of arguments, as one is intent(in) |
375 | -! and the other intent(out)... |
376 | -! |
377 | - CALL MINVEC (Baux,BM, ctransf) |
378 | - GMAX=BIG |
379 | - DO I3=-1,1 |
380 | - DO I2=-1,1 |
381 | - DO I1=-1,1 |
382 | - IF (I1.EQ.0.AND.I2.EQ.0.AND.I3.EQ.0) GO TO 20 |
383 | - G(1)=BM(1,1)*I1+BM(1,2)*I2+BM(1,3)*I3 |
384 | - G(2)=BM(2,1)*I1+BM(2,2)*I2+BM(2,3)*I3 |
385 | - G(3)=BM(3,1)*I1+BM(3,2)*I2+BM(3,3)*I3 |
386 | - GMOD=SQRT(SUM(G**2)) |
387 | - R=HALF*GMOD-SUM(K*G)/GMOD |
388 | - GMAX=MIN(GMAX,R) |
389 | - 20 CONTINUE |
390 | - ENDDO |
391 | - ENDDO |
392 | - ENDDO |
393 | - IF (GMAX.LT.ZERO) call die('CHKGMX: K NOT IN FIRST BZ') |
394 | - G2MSH=GMAX*GMAX-TINY |
395 | - IF (G2MSH.LT.G2MAX) THEN |
396 | -! if (Node.eq.0) then |
397 | -! WRITE(6,*) 'CHKGMX: MESH TOO SPARSE. GMAX HAS BEEN REDUCED' |
398 | -! WRITE(6,*) 'CHKGMX: OLD G2MAX =',G2MAX |
399 | -! WRITE(6,*) 'CHKGMX: NEW G2MAX =',G2MSH |
400 | -! endif |
401 | - G2MAX=G2MSH |
402 | - ENDIF |
403 | - END SUBROUTINE CHKGMX |
404 | - |
405 | -!---------------------------------------------------------------------- |
406 | - |
407 | - FUNCTION meshKcut( cell, nMesh ) |
408 | - |
409 | - ! Finds mesh planewave cutoff |
410 | - |
411 | - use precision, only: dp |
412 | - |
413 | - implicit none |
414 | - real(dp),intent(in):: cell(3,3) ! Unit cell vectors cell(iXYZ,iVector) |
415 | - integer, intent(in):: nMesh(3) ! Mesh divisions of each vector |
416 | - real(dp) :: meshKcut ! Mesh wavevector cutoff |
417 | - |
418 | - real(dp):: g2max, k0(3), kcell(3,3) |
419 | - |
420 | - ! Find reciprocal cell vectors |
421 | - call reclat( cell, kcell, 1 ) |
422 | - |
423 | - ! Initialize arguments to call chkgmx |
424 | - k0(1:3) = 0._dp |
425 | - g2max = huge(g2max) |
426 | - |
427 | - ! chkgmx will reduce g2max to square of mesh cutoff |
428 | - call chkgmx( k0, kcell, nMesh, g2max ) |
429 | - |
430 | - ! Return wavevector cutoff |
431 | - meshKcut = sqrt(g2max) |
432 | - |
433 | - END FUNCTION meshKcut |
434 | - |
435 | - END MODULE m_chkgmx |
436 | +module m_chkgmx |
437 | + |
438 | + ! Used module procedures |
439 | + use sys, only: die ! Termination routine |
440 | + use m_minvec, only: minvec ! Finds a lattice basis of minimal length |
441 | + use cellsubs, only: reclat ! Finds reciprocal unit cell |
442 | + |
443 | + ! Used module parameters and variables |
444 | + use precision, only: dp ! Double precision real kind |
445 | + |
446 | + implicit none |
447 | + |
448 | + private ! Nothing is declared public beyond this point |
449 | + |
450 | + ! Public procedures provided: |
451 | + public :: chkgmx ! Checks that a given cutoff is consistent with a mesh |
452 | + public :: meshKcut ! Returns the planewave cutoff of a periodic mesh |
453 | + |
454 | +contains |
455 | + |
456 | + subroutine chkgmx(K,BG,MESH,G2MAX) |
457 | + |
458 | + real(dp),intent(in) :: K(3) ! Vector in reciprocal unit cell (BZ) |
459 | + real(dp),intent(in) :: BG(3,3) ! Reciprocal lattice vectors BG(ixyz,ivec) |
460 | + integer, intent(in) :: MESH(3) ! Number of mesh point divisions of each |
461 | + ! real-space lattice vector. |
462 | + real(dp),intent(inout):: G2MAX ! Planewave cutoff, which is reduced to |
463 | + ! the maximum value supported by the mesh |
464 | + ! (without aliasing), if this is smaller. |
465 | + |
466 | + real(dp), parameter :: ZERO=0.0_dp,HALF=0.5_dp, & |
467 | + TINY=1.0e-8_dp, BIG=1.0e20_dp |
468 | + |
469 | + integer :: i, j, i1, i2, i3 |
470 | + real(dp):: bm(3,3), baux(3,3), ctransf(3,3), & |
471 | + g(3), gmod, gmax, g2msh, r |
472 | + |
473 | + DO I=1,3 |
474 | + DO J=1,3 |
475 | + BM(J,I)=BG(J,I)*MESH(I) |
476 | + Baux(J,I)=BG(J,I)*MESH(I) |
477 | + END DO |
478 | + END DO |
479 | + ! |
480 | + ! Use Baux to avoid aliasing of arguments, as one is intent(in) |
481 | + ! and the other intent(out)... |
482 | + ! |
483 | + CALL MINVEC (Baux,BM, ctransf) |
484 | + GMAX=BIG |
485 | + DO I3=-1,1 |
486 | + DO I2=-1,1 |
487 | + DO I1=-1,1 |
488 | + IF (I1.EQ.0.AND.I2.EQ.0.AND.I3.EQ.0) cycle |
489 | + G(1)=BM(1,1)*I1+BM(1,2)*I2+BM(1,3)*I3 |
490 | + G(2)=BM(2,1)*I1+BM(2,2)*I2+BM(2,3)*I3 |
491 | + G(3)=BM(3,1)*I1+BM(3,2)*I2+BM(3,3)*I3 |
492 | + GMOD=SQRT(SUM(G**2)) |
493 | + R=HALF*GMOD-SUM(K*G)/GMOD |
494 | + GMAX=MIN(GMAX,R) |
495 | + END DO |
496 | + END DO |
497 | + END DO |
498 | + IF (GMAX.LT.ZERO) call die('CHKGMX: K NOT IN FIRST BZ') |
499 | + G2MSH=GMAX*GMAX-TINY |
500 | + IF (G2MSH.LT.G2MAX) THEN |
501 | + ! if (Node.eq.0) then |
502 | + ! WRITE(6,*) 'CHKGMX: MESH TOO SPARSE. GMAX HAS BEEN REDUCED' |
503 | + ! WRITE(6,*) 'CHKGMX: OLD G2MAX =',G2MAX |
504 | + ! WRITE(6,*) 'CHKGMX: NEW G2MAX =',G2MSH |
505 | + ! endif |
506 | + G2MAX=G2MSH |
507 | + ENDIF |
508 | + end subroutine chkgmx |
509 | + |
510 | + !---------------------------------------------------------------------- |
511 | + |
512 | + function meshKcut( cell, nMesh ) |
513 | + |
514 | + ! Finds mesh planewave cutoff |
515 | + real(dp),intent(in) :: cell(3,3) ! Unit cell vectors cell(iXYZ,iVector) |
516 | + integer, intent(in) :: nMesh(3) ! Mesh divisions of each vector |
517 | + real(dp) :: meshKcut ! Mesh wavevector cutoff |
518 | + |
519 | + real(dp) :: g2max, k0(3), kcell(3,3) |
520 | + |
521 | + ! Find reciprocal cell vectors |
522 | + call reclat( cell, kcell, 1 ) |
523 | + |
524 | + ! Initialize arguments to call chkgmx |
525 | + k0(1:3) = 0._dp |
526 | + g2max = huge(g2max) |
527 | + |
528 | + ! chkgmx will reduce g2max to square of mesh cutoff |
529 | + call chkgmx( k0, kcell, nMesh, g2max ) |
530 | + |
531 | + ! Return wavevector cutoff |
532 | + meshKcut = sqrt(g2max) |
533 | + |
534 | + end function meshKcut |
535 | + |
536 | +end module m_chkgmx |
537 | |
538 | |
539 | === renamed file 'src/ggaxc.F' => 'src/ggaxc.F90' |
540 | --- src/ggaxc.F 2017-10-30 11:35:11 +0000 |
541 | +++ src/ggaxc.F90 2018-02-19 19:59:41 +0000 |
542 | @@ -44,156 +44,151 @@ |
543 | ! |
544 | !****************************************************************************** |
545 | |
546 | - MODULE m_ggaxc |
547 | - |
548 | - ! Used module procedures |
549 | - use sys, only: die ! Termination routine |
550 | - USE m_ldaxc, only: exchng ! Local exchange |
551 | - USE m_ldaxc, only: pw92c ! Perdew & Wang, PRB, 45, 13244 (1992) correl |
552 | - |
553 | - |
554 | - ! Used module parameters |
555 | - use precision, only : dp ! Double precision real kind |
556 | +MODULE m_ggaxc |
557 | + |
558 | + ! Used module procedures |
559 | + use sys, only: die ! Termination routine |
560 | + USE m_ldaxc, only: exchng ! Local exchange |
561 | + USE m_ldaxc, only: pw92c ! Perdew & Wang, PRB, 45, 13244 (1992) correl |
562 | + |
563 | + ! Used module parameters |
564 | + use precision, only : dp ! Double precision real kind |
565 | |
566 | #ifdef LIBXC |
567 | - use xc_f90_types_m |
568 | - use xc_f90_lib_m |
569 | + use xc_f90_types_m |
570 | + use xc_f90_lib_m |
571 | #endif |
572 | |
573 | - implicit none |
574 | - |
575 | - PUBLIC:: |
576 | - . ggaxc, ! General subroutine for all coded GGA XC functionals |
577 | - . blypxc, ! Becke-Lee-Yang-Parr (see subroutine blypxc) |
578 | - . pbexc, ! Perdew, Burke & Ernzerhof, PRL 77, 3865 (1996) |
579 | - . pbesolxc, ! Perdew et al, PRL, 100, 136406 (2008) |
580 | - . pw91xc, ! Perdew & Wang, JCP, 100, 1290 (1994) |
581 | - . revpbexc, ! GGA Zhang & Yang, PRL 80,890(1998) |
582 | - . rpbexc, ! Hammer, Hansen & Norskov, PRB 59, 7413 (1999) |
583 | - . am05xc, ! Mattsson & Armiento, PRB, 79, 155101 (2009) |
584 | - . wcxc, ! Wu-Cohen (see subroutine wcxc) |
585 | - . pbeJsJrLOxc, ! Reparametrizations of the PBE functional by |
586 | - . pbeJsJrHEGxc, ! L.S.Pedroza et al, PRB 79, 201106 (2009) and |
587 | - . pbeGcGxLOxc, ! M.M.Odashima et al, JCTC 5, 798 (2009) |
588 | - . pbeGcGxHEGxc, ! using 4 different combinations of criteria |
589 | - . pw86x, ! Perdew & Wang, PRB 33, 8800 (1986) (exchange only) |
590 | - . pw86rx, ! pw86x refit: Murray, Lee & Langreth, JCTC 5, 2754 (2009) |
591 | - . b88x, ! Becke, PRA 38, 3098 (1988) (exchange only) |
592 | - . b88kbmx, ! Klimes et al, JPCM 22, 022201 (2009) (exchange only) |
593 | - . c09x, ! Cooper, PRB 81, 161104 (2010) (exchange only) |
594 | - . bhx ! Berland & Hyldgaard, PRB 89, 035412 (2014) (exch. only) |
595 | - |
596 | - PRIVATE ! Nothing is declared public beyond this point |
597 | - |
598 | - CONTAINS |
599 | - |
600 | - SUBROUTINE GGAXC( AUTHOR, IREL, nSpin, D, GD, |
601 | - . EPSX, EPSC, dEXdD, dECdD, dEXdGD, dECdGD |
602 | + implicit none |
603 | + |
604 | + private ! everything is private, unless otherwise declared |
605 | + |
606 | + public :: ggaxc ! General subroutine for all coded GGA XC functionals |
607 | + public :: blypxc ! Becke-Lee-Yang-Parr (see subroutine blypxc) |
608 | + public :: pbexc ! Perdew, Burke & Ernzerhof, PRL 77, 3865 (1996) |
609 | + public :: pbesolxc ! Perdew et al, PRL, 100, 136406 (2008) |
610 | + public :: pw91xc ! Perdew & Wang, JCP, 100, 1290 (1994) |
611 | + public :: revpbexc ! GGA Zhang & Yang, PRL 80,890(1998) |
612 | + public :: rpbexc ! Hammer, Hansen & Norskov, PRB 59, 7413 (1999) |
613 | + public :: am05xc ! Mattsson & Armiento, PRB, 79, 155101 (2009) |
614 | + public :: wcxc ! Wu-Cohen (see subroutine wcxc) |
615 | + public :: pbeJsJrLOxc ! Reparametrizations of the PBE functional by |
616 | + public :: pbeJsJrHEGxc ! L.S.Pedroza et al, PRB 79, 201106 (2009) and |
617 | + public :: pbeGcGxLOxc ! M.M.Odashima et al, JCTC 5, 798 (2009) |
618 | + public :: pbeGcGxHEGxc ! using 4 different combinations of criteria |
619 | + public :: pw86x ! Perdew & Wang, PRB 33, 8800 (1986) (exchange only) |
620 | + public :: pw86rx ! pw86x refit: Murray, Lee & Langreth, JCTC 5, 2754 (2009) |
621 | + public :: b88x ! Becke, PRA 38, 3098 (1988) (exchange only) |
622 | + public :: b88kbmx ! Klimes et al, JPCM 22, 022201 (2009) (exchange only) |
623 | + public :: c09x ! Cooper, PRB 81, 161104 (2010) (exchange only) |
624 | + public :: bhx ! Berland & Hyldgaard, PRB 89, 035412 (2014) (exch. only) |
625 | + |
626 | +contains |
627 | + |
628 | + subroutine GGAXC( AUTHOR, IREL, nSpin, D, GD, & |
629 | + EPSX, EPSC, dEXdD, dECdD, dEXdGD, dECdGD & |
630 | #ifdef LIBXC |
631 | - . , is_libxc_in, xc_func, xc_info ) |
632 | + , is_libxc_in, xc_func, xc_info ) |
633 | #else |
634 | - . ) |
635 | -#endif |
636 | - |
637 | -C Finds the exchange and correlation energies at a point, and their |
638 | -C derivatives with respect to density and density gradient, in the |
639 | -C Generalized Gradient Correction approximation. |
640 | -C Lengths in Bohr, energies in Hartrees |
641 | -C Written by L.C.Balbas and J.M.Soler, Dec'96. |
642 | -C Modified by V.M.Garcia-Suarez to include non-collinear spin. June 2002 |
643 | -C Non collinear part rewritten by J.M.Soler. Sept. 2009 |
644 | -C Interface with LibXC added by Micael Oliveira, Jul.2014 |
645 | - |
646 | - implicit none |
647 | - |
648 | - ! Input |
649 | - character(len=*),intent(in):: AUTHOR ! GGA flavour (author initials) |
650 | - integer, intent(in) :: IREL ! Relativistic exchange? 0=no, 1=yes |
651 | - integer, intent(in) :: nSpin ! Number of spin components |
652 | - real(dp),intent(in) :: D(nSpin) ! Local electron (spin) density |
653 | - real(dp),intent(in) :: GD(3,nSpin) ! Gradient of electron density |
654 | - |
655 | - ! Output |
656 | - real(dp),intent(out):: EPSX ! Exchange energy per electron |
657 | - real(dp),intent(out):: EPSC ! Correlation energy per electron |
658 | - real(dp),intent(out):: dEXdD(nSpin) ! dEx/dDens, Ex=Int(dens*epsX) |
659 | - real(dp),intent(out):: dECdD(nSpin) ! dEc/dDens |
660 | - real(dp),intent(out):: dEXdGD(3,nSpin) ! dEx/dGrad(Dens) |
661 | - real(dp),intent(out):: dECdGD(3,nSpin) ! dEc/dGrad(Dens) |
662 | -#ifdef LIBXC |
663 | - logical, intent(in), optional :: is_libxc_in |
664 | - type(xc_f90_pointer_t), optional :: xc_func, xc_info |
665 | -#endif |
666 | - |
667 | - ! Internal variables and arrays |
668 | - integer :: NS, is, ix |
669 | - real(dp) :: DD(2), dECdDD(2), dEXdDD(2), |
670 | - . dDDdD(2,4), dDTOTdD(4), dDPOLdD(4), |
671 | - . dECdGDD(3,2), dEXdGDD(3,2), |
672 | - . dGDDdD(3,2,4), dGDDdGD(2,4), |
673 | - . dGDTOTdD(3,4), dGDPOLdD(3,4), |
674 | - . dGDTOTdGD(4), dGDPOLdGD(4), |
675 | - . DPOL, DTOT, GDD(3,2), GDTOT(3), GDPOL(3), |
676 | - . VPOL |
677 | - real(dp), parameter :: DENMIN = 1.e-12_dp |
678 | - |
679 | - real(dp):: theta, phi, c2, s2, st, ct, cp, sp, dpolz, dpolxy |
680 | - |
681 | - logical , parameter :: old_scheme = .true. |
682 | - |
683 | -#ifdef LIBXC |
684 | - logical :: is_libxc |
685 | - real(dp) :: eps, dedn(nspin), sgm(3), dedsgm(3), dedgd(3, nspin) |
686 | -#endif |
687 | - |
688 | - ! Handle non-collinear spin case |
689 | - if (nSpin==4) then |
690 | - NS = 2 ! Diagonal spin components |
691 | - |
692 | - if ( old_scheme ) then |
693 | - DTOT = D(1) + D(2) |
694 | - dpolz= D(1) - D(2) |
695 | - dpolxy= 2.0d0*sqrt(d(3)**2+d(4)**2) |
696 | - dpol = sqrt( dpolz**2 + dpolxy**2 ) |
697 | - if ( dpol.gt.1.0d-12 ) then |
698 | + ) |
699 | +#endif |
700 | + |
701 | + ! Finds the exchange and correlation energies at a point, and their |
702 | + ! derivatives with respect to density and density gradient, in the |
703 | + ! Generalized Gradient Correction approximation. |
704 | + ! Lengths in Bohr, energies in Hartrees |
705 | + ! Written by L.C.Balbas and J.M.Soler, Dec'96. |
706 | + ! Modified by V.M.Garcia-Suarez to include non-collinear spin. June 2002 |
707 | + ! Non collinear part rewritten by J.M.Soler. Sept. 2009 |
708 | + ! Interface with LibXC added by Micael Oliveira, Jul.2014 |
709 | + |
710 | + ! Input |
711 | + character(len=*),intent(in):: AUTHOR ! GGA flavour (author initials) |
712 | + integer, intent(in) :: IREL ! Relativistic exchange? 0=no, 1=yes |
713 | + integer, intent(in) :: nSpin ! Number of spin components |
714 | + real(dp),intent(in) :: D(nSpin) ! Local electron (spin) density |
715 | + real(dp),intent(in) :: GD(3,nSpin) ! Gradient of electron density |
716 | + |
717 | + ! Output |
718 | + real(dp),intent(out):: EPSX ! Exchange energy per electron |
719 | + real(dp),intent(out):: EPSC ! Correlation energy per electron |
720 | + real(dp),intent(out):: dEXdD(nSpin) ! dEx/dDens, Ex=Int(dens*epsX) |
721 | + real(dp),intent(out):: dECdD(nSpin) ! dEc/dDens |
722 | + real(dp),intent(out):: dEXdGD(3,nSpin) ! dEx/dGrad(Dens) |
723 | + real(dp),intent(out):: dECdGD(3,nSpin) ! dEc/dGrad(Dens) |
724 | +#ifdef LIBXC |
725 | + logical, intent(in), optional :: is_libxc_in |
726 | + type(xc_f90_pointer_t), optional :: xc_func, xc_info |
727 | +#endif |
728 | + |
729 | + ! Internal variables and arrays |
730 | + integer :: NS, is, ix |
731 | + real(dp) :: DD(2), dECdDD(2), dEXdDD(2), & |
732 | + dDDdD(2,4), dDTOTdD(4), dDPOLdD(4), & |
733 | + dECdGDD(3,2), dEXdGDD(3,2), & |
734 | + dGDDdD(3,2,4), dGDDdGD(2,4), & |
735 | + dGDTOTdD(3,4), dGDPOLdD(3,4), & |
736 | + dGDTOTdGD(4), dGDPOLdGD(4), & |
737 | + DPOL, DTOT, GDD(3,2), GDTOT(3), GDPOL(3), & |
738 | + VPOL |
739 | + real(dp), parameter :: DENMIN = 1.e-12_dp |
740 | + |
741 | + real(dp):: theta, phi, c2, s2, st, ct, cp, sp, dpolz, dpolxy |
742 | + |
743 | + logical , parameter :: old_scheme = .true. |
744 | + |
745 | +#ifdef LIBXC |
746 | + logical :: is_libxc |
747 | + real(dp) :: eps, dedn(nspin), sgm(3), dedsgm(3), dedgd(3, nspin) |
748 | +#endif |
749 | + |
750 | + ! Handle non-collinear spin case |
751 | + if (nSpin==4) then |
752 | + NS = 2 ! Diagonal spin components |
753 | + |
754 | + if ( old_scheme ) then |
755 | + DTOT = D(1) + D(2) |
756 | + dpolz= D(1) - D(2) |
757 | + dpolxy= 2.0d0*sqrt(d(3)**2+d(4)**2) |
758 | + dpol = sqrt( dpolz**2 + dpolxy**2 ) |
759 | + if ( dpol.gt.1.0d-12 ) then |
760 | theta = atan2(dpolxy,dpolz) |
761 | - else |
762 | + else |
763 | theta = 0.0_dp |
764 | - endif |
765 | - C2 = COS(THETA/2.0_dp) |
766 | - S2 = SIN(THETA/2.0_dp) |
767 | - ST = SIN(THETA) |
768 | - CT = COS(THETA) |
769 | - PHI = ATAN2(-D(4),D(3)) |
770 | - CP = COS(PHI) |
771 | - SP = SIN(PHI) |
772 | - |
773 | - DD(1) = 0.5D0 * ( DTOT + DPOL ) |
774 | - DD(2) = 0.5D0 * ( DTOT - DPOL ) |
775 | - DO IX = 1,3 |
776 | - GDD(IX,1) = GD(IX,1)*C2**2 + GD(IX,2)*S2**2 + |
777 | - . 2.d0*C2*S2*(GD(IX,3)*CP - GD(IX,4)*SP) |
778 | - GDD(IX,2) = GD(IX,1)*S2**2 + GD(IX,2)*C2**2 - |
779 | - . 2.d0*C2*S2*(GD(IX,3)*CP - GD(IX,4)*SP) |
780 | - ENDDO |
781 | - |
782 | - else |
783 | + endif |
784 | + C2 = COS(THETA/2.0_dp) |
785 | + S2 = SIN(THETA/2.0_dp) |
786 | + ST = SIN(THETA) |
787 | + CT = COS(THETA) |
788 | + PHI = ATAN2(-D(4),D(3)) |
789 | + CP = COS(PHI) |
790 | + SP = SIN(PHI) |
791 | + |
792 | + DD(1) = 0.5D0 * ( DTOT + DPOL ) |
793 | + DD(2) = 0.5D0 * ( DTOT - DPOL ) |
794 | + DO IX = 1,3 |
795 | + GDD(IX,1) = GD(IX,1)*C2**2 + GD(IX,2)*S2**2 + & |
796 | + 2.d0*C2*S2*(GD(IX,3)*CP - GD(IX,4)*SP) |
797 | + GDD(IX,2) = GD(IX,1)*S2**2 + GD(IX,2)*C2**2 - & |
798 | + 2.d0*C2*S2*(GD(IX,3)*CP - GD(IX,4)*SP) |
799 | + ENDDO |
800 | + |
801 | + else |
802 | |
803 | ! Find eigenvalues of density matrix Dij (diagonal densities DD, i.e. |
804 | ! up and down densities along the spin direction). Note convention: |
805 | ! D(1)=D11, D(2)=D22, D(3)=Re(D12)=Re(D21), D(4)=Im(D12)=-Im(D21) |
806 | DTOT = D(1) + D(2) ! DensTot (DensUp+DensDn) |
807 | - DPOL = SQRT( (D(1)-D(2))**2 ! DensPol (DensUp-DensDn) |
808 | - . + 4*(D(3)**2+D(4)**2) ) |
809 | + DPOL = SQRT( (D(1)-D(2))**2 & ! DensPol (DensUp-DensDn) |
810 | + + 4*(D(3)**2+D(4)**2) ) |
811 | DD(1) = ( DTOT + DPOL ) / 2 ! DensUp |
812 | DD(2) = ( DTOT - DPOL ) / 2 ! DensDn |
813 | DPOL = max( DPOL , DENMIN ) ! Avoid division by zero |
814 | |
815 | ! Find gradients of up and down densities |
816 | GDTOT(:) = GD(:,1) + GD(:,2) ! Grad(DensTot) |
817 | - GDPOL(:) = ( (D(1)-D(2))*(GD(:,1)-GD(:,2)) ! Grad(DensPol) |
818 | - . + 4*(D(3)*GD(:,3)+D(4)*GD(:,4)) ) |
819 | - . / DPOL |
820 | + GDPOL(:) = ( (D(1)-D(2))*(GD(:,1)-GD(:,2)) & ! Grad(DensPol) |
821 | + + 4*(D(3)*GD(:,3)+D(4)*GD(:,4)) ) / DPOL |
822 | GDD(:,1) = ( GDTOT(:) + GDPOL(:) ) / 2 ! Grad(DensUp) |
823 | GDD(:,2) = ( GDTOT(:) - GDPOL(:) ) / 2 ! Grad(DensDn) |
824 | |
825 | @@ -209,18 +204,18 @@ |
826 | |
827 | ! Derivatives of grad(Dup) and grad(Ddn) with respect to D(i) |
828 | dGDTOTdD(1:3,1:4) = 0 ! dGradDensTot/dD(i) |
829 | - dGDPOLdD(:,1) = + (GD(:,1)-GD(:,2))/DPOL ! dGradDensPol/dD(i) |
830 | - . - GDPOL(:) * dDPOLdD(1)/DPOL |
831 | - dGDPOLdD(:,2) = - (GD(:,1)-GD(:,2))/DPOL |
832 | - . - GDPOL(:) * dDPOLdD(2)/DPOL |
833 | - dGDPOLdD(:,3) = 4*GD(:,3)/DPOL |
834 | - . - GDPOL(:) * dDPOLdD(3)/DPOL |
835 | - dGDPOLdD(:,4) = 4*GD(:,4)/DPOL |
836 | - . - GDPOL(:) * dDPOLdD(4)/DPOL |
837 | - dGDDdD(:,1,:) = ( dGDTOTdD(:,:) ! dGradDensUp/dD(i) |
838 | - . + dGDPOLdD(:,:) ) / 2 |
839 | - dGDDdD(:,2,:) = ( dGDTOTdD(:,:) ! dGradDensDn/dD(i) |
840 | - . - dGDPOLdD(:,:) ) / 2 |
841 | + dGDPOLdD(:,1) = + (GD(:,1)-GD(:,2))/DPOL & ! dGradDensPol/dD(i) |
842 | + - GDPOL(:) * dDPOLdD(1)/DPOL |
843 | + dGDPOLdD(:,2) = - (GD(:,1)-GD(:,2))/DPOL & |
844 | + - GDPOL(:) * dDPOLdD(2)/DPOL |
845 | + dGDPOLdD(:,3) = 4*GD(:,3)/DPOL & |
846 | + - GDPOL(:) * dDPOLdD(3)/DPOL |
847 | + dGDPOLdD(:,4) = 4*GD(:,4)/DPOL & |
848 | + - GDPOL(:) * dDPOLdD(4)/DPOL |
849 | + dGDDdD(:,1,:) = ( dGDTOTdD(:,:) & ! dGradDensUp/dD(i) |
850 | + + dGDPOLdD(:,:) ) / 2 |
851 | + dGDDdD(:,2,:) = ( dGDTOTdD(:,:) & ! dGradDensDn/dD(i) |
852 | + - dGDPOLdD(:,:) ) / 2 |
853 | |
854 | ! Derivatives of grad(Dup) and grad(Ddn) with respect to grad(D(i)) |
855 | dGDTOTdGD(1:2) = 1 ! dGradDensTot/dGradD(i) |
856 | @@ -229,190 +224,188 @@ |
857 | dGDPOLdGD(2) = -( D(1) - D(2) ) / DPOL |
858 | dGDPOLdGD(3) = 4 * D(3) / DPOL |
859 | dGDPOLdGD(4) = 4 * D(4) / DPOL |
860 | - dGDDdGD(1,:) = ( dGDTOTdGD(:) ! dGradDensUp/dGradD(i) |
861 | - . + dGDPOLdGD(:) ) / 2 |
862 | - dGDDdGD(2,:) = ( dGDTOTdGD(:) ! dGradDensDn/dGradD(i) |
863 | - . - dGDPOLdGD(:) ) / 2 |
864 | - endif |
865 | - |
866 | - else if (nSpin==1 .or. nSpin==2) then ! Normal (collinear) spin |
867 | - NS = nSpin |
868 | - DD(1:NS) = max( D(1:NS), 0.0_dp ) ! ag: Avoid negative densities |
869 | - GDD(1:3,1:NS) = GD(1:3,1:NS) |
870 | - else |
871 | - call die('ggaxc: ERROR: invalid value of nSpin') |
872 | - end if ! (nSpin==4) |
873 | - |
874 | - ! Select functional to find energy density and its derivatives |
875 | + dGDDdGD(1,:) = ( dGDTOTdGD(:) & ! dGradDensUp/dGradD(i) |
876 | + + dGDPOLdGD(:) ) / 2 |
877 | + dGDDdGD(2,:) = ( dGDTOTdGD(:) & ! dGradDensDn/dGradD(i) |
878 | + - dGDPOLdGD(:) ) / 2 |
879 | + endif |
880 | + |
881 | + else if (nSpin==1 .or. nSpin==2) then ! Normal (collinear) spin |
882 | + NS = nSpin |
883 | + DD(1:NS) = max( D(1:NS), 0.0_dp ) ! ag: Avoid negative densities |
884 | + GDD(1:3,1:NS) = GD(1:3,1:NS) |
885 | + else |
886 | + call die('ggaxc: ERROR: invalid value of nSpin') |
887 | + end if ! (nSpin==4) |
888 | + |
889 | + ! Select functional to find energy density and its derivatives |
890 | #ifdef LIBXC |
891 | - is_libxc = .false. |
892 | - if (present(is_libxc_in)) then |
893 | - if (is_libxc_in) then |
894 | - if ((.not. present(xc_func)) .or. |
895 | - $ (.not. present(xc_info))) then |
896 | - call die("xc_func and xc_info not present") |
897 | - endif |
898 | - is_libxc = .true. |
899 | - endif |
900 | + is_libxc = .false. |
901 | + if (present(is_libxc_in)) then |
902 | + if (is_libxc_in) then |
903 | + if ((.not. present(xc_func)) .or. & |
904 | + (.not. present(xc_info))) then |
905 | + call die("xc_func and xc_info not present") |
906 | + endif |
907 | + is_libxc = .true. |
908 | endif |
909 | - |
910 | - if (is_libxc) then |
911 | - sgm(1) = sum(GDD(1:3,1)*GDD(1:3,1)) |
912 | - IF (nspin == 1) THEN |
913 | - ! do nothing |
914 | - ELSE |
915 | - sgm(2) = sum(GDD(1:3,1)*GDD(1:3,2)) |
916 | - sgm(3) = sum(GDD(1:3,2)*GDD(1:3,2)) |
917 | - ENDIF |
918 | - IF (xc_f90_info_family(xc_info) /= XC_FAMILY_GGA) THEN |
919 | - call die('GGAXC: Functional is not a GGA') |
920 | - ENDIF |
921 | - |
922 | - call xc_f90_gga_exc_vxc(xc_func, 1, DD(1), sgm(1), eps, dedn(1), |
923 | - . dedsgm(1)) |
924 | - IF (nspin == 1) THEN |
925 | - dedgd(1:3, 1) = 2.0D0*dedsgm(1)*GDD(1:3, 1) |
926 | - ELSE |
927 | - dedgd(1:3, 1) = 2.0D0*dedsgm(1)*GDD(1:3, 1) + |
928 | - . dedsgm(2)*GDD(1:3, 2) |
929 | - dedgd(1:3, 2) = 2.0D0*dedsgm(3)*GDD(1:3, 2) + |
930 | - . dedsgm(2)*GDD(1:3, 1) |
931 | - ENDIF |
932 | - IF (xc_f90_info_kind(xc_info) == XC_CORRELATION) THEN |
933 | - EPSC = eps |
934 | - dECdDD(1:nspin) = dedn(1:nspin) |
935 | - dECdGDD(1:3, 1:nspin) = dedgd(1:3, 1:nspin) |
936 | - EPSX = 0.0_dp |
937 | - dEXdDD(1:nspin) = 0.0_dp |
938 | - dEXdGDD(1:3, 1:nspin) = 0.0_dp |
939 | - ELSE if (xc_f90_info_kind(xc_info) == XC_EXCHANGE) THEN |
940 | - EPSX = eps |
941 | - dEXdDD(1:nspin) = dedn(1:nspin) |
942 | - dEXdGDD(1:3, 1:nspin) = dedgd(1:3, 1:nspin) |
943 | - EPSC = 0.0_dp |
944 | - dECdDD(1:nspin) = 0.0_dp |
945 | - dECdGDD(1:3, 1:nspin) = 0.0_dp |
946 | - ELSE ! combined functional, use an arbitrary 50/50 split |
947 | - EPSX = 0.5_dp * eps |
948 | - dEXdDD(1:nspin) = 0.5_dp * dedn(1:nspin) |
949 | - dEXdGDD(1:3, 1:nspin) = 0.5_dp * dedgd(1:3, 1:nspin) |
950 | - ! |
951 | - EPSC = EPSX |
952 | - dECdDD(1:nspin) = dEXdDD(1:nspin) |
953 | - dECdGDD(1:3, 1:nspin) = dEXdGDD(1:3,1:nspin) |
954 | - ENDIF |
955 | - |
956 | - else IF (AUTHOR.EQ.'PBE' .OR. AUTHOR.EQ.'pbe') THEN |
957 | + endif |
958 | + |
959 | + if (is_libxc) then |
960 | + sgm(1) = sum(GDD(1:3,1)*GDD(1:3,1)) |
961 | + IF (nspin == 1) THEN |
962 | + ! do nothing |
963 | + ELSE |
964 | + sgm(2) = sum(GDD(1:3,1)*GDD(1:3,2)) |
965 | + sgm(3) = sum(GDD(1:3,2)*GDD(1:3,2)) |
966 | + ENDIF |
967 | + IF (xc_f90_info_family(xc_info) /= XC_FAMILY_GGA) THEN |
968 | + call die('GGAXC: Functional is not a GGA') |
969 | + ENDIF |
970 | + |
971 | + call xc_f90_gga_exc_vxc(xc_func, 1, DD(1), sgm(1), eps, dedn(1), & |
972 | + dedsgm(1)) |
973 | + IF (nspin == 1) THEN |
974 | + dedgd(1:3, 1) = 2.0D0*dedsgm(1)*GDD(1:3, 1) |
975 | + ELSE |
976 | + dedgd(1:3, 1) = 2.0D0*dedsgm(1)*GDD(1:3, 1) + dedsgm(2)*GDD(1:3, 2) |
977 | + dedgd(1:3, 2) = 2.0D0*dedsgm(3)*GDD(1:3, 2) + dedsgm(2)*GDD(1:3, 1) |
978 | + ENDIF |
979 | + IF (xc_f90_info_kind(xc_info) == XC_CORRELATION) THEN |
980 | + EPSC = eps |
981 | + dECdDD(1:nspin) = dedn(1:nspin) |
982 | + dECdGDD(1:3, 1:nspin) = dedgd(1:3, 1:nspin) |
983 | + EPSX = 0.0_dp |
984 | + dEXdDD(1:nspin) = 0.0_dp |
985 | + dEXdGDD(1:3, 1:nspin) = 0.0_dp |
986 | + ELSE if (xc_f90_info_kind(xc_info) == XC_EXCHANGE) THEN |
987 | + EPSX = eps |
988 | + dEXdDD(1:nspin) = dedn(1:nspin) |
989 | + dEXdGDD(1:3, 1:nspin) = dedgd(1:3, 1:nspin) |
990 | + EPSC = 0.0_dp |
991 | + dECdDD(1:nspin) = 0.0_dp |
992 | + dECdGDD(1:3, 1:nspin) = 0.0_dp |
993 | + ELSE ! combined functional, use an arbitrary 50/50 split |
994 | + EPSX = 0.5_dp * eps |
995 | + dEXdDD(1:nspin) = 0.5_dp * dedn(1:nspin) |
996 | + dEXdGDD(1:3, 1:nspin) = 0.5_dp * dedgd(1:3, 1:nspin) |
997 | + ! |
998 | + EPSC = EPSX |
999 | + dECdDD(1:nspin) = dEXdDD(1:nspin) |
1000 | + dECdGDD(1:3, 1:nspin) = dEXdGDD(1:3,1:nspin) |
1001 | + ENDIF |
1002 | + |
1003 | + else IF (AUTHOR.EQ.'PBE' .OR. AUTHOR.EQ.'pbe') THEN |
1004 | #else |
1005 | - IF (AUTHOR.EQ.'PBE' .OR. AUTHOR.EQ.'pbe') THEN |
1006 | + if (AUTHOR.EQ.'PBE' .OR. AUTHOR.EQ.'pbe') THEN |
1007 | #endif |
1008 | - CALL PBEXC( IREL, NS, DD, GDD, ! JMS |
1009 | - . EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1010 | - |
1011 | - ELSE IF (AUTHOR.EQ.'RPBE'.OR.AUTHOR.EQ.'rpbe') THEN |
1012 | - CALL RPBEXC( IREL, NS, DD, GDD, ! MVFS |
1013 | - . EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1014 | - |
1015 | - ELSE IF (AUTHOR.EQ.'WC'.OR.AUTHOR.EQ.'wc') THEN |
1016 | - CALL WCXC( IREL, NS, DD, GDD, ! MVFS |
1017 | - . EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1018 | - |
1019 | - ELSE IF (AUTHOR.EQ.'REVPBE'.OR.AUTHOR.EQ.'revpbe' |
1020 | - . .OR.AUTHOR.EQ.'revPBE') THEN |
1021 | - CALL REVPBEXC( IREL, NS, DD, GDD, ! EA |
1022 | - . EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1023 | - |
1024 | - ELSE IF (AUTHOR.EQ.'BLYP'.OR.AUTHOR.EQ.'blyp'.OR. |
1025 | - . AUTHOR.EQ.'LYP'.OR.AUTHOR.EQ.'lyp') THEN |
1026 | - CALL BLYPXC( NS, DD, GDD, ! AG |
1027 | - . EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1028 | - |
1029 | - ELSEIF (AUTHOR.EQ.'PW91' .OR. AUTHOR.EQ.'pw91') THEN |
1030 | - CALL PW91XC( IREL, NS, DD, GDD, ! AG |
1031 | - . EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1032 | - |
1033 | - ELSEIF (AUTHOR.EQ.'PBESOL' .OR. AUTHOR.EQ.'pbesol' .OR. |
1034 | - . AUTHOR.EQ.'PBEsol') THEN |
1035 | - CALL PBESOLXC( IREL, NS, DD, GDD, |
1036 | - . EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1037 | - |
1038 | - ELSEIF (AUTHOR.EQ.'AM05' .OR. AUTHOR.EQ.'am05') THEN |
1039 | - CALL AM05XC( IREL, NS, DD, GDD, |
1040 | - . EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1041 | - |
1042 | - ELSEIF (AUTHOR.EQ.'PBEJsJrLO' .OR. |
1043 | - . AUTHOR.EQ.'pbejsjrlo' .OR. |
1044 | - . AUTHOR.EQ.'PBEJSJRLO') THEN |
1045 | - CALL PBEJsJrLOxc( IREL, NS, DD, GDD, |
1046 | - . EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1047 | - |
1048 | - ELSEIF (AUTHOR.EQ.'PBEJsJrHEG' .OR. |
1049 | - . AUTHOR.EQ.'pbejsjrheg' .OR. |
1050 | - . AUTHOR.EQ.'PBEJSJRHEG') THEN |
1051 | - CALL PBEJsJrHEGxc( IREL, NS, DD, GDD, |
1052 | - . EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1053 | - |
1054 | - ELSEIF (AUTHOR.EQ.'PBEGcGxLO' .OR. |
1055 | - . AUTHOR.EQ.'pbegcgxlo' .OR. |
1056 | - . AUTHOR.EQ.'PBEGCGXLO') THEN |
1057 | - CALL PBEGcGxLOxc( IREL, NS, DD, GDD, |
1058 | - . EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1059 | - |
1060 | - ELSEIF (AUTHOR.EQ.'PBEGcGxHEG' .OR. |
1061 | - . AUTHOR.EQ.'pbegcgxheg' .OR. |
1062 | - . AUTHOR.EQ.'PBEGCGXHEG') THEN |
1063 | - CALL PBEGcGxHEGxc( IREL, NS, DD, GDD, |
1064 | - . EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1065 | - |
1066 | - ELSEIF (AUTHOR.EQ.'PW86' .OR. AUTHOR.EQ.'pw86') THEN |
1067 | - CALL PW86X( IREL, NS, DD, GDD, |
1068 | - . EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1069 | - |
1070 | - ELSEIF (AUTHOR.EQ.'PW86R' .OR. AUTHOR.EQ.'pw86r') THEN |
1071 | - CALL PW86RX( IREL, NS, DD, GDD, |
1072 | - . EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1073 | - |
1074 | - ELSEIF (AUTHOR.EQ.'B88' .OR. AUTHOR.EQ.'b88') THEN |
1075 | - CALL B88X( IREL, NS, DD, GDD, |
1076 | - . EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1077 | - |
1078 | - ELSEIF (AUTHOR.EQ.'B88KBM' .OR. AUTHOR.EQ.'b88kbm') THEN |
1079 | - CALL B88KBMX( IREL, NS, DD, GDD, |
1080 | - . EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1081 | - |
1082 | - ELSEIF (AUTHOR.EQ.'C09' .OR. AUTHOR.EQ.'c09') THEN |
1083 | - CALL C09X( IREL, NS, DD, GDD, |
1084 | - . EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1085 | - |
1086 | - ELSEIF (AUTHOR.EQ.'BH' .OR. AUTHOR.EQ.'bh') THEN |
1087 | - CALL BHX( IREL, NS, DD, GDD, |
1088 | - . EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1089 | - |
1090 | - ELSE |
1091 | - call die('GGAXC: Unknown author ' // trim(AUTHOR)) |
1092 | - ENDIF |
1093 | - |
1094 | - ! Find dE/dD(i) and dE/dGradD(i). Note convention: |
1095 | - ! DEDD(1)=dE/dD11, DEDD(2)=dE/dD22, DEDD(3)=Re(dE/dD12)=Re(dE/dD21), |
1096 | - ! DEDD(4)=Im(dE/dD12)=-Im(dE/D21) |
1097 | - if (nSpin==4) then ! Non colinear spin |
1098 | - ! dE/dD(i) = dE/dDup * dDup/dD(i) + dE/dDdn * dDdn/dD(i) |
1099 | - ! + dE/dGDup * dGDup/dD(i) + dE/dGDdn * dGDdn/dD(i) |
1100 | - ! dE/dGradD(i) = dE/dGDup * dGDup/dGD(i) + dE/dGDdn * dGDdn/dGD(i) |
1101 | - |
1102 | - if ( old_scheme ) then |
1103 | - VPOL = (dExdDD(1)-dExdDD(2)) * ct |
1104 | - dExdD(1) = 0.5D0 * ( dExdDD(1) + dExdDD(2) + VPOL ) |
1105 | - dExdD(2) = 0.5D0 * ( dExdDD(1) + dExdDD(2) - VPOL ) |
1106 | - dExdD(3) = 0.5d0 * (dExdDD(1)-dExdDD(2)) * st * cp |
1107 | - dExdD(4) =-0.5d0 * (dExdDD(1)-dExdDD(2)) * st * sp |
1108 | - VPOL = (dEcdDD(1)-dEcdDD(2)) * ct |
1109 | - dEcdD(1) = 0.5D0 * ( dEcdDD(1) + dEcdDD(2) + VPOL ) |
1110 | - dEcdD(2) = 0.5D0 * ( dEcdDD(1) + dEcdDD(2) - VPOL ) |
1111 | - dEcdD(3) = 0.5d0 * (dEcdDD(1)-dEcdDD(2)) * st * cp |
1112 | - dEcdD(4) =-0.5d0 * (dEcdDD(1)-dEcdDD(2)) * st * sp |
1113 | -C Gradient terms |
1114 | - DO IX = 1,3 |
1115 | + CALL PBEXC( IREL, NS, DD, GDD, & ! JMS |
1116 | + EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1117 | + |
1118 | + ELSE IF (AUTHOR.EQ.'RPBE'.OR.AUTHOR.EQ.'rpbe') THEN |
1119 | + CALL RPBEXC( IREL, NS, DD, GDD, & ! MVFS |
1120 | + EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1121 | + |
1122 | + ELSE IF (AUTHOR.EQ.'WC'.OR.AUTHOR.EQ.'wc') THEN |
1123 | + CALL WCXC( IREL, NS, DD, GDD, & ! MVFS |
1124 | + EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1125 | + |
1126 | + ELSE IF (AUTHOR.EQ.'REVPBE'.OR.AUTHOR.EQ.'revpbe' & |
1127 | + .OR.AUTHOR.EQ.'revPBE') THEN |
1128 | + CALL REVPBEXC( IREL, NS, DD, GDD, & ! EA |
1129 | + EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1130 | + |
1131 | + ELSE IF (AUTHOR.EQ.'BLYP'.OR.AUTHOR.EQ.'blyp'.OR. & |
1132 | + AUTHOR.EQ.'LYP'.OR.AUTHOR.EQ.'lyp') THEN |
1133 | + CALL BLYPXC( NS, DD, GDD, & ! AG |
1134 | + EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1135 | + |
1136 | + ELSEIF (AUTHOR.EQ.'PW91' .OR. AUTHOR.EQ.'pw91') THEN |
1137 | + CALL PW91XC( IREL, NS, DD, GDD, & ! AG |
1138 | + EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1139 | + |
1140 | + ELSEIF (AUTHOR.EQ.'PBESOL' .OR. AUTHOR.EQ.'pbesol' .OR. & |
1141 | + AUTHOR.EQ.'PBEsol') THEN |
1142 | + CALL PBESOLXC( IREL, NS, DD, GDD, & |
1143 | + EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1144 | + |
1145 | + ELSEIF (AUTHOR.EQ.'AM05' .OR. AUTHOR.EQ.'am05') THEN |
1146 | + CALL AM05XC( IREL, NS, DD, GDD, & |
1147 | + EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1148 | + |
1149 | + ELSEIF (AUTHOR.EQ.'PBEJsJrLO' .OR. & |
1150 | + AUTHOR.EQ.'pbejsjrlo' .OR. & |
1151 | + AUTHOR.EQ.'PBEJSJRLO') THEN |
1152 | + CALL PBEJsJrLOxc( IREL, NS, DD, GDD, & |
1153 | + EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1154 | + |
1155 | + ELSEIF (AUTHOR.EQ.'PBEJsJrHEG' .OR. & |
1156 | + AUTHOR.EQ.'pbejsjrheg' .OR. & |
1157 | + AUTHOR.EQ.'PBEJSJRHEG') THEN |
1158 | + CALL PBEJsJrHEGxc( IREL, NS, DD, GDD, & |
1159 | + EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1160 | + |
1161 | + ELSEIF (AUTHOR.EQ.'PBEGcGxLO' .OR. & |
1162 | + AUTHOR.EQ.'pbegcgxlo' .OR. & |
1163 | + AUTHOR.EQ.'PBEGCGXLO') THEN |
1164 | + CALL PBEGcGxLOxc( IREL, NS, DD, GDD, & |
1165 | + EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1166 | + |
1167 | + ELSEIF (AUTHOR.EQ.'PBEGcGxHEG' .OR. & |
1168 | + AUTHOR.EQ.'pbegcgxheg' .OR. & |
1169 | + AUTHOR.EQ.'PBEGCGXHEG') THEN |
1170 | + CALL PBEGcGxHEGxc( IREL, NS, DD, GDD, & |
1171 | + EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1172 | + |
1173 | + ELSEIF (AUTHOR.EQ.'PW86' .OR. AUTHOR.EQ.'pw86') THEN |
1174 | + CALL PW86X( IREL, NS, DD, GDD, & |
1175 | + EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1176 | + |
1177 | + ELSEIF (AUTHOR.EQ.'PW86R' .OR. AUTHOR.EQ.'pw86r') THEN |
1178 | + CALL PW86RX( IREL, NS, DD, GDD, & |
1179 | + EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1180 | + |
1181 | + ELSEIF (AUTHOR.EQ.'B88' .OR. AUTHOR.EQ.'b88') THEN |
1182 | + CALL B88X( IREL, NS, DD, GDD, & |
1183 | + EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1184 | + |
1185 | + ELSEIF (AUTHOR.EQ.'B88KBM' .OR. AUTHOR.EQ.'b88kbm') THEN |
1186 | + CALL B88KBMX( IREL, NS, DD, GDD, & |
1187 | + EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1188 | + |
1189 | + ELSEIF (AUTHOR.EQ.'C09' .OR. AUTHOR.EQ.'c09') THEN |
1190 | + CALL C09X( IREL, NS, DD, GDD, & |
1191 | + EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1192 | + |
1193 | + ELSEIF (AUTHOR.EQ.'BH' .OR. AUTHOR.EQ.'bh') THEN |
1194 | + CALL BHX( IREL, NS, DD, GDD, & |
1195 | + EPSX, EPSC, dEXdDD, dECdDD, dEXdGDD, dECdGDD ) |
1196 | + |
1197 | + ELSE |
1198 | + call die('GGAXC: Unknown author ' // trim(AUTHOR)) |
1199 | + ENDIF |
1200 | + |
1201 | + ! Find dE/dD(i) and dE/dGradD(i). Note convention: |
1202 | + ! DEDD(1)=dE/dD11, DEDD(2)=dE/dD22, DEDD(3)=Re(dE/dD12)=Re(dE/dD21), |
1203 | + ! DEDD(4)=Im(dE/dD12)=-Im(dE/D21) |
1204 | + if (nSpin==4) then ! Non colinear spin |
1205 | + ! dE/dD(i) = dE/dDup * dDup/dD(i) + dE/dDdn * dDdn/dD(i) |
1206 | + ! + dE/dGDup * dGDup/dD(i) + dE/dGDdn * dGDdn/dD(i) |
1207 | + ! dE/dGradD(i) = dE/dGDup * dGDup/dGD(i) + dE/dGDdn * dGDdn/dGD(i) |
1208 | + |
1209 | + if ( old_scheme ) then |
1210 | + VPOL = (dExdDD(1)-dExdDD(2)) * ct |
1211 | + dExdD(1) = 0.5D0 * ( dExdDD(1) + dExdDD(2) + VPOL ) |
1212 | + dExdD(2) = 0.5D0 * ( dExdDD(1) + dExdDD(2) - VPOL ) |
1213 | + dExdD(3) = 0.5d0 * (dExdDD(1)-dExdDD(2)) * st * cp |
1214 | + dExdD(4) =-0.5d0 * (dExdDD(1)-dExdDD(2)) * st * sp |
1215 | + VPOL = (dEcdDD(1)-dEcdDD(2)) * ct |
1216 | + dEcdD(1) = 0.5D0 * ( dEcdDD(1) + dEcdDD(2) + VPOL ) |
1217 | + dEcdD(2) = 0.5D0 * ( dEcdDD(1) + dEcdDD(2) - VPOL ) |
1218 | + dEcdD(3) = 0.5d0 * (dEcdDD(1)-dEcdDD(2)) * st * cp |
1219 | + dEcdD(4) =-0.5d0 * (dEcdDD(1)-dEcdDD(2)) * st * sp |
1220 | + ! Gradient terms |
1221 | + DO IX = 1,3 |
1222 | dExdGD(IX,1) = dExdGDD(IX,1)*C2**2 + dExdGDD(IX,2)*S2**2 |
1223 | dExdGD(IX,2) = dExdGDD(IX,1)*S2**2 + dExdGDD(IX,2)*C2**2 |
1224 | dExdGD(IX,3) = 0.5D0*(dExdGDD(IX,1) - dExdGDD(IX,2))*ST*CP |
1225 | @@ -421,15 +414,15 @@ |
1226 | dEcdGD(IX,2) = dEcdGDD(IX,1)*S2**2 + dEcdGDD(IX,2)*C2**2 |
1227 | dEcdGD(IX,3) = 0.5D0*(dEcdGDD(IX,1) - dEcdGDD(IX,2))*ST*CP |
1228 | dEcdGD(IX,4) =-0.5D0*(dEcdGDD(IX,1) - dEcdGDD(IX,2))*ST*SP |
1229 | - enddo |
1230 | + enddo |
1231 | |
1232 | - else |
1233 | + else |
1234 | |
1235 | do is = 1,4 |
1236 | - dEXdD(is) = sum( dEXdDD(:) * dDDdD(:,is) ) |
1237 | - . + sum( dEXdGDD(:,:) * dGDDdD(:,:,is) ) |
1238 | - dECdD(is) = sum( dECdDD(:) * dDDdD(:,is) ) |
1239 | - . + sum( dECdGDD(:,:) * dGDDdD(:,:,is) ) |
1240 | + dEXdD(is) = sum( dEXdDD(:) * dDDdD(:,is) ) & |
1241 | + + sum( dEXdGDD(:,:) * dGDDdD(:,:,is) ) |
1242 | + dECdD(is) = sum( dECdDD(:) * dDDdD(:,is) ) & |
1243 | + + sum( dECdGDD(:,:) * dGDDdD(:,:,is) ) |
1244 | do ix = 1,3 |
1245 | dEXdGD(ix,is) = sum( dEXdGDD(ix,:) * dGDDdGD(:,is) ) |
1246 | dECdGD(ix,is) = sum( dECdGDD(ix,:) * dGDDdGD(:,is) ) |
1247 | @@ -445,881 +438,858 @@ |
1248 | dEXdGD(:,3:4) = dEXdGD(:,3:4) / 2 |
1249 | dECdGD(:,3:4) = dECdGD(:,3:4) / 2 |
1250 | |
1251 | - endif |
1252 | - else ! Collinear spin => just copy derivatives to output arrays |
1253 | - dEXdD(1:nSpin) = dEXdDD(1:nSpin) |
1254 | - dECdD(1:nSpin) = dECdDD(1:nSpin) |
1255 | - dEXdGD(:,1:nSpin) = dEXdGDD(:,1:nSpin) |
1256 | - dECdGD(:,1:nSpin) = dECdGDD(:,1:nSpin) |
1257 | - end if ! (nSpin==4) |
1258 | - |
1259 | - END SUBROUTINE GGAXC |
1260 | - |
1261 | - |
1262 | - |
1263 | - SUBROUTINE PBEformXC( beta, mu, kappa, iRel, nSpin, Dens, GDens, |
1264 | - . EX, EC, dEXdD, dECdD, dEXdGD, dECdGD ) |
1265 | - |
1266 | -C ********************************************************************* |
1267 | -C Implements Perdew-Burke-Ernzerhof Generalized-Gradient-Approximation |
1268 | -C functional form, but with variable values for parameters beta, mu, and |
1269 | -C kappa. Ref: J.P.Perdew, K.Burke & M.Ernzerhof, PRL 77, 3865 (1996) |
1270 | -C Written by L.C.Balbas and J.M.Soler. December 1996. |
1271 | -C ******** INPUT ****************************************************** |
1272 | -C REAL*8 BETA : Parameter beta of the PBE functional |
1273 | -C REAL*8 MU : Parameter mu of the PBE functional |
1274 | -C REAL*8 KAPPA : Parameter kappa of the PBE functional |
1275 | -C INTEGER IREL : Relativistic-exchange switch (0=No, 1=Yes) |
1276 | -C INTEGER nspin : Number of spin polarizations (1 or 2) |
1277 | -C REAL*8 Dens(nspin) : Total electron density (if nspin=1) or |
1278 | -C spin electron density (if nspin=2) |
1279 | -C REAL*8 GDens(3,nspin) : Total or spin density gradient |
1280 | -C ******** OUTPUT ***************************************************** |
1281 | -C REAL*8 EX : Exchange energy density |
1282 | -C REAL*8 EC : Correlation energy density |
1283 | -C REAL*8 DEXDD(nspin) : Partial derivative |
1284 | -C d(DensTot*Ex)/dDens(ispin), |
1285 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
1286 | -C For a constant density, this is the |
1287 | -C exchange potential |
1288 | -C REAL*8 DECDD(nspin) : Partial derivative |
1289 | -C d(DensTot*Ec)/dDens(ispin), |
1290 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
1291 | -C For a constant density, this is the |
1292 | -C correlation potential |
1293 | -C REAL*8 DEXDGD(3,nspin): Partial derivative |
1294 | -C d(DensTot*Ex)/d(GradDens(i,ispin)) |
1295 | -C REAL*8 DECDGD(3,nspin): Partial derivative |
1296 | -C d(DensTot*Ec)/d(GradDens(i,ispin)) |
1297 | -C ********* UNITS **************************************************** |
1298 | -C Lengths in Bohr |
1299 | -C Densities in electrons per Bohr**3 |
1300 | -C Energies in Hartrees |
1301 | -C Gradient vectors in cartesian coordinates |
1302 | -C ********* ROUTINES CALLED ****************************************** |
1303 | -C EXCHNG, PW92C |
1304 | -C ******************************************************************** |
1305 | - |
1306 | - implicit none |
1307 | - |
1308 | -C Input |
1309 | - real(dp),intent(in) :: beta ! Parameter of PBE functional |
1310 | - real(dp),intent(in) :: mu ! Parameter of PBE functional |
1311 | - real(dp),intent(in) :: kappa ! Parameter of PBE functional |
1312 | - integer, intent(in) :: iRel ! Relativistic exchange? 0=no, 1=yes |
1313 | - integer, intent(in) :: nSpin ! Number of spin components |
1314 | - real(dp),intent(in) :: Dens(nSpin) ! Local electron (spin) density |
1315 | - real(dp),intent(in) :: GDens(3,nSpin) ! Gradient of electron density |
1316 | - |
1317 | -C Output |
1318 | - real(dp),intent(out):: EX ! Exchange energy per electron |
1319 | - real(dp),intent(out):: EC ! Correlation energy per electron |
1320 | - real(dp),intent(out):: dEXdD(nSpin) ! dEx/dDens, Ex=Int(dens*epsX) |
1321 | - real(dp),intent(out):: dECdD(nSpin) ! dEc/dDens |
1322 | - real(dp),intent(out):: dEXdGD(3,nSpin) ! dEx/dGrad(Dens) |
1323 | - real(dp),intent(out):: dECdGD(3,nSpin) ! dEc/dGrad(Dens) |
1324 | - |
1325 | -C Internal variables |
1326 | - INTEGER |
1327 | - . IS, IX |
1328 | - real(dp) |
1329 | - . A, D(2), DADD, DECUDD, DENMIN, |
1330 | - . DF1DD, DF2DD, DF3DD, DF4DD, DF1DGD, DF3DGD, DF4DGD, |
1331 | - . DFCDD(2), DFCDGD(3,2), DFDD, DFDGD, DFXDD(2), DFXDGD(3,2), |
1332 | - . DHDD, DHDGD, DKFDD, DKSDD, DPDD, DPDZ, DRSDD, |
1333 | - . DS(2), DSDD, DSDGD, DT, DTDD, DTDGD, DZDD(2), |
1334 | - . ECUNIF, EXUNIF, |
1335 | - . F, F1, F2, F3, F4, FC, FX, FOUTHD, |
1336 | - . GAMMA, GD(3,2), GDM(2), GDMIN, GDMS, GDMT, GDS, GDT(3), |
1337 | - . H, HALF, KF, KFS, KS, PHI, PI, RS, S, |
1338 | - . T, THD, THRHLF, TWO, TWOTHD, VCUNIF(2), VXUNIF(2), ZETA |
1339 | - |
1340 | -C Lower bounds of density and its gradient to avoid divisions by zero |
1341 | - PARAMETER ( DENMIN = 1.D-12 ) |
1342 | - PARAMETER ( GDMIN = 1.D-12 ) |
1343 | - |
1344 | -C Fix some numerical parameters |
1345 | - PARAMETER ( FOUTHD=4.D0/3.D0, HALF=0.5D0, |
1346 | - . THD=1.D0/3.D0, THRHLF=1.5D0, |
1347 | - . TWO=2.D0, TWOTHD=2.D0/3.D0 ) |
1348 | - |
1349 | -C Fix some more numerical constants |
1350 | - PI = 4 * ATAN(1.D0) |
1351 | - GAMMA = (1 - LOG(TWO)) / PI**2 |
1352 | - |
1353 | -C Translate density and its gradient to new variables |
1354 | - IF (nspin .EQ. 1) THEN |
1355 | - D(1) = HALF * Dens(1) |
1356 | - D(2) = D(1) |
1357 | - DT = MAX( DENMIN, Dens(1) ) |
1358 | - DO 10 IX = 1,3 |
1359 | - GD(IX,1) = HALF * GDens(IX,1) |
1360 | - GD(IX,2) = GD(IX,1) |
1361 | - GDT(IX) = GDens(IX,1) |
1362 | - 10 CONTINUE |
1363 | - ELSE |
1364 | - D(1) = Dens(1) |
1365 | - D(2) = Dens(2) |
1366 | - DT = MAX( DENMIN, Dens(1)+Dens(2) ) |
1367 | - DO 20 IX = 1,3 |
1368 | - GD(IX,1) = GDens(IX,1) |
1369 | - GD(IX,2) = GDens(IX,2) |
1370 | - GDT(IX) = GDens(IX,1) + GDens(IX,2) |
1371 | - 20 CONTINUE |
1372 | - ENDIF |
1373 | - GDM(1) = SQRT( GD(1,1)**2 + GD(2,1)**2 + GD(3,1)**2 ) |
1374 | - GDM(2) = SQRT( GD(1,2)**2 + GD(2,2)**2 + GD(3,2)**2 ) |
1375 | - GDMT = SQRT( GDT(1)**2 + GDT(2)**2 + GDT(3)**2 ) |
1376 | - GDMT = MAX( GDMIN, GDMT ) |
1377 | - |
1378 | -C Find local correlation energy and potential |
1379 | - CALL PW92C( 2, D, ECUNIF, VCUNIF ) |
1380 | - |
1381 | -C Find total correlation energy |
1382 | - RS = ( 3 / (4*PI*DT) )**THD |
1383 | - KF = (3 * PI**2 * DT)**THD |
1384 | - KS = SQRT( 4 * KF / PI ) |
1385 | - ZETA = ( D(1) - D(2) ) / DT |
1386 | - ZETA = MAX( -1.D0+DENMIN, ZETA ) |
1387 | - ZETA = MIN( 1.D0-DENMIN, ZETA ) |
1388 | - PHI = HALF * ( (1+ZETA)**TWOTHD + (1-ZETA)**TWOTHD ) |
1389 | - T = GDMT / (2 * PHI * KS * DT) |
1390 | - F1 = ECUNIF / GAMMA / PHI**3 |
1391 | - F2 = EXP(-F1) |
1392 | - A = BETA / GAMMA / (F2-1) |
1393 | - F3 = T**2 + A * T**4 |
1394 | - F4 = BETA/GAMMA * F3 / (1 + A*F3) |
1395 | - H = GAMMA * PHI**3 * LOG( 1 + F4 ) |
1396 | - FC = ECUNIF + H |
1397 | - |
1398 | -C Find correlation energy derivatives |
1399 | - DRSDD = - (THD * RS / DT) |
1400 | - DKFDD = THD * KF / DT |
1401 | - DKSDD = HALF * KS * DKFDD / KF |
1402 | - DZDD(1) = 1 / DT - ZETA / DT |
1403 | - DZDD(2) = - (1 / DT) - ZETA / DT |
1404 | - DPDZ = HALF * TWOTHD * ( 1/(1+ZETA)**THD - 1/(1-ZETA)**THD ) |
1405 | - DO 40 IS = 1,2 |
1406 | - DECUDD = ( VCUNIF(IS) - ECUNIF ) / DT |
1407 | - DPDD = DPDZ * DZDD(IS) |
1408 | - DTDD = (- T) * ( DPDD/PHI + DKSDD/KS + 1/DT ) |
1409 | - DF1DD = F1 * ( DECUDD/ECUNIF - 3*DPDD/PHI ) |
1410 | - DF2DD = (- F2) * DF1DD |
1411 | - DADD = (- A) * DF2DD / (F2-1) |
1412 | - DF3DD = (2*T + 4*A*T**3) * DTDD + DADD * T**4 |
1413 | - DF4DD = F4 * ( DF3DD/F3 - (DADD*F3+A*DF3DD)/(1+A*F3) ) |
1414 | - DHDD = 3 * H * DPDD / PHI |
1415 | - DHDD = DHDD + GAMMA * PHI**3 * DF4DD / (1+F4) |
1416 | - DFCDD(IS) = VCUNIF(IS) + H + DT * DHDD |
1417 | - |
1418 | - DO 30 IX = 1,3 |
1419 | - DTDGD = (T / GDMT) * GDT(IX) / GDMT |
1420 | - DF3DGD = DTDGD * ( 2 * T + 4 * A * T**3 ) |
1421 | - DF4DGD = F4 * DF3DGD * ( 1/F3 - A/(1+A*F3) ) |
1422 | - DHDGD = GAMMA * PHI**3 * DF4DGD / (1+F4) |
1423 | - DFCDGD(IX,IS) = DT * DHDGD |
1424 | - 30 CONTINUE |
1425 | - 40 CONTINUE |
1426 | - |
1427 | -C Find exchange energy and potential |
1428 | - FX = 0 |
1429 | - DO 60 IS = 1,2 |
1430 | - DS(IS) = MAX( DENMIN, 2 * D(IS) ) |
1431 | - GDMS = MAX( GDMIN, 2 * GDM(IS) ) |
1432 | - KFS = (3 * PI**2 * DS(IS))**THD |
1433 | - S = GDMS / (2 * KFS * DS(IS)) |
1434 | - F1 = 1 + MU * S**2 / KAPPA |
1435 | - F = 1 + KAPPA - KAPPA / F1 |
1436 | -c |
1437 | -c Note nspin=1 in call to exchng... |
1438 | -c |
1439 | - CALL EXCHNG( IREL, 1, DS(IS), EXUNIF, VXUNIF(IS) ) |
1440 | - FX = FX + DS(IS) * EXUNIF * F |
1441 | - |
1442 | - DKFDD = THD * KFS / DS(IS) |
1443 | - DSDD = S * ( -(DKFDD/KFS) - 1/DS(IS) ) |
1444 | - DF1DD = 2 * (F1-1) * DSDD / S |
1445 | - DFDD = KAPPA * DF1DD / F1**2 |
1446 | - DFXDD(IS) = VXUNIF(IS) * F + DS(IS) * EXUNIF * DFDD |
1447 | - |
1448 | - DO 50 IX = 1,3 |
1449 | - GDS = 2 * GD(IX,IS) |
1450 | - DSDGD = (S / GDMS) * GDS / GDMS |
1451 | - DF1DGD = 2 * MU * S * DSDGD / KAPPA |
1452 | - DFDGD = KAPPA * DF1DGD / F1**2 |
1453 | - DFXDGD(IX,IS) = DS(IS) * EXUNIF * DFDGD |
1454 | - 50 CONTINUE |
1455 | - 60 CONTINUE |
1456 | - FX = HALF * FX / DT |
1457 | - |
1458 | -C Set output arguments |
1459 | - EX = FX |
1460 | - EC = FC |
1461 | - DO 90 IS = 1,nspin |
1462 | - DEXDD(IS) = DFXDD(IS) |
1463 | - DECDD(IS) = DFCDD(IS) |
1464 | - DO 80 IX = 1,3 |
1465 | - DEXDGD(IX,IS) = DFXDGD(IX,IS) |
1466 | - DECDGD(IX,IS) = DFCDGD(IX,IS) |
1467 | - 80 CONTINUE |
1468 | - 90 CONTINUE |
1469 | - |
1470 | - END SUBROUTINE PBEformXC |
1471 | - |
1472 | - |
1473 | - |
1474 | - SUBROUTINE PBEXC( IREL, nspin, Dens, GDens, |
1475 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
1476 | - |
1477 | -C ********************************************************************* |
1478 | -C Implements Perdew-Burke-Ernzerhof Generalized-Gradient-Approximation. |
1479 | -C Ref: J.P.Perdew, K.Burke & M.Ernzerhof, PRL 77, 3865 (1996) |
1480 | -C Modified to call PBEformXC by J.M.Soler. December 2009. |
1481 | -C ******** INPUT ****************************************************** |
1482 | -C INTEGER IREL : Relativistic-exchange switch (0=No, 1=Yes) |
1483 | -C INTEGER nspin : Number of spin polarizations (1 or 2) |
1484 | -C REAL*8 Dens(nspin) : Total electron density (if nspin=1) or |
1485 | -C spin electron density (if nspin=2) |
1486 | -C REAL*8 GDens(3,nspin) : Total or spin density gradient |
1487 | -C ******** OUTPUT ***************************************************** |
1488 | -C REAL*8 EX : Exchange energy density |
1489 | -C REAL*8 EC : Correlation energy density |
1490 | -C REAL*8 DEXDD(nspin) : Partial derivative |
1491 | -C d(DensTot*Ex)/dDens(ispin), |
1492 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
1493 | -C For a constant density, this is the |
1494 | -C exchange potential |
1495 | -C REAL*8 DECDD(nspin) : Partial derivative |
1496 | -C d(DensTot*Ec)/dDens(ispin), |
1497 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
1498 | -C For a constant density, this is the |
1499 | -C correlation potential |
1500 | -C REAL*8 DEXDGD(3,nspin): Partial derivative |
1501 | -C d(DensTot*Ex)/d(GradDens(i,ispin)) |
1502 | -C REAL*8 DECDGD(3,nspin): Partial derivative |
1503 | -C d(DensTot*Ec)/d(GradDens(i,ispin)) |
1504 | -C ********* UNITS **************************************************** |
1505 | -C Lengths in Bohr |
1506 | -C Densities in electrons per Bohr**3 |
1507 | -C Energies in Hartrees |
1508 | -C Gradient vectors in cartesian coordinates |
1509 | -C ********* ROUTINES CALLED ****************************************** |
1510 | -C EXCHNG, PW92C |
1511 | -C ******************************************************************** |
1512 | - |
1513 | - IMPLICIT NONE |
1514 | - |
1515 | -C Passed arguments |
1516 | - integer, intent(in) :: IREL, NSPIN |
1517 | - real(dp),intent(in) :: DENS(NSPIN), GDENS(3,NSPIN) |
1518 | - real(dp),intent(out):: EX, EC, DECDD(NSPIN), DECDGD(3,NSPIN), |
1519 | - . DEXDD(NSPIN), DEXDGD(3,NSPIN) |
1520 | - |
1521 | -C Internal variables |
1522 | - real(dp):: BETA, KAPPA, MU, PI |
1523 | - |
1524 | -C Fix values for PBE functional parameters |
1525 | - PI = 4 * ATAN(1._dp) |
1526 | - BETA = 0.066725_dp ! From grad. exp. for correl. rs->0 |
1527 | - MU = BETA * PI**2 / 3 ! From Jell. response for x+c |
1528 | - KAPPA = 0.804_dp ! From general Lieb-Oxford bound |
1529 | - |
1530 | -C Call PBE routine with appropriate values for beta, mu, and kappa. |
1531 | - CALL PBEformXC( BETA, MU, KAPPA, IREL, nspin, Dens, GDens, |
1532 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
1533 | - |
1534 | - END SUBROUTINE PBEXC |
1535 | - |
1536 | - |
1537 | - |
1538 | - SUBROUTINE REVPBEXC( IREL, nspin, Dens, GDens, |
1539 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
1540 | - |
1541 | -C ********************************************************************* |
1542 | -C Implements revPBE: revised Perdew-Burke-Ernzerhof GGA. |
1543 | -C Ref: Y. Zhang & W. Yang, Phys. Rev. Lett. 80, 890 (1998). |
1544 | -C Same interface as PBEXC. |
1545 | -C revPBE parameters introduced by E. Artacho in January 2006 |
1546 | -C Modified to call PBEformXC by J.M.Soler. December 2009. |
1547 | -C ******************************************************************** |
1548 | - |
1549 | - IMPLICIT NONE |
1550 | - |
1551 | -C Passed arguments |
1552 | - integer, intent(in) :: IREL, NSPIN |
1553 | - real(dp),intent(in) :: DENS(NSPIN), GDENS(3,NSPIN) |
1554 | - real(dp),intent(out):: EX, EC, DECDD(NSPIN), DECDGD(3,NSPIN), |
1555 | - . DEXDD(NSPIN), DEXDGD(3,NSPIN) |
1556 | - |
1557 | -C Internal variables |
1558 | - real(dp):: BETA, KAPPA, MU, PI |
1559 | - |
1560 | -C Fix values for PBE functional parameters |
1561 | - PI = 4 * ATAN(1._dp) |
1562 | - BETA = 0.066725_dp ! From grad. exp. for correl. rs->0 |
1563 | - MU = BETA * PI**2 / 3 ! From Jell. response for x+c |
1564 | - KAPPA = 1.245_dp ! From fit of molecular energies |
1565 | - |
1566 | -C Call PBE routine with appropriate values for beta, mu, and kappa. |
1567 | - CALL PBEformXC( BETA, MU, KAPPA, IREL, nspin, Dens, GDens, |
1568 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
1569 | - |
1570 | - END SUBROUTINE REVPBEXC |
1571 | - |
1572 | - |
1573 | - |
1574 | - SUBROUTINE PBESOLXC( IREL, NSPIN, DENS, GDENS, |
1575 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
1576 | - |
1577 | -C ********************************************************************* |
1578 | -C Implements Perdew-Burke-Ernzerhof Generalized-Gradient-Approximation. |
1579 | -C with the revised parameters for solids (PBEsol). |
1580 | -C Ref: J.P.Perdew et al, PRL 100, 136406 (2008) |
1581 | -C Same interface as PBEXC. |
1582 | -C Modified by J.D. Gale for PBEsol. May 2009. |
1583 | -C Modified to call PBEformXC by J.M.Soler. December 2009. |
1584 | -C ******************************************************************** |
1585 | - |
1586 | - IMPLICIT NONE |
1587 | - |
1588 | -C Passed arguments |
1589 | - integer, intent(in) :: IREL, NSPIN |
1590 | - real(dp),intent(in) :: DENS(NSPIN), GDENS(3,NSPIN) |
1591 | - real(dp),intent(out):: EX, EC, DECDD(NSPIN), DECDGD(3,NSPIN), |
1592 | - . DEXDD(NSPIN), DEXDGD(3,NSPIN) |
1593 | - |
1594 | -C Internal variables |
1595 | - real(dp):: BETA, KAPPA, MU, PI |
1596 | - |
1597 | -C Fix values for PBE functional parameters |
1598 | - PI = 4 * ATAN(1._dp) |
1599 | - BETA = 0.046_dp ! From fit of Jell. surf. energies |
1600 | - MU = 10.0_dp / 81.0_dp ! From grad. exp. for exchange. |
1601 | - KAPPA = 0.804_dp ! From general Lieb-Oxford bound |
1602 | - |
1603 | -C Call PBE routine with appropriate values for beta, mu, and kappa. |
1604 | - CALL PBEformXC( BETA, MU, KAPPA, IREL, nspin, Dens, GDens, |
1605 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
1606 | - |
1607 | - END SUBROUTINE PBESOLXC |
1608 | - |
1609 | - |
1610 | - |
1611 | - SUBROUTINE PBEJsJrLOxc( IREL, NSPIN, DENS, GDENS, |
1612 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
1613 | - |
1614 | -C ********************************************************************* |
1615 | -C Implements Perdew-Burke-Ernzerhof Generalized-Gradient-Approximation |
1616 | -C functional form, with revised parameters of Capelle et al: |
1617 | -C Js refers to Jellium surface energies, that fix parameter beta |
1618 | -C Jr refers to Jellium response, that fixes parameter mu |
1619 | -C LO refers to Lieb-Oxford bound, that fixes parameter kappa |
1620 | -C Refs: L.S.Pedroza et al, PRB 79, 201106 (2009) |
1621 | -C M.M.Odashima et al, J. Chem. Theory Comp. 5, 798 (2009) |
1622 | -C Same interface as PBEXC. J.M.Soler. December 2009. |
1623 | -C ******************************************************************** |
1624 | - |
1625 | - IMPLICIT NONE |
1626 | - |
1627 | -C Passed arguments |
1628 | - integer, intent(in) :: IREL, NSPIN |
1629 | - real(dp),intent(in) :: DENS(NSPIN), GDENS(3,NSPIN) |
1630 | - real(dp),intent(out):: EX, EC, DECDD(NSPIN), DECDGD(3,NSPIN), |
1631 | - . DEXDD(NSPIN), DEXDGD(3,NSPIN) |
1632 | - |
1633 | -C Internal variables |
1634 | - real(dp):: BETA, KAPPA, MU, PI |
1635 | - |
1636 | -C Fix values for PBE functional parameters |
1637 | - PI = 4 * ATAN(1._dp) |
1638 | - BETA = 0.046_dp ! From fit of Jell. surf. energies |
1639 | - MU = BETA * PI**2 / 3 ! From Jell. response for x+c |
1640 | - KAPPA = 0.804_dp ! From general Lieb-Oxford bound |
1641 | - |
1642 | -C Call PBE routine with appropriate values for beta, mu, and kappa. |
1643 | - CALL PBEformXC( BETA, MU, KAPPA, IREL, nspin, Dens, GDens, |
1644 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
1645 | - |
1646 | - END SUBROUTINE PBEJsJrLOxc |
1647 | - |
1648 | - |
1649 | - |
1650 | - SUBROUTINE PBEJsJrHEGxc( IREL, NSPIN, DENS, GDENS, |
1651 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
1652 | - |
1653 | -C ********************************************************************* |
1654 | -C Implements Perdew-Burke-Ernzerhof Generalized-Gradient-Approximation |
1655 | -C functional form, with revised parameters of Capelle et al: |
1656 | -C Js refers to Jellium surface energies, that fix parameter beta |
1657 | -C Jr refers to Jellium response, that fixes parameter mu |
1658 | -C HGE refers to the Lieb-Oxford bound for the low-density limit of |
1659 | -C the homogeneous electron gas, that fixes parameter kappa |
1660 | -C Refs: L.S.Pedroza et al, PRB 79, 201106 (2009) |
1661 | -C M.M.Odashima et al, J. Chem. Theory Comp. 5, 798 (2009) |
1662 | -C Same interface as PBEXC. J.M.Soler. December 2009. |
1663 | -C ******************************************************************** |
1664 | - |
1665 | - IMPLICIT NONE |
1666 | - |
1667 | -C Passed arguments |
1668 | - integer, intent(in) :: IREL, NSPIN |
1669 | - real(dp),intent(in) :: DENS(NSPIN), GDENS(3,NSPIN) |
1670 | - real(dp),intent(out):: EX, EC, DECDD(NSPIN), DECDGD(3,NSPIN), |
1671 | - . DEXDD(NSPIN), DEXDGD(3,NSPIN) |
1672 | - |
1673 | -C Internal variables |
1674 | - real(dp):: BETA, KAPPA, MU, PI |
1675 | - |
1676 | -C Fix values for PBE functional parameters |
1677 | - PI = 4 * ATAN(1._dp) |
1678 | - BETA = 0.046_dp ! From fit of Jell. surf. energies |
1679 | - MU = BETA * PI**2 / 3 ! From Jell. response for x+c |
1680 | - KAPPA = 0.552_dp ! From Lieb-Oxford bound for HEG |
1681 | - |
1682 | -C Call PBE routine with appropriate values for beta, mu, and kappa. |
1683 | - CALL PBEformXC( BETA, MU, KAPPA, IREL, nspin, Dens, GDens, |
1684 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
1685 | - |
1686 | - END SUBROUTINE PBEJsJrHEGxc |
1687 | - |
1688 | - |
1689 | - |
1690 | - SUBROUTINE PBEGcGxLOxc( IREL, NSPIN, DENS, GDENS, |
1691 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
1692 | - |
1693 | -C ********************************************************************* |
1694 | -C Implements Perdew-Burke-Ernzerhof Generalized-Gradient-Approximation |
1695 | -C functional form, with revised parameters of Capelle et al: |
1696 | -C Gc refers to gradient exp. for correl., that fixes parameter beta |
1697 | -C Gx refers to grad. expansion for exchange, that fixes parameter mu |
1698 | -C LO refers to Lieb-Oxford bound, that fixes parameter kappa |
1699 | -C Refs: L.S.Pedroza et al, PRB 79, 201106 (2009) |
1700 | -C M.M.Odashima et al, J. Chem. Theory Comp. 5, 798 (2009) |
1701 | -C Same interface as PBEXC. J.M.Soler. December 2009. |
1702 | -C ******************************************************************** |
1703 | - |
1704 | - IMPLICIT NONE |
1705 | - |
1706 | -C Passed arguments |
1707 | - integer, intent(in) :: IREL, NSPIN |
1708 | - real(dp),intent(in) :: DENS(NSPIN), GDENS(3,NSPIN) |
1709 | - real(dp),intent(out):: EX, EC, DECDD(NSPIN), DECDGD(3,NSPIN), |
1710 | - . DEXDD(NSPIN), DEXDGD(3,NSPIN) |
1711 | - |
1712 | -C Internal variables |
1713 | - real(dp):: BETA, KAPPA, MU, PI |
1714 | - |
1715 | -C Fix values for PBE functional parameters |
1716 | - PI = 4 * ATAN(1._dp) |
1717 | - BETA = 0.066725_dp ! From grad. exp. for correl. rs->0 |
1718 | - MU = 10._dp / 81._dp ! From grad. exp. for exchange. |
1719 | - KAPPA = 0.804_dp ! From general Lieb-Oxford bound |
1720 | - |
1721 | -C Call PBE routine with appropriate values for beta, mu, and kappa. |
1722 | - CALL PBEformXC( BETA, MU, KAPPA, IREL, nspin, Dens, GDens, |
1723 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
1724 | - |
1725 | - END SUBROUTINE PBEGcGxLOxc |
1726 | - |
1727 | - |
1728 | - |
1729 | - SUBROUTINE PBEGcGxHEGxc( IREL, NSPIN, DENS, GDENS, |
1730 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
1731 | - |
1732 | -C ********************************************************************* |
1733 | -C Implements Perdew-Burke-Ernzerhof Generalized-Gradient-Approximation |
1734 | -C functional form, with revised parameters of Capelle et al: |
1735 | -C Gc refers to gradient exp. for correl., that fixes parameter beta |
1736 | -C Gx refers to grad. expansion for exchange, that fixes parameter mu |
1737 | -C HGE refers to the Lieb-Oxford bound for the low-density limit of |
1738 | -C the homogeneous electron gas, that fixes parameter kappa |
1739 | -C Refs: L.S.Pedroza et al, PRB 79, 201106 (2009) |
1740 | -C M.M.Odashima et al, J. Chem. Theory Comp. 5, 798 (2009) |
1741 | -C Same interface as PBEXC. J.M.Soler. December 2009. |
1742 | -C ******************************************************************** |
1743 | - |
1744 | - IMPLICIT NONE |
1745 | - |
1746 | -C Passed arguments |
1747 | - integer, intent(in) :: IREL, NSPIN |
1748 | - real(dp),intent(in) :: DENS(NSPIN), GDENS(3,NSPIN) |
1749 | - real(dp),intent(out):: EX, EC, DECDD(NSPIN), DECDGD(3,NSPIN), |
1750 | - . DEXDD(NSPIN), DEXDGD(3,NSPIN) |
1751 | - |
1752 | -C Internal variables |
1753 | - real(dp):: BETA, KAPPA, MU, PI |
1754 | - |
1755 | -C Fix values for PBE functional parameters |
1756 | - PI = 4 * ATAN(1._dp) |
1757 | - BETA = 0.066725_dp ! From grad. exp. for correl. rs->0 |
1758 | - MU = 10._dp / 81._dp ! From grad. exp. for exchange. |
1759 | - KAPPA = 0.552_dp ! From Lieb-Oxford bound for HEG |
1760 | - |
1761 | -C Call PBE routine with appropriate values for beta, mu, and kappa. |
1762 | - CALL PBEformXC( BETA, MU, KAPPA, IREL, nspin, Dens, GDens, |
1763 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
1764 | - |
1765 | - END SUBROUTINE PBEGcGxHEGxc |
1766 | - |
1767 | - |
1768 | - |
1769 | - SUBROUTINE PW91XC( IREL, nspin, Dens, GDens, |
1770 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
1771 | - |
1772 | -C ********************************************************************* |
1773 | -C Implements Perdew-Wang91 Generalized-Gradient-Approximation. |
1774 | -C Ref: JCP 100, 1290 (1994) |
1775 | -C Written by J.L. Martins August 2000 |
1776 | -C ******** INPUT ****************************************************** |
1777 | -C INTEGER IREL : Relativistic-exchange switch (0=No, 1=Yes) |
1778 | -C INTEGER nspin : Number of spin polarizations (1 or 2) |
1779 | -C REAL*8 Dens(nspin) : Total electron density (if nspin=1) or |
1780 | -C spin electron density (if nspin=2) |
1781 | -C REAL*8 GDens(3,nspin) : Total or spin density gradient |
1782 | -C ******** OUTPUT ***************************************************** |
1783 | -C REAL*8 EX : Exchange energy density |
1784 | -C REAL*8 EC : Correlation energy density |
1785 | -C REAL*8 DEXDD(nspin) : Partial derivative |
1786 | -C d(DensTot*Ex)/dDens(ispin), |
1787 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
1788 | -C For a constant density, this is the |
1789 | -C exchange potential |
1790 | -C REAL*8 DECDD(nspin) : Partial derivative |
1791 | -C d(DensTot*Ec)/dDens(ispin), |
1792 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
1793 | -C For a constant density, this is the |
1794 | -C correlation potential |
1795 | -C REAL*8 DEXDGD(3,nspin): Partial derivative |
1796 | -C d(DensTot*Ex)/d(GradDens(i,ispin)) |
1797 | -C REAL*8 DECDGD(3,nspin): Partial derivative |
1798 | -C d(DensTot*Ec)/d(GradDens(i,ispin)) |
1799 | -C ********* UNITS **************************************************** |
1800 | -C Lengths in Bohr |
1801 | -C Densities in electrons per Bohr**3 |
1802 | -C Energies in Hartrees |
1803 | -C Gradient vectors in cartesian coordinates |
1804 | -C ********* ROUTINES CALLED ****************************************** |
1805 | -C EXCHNG, PW92C |
1806 | -C ******************************************************************** |
1807 | - |
1808 | - implicit none |
1809 | - INTEGER IREL, nspin |
1810 | - real(dp) Dens(nspin), DECDD(nspin), DECDGD(3,nspin), |
1811 | - . DEXDD(nspin), DEXDGD(3,nspin), GDens(3,nspin) |
1812 | - |
1813 | -C Internal variables |
1814 | - INTEGER |
1815 | - . IS, IX |
1816 | - real(dp) |
1817 | - . A, BETA, D(2), DADD, DECUDD, DENMIN, |
1818 | - . DF1DD, DF2DD, DF3DD, DF4DD, DF1DGD, DF3DGD, DF4DGD, |
1819 | - . DFCDD(2), DFCDGD(3,2), DFDD, DFDGD, DFXDD(2), DFXDGD(3,2), |
1820 | - . DHDD, DHDGD, DKFDD, DKSDD, DPDD, DPDZ, DRSDD, |
1821 | - . DS(2), DSDD, DSDGD, DT, DTDD, DTDGD, DZDD(2), |
1822 | - . EC, ECUNIF, EX, EXUNIF, |
1823 | - . F, F1, F2, F3, F4, FC, FX, FOUTHD, |
1824 | - . GAMMA, GD(3,2), GDM(2), GDMIN, GDMS, GDMT, GDS, GDT(3), |
1825 | - . H, HALF, KF, KFS, KS, PHI, PI, RS, S, |
1826 | - . T, THD, THRHLF, TWO, TWOTHD, VCUNIF(2), VXUNIF(2), ZETA |
1827 | - |
1828 | - real(dp) F5, F6, F7, F8, ASINHS |
1829 | - real(dp) DF5DD,DF6DD,DF7DD,DF8DD |
1830 | - real(dp) DF1DS, DF2DS, DF3DS, DFDS, DF7DGD |
1831 | - |
1832 | -C Lower bounds of density and its gradient to avoid divisions by zero |
1833 | - PARAMETER ( DENMIN = 1.D-12 ) |
1834 | - PARAMETER ( GDMIN = 1.D-12 ) |
1835 | - |
1836 | -C Fix some numerical parameters |
1837 | - PARAMETER ( FOUTHD=4.D0/3.D0, HALF=0.5D0, |
1838 | - . THD=1.D0/3.D0, THRHLF=1.5D0, |
1839 | - . TWO=2.D0, TWOTHD=2.D0/3.D0 ) |
1840 | - |
1841 | -C Fix some more numerical constants |
1842 | - PI = 4.0_dp * ATAN(1.0_dp) |
1843 | - BETA = 15.75592_dp * 0.004235_dp |
1844 | - GAMMA = BETA**2 / (2.0_dp * 0.09_dp) |
1845 | - |
1846 | -C Translate density and its gradient to new variables |
1847 | - IF (nspin .EQ. 1) THEN |
1848 | - D(1) = HALF * Dens(1) |
1849 | - D(2) = D(1) |
1850 | - DT = MAX( DENMIN, Dens(1) ) |
1851 | - DO 10 IX = 1,3 |
1852 | - GD(IX,1) = HALF * GDens(IX,1) |
1853 | - GD(IX,2) = GD(IX,1) |
1854 | - GDT(IX) = GDens(IX,1) |
1855 | - 10 CONTINUE |
1856 | - ELSE |
1857 | - D(1) = Dens(1) |
1858 | - D(2) = Dens(2) |
1859 | - DT = MAX( DENMIN, Dens(1)+Dens(2) ) |
1860 | - DO 20 IX = 1,3 |
1861 | - GD(IX,1) = GDens(IX,1) |
1862 | - GD(IX,2) = GDens(IX,2) |
1863 | - GDT(IX) = GDens(IX,1) + GDens(IX,2) |
1864 | - 20 CONTINUE |
1865 | - ENDIF |
1866 | - GDM(1) = SQRT( GD(1,1)**2 + GD(2,1)**2 + GD(3,1)**2 ) |
1867 | - GDM(2) = SQRT( GD(1,2)**2 + GD(2,2)**2 + GD(3,2)**2 ) |
1868 | - GDMT = SQRT( GDT(1)**2 + GDT(2)**2 + GDT(3)**2 ) |
1869 | - GDMT = MAX( GDMIN, GDMT ) |
1870 | - |
1871 | -C Find local correlation energy and potential |
1872 | - CALL PW92C( 2, D, ECUNIF, VCUNIF ) |
1873 | - |
1874 | -C Find total correlation energy |
1875 | - RS = ( 3 / (4*PI*DT) )**THD |
1876 | - KF = (3 * PI**2 * DT)**THD |
1877 | - KS = SQRT( 4 * KF / PI ) |
1878 | - S = GDMT / (2 * KF * DT) |
1879 | - T = GDMT / (2 * KS * DT) |
1880 | - ZETA = ( D(1) - D(2) ) / DT |
1881 | - ZETA = MAX( -1.D0+DENMIN, ZETA ) |
1882 | - ZETA = MIN( 1.D0-DENMIN, ZETA ) |
1883 | - PHI = HALF * ( (1+ZETA)**TWOTHD + (1-ZETA)**TWOTHD ) |
1884 | - F1 = ECUNIF / GAMMA / PHI**3 |
1885 | - F2 = EXP(-F1) |
1886 | - A = BETA / GAMMA / (F2-1) |
1887 | - F3 = T**2 + A * T**4 |
1888 | - F4 = BETA/GAMMA * F3 / (1 + A*F3) |
1889 | - F5 = 0.002568D0 + 0.023266D0*RS + 7.389D-6*RS**2 |
1890 | - F6 = 1.0D0 + 8.723D0*RS + 0.472D0*RS**2 + 0.07389D0*RS**3 |
1891 | - F7 = EXP(-100.0D0 * S**2 * PHI**4) |
1892 | - F8 = 15.75592D0*(0.001667212D0 + F5/F6 -0.004235D0 + |
1893 | - . 3.0D0*0.001667212D0/7.0D0) |
1894 | - H = GAMMA * PHI**3 * LOG( 1 + F4 ) + F8 * T**2 * F7 |
1895 | - FC = ECUNIF + H |
1896 | - |
1897 | -C Find correlation energy derivatives |
1898 | - DRSDD = - THD * RS / DT |
1899 | - DKFDD = THD * KF / DT |
1900 | - DKSDD = HALF * KS * DKFDD / KF |
1901 | - DZDD(1) = 1 / DT - ZETA / DT |
1902 | - DZDD(2) = - 1 / DT - ZETA / DT |
1903 | - DPDZ = HALF * TWOTHD * ( 1/(1+ZETA)**THD - 1/(1-ZETA)**THD ) |
1904 | - DO 40 IS = 1,2 |
1905 | - DECUDD = ( VCUNIF(IS) - ECUNIF ) / DT |
1906 | - DPDD = DPDZ * DZDD(IS) |
1907 | - DSDD = -S*DKFDD/KF - S/DT ! JMS: corrected, May.2014 |
1908 | - DTDD = -T*DKSDD/KS - T/DT |
1909 | - DF1DD = F1 * ( DECUDD/ECUNIF - 3*DPDD/PHI ) |
1910 | - DF2DD = - F2 * DF1DD |
1911 | - DADD = - A * DF2DD / (F2-1) |
1912 | - DF3DD = (2*T + 4*A*T**3) * DTDD + DADD * T**4 |
1913 | - DF4DD = F4 * ( DF3DD/F3 - (DADD*F3+A*DF3DD)/(1+A*F3) ) |
1914 | - DF5DD = (0.023266D0 + 2.0D0*7.389D-6*RS)*DRSDD |
1915 | - DF6DD = (8.723D0 + 2.0D0*0.472D0*RS |
1916 | - . + 3.0D0*0.07389D0*RS**2)*DRSDD |
1917 | - DF7DD = -200.0D0 * S * PHI**4 * DSDD * F7 |
1918 | - . -100.0D0 * S**2 * 4.0D0* PHI**3 * DPDD * F7 |
1919 | - DF8DD = 15.75592D0 * DF5DD/F6 - 15.75592D0*F5*DF6DD / F6**2 |
1920 | - DHDD = 3 * H * DPDD / PHI |
1921 | - DHDD = DHDD + GAMMA * PHI**3 * DF4DD / (1+F4) |
1922 | - DHDD = DHDD + DF8DD * T**2 * F7 |
1923 | - DHDD = DHDD + F8 * 2*T*DTDD *F7 |
1924 | - DHDD = DHDD + F8 * T**2 * DF7DD |
1925 | - |
1926 | - DFCDD(IS) = VCUNIF(IS) + H + DT * DHDD |
1927 | - DO 30 IX = 1,3 |
1928 | - DTDGD = (T / GDMT) * GDT(IX) / GDMT |
1929 | - DSDGD = (S / GDMT) * GDT(IX) / GDMT |
1930 | - DF3DGD = DTDGD * ( 2 * T + 4 * A * T**3 ) |
1931 | - DF4DGD = F4 * DF3DGD * ( 1/F3 - A/(1+A*F3) ) |
1932 | - DF7DGD = -200.0D0 * S * PHI**4 * DSDGD * F7 |
1933 | - DHDGD = GAMMA * PHI**3 * DF4DGD / (1+F4) |
1934 | - DHDGD = DHDGD + F8 * 2*T*DTDGD *F7 + F8 * T**2 *DF7DGD |
1935 | - DFCDGD(IX,IS) = DT * DHDGD |
1936 | - 30 CONTINUE |
1937 | - 40 CONTINUE |
1938 | - |
1939 | -C Find exchange energy and potential |
1940 | - FX = 0 |
1941 | - DO 60 IS = 1,2 |
1942 | - DS(1) = MAX( DENMIN, 2 * D(IS) ) |
1943 | - GDMS = MAX( GDMIN, 2 * GDM(IS) ) |
1944 | - KFS = (3 * PI**2 * DS(1))**THD |
1945 | - S = GDMS / (2 * KFS * DS(1)) |
1946 | - F4 = SQRT(1.0D0 + (7.7956D0*S)**2) |
1947 | - ASINHS = LOG(7.7956D0*S + F4) |
1948 | - F1 = 1.0D0 + 0.19645D0 * S * ASINHS |
1949 | - F2 = 0.2743D0 - 0.15084D0*EXP(-100.0D0*S*S) |
1950 | - F3 = 1.0D0 / (F1 + 0.004D0 * S*S*S*S) |
1951 | - F = (F1 + F2 * S*S ) * F3 |
1952 | - . |
1953 | - CALL EXCHNG( IREL, 1, DS, EXUNIF, VXUNIF ) |
1954 | - FX = FX + DS(1) * EXUNIF * F |
1955 | - |
1956 | - DKFDD = THD * KFS / DS(1) |
1957 | - DSDD = S * ( -DKFDD/KFS - 1/DS(1) ) |
1958 | - DF1DS = 0.19645D0 * ASINHS + |
1959 | - . 0.19645D0 * S * 7.7956D0 / F4 |
1960 | - DF2DS = 0.15084D0*200.0D0*S*EXP(-100.0D0*S*S) |
1961 | - DF3DS = - F3*F3 * (DF1DS + 4.0D0*0.004D0 * S*S*S) |
1962 | - DFDS = DF1DS * F3 + DF2DS * S*S * F3 + 2.0D0 * S * F2 * F3 |
1963 | - . + (F1 + F2 * S*S ) * DF3DS |
1964 | - DFXDD(IS) = VXUNIF(1) * F + DS(1) * EXUNIF * DFDS * DSDD |
1965 | - |
1966 | - DO 50 IX = 1,3 |
1967 | - GDS = 2 * GD(IX,IS) |
1968 | - DSDGD = (S / GDMS) * GDS / GDMS |
1969 | - DFDGD = DFDS * DSDGD |
1970 | - DFXDGD(IX,IS) = DS(1) * EXUNIF * DFDGD |
1971 | - 50 CONTINUE |
1972 | - 60 CONTINUE |
1973 | - FX = HALF * FX / DT |
1974 | - |
1975 | -C Set output arguments |
1976 | - EX = FX |
1977 | - EC = FC |
1978 | - DO 90 IS = 1,nspin |
1979 | - DEXDD(IS) = DFXDD(IS) |
1980 | - DECDD(IS) = DFCDD(IS) |
1981 | - DO 80 IX = 1,3 |
1982 | - DEXDGD(IX,IS) = DFXDGD(IX,IS) |
1983 | - DECDGD(IX,IS) = DFCDGD(IX,IS) |
1984 | - 80 CONTINUE |
1985 | - 90 CONTINUE |
1986 | - |
1987 | - END SUBROUTINE PW91XC |
1988 | - |
1989 | - |
1990 | - |
1991 | - subroutine blypxc(nspin,dens,gdens,EX,EC, |
1992 | - . dEXdd,dECdd,dEXdgd,dECdgd) |
1993 | -c *************************************************************** |
1994 | -c Implements Becke gradient exchange functional (A.D. |
1995 | -c Becke, Phys. Rev. A 38, 3098 (1988)) and Lee, Yang, Parr |
1996 | -c correlation functional (C. Lee, W. Yang, R.G. Parr, Phys. Rev. B |
1997 | -c 37, 785 (1988)), as modificated by Miehlich,Savin,Stoll and Preuss, |
1998 | -c Chem. Phys. Lett. 157,200 (1989). See also Johnson, Gill and Pople, |
1999 | -c J. Chem. Phys. 98, 5612 (1993). Some errors were detected in this |
2000 | -c last paper, so not all of the expressions correspond exactly to those |
2001 | -c implemented here. |
2002 | -c Written by Maider Machado. July 1998. |
2003 | -c **************** INPUT ******************************************** |
2004 | -c integer nspin : Number of spin polarizations (1 or 2) |
2005 | -c real*8 dens(nspin) : Total electron density (if nspin=1) or |
2006 | -c spin electron density (if nspin=2) |
2007 | -c real*8 gdens(3,nspin) : Total or spin density gradient |
2008 | -c ******** OUTPUT ***************************************************** |
2009 | -c real*8 ex : Exchange energy density |
2010 | -c real*8 ec : Correlation energy density |
2011 | -c real*8 dexdd(nspin) : Partial derivative |
2012 | -c d(DensTot*Ex)/dDens(ispin), |
2013 | -c where DensTot = Sum_ispin( Dens(ispin) ) |
2014 | -c For a constant density, this is the |
2015 | -c exchange potential |
2016 | -c real*8 decdd(nspin) : Partial derivative |
2017 | -c d(DensTot*Ec)/dDens(ispin), |
2018 | -c where DensTot = Sum_ispin( Dens(ispin) ) |
2019 | -c For a constant density, this is the |
2020 | -c correlation potential |
2021 | -c real*8 dexdgd(3,nspin): Partial derivative |
2022 | -c d(DensTot*Ex)/d(GradDens(i,ispin)) |
2023 | -c real*8 decdgd(3,nspin): Partial derivative |
2024 | -c d(DensTot*Ec)/d(GradDens(i,ispin)) |
2025 | -c ********* UNITS **************************************************** |
2026 | -c Lengths in Bohr |
2027 | -c Densities in electrons per Bohr**3 |
2028 | -c Energies in Hartrees |
2029 | -c Gradient vectors in cartesian coordinates |
2030 | -c ******************************************************************** |
2031 | - |
2032 | - implicit none |
2033 | - |
2034 | - integer nspin |
2035 | - real(dp) dens(nspin), gdens(3,nspin), EX, EC, |
2036 | - . dEXdd(nspin), dECdd(nspin), dEXdgd(3,nspin), |
2037 | - . dECdgd(3,nspin) |
2038 | - |
2039 | -c Internal variables |
2040 | - integer is,ix |
2041 | - real(dp) pi, beta, thd, tthd, thrhlf, half, fothd, |
2042 | - . d(2),gd(3,2),dmin, ash,gdm(2),denmin,dt, |
2043 | - . g(2),x(2),a,b,c,dd,onzthd,gdmin, |
2044 | - . ga, gb, gc,becke,dbecgd(3,2), |
2045 | - . dgdx(2), dgdxa, dgdxb, dgdxc,dgdxd,dbecdd(2), |
2046 | - . den,omega, domega, delta, ddelta,cf, |
2047 | - . gam11, gam12, gam22, LYPa, LYPb1, |
2048 | - . LYPb2,dLYP11,dLYP12,dLYP22,LYP, |
2049 | - . dd1g11,dd1g12,dd1g22,dd2g12,dd2g11,dd2g22, |
2050 | - . dLYPdd(2),dg11dd(3,2),dg22dd(3,2), |
2051 | - . dg12dd(3,2),dLYPgd(3,2) |
2052 | - |
2053 | -c Lower bounds of density and its gradient to avoid divisions by zero |
2054 | - parameter ( denmin=1.0e-8_dp ) |
2055 | - parameter ( gdmin=1.0e-8_dp ) |
2056 | - parameter ( dmin=1.0e-5_dp ) |
2057 | - |
2058 | -c Fix some numerical parameters |
2059 | - parameter ( thd = 1.d0/3.d0, tthd=2.d0/3.d0 ) |
2060 | - parameter ( thrhlf=1.5d0, half=0.5d0, |
2061 | - . fothd=4.d0/3.d0, onzthd=11.d0/3.d0) |
2062 | - |
2063 | -c Empirical parameter for Becke exchange functional (a.u.) |
2064 | - parameter(beta= 0.0042d0) |
2065 | - |
2066 | -c Constants for LYP functional (a.u.) |
2067 | - parameter(a=0.04918d0, b=0.132d0, c=0.2533d0, dd=0.349d0) |
2068 | - |
2069 | - pi= 4*atan(1.d0) |
2070 | - |
2071 | -c Translate density and its gradient to new variables |
2072 | - if (nspin .eq. 1) then |
2073 | - d(1) = half * dens(1) |
2074 | - d(1) = max(denmin,d(1)) |
2075 | - d(2) = d(1) |
2076 | - dt = max( denmin, dens(1) ) |
2077 | - do ix = 1,3 |
2078 | - gd(ix,1) = half * gdens(ix,1) |
2079 | - gd(ix,2) = gd(ix,1) |
2080 | - enddo |
2081 | - else |
2082 | - d(1) = dens(1) |
2083 | - d(2) = dens(2) |
2084 | - do is=1,2 |
2085 | - d(is) = max (denmin,d(is)) |
2086 | - enddo |
2087 | - dt = max( denmin, dens(1)+dens(2) ) |
2088 | - do ix = 1,3 |
2089 | - gd(ix,1) = gdens(ix,1) |
2090 | - gd(ix,2) = gdens(ix,2) |
2091 | - enddo |
2092 | endif |
2093 | - |
2094 | - gdm(1) = sqrt( gd(1,1)**2 + gd(2,1)**2 + gd(3,1)**2 ) |
2095 | - gdm(2) = sqrt( gd(1,2)**2 + gd(2,2)**2 + gd(3,2)**2 ) |
2096 | - |
2097 | + else ! Collinear spin => just copy derivatives to output arrays |
2098 | + dEXdD(1:nSpin) = dEXdDD(1:nSpin) |
2099 | + dECdD(1:nSpin) = dECdDD(1:nSpin) |
2100 | + dEXdGD(:,1:nSpin) = dEXdGDD(:,1:nSpin) |
2101 | + dECdGD(:,1:nSpin) = dECdGDD(:,1:nSpin) |
2102 | + end if ! (nSpin==4) |
2103 | + |
2104 | + END SUBROUTINE GGAXC |
2105 | + |
2106 | + |
2107 | + |
2108 | + SUBROUTINE PBEformXC( beta, mu, kappa, iRel, nSpin, Dens, GDens, & |
2109 | + EX, EC, dEXdD, dECdD, dEXdGD, dECdGD ) |
2110 | + |
2111 | + ! ********************************************************************* |
2112 | + ! Implements Perdew-Burke-Ernzerhof Generalized-Gradient-Approximation |
2113 | + ! functional form, but with variable values for parameters beta, mu, and |
2114 | + ! kappa. Ref: J.P.Perdew, K.Burke & M.Ernzerhof, PRL 77, 3865 (1996) |
2115 | + ! Written by L.C.Balbas and J.M.Soler. December 1996. |
2116 | + ! ******** INPUT ****************************************************** |
2117 | + ! REAL*8 BETA : Parameter beta of the PBE functional |
2118 | + ! REAL*8 MU : Parameter mu of the PBE functional |
2119 | + ! REAL*8 KAPPA : Parameter kappa of the PBE functional |
2120 | + ! INTEGER IREL : Relativistic-exchange switch (0=No, 1=Yes) |
2121 | + ! INTEGER nspin : Number of spin polarizations (1 or 2) |
2122 | + ! REAL*8 Dens(nspin) : Total electron density (if nspin=1) or |
2123 | + ! spin electron density (if nspin=2) |
2124 | + ! REAL*8 GDens(3,nspin) : Total or spin density gradient |
2125 | + ! ******** OUTPUT ***************************************************** |
2126 | + ! REAL*8 EX : Exchange energy density |
2127 | + ! REAL*8 EC : Correlation energy density |
2128 | + ! REAL*8 DEXDD(nspin) : Partial derivative |
2129 | + ! d(DensTot*Ex)/dDens(ispin), |
2130 | + ! where DensTot = Sum_ispin( Dens(ispin) ) |
2131 | + ! For a constant density, this is the |
2132 | + ! exchange potential |
2133 | + ! REAL*8 DECDD(nspin) : Partial derivative |
2134 | + ! d(DensTot*Ec)/dDens(ispin), |
2135 | + ! where DensTot = Sum_ispin( Dens(ispin) ) |
2136 | + ! For a constant density, this is the |
2137 | + ! correlation potential |
2138 | + ! REAL*8 DEXDGD(3,nspin): Partial derivative |
2139 | + ! d(DensTot*Ex)/d(GradDens(i,ispin)) |
2140 | + ! REAL*8 DECDGD(3,nspin): Partial derivative |
2141 | + ! d(DensTot*Ec)/d(GradDens(i,ispin)) |
2142 | + ! ********* UNITS **************************************************** |
2143 | + ! Lengths in Bohr |
2144 | + ! Densities in electrons per Bohr**3 |
2145 | + ! Energies in Hartrees |
2146 | + ! Gradient vectors in cartesian coordinates |
2147 | + ! ********* ROUTINES CALLED ****************************************** |
2148 | + ! EXCHNG, PW92C |
2149 | + ! ******************************************************************** |
2150 | + |
2151 | + ! Input |
2152 | + real(dp),intent(in) :: beta ! Parameter of PBE functional |
2153 | + real(dp),intent(in) :: mu ! Parameter of PBE functional |
2154 | + real(dp),intent(in) :: kappa ! Parameter of PBE functional |
2155 | + integer, intent(in) :: iRel ! Relativistic exchange? 0=no, 1=yes |
2156 | + integer, intent(in) :: nSpin ! Number of spin components |
2157 | + real(dp),intent(in) :: Dens(nSpin) ! Local electron (spin) density |
2158 | + real(dp),intent(in) :: GDens(3,nSpin) ! Gradient of electron density |
2159 | + |
2160 | + ! Output |
2161 | + real(dp),intent(out):: EX ! Exchange energy per electron |
2162 | + real(dp),intent(out):: EC ! Correlation energy per electron |
2163 | + real(dp),intent(out):: dEXdD(nSpin) ! dEx/dDens, Ex=Int(dens*epsX) |
2164 | + real(dp),intent(out):: dECdD(nSpin) ! dEc/dDens |
2165 | + real(dp),intent(out):: dEXdGD(3,nSpin) ! dEx/dGrad(Dens) |
2166 | + real(dp),intent(out):: dECdGD(3,nSpin) ! dEc/dGrad(Dens) |
2167 | + |
2168 | + ! Internal variables |
2169 | + INTEGER :: IS, IX |
2170 | + real(dp) & |
2171 | + A, D(2), DADD, DECUDD, DENMIN, & |
2172 | + DF1DD, DF2DD, DF3DD, DF4DD, DF1DGD, DF3DGD, DF4DGD, & |
2173 | + DFCDD(2), DFCDGD(3,2), DFDD, DFDGD, DFXDD(2), DFXDGD(3,2), & |
2174 | + DHDD, DHDGD, DKFDD, DKSDD, DPDD, DPDZ, DRSDD, & |
2175 | + DS(2), DSDD, DSDGD, DT, DTDD, DTDGD, DZDD(2), & |
2176 | + ECUNIF, EXUNIF, & |
2177 | + F, F1, F2, F3, F4, FC, FX, FOUTHD, & |
2178 | + GAMMA, GD(3,2), GDM(2), GDMIN, GDMS, GDMT, GDS, GDT(3), & |
2179 | + H, HALF, KF, KFS, KS, PHI, PI, RS, S, & |
2180 | + T, THD, THRHLF, TWO, TWOTHD, VCUNIF(2), VXUNIF(2), ZETA |
2181 | + |
2182 | + ! Lower bounds of density and its gradient to avoid divisions by zero |
2183 | + PARAMETER ( DENMIN = 1.D-12 ) |
2184 | + PARAMETER ( GDMIN = 1.D-12 ) |
2185 | + |
2186 | + ! Fix some numerical parameters |
2187 | + PARAMETER ( FOUTHD=4.D0/3.D0, HALF=0.5D0, & |
2188 | + THD=1.D0/3.D0, THRHLF=1.5D0, & |
2189 | + TWO=2.D0, TWOTHD=2.D0/3.D0 ) |
2190 | + |
2191 | + ! Fix some more numerical constants |
2192 | + PI = 4 * ATAN(1.D0) |
2193 | + GAMMA = (1 - LOG(TWO)) / PI**2 |
2194 | + |
2195 | + ! Translate density and its gradient to new variables |
2196 | + IF (nspin .EQ. 1) THEN |
2197 | + D(1) = HALF * Dens(1) |
2198 | + D(2) = D(1) |
2199 | + DT = MAX( DENMIN, Dens(1) ) |
2200 | + DO IX = 1,3 |
2201 | + GD(IX,1) = HALF * GDens(IX,1) |
2202 | + GD(IX,2) = GD(IX,1) |
2203 | + GDT(IX) = GDens(IX,1) |
2204 | + end DO |
2205 | + ELSE |
2206 | + D(1) = Dens(1) |
2207 | + D(2) = Dens(2) |
2208 | + DT = MAX( DENMIN, Dens(1)+Dens(2) ) |
2209 | + DO IX = 1,3 |
2210 | + GD(IX,1) = GDens(IX,1) |
2211 | + GD(IX,2) = GDens(IX,2) |
2212 | + GDT(IX) = GDens(IX,1) + GDens(IX,2) |
2213 | + end DO |
2214 | + ENDIF |
2215 | + GDM(1) = SQRT( GD(1,1)**2 + GD(2,1)**2 + GD(3,1)**2 ) |
2216 | + GDM(2) = SQRT( GD(1,2)**2 + GD(2,2)**2 + GD(3,2)**2 ) |
2217 | + GDMT = SQRT( GDT(1)**2 + GDT(2)**2 + GDT(3)**2 ) |
2218 | + GDMT = MAX( GDMIN, GDMT ) |
2219 | + |
2220 | + ! Find local correlation energy and potential |
2221 | + CALL PW92C( 2, D, ECUNIF, VCUNIF ) |
2222 | + |
2223 | + ! Find total correlation energy |
2224 | + RS = ( 3 / (4*PI*DT) )**THD |
2225 | + KF = (3 * PI**2 * DT)**THD |
2226 | + KS = SQRT( 4 * KF / PI ) |
2227 | + ZETA = ( D(1) - D(2) ) / DT |
2228 | + ZETA = MAX( -1.D0+DENMIN, ZETA ) |
2229 | + ZETA = MIN( 1.D0-DENMIN, ZETA ) |
2230 | + PHI = HALF * ( (1+ZETA)**TWOTHD + (1-ZETA)**TWOTHD ) |
2231 | + T = GDMT / (2 * PHI * KS * DT) |
2232 | + F1 = ECUNIF / GAMMA / PHI**3 |
2233 | + F2 = EXP(-F1) |
2234 | + A = BETA / GAMMA / (F2-1) |
2235 | + F3 = T**2 + A * T**4 |
2236 | + F4 = BETA/GAMMA * F3 / (1 + A*F3) |
2237 | + H = GAMMA * PHI**3 * LOG( 1 + F4 ) |
2238 | + FC = ECUNIF + H |
2239 | + |
2240 | + ! Find correlation energy derivatives |
2241 | + DRSDD = - (THD * RS / DT) |
2242 | + DKFDD = THD * KF / DT |
2243 | + DKSDD = HALF * KS * DKFDD / KF |
2244 | + DZDD(1) = 1 / DT - ZETA / DT |
2245 | + DZDD(2) = - (1 / DT) - ZETA / DT |
2246 | + DPDZ = HALF * TWOTHD * ( 1/(1+ZETA)**THD - 1/(1-ZETA)**THD ) |
2247 | + DO IS = 1,2 |
2248 | + DECUDD = ( VCUNIF(IS) - ECUNIF ) / DT |
2249 | + DPDD = DPDZ * DZDD(IS) |
2250 | + DTDD = (- T) * ( DPDD/PHI + DKSDD/KS + 1/DT ) |
2251 | + DF1DD = F1 * ( DECUDD/ECUNIF - 3*DPDD/PHI ) |
2252 | + DF2DD = (- F2) * DF1DD |
2253 | + DADD = (- A) * DF2DD / (F2-1) |
2254 | + DF3DD = (2*T + 4*A*T**3) * DTDD + DADD * T**4 |
2255 | + DF4DD = F4 * ( DF3DD/F3 - (DADD*F3+A*DF3DD)/(1+A*F3) ) |
2256 | + DHDD = 3 * H * DPDD / PHI |
2257 | + DHDD = DHDD + GAMMA * PHI**3 * DF4DD / (1+F4) |
2258 | + DFCDD(IS) = VCUNIF(IS) + H + DT * DHDD |
2259 | + |
2260 | + DO IX = 1,3 |
2261 | + DTDGD = (T / GDMT) * GDT(IX) / GDMT |
2262 | + DF3DGD = DTDGD * ( 2 * T + 4 * A * T**3 ) |
2263 | + DF4DGD = F4 * DF3DGD * ( 1/F3 - A/(1+A*F3) ) |
2264 | + DHDGD = GAMMA * PHI**3 * DF4DGD / (1+F4) |
2265 | + DFCDGD(IX,IS) = DT * DHDGD |
2266 | + end DO |
2267 | + end DO |
2268 | + |
2269 | + ! Find exchange energy and potential |
2270 | + FX = 0 |
2271 | + DO IS = 1,2 |
2272 | + DS(IS) = MAX( DENMIN, 2 * D(IS) ) |
2273 | + GDMS = MAX( GDMIN, 2 * GDM(IS) ) |
2274 | + KFS = (3 * PI**2 * DS(IS))**THD |
2275 | + S = GDMS / (2 * KFS * DS(IS)) |
2276 | + F1 = 1 + MU * S**2 / KAPPA |
2277 | + F = 1 + KAPPA - KAPPA / F1 |
2278 | + ! |
2279 | + ! Note nspin=1 in call to exchng... |
2280 | + ! |
2281 | + CALL EXCHNG( IREL, 1, DS(IS), EXUNIF, VXUNIF(IS) ) |
2282 | + FX = FX + DS(IS) * EXUNIF * F |
2283 | + |
2284 | + DKFDD = THD * KFS / DS(IS) |
2285 | + DSDD = S * ( -(DKFDD/KFS) - 1/DS(IS) ) |
2286 | + DF1DD = 2 * (F1-1) * DSDD / S |
2287 | + DFDD = KAPPA * DF1DD / F1**2 |
2288 | + DFXDD(IS) = VXUNIF(IS) * F + DS(IS) * EXUNIF * DFDD |
2289 | + |
2290 | + DO IX = 1,3 |
2291 | + GDS = 2 * GD(IX,IS) |
2292 | + DSDGD = (S / GDMS) * GDS / GDMS |
2293 | + DF1DGD = 2 * MU * S * DSDGD / KAPPA |
2294 | + DFDGD = KAPPA * DF1DGD / F1**2 |
2295 | + DFXDGD(IX,IS) = DS(IS) * EXUNIF * DFDGD |
2296 | + end DO |
2297 | + end DO |
2298 | + FX = HALF * FX / DT |
2299 | + |
2300 | + ! Set output arguments |
2301 | + EX = FX |
2302 | + EC = FC |
2303 | + DO IS = 1,nspin |
2304 | + DEXDD(IS) = DFXDD(IS) |
2305 | + DECDD(IS) = DFCDD(IS) |
2306 | + DO IX = 1,3 |
2307 | + DEXDGD(IX,IS) = DFXDGD(IX,IS) |
2308 | + DECDGD(IX,IS) = DFCDGD(IX,IS) |
2309 | + end DO |
2310 | + end DO |
2311 | + END SUBROUTINE PBEformXC |
2312 | + |
2313 | + |
2314 | + |
2315 | + SUBROUTINE PBEXC( IREL, nspin, Dens, GDens, & |
2316 | + EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
2317 | + |
2318 | + ! ********************************************************************* |
2319 | + ! Implements Perdew-Burke-Ernzerhof Generalized-Gradient-Approximation. |
2320 | + ! Ref: J.P.Perdew, K.Burke & M.Ernzerhof, PRL 77, 3865 (1996) |
2321 | + ! Modified to call PBEformXC by J.M.Soler. December 2009. |
2322 | + ! ******** INPUT ****************************************************** |
2323 | + ! INTEGER IREL : Relativistic-exchange switch (0=No, 1=Yes) |
2324 | + ! INTEGER nspin : Number of spin polarizations (1 or 2) |
2325 | + ! REAL*8 Dens(nspin) : Total electron density (if nspin=1) or |
2326 | + ! spin electron density (if nspin=2) |
2327 | + ! REAL*8 GDens(3,nspin) : Total or spin density gradient |
2328 | + ! ******** OUTPUT ***************************************************** |
2329 | + ! REAL*8 EX : Exchange energy density |
2330 | + ! REAL*8 EC : Correlation energy density |
2331 | + ! REAL*8 DEXDD(nspin) : Partial derivative |
2332 | + ! d(DensTot*Ex)/dDens(ispin), |
2333 | + ! where DensTot = Sum_ispin( Dens(ispin) ) |
2334 | + ! For a constant density, this is the |
2335 | + ! exchange potential |
2336 | + ! REAL*8 DECDD(nspin) : Partial derivative |
2337 | + ! d(DensTot*Ec)/dDens(ispin), |
2338 | + ! where DensTot = Sum_ispin( Dens(ispin) ) |
2339 | + ! For a constant density, this is the |
2340 | + ! correlation potential |
2341 | + ! REAL*8 DEXDGD(3,nspin): Partial derivative |
2342 | + ! d(DensTot*Ex)/d(GradDens(i,ispin)) |
2343 | + ! REAL*8 DECDGD(3,nspin): Partial derivative |
2344 | + ! d(DensTot*Ec)/d(GradDens(i,ispin)) |
2345 | + ! ********* UNITS **************************************************** |
2346 | + ! Lengths in Bohr |
2347 | + ! Densities in electrons per Bohr**3 |
2348 | + ! Energies in Hartrees |
2349 | + ! Gradient vectors in cartesian coordinates |
2350 | + ! ********* ROUTINES CALLED ****************************************** |
2351 | + ! EXCHNG, PW92C |
2352 | + ! ******************************************************************** |
2353 | + |
2354 | + ! Passed arguments |
2355 | + integer, intent(in) :: IREL, NSPIN |
2356 | + real(dp),intent(in) :: DENS(NSPIN), GDENS(3,NSPIN) |
2357 | + real(dp),intent(out):: EX, EC, DECDD(NSPIN), DECDGD(3,NSPIN), & |
2358 | + DEXDD(NSPIN), DEXDGD(3,NSPIN) |
2359 | + |
2360 | + ! Internal variables |
2361 | + real(dp):: BETA, KAPPA, MU, PI |
2362 | + |
2363 | + ! Fix values for PBE functional parameters |
2364 | + PI = 4 * ATAN(1._dp) |
2365 | + BETA = 0.066725_dp ! From grad. exp. for correl. rs->0 |
2366 | + MU = BETA * PI**2 / 3 ! From Jell. response for x+c |
2367 | + KAPPA = 0.804_dp ! From general Lieb-Oxford bound |
2368 | + |
2369 | + ! Call PBE routine with appropriate values for beta, mu, and kappa. |
2370 | + CALL PBEformXC( BETA, MU, KAPPA, IREL, nspin, Dens, GDens, & |
2371 | + EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
2372 | + |
2373 | + END SUBROUTINE PBEXC |
2374 | + |
2375 | + |
2376 | + |
2377 | + SUBROUTINE REVPBEXC( IREL, nspin, Dens, GDens,& |
2378 | + EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
2379 | + |
2380 | + ! ********************************************************************* |
2381 | + ! Implements revPBE: revised Perdew-Burke-Ernzerhof GGA. |
2382 | + ! Ref: Y. Zhang & W. Yang, Phys. Rev. Lett. 80, 890 (1998). |
2383 | + ! Same interface as PBEXC. |
2384 | + ! revPBE parameters introduced by E. Artacho in January 2006 |
2385 | + ! Modified to call PBEformXC by J.M.Soler. December 2009. |
2386 | + ! ******************************************************************** |
2387 | + |
2388 | + ! Passed arguments |
2389 | + integer, intent(in) :: IREL, NSPIN |
2390 | + real(dp),intent(in) :: DENS(NSPIN), GDENS(3,NSPIN) |
2391 | + real(dp),intent(out):: EX, EC, DECDD(NSPIN), DECDGD(3,NSPIN), & |
2392 | + DEXDD(NSPIN), DEXDGD(3,NSPIN) |
2393 | + |
2394 | + ! Internal variables |
2395 | + real(dp):: BETA, KAPPA, MU, PI |
2396 | + |
2397 | + ! Fix values for PBE functional parameters |
2398 | + PI = 4 * ATAN(1._dp) |
2399 | + BETA = 0.066725_dp ! From grad. exp. for correl. rs->0 |
2400 | + MU = BETA * PI**2 / 3 ! From Jell. response for x+c |
2401 | + KAPPA = 1.245_dp ! From fit of molecular energies |
2402 | + |
2403 | + ! Call PBE routine with appropriate values for beta, mu, and kappa. |
2404 | + CALL PBEformXC( BETA, MU, KAPPA, IREL, nspin, Dens, GDens, & |
2405 | + EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
2406 | + |
2407 | + END SUBROUTINE REVPBEXC |
2408 | + |
2409 | + |
2410 | + |
2411 | + SUBROUTINE PBESOLXC( IREL, NSPIN, DENS, GDENS, & |
2412 | + EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
2413 | + |
2414 | + ! ********************************************************************* |
2415 | + ! Implements Perdew-Burke-Ernzerhof Generalized-Gradient-Approximation. |
2416 | + ! with the revised parameters for solids (PBEsol). |
2417 | + ! Ref: J.P.Perdew et al, PRL 100, 136406 (2008) |
2418 | + ! Same interface as PBEXC. |
2419 | + ! Modified by J.D. Gale for PBEsol. May 2009. |
2420 | + ! Modified to call PBEformXC by J.M.Soler. December 2009. |
2421 | + ! ******************************************************************** |
2422 | + |
2423 | + ! Passed arguments |
2424 | + integer, intent(in) :: IREL, NSPIN |
2425 | + real(dp),intent(in) :: DENS(NSPIN), GDENS(3,NSPIN) |
2426 | + real(dp),intent(out):: EX, EC, DECDD(NSPIN), DECDGD(3,NSPIN), & |
2427 | + DEXDD(NSPIN), DEXDGD(3,NSPIN) |
2428 | + |
2429 | + ! Internal variables |
2430 | + real(dp):: BETA, KAPPA, MU, PI |
2431 | + |
2432 | + ! Fix values for PBE functional parameters |
2433 | + PI = 4 * ATAN(1._dp) |
2434 | + BETA = 0.046_dp ! From fit of Jell. surf. energies |
2435 | + MU = 10.0_dp / 81.0_dp ! From grad. exp. for exchange. |
2436 | + KAPPA = 0.804_dp ! From general Lieb-Oxford bound |
2437 | + |
2438 | + ! Call PBE routine with appropriate values for beta, mu, and kappa. |
2439 | + CALL PBEformXC( BETA, MU, KAPPA, IREL, nspin, Dens, GDens, & |
2440 | + EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
2441 | + |
2442 | + END SUBROUTINE PBESOLXC |
2443 | + |
2444 | + |
2445 | + |
2446 | + SUBROUTINE PBEJsJrLOxc( IREL, NSPIN, DENS, GDENS, & |
2447 | + EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
2448 | + |
2449 | + ! ********************************************************************* |
2450 | + ! Implements Perdew-Burke-Ernzerhof Generalized-Gradient-Approximation |
2451 | + ! functional form, with revised parameters of Capelle et al: |
2452 | + ! Js refers to Jellium surface energies, that fix parameter beta |
2453 | + ! Jr refers to Jellium response, that fixes parameter mu |
2454 | + ! LO refers to Lieb-Oxford bound, that fixes parameter kappa |
2455 | + ! Refs: L.S.Pedroza et al, PRB 79, 201106 (2009) |
2456 | + ! M.M.Odashima et al, J. Chem. Theory Comp. 5, 798 (2009) |
2457 | + ! Same interface as PBEXC. J.M.Soler. December 2009. |
2458 | + ! ******************************************************************** |
2459 | + |
2460 | + ! Passed arguments |
2461 | + integer, intent(in) :: IREL, NSPIN |
2462 | + real(dp),intent(in) :: DENS(NSPIN), GDENS(3,NSPIN) |
2463 | + real(dp),intent(out):: EX, EC, DECDD(NSPIN), DECDGD(3,NSPIN), & |
2464 | + DEXDD(NSPIN), DEXDGD(3,NSPIN) |
2465 | + |
2466 | + ! Internal variables |
2467 | + real(dp):: BETA, KAPPA, MU, PI |
2468 | + |
2469 | + ! Fix values for PBE functional parameters |
2470 | + PI = 4 * ATAN(1._dp) |
2471 | + BETA = 0.046_dp ! From fit of Jell. surf. energies |
2472 | + MU = BETA * PI**2 / 3 ! From Jell. response for x+c |
2473 | + KAPPA = 0.804_dp ! From general Lieb-Oxford bound |
2474 | + |
2475 | + ! Call PBE routine with appropriate values for beta, mu, and kappa. |
2476 | + CALL PBEformXC( BETA, MU, KAPPA, IREL, nspin, Dens, GDens, & |
2477 | + EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
2478 | + |
2479 | + END SUBROUTINE PBEJsJrLOxc |
2480 | + |
2481 | + |
2482 | + |
2483 | + SUBROUTINE PBEJsJrHEGxc( IREL, NSPIN, DENS, GDENS, & |
2484 | + EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
2485 | + |
2486 | + ! ********************************************************************* |
2487 | + ! Implements Perdew-Burke-Ernzerhof Generalized-Gradient-Approximation |
2488 | + ! functional form, with revised parameters of Capelle et al: |
2489 | + ! Js refers to Jellium surface energies, that fix parameter beta |
2490 | + ! Jr refers to Jellium response, that fixes parameter mu |
2491 | + ! HGE refers to the Lieb-Oxford bound for the low-density limit of |
2492 | + ! the homogeneous electron gas, that fixes parameter kappa |
2493 | + ! Refs: L.S.Pedroza et al, PRB 79, 201106 (2009) |
2494 | + ! M.M.Odashima et al, J. Chem. Theory Comp. 5, 798 (2009) |
2495 | + ! Same interface as PBEXC. J.M.Soler. December 2009. |
2496 | + ! ******************************************************************** |
2497 | + |
2498 | + ! Passed arguments |
2499 | + integer, intent(in) :: IREL, NSPIN |
2500 | + real(dp),intent(in) :: DENS(NSPIN), GDENS(3,NSPIN) |
2501 | + real(dp),intent(out):: EX, EC, DECDD(NSPIN), DECDGD(3,NSPIN), & |
2502 | + DEXDD(NSPIN), DEXDGD(3,NSPIN) |
2503 | + |
2504 | + ! Internal variables |
2505 | + real(dp):: BETA, KAPPA, MU, PI |
2506 | + |
2507 | + ! Fix values for PBE functional parameters |
2508 | + PI = 4 * ATAN(1._dp) |
2509 | + BETA = 0.046_dp ! From fit of Jell. surf. energies |
2510 | + MU = BETA * PI**2 / 3 ! From Jell. response for x+c |
2511 | + KAPPA = 0.552_dp ! From Lieb-Oxford bound for HEG |
2512 | + |
2513 | + ! Call PBE routine with appropriate values for beta, mu, and kappa. |
2514 | + CALL PBEformXC( BETA, MU, KAPPA, IREL, nspin, Dens, GDens, & |
2515 | + EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
2516 | + |
2517 | + END SUBROUTINE PBEJsJrHEGxc |
2518 | + |
2519 | + |
2520 | + |
2521 | + SUBROUTINE PBEGcGxLOxc( IREL, NSPIN, DENS, GDENS, & |
2522 | + EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
2523 | + |
2524 | + ! ********************************************************************* |
2525 | + ! Implements Perdew-Burke-Ernzerhof Generalized-Gradient-Approximation |
2526 | + ! functional form, with revised parameters of Capelle et al: |
2527 | + ! Gc refers to gradient exp. for correl., that fixes parameter beta |
2528 | + ! Gx refers to grad. expansion for exchange, that fixes parameter mu |
2529 | + ! LO refers to Lieb-Oxford bound, that fixes parameter kappa |
2530 | + ! Refs: L.S.Pedroza et al, PRB 79, 201106 (2009) |
2531 | + ! M.M.Odashima et al, J. Chem. Theory Comp. 5, 798 (2009) |
2532 | + ! Same interface as PBEXC. J.M.Soler. December 2009. |
2533 | + ! ******************************************************************** |
2534 | + |
2535 | + ! Passed arguments |
2536 | + integer, intent(in) :: IREL, NSPIN |
2537 | + real(dp),intent(in) :: DENS(NSPIN), GDENS(3,NSPIN) |
2538 | + real(dp),intent(out):: EX, EC, DECDD(NSPIN), DECDGD(3,NSPIN), & |
2539 | + DEXDD(NSPIN), DEXDGD(3,NSPIN) |
2540 | + |
2541 | + ! Internal variables |
2542 | + real(dp):: BETA, KAPPA, MU, PI |
2543 | + |
2544 | + ! Fix values for PBE functional parameters |
2545 | + PI = 4 * ATAN(1._dp) |
2546 | + BETA = 0.066725_dp ! From grad. exp. for correl. rs->0 |
2547 | + MU = 10._dp / 81._dp ! From grad. exp. for exchange. |
2548 | + KAPPA = 0.804_dp ! From general Lieb-Oxford bound |
2549 | + |
2550 | + ! Call PBE routine with appropriate values for beta, mu, and kappa. |
2551 | + CALL PBEformXC( BETA, MU, KAPPA, IREL, nspin, Dens, GDens, & |
2552 | + EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
2553 | + |
2554 | + END SUBROUTINE PBEGcGxLOxc |
2555 | + |
2556 | + |
2557 | + |
2558 | + SUBROUTINE PBEGcGxHEGxc( IREL, NSPIN, DENS, GDENS, & |
2559 | + EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
2560 | + |
2561 | + ! ********************************************************************* |
2562 | + ! Implements Perdew-Burke-Ernzerhof Generalized-Gradient-Approximation |
2563 | + ! functional form, with revised parameters of Capelle et al: |
2564 | + ! Gc refers to gradient exp. for correl., that fixes parameter beta |
2565 | + ! Gx refers to grad. expansion for exchange, that fixes parameter mu |
2566 | + ! HGE refers to the Lieb-Oxford bound for the low-density limit of |
2567 | + ! the homogeneous electron gas, that fixes parameter kappa |
2568 | + ! Refs: L.S.Pedroza et al, PRB 79, 201106 (2009) |
2569 | + ! M.M.Odashima et al, J. Chem. Theory Comp. 5, 798 (2009) |
2570 | + ! Same interface as PBEXC. J.M.Soler. December 2009. |
2571 | + ! ******************************************************************** |
2572 | + |
2573 | + ! Passed arguments |
2574 | + integer, intent(in) :: IREL, NSPIN |
2575 | + real(dp),intent(in) :: DENS(NSPIN), GDENS(3,NSPIN) |
2576 | + real(dp),intent(out):: EX, EC, DECDD(NSPIN), DECDGD(3,NSPIN), & |
2577 | + DEXDD(NSPIN), DEXDGD(3,NSPIN) |
2578 | + |
2579 | + ! Internal variables |
2580 | + real(dp):: BETA, KAPPA, MU, PI |
2581 | + |
2582 | + ! Fix values for PBE functional parameters |
2583 | + PI = 4 * ATAN(1._dp) |
2584 | + BETA = 0.066725_dp ! From grad. exp. for correl. rs->0 |
2585 | + MU = 10._dp / 81._dp ! From grad. exp. for exchange. |
2586 | + KAPPA = 0.552_dp ! From Lieb-Oxford bound for HEG |
2587 | + |
2588 | + ! Call PBE routine with appropriate values for beta, mu, and kappa. |
2589 | + CALL PBEformXC( BETA, MU, KAPPA, IREL, nspin, Dens, GDens, & |
2590 | + EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
2591 | + |
2592 | + END SUBROUTINE PBEGcGxHEGxc |
2593 | + |
2594 | + |
2595 | + |
2596 | + SUBROUTINE PW91XC( IREL, nspin, Dens, GDens, & |
2597 | + EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
2598 | + |
2599 | + ! ********************************************************************* |
2600 | + ! Implements Perdew-Wang91 Generalized-Gradient-Approximation. |
2601 | + ! Ref: JCP 100, 1290 (1994) |
2602 | + ! Written by J.L. Martins August 2000 |
2603 | + ! ******** INPUT ****************************************************** |
2604 | + ! INTEGER IREL : Relativistic-exchange switch (0=No, 1=Yes) |
2605 | + ! INTEGER nspin : Number of spin polarizations (1 or 2) |
2606 | + ! REAL*8 Dens(nspin) : Total electron density (if nspin=1) or |
2607 | + ! spin electron density (if nspin=2) |
2608 | + ! REAL*8 GDens(3,nspin) : Total or spin density gradient |
2609 | + ! ******** OUTPUT ***************************************************** |
2610 | + ! REAL*8 EX : Exchange energy density |
2611 | + ! REAL*8 EC : Correlation energy density |
2612 | + ! REAL*8 DEXDD(nspin) : Partial derivative |
2613 | + ! d(DensTot*Ex)/dDens(ispin), |
2614 | + ! where DensTot = Sum_ispin( Dens(ispin) ) |
2615 | + ! For a constant density, this is the |
2616 | + ! exchange potential |
2617 | + ! REAL*8 DECDD(nspin) : Partial derivative |
2618 | + ! d(DensTot*Ec)/dDens(ispin), |
2619 | + ! where DensTot = Sum_ispin( Dens(ispin) ) |
2620 | + ! For a constant density, this is the |
2621 | + ! correlation potential |
2622 | + ! REAL*8 DEXDGD(3,nspin): Partial derivative |
2623 | + ! d(DensTot*Ex)/d(GradDens(i,ispin)) |
2624 | + ! REAL*8 DECDGD(3,nspin): Partial derivative |
2625 | + ! d(DensTot*Ec)/d(GradDens(i,ispin)) |
2626 | + ! ********* UNITS **************************************************** |
2627 | + ! Lengths in Bohr |
2628 | + ! Densities in electrons per Bohr**3 |
2629 | + ! Energies in Hartrees |
2630 | + ! Gradient vectors in cartesian coordinates |
2631 | + ! ********* ROUTINES CALLED ****************************************** |
2632 | + ! EXCHNG, PW92C |
2633 | + ! ******************************************************************** |
2634 | + |
2635 | + INTEGER IREL, nspin |
2636 | + real(dp) Dens(nspin), DECDD(nspin), DECDGD(3,nspin), & |
2637 | + DEXDD(nspin), DEXDGD(3,nspin), GDens(3,nspin) |
2638 | + |
2639 | + ! Internal variables |
2640 | + INTEGER :: IS, IX |
2641 | + real(dp) & |
2642 | + A, BETA, D(2), DADD, DECUDD, DENMIN, & |
2643 | + DF1DD, DF2DD, DF3DD, DF4DD, DF1DGD, DF3DGD, DF4DGD, & |
2644 | + DFCDD(2), DFCDGD(3,2), DFDD, DFDGD, DFXDD(2), DFXDGD(3,2), & |
2645 | + DHDD, DHDGD, DKFDD, DKSDD, DPDD, DPDZ, DRSDD, & |
2646 | + DS(2), DSDD, DSDGD, DT, DTDD, DTDGD, DZDD(2), & |
2647 | + EC, ECUNIF, EX, EXUNIF, & |
2648 | + F, F1, F2, F3, F4, FC, FX, FOUTHD, & |
2649 | + GAMMA, GD(3,2), GDM(2), GDMIN, GDMS, GDMT, GDS, GDT(3), & |
2650 | + H, HALF, KF, KFS, KS, PHI, PI, RS, S, & |
2651 | + T, THD, THRHLF, TWO, TWOTHD, VCUNIF(2), VXUNIF(2), ZETA |
2652 | + |
2653 | + real(dp) F5, F6, F7, F8, ASINHS |
2654 | + real(dp) DF5DD,DF6DD,DF7DD,DF8DD |
2655 | + real(dp) DF1DS, DF2DS, DF3DS, DFDS, DF7DGD |
2656 | + |
2657 | + ! Lower bounds of density and its gradient to avoid divisions by zero |
2658 | + PARAMETER ( DENMIN = 1.D-12 ) |
2659 | + PARAMETER ( GDMIN = 1.D-12 ) |
2660 | + |
2661 | + ! Fix some numerical parameters |
2662 | + PARAMETER ( FOUTHD=4.D0/3.D0, HALF=0.5D0, & |
2663 | + THD=1.D0/3.D0, THRHLF=1.5D0, & |
2664 | + TWO=2.D0, TWOTHD=2.D0/3.D0 ) |
2665 | + |
2666 | + ! Fix some more numerical constants |
2667 | + PI = 4.0_dp * ATAN(1.0_dp) |
2668 | + BETA = 15.75592_dp * 0.004235_dp |
2669 | + GAMMA = BETA**2 / (2.0_dp * 0.09_dp) |
2670 | + |
2671 | + ! Translate density and its gradient to new variables |
2672 | + IF (nspin .EQ. 1) THEN |
2673 | + D(1) = HALF * Dens(1) |
2674 | + D(2) = D(1) |
2675 | + DT = MAX( DENMIN, Dens(1) ) |
2676 | + DO IX = 1,3 |
2677 | + GD(IX,1) = HALF * GDens(IX,1) |
2678 | + GD(IX,2) = GD(IX,1) |
2679 | + GDT(IX) = GDens(IX,1) |
2680 | + end DO |
2681 | + ELSE |
2682 | + D(1) = Dens(1) |
2683 | + D(2) = Dens(2) |
2684 | + DT = MAX( DENMIN, Dens(1)+Dens(2) ) |
2685 | + DO IX = 1,3 |
2686 | + GD(IX,1) = GDens(IX,1) |
2687 | + GD(IX,2) = GDens(IX,2) |
2688 | + GDT(IX) = GDens(IX,1) + GDens(IX,2) |
2689 | + end DO |
2690 | + ENDIF |
2691 | + GDM(1) = SQRT( GD(1,1)**2 + GD(2,1)**2 + GD(3,1)**2 ) |
2692 | + GDM(2) = SQRT( GD(1,2)**2 + GD(2,2)**2 + GD(3,2)**2 ) |
2693 | + GDMT = SQRT( GDT(1)**2 + GDT(2)**2 + GDT(3)**2 ) |
2694 | + GDMT = MAX( GDMIN, GDMT ) |
2695 | + |
2696 | + ! Find local correlation energy and potential |
2697 | + CALL PW92C( 2, D, ECUNIF, VCUNIF ) |
2698 | + |
2699 | + ! Find total correlation energy |
2700 | + RS = ( 3 / (4*PI*DT) )**THD |
2701 | + KF = (3 * PI**2 * DT)**THD |
2702 | + KS = SQRT( 4 * KF / PI ) |
2703 | + S = GDMT / (2 * KF * DT) |
2704 | + T = GDMT / (2 * KS * DT) |
2705 | + ZETA = ( D(1) - D(2) ) / DT |
2706 | + ZETA = MAX( -1.D0+DENMIN, ZETA ) |
2707 | + ZETA = MIN( 1.D0-DENMIN, ZETA ) |
2708 | + PHI = HALF * ( (1+ZETA)**TWOTHD + (1-ZETA)**TWOTHD ) |
2709 | + F1 = ECUNIF / GAMMA / PHI**3 |
2710 | + F2 = EXP(-F1) |
2711 | + A = BETA / GAMMA / (F2-1) |
2712 | + F3 = T**2 + A * T**4 |
2713 | + F4 = BETA/GAMMA * F3 / (1 + A*F3) |
2714 | + F5 = 0.002568D0 + 0.023266D0*RS + 7.389D-6*RS**2 |
2715 | + F6 = 1.0D0 + 8.723D0*RS + 0.472D0*RS**2 + 0.07389D0*RS**3 |
2716 | + F7 = EXP(-100.0D0 * S**2 * PHI**4) |
2717 | + F8 = 15.75592D0*(0.001667212D0 + F5/F6 -0.004235D0 + & |
2718 | + 3.0D0*0.001667212D0/7.0D0) |
2719 | + H = GAMMA * PHI**3 * LOG( 1 + F4 ) + F8 * T**2 * F7 |
2720 | + FC = ECUNIF + H |
2721 | + |
2722 | + ! Find correlation energy derivatives |
2723 | + DRSDD = - THD * RS / DT |
2724 | + DKFDD = THD * KF / DT |
2725 | + DKSDD = HALF * KS * DKFDD / KF |
2726 | + DZDD(1) = 1 / DT - ZETA / DT |
2727 | + DZDD(2) = - 1 / DT - ZETA / DT |
2728 | + DPDZ = HALF * TWOTHD * ( 1/(1+ZETA)**THD - 1/(1-ZETA)**THD ) |
2729 | + DO IS = 1,2 |
2730 | + DECUDD = ( VCUNIF(IS) - ECUNIF ) / DT |
2731 | + DPDD = DPDZ * DZDD(IS) |
2732 | + DSDD = -S*DKFDD/KF - S/DT ! JMS: corrected, May.2014 |
2733 | + DTDD = -T*DKSDD/KS - T/DT |
2734 | + DF1DD = F1 * ( DECUDD/ECUNIF - 3*DPDD/PHI ) |
2735 | + DF2DD = - F2 * DF1DD |
2736 | + DADD = - A * DF2DD / (F2-1) |
2737 | + DF3DD = (2*T + 4*A*T**3) * DTDD + DADD * T**4 |
2738 | + DF4DD = F4 * ( DF3DD/F3 - (DADD*F3+A*DF3DD)/(1+A*F3) ) |
2739 | + DF5DD = (0.023266D0 + 2.0D0*7.389D-6*RS)*DRSDD |
2740 | + DF6DD = (8.723D0 + 2.0D0*0.472D0*RS & |
2741 | + + 3.0D0*0.07389D0*RS**2)*DRSDD |
2742 | + DF7DD = -200.0D0 * S * PHI**4 * DSDD * F7 & |
2743 | + -100.0D0 * S**2 * 4.0D0* PHI**3 * DPDD * F7 |
2744 | + DF8DD = 15.75592D0 * DF5DD/F6 - 15.75592D0*F5*DF6DD / F6**2 |
2745 | + DHDD = 3 * H * DPDD / PHI |
2746 | + DHDD = DHDD + GAMMA * PHI**3 * DF4DD / (1+F4) |
2747 | + DHDD = DHDD + DF8DD * T**2 * F7 |
2748 | + DHDD = DHDD + F8 * 2*T*DTDD *F7 |
2749 | + DHDD = DHDD + F8 * T**2 * DF7DD |
2750 | + |
2751 | + DFCDD(IS) = VCUNIF(IS) + H + DT * DHDD |
2752 | + DO IX = 1,3 |
2753 | + DTDGD = (T / GDMT) * GDT(IX) / GDMT |
2754 | + DSDGD = (S / GDMT) * GDT(IX) / GDMT |
2755 | + DF3DGD = DTDGD * ( 2 * T + 4 * A * T**3 ) |
2756 | + DF4DGD = F4 * DF3DGD * ( 1/F3 - A/(1+A*F3) ) |
2757 | + DF7DGD = -200.0D0 * S * PHI**4 * DSDGD * F7 |
2758 | + DHDGD = GAMMA * PHI**3 * DF4DGD / (1+F4) |
2759 | + DHDGD = DHDGD + F8 * 2*T*DTDGD *F7 + F8 * T**2 *DF7DGD |
2760 | + DFCDGD(IX,IS) = DT * DHDGD |
2761 | + end DO |
2762 | + end DO |
2763 | + |
2764 | + ! Find exchange energy and potential |
2765 | + FX = 0 |
2766 | + DO IS = 1,2 |
2767 | + DS(1) = MAX( DENMIN, 2 * D(IS) ) |
2768 | + GDMS = MAX( GDMIN, 2 * GDM(IS) ) |
2769 | + KFS = (3 * PI**2 * DS(1))**THD |
2770 | + S = GDMS / (2 * KFS * DS(1)) |
2771 | + F4 = SQRT(1.0D0 + (7.7956D0*S)**2) |
2772 | + ASINHS = LOG(7.7956D0*S + F4) |
2773 | + F1 = 1.0D0 + 0.19645D0 * S * ASINHS |
2774 | + F2 = 0.2743D0 - 0.15084D0*EXP(-100.0D0*S*S) |
2775 | + F3 = 1.0D0 / (F1 + 0.004D0 * S*S*S*S) |
2776 | + F = (F1 + F2 * S*S ) * F3 |
2777 | + CALL EXCHNG( IREL, 1, DS, EXUNIF, VXUNIF ) |
2778 | + FX = FX + DS(1) * EXUNIF * F |
2779 | + |
2780 | + DKFDD = THD * KFS / DS(1) |
2781 | + DSDD = S * ( -DKFDD/KFS - 1/DS(1) ) |
2782 | + DF1DS = 0.19645D0 * ASINHS + & |
2783 | + 0.19645D0 * S * 7.7956D0 / F4 |
2784 | + DF2DS = 0.15084D0*200.0D0*S*EXP(-100.0D0*S*S) |
2785 | + DF3DS = - F3*F3 * (DF1DS + 4.0D0*0.004D0 * S*S*S) |
2786 | + DFDS = DF1DS * F3 + DF2DS * S*S * F3 + 2.0D0 * S * F2 * F3 & |
2787 | + + (F1 + F2 * S*S ) * DF3DS |
2788 | + DFXDD(IS) = VXUNIF(1) * F + DS(1) * EXUNIF * DFDS * DSDD |
2789 | + |
2790 | + DO IX = 1,3 |
2791 | + GDS = 2 * GD(IX,IS) |
2792 | + DSDGD = (S / GDMS) * GDS / GDMS |
2793 | + DFDGD = DFDS * DSDGD |
2794 | + DFXDGD(IX,IS) = DS(1) * EXUNIF * DFDGD |
2795 | + end DO |
2796 | + end DO |
2797 | + FX = HALF * FX / DT |
2798 | + |
2799 | + ! Set output arguments |
2800 | + EX = FX |
2801 | + EC = FC |
2802 | + DO IS = 1,nspin |
2803 | + DEXDD(IS) = DFXDD(IS) |
2804 | + DECDD(IS) = DFCDD(IS) |
2805 | + DO IX = 1,3 |
2806 | + DEXDGD(IX,IS) = DFXDGD(IX,IS) |
2807 | + DECDGD(IX,IS) = DFCDGD(IX,IS) |
2808 | + end DO |
2809 | + end DO |
2810 | + |
2811 | + END SUBROUTINE PW91XC |
2812 | + |
2813 | + |
2814 | + |
2815 | + subroutine blypxc(nspin,dens,gdens,EX,EC, & |
2816 | + dEXdd,dECdd,dEXdgd,dECdgd) |
2817 | + ! *************************************************************** |
2818 | + ! Implements Becke gradient exchange functional (A.D. |
2819 | + ! Becke, Phys. Rev. A 38, 3098 (1988)) and Lee, Yang, Parr |
2820 | + ! correlation functional (C. Lee, W. Yang, R.G. Parr, Phys. Rev. B |
2821 | + ! 37, 785 (1988)), as modificated by Miehlich,Savin,Stoll and Preuss, |
2822 | + ! Chem. Phys. Lett. 157,200 (1989). See also Johnson, Gill and Pople, |
2823 | + ! J. Chem. Phys. 98, 5612 (1993). Some errors were detected in this |
2824 | + ! last paper, so not all of the expressions correspond exactly to those |
2825 | + ! implemented here. |
2826 | + ! Written by Maider Machado. July 1998. |
2827 | + ! **************** INPUT ******************************************** |
2828 | + ! integer nspin : Number of spin polarizations (1 or 2) |
2829 | + ! real*8 dens(nspin) : Total electron density (if nspin=1) or |
2830 | + ! spin electron density (if nspin=2) |
2831 | + ! real*8 gdens(3,nspin) : Total or spin density gradient |
2832 | + ! ******** OUTPUT ***************************************************** |
2833 | + ! real*8 ex : Exchange energy density |
2834 | + ! real*8 ec : Correlation energy density |
2835 | + ! real*8 dexdd(nspin) : Partial derivative |
2836 | + ! d(DensTot*Ex)/dDens(ispin), |
2837 | + ! where DensTot = Sum_ispin( Dens(ispin) ) |
2838 | + ! For a constant density, this is the |
2839 | + ! exchange potential |
2840 | + ! real*8 decdd(nspin) : Partial derivative |
2841 | + ! d(DensTot*Ec)/dDens(ispin), |
2842 | + ! where DensTot = Sum_ispin( Dens(ispin) ) |
2843 | + ! For a constant density, this is the |
2844 | + ! correlation potential |
2845 | + ! real*8 dexdgd(3,nspin): Partial derivative |
2846 | + ! d(DensTot*Ex)/d(GradDens(i,ispin)) |
2847 | + ! real*8 decdgd(3,nspin): Partial derivative |
2848 | + ! d(DensTot*Ec)/d(GradDens(i,ispin)) |
2849 | + ! ********* UNITS **************************************************** |
2850 | + ! Lengths in Bohr |
2851 | + ! Densities in electrons per Bohr**3 |
2852 | + ! Energies in Hartrees |
2853 | + ! Gradient vectors in cartesian coordinates |
2854 | + ! ******************************************************************** |
2855 | + |
2856 | + integer nspin |
2857 | + real(dp) dens(nspin), gdens(3,nspin), EX, EC, & |
2858 | + dEXdd(nspin), dECdd(nspin), dEXdgd(3,nspin), & |
2859 | + dECdgd(3,nspin) |
2860 | + |
2861 | + ! Internal variables |
2862 | + integer is,ix |
2863 | + real(dp) pi, beta, thd, tthd, thrhlf, half, fothd, & |
2864 | + d(2),gd(3,2),dmin, ash,gdm(2),denmin,dt, & |
2865 | + g(2),x(2),a,b,c,dd,onzthd,gdmin, & |
2866 | + ga, gb, gc,becke,dbecgd(3,2), & |
2867 | + dgdx(2), dgdxa, dgdxb, dgdxc,dgdxd,dbecdd(2), & |
2868 | + den,omega, domega, delta, ddelta,cf, & |
2869 | + gam11, gam12, gam22, LYPa, LYPb1, & |
2870 | + LYPb2,dLYP11,dLYP12,dLYP22,LYP, & |
2871 | + dd1g11,dd1g12,dd1g22,dd2g12,dd2g11,dd2g22, & |
2872 | + dLYPdd(2),dg11dd(3,2),dg22dd(3,2), & |
2873 | + dg12dd(3,2),dLYPgd(3,2) |
2874 | + |
2875 | + ! Lower bounds of density and its gradient to avoid divisions by zero |
2876 | + parameter ( denmin=1.0e-8_dp ) |
2877 | + parameter ( gdmin=1.0e-8_dp ) |
2878 | + parameter ( dmin=1.0e-5_dp ) |
2879 | + |
2880 | + ! Fix some numerical parameters |
2881 | + parameter ( thd = 1.d0/3.d0, tthd=2.d0/3.d0 ) |
2882 | + parameter ( thrhlf=1.5d0, half=0.5d0, & |
2883 | + fothd=4.d0/3.d0, onzthd=11.d0/3.d0) |
2884 | + |
2885 | + ! Empirical parameter for Becke exchange functional (a.u.) |
2886 | + parameter(beta= 0.0042d0) |
2887 | + |
2888 | + ! Constants for LYP functional (a.u.) |
2889 | + parameter(a=0.04918d0, b=0.132d0, c=0.2533d0, dd=0.349d0) |
2890 | + |
2891 | + pi= 4*atan(1.d0) |
2892 | + |
2893 | + ! Translate density and its gradient to new variables |
2894 | + if (nspin .eq. 1) then |
2895 | + d(1) = half * dens(1) |
2896 | + d(1) = max(denmin,d(1)) |
2897 | + d(2) = d(1) |
2898 | + dt = max( denmin, dens(1) ) |
2899 | + do ix = 1,3 |
2900 | + gd(ix,1) = half * gdens(ix,1) |
2901 | + gd(ix,2) = gd(ix,1) |
2902 | + enddo |
2903 | + else |
2904 | + d(1) = dens(1) |
2905 | + d(2) = dens(2) |
2906 | do is=1,2 |
2907 | + d(is) = max (denmin,d(is)) |
2908 | + enddo |
2909 | + dt = max( denmin, dens(1)+dens(2) ) |
2910 | + do ix = 1,3 |
2911 | + gd(ix,1) = gdens(ix,1) |
2912 | + gd(ix,2) = gdens(ix,2) |
2913 | + enddo |
2914 | + endif |
2915 | + |
2916 | + gdm(1) = sqrt( gd(1,1)**2 + gd(2,1)**2 + gd(3,1)**2 ) |
2917 | + gdm(2) = sqrt( gd(1,2)**2 + gd(2,2)**2 + gd(3,2)**2 ) |
2918 | + |
2919 | + do is=1,2 |
2920 | gdm(is)= max(gdm(is),gdmin) |
2921 | - enddo |
2922 | + enddo |
2923 | |
2924 | -c Find Becke exchange energy |
2925 | - ga = -thrhlf*(3.d0/4.d0/pi)**thd |
2926 | - do is=1,2 |
2927 | - if(d(is).lt.dmin) then |
2928 | + ! Find Becke exchange energy |
2929 | + ga = -thrhlf*(3.d0/4.d0/pi)**thd |
2930 | + do is=1,2 |
2931 | + if(d(is).lt.dmin) then |
2932 | g(is)=ga |
2933 | - else |
2934 | + else |
2935 | x(is) = gdm(is)/d(is)**fothd |
2936 | gb = beta*x(is)**2 |
2937 | ash=log(x(is)+sqrt(x(is)**2+1)) |
2938 | gc = 1+6*beta*x(is)*ash |
2939 | g(is) = ga-gb/gc |
2940 | - endif |
2941 | - enddo |
2942 | - |
2943 | -c Density of energy |
2944 | - becke=(g(1)*d(1)**fothd+g(2)*d(2)**fothd)/dt |
2945 | - |
2946 | -c Exchange energy derivatives |
2947 | - do is=1,2 |
2948 | - if(d(is).lt.dmin)then |
2949 | - dbecdd(is)=0. |
2950 | - do ix=1,3 |
2951 | + endif |
2952 | + enddo |
2953 | + |
2954 | + ! Density of energy |
2955 | + becke=(g(1)*d(1)**fothd+g(2)*d(2)**fothd)/dt |
2956 | + |
2957 | + ! Exchange energy derivatives |
2958 | + do is=1,2 |
2959 | + if(d(is).lt.dmin)then |
2960 | + dbecdd(is)=0. |
2961 | + do ix=1,3 |
2962 | dbecgd(ix,is)=0. |
2963 | - enddo |
2964 | - else |
2965 | + enddo |
2966 | + else |
2967 | dgdxa=6*beta**2*x(is)**2 |
2968 | ash=log(x(is)+sqrt(x(is)**2+1)) |
2969 | dgdxb=x(is)/sqrt(x(is)**2+1)-ash |
2970 | @@ -1328,1513 +1298,1484 @@ |
2971 | dgdx(is)=(dgdxa*dgdxb+dgdxc)/dgdxd |
2972 | dbecdd(is)=fothd*d(is)**thd*(g(is)-x(is)*dgdx(is)) |
2973 | do ix=1,3 |
2974 | - dbecgd(ix,is)=d(is)**(-fothd)*dgdx(is)*gd(ix,is)/x(is) |
2975 | - enddo |
2976 | - endif |
2977 | - enddo |
2978 | - |
2979 | -c Lee-Yang-Parr correlation energy |
2980 | - den=1+dd*dt**(-thd) |
2981 | - omega=dt**(-onzthd)*exp(-c*dt**(-thd))/den |
2982 | - delta=c*dt**(-thd)+dd*dt**(-thd)/den |
2983 | - cf=3.*(3*pi**2)**tthd/10. |
2984 | - gam11=gdm(1)**2 |
2985 | - gam12=gd(1,1)*gd(1,2)+gd(2,1)*gd(2,2)+gd(3,1)*gd(3,2) |
2986 | - gam22=gdm(2)**2 |
2987 | - LYPa=-4*a*d(1)*d(2)/(den*dt) |
2988 | - LYPb1=2**onzthd*cf*a*b*omega*d(1)*d(2) |
2989 | - LYPb2=d(1)**(8./3.)+d(2)**(8./3.) |
2990 | - dLYP11=-a*b*omega*(d(1)*d(2)/9.*(1.-3.*delta-(delta-11.) |
2991 | - .*d(1)/dt)-d(2)**2) |
2992 | - dLYP12=-a*b*omega*(d(1)*d(2)/9.*(47.-7.*delta) |
2993 | - .-fothd*dt**2) |
2994 | - dLYP22=-a*b*omega*(d(1)*d(2)/9.*(1.-3.*delta-(delta-11.)* |
2995 | - .d(2)/dt)-d(1)**2) |
2996 | - |
2997 | -c Density of energy |
2998 | - LYP=(LYPa-LYPb1*LYPb2+dLYP11*gam11+dLYP12*gam12 |
2999 | - .+dLYP22*gam22)/dt |
3000 | - |
3001 | -c Correlation energy derivatives |
3002 | - domega=-thd*dt**(-fothd)*omega*(11.*dt**thd-c-dd/den) |
3003 | - ddelta=thd*(dd**2*dt**(-5./3.)/den**2-delta/dt) |
3004 | - |
3005 | -c Second derivatives with respect to the density |
3006 | - dd1g11=domega/omega*dLYP11-a*b*omega*(d(2)/9.* |
3007 | - . (1.-3.*delta-2*(delta-11.)*d(1)/dt)-d(1)*d(2)/9.* |
3008 | - . ((3.+d(1)/dt)*ddelta-(delta-11.)*d(1)/dt**2)) |
3009 | - |
3010 | - dd1g12=domega/omega*dLYP12-a*b*omega*(d(2)/9.* |
3011 | - . (47.-7.*delta)-7./9.*d(1)*d(2)*ddelta-8./3.*dt) |
3012 | - |
3013 | - dd1g22=domega/omega*dLYP22-a*b*omega*(1./9.*d(2) |
3014 | - . *(1.-3.*delta-(delta-11.)*d(2)/dt)-d(1)*d(2)/9.* |
3015 | - . ((3.+d(2)/dt)*ddelta-(delta-11.)*d(2)/dt**2)-2*d(1)) |
3016 | - |
3017 | - dd2g22=domega/omega*dLYP22-a*b*omega*(d(1)/9.* |
3018 | - . (1.-3.*delta-2*(delta-11.)*d(2)/dt)-d(1)*d(2)/9.* |
3019 | - . ((3+d(2)/dt)*ddelta-(delta-11.)*d(2)/dt**2)) |
3020 | - |
3021 | - dd2g12=domega/omega*dLYP12-a*b*omega*(d(1)/9.* |
3022 | - . (47.-7.*delta)-7./9.*d(1)*d(2)*ddelta-8./3.*dt) |
3023 | - |
3024 | - dd2g11=domega/omega*dLYP11-a*b*omega*(1./9.*d(1) |
3025 | - . *(1.-3.*delta-(delta-11.)*d(1)/dt)-d(1)*d(2)/9.* |
3026 | - . ((3.+d(1)/dt)*ddelta-(delta-11.)*d(1)/dt**2)-2*d(2)) |
3027 | - |
3028 | - dLYPdd(1)=-4*a/den*d(1)*d(2)/dt* |
3029 | - . (thd*dd*dt**(-fothd)/den |
3030 | - . +1./d(1)-1./dt)-2**onzthd*cf*a*b*(domega*d(1)*d(2)* |
3031 | - . (d(1)**(8./3.)+d(2)**(8./3.))+omega*d(2)*(onzthd* |
3032 | - . d(1)**(8./3.)+d(2)**(8./3.)))+dd1g11*gam11+ |
3033 | - . dd1g12*gam12+dd1g22*gam22 |
3034 | - |
3035 | - dLYPdd(2)=-4*a/den*d(1)*d(2)/dt*(thd*dd*dt**(-fothd)/den |
3036 | - . +1./d(2)-1./dt)-2**onzthd*cf*a*b*(domega*d(1)*d(2)* |
3037 | - . (d(1)**(8./3.)+d(2)**(8./3.))+omega*d(1)*(onzthd* |
3038 | - . d(2)**(8./3.)+d(1)**(8./3.)))+dd2g22*gam22+ |
3039 | - . dd2g12*gam12+dd2g11*gam11 |
3040 | - |
3041 | -c second derivatives with respect to the density gradient |
3042 | - do is=1,2 |
3043 | - do ix=1,3 |
3044 | - dg11dd(ix,is)=2*gd(ix,is) |
3045 | - dg22dd(ix,is)=2*gd(ix,is) |
3046 | - enddo |
3047 | - enddo |
3048 | - do ix=1,3 |
3049 | - dLYPgd(ix,1)=dLYP11*dg11dd(ix,1)+dLYP12*gd(ix,2) |
3050 | - dLYPgd(ix,2)=dLYP22*dg22dd(ix,2)+dLYP12*gd(ix,1) |
3051 | - enddo |
3052 | - |
3053 | - EX=becke |
3054 | - EC=LYP |
3055 | - do is=1,nspin |
3056 | - dEXdd(is)=dbecdd(is) |
3057 | - dECdd(is)=dLYPdd(is) |
3058 | - do ix=1,3 |
3059 | - dEXdgd(ix,is)=dbecgd(ix,is) |
3060 | - dECdgd(ix,is)=dLYPgd(ix,is) |
3061 | - enddo |
3062 | - enddo |
3063 | - end subroutine blypxc |
3064 | - |
3065 | - |
3066 | - |
3067 | - SUBROUTINE RPBEXC( IREL, nspin, Dens, GDens, |
3068 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
3069 | - |
3070 | -C ********************************************************************* |
3071 | -C Implements Hammer's RPBE Generalized-Gradient-Approximation (GGA). |
3072 | -C A revision of PBE (Perdew-Burke-Ernzerhof) |
3073 | -C Ref: Hammer, Hansen & Norskov, PRB 59, 7413 (1999) and |
3074 | -C J.P.Perdew, K.Burke & M.Ernzerhof, PRL 77, 3865 (1996) |
3075 | -C |
3076 | -C Written by M.V. Fernandez-Serra. March 2004. On the PBE routine of |
3077 | -C L.C.Balbas and J.M.Soler. December 1996. |
3078 | -C ******** INPUT ****************************************************** |
3079 | -C INTEGER IREL : Relativistic-exchange switch (0=No, 1=Yes) |
3080 | -C INTEGER nspin : Number of spin polarizations (1 or 2) |
3081 | -C REAL*8 Dens(nspin) : Total electron density (if nspin=1) or |
3082 | -C spin electron density (if nspin=2) |
3083 | -C REAL*8 GDens(3,nspin) : Total or spin density gradient |
3084 | -C ******** OUTPUT ***************************************************** |
3085 | -C REAL*8 EX : Exchange energy density |
3086 | -C REAL*8 EC : Correlation energy density |
3087 | -C REAL*8 DEXDD(nspin) : Partial derivative |
3088 | -C d(DensTot*Ex)/dDens(ispin), |
3089 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
3090 | -C For a constant density, this is the |
3091 | -C exchange potential |
3092 | -C REAL*8 DECDD(nspin) : Partial derivative |
3093 | -C d(DensTot*Ec)/dDens(ispin), |
3094 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
3095 | -C For a constant density, this is the |
3096 | -C correlation potential |
3097 | -C REAL*8 DEXDGD(3,nspin): Partial derivative |
3098 | -C d(DensTot*Ex)/d(GradDens(i,ispin)) |
3099 | -C REAL*8 DECDGD(3,nspin): Partial derivative |
3100 | -C d(DensTot*Ec)/d(GradDens(i,ispin)) |
3101 | -C ********* UNITS **************************************************** |
3102 | -C Lengths in Bohr |
3103 | -C Densities in electrons per Bohr**3 |
3104 | -C Energies in Hartrees |
3105 | -C Gradient vectors in cartesian coordinates |
3106 | -C ********* ROUTINES CALLED ****************************************** |
3107 | -C EXCHNG, PW92C |
3108 | -C ******************************************************************** |
3109 | - |
3110 | - implicit none |
3111 | - INTEGER IREL, nspin |
3112 | - real(dp) Dens(nspin), DECDD(nspin), DECDGD(3,nspin), |
3113 | - . DEXDD(nspin), DEXDGD(3,nspin), GDens(3,nspin) |
3114 | - |
3115 | -C Internal variables |
3116 | - INTEGER |
3117 | - . IS, IX |
3118 | - |
3119 | - real(dp) |
3120 | - . A, BETA, D(2), DADD, DECUDD, DENMIN, |
3121 | - . DF1DD, DF2DD, DF3DD, DF4DD, DF1DGD, DF3DGD, DF4DGD, |
3122 | - . DFCDD(2), DFCDGD(3,2), DFDD, DFDGD, DFXDD(2), DFXDGD(3,2), |
3123 | - . DHDD, DHDGD, DKFDD, DKSDD, DPDD, DPDZ, DRSDD, |
3124 | - . DS(2), DSDD, DSDGD, DT, DTDD, DTDGD, DZDD(2), |
3125 | - . EC, ECUNIF, EX, EXUNIF, |
3126 | - . F, F1, F2, F3, F4, FC, FX, FOUTHD, |
3127 | - . GAMMA, GD(3,2), GDM(2), GDMIN, GDMS, GDMT, GDS, GDT(3), |
3128 | - . H, HALF, KAPPA, KF, KFS, KS, MU, PHI, PI, RS, S, |
3129 | - . T, THD, THRHLF, TWO, TWOTHD, VCUNIF(2), VXUNIF(2), ZETA |
3130 | - |
3131 | -C Lower bounds of density and its gradient to avoid divisions by zero |
3132 | - PARAMETER ( DENMIN = 1.D-12 ) |
3133 | - PARAMETER ( GDMIN = 1.D-12 ) |
3134 | - |
3135 | -C Fix some numerical parameters |
3136 | - PARAMETER ( FOUTHD=4.D0/3.D0, HALF=0.5D0, |
3137 | - . THD=1.D0/3.D0, THRHLF=1.5D0, |
3138 | - . TWO=2.D0, TWOTHD=2.D0/3.D0 ) |
3139 | - |
3140 | -C Fix some more numerical constants |
3141 | - PI = 4 * ATAN(1.D0) |
3142 | - BETA = 0.066725D0 |
3143 | - GAMMA = (1 - LOG(TWO)) / PI**2 |
3144 | - MU = BETA * PI**2 / 3 |
3145 | - KAPPA = 0.804D0 |
3146 | - |
3147 | -C Translate density and its gradient to new variables |
3148 | - IF (nspin .EQ. 1) THEN |
3149 | - D(1) = HALF * Dens(1) |
3150 | - D(2) = D(1) |
3151 | - DT = MAX( DENMIN, Dens(1) ) |
3152 | - DO 10 IX = 1,3 |
3153 | - GD(IX,1) = HALF * GDens(IX,1) |
3154 | - GD(IX,2) = GD(IX,1) |
3155 | - GDT(IX) = GDens(IX,1) |
3156 | - 10 CONTINUE |
3157 | - ELSE |
3158 | - D(1) = Dens(1) |
3159 | - D(2) = Dens(2) |
3160 | - DT = MAX( DENMIN, Dens(1)+Dens(2) ) |
3161 | - DO 20 IX = 1,3 |
3162 | - GD(IX,1) = GDens(IX,1) |
3163 | - GD(IX,2) = GDens(IX,2) |
3164 | - GDT(IX) = GDens(IX,1) + GDens(IX,2) |
3165 | - 20 CONTINUE |
3166 | - ENDIF |
3167 | - GDM(1) = SQRT( GD(1,1)**2 + GD(2,1)**2 + GD(3,1)**2 ) |
3168 | - GDM(2) = SQRT( GD(1,2)**2 + GD(2,2)**2 + GD(3,2)**2 ) |
3169 | - GDMT = SQRT( GDT(1)**2 + GDT(2)**2 + GDT(3)**2 ) |
3170 | - GDMT = MAX( GDMIN, GDMT ) |
3171 | - |
3172 | -C Find local correlation energy and potential |
3173 | - CALL PW92C( 2, D, ECUNIF, VCUNIF ) |
3174 | - |
3175 | -C Find total correlation energy |
3176 | - RS = ( 3 / (4*PI*DT) )**THD |
3177 | - KF = (3 * PI**2 * DT)**THD |
3178 | - KS = SQRT( 4 * KF / PI ) |
3179 | - ZETA = ( D(1) - D(2) ) / DT |
3180 | - ZETA = MAX( -1.D0+DENMIN, ZETA ) |
3181 | - ZETA = MIN( 1.D0-DENMIN, ZETA ) |
3182 | - PHI = HALF * ( (1+ZETA)**TWOTHD + (1-ZETA)**TWOTHD ) |
3183 | - T = GDMT / (2 * PHI * KS * DT) |
3184 | - F1 = ECUNIF / GAMMA / PHI**3 |
3185 | - F2 = EXP(-F1) |
3186 | - A = BETA / GAMMA / (F2-1) |
3187 | - F3 = T**2 + A * T**4 |
3188 | - F4 = BETA/GAMMA * F3 / (1 + A*F3) |
3189 | - H = GAMMA * PHI**3 * LOG( 1 + F4 ) |
3190 | - FC = ECUNIF + H |
3191 | - |
3192 | -C Find correlation energy derivatives |
3193 | - DRSDD = - (THD * RS / DT) |
3194 | - DKFDD = THD * KF / DT |
3195 | - DKSDD = HALF * KS * DKFDD / KF |
3196 | - DZDD(1) = 1 / DT - ZETA / DT |
3197 | - DZDD(2) = - (1 / DT) - ZETA / DT |
3198 | - DPDZ = HALF * TWOTHD * ( 1/(1+ZETA)**THD - 1/(1-ZETA)**THD ) |
3199 | - DO 40 IS = 1,2 |
3200 | - DECUDD = ( VCUNIF(IS) - ECUNIF ) / DT |
3201 | - DPDD = DPDZ * DZDD(IS) |
3202 | - DTDD = (- T) * ( DPDD/PHI + DKSDD/KS + 1/DT ) |
3203 | - DF1DD = F1 * ( DECUDD/ECUNIF - 3*DPDD/PHI ) |
3204 | - DF2DD = (- F2) * DF1DD |
3205 | - DADD = (- A) * DF2DD / (F2-1) |
3206 | - DF3DD = (2*T + 4*A*T**3) * DTDD + DADD * T**4 |
3207 | - DF4DD = F4 * ( DF3DD/F3 - (DADD*F3+A*DF3DD)/(1+A*F3) ) |
3208 | - DHDD = 3 * H * DPDD / PHI |
3209 | - DHDD = DHDD + GAMMA * PHI**3 * DF4DD / (1+F4) |
3210 | - DFCDD(IS) = VCUNIF(IS) + H + DT * DHDD |
3211 | - |
3212 | - DO 30 IX = 1,3 |
3213 | - DTDGD = (T / GDMT) * GDT(IX) / GDMT |
3214 | - DF3DGD = DTDGD * ( 2 * T + 4 * A * T**3 ) |
3215 | - DF4DGD = F4 * DF3DGD * ( 1/F3 - A/(1+A*F3) ) |
3216 | - DHDGD = GAMMA * PHI**3 * DF4DGD / (1+F4) |
3217 | - DFCDGD(IX,IS) = DT * DHDGD |
3218 | - 30 CONTINUE |
3219 | - 40 CONTINUE |
3220 | - |
3221 | -C Find exchange energy and potential |
3222 | - FX = 0 |
3223 | - DO 60 IS = 1,2 |
3224 | - DS(IS) = MAX( DENMIN, 2 * D(IS) ) |
3225 | - GDMS = MAX( GDMIN, 2 * GDM(IS) ) |
3226 | - KFS = (3 * PI**2 * DS(IS))**THD |
3227 | - S = GDMS / (2 * KFS * DS(IS)) |
3228 | -cea Hammer's RPBE (Hammer, Hansen & Norskov PRB 59 7413 (99) |
3229 | -cea F1 = DEXP( - MU * S**2 / KAPPA) |
3230 | -cea F = 1 + KAPPA * (1 - F1) |
3231 | -cea Following is standard PBE |
3232 | -cea F1 = 1 + MU * S**2 / KAPPA |
3233 | -cea F = 1 + KAPPA - KAPPA / F1 |
3234 | -cea (If revPBE Zhang & Yang, PRL 80,890(1998),change PBE's KAPPA to 1.245) |
3235 | - F1 = DEXP( - MU * S**2 / KAPPA) |
3236 | - F = 1 + KAPPA * (1 - F1) |
3237 | - |
3238 | -c Note nspin=1 in call to exchng... |
3239 | - |
3240 | - CALL EXCHNG( IREL, 1, DS(IS), EXUNIF, VXUNIF(IS) ) |
3241 | - FX = FX + DS(IS) * EXUNIF * F |
3242 | - |
3243 | -cMVFS The derivatives of F also need to be changed for Hammer's RPBE. |
3244 | -cMVFS DF1DD = 2 * F1 * DSDD * ( - MU * S / KAPPA) |
3245 | -cMVFS DF1DGD= 2 * F1 * DSDGD * ( - MU * S / KAPPA) |
3246 | -cMVFS DFDD = -1 * KAPPA * DF1DD |
3247 | -cMVFS DFDGD = -1 * KAPPA * DFDGD |
3248 | - |
3249 | - DKFDD = THD * KFS / DS(IS) |
3250 | - DSDD = S * ( -(DKFDD/KFS) - 1/DS(IS) ) |
3251 | -c DF1DD = 2 * (F1-1) * DSDD / S |
3252 | -c DFDD = KAPPA * DF1DD / F1**2 |
3253 | - DF1DD = 2* F1 * DSDD * ( - MU * S / KAPPA) |
3254 | - DFDD = -1 * KAPPA * DF1DD |
3255 | - DFXDD(IS) = VXUNIF(IS) * F + DS(IS) * EXUNIF * DFDD |
3256 | - |
3257 | - DO 50 IX = 1,3 |
3258 | - GDS = 2 * GD(IX,IS) |
3259 | - DSDGD = (S / GDMS) * GDS / GDMS |
3260 | -c DF1DGD = 2 * MU * S * DSDGD / KAPPA |
3261 | -c DFDGD = KAPPA * DF1DGD / F1**2 |
3262 | - DF1DGD =2*F1 * DSDGD * ( - MU * S / KAPPA) |
3263 | - DFDGD = -1 * KAPPA * DF1DGD |
3264 | - DFXDGD(IX,IS) = DS(IS) * EXUNIF * DFDGD |
3265 | - 50 CONTINUE |
3266 | - 60 CONTINUE |
3267 | - FX = HALF * FX / DT |
3268 | - |
3269 | -C Set output arguments |
3270 | - EX = FX |
3271 | - EC = FC |
3272 | - DO 90 IS = 1,nspin |
3273 | - DEXDD(IS) = DFXDD(IS) |
3274 | - DECDD(IS) = DFCDD(IS) |
3275 | - DO 80 IX = 1,3 |
3276 | - DEXDGD(IX,IS) = DFXDGD(IX,IS) |
3277 | - DECDGD(IX,IS) = DFCDGD(IX,IS) |
3278 | - 80 CONTINUE |
3279 | - 90 CONTINUE |
3280 | - |
3281 | - END SUBROUTINE RPBEXC |
3282 | - |
3283 | - |
3284 | - |
3285 | - SUBROUTINE WCXC( IREL, nspin, Dens, GDens, |
3286 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
3287 | - |
3288 | -C ********************************************************************* |
3289 | -C Implements Wu-Cohen Generalized-Gradient-Approximation. |
3290 | -C Ref: Z. Wu and R. E. Cohen PRB 73, 235116 (2006) |
3291 | -C Written by Marivi Fernandez-Serra, with contributions by |
3292 | -C Julian Gale and Alberto Garcia, |
3293 | -C over the PBEXC subroutine of L.C.Balbas and J.M.Soler. |
3294 | -C September, 2006. |
3295 | -C ******** INPUT ****************************************************** |
3296 | -C INTEGER IREL : Relativistic-exchange switch (0=No, 1=Yes) |
3297 | -C INTEGER nspin : Number of spin polarizations (1 or 2) |
3298 | -C REAL*8 Dens(nspin) : Total electron density (if nspin=1) or |
3299 | -C spin electron density (if nspin=2) |
3300 | -C REAL*8 GDens(3,nspin) : Total or spin density gradient |
3301 | -C ******** OUTPUT ***************************************************** |
3302 | -C REAL*8 EX : Exchange energy density |
3303 | -C REAL*8 EC : Correlation energy density |
3304 | -C REAL*8 DEXDD(nspin) : Partial derivative |
3305 | -C d(DensTot*Ex)/dDens(ispin), |
3306 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
3307 | -C For a constant density, this is the |
3308 | -C exchange potential |
3309 | -C REAL*8 DECDD(nspin) : Partial derivative |
3310 | -C d(DensTot*Ec)/dDens(ispin), |
3311 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
3312 | -C For a constant density, this is the |
3313 | -C correlation potential |
3314 | -C REAL*8 DEXDGD(3,nspin): Partial derivative |
3315 | -C d(DensTot*Ex)/d(GradDens(i,ispin)) |
3316 | -C REAL*8 DECDGD(3,nspin): Partial derivative |
3317 | -C d(DensTot*Ec)/d(GradDens(i,ispin)) |
3318 | -C ********* UNITS **************************************************** |
3319 | -C Lengths in Bohr |
3320 | -C Densities in electrons per Bohr**3 |
3321 | -C Energies in Hartrees |
3322 | -C Gradient vectors in cartesian coordinates |
3323 | -C ********* ROUTINES CALLED ****************************************** |
3324 | -C EXCHNG, PW92C |
3325 | -C ******************************************************************** |
3326 | - |
3327 | - implicit none |
3328 | - INTEGER IREL, nspin |
3329 | - real(dp) Dens(nspin), DECDD(nspin), DECDGD(3,nspin), |
3330 | - . DEXDD(nspin), DEXDGD(3,nspin), GDens(3,nspin) |
3331 | - |
3332 | -C Internal variables |
3333 | - INTEGER |
3334 | - . IS, IX |
3335 | - |
3336 | - real(dp) |
3337 | - . A, BETA, D(2), DADD, DECUDD, DENMIN, |
3338 | - . DF1DD, DF2DD, DF3DD, DF4DD, DF1DGD, DF3DGD, DF4DGD, |
3339 | - . DFCDD(2), DFCDGD(3,2), DFDD, DFDGD, DFXDD(2), DFXDGD(3,2), |
3340 | - . DHDD, DHDGD, DKFDD, DKSDD, DPDD, DPDZ, DRSDD, |
3341 | - . DS(2), DSDD, DSDGD, DT, DTDD, DTDGD, DZDD(2), |
3342 | - . XWC, DXWCDS, CWC, |
3343 | - . EC, ECUNIF, EX, EXUNIF, |
3344 | - . F, F1, F2, F3, F4, FC, FX, FOUTHD, |
3345 | - . GAMMA, GD(3,2), GDM(2), GDMIN, GDMS, GDMT, GDS, GDT(3), |
3346 | - . H, HALF, KAPPA, KF, KFS, KS, MU, PHI, PI, RS, S, |
3347 | - . TEN81, |
3348 | - . T, THD, THRHLF, TWO, TWOTHD, VCUNIF(2), VXUNIF(2), ZETA |
3349 | - |
3350 | -C Lower bounds of density and its gradient to avoid divisions by zero |
3351 | - PARAMETER ( DENMIN = 1.D-12 ) |
3352 | - PARAMETER ( GDMIN = 1.D-12 ) |
3353 | - |
3354 | -C Fix some numerical parameters |
3355 | - PARAMETER ( FOUTHD=4.D0/3.D0, HALF=0.5D0, |
3356 | - . THD=1.D0/3.D0, THRHLF=1.5D0, |
3357 | - . TWO=2.D0, TWOTHD=2.D0/3.D0 ) |
3358 | - PARAMETER ( TEN81 = 10.0d0/81.0d0 ) |
3359 | - |
3360 | -C Fix some more numerical constants |
3361 | - PI = 4 * ATAN(1.D0) |
3362 | - BETA = 0.066725D0 |
3363 | - GAMMA = (1 - LOG(TWO)) / PI**2 |
3364 | - MU = BETA * PI**2 / 3 |
3365 | - KAPPA = 0.804D0 |
3366 | - CWC = 0.0079325D0 |
3367 | - |
3368 | -C Translate density and its gradient to new variables |
3369 | - IF (nspin .EQ. 1) THEN |
3370 | - D(1) = HALF * Dens(1) |
3371 | - D(2) = D(1) |
3372 | - DT = MAX( DENMIN, Dens(1) ) |
3373 | - DO 10 IX = 1,3 |
3374 | - GD(IX,1) = HALF * GDens(IX,1) |
3375 | - GD(IX,2) = GD(IX,1) |
3376 | - GDT(IX) = GDens(IX,1) |
3377 | - 10 CONTINUE |
3378 | - ELSE |
3379 | - D(1) = Dens(1) |
3380 | - D(2) = Dens(2) |
3381 | - DT = MAX( DENMIN, Dens(1)+Dens(2) ) |
3382 | - DO 20 IX = 1,3 |
3383 | - GD(IX,1) = GDens(IX,1) |
3384 | - GD(IX,2) = GDens(IX,2) |
3385 | - GDT(IX) = GDens(IX,1) + GDens(IX,2) |
3386 | - 20 CONTINUE |
3387 | - ENDIF |
3388 | - GDM(1) = SQRT( GD(1,1)**2 + GD(2,1)**2 + GD(3,1)**2 ) |
3389 | - GDM(2) = SQRT( GD(1,2)**2 + GD(2,2)**2 + GD(3,2)**2 ) |
3390 | - GDMT = SQRT( GDT(1)**2 + GDT(2)**2 + GDT(3)**2 ) |
3391 | - GDMT = MAX( GDMIN, GDMT ) |
3392 | - |
3393 | -C Find local correlation energy and potential |
3394 | - CALL PW92C( 2, D, ECUNIF, VCUNIF ) |
3395 | - |
3396 | -C Find total correlation energy |
3397 | - RS = ( 3 / (4*PI*DT) )**THD |
3398 | - KF = (3 * PI**2 * DT)**THD |
3399 | - KS = SQRT( 4 * KF / PI ) |
3400 | - ZETA = ( D(1) - D(2) ) / DT |
3401 | - ZETA = MAX( -1.D0+DENMIN, ZETA ) |
3402 | - ZETA = MIN( 1.D0-DENMIN, ZETA ) |
3403 | - PHI = HALF * ( (1+ZETA)**TWOTHD + (1-ZETA)**TWOTHD ) |
3404 | - T = GDMT / (2 * PHI * KS * DT) |
3405 | - F1 = ECUNIF / GAMMA / PHI**3 |
3406 | - F2 = EXP(-F1) |
3407 | - A = BETA / GAMMA / (F2-1) |
3408 | - F3 = T**2 + A * T**4 |
3409 | - F4 = BETA/GAMMA * F3 / (1 + A*F3) |
3410 | - H = GAMMA * PHI**3 * LOG( 1 + F4 ) |
3411 | - FC = ECUNIF + H |
3412 | - |
3413 | -C Find correlation energy derivatives |
3414 | - DRSDD = - (THD * RS / DT) |
3415 | - DKFDD = THD * KF / DT |
3416 | - DKSDD = HALF * KS * DKFDD / KF |
3417 | - DZDD(1) = 1 / DT - ZETA / DT |
3418 | - DZDD(2) = - (1 / DT) - ZETA / DT |
3419 | - DPDZ = HALF * TWOTHD * ( 1/(1+ZETA)**THD - 1/(1-ZETA)**THD ) |
3420 | - DO 40 IS = 1,2 |
3421 | - DECUDD = ( VCUNIF(IS) - ECUNIF ) / DT |
3422 | - DPDD = DPDZ * DZDD(IS) |
3423 | - DTDD = (- T) * ( DPDD/PHI + DKSDD/KS + 1/DT ) |
3424 | - DF1DD = F1 * ( DECUDD/ECUNIF - 3*DPDD/PHI ) |
3425 | - DF2DD = (- F2) * DF1DD |
3426 | - DADD = (- A) * DF2DD / (F2-1) |
3427 | - DF3DD = (2*T + 4*A*T**3) * DTDD + DADD * T**4 |
3428 | - DF4DD = F4 * ( DF3DD/F3 - (DADD*F3+A*DF3DD)/(1+A*F3) ) |
3429 | - DHDD = 3 * H * DPDD / PHI |
3430 | - DHDD = DHDD + GAMMA * PHI**3 * DF4DD / (1+F4) |
3431 | - DFCDD(IS) = VCUNIF(IS) + H + DT * DHDD |
3432 | - |
3433 | - DO 30 IX = 1,3 |
3434 | - DTDGD = (T / GDMT) * GDT(IX) / GDMT |
3435 | - DF3DGD = DTDGD * ( 2 * T + 4 * A * T**3 ) |
3436 | - DF4DGD = F4 * DF3DGD * ( 1/F3 - A/(1+A*F3) ) |
3437 | - DHDGD = GAMMA * PHI**3 * DF4DGD / (1+F4) |
3438 | - DFCDGD(IX,IS) = DT * DHDGD |
3439 | - 30 CONTINUE |
3440 | - 40 CONTINUE |
3441 | - |
3442 | -C Find exchange energy and potential |
3443 | - FX = 0 |
3444 | - DO 60 IS = 1,2 |
3445 | - DS(IS) = MAX( DENMIN, 2 * D(IS) ) |
3446 | - GDMS = MAX( GDMIN, 2 * GDM(IS) ) |
3447 | - KFS = (3 * PI**2 * DS(IS))**THD |
3448 | - S = GDMS / (2 * KFS * DS(IS)) |
3449 | -c |
3450 | -c For PBE: |
3451 | -c |
3452 | -c x = MU * S**2 |
3453 | -c dxds = 2*MU*S |
3454 | -c |
3455 | -c Wu-Cohen form: |
3456 | -c |
3457 | - XWC= TEN81 * s**2 + (MU- TEN81) * |
3458 | - . S**2 * exp(-S**2) + log(1+ CWC * S**4) |
3459 | - DXWCDS = 2 * TEN81 * S + (MU - TEN81) * exp(-S**2) * |
3460 | - . 2*S * (1 - S*S) + 4 * CWC * S**3 / (1 + CWC * S**4) |
3461 | -c------------------- |
3462 | - |
3463 | - F1 = 1 + XWC / KAPPA |
3464 | - F = 1 + KAPPA - KAPPA / F1 |
3465 | -c |
3466 | -c Note nspin=1 in call to exchng... |
3467 | -c |
3468 | - CALL EXCHNG( IREL, 1, DS(IS), EXUNIF, VXUNIF(IS) ) |
3469 | - FX = FX + DS(IS) * EXUNIF * F |
3470 | - |
3471 | - DKFDD = THD * KFS / DS(IS) |
3472 | - DSDD = S * ( -(DKFDD/KFS) - 1/DS(IS) ) |
3473 | - DF1DD = DXWCDS * DSDD / KAPPA |
3474 | - DFDD = KAPPA * DF1DD / F1**2 |
3475 | - DFXDD(IS) = VXUNIF(IS) * F + DS(IS) * EXUNIF * DFDD |
3476 | - |
3477 | - DO 50 IX = 1,3 |
3478 | - GDS = 2 * GD(IX,IS) |
3479 | - DSDGD = (S / GDMS) * GDS / GDMS |
3480 | - DF1DGD = DXWCDS * DSDGD / KAPPA |
3481 | - DFDGD = KAPPA * DF1DGD / F1**2 |
3482 | - DFXDGD(IX,IS) = DS(IS) * EXUNIF * DFDGD |
3483 | - 50 CONTINUE |
3484 | - 60 CONTINUE |
3485 | - FX = HALF * FX / DT |
3486 | - |
3487 | -C Set output arguments |
3488 | - EX = FX |
3489 | - EC = FC |
3490 | - DO 90 IS = 1,nspin |
3491 | - DEXDD(IS) = DFXDD(IS) |
3492 | - DECDD(IS) = DFCDD(IS) |
3493 | - DO 80 IX = 1,3 |
3494 | - DEXDGD(IX,IS) = DFXDGD(IX,IS) |
3495 | - DECDGD(IX,IS) = DFCDGD(IX,IS) |
3496 | - 80 CONTINUE |
3497 | - 90 CONTINUE |
3498 | - |
3499 | - END SUBROUTINE WCXC |
3500 | - |
3501 | - |
3502 | - |
3503 | - SUBROUTINE AM05XC( IREL, nspin, Dens, GDens, |
3504 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
3505 | - |
3506 | -C ********************************************************************* |
3507 | -C Implements the Armiento Mattsson AM05 GGA. |
3508 | -C Ref: R. Armiento and A. E. Mattsson, PRB 72, 085108 (2005) |
3509 | -C Written by L.C.Balbas and J.M.Soler originally for PBE. December 1996. |
3510 | -C Modified by J.D. Gale for AM05. May 2009. |
3511 | -C ******** INPUT ****************************************************** |
3512 | -C INTEGER IREL : Relativistic-exchange switch (0=No, 1=Yes) |
3513 | -C INTEGER nspin : Number of spin polarizations (1 or 2) |
3514 | -C REAL*8 Dens(nspin) : Total electron density (if nspin=1) or |
3515 | -C spin electron density (if nspin=2) |
3516 | -C REAL*8 GDens(3,nspin) : Total or spin density gradient |
3517 | -C ******** OUTPUT ***************************************************** |
3518 | -C REAL*8 EX : Exchange energy density |
3519 | -C REAL*8 EC : Correlation energy density |
3520 | -C REAL*8 DEXDD(nspin) : Partial derivative |
3521 | -C d(DensTot*Ex)/dDens(ispin), |
3522 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
3523 | -C For a constant density, this is the |
3524 | -C exchange potential |
3525 | -C REAL*8 DECDD(nspin) : Partial derivative |
3526 | -C d(DensTot*Ec)/dDens(ispin), |
3527 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
3528 | -C For a constant density, this is the |
3529 | -C correlation potential |
3530 | -C REAL*8 DEXDGD(3,nspin): Partial derivative |
3531 | -C d(DensTot*Ex)/d(GradDens(i,ispin)) |
3532 | -C REAL*8 DECDGD(3,nspin): Partial derivative |
3533 | -C d(DensTot*Ec)/d(GradDens(i,ispin)) |
3534 | -C ********* UNITS **************************************************** |
3535 | -C Lengths in Bohr |
3536 | -C Densities in electrons per Bohr**3 |
3537 | -C Energies in Hartrees |
3538 | -C Gradient vectors in cartesian coordinates |
3539 | -C ********* ROUTINES CALLED ****************************************** |
3540 | -C am05wbs |
3541 | -C ******************************************************************** |
3542 | - |
3543 | - use precision, only : dp |
3544 | - use am05, only : am05wbs |
3545 | - |
3546 | - implicit none |
3547 | - integer irel, nspin |
3548 | - real(dp) Dens(nspin), DECDD(nspin), DECDGD(3,nspin), |
3549 | - . DEXDD(nspin), DEXDGD(3,nspin), GDens(3,nspin) |
3550 | - |
3551 | -C Internal variables |
3552 | - integer |
3553 | - . is, ix |
3554 | - |
3555 | - real(dp) |
3556 | - . D(2), DENMIN, DFXDD(2), DFCDD(2), DFCDGD(3,2), |
3557 | - . DFXDGD(3,2), DFXDG(2), DFCDG(2), |
3558 | - . DS(2), DT, EC, EX, FX, FC, |
3559 | - . GD(3,2), GDM(2), GDMIN, GDMS, GDMT, GDS, GDT(3) |
3560 | - |
3561 | -C Lower bounds of density and its gradient to avoid divisions by zero |
3562 | - parameter ( DENMIN = 1.D-12 ) |
3563 | - parameter ( GDMIN = 1.D-12 ) |
3564 | - |
3565 | -C Translate density and its gradient to new variables |
3566 | - if (nspin .eq. 1) then |
3567 | - D(1) = 0.5_dp*Dens(1) |
3568 | - D(2) = D(1) |
3569 | - DT = max( DENMIN, Dens(1) ) |
3570 | - do ix = 1,3 |
3571 | - GD(ix,1) = 0.5_dp*GDens(ix,1) |
3572 | - GD(ix,2) = GD(ix,1) |
3573 | - GDT(ix) = GDens(ix,1) |
3574 | - enddo |
3575 | - else |
3576 | - D(1) = Dens(1) |
3577 | - D(2) = Dens(2) |
3578 | - DT = max( DENMIN, Dens(1)+Dens(2) ) |
3579 | - do ix = 1,3 |
3580 | - GD(ix,1) = GDens(ix,1) |
3581 | - GD(ix,2) = GDens(ix,2) |
3582 | - GDT(ix) = GDens(ix,1) + GDens(ix,2) |
3583 | + dbecgd(ix,is)=d(is)**(-fothd)*dgdx(is)*gd(ix,is)/x(is) |
3584 | enddo |
3585 | endif |
3586 | - GDM(1) = sqrt( GD(1,1)**2 + GD(2,1)**2 + GD(3,1)**2 ) |
3587 | - GDM(2) = sqrt( GD(1,2)**2 + GD(2,2)**2 + GD(3,2)**2 ) |
3588 | - GDMT = sqrt( GDT(1)**2 + GDT(2)**2 + GDT(3)**2 ) |
3589 | - GDMT = max( GDMIN, GDMT ) |
3590 | - |
3591 | - D(1) = max(D(1),denmin) |
3592 | - D(2) = max(D(2),denmin) |
3593 | - |
3594 | -C Call AM05 subroutine |
3595 | - call am05wbs(D(1), D(2), GDM(1), GDM(2), FX, FC, |
3596 | - . DFXDD(1), DFXDD(2), DFCDD(1), DFCDD(2), |
3597 | - . DFXDG(1), DFXDG(2), DFCDG(1), DFCDG(2)) |
3598 | - |
3599 | -C Convert gradient terms into vectors |
3600 | - do is = 1,nspin |
3601 | - do ix = 1,3 |
3602 | - DFXDGD(ix,is) = DFXDG(is)*GD(ix,is) |
3603 | - DFCDGD(ix,is) = DFCDG(is)*GD(ix,is) |
3604 | - enddo |
3605 | - enddo |
3606 | - |
3607 | -C Convert FX to form required by SIESTA - note factor of 1/2 |
3608 | -C is already applied in am05 code. |
3609 | - FX = FX / DT |
3610 | - |
3611 | -C Set output arguments |
3612 | - EX = FX |
3613 | - EC = FC |
3614 | - do is = 1,nspin |
3615 | - DEXDD(is) = DFXDD(is) |
3616 | - DECDD(is) = DFCDD(is) |
3617 | - do ix = 1,3 |
3618 | - DEXDGD(ix,is) = DFXDGD(ix,is) |
3619 | - DECDGD(ix,is) = DFCDGD(ix,is) |
3620 | - enddo |
3621 | - enddo |
3622 | - |
3623 | - END SUBROUTINE AM05XC |
3624 | - |
3625 | - |
3626 | - |
3627 | - SUBROUTINE PW86formX( a, b, c, iRel, nSpin, Dens, GDens, |
3628 | - . EX, dEXdD, dEXdGD ) |
3629 | - |
3630 | -C ********************************************************************* |
3631 | -C Implements Perdew-Wang-86 Generalized-Gradient-Approximation exchange-only |
3632 | -C functional form, eps_x=eps_x_LDA*(1+15*a*s**2+b*s**4+c*s**6)**(1/15), |
3633 | -C but with variable values for parameters a, b, and c |
3634 | -C Refs: J.P.Perdew & Y.Wang, PRB 33, 8800 (1986) |
3635 | -C E.D.Murray, K.Lee & D.C.Langreth, JCTC 5, 2754 (2009) |
3636 | -C Written by J.M.Soler. March 2010. |
3637 | -C ******** INPUT ****************************************************** |
3638 | -C REAL*8 a, b, c : Parameter a, b, and c of the PW86 functional |
3639 | -C INTEGER IREL : Relativistic-exchange switch (0=No, 1=Yes) |
3640 | -C INTEGER nspin : Number of spin polarizations (1 or 2) |
3641 | -C REAL*8 Dens(nspin) : Total electron density (if nspin=1) or |
3642 | -C spin electron density (if nspin=2) |
3643 | -C REAL*8 GDens(3,nspin) : Total or spin density gradient |
3644 | -C ******** OUTPUT ***************************************************** |
3645 | -C REAL*8 EX : Exchange energy density |
3646 | -C REAL*8 DEXDD(nspin) : Partial derivative |
3647 | -C d(DensTot*Ex)/dDens(ispin), |
3648 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
3649 | -C For a constant density, this is the |
3650 | -C exchange potential |
3651 | -C REAL*8 DEXDGD(3,nspin): Partial derivative |
3652 | -C d(DensTot*Ex)/d(GradDens(i,ispin)) |
3653 | -C ********* UNITS **************************************************** |
3654 | -C Lengths in Bohr |
3655 | -C Densities in electrons per Bohr**3 |
3656 | -C Energies in Hartrees |
3657 | -C Gradient vectors in cartesian coordinates |
3658 | -C ********* ROUTINES CALLED ****************************************** |
3659 | -C EXCHNG |
3660 | -C ******************************************************************** |
3661 | - |
3662 | - implicit none |
3663 | - |
3664 | -C Input |
3665 | - real(dp),intent(in) :: a ! Parameter of PW86 functional |
3666 | - real(dp),intent(in) :: b ! Parameter of PW86 functional |
3667 | - real(dp),intent(in) :: c ! Parameter of PW86 functional |
3668 | - integer, intent(in) :: iRel ! Relativistic exchange? 0=no, 1=yes |
3669 | - integer, intent(in) :: nSpin ! Number of spin components |
3670 | - real(dp),intent(in) :: Dens(nSpin) ! Local electron (spin) density |
3671 | - real(dp),intent(in) :: GDens(3,nSpin) ! Gradient of electron density |
3672 | - |
3673 | -C Output |
3674 | - real(dp),intent(out):: EX ! Exchange energy per electron |
3675 | - real(dp),intent(out):: dEXdD(nSpin) ! dEx/dDens, Ex=Int(dens*epsX) |
3676 | - real(dp),intent(out):: dEXdGD(3,nSpin) ! dEx/dGrad(Dens) |
3677 | - |
3678 | -C Internal variables |
3679 | - INTEGER |
3680 | - . IS, IX |
3681 | - real(dp) |
3682 | - . D(2), DENMIN, DF1DS, DFDD, DFDGD, DFDS, DFXDD(2), DFXDGD(3,2), |
3683 | - . DKFDD, DS(2), DSDD, DSDGD, DT, ECUNIF, EXUNIF, F, F1, FX, |
3684 | - . GD(3,2), GDM(2), GDMIN, GDMS, GDMT, GDS, GDT(3), |
3685 | - . KFS, PI, S, VXUNIF(2), ZETA |
3686 | - |
3687 | -C Lower bounds of density and its gradient to avoid divisions by zero |
3688 | - PARAMETER ( DENMIN = 1.D-12 ) |
3689 | - PARAMETER ( GDMIN = 1.D-12 ) |
3690 | - |
3691 | -C Fix some more numerical constants |
3692 | - PI = 4 * ATAN(1.D0) |
3693 | - |
3694 | -C Translate density and its gradient to new variables |
3695 | - IF (nspin .EQ. 1) THEN |
3696 | - D(1) = Dens(1) / 2 |
3697 | - D(2) = D(1) |
3698 | - DT = MAX( DENMIN, Dens(1) ) |
3699 | - DO 10 IX = 1,3 |
3700 | - GD(IX,1) = GDens(IX,1) / 2 |
3701 | - GD(IX,2) = GD(IX,1) |
3702 | - GDT(IX) = GDens(IX,1) |
3703 | - 10 CONTINUE |
3704 | - ELSE |
3705 | - D(1) = Dens(1) |
3706 | - D(2) = Dens(2) |
3707 | - DT = MAX( DENMIN, Dens(1)+Dens(2) ) |
3708 | - DO 20 IX = 1,3 |
3709 | - GD(IX,1) = GDens(IX,1) |
3710 | - GD(IX,2) = GDens(IX,2) |
3711 | - GDT(IX) = GDens(IX,1) + GDens(IX,2) |
3712 | - 20 CONTINUE |
3713 | - ENDIF |
3714 | - GDM(1) = SQRT( GD(1,1)**2 + GD(2,1)**2 + GD(3,1)**2 ) |
3715 | - GDM(2) = SQRT( GD(1,2)**2 + GD(2,2)**2 + GD(3,2)**2 ) |
3716 | - GDMT = SQRT( GDT(1)**2 + GDT(2)**2 + GDT(3)**2 ) |
3717 | - GDMT = MAX( GDMIN, GDMT ) |
3718 | - |
3719 | -C Find exchange energy and potential |
3720 | - FX = 0 |
3721 | - DO 60 IS = 1,2 |
3722 | - DS(IS) = MAX( DENMIN, 2 * D(IS) ) |
3723 | - GDMS = MAX( GDMIN, 2 * GDM(IS) ) |
3724 | - KFS = (3 * PI**2 * DS(IS))**(1._dp/3) |
3725 | - S = GDMS / (2 * KFS * DS(IS)) |
3726 | - F1 = 1 + 15*a*S**2 + b*S**4 + c*S**6 |
3727 | - F = F1**(1._dp/15) |
3728 | -c |
3729 | -c Note nspin=1 in call to exchng... |
3730 | -c |
3731 | - CALL EXCHNG( IREL, 1, DS(IS), EXUNIF, VXUNIF(IS) ) |
3732 | - FX = FX + DS(IS) * EXUNIF * F |
3733 | - |
3734 | - DKFDD = KFS / DS(IS) / 3 |
3735 | - DSDD = S * ( -(DKFDD/KFS) - 1/DS(IS) ) |
3736 | - DF1DS = 30*a*S + 4*b*S**3 + 6*c*S**5 |
3737 | - DFDS = F/F1/15 * DF1DS |
3738 | - DFDD = DFDS * DSDD |
3739 | - DFXDD(IS) = VXUNIF(IS) * F + DS(IS) * EXUNIF * DFDD |
3740 | - |
3741 | - DO 50 IX = 1,3 |
3742 | - GDS = 2 * GD(IX,IS) |
3743 | - DSDGD = (S / GDMS) * GDS / GDMS |
3744 | - DFDGD = DFDS * DSDGD |
3745 | - DFXDGD(IX,IS) = DS(IS) * EXUNIF * DFDGD |
3746 | - 50 CONTINUE |
3747 | - 60 CONTINUE |
3748 | - FX = FX / DT / 2 |
3749 | - |
3750 | -C Set output arguments |
3751 | - EX = FX |
3752 | - DO 90 IS = 1,nspin |
3753 | - DEXDD(IS) = DFXDD(IS) |
3754 | - DO 80 IX = 1,3 |
3755 | - DEXDGD(IX,IS) = DFXDGD(IX,IS) |
3756 | - 80 CONTINUE |
3757 | - 90 CONTINUE |
3758 | - |
3759 | - END SUBROUTINE PW86formX |
3760 | - |
3761 | - |
3762 | - |
3763 | - SUBROUTINE PW86X( IREL, nspin, Dens, GDens, |
3764 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
3765 | - |
3766 | -C ********************************************************************* |
3767 | -C Implements Perdew-Wang-86 Generalized-Gradient-Approximation |
3768 | -C exchange-only functional. Correlation energy returns as zero. |
3769 | -C Ref: J.P.Perdew & Y.Wang, PRB 33, 8800 (1986) |
3770 | -C Written by J.M.Soler. March 2010. |
3771 | -C ******** INPUT ****************************************************** |
3772 | -C INTEGER IREL : Relativistic-exchange switch (0=No, 1=Yes) |
3773 | -C INTEGER nspin : Number of spin polarizations (1 or 2) |
3774 | -C REAL*8 Dens(nspin) : Total electron density (if nspin=1) or |
3775 | -C spin electron density (if nspin=2) |
3776 | -C REAL*8 GDens(3,nspin) : Total or spin density gradient |
3777 | -C ******** OUTPUT ***************************************************** |
3778 | -C REAL*8 EX : Exchange energy density |
3779 | -C REAL*8 EC : Correlation energy density |
3780 | -C REAL*8 DEXDD(nspin) : Partial derivative |
3781 | -C d(DensTot*Ex)/dDens(ispin), |
3782 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
3783 | -C For a constant density, this is the |
3784 | -C exchange potential |
3785 | -C REAL*8 DECDD(nspin) : Partial derivative |
3786 | -C d(DensTot*Ec)/dDens(ispin), |
3787 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
3788 | -C For a constant density, this is the |
3789 | -C correlation potential |
3790 | -C REAL*8 DEXDGD(3,nspin): Partial derivative |
3791 | -C d(DensTot*Ex)/d(GradDens(i,ispin)) |
3792 | -C REAL*8 DECDGD(3,nspin): Partial derivative |
3793 | -C d(DensTot*Ec)/d(GradDens(i,ispin)) |
3794 | -C ********* UNITS **************************************************** |
3795 | -C Lengths in Bohr |
3796 | -C Densities in electrons per Bohr**3 |
3797 | -C Energies in Hartrees |
3798 | -C Gradient vectors in cartesian coordinates |
3799 | -C ********* ROUTINES CALLED ****************************************** |
3800 | -C PW86formX |
3801 | -C ******************************************************************** |
3802 | - |
3803 | - IMPLICIT NONE |
3804 | - |
3805 | -C Passed arguments |
3806 | - integer, intent(in) :: IREL, NSPIN |
3807 | - real(dp),intent(in) :: DENS(NSPIN), GDENS(3,NSPIN) |
3808 | - real(dp),intent(out):: EX, EC, DECDD(NSPIN), DECDGD(3,NSPIN), |
3809 | - . DEXDD(NSPIN), DEXDGD(3,NSPIN) |
3810 | - |
3811 | -C Internal parameters of the PW86 exchange functional |
3812 | - real(dp),parameter:: a = 0.0864_dp |
3813 | - real(dp),parameter:: b = 14.0_dp |
3814 | - real(dp),parameter:: c = 0.2_dp |
3815 | - |
3816 | -C Call PW86 routine with appropriate values for a, b, and c. |
3817 | - CALL PW86formX( a, b, c, IREL, nspin, Dens, GDens, |
3818 | - . EX, DEXDD, DEXDGD ) |
3819 | - |
3820 | -C Set correlation energy and derivatives to zero |
3821 | - EC = 0 |
3822 | - DECDD(:) = 0 |
3823 | - DECDGD(:,:) = 0 |
3824 | - |
3825 | - END SUBROUTINE PW86X |
3826 | - |
3827 | - |
3828 | - |
3829 | - SUBROUTINE PW86RX( IREL, nspin, Dens, GDens, |
3830 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
3831 | - |
3832 | -C ********************************************************************* |
3833 | -C Implements Perdew-Wang-86 Generalized-Gradient-Approximation |
3834 | -C exchange-only functional with the refitted parameters of |
3835 | -C Murray, Lee, and Langreth. Correlation energy returns as zero. |
3836 | -C Refs: J.P.Perdew & Y.Wang, PRB 33, 8800 (1986) |
3837 | -C E.D.Murray, K.Lee & D.C.Langreth, JCTC 5, 2754 (2009) |
3838 | -C Written by J.M.Soler. March 2010. |
3839 | -C ******** INPUT ****************************************************** |
3840 | -C INTEGER IREL : Relativistic-exchange switch (0=No, 1=Yes) |
3841 | -C INTEGER nspin : Number of spin polarizations (1 or 2) |
3842 | -C REAL*8 Dens(nspin) : Total electron density (if nspin=1) or |
3843 | -C spin electron density (if nspin=2) |
3844 | -C REAL*8 GDens(3,nspin) : Total or spin density gradient |
3845 | -C ******** OUTPUT ***************************************************** |
3846 | -C REAL*8 EX : Exchange energy density |
3847 | -C REAL*8 EC : Correlation energy density |
3848 | -C REAL*8 DEXDD(nspin) : Partial derivative |
3849 | -C d(DensTot*Ex)/dDens(ispin), |
3850 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
3851 | -C For a constant density, this is the |
3852 | -C exchange potential |
3853 | -C REAL*8 DECDD(nspin) : Partial derivative |
3854 | -C d(DensTot*Ec)/dDens(ispin), |
3855 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
3856 | -C For a constant density, this is the |
3857 | -C correlation potential |
3858 | -C REAL*8 DEXDGD(3,nspin): Partial derivative |
3859 | -C d(DensTot*Ex)/d(GradDens(i,ispin)) |
3860 | -C REAL*8 DECDGD(3,nspin): Partial derivative |
3861 | -C d(DensTot*Ec)/d(GradDens(i,ispin)) |
3862 | -C ********* UNITS **************************************************** |
3863 | -C Lengths in Bohr |
3864 | -C Densities in electrons per Bohr**3 |
3865 | -C Energies in Hartrees |
3866 | -C Gradient vectors in cartesian coordinates |
3867 | -C ********* ROUTINES CALLED ****************************************** |
3868 | -C PW86formX |
3869 | -C ******************************************************************** |
3870 | - |
3871 | - IMPLICIT NONE |
3872 | - |
3873 | -C Passed arguments |
3874 | - integer, intent(in) :: IREL, NSPIN |
3875 | - real(dp),intent(in) :: DENS(NSPIN), GDENS(3,NSPIN) |
3876 | - real(dp),intent(out):: EX, EC, DECDD(NSPIN), DECDGD(3,NSPIN), |
3877 | - . DEXDD(NSPIN), DEXDGD(3,NSPIN) |
3878 | - |
3879 | -C Internal parameters of the refitted PW86 exchange functional |
3880 | - real(dp),parameter:: a = 0.1234_dp |
3881 | - real(dp),parameter:: b = 17.33_dp |
3882 | - real(dp),parameter:: c = 0.163_dp |
3883 | - |
3884 | -C Call PW86 routine with appropriate values for a, b, and c. |
3885 | - CALL PW86formX( a, b, c, IREL, nspin, Dens, GDens, |
3886 | - . EX, DEXDD, DEXDGD ) |
3887 | - |
3888 | -C Set correlation energy and derivatives to zero |
3889 | - EC = 0 |
3890 | - DECDD(:) = 0 |
3891 | - DECDGD(:,:) = 0 |
3892 | - |
3893 | - END SUBROUTINE PW86RX |
3894 | - |
3895 | - |
3896 | - SUBROUTINE BHX( IREL, nspin, Dens, GDens, |
3897 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
3898 | - |
3899 | -C ********************************************************************* |
3900 | -C Implements the combination by Berland and Hyldgaard of Perdew-Wang-86 |
3901 | -C Generalized-Gradient-Approximation exchange-only functional with the |
3902 | -C refitted parameters of Murray, Lee, and Langreth and Langreth-Vosko |
3903 | -C screened exchange. Correlation energy returns as zero. |
3904 | -C Refs: J.P.Perdew & Y.Wang, PRB 33, 8800 (1986) |
3905 | -C E.D.Murray, K.Lee & D.C.Langreth, JCTC 5, 2754 (2009) |
3906 | -C K.Berland & P.Hyldgaard, PRB 89, 035412 (2014) |
3907 | -C Written by Michelle Fritz Feb. 2014. |
3908 | -C ******** INPUT ****************************************************** |
3909 | -C INTEGER IREL : Relativistic-exchange switch (0=No, 1=Yes) |
3910 | -C INTEGER NSPIN : Number of spin polarizations (1 or 2) |
3911 | -C REAL*8 DENS(nspin) : Total electron density (if nspin=1) or |
3912 | -C spin electron density (if nspin=2) |
3913 | -C REAL*8 GDens(3,nspin) : Total or spin density gradient |
3914 | -C ******** OUTPUT ***************************************************** |
3915 | -C REAL*8 EX : Exchange energy density |
3916 | -C REAL*8 EC : Correlation energy density |
3917 | -C REAL*8 DEXDD(nspin) : Partial derivative |
3918 | -C d(DensTot*Ex)/dDens(ispin), |
3919 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
3920 | -C For a constant density, this is the |
3921 | -C exchange potential |
3922 | -C REAL*8 DECDD(nspin) : Partial derivative |
3923 | -C d(DensTot*Ec)/dDens(ispin), |
3924 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
3925 | -C For a constant density, this is the |
3926 | -C correlation potential |
3927 | -C REAL*8 DEXDGD(3,nspin): Partial derivative |
3928 | -C d(DensTot*Ex)/d(GradDens(i,ispin)) |
3929 | -C REAL*8 DECDGD(3,nspin): Partial derivative |
3930 | -C d(DensTot*Ec)/d(GradDens(i,ispin)) |
3931 | -C ********* UNITS **************************************************** |
3932 | -C Lengths in Bohr |
3933 | -C Densities in electrons per Bohr**3 |
3934 | -C Energies in Hartrees |
3935 | -C Gradient vectors in cartesian coordinates |
3936 | -C ********* ROUTINES CALLED ****************************************** |
3937 | -C EXCHNG |
3938 | -C ******************************************************************** |
3939 | - |
3940 | - IMPLICIT NONE |
3941 | - |
3942 | -C Passed arguments |
3943 | - integer, intent(in) :: IREL, NSPIN |
3944 | - real(dp),intent(in) :: DENS(NSPIN), GDENS(3,NSPIN) |
3945 | - real(dp),intent(out):: EX, EC, DECDD(NSPIN), DECDGD(3,NSPIN), |
3946 | - . DEXDD(NSPIN), DEXDGD(3,NSPIN) |
3947 | - |
3948 | -C Internal variables |
3949 | - INTEGER |
3950 | - . IS, IX |
3951 | - real(dp) |
3952 | - . D(2), DENMIN, DF1DS, DFDD, DFDGD, DFDS, DFLVDS, DFPW86RDS, |
3953 | - . DFXDD(2), DFXDGD(3,2), DKFDD, DS(2), DSDD, DSDGD, DT, ECUNIF, |
3954 | - . EXUNIF, FPW86R, FLV, F, F1, FX, GD(3,2), GDM(2), GDMIN, GDMS, |
3955 | - . GDMT, GDS, GDT(3), KFS, PI, S, VXUNIF(2), ZETA, MLV |
3956 | - |
3957 | -C Internal parameters of the refitted PW86 exchange functional |
3958 | - real(dp),parameter:: a = 0.1234_dp |
3959 | - real(dp),parameter:: b = 17.33_dp |
3960 | - real(dp),parameter:: c = 0.163_dp |
3961 | - real(dp),parameter:: zab = -0.8491_dp |
3962 | - real(dp),parameter:: alpha = 0.02178_dp |
3963 | - real(dp),parameter:: beta = 1.15_dp |
3964 | - |
3965 | -C Lower bounds of density and its gradient to avoid divisions by zero |
3966 | - PARAMETER ( DENMIN = 1.D-12 ) |
3967 | - PARAMETER ( GDMIN = 1.D-12 ) |
3968 | - |
3969 | -C Fix some more numerical constants |
3970 | - PI = 4 * ATAN(1.D0) |
3971 | - |
3972 | -C Translate density and its gradient to new variables |
3973 | - IF (NSPIN .EQ. 1) THEN |
3974 | - D(1) = DENS(1) / 2 |
3975 | - D(2) = D(1) |
3976 | - DT = MAX( DENMIN, DENS(1) ) |
3977 | - DO 10 IX = 1,3 |
3978 | - GD(IX,1) = GDENS(IX,1) / 2 |
3979 | - GD(IX,2) = GD(IX,1) |
3980 | - GDT(IX) = GDENS(IX,1) |
3981 | - 10 CONTINUE |
3982 | - ELSE |
3983 | - D(1) = DENS(1) |
3984 | - D(2) = DENS(2) |
3985 | - DT = MAX( DENMIN, DENS(1)+DENS(2) ) |
3986 | - DO 20 IX = 1,3 |
3987 | - GD(IX,1) = GDENS(IX,1) |
3988 | - GD(IX,2) = GDENS(IX,2) |
3989 | - GDT(IX) = GDENS(IX,1) + GDENS(IX,2) |
3990 | - 20 CONTINUE |
3991 | - ENDIF |
3992 | - GDM(1) = SQRT( GD(1,1)**2 + GD(2,1)**2 + GD(3,1)**2 ) |
3993 | - GDM(2) = SQRT( GD(1,2)**2 + GD(2,2)**2 + GD(3,2)**2 ) |
3994 | - GDMT = SQRT( GDT(1)**2 + GDT(2)**2 + GDT(3)**2 ) |
3995 | - GDMT = MAX( GDMIN, GDMT ) |
3996 | - |
3997 | -C Find exchange energy and potential |
3998 | - FX = 0 |
3999 | - DO 60 IS = 1,2 |
4000 | - DS(IS) = MAX( DENMIN, 2 * D(IS) ) |
4001 | - GDMS = MAX( GDMIN, 2 * GDM(IS) ) |
4002 | - KFS = (3 * PI**2 * DS(IS))**(1._dp/3) |
4003 | - S = GDMS / (2 * KFS * DS(IS)) |
4004 | - F1 = 1 + 15*a*S**2 + b*S**4 + c*S**6 |
4005 | - FPW86R = F1**(1._dp/15) |
4006 | - MLV = -zab/9._dp |
4007 | - FLV = 1 + MLV*S**2 |
4008 | - F = (1 / (1 + alpha*S**6)) * FLV |
4009 | - F = F + ((alpha*S**6) / (beta + alpha*S**6)) * FPW86R |
4010 | - |
4011 | -c |
4012 | -c Note nspin=1 in call to exchng... |
4013 | -c |
4014 | - CALL EXCHNG( IREL, 1, DS(IS), EXUNIF, VXUNIF(IS) ) |
4015 | - FX = FX + DS(IS) * EXUNIF * F |
4016 | - |
4017 | - DKFDD = KFS / DS(IS) / 3 |
4018 | - DSDD = S * ( -(DKFDD/KFS) - 1/DS(IS) ) |
4019 | - DF1DS = 30*a*S + 4*b*S**3 + 6*c*S**5 |
4020 | - DFLVDS = 2*MLV*S |
4021 | - DFPW86RDS = FPW86R/F1/15 * DF1DS |
4022 | - DFDS = -((6*alpha*S**5) / (1 + alpha*S**6)**2) * FLV |
4023 | - DFDS = DFDS + (1 / (1 + alpha*S**6)) * DFLVDS |
4024 | - DFDS = DFDS + ((6*alpha*S**5) / (beta + alpha*S**6)) * FPW86R |
4025 | - DFDS =DFDS-((6*alpha**2*S**11)/(beta + alpha*S**6)**2)*FPW86R |
4026 | - DFDS = DFDS + ((alpha*S**6) / (beta + alpha*S**6)) * DFPW86RDS |
4027 | - DFDD = DFDS * DSDD |
4028 | - DFXDD(IS) = VXUNIF(IS) * F + DS(IS) * EXUNIF * DFDD |
4029 | - |
4030 | - DO 50 IX = 1,3 |
4031 | - GDS = 2 * GD(IX,IS) |
4032 | - DSDGD = (S / GDMS) * GDS / GDMS |
4033 | - DFDGD = DFDS * DSDGD |
4034 | - DFXDGD(IX,IS) = DS(IS) * EXUNIF * DFDGD |
4035 | - 50 CONTINUE |
4036 | - 60 CONTINUE |
4037 | - FX = FX / DT / 2 |
4038 | - |
4039 | - EX = FX |
4040 | - DO 90 IS = 1,NSPIN |
4041 | - DEXDD(IS) = DFXDD(IS) |
4042 | - DO 80 IX = 1,3 |
4043 | - DEXDGD(IX,IS) = DFXDGD(IX,IS) |
4044 | - 80 CONTINUE |
4045 | - 90 CONTINUE |
4046 | - |
4047 | -C Set correlation energy and derivatives to zero |
4048 | - EC = 0 |
4049 | - DECDD(:) = 0 |
4050 | - DECDGD(:,:) = 0 |
4051 | - |
4052 | - END SUBROUTINE BHX |
4053 | - |
4054 | - |
4055 | - SUBROUTINE B88formX( beta, mu, c, iRel, nSpin, Dens, GDens, |
4056 | - . EX, dEXdD, dEXdGD ) |
4057 | - |
4058 | -C ********************************************************************* |
4059 | -C Implements Becke-88 Generalized-Gradient-Approximation exchange-only |
4060 | -C functional form, eps_x=eps_x_LDA*(1+mu*s**2/(1+beta*s*asinh(c*s))), |
4061 | -C but with variable values for parameters beta, mu, and c |
4062 | -C Refs: A.D.Becke, PRA 38, 3098 (1988) |
4063 | -C J.Klimes, D.R.Bowler, and A.Michaelides, JPCM 22, 022201 (2009) |
4064 | -C Written by J.M.Soler. April 2010. |
4065 | -C ******** INPUT ****************************************************** |
4066 | -C REAL*8 beta, mu, c : Parameter beta mu, and c of the B88 functional, |
4067 | -C as formulated by Klimes et al |
4068 | -C INTEGER IREL : Relativistic-exchange switch (0=No, 1=Yes) |
4069 | -C INTEGER nspin : Number of spin polarizations (1 or 2) |
4070 | -C REAL*8 Dens(nspin) : Total electron density (if nspin=1) or |
4071 | -C spin electron density (if nspin=2) |
4072 | -C REAL*8 GDens(3,nspin) : Total or spin density gradient |
4073 | -C ******** OUTPUT ***************************************************** |
4074 | -C REAL*8 EX : Exchange energy density |
4075 | -C REAL*8 DEXDD(nspin) : Partial derivative |
4076 | -C d(DensTot*Ex)/dDens(ispin), |
4077 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
4078 | -C For a constant density, this is the |
4079 | -C exchange potential |
4080 | -C REAL*8 DEXDGD(3,nspin): Partial derivative |
4081 | -C d(DensTot*Ex)/d(GradDens(i,ispin)) |
4082 | -C ********* UNITS **************************************************** |
4083 | -C Lengths in Bohr |
4084 | -C Densities in electrons per Bohr**3 |
4085 | -C Energies in Hartrees |
4086 | -C Gradient vectors in cartesian coordinates |
4087 | -C ********* ROUTINES CALLED ****************************************** |
4088 | -C EXCHNG |
4089 | -C ******************************************************************** |
4090 | - |
4091 | - implicit none |
4092 | - |
4093 | -C Input |
4094 | - real(dp),intent(in) :: beta ! Parameter of B88 functional |
4095 | - real(dp),intent(in) :: mu ! Parameter of B88 functional |
4096 | - real(dp),intent(in) :: c ! Parameter of B88 functional |
4097 | - integer, intent(in) :: iRel ! Relativistic exchange? 0=no, 1=yes |
4098 | - integer, intent(in) :: nSpin ! Number of spin components |
4099 | - real(dp),intent(in) :: Dens(nSpin) ! Local electron (spin) density |
4100 | - real(dp),intent(in) :: GDens(3,nSpin) ! Gradient of electron density |
4101 | - |
4102 | -C Output |
4103 | - real(dp),intent(out):: EX ! Exchange energy per electron |
4104 | - real(dp),intent(out):: dEXdD(nSpin) ! dEx/dDens, Ex=Int(dens*epsX) |
4105 | - real(dp),intent(out):: dEXdGD(3,nSpin) ! dEx/dGrad(Dens) |
4106 | - |
4107 | -C Internal variables |
4108 | - INTEGER |
4109 | - . IS, IX |
4110 | - real(dp) |
4111 | - . ASINHCS, CS, D(2), DASINHDS, |
4112 | - . DENMIN, DF1DS, DFDD, DFDGD, DFDS, DFXDD(2), DFXDGD(3,2), |
4113 | - . DKFDD, DS(2), DSDD, DSDGD, DT, ECUNIF, EXUNIF, F, F1, FX, |
4114 | - . GD(3,2), GDM(2), GDMIN, GDMS, GDMT, GDS, GDT(3), |
4115 | - . KFS, PI, S, VXUNIF(2), ZETA |
4116 | - |
4117 | -C Lower bounds of density and its gradient to avoid divisions by zero |
4118 | - PARAMETER ( DENMIN = 1.D-12 ) |
4119 | - PARAMETER ( GDMIN = 1.D-12 ) |
4120 | - |
4121 | -C Fix some more numerical constants |
4122 | - PI = 4 * ATAN(1.D0) |
4123 | - |
4124 | -C Translate density and its gradient to new variables |
4125 | - IF (nspin .EQ. 1) THEN |
4126 | - D(1) = Dens(1) / 2 |
4127 | - D(2) = D(1) |
4128 | - DT = MAX( DENMIN, Dens(1) ) |
4129 | - DO 10 IX = 1,3 |
4130 | - GD(IX,1) = GDens(IX,1) / 2 |
4131 | - GD(IX,2) = GD(IX,1) |
4132 | - GDT(IX) = GDens(IX,1) |
4133 | - 10 CONTINUE |
4134 | - ELSE |
4135 | - D(1) = Dens(1) |
4136 | - D(2) = Dens(2) |
4137 | - DT = MAX( DENMIN, Dens(1)+Dens(2) ) |
4138 | - DO 20 IX = 1,3 |
4139 | - GD(IX,1) = GDens(IX,1) |
4140 | - GD(IX,2) = GDens(IX,2) |
4141 | - GDT(IX) = GDens(IX,1) + GDens(IX,2) |
4142 | - 20 CONTINUE |
4143 | - ENDIF |
4144 | - GDM(1) = SQRT( GD(1,1)**2 + GD(2,1)**2 + GD(3,1)**2 ) |
4145 | - GDM(2) = SQRT( GD(1,2)**2 + GD(2,2)**2 + GD(3,2)**2 ) |
4146 | - GDMT = SQRT( GDT(1)**2 + GDT(2)**2 + GDT(3)**2 ) |
4147 | - GDMT = MAX( GDMIN, GDMT ) |
4148 | - |
4149 | -C Find exchange energy and potential |
4150 | - FX = 0 |
4151 | - DO 60 IS = 1,2 |
4152 | - DS(IS) = MAX( DENMIN, 2 * D(IS) ) |
4153 | - GDMS = MAX( GDMIN, 2 * GDM(IS) ) |
4154 | - KFS = (3 * PI**2 * DS(IS))**(1._dp/3) |
4155 | - S = GDMS / (2 * KFS * DS(IS)) |
4156 | - CS = C * S |
4157 | - ! Next line is ASINH(CS). See Numerical Recipes |
4158 | - ASINHCS = log(CS+sqrt(CS**2+1)) |
4159 | - F1 = 1 + beta * S * ASINHCS |
4160 | - F = 1 + mu * S**2 / F1 |
4161 | -c |
4162 | -c Note nspin=1 in call to exchng... |
4163 | -c |
4164 | - CALL EXCHNG( IREL, 1, DS(IS), EXUNIF, VXUNIF(IS) ) |
4165 | - FX = FX + DS(IS) * EXUNIF * F |
4166 | - |
4167 | - DKFDD = KFS / DS(IS) / 3 |
4168 | - DSDD = S * ( -(DKFDD/KFS) - 1/DS(IS) ) |
4169 | - DASINHDS = C * (1 + CS/sqrt(CS**2+1)) / (CS+sqrt(CS**2+1)) |
4170 | - DF1DS = beta * ASINHCS + beta * S * DASINHDS |
4171 | - DFDS = 2*mu*S/F1 - mu*S**2/F1**2 * DF1DS |
4172 | - DFDD = DFDS * DSDD |
4173 | - DFXDD(IS) = VXUNIF(IS) * F + DS(IS) * EXUNIF * DFDD |
4174 | - |
4175 | - DO 50 IX = 1,3 |
4176 | - GDS = 2 * GD(IX,IS) |
4177 | - DSDGD = (S / GDMS) * GDS / GDMS |
4178 | - DFDGD = DFDS * DSDGD |
4179 | - DFXDGD(IX,IS) = DS(IS) * EXUNIF * DFDGD |
4180 | - 50 CONTINUE |
4181 | - 60 CONTINUE |
4182 | - FX = FX / DT / 2 |
4183 | - |
4184 | -C Set output arguments |
4185 | - EX = FX |
4186 | - DO 90 IS = 1,nspin |
4187 | - DEXDD(IS) = DFXDD(IS) |
4188 | - DO 80 IX = 1,3 |
4189 | - DEXDGD(IX,IS) = DFXDGD(IX,IS) |
4190 | - 80 CONTINUE |
4191 | - 90 CONTINUE |
4192 | - |
4193 | - END SUBROUTINE B88formX |
4194 | - |
4195 | - |
4196 | - |
4197 | - SUBROUTINE B88X( IREL, nspin, Dens, GDens, |
4198 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
4199 | - |
4200 | -C ********************************************************************* |
4201 | -C Implements Becke-88 Generalized-Gradient-Approximation |
4202 | -C exchange-only functional. Correlation energy returns as zero. |
4203 | -C Refs: A.D.Becke, PRA 38, 3098 (1988) |
4204 | -C J.Klimes, D.R.Bowler, and A.Michaelides, JPCM 22, 022201 (2009) |
4205 | -C Written by J.M.Soler. April 2010. |
4206 | -C ******** INPUT ****************************************************** |
4207 | -C INTEGER IREL : Relativistic-exchange switch (0=No, 1=Yes) |
4208 | -C INTEGER nspin : Number of spin polarizations (1 or 2) |
4209 | -C REAL*8 Dens(nspin) : Total electron density (if nspin=1) or |
4210 | -C spin electron density (if nspin=2) |
4211 | -C REAL*8 GDens(3,nspin) : Total or spin density gradient |
4212 | -C ******** OUTPUT ***************************************************** |
4213 | -C REAL*8 EX : Exchange energy density |
4214 | -C REAL*8 EC : Correlation energy density |
4215 | -C REAL*8 DEXDD(nspin) : Partial derivative |
4216 | -C d(DensTot*Ex)/dDens(ispin), |
4217 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
4218 | -C For a constant density, this is the |
4219 | -C exchange potential |
4220 | -C REAL*8 DECDD(nspin) : Partial derivative |
4221 | -C d(DensTot*Ec)/dDens(ispin), |
4222 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
4223 | -C For a constant density, this is the |
4224 | -C correlation potential |
4225 | -C REAL*8 DEXDGD(3,nspin): Partial derivative |
4226 | -C d(DensTot*Ex)/d(GradDens(i,ispin)) |
4227 | -C REAL*8 DECDGD(3,nspin): Partial derivative |
4228 | -C d(DensTot*Ec)/d(GradDens(i,ispin)) |
4229 | -C ********* UNITS **************************************************** |
4230 | -C Lengths in Bohr |
4231 | -C Densities in electrons per Bohr**3 |
4232 | -C Energies in Hartrees |
4233 | -C Gradient vectors in cartesian coordinates |
4234 | -C ********* ROUTINES CALLED ****************************************** |
4235 | -C PW86formX |
4236 | -C ******************************************************************** |
4237 | - |
4238 | - IMPLICIT NONE |
4239 | - |
4240 | -C Passed arguments |
4241 | - integer, intent(in) :: IREL, NSPIN |
4242 | - real(dp),intent(in) :: DENS(NSPIN), GDENS(3,NSPIN) |
4243 | - real(dp),intent(out):: EX, EC, DECDD(NSPIN), DECDGD(3,NSPIN), |
4244 | - . DEXDD(NSPIN), DEXDGD(3,NSPIN) |
4245 | - |
4246 | -C Internal variables and arrays |
4247 | - real(dp):: beta, c, mu, pi |
4248 | - |
4249 | -C Internal parameters of the B88 exchange functional, written as |
4250 | -C by Klimes et al |
4251 | - pi = acos(-1._dp) |
4252 | - c = 2*(6*pi**2)**(1._dp/3) |
4253 | - mu = 0.2743_dp |
4254 | - beta = 9 * mu * (6/pi)**(1._dp/3) / (2*c) |
4255 | - |
4256 | -C Call PW86 routine with appropriate values for a, b, and c. |
4257 | - CALL B88formX( beta, mu, c, IREL, nspin, Dens, GDens, |
4258 | - . EX, DEXDD, DEXDGD ) |
4259 | - |
4260 | -C Set correlation energy and derivatives to zero |
4261 | - EC = 0 |
4262 | - DECDD(:) = 0 |
4263 | - DECDGD(:,:) = 0 |
4264 | - |
4265 | - END SUBROUTINE B88X |
4266 | - |
4267 | - |
4268 | - |
4269 | - SUBROUTINE B88KBMX( IREL, nspin, Dens, GDens, |
4270 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
4271 | - |
4272 | -C ********************************************************************* |
4273 | -C Implements Becke-88 GGA exchange functional, reparametrized by Klimes |
4274 | -C et al for its combined use with vdW-DF nonlocal correlation. |
4275 | -C Correlation energy returns as zero. |
4276 | -C Refs: A.D.Becke, PRA 38, 3098 (1988) |
4277 | -C J.Klimes, D.R.Bowler, and A.Michaelides, JPCM 22, 022201 (2009) |
4278 | -C Written by J.M.Soler. April 2010. |
4279 | -C ******** INPUT ****************************************************** |
4280 | -C INTEGER IREL : Relativistic-exchange switch (0=No, 1=Yes) |
4281 | -C INTEGER nspin : Number of spin polarizations (1 or 2) |
4282 | -C REAL*8 Dens(nspin) : Total electron density (if nspin=1) or |
4283 | -C spin electron density (if nspin=2) |
4284 | -C REAL*8 GDens(3,nspin) : Total or spin density gradient |
4285 | -C ******** OUTPUT ***************************************************** |
4286 | -C REAL*8 EX : Exchange energy density |
4287 | -C REAL*8 EC : Correlation energy density |
4288 | -C REAL*8 DEXDD(nspin) : Partial derivative |
4289 | -C d(DensTot*Ex)/dDens(ispin), |
4290 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
4291 | -C For a constant density, this is the |
4292 | -C exchange potential |
4293 | -C REAL*8 DECDD(nspin) : Partial derivative |
4294 | -C d(DensTot*Ec)/dDens(ispin), |
4295 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
4296 | -C For a constant density, this is the |
4297 | -C correlation potential |
4298 | -C REAL*8 DEXDGD(3,nspin): Partial derivative |
4299 | -C d(DensTot*Ex)/d(GradDens(i,ispin)) |
4300 | -C REAL*8 DECDGD(3,nspin): Partial derivative |
4301 | -C d(DensTot*Ec)/d(GradDens(i,ispin)) |
4302 | -C ********* UNITS **************************************************** |
4303 | -C Lengths in Bohr |
4304 | -C Densities in electrons per Bohr**3 |
4305 | -C Energies in Hartrees |
4306 | -C Gradient vectors in cartesian coordinates |
4307 | -C ********* ROUTINES CALLED ****************************************** |
4308 | -C PW86formX |
4309 | -C ******************************************************************** |
4310 | - |
4311 | - IMPLICIT NONE |
4312 | - |
4313 | -C Passed arguments |
4314 | - integer, intent(in) :: IREL, NSPIN |
4315 | - real(dp),intent(in) :: DENS(NSPIN), GDENS(3,NSPIN) |
4316 | - real(dp),intent(out):: EX, EC, DECDD(NSPIN), DECDGD(3,NSPIN), |
4317 | - . DEXDD(NSPIN), DEXDGD(3,NSPIN) |
4318 | - |
4319 | -C Internal variables and arrays |
4320 | - real(dp):: beta, c, mu, pi |
4321 | - |
4322 | -C Klimes et al parameters for the B88 exchange functional |
4323 | - pi = acos(-1._dp) |
4324 | - c = 2*(6*pi**2)**(1._dp/3) |
4325 | - mu = 0.22_dp |
4326 | - beta = mu / 1.2_dp |
4327 | - |
4328 | -C Call PW86 routine with appropriate values for a, b, and c. |
4329 | - CALL B88formX( beta, mu, c, IREL, nspin, Dens, GDens, |
4330 | - . EX, DEXDD, DEXDGD ) |
4331 | - |
4332 | -C Set correlation energy and derivatives to zero |
4333 | - EC = 0 |
4334 | - DECDD(:) = 0 |
4335 | - DECDGD(:,:) = 0 |
4336 | - |
4337 | - END SUBROUTINE B88KBMX |
4338 | - |
4339 | - |
4340 | - SUBROUTINE C09X( IREL, nspin, Dens, GDens, |
4341 | - . EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
4342 | - |
4343 | -C ********************************************************************* |
4344 | -C Implements Cooper-09 exchange-only GGA (for use with vdW-DF1 correlation). |
4345 | -C Correlation energy returns as zero. |
4346 | -C Ref: V.R.Cooper, PRB 81, 161104(R) (2010) |
4347 | -C Written by J.M.Soler. April 2010. |
4348 | -C ******** INPUT ****************************************************** |
4349 | -C INTEGER IREL : Relativistic-exchange switch (0=No, 1=Yes) |
4350 | -C INTEGER nspin : Number of spin polarizations (1 or 2) |
4351 | -C REAL*8 Dens(nspin) : Total electron density (if nspin=1) or |
4352 | -C spin electron density (if nspin=2) |
4353 | -C REAL*8 GDens(3,nspin) : Total or spin density gradient |
4354 | -C ******** OUTPUT ***************************************************** |
4355 | -C REAL*8 EX : Exchange energy density |
4356 | -C REAL*8 EC : Correlation energy density |
4357 | -C REAL*8 DEXDD(nspin) : Partial derivative |
4358 | -C d(DensTot*Ex)/dDens(ispin), |
4359 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
4360 | -C For a constant density, this is the |
4361 | -C exchange potential |
4362 | -C REAL*8 DECDD(nspin) : Partial derivative |
4363 | -C d(DensTot*Ec)/dDens(ispin), |
4364 | -C where DensTot = Sum_ispin( Dens(ispin) ) |
4365 | -C For a constant density, this is the |
4366 | -C correlation potential |
4367 | -C REAL*8 DEXDGD(3,nspin): Partial derivative |
4368 | -C d(DensTot*Ex)/d(GradDens(i,ispin)) |
4369 | -C REAL*8 DECDGD(3,nspin): Partial derivative |
4370 | -C d(DensTot*Ec)/d(GradDens(i,ispin)) |
4371 | -C ********* UNITS **************************************************** |
4372 | -C Lengths in Bohr |
4373 | -C Densities in electrons per Bohr**3 |
4374 | -C Energies in Hartrees |
4375 | -C Gradient vectors in cartesian coordinates |
4376 | -C ********* ROUTINES CALLED ****************************************** |
4377 | -C none |
4378 | -C ******************************************************************** |
4379 | - |
4380 | - IMPLICIT NONE |
4381 | - |
4382 | -C Passed arguments |
4383 | - integer, intent(in) :: IREL, NSPIN |
4384 | - real(dp),intent(in) :: DENS(NSPIN), GDENS(3,NSPIN) |
4385 | - real(dp),intent(out):: EX, EC, DECDD(NSPIN), DECDGD(3,NSPIN), |
4386 | - . DEXDD(NSPIN), DEXDGD(3,NSPIN) |
4387 | - |
4388 | -C Internal variables and arrays (V.R.Cooper, PRB 81, 161104(R) (2010)) |
4389 | - real(dp),parameter:: alpha = 0.0483_dp |
4390 | - real(dp),parameter:: kappa = 1.245_dp |
4391 | - real(dp),parameter:: mu = 0.0617 |
4392 | - |
4393 | -C Internal variables |
4394 | - INTEGER |
4395 | - . IS, IX |
4396 | - real(dp) |
4397 | - . D(2), DENMIN, DES2DS, DF1DS, DFDD, DFDGD, DFDS, |
4398 | - . DFXDD(2), DFXDGD(3,2), DKFDD, DS(2), DSDD, DSDGD, DT, |
4399 | - . ECUNIF, ES2, EXUNIF, F, FX, |
4400 | - . GD(3,2), GDM(2), GDMIN, GDMS, GDMT, GDS, GDT(3), |
4401 | - . KFS, PI, S, S2, VXUNIF(2) |
4402 | - |
4403 | -C Lower bounds of density and its gradient to avoid divisions by zero |
4404 | - PARAMETER ( DENMIN = 1.D-12 ) |
4405 | - PARAMETER ( GDMIN = 1.D-12 ) |
4406 | - |
4407 | -C Fix some more numerical constants |
4408 | - PI = 4 * ATAN(1.D0) |
4409 | - |
4410 | -C Translate density and its gradient to new variables |
4411 | - IF (nspin .EQ. 1) THEN |
4412 | - D(1) = Dens(1) / 2 |
4413 | - D(2) = D(1) |
4414 | - DT = MAX( DENMIN, Dens(1) ) |
4415 | - DO 10 IX = 1,3 |
4416 | - GD(IX,1) = GDens(IX,1) / 2 |
4417 | - GD(IX,2) = GD(IX,1) |
4418 | - GDT(IX) = GDens(IX,1) |
4419 | - 10 CONTINUE |
4420 | - ELSE |
4421 | - D(1) = Dens(1) |
4422 | - D(2) = Dens(2) |
4423 | - DT = MAX( DENMIN, Dens(1)+Dens(2) ) |
4424 | - DO 20 IX = 1,3 |
4425 | - GD(IX,1) = GDens(IX,1) |
4426 | - GD(IX,2) = GDens(IX,2) |
4427 | - GDT(IX) = GDens(IX,1) + GDens(IX,2) |
4428 | - 20 CONTINUE |
4429 | - ENDIF |
4430 | - GDM(1) = SQRT( GD(1,1)**2 + GD(2,1)**2 + GD(3,1)**2 ) |
4431 | - GDM(2) = SQRT( GD(1,2)**2 + GD(2,2)**2 + GD(3,2)**2 ) |
4432 | - GDMT = SQRT( GDT(1)**2 + GDT(2)**2 + GDT(3)**2 ) |
4433 | - GDMT = MAX( GDMIN, GDMT ) |
4434 | - |
4435 | -C Find exchange energy and potential |
4436 | - FX = 0 |
4437 | - DO 60 IS = 1,2 |
4438 | - DS(IS) = MAX( DENMIN, 2 * D(IS) ) |
4439 | - GDMS = MAX( GDMIN, 2 * GDM(IS) ) |
4440 | - KFS = (3 * PI**2 * DS(IS))**(1._dp/3) |
4441 | - S = GDMS / (2 * KFS * DS(IS)) |
4442 | - S2 = S**2 |
4443 | - |
4444 | - ! Next lines are the core of the C09 functional |
4445 | - ES2 = exp(-alpha*S2/2) |
4446 | - F = 1 + mu*S2*ES2**2 + kappa*(1-ES2) |
4447 | - DES2DS = -alpha*S*ES2 |
4448 | - DFDS = 2*mu*S*ES2**2 + 2*mu*S2*ES2*DES2DS - kappa*DES2DS |
4449 | - |
4450 | - ! Note nspin=1 in call to exchng... |
4451 | - CALL EXCHNG( IREL, 1, DS(IS), EXUNIF, VXUNIF(IS) ) |
4452 | - FX = FX + DS(IS) * EXUNIF * F |
4453 | - |
4454 | - DKFDD = KFS / DS(IS) / 3 |
4455 | - DSDD = S * ( -(DKFDD/KFS) - 1/DS(IS) ) |
4456 | - DFDD = DFDS * DSDD |
4457 | - DFXDD(IS) = VXUNIF(IS) * F + DS(IS) * EXUNIF * DFDD |
4458 | - |
4459 | - DO 50 IX = 1,3 |
4460 | - GDS = 2 * GD(IX,IS) |
4461 | - DSDGD = (S / GDMS) * GDS / GDMS |
4462 | - DFDGD = DFDS * DSDGD |
4463 | - DFXDGD(IX,IS) = DS(IS) * EXUNIF * DFDGD |
4464 | - 50 CONTINUE |
4465 | - 60 CONTINUE |
4466 | - FX = FX / DT / 2 |
4467 | - |
4468 | -C Set output arguments |
4469 | - EX = FX |
4470 | - DO 90 IS = 1,nspin |
4471 | - DEXDD(IS) = DFXDD(IS) |
4472 | - DO 80 IX = 1,3 |
4473 | - DEXDGD(IX,IS) = DFXDGD(IX,IS) |
4474 | - 80 CONTINUE |
4475 | - 90 CONTINUE |
4476 | - |
4477 | -C Set correlation energy and derivatives to zero |
4478 | - EC = 0 |
4479 | - DECDD(:) = 0 |
4480 | - DECDGD(:,:) = 0 |
4481 | - |
4482 | - END SUBROUTINE C09X |
4483 | - |
4484 | - END MODULE m_ggaxc |
4485 | + enddo |
4486 | + |
4487 | + ! Lee-Yang-Parr correlation energy |
4488 | + den=1+dd*dt**(-thd) |
4489 | + omega=dt**(-onzthd)*exp(-c*dt**(-thd))/den |
4490 | + delta=c*dt**(-thd)+dd*dt**(-thd)/den |
4491 | + cf=3.*(3*pi**2)**tthd/10. |
4492 | + gam11=gdm(1)**2 |
4493 | + gam12=gd(1,1)*gd(1,2)+gd(2,1)*gd(2,2)+gd(3,1)*gd(3,2) |
4494 | + gam22=gdm(2)**2 |
4495 | + LYPa=-4*a*d(1)*d(2)/(den*dt) |
4496 | + LYPb1=2**onzthd*cf*a*b*omega*d(1)*d(2) |
4497 | + LYPb2=d(1)**(8./3.)+d(2)**(8./3.) |
4498 | + dLYP11=-a*b*omega*(d(1)*d(2)/9.*(1.-3.*delta-(delta-11.) & |
4499 | + *d(1)/dt)-d(2)**2) |
4500 | + dLYP12=-a*b*omega*(d(1)*d(2)/9.*(47.-7.*delta) & |
4501 | + -fothd*dt**2) |
4502 | + dLYP22=-a*b*omega*(d(1)*d(2)/9.*(1.-3.*delta-(delta-11.)* & |
4503 | + d(2)/dt)-d(1)**2) |
4504 | + |
4505 | + ! Density of energy |
4506 | + LYP=(LYPa-LYPb1*LYPb2+dLYP11*gam11+dLYP12*gam12 & |
4507 | + +dLYP22*gam22)/dt |
4508 | + |
4509 | + ! Correlation energy derivatives |
4510 | + domega=-thd*dt**(-fothd)*omega*(11.*dt**thd-c-dd/den) |
4511 | + ddelta=thd*(dd**2*dt**(-5./3.)/den**2-delta/dt) |
4512 | + |
4513 | + ! Second derivatives with respect to the density |
4514 | + dd1g11=domega/omega*dLYP11-a*b*omega*(d(2)/9.* & |
4515 | + (1.-3.*delta-2*(delta-11.)*d(1)/dt)-d(1)*d(2)/9.* & |
4516 | + ((3.+d(1)/dt)*ddelta-(delta-11.)*d(1)/dt**2)) |
4517 | + |
4518 | + dd1g12=domega/omega*dLYP12-a*b*omega*(d(2)/9.* & |
4519 | + (47.-7.*delta)-7./9.*d(1)*d(2)*ddelta-8./3.*dt) |
4520 | + |
4521 | + dd1g22=domega/omega*dLYP22-a*b*omega*(1./9.*d(2) & |
4522 | + *(1.-3.*delta-(delta-11.)*d(2)/dt)-d(1)*d(2)/9.* & |
4523 | + ((3.+d(2)/dt)*ddelta-(delta-11.)*d(2)/dt**2)-2*d(1)) |
4524 | + |
4525 | + dd2g22=domega/omega*dLYP22-a*b*omega*(d(1)/9.* & |
4526 | + (1.-3.*delta-2*(delta-11.)*d(2)/dt)-d(1)*d(2)/9.* & |
4527 | + ((3+d(2)/dt)*ddelta-(delta-11.)*d(2)/dt**2)) |
4528 | + |
4529 | + dd2g12=domega/omega*dLYP12-a*b*omega*(d(1)/9.* & |
4530 | + (47.-7.*delta)-7./9.*d(1)*d(2)*ddelta-8./3.*dt) |
4531 | + |
4532 | + dd2g11=domega/omega*dLYP11-a*b*omega*(1./9.*d(1) & |
4533 | + *(1.-3.*delta-(delta-11.)*d(1)/dt)-d(1)*d(2)/9.* & |
4534 | + ((3.+d(1)/dt)*ddelta-(delta-11.)*d(1)/dt**2)-2*d(2)) |
4535 | + |
4536 | + dLYPdd(1)=-4*a/den*d(1)*d(2)/dt* & |
4537 | + (thd*dd*dt**(-fothd)/den & |
4538 | + +1./d(1)-1./dt)-2**onzthd*cf*a*b*(domega*d(1)*d(2)* & |
4539 | + (d(1)**(8./3.)+d(2)**(8./3.))+omega*d(2)*(onzthd* & |
4540 | + d(1)**(8./3.)+d(2)**(8./3.)))+dd1g11*gam11+ & |
4541 | + dd1g12*gam12+dd1g22*gam22 |
4542 | + |
4543 | + dLYPdd(2)=-4*a/den*d(1)*d(2)/dt*(thd*dd*dt**(-fothd)/den & |
4544 | + +1./d(2)-1./dt)-2**onzthd*cf*a*b*(domega*d(1)*d(2)* & |
4545 | + (d(1)**(8./3.)+d(2)**(8./3.))+omega*d(1)*(onzthd* & |
4546 | + d(2)**(8./3.)+d(1)**(8./3.)))+dd2g22*gam22+ & |
4547 | + dd2g12*gam12+dd2g11*gam11 |
4548 | + |
4549 | + ! second derivatives with respect to the density gradient |
4550 | + do is=1,2 |
4551 | + do ix=1,3 |
4552 | + dg11dd(ix,is)=2*gd(ix,is) |
4553 | + dg22dd(ix,is)=2*gd(ix,is) |
4554 | + enddo |
4555 | + enddo |
4556 | + do ix=1,3 |
4557 | + dLYPgd(ix,1)=dLYP11*dg11dd(ix,1)+dLYP12*gd(ix,2) |
4558 | + dLYPgd(ix,2)=dLYP22*dg22dd(ix,2)+dLYP12*gd(ix,1) |
4559 | + enddo |
4560 | + |
4561 | + EX=becke |
4562 | + EC=LYP |
4563 | + do is=1,nspin |
4564 | + dEXdd(is)=dbecdd(is) |
4565 | + dECdd(is)=dLYPdd(is) |
4566 | + do ix=1,3 |
4567 | + dEXdgd(ix,is)=dbecgd(ix,is) |
4568 | + dECdgd(ix,is)=dLYPgd(ix,is) |
4569 | + enddo |
4570 | + enddo |
4571 | + end subroutine blypxc |
4572 | + |
4573 | + |
4574 | + |
4575 | + SUBROUTINE RPBEXC( IREL, nspin, Dens, GDens, & |
4576 | + EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
4577 | + |
4578 | + ! ********************************************************************* |
4579 | + ! Implements Hammer's RPBE Generalized-Gradient-Approximation (GGA). |
4580 | + ! A revision of PBE (Perdew-Burke-Ernzerhof) |
4581 | + ! Ref: Hammer, Hansen & Norskov, PRB 59, 7413 (1999) and |
4582 | + ! J.P.Perdew, K.Burke & M.Ernzerhof, PRL 77, 3865 (1996) |
4583 | + ! |
4584 | + ! Written by M.V. Fernandez-Serra. March 2004. On the PBE routine of |
4585 | + ! L.C.Balbas and J.M.Soler. December 1996. |
4586 | + ! ******** INPUT ****************************************************** |
4587 | + ! INTEGER IREL : Relativistic-exchange switch (0=No, 1=Yes) |
4588 | + ! INTEGER nspin : Number of spin polarizations (1 or 2) |
4589 | + ! REAL*8 Dens(nspin) : Total electron density (if nspin=1) or |
4590 | + ! spin electron density (if nspin=2) |
4591 | + ! REAL*8 GDens(3,nspin) : Total or spin density gradient |
4592 | + ! ******** OUTPUT ***************************************************** |
4593 | + ! REAL*8 EX : Exchange energy density |
4594 | + ! REAL*8 EC : Correlation energy density |
4595 | + ! REAL*8 DEXDD(nspin) : Partial derivative |
4596 | + ! d(DensTot*Ex)/dDens(ispin), |
4597 | + ! where DensTot = Sum_ispin( Dens(ispin) ) |
4598 | + ! For a constant density, this is the |
4599 | + ! exchange potential |
4600 | + ! REAL*8 DECDD(nspin) : Partial derivative |
4601 | + ! d(DensTot*Ec)/dDens(ispin), |
4602 | + ! where DensTot = Sum_ispin( Dens(ispin) ) |
4603 | + ! For a constant density, this is the |
4604 | + ! correlation potential |
4605 | + ! REAL*8 DEXDGD(3,nspin): Partial derivative |
4606 | + ! d(DensTot*Ex)/d(GradDens(i,ispin)) |
4607 | + ! REAL*8 DECDGD(3,nspin): Partial derivative |
4608 | + ! d(DensTot*Ec)/d(GradDens(i,ispin)) |
4609 | + ! ********* UNITS **************************************************** |
4610 | + ! Lengths in Bohr |
4611 | + ! Densities in electrons per Bohr**3 |
4612 | + ! Energies in Hartrees |
4613 | + ! Gradient vectors in cartesian coordinates |
4614 | + ! ********* ROUTINES CALLED ****************************************** |
4615 | + ! EXCHNG, PW92C |
4616 | + ! ******************************************************************** |
4617 | + |
4618 | + INTEGER IREL, nspin |
4619 | + real(dp) Dens(nspin), DECDD(nspin), DECDGD(3,nspin), & |
4620 | + DEXDD(nspin), DEXDGD(3,nspin), GDens(3,nspin) |
4621 | + |
4622 | + ! Internal variables |
4623 | + INTEGER :: IS, IX |
4624 | + |
4625 | + real(dp) & |
4626 | + A, BETA, D(2), DADD, DECUDD, DENMIN, & |
4627 | + DF1DD, DF2DD, DF3DD, DF4DD, DF1DGD, DF3DGD, DF4DGD, & |
4628 | + DFCDD(2), DFCDGD(3,2), DFDD, DFDGD, DFXDD(2), DFXDGD(3,2), & |
4629 | + DHDD, DHDGD, DKFDD, DKSDD, DPDD, DPDZ, DRSDD, & |
4630 | + DS(2), DSDD, DSDGD, DT, DTDD, DTDGD, DZDD(2), & |
4631 | + EC, ECUNIF, EX, EXUNIF, & |
4632 | + F, F1, F2, F3, F4, FC, FX, FOUTHD, & |
4633 | + GAMMA, GD(3,2), GDM(2), GDMIN, GDMS, GDMT, GDS, GDT(3), & |
4634 | + H, HALF, KAPPA, KF, KFS, KS, MU, PHI, PI, RS, S, & |
4635 | + T, THD, THRHLF, TWO, TWOTHD, VCUNIF(2), VXUNIF(2), ZETA |
4636 | + |
4637 | + ! Lower bounds of density and its gradient to avoid divisions by zero |
4638 | + PARAMETER ( DENMIN = 1.D-12 ) |
4639 | + PARAMETER ( GDMIN = 1.D-12 ) |
4640 | + |
4641 | + ! Fix some numerical parameters |
4642 | + PARAMETER ( FOUTHD=4.D0/3.D0, HALF=0.5D0, & |
4643 | + THD=1.D0/3.D0, THRHLF=1.5D0, & |
4644 | + TWO=2.D0, TWOTHD=2.D0/3.D0 ) |
4645 | + |
4646 | + ! Fix some more numerical constants |
4647 | + PI = 4 * ATAN(1.D0) |
4648 | + BETA = 0.066725D0 |
4649 | + GAMMA = (1 - LOG(TWO)) / PI**2 |
4650 | + MU = BETA * PI**2 / 3 |
4651 | + KAPPA = 0.804D0 |
4652 | + |
4653 | + ! Translate density and its gradient to new variables |
4654 | + IF (nspin .EQ. 1) THEN |
4655 | + D(1) = HALF * Dens(1) |
4656 | + D(2) = D(1) |
4657 | + DT = MAX( DENMIN, Dens(1) ) |
4658 | + DO IX = 1,3 |
4659 | + GD(IX,1) = HALF * GDens(IX,1) |
4660 | + GD(IX,2) = GD(IX,1) |
4661 | + GDT(IX) = GDens(IX,1) |
4662 | + end DO |
4663 | + ELSE |
4664 | + D(1) = Dens(1) |
4665 | + D(2) = Dens(2) |
4666 | + DT = MAX( DENMIN, Dens(1)+Dens(2) ) |
4667 | + DO IX = 1,3 |
4668 | + GD(IX,1) = GDens(IX,1) |
4669 | + GD(IX,2) = GDens(IX,2) |
4670 | + GDT(IX) = GDens(IX,1) + GDens(IX,2) |
4671 | + end DO |
4672 | + ENDIF |
4673 | + GDM(1) = SQRT( GD(1,1)**2 + GD(2,1)**2 + GD(3,1)**2 ) |
4674 | + GDM(2) = SQRT( GD(1,2)**2 + GD(2,2)**2 + GD(3,2)**2 ) |
4675 | + GDMT = SQRT( GDT(1)**2 + GDT(2)**2 + GDT(3)**2 ) |
4676 | + GDMT = MAX( GDMIN, GDMT ) |
4677 | + |
4678 | + ! Find local correlation energy and potential |
4679 | + CALL PW92C( 2, D, ECUNIF, VCUNIF ) |
4680 | + |
4681 | + ! Find total correlation energy |
4682 | + RS = ( 3 / (4*PI*DT) )**THD |
4683 | + KF = (3 * PI**2 * DT)**THD |
4684 | + KS = SQRT( 4 * KF / PI ) |
4685 | + ZETA = ( D(1) - D(2) ) / DT |
4686 | + ZETA = MAX( -1.D0+DENMIN, ZETA ) |
4687 | + ZETA = MIN( 1.D0-DENMIN, ZETA ) |
4688 | + PHI = HALF * ( (1+ZETA)**TWOTHD + (1-ZETA)**TWOTHD ) |
4689 | + T = GDMT / (2 * PHI * KS * DT) |
4690 | + F1 = ECUNIF / GAMMA / PHI**3 |
4691 | + F2 = EXP(-F1) |
4692 | + A = BETA / GAMMA / (F2-1) |
4693 | + F3 = T**2 + A * T**4 |
4694 | + F4 = BETA/GAMMA * F3 / (1 + A*F3) |
4695 | + H = GAMMA * PHI**3 * LOG( 1 + F4 ) |
4696 | + FC = ECUNIF + H |
4697 | + |
4698 | + ! Find correlation energy derivatives |
4699 | + DRSDD = - (THD * RS / DT) |
4700 | + DKFDD = THD * KF / DT |
4701 | + DKSDD = HALF * KS * DKFDD / KF |
4702 | + DZDD(1) = 1 / DT - ZETA / DT |
4703 | + DZDD(2) = - (1 / DT) - ZETA / DT |
4704 | + DPDZ = HALF * TWOTHD * ( 1/(1+ZETA)**THD - 1/(1-ZETA)**THD ) |
4705 | + DO IS = 1,2 |
4706 | + DECUDD = ( VCUNIF(IS) - ECUNIF ) / DT |
4707 | + DPDD = DPDZ * DZDD(IS) |
4708 | + DTDD = (- T) * ( DPDD/PHI + DKSDD/KS + 1/DT ) |
4709 | + DF1DD = F1 * ( DECUDD/ECUNIF - 3*DPDD/PHI ) |
4710 | + DF2DD = (- F2) * DF1DD |
4711 | + DADD = (- A) * DF2DD / (F2-1) |
4712 | + DF3DD = (2*T + 4*A*T**3) * DTDD + DADD * T**4 |
4713 | + DF4DD = F4 * ( DF3DD/F3 - (DADD*F3+A*DF3DD)/(1+A*F3) ) |
4714 | + DHDD = 3 * H * DPDD / PHI |
4715 | + DHDD = DHDD + GAMMA * PHI**3 * DF4DD / (1+F4) |
4716 | + DFCDD(IS) = VCUNIF(IS) + H + DT * DHDD |
4717 | + |
4718 | + DO IX = 1,3 |
4719 | + DTDGD = (T / GDMT) * GDT(IX) / GDMT |
4720 | + DF3DGD = DTDGD * ( 2 * T + 4 * A * T**3 ) |
4721 | + DF4DGD = F4 * DF3DGD * ( 1/F3 - A/(1+A*F3) ) |
4722 | + DHDGD = GAMMA * PHI**3 * DF4DGD / (1+F4) |
4723 | + DFCDGD(IX,IS) = DT * DHDGD |
4724 | + end DO |
4725 | + end DO |
4726 | + |
4727 | + ! Find exchange energy and potential |
4728 | + FX = 0 |
4729 | + DO IS = 1,2 |
4730 | + DS(IS) = MAX( DENMIN, 2 * D(IS) ) |
4731 | + GDMS = MAX( GDMIN, 2 * GDM(IS) ) |
4732 | + KFS = (3 * PI**2 * DS(IS))**THD |
4733 | + S = GDMS / (2 * KFS * DS(IS)) |
4734 | + !ea Hammer's RPBE (Hammer, Hansen & Norskov PRB 59 7413 (99) |
4735 | + !ea F1 = DEXP( - MU * S**2 / KAPPA) |
4736 | + !ea F = 1 + KAPPA * (1 - F1) |
4737 | + !ea Following is standard PBE |
4738 | + !ea F1 = 1 + MU * S**2 / KAPPA |
4739 | + !ea F = 1 + KAPPA - KAPPA / F1 |
4740 | + !ea (If revPBE Zhang & Yang, PRL 80,890(1998),change PBE's KAPPA to 1.245) |
4741 | + F1 = DEXP( - MU * S**2 / KAPPA) |
4742 | + F = 1 + KAPPA * (1 - F1) |
4743 | + |
4744 | + ! Note nspin=1 in call to exchng... |
4745 | + |
4746 | + CALL EXCHNG( IREL, 1, DS(IS), EXUNIF, VXUNIF(IS) ) |
4747 | + FX = FX + DS(IS) * EXUNIF * F |
4748 | + |
4749 | + !MVFS The derivatives of F also need to be changed for Hammer's RPBE. |
4750 | + !MVFS DF1DD = 2 * F1 * DSDD * ( - MU * S / KAPPA) |
4751 | + !MVFS DF1DGD= 2 * F1 * DSDGD * ( - MU * S / KAPPA) |
4752 | + !MVFS DFDD = -1 * KAPPA * DF1DD |
4753 | + !MVFS DFDGD = -1 * KAPPA * DFDGD |
4754 | + |
4755 | + DKFDD = THD * KFS / DS(IS) |
4756 | + DSDD = S * ( -(DKFDD/KFS) - 1/DS(IS) ) |
4757 | + ! DF1DD = 2 * (F1-1) * DSDD / S |
4758 | + ! DFDD = KAPPA * DF1DD / F1**2 |
4759 | + DF1DD = 2* F1 * DSDD * ( - MU * S / KAPPA) |
4760 | + DFDD = -1 * KAPPA * DF1DD |
4761 | + DFXDD(IS) = VXUNIF(IS) * F + DS(IS) * EXUNIF * DFDD |
4762 | + |
4763 | + DO IX = 1,3 |
4764 | + GDS = 2 * GD(IX,IS) |
4765 | + DSDGD = (S / GDMS) * GDS / GDMS |
4766 | + ! DF1DGD = 2 * MU * S * DSDGD / KAPPA |
4767 | + ! DFDGD = KAPPA * DF1DGD / F1**2 |
4768 | + DF1DGD =2*F1 * DSDGD * ( - MU * S / KAPPA) |
4769 | + DFDGD = -1 * KAPPA * DF1DGD |
4770 | + DFXDGD(IX,IS) = DS(IS) * EXUNIF * DFDGD |
4771 | + end DO |
4772 | + end DO |
4773 | + FX = HALF * FX / DT |
4774 | + |
4775 | + ! Set output arguments |
4776 | + EX = FX |
4777 | + EC = FC |
4778 | + DO IS = 1,nspin |
4779 | + DEXDD(IS) = DFXDD(IS) |
4780 | + DECDD(IS) = DFCDD(IS) |
4781 | + DO IX = 1,3 |
4782 | + DEXDGD(IX,IS) = DFXDGD(IX,IS) |
4783 | + DECDGD(IX,IS) = DFCDGD(IX,IS) |
4784 | + end DO |
4785 | + end DO |
4786 | + END SUBROUTINE RPBEXC |
4787 | + |
4788 | + |
4789 | + |
4790 | + SUBROUTINE WCXC( IREL, nspin, Dens, GDens, & |
4791 | + EX, EC, DEXDD, DECDD, DEXDGD, DECDGD ) |
4792 | + |
4793 | + ! ********************************************************************* |
4794 | + ! Implements Wu-Cohen Generalized-Gradient-Approximation. |
4795 | + ! Ref: Z. Wu and R. E. Cohen PRB 73, 235116 (2006) |
4796 | + ! Written by Marivi Fernandez-Serra, with contributions by |
4797 | + ! Julian Gale and Alberto Garcia, |
4798 | + ! over the PBEXC subroutine of L.C.Balbas and J.M.Soler. |
4799 | + ! September, 2006. |
4800 | + ! ******** INPUT ****************************************************** |
4801 | + ! INTEGER IREL : Relativistic-exchange switch (0=No, 1=Yes) |
4802 | + ! INTEGER nspin : Number of spin polarizations (1 or 2) |
4803 | + ! REAL*8 Dens(nspin) : Total electron density (if nspin=1) or |
4804 | + ! spin electron density (if nspin=2) |
4805 | + ! REAL*8 GDens(3,nspin) : Total or spin density gradient |
4806 | + ! ******** OUTPUT ***************************************************** |
4807 | + ! REAL*8 EX : Exchange energy density |
4808 | + ! REAL*8 EC : Correlation energy density |
4809 | + ! REAL*8 DEXDD(nspin) : Partial derivative |
4810 | + ! d(DensTot*Ex)/dDens(ispin), |
4811 | + ! where DensTot = Sum_ispin( Dens(ispin) ) |
4812 | + ! For a constant density, this is the |
4813 | + ! exchange potential |
4814 | + ! REAL*8 DECDD(nspin) : Partial derivative |
4815 | + ! d(DensTot*Ec)/dDens(ispin), |
4816 | + ! where DensTot = Sum_ispin( Dens(ispin) ) |
4817 | + ! For a constant density, this is the |
4818 | + ! correlation potential |
4819 | + ! REAL*8 DEXDGD(3,nspin): Partial derivative |
4820 | + ! d(DensTot*Ex)/d(GradDens(i,ispin)) |
4821 | + ! REAL*8 DECDGD(3,nspin): Partial derivative |
4822 | + ! d(DensTot*Ec)/d(GradDens(i,ispin)) |
4823 | + ! ********* UNITS **************************************************** |
4824 | + ! Lengths in Bohr |
4825 | + ! Densities in electrons per Bohr**3 |
4826 | + ! Energies in Hartrees |
4827 | + ! Gradient vectors in cartesian coordinates |
4828 | + ! ********* ROUTINES CALLED ****************************************** |
4829 | + ! EXCHNG, PW92C |
4830 | + ! ******************************************************************** |
4831 | + |
4832 | + INTEGER IREL, nspin |
4833 | + real(dp) Dens(nspin), DECDD(nspin), DECDGD(3,nspin), & |
4834 | + DEXDD(nspin), DEXDGD(3,nspin), GDens(3,nspin) |
4835 | + |
4836 | + ! Internal variables |
4837 | + INTEGER :: IS, IX |
4838 | + |
4839 | + real(dp) & |
4840 | + A, BETA, D(2), DADD, DECUDD, DENMIN, & |
4841 | + DF1DD, DF2DD, DF3DD, DF4DD, DF1DGD, DF3DGD, DF4DGD, & |
4842 | + DFCDD(2), DFCDGD(3,2), DFDD, DFDGD, DFXDD(2), DFXDGD(3,2), & |
4843 | + DHDD, DHDGD, DKFDD, DKSDD, DPDD, DPDZ, DRSDD, & |
4844 | + DS(2), DSDD, DSDGD, DT, DTDD, DTDGD, DZDD(2), & |
4845 | + XWC, DXWCDS, CWC, & |
4846 | + EC, ECUNIF, EX, EXUNIF, & |
4847 | + F, F1, F2, F3, F4, FC, FX, FOUTHD, & |
4848 | + GAMMA, GD(3,2), GDM(2), GDMIN, GDMS, GDMT, GDS, GDT(3), & |
4849 | + H, HALF, KAPPA, KF, KFS, KS, MU, PHI, PI, RS, S, & |
4850 | + TEN81, & |
4851 | + T, THD, THRHLF, TWO, TWOTHD, VCUNIF(2), VXUNIF(2), ZETA |
4852 | + |
4853 | + ! Lower bounds of density and its gradient to avoid divisions by zero |
4854 | + PARAMETER ( DENMIN = 1.D-12 ) |
4855 | + PARAMETER ( GDMIN = 1.D-12 ) |
4856 | + |
4857 | + ! Fix some numerical parameters |
4858 | + PARAMETER ( FOUTHD=4.D0/3.D0, HALF=0.5D0, & |
4859 | + THD=1.D0/3.D0, THRHLF=1.5D0, & |
4860 | + TWO=2.D0, TWOTHD=2.D0/3.D0 ) |
4861 | + PARAMETER ( TEN81 = 10.0d0/81.0d0 ) |
4862 | + |
4863 | + ! Fix some more numerical constants |
4864 | + PI = 4 * ATAN(1.D0) |
4865 | + BETA = 0.066725D0 |
4866 | + GAMMA = (1 - LOG(TWO)) / PI**2 |
4867 | + MU = BETA * PI**2 / 3 |
4868 | + KAPPA = 0.804D0 |
4869 | + CWC = 0.0079325D0 |
4870 | + |
4871 | + ! Translate density and its gradient to new variables |
4872 | + IF (nspin .EQ. 1) THEN |
4873 | + D(1) = HALF * Dens(1) |
4874 | + D(2) = D(1) |
4875 | + DT = MAX( DENMIN, Dens(1) ) |
4876 | + DO IX = 1,3 |
4877 | + GD(IX,1) = HALF * GDens(IX,1) |
4878 | + GD(IX,2) = GD(IX,1) |
4879 | + GDT(IX) = GDens(IX,1) |
4880 | + end DO |
4881 | + ELSE |
4882 | + D(1) = Dens(1) |
4883 | + D(2) = Dens(2) |
4884 | + DT = MAX( DENMIN, Dens(1)+Dens(2) ) |
4885 | + DO IX = 1,3 |
4886 | + GD(IX,1) = GDens(IX,1) |
4887 | + GD(IX,2) = GDens(IX,2) |
4888 | + GDT(IX) = GDens(IX,1) + GDens(IX,2) |
4889 | + end DO |
4890 | + ENDIF |
4891 | + GDM(1) = SQRT( GD(1,1)**2 + GD(2,1)**2 + GD(3,1)**2 ) |
4892 | + GDM(2) = SQRT( GD(1,2)**2 + GD(2,2)**2 + GD(3,2)**2 ) |
4893 | + GDMT = SQRT( GDT(1)**2 + GDT(2)**2 + GDT(3)**2 ) |
4894 | + GDMT = MAX( GDMIN, GDMT ) |
4895 | + |
4896 | + ! Find local correlation energy and potential |
4897 | + CALL PW92C( 2, D, ECUNIF, VCUNIF ) |
4898 | + |
4899 | + ! Find total correlation energy |
4900 | + RS = ( 3 / (4*PI*DT) )**THD |
4901 | + KF = (3 * PI**2 * DT)**THD |
4902 | + KS = SQRT( 4 * KF / PI ) |
4903 | + ZETA = ( D(1) - D(2) ) / DT |
4904 | + ZETA = MAX( -1.D0+DENMIN, ZETA ) |
4905 | + ZETA = MIN( 1.D0-DENMIN, ZETA ) |
4906 | + PHI = HALF * ( (1+ZETA)**TWOTHD + (1-ZETA)**TWOTHD ) |
4907 | + T = GDMT / (2 * PHI * KS * DT) |
4908 | + F1 = ECUNIF / GAMMA / PHI**3 |
4909 | + F2 = EXP(-F1) |
4910 | + A = BETA / GAMMA / (F2-1) |
4911 | + F3 = T**2 + A * T**4 |
4912 | + F4 = BETA/GAMMA * F3 / (1 + A*F3) |
4913 | + H = GAMMA * PHI**3 * LOG( 1 + F4 ) |
4914 | + FC = ECUNIF + H |
4915 | + |
4916 | + ! Find correlation energy derivatives |
4917 | + DRSDD = - (THD * RS / DT) |
4918 | + DKFDD = THD * KF / DT |
4919 | + DKSDD = HALF * KS * DKFDD / KF |
4920 | + DZDD(1) = 1 / DT - ZETA / DT |
4921 | + DZDD(2) = - (1 / DT) - ZETA / DT |
4922 | + DPDZ = HALF * TWOTHD * ( 1/(1+ZETA)**THD - 1/(1-ZETA)**THD ) |
4923 | + DO IS = 1,2 |
4924 | + DECUDD = ( VCUNIF(IS) - ECUNIF ) / DT |
4925 | + DPDD = DPDZ * DZDD(IS) |
4926 | + DTDD = (- T) * ( DPDD/PHI + DKSDD/KS + 1/DT ) |
4927 | + DF1DD = F1 * ( DECUDD/ECUNIF - 3*DPDD/PHI ) |
4928 | + DF2DD = (- F2) * DF1DD |
4929 | + DADD = (- A) * DF2DD / (F2-1) |
4930 | + DF3DD = (2*T + 4*A*T**3) * DTDD + DADD * T**4 |
4931 | + DF4DD = F4 * ( DF3DD/F3 - (DADD*F3+A*DF3DD)/(1+A*F3) ) |
4932 | + DHDD = 3 * H * DPDD / PHI |
4933 | + DHDD = DHDD + GAMMA * PHI**3 * DF4DD / (1+F4) |
4934 | + DFCDD(IS) = VCUNIF(IS) + H + DT * DHDD |
4935 | + |
4936 | + DO IX = 1,3 |
4937 | + DTDGD = (T / GDMT) * GDT(IX) / GDMT |
4938 | + DF3DGD = DTDGD * ( 2 * T + 4 * A * T**3 ) |
4939 | + DF4DGD = F4 * DF3DGD * ( 1/F3 - A/(1+A*F3) ) |
4940 | + DHDGD = GAMMA * PHI**3 * DF4DGD / (1+F4) |
4941 | + DFCDGD(IX,IS) = DT * DHDGD |
4942 | + end DO |
4943 | + end DO |
4944 | + |
4945 | + ! Find exchange energy and potential |
4946 | + FX = 0 |
4947 | + DO IS = 1,2 |
4948 | + DS(IS) = MAX( DENMIN, 2 * D(IS) ) |
4949 | + GDMS = MAX( GDMIN, 2 * GDM(IS) ) |
4950 | + KFS = (3 * PI**2 * DS(IS))**THD |
4951 | + S = GDMS / (2 * KFS * DS(IS)) |
4952 | + ! |
4953 | + ! For PBE: |
4954 | + ! |
4955 | + ! x = MU * S**2 |
4956 | + ! dxds = 2*MU*S |
4957 | + ! |
4958 | + ! Wu-Cohen form: |
4959 | + ! |
4960 | + XWC= TEN81 * s**2 + (MU- TEN81) * & |
4961 | + S**2 * exp(-S**2) + log(1+ CWC * S**4) |
4962 | + DXWCDS = 2 * TEN81 * S + (MU - TEN81) * exp(-S**2) * & |
4963 | + 2*S * (1 - S*S) + 4 * CWC * S**3 / (1 + CWC * S**4) |
4964 | + |
4965 | + F1 = 1 + XWC / KAPPA |
4966 | + F = 1 + KAPPA - KAPPA / F1 |
4967 | + ! |
4968 | + ! Note nspin=1 in call to exchng... |
4969 | + ! |
4970 | + CALL EXCHNG( IREL, 1, DS(IS), EXUNIF, VXUNIF(IS) ) |
4971 | + FX = FX + DS(IS) * EXUNIF * F |
4972 | + |
4973 | + DKFDD = THD * KFS / DS(IS) |
4974 | + DSDD = S * ( -(DKFDD/KFS) - 1/DS(IS) ) |
4975 | + DF1DD = DXWCDS * DSDD / KAPPA |
4976 | + DFDD = KAPPA * DF1DD / F1**2 |
4977 | + DFXDD(IS) = VXUNIF(IS) * F + DS(IS) * EXUNIF * DFDD |
4978 | + |
4979 | + DO IX = 1,3 |
4980 | + GDS = 2 * GD(IX,IS) |
4981 | + DSDGD = (S / GDMS) * GDS / GDMS |
4982 | + DF1DGD = DXWCDS * DSDGD / KAPPA |
4983 | + DFDGD = KAPPA * DF1DGD / F1**2 |
4984 | + DFXDGD(IX,IS) = DS(IS) * EXUNIF * DFDGD |
4985 | + end DO |
4986 | + end DO |
4987 | + FX = HALF * FX / DT |
4988 | + |
4989 | + ! Set output arguments |
4990 | + EX = FX |
4991 | + EC = FC |
4992 | + DO IS = 1,nspin |
4993 | + DEXDD(IS) = DFXDD(IS) |
4994 | + DECDD(IS) = DFCDD(IS) |
4995 | + DO IX = 1,3 |
4996 | + DEXDGD(IX,IS) = DFXDGD(IX,IS) |
4997 | + DECDGD(IX,IS) = DFCDGD(IX,IS) |
4998 | + end DO |
4999 | + end DO |
5000 | + |
The diff has been truncated for viewing.
Note I have checked the output of test1 and test3 @ rev39 and my branch, they both yield _exactly_ the same output.
test3 has also been runned with mpirun -np 4.