Merge lp:~nickpapior/libgridxc/fortran-standard into lp:libgridxc

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
Reviewer Review Type Date Requested Status
Yann Pouillon (community) Approve
Review via email: mp+337978@code.launchpad.net

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 :

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.

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.

Subscribers

People subscribed via source and target branches

to all changes: