37#include "../base/base_uses.f90"
44 REAL(KIND=
dp),
PARAMETER :: f13 = 1.0_dp/3.0_dp, &
50 REAL(KIND=
dp) :: xparam, flda, flsd
51 REAL(KIND=
dp) :: eps_rho
52 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'xc_xalpha'
61 SUBROUTINE xalpha_init(cutoff, xalpha)
63 REAL(KIND=
dp),
INTENT(IN) :: cutoff
64 REAL(KIND=
dp),
INTENT(IN),
OPTIONAL :: xalpha
68 IF (
PRESENT(xalpha))
THEN
71 xparam = 2.0_dp/3.0_dp
74 flda = -9.0_dp/8.0_dp*xparam*(3.0_dp/
pi)**f13
75 flsd = flda*2.0_dp**f13
77 END SUBROUTINE xalpha_init
89 SUBROUTINE xalpha_info(lsd, reference, shortform, needs, max_deriv, &
90 xa_parameter, scaling)
91 LOGICAL,
INTENT(in) :: lsd
92 CHARACTER(LEN=*),
INTENT(OUT),
OPTIONAL :: reference, shortform
94 INTEGER,
INTENT(out),
OPTIONAL :: max_deriv
95 REAL(kind=
dp),
INTENT(in),
OPTIONAL :: xa_parameter, scaling
97 REAL(kind=
dp) :: my_scaling, my_xparam
99 my_xparam = 2.0_dp/3.0_dp
100 IF (
PRESENT(xa_parameter)) my_xparam = xa_parameter
102 IF (
PRESENT(scaling)) my_scaling = scaling
104 IF (
PRESENT(reference))
THEN
105 IF (my_scaling /= 1._dp)
THEN
106 WRITE (reference,
'(A,F8.4,A,F8.4)') &
107 "Dirac/Slater local exchange; parameter=", my_xparam,
" scaling=", my_scaling
109 WRITE (reference,
'(A,F8.4)') &
110 "Dirac/Slater local exchange; parameter=", my_xparam
113 IF (len_trim(reference) + 6 < len(reference))
THEN
114 reference(len_trim(reference):len_trim(reference) + 6) =
' {LDA}'
118 IF (
PRESENT(shortform))
THEN
119 IF (my_scaling /= 1._dp)
THEN
120 WRITE (shortform,
'(A,F8.4,F8.4)')
"Dirac/Slater exchange", my_xparam, my_scaling
122 WRITE (shortform,
'(A,F8.4)')
"Dirac/Slater exchange", my_xparam
125 IF (len_trim(shortform) + 6 < len(shortform))
THEN
126 shortform(len_trim(shortform):len_trim(shortform) + 6) =
' {LDA}'
130 IF (
PRESENT(needs))
THEN
132 needs%rho_spin = .true.
133 needs%rho_spin_1_3 = .true.
136 needs%rho_1_3 = .true.
139 IF (
PRESENT(max_deriv)) max_deriv = 3
154 INTEGER,
INTENT(in) :: order
156 REAL(kind=
dp),
INTENT(in),
OPTIONAL :: xa_parameter
158 CHARACTER(len=*),
PARAMETER :: routinen =
'xalpha_lda_eval'
160 INTEGER :: handle, npoints
161 INTEGER,
DIMENSION(2, 3) :: bo
162 REAL(kind=
dp) :: epsilon_rho, sx
163 REAL(kind=
dp),
CONTIGUOUS,
DIMENSION(:, :, :), &
164 POINTER :: e_0, e_rho, e_rho_rho, e_rho_rho_rho, &
168 CALL timeset(routinen, handle)
173 local_bounds=bo, rho_cutoff=epsilon_rho)
174 npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1)
175 CALL xalpha_init(epsilon_rho, xa_parameter)
178 allocate_deriv=.true.)
181 CALL xalpha_lda_0(npoints, rho, r13, e_0, sx)
185 allocate_deriv=.true.)
188 CALL xalpha_lda_1(npoints, rho, r13, e_rho, sx)
192 allocate_deriv=.true.)
195 CALL xalpha_lda_2(npoints, rho, r13, e_rho_rho, sx)
199 allocate_deriv=.true.)
202 CALL xalpha_lda_3(npoints, rho, r13, e_rho_rho_rho, sx)
205 cpabort(
"derivatives bigger than 3 not implemented")
207 CALL timestop(handle)
222 INTEGER,
INTENT(in) :: order
224 REAL(kind=
dp),
INTENT(in),
OPTIONAL :: xa_parameter
226 CHARACTER(len=*),
PARAMETER :: routinen =
'xalpha_lsd_eval'
229 INTEGER :: handle, i, ispin, npoints
230 INTEGER,
DIMENSION(2, 3) :: bo
231 REAL(kind=
dp) :: epsilon_rho, sx
232 REAL(kind=
dp),
CONTIGUOUS,
DIMENSION(:, :, :), &
233 POINTER :: e_0, e_rho, e_rho_rho, e_rho_rho_rho
237 CALL timeset(routinen, handle)
240 NULLIFY (rho(i)%array, rho_1_3(i)%array)
246 rhob_1_3=rho_1_3(2)%array, rhoa=rho(1)%array, &
247 rhob=rho(2)%array, rho_cutoff=epsilon_rho, &
249 npoints = (bo(2, 1) - bo(1, 1) + 1)*(bo(2, 2) - bo(1, 2) + 1)*(bo(2, 3) - bo(1, 3) + 1)
250 CALL xalpha_init(epsilon_rho, xa_parameter)
254 allocate_deriv=.true.)
257 CALL xalpha_lsd_0(npoints, rho(ispin)%array, rho_1_3(ispin)%array, &
261 allocate_deriv=.true.)
264 CALL xalpha_lsd_1(npoints, rho(ispin)%array, rho_1_3(ispin)%array, &
269 rho_spin_name(ispin)], allocate_deriv=.true.)
272 CALL xalpha_lsd_2(npoints, rho(ispin)%array, rho_1_3(ispin)%array, &
277 rho_spin_name(ispin), rho_spin_name(ispin)], &
278 allocate_deriv=.true.)
281 CALL xalpha_lsd_3(npoints, rho(ispin)%array, rho_1_3(ispin)%array, &
285 cpabort(
"derivatives bigger than 3 not implemented")
288 CALL timestop(handle)
299 SUBROUTINE xalpha_lda_0(n, rho, r13, pot, sx)
301 INTEGER,
INTENT(IN) :: n
302 REAL(kind=
dp),
DIMENSION(*),
INTENT(IN) :: rho, r13
303 REAL(kind=
dp),
DIMENSION(*),
INTENT(INOUT) :: pot
304 REAL(kind=
dp),
INTENT(IN) :: sx
314 IF (rho(ip) > eps_rho)
THEN
315 pot(ip) = pot(ip) + f*r13(ip)*rho(ip)
319 END SUBROUTINE xalpha_lda_0
329 SUBROUTINE xalpha_lda_1(n, rho, r13, pot, sx)
331 INTEGER,
INTENT(IN) :: n
332 REAL(kind=
dp),
DIMENSION(*),
INTENT(IN) :: rho, r13
333 REAL(kind=
dp),
DIMENSION(*),
INTENT(INOUT) :: pot
343 IF (rho(ip) > eps_rho)
THEN
344 pot(ip) = pot(ip) + f*r13(ip)
348 END SUBROUTINE xalpha_lda_1
358 SUBROUTINE xalpha_lda_2(n, rho, r13, pot, sx)
360 INTEGER,
INTENT(IN) :: n
361 REAL(kind=
dp),
DIMENSION(*),
INTENT(IN) :: rho, r13
362 REAL(kind=
dp),
DIMENSION(*),
INTENT(INOUT) :: pot
372 IF (rho(ip) > eps_rho)
THEN
373 pot(ip) = pot(ip) + f*r13(ip)/rho(ip)
377 END SUBROUTINE xalpha_lda_2
387 SUBROUTINE xalpha_lda_3(n, rho, r13, pot, sx)
389 INTEGER,
INTENT(IN) :: n
390 REAL(kind=
dp),
DIMENSION(*),
INTENT(IN) :: rho, r13
391 REAL(kind=
dp),
DIMENSION(*),
INTENT(INOUT) :: pot
397 f = -f23*f13*f43*flda*sx
401 IF (rho(ip) > eps_rho)
THEN
402 pot(ip) = pot(ip) + f*r13(ip)/(rho(ip)*rho(ip))
406 END SUBROUTINE xalpha_lda_3
416 SUBROUTINE xalpha_lsd_0(n, rhoa, r13a, pot, sx)
418 INTEGER,
INTENT(IN) :: n
419 REAL(kind=
dp),
DIMENSION(*),
INTENT(IN) :: rhoa, r13a
420 REAL(kind=
dp),
DIMENSION(*),
INTENT(INOUT) :: pot
434 IF (rhoa(ip) > eps_rho)
THEN
435 pot(ip) = pot(ip) + f*r13a(ip)*rhoa(ip)
440 END SUBROUTINE xalpha_lsd_0
450 SUBROUTINE xalpha_lsd_1(n, rhoa, r13a, pota, sx)
452 INTEGER,
INTENT(IN) :: n
453 REAL(kind=
dp),
DIMENSION(*),
INTENT(IN) :: rhoa, r13a
454 REAL(kind=
dp),
DIMENSION(*),
INTENT(INOUT) :: pota
468 IF (rhoa(ip) > eps_rho)
THEN
469 pota(ip) = pota(ip) + f*r13a(ip)
474 END SUBROUTINE xalpha_lsd_1
484 SUBROUTINE xalpha_lsd_2(n, rhoa, r13a, potaa, sx)
486 INTEGER,
INTENT(IN) :: n
487 REAL(kind=
dp),
DIMENSION(*),
INTENT(IN) :: rhoa, r13a
488 REAL(kind=
dp),
DIMENSION(*),
INTENT(INOUT) :: potaa
502 IF (rhoa(ip) > eps_rho)
THEN
503 potaa(ip) = potaa(ip) + f*r13a(ip)/rhoa(ip)
508 END SUBROUTINE xalpha_lsd_2
518 SUBROUTINE xalpha_lsd_3(n, rhoa, r13a, potaaa, sx)
520 INTEGER,
INTENT(IN) :: n
521 REAL(kind=
dp),
DIMENSION(*),
INTENT(IN) :: rhoa, r13a
522 REAL(kind=
dp),
DIMENSION(*),
INTENT(INOUT) :: potaaa
530 f = -f23*f13*f43*flsd*sx
536 IF (rhoa(ip) > eps_rho)
THEN
537 potaaa(ip) = potaaa(ip) + f*r13a(ip)/(rhoa(ip)*rhoa(ip))
542 END SUBROUTINE xalpha_lsd_3
556 REAL(kind=
dp),
INTENT(IN) :: scale_x, eps_rho
559 INTEGER,
DIMENSION(2, 3) :: bo
560 REAL(kind=
dp) :: eaa, ebb, f, flda, flsd, rhoa, rhob
562 flda = -3.0_dp/4.0_dp*(3.0_dp/
pi)**f13
563 flsd = flda*2.0_dp**f13
564 f = f13*f43*flsd*scale_x
565 bo(1:2, 1:3) = rho_a%pw_grid%bounds_local(1:2, 1:3)
568 DO k = bo(1, 3), bo(2, 3)
569 DO j = bo(1, 2), bo(2, 2)
570 DO i = bo(1, 1), bo(2, 1)
572 rhoa = rho_a%array(i, j, k)
573 IF (rhoa > eps_rho)
THEN
575 fxc_aa%array(i, j, k) = fxc_aa%array(i, j, k) + f*eaa
577 rhob = rho_b%array(i, j, k)
578 IF (rhob > eps_rho)
THEN
580 fxc_bb%array(i, j, k) = fxc_bb%array(i, j, k) + f*ebb
various utilities that regard array of different kinds: output, allocation,... maybe it is not a good...
Defines the basic variable types.
integer, parameter, public dp
Definition of mathematical constants and functions.
real(kind=dp), parameter, public pi
Module with functions to handle derivative descriptors. derivative description are strings have the f...
integer, parameter, public deriv_rhob
integer, parameter, public deriv_rhoa
integer, parameter, public deriv_rho
represent a group ofunctional derivatives
type(xc_derivative_type) function, pointer, public xc_dset_get_derivative(derivative_set, description, allocate_deriv)
returns the requested xc_derivative
Provides types for the management of the xc-functionals and their derivatives.
subroutine, public xc_derivative_get(deriv, split_desc, order, deriv_data, accept_null_data)
returns various information on the given derivative
Utility routines for the functional calculations.
subroutine, public set_util(cutoff)
...
subroutine, public xc_rho_set_get(rho_set, can_return_null, rho, drho, norm_drho, rhoa, rhob, norm_drhoa, norm_drhob, rho_1_3, rhoa_1_3, rhob_1_3, laplace_rho, laplace_rhoa, laplace_rhob, drhoa, drhob, rho_cutoff, drho_cutoff, tau_cutoff, tau, tau_a, tau_b, local_bounds)
returns the various attributes of rho_set
Calculate the local exchange functional.
subroutine, public xalpha_fxc_eval(rho_a, rho_b, fxc_aa, fxc_bb, scale_x, eps_rho)
...
subroutine, public xalpha_lda_eval(rho_set, deriv_set, order, xa_params, xa_parameter)
...
subroutine, public xalpha_info(lsd, reference, shortform, needs, max_deriv, xa_parameter, scaling)
...
subroutine, public xalpha_lsd_eval(rho_set, deriv_set, order, xa_params, xa_parameter)
...
represent a pointer to a contiguous 3d array
A derivative set contains the different derivatives of a xc-functional in form of a linked list.
represent a derivative of a functional
contains a flag for each component of xc_rho_set, so that you can use it to tell which components you...
represent a density, with all the representation and data needed to perform a functional evaluation