9 USE ieee_arithmetic,
ONLY: ieee_is_finite
57 INTEGER :: axis, configuration, spin, variant
58 REAL(
dp) :: energy, gradient(5), hessian(5, 5), minus, plus, gm(5), gp(5), scratch(5, 5), &
59 step, trial(5), x(5), energy_error, hessian_error
62 NULLIFY (specification, functional)
67 hessian_error = 0.0_dp
68 DO variant = 1,
SIZE(variants)
70 DO configuration = 1, 3
72 IF (configuration == 1 .AND. spin == 2) cycle
73 x = [0.4_dp, 0.2_dp, 0.3_dp, 0.2_dp, 0.25_dp]
74 IF (configuration == 2) x(spin) = -0.1_dp
75 IF (configuration == 3) x(spin) = 1.e-13_dp
76 CALL evaluate(x, energy, gradient, hessian)
79 IF (configuration == 3 .AND. axis == spin) step = 1.e-14_dp
81 trial(axis) = x(axis) + step
82 CALL evaluate(trial, plus, gp, scratch)
83 trial(axis) = x(axis) - step
84 CALL evaluate(trial, minus, gm, scratch)
85 energy_error = max(energy_error, abs((plus - minus)/(2.0_dp*step) - gradient(axis)))
86 hessian_error = max(hessian_error, maxval(abs((gp - gm)/(2.0_dp*step) - hessian(:, axis))))
91 WRITE (*,
'(A,2ES15.6)')
'PBE spin-floor first/second derivative errors:', energy_error, hessian_error
92 IF (energy_error > 2.e-8_dp) error stop
'PBE potential is not the derivative of its clamped-density energy'
93 IF (hessian_error > 2.e-7_dp) error stop
'PBE kernel is not the derivative of its clamped-density potential'
96 CALL check_tpss_zero_gradient()
101 CALL check_xwpbe_limits()
104 CALL check_libxc_tau_projection()
105 CALL check_libxc_c2_window()
106 CALL check_libxc_c2_rounding()
107 CALL check_libxc_individual_floor()
119 SUBROUTINE check_libxc_tau_projection()
120 CHARACTER(len=32),
PARAMETER :: names(6) = [character(len=32)::
'MGGA_X_TPSS',
'MGGA_C_TPSS',&
121 'MGGA_X_R2SCAN',
'MGGA_C_R2SCAN',
'LDA_C_PW',
'GGA_C_PBE']
122 REAL(
dp),
PARAMETER :: step = 1.e-5_dp
124 INTEGER :: axis, configuration, family, nconfig, &
126 REAL(
dp) :: energy, first_error, minus, plus, &
128 REAL(
dp),
ALLOCATABLE :: gm(:), gp(:), gradient(:), &
129 hessian(:, :), scratch(:, :), &
133 second_error = 0.0_dp
137 IF (spin_case == 2)
THEN
141 ALLOCATE (x(nvar), trial(nvar), gradient(nvar), gp(nvar), gm(nvar), &
142 hessian(nvar, nvar), scratch(nvar, nvar))
143 DO family = 1,
SIZE(names)
144 DO configuration = 1, nconfig
145 IF (spin_case == 1)
THEN
146 x(:) = [0.4_dp, 0.8_dp, 0.3_dp]
147 IF (configuration == 2) x(3) = 0.02_dp
148 IF (configuration == 3) x(3) = -0.02_dp
150 x(:) = [0.3_dp, 0.2_dp, 0.6_dp, 0.4_dp, 0.3_dp, 0.12_dp, 0.10_dp]
151 IF (configuration == 2) x(6:7) = [0.02_dp, 0.015_dp]
152 IF (configuration == 3) x(6) = -0.02_dp
153 IF (configuration == 4) x(6:7) = [-0.02_dp, -0.015_dp]
154 IF (configuration == 5) x(1) = -0.1_dp
155 IF (configuration == 6) x(2) = -0.1_dp
157 CALL evaluate_libxc_point(names(family), x, energy, gradient, hessian)
158 IF (configuration >= 3)
THEN
159 IF (index(names(family),
'MGGA_X_') == 1 .AND. abs(energy) < 1.e-4_dp)
THEN
160 error stop
'Libxc discarded finite density at nonpositive tau'
163 trial(nvar - spin_case + 1) = 1.e-10_dp
164 CALL evaluate_libxc_point(names(family), trial, plus, gp, scratch)
165 trial(nvar - spin_case + 1) = -1.e-10_dp
166 CALL evaluate_libxc_point(names(family), trial, minus, gm, scratch)
167 IF (abs(plus - minus) > 1.e-9_dp) error stop
'Libxc energy is discontinuous through zero tau'
171 trial(axis) = x(axis) + step
172 CALL evaluate_libxc_point(names(family), trial, plus, gp, scratch)
173 trial(axis) = x(axis) - step
174 CALL evaluate_libxc_point(names(family), trial, minus, gm, scratch)
175 first_error = max(first_error, &
176 abs((plus - minus)/(2.0_dp*step) - gradient(axis))/(1.0_dp + abs(gradient(axis))))
177 second_error = max(second_error, &
178 maxval(abs((gp - gm)/(2.0_dp*step) - hessian(:, axis))/ &
179 (1.0_dp + abs(hessian(:, axis)))))
183 DEALLOCATE (x, trial, gradient, gp, gm, hessian, scratch)
185 WRITE (*,
'(A,2ES15.6)')
'Libxc projected-tau first/second derivative errors:', first_error, second_error
186 IF (first_error > 3.e-8_dp) error stop
'Libxc projected-tau potential is not the energy derivative'
187 IF (second_error > 2.e-6_dp) error stop
'Libxc projected-tau kernel is not the potential derivative'
188 END SUBROUTINE check_libxc_tau_projection
193 SUBROUTINE check_libxc_c2_window()
194 CHARACTER(len=32),
PARAMETER :: names(4) = [character(len=32)::
'MGGA_X_TPSS',
'MGGA_C_TPSS',&
195 'MGGA_X_R2SCAN',
'MGGA_C_R2SCAN']
196 REAL(
dp),
PARAMETER :: offsets(3) = [-0.6_dp, 0.2_dp, 0.6_dp], &
197 relative_width = 64.0_dp*sqrt(epsilon(0.0_dp))
199 INTEGER :: axis, configuration, family, nvar, &
201 REAL(
dp) :: em, emm, energy, ep, epp, first_error, &
202 first_fd, h, second_error, &
203 third_error, wa, wb, widtha, widthb
204 REAL(
dp),
ALLOCATABLE :: gm(:), gmm(:), gp(:), gpp(:), gradient(:), hessian(:, :), hm(:, :), &
205 hmm(:, :), hp(:, :), hpp(:, :), third(:, :, :), trial(:), x(:)
210 second_error = 0.0_dp
214 IF (spin_case == 2) nvar = 7
215 ALLOCATE (x(nvar), trial(nvar), gradient(nvar), gm(nvar), gp(nvar), &
216 gmm(nvar), gpp(nvar), hessian(nvar, nvar), &
217 third(nvar, nvar, nvar), hm(nvar, nvar), hp(nvar, nvar), hmm(nvar, nvar), hpp(nvar, nvar))
218 DO family = 1,
SIZE(names)
219 DO configuration = 1,
SIZE(offsets)
220 IF (spin_case == 1)
THEN
221 x(:) = [0.4_dp, 0.64_dp, 0.3_dp]
222 wa = x(2)/(8.0_dp*x(1))
223 widtha = relative_width*wa
224 x(3) = wa + offsets(configuration)*widtha
226 x(:) = [0.3_dp, 0.2_dp, 0.055_dp, 0.16_dp, 0.09_dp, 0.12_dp, 0.10_dp]
227 wa = x(4)/(8.0_dp*x(1))
228 wb = x(5)/(8.0_dp*x(2))
229 widtha = relative_width*wa
230 widthb = relative_width*wb
231 x(6) = wa + offsets(configuration)*widtha
232 x(7) = wb - offsets(configuration)*widthb
235 IF (family <= 2)
THEN
236 CALL evaluate_libxc_point(names(family), x, energy, gradient, hessian, third_all=third, contractions=.true.)
238 CALL evaluate_libxc_point(names(family), x, energy, gradient, hessian, contractions=.true.)
242 IF (spin_case == 1)
THEN
243 IF (axis == 1) h = 0.01_dp*widtha/(wa/x(1))
244 IF (axis == 2) h = 0.01_dp*widtha/(wa/x(2))
246 IF (axis == 1) h = 0.01_dp*widtha/(wa/x(1))
247 IF (axis == 2) h = 0.01_dp*widthb/(wb/x(2))
248 IF (axis == 3) h = 1.e-5_dp
249 IF (axis == 4) h = 0.01_dp*widtha/(wa/x(4))
250 IF (axis == 5) h = 0.01_dp*widthb/(wb/x(5))
251 IF (axis == 7) h = 0.01_dp*widthb
253 trial(:) = x(:); trial(axis) = x(axis) + h
254 CALL evaluate_libxc_point(names(family), trial, ep, gp, hp, contractions=.true.)
255 trial(axis) = x(axis) - h
256 CALL evaluate_libxc_point(names(family), trial, em, gm, hm, contractions=.true.)
257 trial(axis) = x(axis) + 2.0_dp*h
258 CALL evaluate_libxc_point(names(family), trial, epp, gpp, hpp, contractions=.true.)
259 trial(axis) = x(axis) - 2.0_dp*h
260 CALL evaluate_libxc_point(names(family), trial, emm, gmm, hmm, contractions=.true.)
261 first_fd = (8.0_dp*(ep - em) - (epp - emm))/(12.0_dp*h)
262 first_error = max(first_error, abs(first_fd - gradient(axis))/(1.0_dp + abs(gradient(axis))))
263 second_error = max(second_error, &
264 maxval(abs((8.0_dp*(gp - gm) - (gpp - gmm))/(12.0_dp*h) - hessian(:, axis))/(1.0_dp + abs(hessian(:, axis)))))
265 IF (family <= 2)
THEN
266 third_error = max(third_error, &
267 maxval(abs((8.0_dp*(hp - hm) - (hpp - hmm))/(12.0_dp*h) - third(:, :, axis))/ &
268 (1.0_dp + abs(third(:, :, axis)))))
273 DEALLOCATE (x, trial, gradient, gm, gp, gmm, gpp, hessian, third, hm, hp, hmm, hpp)
275 WRITE (*,
'(A,3ES15.6)')
'Libxc C2-window first/second/third derivative errors:', first_error, second_error, third_error
276 IF (first_error > 2.e-6_dp) error stop
'C2-window energy Jacobian failed'
277 IF (second_error > 2.e-5_dp) error stop
'C2-window potential Hessian failed'
278 IF (third_error > 2.e-5_dp) error stop
'C2-window kernel third derivatives failed'
279 END SUBROUTINE check_libxc_c2_window
284 SUBROUTINE check_libxc_c2_rounding()
285 CHARACTER(len=32),
PARAMETER :: names(4) = [character(len=32)::
'MGGA_X_TPSS',
'MGGA_C_TPSS',&
286 'MGGA_X_R2SCAN',
'MGGA_C_R2SCAN']
287 REAL(
dp),
PARAMETER :: relative_width = 64.0_dp*sqrt(epsilon(0.0_dp))
289 INTEGER :: channel, family, nvar, spin_case, &
291 REAL(
dp) :: curve, energy, error, expected, slope, &
293 REAL(
dp),
ALLOCATABLE :: gp(:), gradient(:), hessian(:, :), &
294 hp(:, :), probe(:), x(:)
299 IF (spin_case == 2) nvar = 7
300 ALLOCATE (x(nvar), probe(nvar), gradient(nvar), gp(nvar), hessian(nvar, nvar), hp(nvar, nvar))
301 DO family = 1,
SIZE(names)
302 IF (spin_case == 1)
THEN
303 x(:) = [0.4_dp, 0.8_dp, 0.3_dp]
304 w(1) = x(2)**2/(8.0_dp*x(1))
306 x(:) = [0.3_dp, 0.2_dp, 0.6_dp, 0.4_dp, 0.3_dp, 0.12_dp, 0.10_dp]
307 w(1) = x(4)**2/(8.0_dp*x(1))
308 w(2) = x(5)**2/(8.0_dp*x(2))
311 DO channel = 1, spin_case
312 tau_axis = nvar - spin_case + channel
313 width(channel) = relative_width*w(channel)
314 x(tau_axis) = w(channel) + 0.99999_dp*width(channel)
316 probe(tau_axis) = w(channel) + 1.00001_dp*width(channel)
318 CALL evaluate_libxc_point(names(family), x, energy, gradient, hessian)
319 CALL evaluate_libxc_point(names(family), probe, energy, gp, hp)
320 DO channel = 1, spin_case
321 tau_axis = nvar - spin_case + channel
322 u = (x(tau_axis) - w(channel))/width(channel)
323 slope = (1.0_dp + u)**2*(2.0_dp - u)/4.0_dp
324 curve = 0.75_dp*(1.0_dp - u*u)/width(channel)
325 expected = hp(tau_axis, tau_axis)*slope*slope + gp(tau_axis)*curve
326 error = max(error, abs(hessian(tau_axis, tau_axis) - expected)/(1.0_dp + abs(expected)))
329 DEALLOCATE (x, probe, gradient, gp, hessian, hp)
331 WRITE (*,
'(A,ES15.6)')
'Libxc rounded-window curvature error:', error
332 IF (error > 2.e-6_dp) error stop
'Rounded energy value discarded C2 projection curvature'
333 END SUBROUTINE check_libxc_c2_rounding
338 SUBROUTINE check_libxc_individual_floor()
339 CHARACTER(len=24),
PARAMETER :: names(6) = [character(len=24) ::
'LDA_C_PW',
'GGA_C_PBE', &
340 'MGGA_X_TPSS',
'MGGA_C_TPSS',
'MGGA_X_R2SCAN',
'MGGA_C_R2SCAN']
342 INTEGER :: axis, configuration, f
343 REAL(
dp) :: energy, error_first, error_second, error_third, gm(7), gp(7), gradient(7), &
344 hessian(7, 7), hm(7, 7), hp(7, 7), minus, plus, step, third(2, 2, 2), trial(7), x(7)
347 error_second = 0.0_dp
349 DO f = 1,
SIZE(names)
350 DO configuration = 1, 6
351 x = [0.6_dp, 0.01_dp, 0.21_dp, 0.2_dp, 0.02_dp, 0.3_dp, 0.2_dp]
352 SELECT CASE (configuration)
358 x(1:2) = [0.01_dp, 0.6_dp]
362 x(1:2) = [-0.01_dp, 0.6_dp]
365 CALL evaluate_libxc_point(trim(names(f)), x, energy, gradient, hessian, 0.05_dp, third)
367 CALL evaluate_libxc_point(trim(names(f)), x, energy, gradient, hessian, 0.05_dp)
372 trial(axis) = x(axis) + step
373 CALL evaluate_libxc_point(trim(names(f)), trial, plus, gp, hp, 0.05_dp)
374 trial(axis) = x(axis) - step
375 CALL evaluate_libxc_point(trim(names(f)), trial, minus, gm, hm, 0.05_dp)
376 error_first = max(error_first, abs((plus - minus)/(2.0_dp*step) - gradient(axis)))
377 error_second = max(error_second, maxval(abs((gp - gm)/(2.0_dp*step) - hessian(:, axis))))
378 IF (f <= 2 .AND. axis <= 2)
THEN
379 error_third = max(error_third, maxval(abs((hp(1:2, 1:2) - hm(1:2, 1:2))/ &
380 (2.0_dp*step) - third(:, :, axis))))
385 WRITE (*,
'(A,3ES15.6)')
'Libxc individual spin-floor first/second/third derivative errors:', &
386 error_first, error_second, error_third
387 IF (error_first > 2.e-7_dp) error stop
'Libxc individual spin-floor potential is not an energy derivative'
388 IF (error_second > 2.e-6_dp) error stop
'Libxc individual spin-floor kernel is not a potential derivative'
389 IF (error_third > 2.e-5_dp) error stop
'Libxc individual spin-floor third derivatives are inconsistent'
390 END SUBROUTINE check_libxc_individual_floor
404 SUBROUTINE evaluate_libxc_point(name, x, energy, gradient, hessian, density_cutoff, third_rho, third_all, contractions)
405 CHARACTER(len=*),
INTENT(IN) :: name
406 REAL(
dp),
INTENT(IN) :: x(:)
407 REAL(
dp),
INTENT(OUT) :: energy, gradient(size(x)), &
408 hessian(size(x), size(x))
409 REAL(
dp),
INTENT(IN),
OPTIONAL :: density_cutoff
410 REAL(
dp),
INTENT(OUT),
OPTIONAL :: third_rho(2, 2, 2), third_all(size(x), size(x), size(x))
411 LOGICAL,
INTENT(IN),
OPTIONAL :: contractions
413 INTEGER :: bounds(2, 3), i, j, k, labels(7), &
415 LOGICAL :: use_contractions
417 REAL(
dp),
POINTER :: values(:, :, :)
425 use_contractions = .false.
426 IF (
PRESENT(contractions)) use_contractions = contractions
428 needs%norm_drho = .true.
429 IF (
SIZE(x) == 3)
THEN
434 needs%laplace_rho = .true.
438 needs%rho_spin = .true.
439 needs%norm_drho_spin = .true.
440 needs%tau_spin = .true.
441 needs%laplace_rho_spin = .true.
443 IF (use_contractions)
THEN
444 IF (nspins == 1)
THEN
451 IF (
PRESENT(density_cutoff)) cutoff = density_cutoff
454 IF (nspins == 1)
THEN
456 rho_set%norm_drho = x(2)
458 rho_set%laplace_rho = 0.0_dp
459 IF (use_contractions) rho_set%norm_drho = sqrt(x(2))
463 rho_set%norm_drho = x(3)
464 rho_set%norm_drhoa = x(4)
465 rho_set%norm_drhob = x(5)
468 rho_set%laplace_rhoa = 0.0_dp
469 rho_set%laplace_rhob = 0.0_dp
470 IF (use_contractions)
THEN
471 rho_set%norm_drho = sqrt(2.0_dp*x(3) + x(4) + x(5))
472 rho_set%norm_drhoa = sqrt(x(4))
473 rho_set%norm_drhob = sqrt(x(5))
489 IF (
PRESENT(third_rho) .OR.
PRESENT(third_all))
THEN
490 IF (
PRESENT(third_rho) .AND. nspins /= 2) error stop
'Spin third-derivative oracle requires two spins'
495 derivative =>
xc_dset_get_derivative(derivatives, [labels(i), labels(j), labels(k)], allocate_deriv=.true.)
503 IF (nspins == 1)
THEN
510 energy = values(1, 1, 1)
514 gradient(i) = values(1, 1, 1) - 0.125_dp
518 hessian(i, j) = values(1, 1, 1) - 0.125_dp
519 hessian(j, i) = hessian(i, j)
522 IF (
PRESENT(third_rho))
THEN
528 third_rho(i, j, k) = values(1, 1, 1) - 0.125_dp
533 IF (
PRESENT(third_all))
THEN
539 third_all(i, j, k) = values(1, 1, 1) - 0.125_dp
543 IF (.NOT. all(ieee_is_finite(third_all))) error stop
'Nonfinite Libxc third derivatives'
545 IF (.NOT. ieee_is_finite(energy) .OR. .NOT. all(ieee_is_finite(gradient)) .OR. &
546 .NOT. all(ieee_is_finite(hessian))) error stop
'Nonfinite Libxc projected-tau result'
549 END SUBROUTINE evaluate_libxc_point
560 SUBROUTINE evaluate(x, energy, gradient, hessian, derivative_order)
561 REAL(dp),
INTENT(IN) :: x(5)
562 REAL(dp),
INTENT(OUT) :: energy, gradient(5), hessian(5, 5)
563 INTEGER,
INTENT(IN),
OPTIONAL :: derivative_order
565 INTEGER :: bounds(2, 3), i, j, order
566 REAL(dp),
POINTER :: values(:, :, :)
573 IF (
PRESENT(derivative_order)) order = derivative_order
576 needs%norm_drho = .true.
581 rho_set%norm_drho = x(3)
582 rho_set%norm_drhoa = x(4)
583 rho_set%norm_drhob = x(5)
584 rho_set%has%rho_spin = .true.
585 rho_set%has%norm_drho = .true.
586 rho_set%has%norm_drho_spin = .true.
599 CALL xc_functionals_eval(functional, lsd=.true., rho_set=rho_set, deriv_set=derivatives, deriv_order=order)
602 energy = values(1, 1, 1)
606 gradient(i) = values(1, 1, 1) - 0.125_dp
610 hessian(i, j) = values(1, 1, 1) - 0.125_dp
611 IF (order == 1) hessian(i, j) = 0.0_dp
612 hessian(j, i) = hessian(i, j)
622 SUBROUTINE check_tpss_zero_gradient()
623 REAL(dp),
PARAMETER :: step = 1.e-5_dp, tau_scales(3) = [0.2_dp, 1.0_dp, 2.0_dp]
625 INTEGER :: axis, configuration
626 REAL(dp) :: energy, error, gradient(3), minus, plus, &
627 scratch(3), tau_unif, trial(3), x(3)
631 tau_unif = 0.3_dp*(3.0_dp*
pi**2)**(2.0_dp/3.0_dp)*x(1)**(5.0_dp/3.0_dp)
632 DO configuration = 1,
SIZE(tau_scales)
634 x(3) = tau_scales(configuration)*tau_unif
635 CALL evaluate_tpss_point(x, energy, gradient)
636 IF (abs(gradient(2)) > 1.e-13_dp) error stop
'TPSS has a nonzero derivative at zero density gradient'
639 trial(axis) = x(axis) + step
640 CALL evaluate_tpss_point(trial, plus, scratch)
641 trial(axis) = x(axis) - step
642 CALL evaluate_tpss_point(trial, minus, scratch)
643 error = max(error, abs((plus - minus)/(2.0_dp*step) - gradient(axis)))
646 trial(2) = 1.e-100_dp
647 CALL evaluate_tpss_point(trial, plus, scratch)
648 IF (abs(plus - energy) > 1.e-13_dp .OR. abs(scratch(2)) > 1.e-20_dp)
THEN
649 error stop
'TPSS does not approach its zero-gradient limit continuously'
652 CALL evaluate_tpss_point(x, energy, gradient)
654 trial(2) = x(2) + step
655 CALL evaluate_tpss_point(trial, plus, scratch)
656 trial(2) = x(2) - step
657 CALL evaluate_tpss_point(trial, minus, scratch)
658 error = max(error, abs((plus - minus)/(2.0_dp*step) - gradient(2)))
661 x = [0.4_dp, 1.2_dp, 0.05_dp]
662 CALL evaluate_tpss_point(x, energy, gradient)
665 trial(axis) = x(axis) + step
666 CALL evaluate_tpss_point(trial, plus, scratch)
667 trial(axis) = x(axis) - step
668 CALL evaluate_tpss_point(trial, minus, scratch)
669 error = max(error, abs((plus - minus)/(2.0_dp*step) - gradient(axis)))
672 DO configuration = 1, 2
673 x = [0.4_dp, 1.2_dp, -0.05_dp]
674 IF (configuration == 2) x(2) = 0.0_dp
675 CALL evaluate_tpss_point(x, energy, gradient)
676 IF (abs(energy) < 1.e-4_dp .OR. gradient(3) /= 0.0_dp)
THEN
677 error stop
'TPSS negative-tau continuation is not finite and constant in tau'
680 IF (axis == 2 .AND. configuration == 2) cycle
682 trial(axis) = x(axis) + step
683 CALL evaluate_tpss_point(trial, plus, scratch)
684 trial(axis) = x(axis) - step
685 CALL evaluate_tpss_point(trial, minus, scratch)
686 error = max(error, abs((plus - minus)/(2.0_dp*step) - gradient(axis)))
689 x = [0.4_dp, 1.2_dp, 0.0_dp]
690 CALL evaluate_tpss_point(x, energy, gradient)
693 CALL evaluate_tpss_point(trial, plus, scratch)
694 trial(3) = -1.e-10_dp
695 CALL evaluate_tpss_point(trial, minus, scratch)
696 IF (max(abs(plus - energy), abs(minus - energy)) > 1.e-9_dp)
THEN
697 error stop
'TPSS energy is discontinuous through zero kinetic density'
699 WRITE (*,
'(A,ES15.6)')
'TPSS limiting-density first-derivative error:', error
700 IF (error > 3.e-8_dp) error stop
'TPSS limiting-density potential is not the energy derivative'
701 END SUBROUTINE check_tpss_zero_gradient
706 SUBROUTINE check_xwpbe_limits()
707 REAL(dp),
PARAMETER :: reduced_gradients(3) = [0.0_dp, 0.2_dp, 12.0_dp], step = 1.e-5_dp
709 INTEGER :: axis, configuration, range_case
710 REAL(dp) :: energy, error, gr(3), gs(5), &
711 hessian(5, 5), minus, plus, &
712 scratchr(3), scratchs(5), trialr(3), &
713 trials(5), xr(3), xs(5)
720 DO configuration = 1,
SIZE(reduced_gradients)
721 xr = [0.4_dp, 0.0_dp, 0.5_dp]
722 xr(2) = reduced_gradients(configuration)*2.0_dp*(3.0_dp*
pi**2)**(1.0_dp/3.0_dp)*xr(1)**(4.0_dp/3.0_dp)
723 CALL evaluate_tpss_point(xr, energy, gr)
725 IF (axis == 2 .AND. configuration == 1) cycle
726 trialr = xr; trialr(axis) = xr(axis) + step
727 CALL evaluate_tpss_point(trialr, plus, scratchr)
728 trialr(axis) = xr(axis) - step
729 CALL evaluate_tpss_point(trialr, minus, scratchr)
730 error = max(error, abs((plus - minus)/(2.0_dp*step) - gr(axis))/(1.0_dp + abs(gr(axis))))
732 IF (configuration == 1)
THEN
733 IF (abs(gr(2)) > 1.e-13_dp) error stop
'XWPBE zero-gradient potential is not stationary'
734 trialr = xr; trialr(2) = 1.e-8_dp
735 CALL evaluate_tpss_point(trialr, plus, scratchr)
736 IF (abs(plus - energy) > 1.e-12_dp) error stop
'XWPBE zero-gradient energy is discontinuous'
738 xs = [0.3_dp, 0.2_dp, 0.3_dp, 0.0_dp, 0.0_dp]
739 xs(4) = reduced_gradients(configuration)*2.0_dp*(3.0_dp*
pi**2)**(1.0_dp/3.0_dp)*(2.0_dp*xs(1))**(4.0_dp/3.0_dp)/2.0_dp
740 xs(5) = reduced_gradients(configuration)*2.0_dp*(3.0_dp*
pi**2)**(1.0_dp/3.0_dp)*(2.0_dp*xs(2))**(4.0_dp/3.0_dp)/2.0_dp
741 CALL evaluate(xs, energy, gs, hessian, derivative_order=1)
743 IF (axis >= 4 .AND. configuration == 1) cycle
744 trials = xs; trials(axis) = xs(axis) + step
745 CALL evaluate(trials, plus, scratchs, hessian, derivative_order=1)
746 trials(axis) = xs(axis) - step
747 CALL evaluate(trials, minus, scratchs, hessian, derivative_order=1)
748 error = max(error, abs((plus - minus)/(2.0_dp*step) - gs(axis))/(1.0_dp + abs(gs(axis))))
750 IF (configuration == 1 .AND. maxval(abs(gs(4:5))) > 1.e-13_dp) error stop
'XWPBE spin zero-gradient potential is not stationary'
753 WRITE (*,
'(A,ES15.6)')
'XWPBE limiting/large-gradient first-derivative error:', error
754 IF (error > 3.e-8_dp) error stop
'XWPBE potential is not the derivative of its scaled-gradient energy'
755 END SUBROUTINE check_xwpbe_limits
763 SUBROUTINE evaluate_tpss_point(x, energy, gradient)
764 REAL(dp),
INTENT(IN) :: x(3)
765 REAL(dp),
INTENT(OUT) :: energy, gradient(3)
769 INTEGER :: bounds(2, 3), i
770 REAL(dp),
POINTER :: values(:, :, :)
779 CALL xc_rho_set_create(rho_set, bounds, rho_cutoff=1.e-20_dp, tau_cutoff=1.e-20_dp)
782 rho_set%norm_drho = x(2)
784 rho_set%has%rho = .true.
785 rho_set%has%norm_drho = .true.
786 rho_set%has%tau = .true.
788 DO i = 1,
SIZE(labels)
793 CALL xc_functionals_eval(functional, lsd=.false., rho_set=rho_set, deriv_set=derivatives, deriv_order=1)
796 energy = values(1, 1, 1)
797 DO i = 1,
SIZE(labels)
800 gradient(i) = values(1, 1, 1) - 0.125_dp
802 IF (.NOT. ieee_is_finite(energy) .OR. .NOT. all(ieee_is_finite(gradient)))
THEN
803 error stop
'TPSS energy or first derivative is nonfinite at a stationary density point'
807 END SUBROUTINE evaluate_tpss_point
Defines the basic variable types.
integer, parameter, public dp
subroutine, public cp2k_finalize()
...
subroutine, public cp2k_init()
...
Definition of mathematical constants and functions.
real(kind=dp), parameter, public pi
subroutine, public xc_rho_set_atom_update(rho_set, needs, nspins, bo)
...
Module with functions to handle derivative descriptors. derivative description are strings have the f...
integer, parameter, public deriv_norm_drho
integer, parameter, public deriv_gamma
integer, parameter, public deriv_norm_drhoa
integer, parameter, public deriv_rhob
integer, parameter, public deriv_gamma_aa
integer, parameter, public deriv_rhoa
integer, parameter, public deriv_tau
integer, parameter, public deriv_tau_b
integer, parameter, public deriv_tau_a
integer, parameter, public deriv_rho
integer, parameter, public deriv_gamma_bb
integer, parameter, public deriv_norm_drhob
integer, parameter, public deriv_gamma_ab
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
subroutine, public xc_dset_release(derivative_set)
releases a derivative set
subroutine, public xc_dset_create(derivative_set, pw_pool, local_bounds)
creates a derivative set object
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
type(xc_rho_cflags_type) function, public xc_functionals_get_needs(functionals, lsd, calc_potential)
...
subroutine, public xc_functionals_eval(functionals, lsd, rho_set, deriv_set, deriv_order)
...
calculates a functional from libxc and its derivatives
subroutine, public libxc_spin_unpolarized_eval(rho_set, deriv_set, grad_deriv, libxc_params, func_name_override)
evaluates the functional from libxc
subroutine, public libxc_spin_polarized_eval(rho_set, deriv_set, grad_deriv, libxc_params, func_name_override)
evaluates the functional from libxc
subroutine, public xc_rho_set_create(rho_set, local_bounds, rho_cutoff, drho_cutoff, tau_cutoff)
allocates and does (minimal) initialization of a rho_set
subroutine, public xc_rho_set_release(rho_set, pw_pool)
releases the given rho_set
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
subroutine evaluate(x, energy, gradient, hessian, derivative_order)
Evaluate native PBE in its independent spin-density and gradient-norm variables.
program xc_semilocal_unittest