Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : MODULE xc_derivatives
10 :
11 : USE input_section_types, ONLY: section_vals_get_subs_vals2,&
12 : section_vals_type,&
13 : section_vals_val_get
14 : USE kinds, ONLY: default_string_length,&
15 : dp
16 : USE string_utilities, ONLY: uppercase
17 : USE xc_b97, ONLY: b97_lda_eval,&
18 : b97_lda_info,&
19 : b97_lsd_eval,&
20 : b97_lsd_info
21 : USE xc_cs1, ONLY: cs1_lda_eval,&
22 : cs1_lda_info,&
23 : cs1_lsd_eval,&
24 : cs1_lsd_info
25 : USE xc_derivative_set_types, ONLY: xc_derivative_set_type
26 : USE xc_exchange_gga, ONLY: xgga_eval,&
27 : xgga_info
28 : USE xc_gauxc_functional, ONLY: skala_info
29 : USE xc_hcth, ONLY: hcth_lda_eval,&
30 : hcth_lda_info
31 : USE xc_ke_gga, ONLY: ke_gga_info,&
32 : ke_gga_lda_eval,&
33 : ke_gga_lsd_eval
34 : USE xc_libxc, ONLY: libxc_spin_polarized_eval,&
35 : libxc_spin_polarized_info,&
36 : libxc_spin_unpolarized_eval,&
37 : libxc_spin_unpolarized_info
38 : USE xc_lyp, ONLY: lyp_lda_eval,&
39 : lyp_lda_info,&
40 : lyp_lsd_eval,&
41 : lyp_lsd_info
42 : USE xc_lyp_adiabatic, ONLY: lyp_adiabatic_lda_eval,&
43 : lyp_adiabatic_lda_info,&
44 : lyp_adiabatic_lsd_eval,&
45 : lyp_adiabatic_lsd_info
46 : USE xc_optx, ONLY: optx_lda_eval,&
47 : optx_lda_info,&
48 : optx_lsd_eval,&
49 : optx_lsd_info
50 : USE xc_pade, ONLY: pade_info,&
51 : pade_init,&
52 : pade_lda_pw_eval,&
53 : pade_lsd_pw_eval
54 : USE xc_pbe, ONLY: pbe_lda_eval,&
55 : pbe_lda_info,&
56 : pbe_lsd_eval,&
57 : pbe_lsd_info
58 : USE xc_perdew86, ONLY: p86_lda_eval,&
59 : p86_lda_info
60 : USE xc_perdew_wang, ONLY: perdew_wang_info,&
61 : perdew_wang_lda_eval,&
62 : perdew_wang_lsd_eval
63 : USE xc_perdew_zunger, ONLY: pz_info,&
64 : pz_lda_eval,&
65 : pz_lsd_eval
66 : USE xc_rho_cflags_types, ONLY: xc_rho_cflags_setall,&
67 : xc_rho_cflags_type
68 : USE xc_rho_set_types, ONLY: xc_rho_set_get,&
69 : xc_rho_set_type
70 : USE xc_tfw, ONLY: tfw_lda_eval,&
71 : tfw_lda_info,&
72 : tfw_lsd_eval,&
73 : tfw_lsd_info
74 : USE xc_thomas_fermi, ONLY: thomas_fermi_info,&
75 : thomas_fermi_lda_eval,&
76 : thomas_fermi_lsd_eval
77 : USE xc_tpss, ONLY: tpss_lda_eval,&
78 : tpss_lda_info
79 : USE xc_vwn, ONLY: vwn_lda_eval,&
80 : vwn_lda_info,&
81 : vwn_lsd_eval,&
82 : vwn_lsd_info
83 : USE xc_xalpha, ONLY: xalpha_info,&
84 : xalpha_lda_eval,&
85 : xalpha_lsd_eval
86 : USE xc_xbecke88, ONLY: xb88_lda_eval,&
87 : xb88_lda_info,&
88 : xb88_lsd_eval,&
89 : xb88_lsd_info
90 : USE xc_xbecke88_long_range, ONLY: xb88_lr_lda_eval,&
91 : xb88_lr_lda_info,&
92 : xb88_lr_lsd_eval,&
93 : xb88_lr_lsd_info
94 : USE xc_xbecke88_lr_adiabatic, ONLY: xb88_lr_adiabatic_lda_eval,&
95 : xb88_lr_adiabatic_lda_info,&
96 : xb88_lr_adiabatic_lsd_eval,&
97 : xb88_lr_adiabatic_lsd_info
98 : USE xc_xbecke_roussel, ONLY: xbecke_roussel_lda_eval,&
99 : xbecke_roussel_lda_info,&
100 : xbecke_roussel_lsd_eval,&
101 : xbecke_roussel_lsd_info
102 : USE xc_xbeef, ONLY: xbeef_lda_eval,&
103 : xbeef_lda_info,&
104 : xbeef_lsd_eval,&
105 : xbeef_lsd_info
106 : USE xc_xbr_pbe_lda_hole_t_c_lr, ONLY: xbr_pbe_lda_hole_tc_lr_lda_eval,&
107 : xbr_pbe_lda_hole_tc_lr_lda_info,&
108 : xbr_pbe_lda_hole_tc_lr_lsd_eval,&
109 : xbr_pbe_lda_hole_tc_lr_lsd_info
110 : USE xc_xlda_hole_t_c_lr, ONLY: xlda_hole_t_c_lr_lda_eval,&
111 : xlda_hole_t_c_lr_lda_info,&
112 : xlda_hole_t_c_lr_lsd_eval,&
113 : xlda_hole_t_c_lr_lsd_info
114 : USE xc_xpbe_hole_t_c_lr, ONLY: xpbe_hole_t_c_lr_lda_eval,&
115 : xpbe_hole_t_c_lr_lda_info,&
116 : xpbe_hole_t_c_lr_lsd_eval,&
117 : xpbe_hole_t_c_lr_lsd_info
118 : USE xc_xwpbe, ONLY: xwpbe_lda_eval,&
119 : xwpbe_lda_info,&
120 : xwpbe_lsd_eval,&
121 : xwpbe_lsd_info
122 : #include "../base/base_uses.f90"
123 :
124 : IMPLICIT NONE
125 :
126 : PRIVATE
127 :
128 : LOGICAL, PARAMETER :: debug_this_module = .FALSE.
129 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xc_derivatives'
130 :
131 : PUBLIC :: xc_functional_get_info, xc_functionals_eval, xc_functionals_get_needs
132 :
133 : CONTAINS
134 :
135 : ! **************************************************************************************************
136 : !> \brief get the information about the given functional
137 : !> \param functional the functional you want info about
138 : !> \param lsd if you are using lsd or lda
139 : !> \param reference the reference to the acticle where the functional is
140 : !> explained
141 : !> \param shortform the short definition of the functional
142 : !> \param needs the flags corresponding to the inputs needed by this
143 : !> functional are set to true (the flags not needed aren't touched)
144 : !> \param max_deriv the maximal derivative available
145 : !> \param print_warn whether to print warnings (mainly relevant for libxc)
146 : !> \author fawzi
147 : ! **************************************************************************************************
148 298707 : SUBROUTINE xc_functional_get_info(functional, lsd, reference, shortform, &
149 : needs, max_deriv, print_warn)
150 : TYPE(section_vals_type), POINTER :: functional
151 : LOGICAL, INTENT(in) :: lsd
152 : CHARACTER(LEN=*), INTENT(OUT), OPTIONAL :: reference, shortform
153 : TYPE(xc_rho_cflags_type), INTENT(inout), OPTIONAL :: needs
154 : INTEGER, INTENT(out), OPTIONAL :: max_deriv
155 : LOGICAL, INTENT(IN), OPTIONAL :: print_warn
156 :
157 : INTEGER :: i_param
158 : REAL(kind=dp) :: r_param
159 :
160 298707 : CPASSERT(ASSOCIATED(functional))
161 299374 : SELECT CASE (functional%section%name)
162 : CASE ("BECKE97")
163 667 : IF (lsd) THEN
164 : CALL b97_lsd_info(reference=reference, shortform=shortform, &
165 0 : needs=needs, max_deriv=max_deriv, b97_params=functional)
166 : ELSE
167 : CALL b97_lda_info(reference=reference, shortform=shortform, &
168 1993 : needs=needs, max_deriv=max_deriv, b97_params=functional)
169 : END IF
170 : CASE ("BECKE88_LR_ADIABATIC")
171 186 : IF (lsd) THEN
172 : CALL xb88_lr_adiabatic_lsd_info(reference=reference, shortform=shortform, &
173 325 : needs=needs, max_deriv=max_deriv)
174 : ELSE
175 : CALL xb88_lr_adiabatic_lda_info(reference=reference, shortform=shortform, &
176 229 : needs=needs, max_deriv=max_deriv)
177 : END IF
178 : CASE ("LYP_ADIABATIC")
179 186 : IF (lsd) THEN
180 : CALL lyp_adiabatic_lsd_info(reference=reference, shortform=shortform, &
181 325 : needs=needs, max_deriv=max_deriv)
182 : ELSE
183 : CALL lyp_adiabatic_lda_info(reference=reference, shortform=shortform, &
184 229 : needs=needs, max_deriv=max_deriv)
185 : END IF
186 : CASE ("BEEF")
187 23 : IF (lsd) THEN
188 : CALL xbeef_lsd_info(reference=reference, shortform=shortform, &
189 0 : needs=needs, max_deriv=max_deriv)
190 : ELSE
191 : CALL xbeef_lda_info(reference=reference, shortform=shortform, &
192 67 : needs=needs, max_deriv=max_deriv)
193 : END IF
194 : CASE ("BECKE88")
195 13511 : IF (lsd) THEN
196 : CALL xb88_lsd_info(reference=reference, shortform=shortform, &
197 8601 : needs=needs, max_deriv=max_deriv)
198 : ELSE
199 : CALL xb88_lda_info(reference=reference, shortform=shortform, &
200 31624 : needs=needs, max_deriv=max_deriv)
201 : END IF
202 : CASE ("BECKE88_LR")
203 1633 : IF (lsd) THEN
204 : CALL xb88_lr_lsd_info(reference=reference, shortform=shortform, &
205 169 : needs=needs, max_deriv=max_deriv)
206 : ELSE
207 : CALL xb88_lr_lda_info(reference=reference, shortform=shortform, &
208 4712 : needs=needs, max_deriv=max_deriv)
209 : END IF
210 : CASE ("LYP")
211 11446 : IF (lsd) THEN
212 : CALL lyp_lsd_info(reference=reference, shortform=shortform, &
213 8398 : needs=needs, max_deriv=max_deriv)
214 : ELSE
215 : CALL lyp_lda_info(reference=reference, shortform=shortform, &
216 25650 : needs=needs, max_deriv=max_deriv)
217 : END IF
218 : CASE ("PADE")
219 268110 : CALL pade_info(reference, shortform, lsd=lsd, needs=needs)
220 : CASE ("HCTH")
221 589 : CALL section_vals_val_get(functional, "PARAMETER_SET", i_val=i_param)
222 589 : CPASSERT(.NOT. lsd)
223 1763 : CALL hcth_lda_info(i_param, reference, shortform, needs, max_deriv)
224 : CASE ("OPTX")
225 916 : IF (lsd) THEN
226 1441 : CALL optx_lsd_info(reference, shortform, needs, max_deriv)
227 : ELSE
228 1299 : CALL optx_lda_info(reference, shortform, needs, max_deriv)
229 : END IF
230 : CASE ("CS1")
231 33 : IF (lsd) THEN
232 0 : CALL cs1_lsd_info(reference, shortform, needs, max_deriv)
233 : ELSE
234 97 : CALL cs1_lda_info(reference, shortform, needs=needs, max_deriv=max_deriv)
235 : END IF
236 : CASE ("XGGA")
237 14 : CALL section_vals_val_get(functional, "FUNCTIONAL", i_val=i_param)
238 38 : CALL xgga_info(i_param, lsd, reference, shortform, needs, max_deriv)
239 : CASE ("KE_GGA")
240 2042 : CALL section_vals_val_get(functional, "FUNCTIONAL", i_val=i_param)
241 6126 : CALL ke_gga_info(i_param, lsd, reference, shortform, needs, max_deriv)
242 : CASE ("P86C")
243 215 : IF (lsd) THEN
244 0 : CPABORT("BP functional not implemented with LSD")
245 : END IF
246 631 : CALL p86_lda_info(reference, shortform, needs, max_deriv)
247 : CASE ("PW92")
248 337 : CALL section_vals_val_get(functional, "PARAMETRIZATION", i_val=i_param)
249 337 : CALL section_vals_val_get(functional, "SCALE", r_val=r_param)
250 : CALL perdew_wang_info(i_param, lsd, reference, shortform, needs, max_deriv, &
251 989 : r_param)
252 : CASE ("PZ81")
253 39 : CALL section_vals_val_get(functional, "PARAMETRIZATION", i_val=i_param)
254 115 : CALL pz_info(i_param, lsd, reference, shortform, needs, max_deriv)
255 : CASE ("TFW")
256 0 : IF (lsd) THEN
257 0 : CALL tfw_lsd_info(reference, shortform, needs, max_deriv)
258 : ELSE
259 0 : CALL tfw_lda_info(reference, shortform, needs, max_deriv)
260 : END IF
261 : CASE ("TF")
262 672 : CALL thomas_fermi_info(lsd, reference, shortform, needs, max_deriv)
263 : CASE ("VWN")
264 966 : IF (lsd) THEN
265 56 : CALL vwn_lsd_info(reference, shortform, needs, max_deriv)
266 : ELSE
267 2792 : CALL vwn_lda_info(reference, shortform, needs, max_deriv)
268 : END IF
269 : CASE ("XALPHA")
270 3047 : CALL section_vals_val_get(functional, "XA", r_val=r_param)
271 : CALL xalpha_info(lsd, reference, shortform, needs, max_deriv, &
272 9065 : xa_parameter=r_param)
273 : CASE ("TPSS")
274 2611 : IF (lsd) THEN
275 0 : CPABORT("TPSS functional not implemented with LSD. Use the LIBXC version instead.")
276 : ELSE
277 7787 : CALL tpss_lda_info(functional, reference, shortform, needs, max_deriv)
278 : END IF
279 : CASE ("PBE")
280 141618 : IF (lsd) THEN
281 79509 : CALL pbe_lsd_info(functional, reference, shortform, needs, max_deriv)
282 : ELSE
283 343109 : CALL pbe_lda_info(functional, reference, shortform, needs, max_deriv)
284 : END IF
285 : CASE ("GAUXC")
286 575 : IF (gauxc_model_none_selected(functional)) THEN
287 : CALL gauxc_model_none_xc_info(functional, lsd, reference, shortform, &
288 160 : needs, max_deriv, print_warn)
289 : ELSE
290 1547 : CALL skala_info(functional, lsd, reference, shortform, needs, max_deriv)
291 : ! Note: SKALA functional routes through apply_gauxc in qs_ks_methods.F
292 : ! when USE_GAUXC = .TRUE. (requires dft_control%use_gauxc to be set)
293 : END IF
294 : CASE ("XWPBE")
295 4127 : IF (lsd) THEN
296 3488 : CALL xwpbe_lsd_info(reference, shortform, needs, max_deriv)
297 : ELSE
298 8871 : CALL xwpbe_lda_info(reference, shortform, needs, max_deriv)
299 : END IF
300 : CASE ("BECKE_ROUSSEL")
301 191 : IF (lsd) THEN
302 272 : CALL xbecke_roussel_lsd_info(reference, shortform, needs, max_deriv)
303 : ELSE
304 291 : CALL xbecke_roussel_lda_info(reference, shortform, needs, max_deriv)
305 : END IF
306 : CASE ("LDA_HOLE_T_C_LR")
307 90 : IF (lsd) THEN
308 187 : CALL xlda_hole_t_c_lr_lsd_info(reference, shortform, needs, max_deriv)
309 : ELSE
310 79 : CALL xlda_hole_t_c_lr_lda_info(reference, shortform, needs, max_deriv)
311 : END IF
312 : CASE ("PBE_HOLE_T_C_LR")
313 3606 : IF (lsd) THEN
314 3158 : CALL xpbe_hole_t_c_lr_lsd_info(reference, shortform, needs, max_deriv)
315 : ELSE
316 7652 : CALL xpbe_hole_t_c_lr_lda_info(reference, shortform, needs, max_deriv)
317 : END IF
318 : CASE ("GV09")
319 268 : IF (lsd) THEN
320 187 : CALL xbr_pbe_lda_hole_tc_lr_lsd_info(reference, shortform, needs, max_deriv)
321 : ELSE
322 613 : CALL xbr_pbe_lda_hole_tc_lr_lda_info(reference, shortform, needs, max_deriv)
323 : END IF
324 : CASE default
325 : ! If the functional has not been implemented internally, it's from LibXC
326 298707 : IF (lsd) THEN
327 12219 : CALL libxc_spin_polarized_info(functional, reference, shortform, needs, max_deriv, print_warn)
328 : ELSE
329 46966 : CALL libxc_spin_unpolarized_info(functional, reference, shortform, needs, max_deriv, print_warn)
330 : END IF
331 : END SELECT
332 298707 : END SUBROUTINE xc_functional_get_info
333 :
334 : ! **************************************************************************************************
335 : !> \brief evaluate a functional (and its derivatives)
336 : !> \param functional a section that describes the functional to be added
337 : !> \param lsd if a local spin desnity is performed
338 : !> \param rho_set a rho set where all the arguments needed by this functional
339 : !> should be valid (which argument are needed can be found with
340 : !> xc_functional_get_info)
341 : !> \param deriv_set place where to store the functional derivatives (they are
342 : !> added to the derivatives)
343 : !> \param deriv_order degree of the derivative that should be evaluated,
344 : !> if positive all the derivatives up to the given degree are evaluated,
345 : !> if negative only the given degree is requested (but to simplify
346 : !> the code all the derivatives might be calculated, you should ignore
347 : !> them when adding derivatives of various functionals they might contain
348 : !> the derivative of just one functional)
349 : !> \par History
350 : !> 11.2003 created [fawzi]
351 : !> \author fawzi
352 : ! **************************************************************************************************
353 977076 : SUBROUTINE xc_functional_eval(functional, lsd, rho_set, deriv_set, deriv_order)
354 :
355 : TYPE(section_vals_type), POINTER :: functional
356 : LOGICAL, INTENT(in) :: lsd
357 : TYPE(xc_rho_set_type), INTENT(IN) :: rho_set
358 : TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set
359 : INTEGER, INTENT(IN) :: deriv_order
360 :
361 : CHARACTER(len=*), PARAMETER :: abort_message_skala = &
362 : "GauXC functionals are evaluated only through the QS GauXC path. "// &
363 : "Higher XC derivatives for response and kernel properties are not implemented.", &
364 : routineN = 'xc_functional_eval'
365 :
366 : INTEGER :: handle, i_param
367 : LOGICAL :: fun_active
368 : REAL(KIND=dp) :: density_cut, gradient_cut, r_param
369 :
370 325692 : CALL timeset(routineN, handle)
371 :
372 : CALL xc_rho_set_get(rho_set, rho_cutoff=density_cut, &
373 325692 : drho_cutoff=gradient_cut)
374 : CALL section_vals_val_get(functional, "_SECTION_PARAMETERS_", &
375 325692 : l_val=fun_active)
376 325692 : IF (.NOT. fun_active) THEN
377 122 : CALL timestop(handle)
378 122 : RETURN
379 : END IF
380 :
381 325570 : IF (deriv_order < 0) THEN
382 0 : CPABORT("Negative orders of derivative not allowed!")
383 : END IF
384 :
385 326213 : SELECT CASE (functional%section%name)
386 : CASE ("BECKE97")
387 643 : IF (lsd) THEN
388 0 : CALL b97_lsd_eval(rho_set, deriv_set, deriv_order, functional)
389 : ELSE
390 643 : CALL b97_lda_eval(rho_set, deriv_set, deriv_order, functional)
391 : END IF
392 : CASE ("BECKE88_LR_ADIABATIC")
393 176 : IF (lsd) THEN
394 104 : CALL xb88_lr_adiabatic_lsd_eval(rho_set, deriv_set, deriv_order, functional)
395 : ELSE
396 72 : CALL xb88_lr_adiabatic_lda_eval(rho_set, deriv_set, deriv_order, functional)
397 : END IF
398 : CASE ("LYP_ADIABATIC")
399 176 : IF (lsd) THEN
400 104 : CALL lyp_adiabatic_lsd_eval(rho_set, deriv_set, deriv_order, functional)
401 : ELSE
402 72 : CALL lyp_adiabatic_lda_eval(rho_set, deriv_set, deriv_order, functional)
403 : END IF
404 : CASE ("BECKE88")
405 12681 : IF (lsd) THEN
406 3094 : CALL xb88_lsd_eval(rho_set, deriv_set, deriv_order, functional)
407 : ELSE
408 9587 : CALL xb88_lda_eval(rho_set, deriv_set, deriv_order, functional)
409 : END IF
410 : CASE ("BEEF")
411 18 : IF (lsd) THEN
412 0 : CALL xbeef_lsd_eval(rho_set, deriv_set, deriv_order, functional)
413 : ELSE
414 18 : CALL xbeef_lda_eval(rho_set, deriv_set, deriv_order, functional)
415 : END IF
416 : CASE ("BECKE88_LR")
417 1190 : IF (lsd) THEN
418 52 : CALL xb88_lr_lsd_eval(rho_set, deriv_set, deriv_order, functional)
419 : ELSE
420 1138 : CALL xb88_lr_lda_eval(rho_set, deriv_set, deriv_order, functional)
421 : END IF
422 : CASE ("LYP")
423 11317 : IF (lsd) THEN
424 3040 : CALL lyp_lsd_eval(rho_set, deriv_set, deriv_order, functional)
425 : ELSE
426 8277 : CALL lyp_lda_eval(rho_set, deriv_set, deriv_order, functional)
427 : END IF
428 : CASE ("PADE")
429 96770 : CALL pade_init(density_cut)
430 96770 : IF (lsd) THEN
431 16627 : CALL pade_lsd_pw_eval(deriv_set, rho_set, deriv_order)
432 : ELSE
433 80143 : CALL pade_lda_pw_eval(deriv_set, rho_set, deriv_order)
434 : END IF
435 : CASE ("HCTH")
436 565 : CPASSERT(.NOT. lsd)
437 565 : CALL section_vals_val_get(functional, "PARAMETER_SET", i_val=i_param)
438 565 : CALL hcth_lda_eval(i_param, rho_set, deriv_set, deriv_order)
439 : CASE ("OPTX")
440 1040 : IF (lsd) THEN
441 476 : CALL optx_lsd_eval(rho_set, deriv_set, deriv_order, functional)
442 : ELSE
443 564 : CALL optx_lda_eval(rho_set, deriv_set, deriv_order, functional)
444 : END IF
445 : CASE ("CS1")
446 32 : IF (lsd) THEN
447 0 : CALL cs1_lsd_eval(rho_set, deriv_set, deriv_order)
448 : ELSE
449 32 : CALL cs1_lda_eval(rho_set, deriv_set, deriv_order)
450 : END IF
451 : CASE ("XGGA")
452 4 : CALL section_vals_val_get(functional, "FUNCTIONAL", i_val=i_param)
453 4 : CALL xgga_eval(i_param, lsd, rho_set, deriv_set, deriv_order)
454 : CASE ("KE_GGA")
455 1780 : CALL section_vals_val_get(functional, "FUNCTIONAL", i_val=i_param)
456 1780 : IF (lsd) THEN
457 0 : CALL ke_gga_lsd_eval(i_param, rho_set, deriv_set, deriv_order)
458 : ELSE
459 1780 : CALL ke_gga_lda_eval(i_param, rho_set, deriv_set, deriv_order)
460 : END IF
461 : CASE ("P86C")
462 180 : CPASSERT(.NOT. lsd)
463 180 : CALL p86_lda_eval(rho_set, deriv_set, deriv_order, functional)
464 : CASE ("PW92")
465 240 : CALL section_vals_val_get(functional, "PARAMETRIZATION", i_val=i_param)
466 240 : CALL section_vals_val_get(functional, "SCALE", r_val=r_param)
467 240 : IF (lsd) THEN
468 : CALL perdew_wang_lsd_eval(i_param, rho_set, deriv_set, deriv_order, &
469 20 : r_param)
470 : ELSE
471 : CALL perdew_wang_lda_eval(i_param, rho_set, deriv_set, deriv_order, &
472 220 : r_param)
473 : END IF
474 : CASE ("PZ81")
475 50 : CALL section_vals_val_get(functional, "PARAMETRIZATION", i_val=i_param)
476 50 : IF (lsd) THEN
477 12 : CALL pz_lsd_eval(i_param, rho_set, deriv_set, deriv_order, functional)
478 : ELSE
479 38 : CALL pz_lda_eval(i_param, rho_set, deriv_set, deriv_order, functional)
480 : END IF
481 : CASE ("TFW")
482 0 : IF (lsd) THEN
483 0 : CALL tfw_lsd_eval(rho_set, deriv_set, deriv_order)
484 : ELSE
485 0 : CALL tfw_lda_eval(rho_set, deriv_set, deriv_order)
486 : END IF
487 : CASE ("TF")
488 216 : IF (lsd) THEN
489 0 : CALL thomas_fermi_lsd_eval(rho_set, deriv_set, deriv_order)
490 : ELSE
491 216 : CALL thomas_fermi_lda_eval(rho_set, deriv_set, deriv_order)
492 : END IF
493 : CASE ("VWN")
494 1163 : IF (lsd) THEN
495 32 : CALL vwn_lsd_eval(rho_set, deriv_set, deriv_order, functional)
496 : ELSE
497 1131 : CALL vwn_lda_eval(rho_set, deriv_set, deriv_order, functional)
498 : END IF
499 : CASE ("XALPHA")
500 2727 : CALL section_vals_val_get(functional, "XA", r_val=r_param)
501 2727 : IF (lsd) THEN
502 : CALL xalpha_lsd_eval(rho_set, deriv_set, deriv_order, &
503 166 : xa_parameter=r_param, xa_params=functional)
504 : ELSE
505 : CALL xalpha_lda_eval(rho_set, deriv_set, deriv_order, &
506 2561 : xa_parameter=r_param, xa_params=functional)
507 : END IF
508 : CASE ("TPSS")
509 3386 : IF (lsd) THEN
510 0 : CPABORT("TPSS functional not implemented with LSD. Use the LIBXC version instead.")
511 : ELSE
512 3386 : CALL tpss_lda_eval(rho_set, deriv_set, deriv_order, functional)
513 : END IF
514 : CASE ("PBE")
515 157690 : IF (lsd) THEN
516 26341 : CALL pbe_lsd_eval(rho_set, deriv_set, deriv_order, functional)
517 : ELSE
518 131349 : CALL pbe_lda_eval(rho_set, deriv_set, deriv_order, functional)
519 : END IF
520 : CASE ("GAUXC")
521 0 : IF (gauxc_model_none_selected(functional)) THEN
522 0 : CALL gauxc_model_none_xc_eval(functional, lsd, rho_set, deriv_set, deriv_order)
523 : ELSE
524 0 : CPABORT(abort_message_skala)
525 : END IF
526 : CASE ("XWPBE")
527 5092 : IF (lsd) THEN
528 1324 : CALL xwpbe_lsd_eval(rho_set, deriv_set, deriv_order, functional)
529 : ELSE
530 3768 : CALL xwpbe_lda_eval(rho_set, deriv_set, deriv_order, functional)
531 : END IF
532 : CASE ("BECKE_ROUSSEL")
533 166 : IF (lsd) THEN
534 82 : CALL xbecke_roussel_lsd_eval(rho_set, deriv_set, deriv_order, functional)
535 : ELSE
536 84 : CALL xbecke_roussel_lda_eval(rho_set, deriv_set, deriv_order, functional)
537 : END IF
538 : CASE ("LDA_HOLE_T_C_LR")
539 80 : IF (lsd) THEN
540 58 : CALL xlda_hole_t_c_lr_lsd_eval(rho_set, deriv_set, deriv_order, functional)
541 : ELSE
542 22 : CALL xlda_hole_t_c_lr_lda_eval(rho_set, deriv_set, deriv_order, functional)
543 : END IF
544 : CASE ("PBE_HOLE_T_C_LR")
545 4318 : IF (lsd) THEN
546 1196 : CALL xpbe_hole_t_c_lr_lsd_eval(rho_set, deriv_set, deriv_order, functional)
547 : ELSE
548 3122 : CALL xpbe_hole_t_c_lr_lda_eval(rho_set, deriv_set, deriv_order, functional)
549 : END IF
550 : CASE ("GV09")
551 258 : IF (lsd) THEN
552 : CALL xbr_pbe_lda_hole_tc_lr_lsd_eval(rho_set, deriv_set, deriv_order, &
553 58 : functional)
554 : ELSE
555 : CALL xbr_pbe_lda_hole_tc_lr_lda_eval(rho_set, deriv_set, deriv_order, &
556 200 : functional)
557 : END IF
558 : CASE default
559 : ! If functional not natively supported, ask LibXC
560 326135 : IF (lsd) THEN
561 3904 : CALL libxc_spin_polarized_eval(rho_set, deriv_set, deriv_order, functional)
562 : ELSE
563 19708 : CALL libxc_spin_unpolarized_eval(rho_set, deriv_set, deriv_order, functional)
564 : END IF
565 : END SELECT
566 :
567 325570 : CALL timestop(handle)
568 : END SUBROUTINE xc_functional_eval
569 :
570 : ! **************************************************************************************************
571 : !> \brief true for GAUXC sections that wrap a conventional LibXC functional
572 : !> \param functional the GAUXC section
573 : !> \return whether MODEL NONE is active
574 : ! **************************************************************************************************
575 575 : FUNCTION gauxc_model_none_selected(functional)
576 : TYPE(section_vals_type), POINTER :: functional
577 : LOGICAL :: gauxc_model_none_selected
578 :
579 : CHARACTER(LEN=default_string_length) :: model_key, model_name, xc_fun_name, &
580 : xc_key
581 :
582 575 : CALL section_vals_val_get(functional, "MODEL", c_val=model_name)
583 575 : CALL section_vals_val_get(functional, "FUNCTIONAL", c_val=xc_fun_name)
584 575 : model_key = ADJUSTL(model_name)
585 575 : xc_key = ADJUSTL(xc_fun_name)
586 575 : CALL uppercase(model_key)
587 575 : CALL uppercase(xc_key)
588 : gauxc_model_none_selected = (TRIM(model_key) == "" .OR. TRIM(model_key) == "NONE" .OR. &
589 575 : TRIM(model_key) == TRIM(xc_key))
590 575 : END FUNCTION gauxc_model_none_selected
591 :
592 : ! **************************************************************************************************
593 : !> \brief map GAUXC MODEL NONE shorthand names to LibXC exchange/correlation components
594 : !> \param functional the GAUXC section
595 : !> \param xc_fun_name the GAUXC FUNCTIONAL value
596 : !> \param libxc_names LibXC section names to evaluate and add
597 : !> \param nfunc number of LibXC components
598 : ! **************************************************************************************************
599 112 : SUBROUTINE gauxc_model_none_libxc_names(functional, xc_fun_name, libxc_names, nfunc)
600 : TYPE(section_vals_type), POINTER :: functional
601 : CHARACTER(LEN=*), INTENT(OUT) :: xc_fun_name
602 : CHARACTER(LEN=*), DIMENSION(:), INTENT(OUT) :: libxc_names
603 : INTEGER, INTENT(OUT) :: nfunc
604 :
605 : CHARACTER(LEN=default_string_length) :: xc_key
606 :
607 56 : CALL section_vals_val_get(functional, "FUNCTIONAL", c_val=xc_fun_name)
608 56 : xc_key = ADJUSTL(xc_fun_name)
609 56 : CALL uppercase(xc_key)
610 168 : libxc_names(:) = ""
611 56 : SELECT CASE (TRIM(xc_key))
612 : CASE ("LDA", "PADE")
613 0 : nfunc = 2
614 0 : libxc_names(1) = "LDA_X"
615 0 : libxc_names(2) = "LDA_C_PW"
616 : CASE ("VWN")
617 0 : nfunc = 2
618 0 : libxc_names(1) = "LDA_X"
619 0 : libxc_names(2) = "LDA_C_VWN"
620 : CASE ("PBE")
621 56 : nfunc = 2
622 56 : libxc_names(1) = "GGA_X_PBE"
623 56 : libxc_names(2) = "GGA_C_PBE"
624 : CASE ("BLYP")
625 0 : nfunc = 2
626 0 : libxc_names(1) = "GGA_X_B88"
627 0 : libxc_names(2) = "GGA_C_LYP"
628 : CASE ("BP")
629 0 : nfunc = 2
630 0 : libxc_names(1) = "GGA_X_B88"
631 0 : libxc_names(2) = "GGA_C_P86"
632 : CASE ("TPSS")
633 0 : nfunc = 2
634 0 : libxc_names(1) = "MGGA_X_TPSS"
635 0 : libxc_names(2) = "MGGA_C_TPSS"
636 : CASE ("R2SCAN")
637 0 : nfunc = 2
638 0 : libxc_names(1) = "MGGA_X_R2SCAN"
639 0 : libxc_names(2) = "MGGA_C_R2SCAN"
640 : CASE DEFAULT
641 0 : nfunc = 1
642 56 : libxc_names(1) = TRIM(xc_key)
643 : END SELECT
644 56 : END SUBROUTINE gauxc_model_none_libxc_names
645 :
646 : ! **************************************************************************************************
647 : !> \brief needs information for GAUXC MODEL NONE one-center GAPW corrections
648 : !> \param functional the GAUXC section
649 : !> \param lsd whether spin-polarized derivatives are needed
650 : !> \param reference reference string for the wrapped functional
651 : !> \param shortform short name for printout
652 : !> \param needs density ingredients needed by the wrapped functional
653 : !> \param max_deriv maximum implemented derivative order
654 : !> \param print_warn whether LibXC should print development warnings
655 : ! **************************************************************************************************
656 56 : SUBROUTINE gauxc_model_none_xc_info(functional, lsd, reference, shortform, &
657 : needs, max_deriv, print_warn)
658 : TYPE(section_vals_type), POINTER :: functional
659 : LOGICAL, INTENT(in) :: lsd
660 : CHARACTER(LEN=*), INTENT(OUT), OPTIONAL :: reference, shortform
661 : TYPE(xc_rho_cflags_type), INTENT(inout), OPTIONAL :: needs
662 : INTEGER, INTENT(out), OPTIONAL :: max_deriv
663 : LOGICAL, INTENT(IN), OPTIONAL :: print_warn
664 :
665 : CHARACTER(LEN=default_string_length) :: libxc_names(2), xc_fun_name
666 : INTEGER :: ifunc, max_deriv_i, max_deriv_min, nfunc
667 :
668 56 : CALL gauxc_model_none_libxc_names(functional, xc_fun_name, libxc_names, nfunc)
669 56 : max_deriv_min = HUGE(max_deriv_min)
670 168 : DO ifunc = 1, nfunc
671 112 : IF (lsd) THEN
672 : CALL libxc_spin_polarized_info(functional, needs=needs, max_deriv=max_deriv_i, &
673 : print_warn=print_warn, &
674 24 : func_name_override=TRIM(libxc_names(ifunc)))
675 : ELSE
676 : CALL libxc_spin_unpolarized_info(functional, needs=needs, max_deriv=max_deriv_i, &
677 : print_warn=print_warn, &
678 88 : func_name_override=TRIM(libxc_names(ifunc)))
679 : END IF
680 168 : max_deriv_min = MIN(max_deriv_min, max_deriv_i)
681 : END DO
682 56 : IF (PRESENT(max_deriv)) max_deriv = max_deriv_min
683 56 : IF (PRESENT(reference)) THEN
684 4 : reference = "Functional computed by GauXC (underlying: "//TRIM(xc_fun_name)//")"
685 : END IF
686 56 : IF (PRESENT(shortform)) shortform = "GAUXC ("//TRIM(xc_fun_name)//")"
687 56 : END SUBROUTINE gauxc_model_none_xc_info
688 :
689 : ! **************************************************************************************************
690 : !> \brief one-center GAPW correction evaluation for GAUXC MODEL NONE
691 : !> \param functional the GAUXC section
692 : !> \param lsd whether spin-polarized derivatives are evaluated
693 : !> \param rho_set density ingredients
694 : !> \param deriv_set derivative accumulator
695 : !> \param deriv_order derivative order to evaluate
696 : ! **************************************************************************************************
697 0 : SUBROUTINE gauxc_model_none_xc_eval(functional, lsd, rho_set, deriv_set, deriv_order)
698 : TYPE(section_vals_type), POINTER :: functional
699 : LOGICAL, INTENT(in) :: lsd
700 : TYPE(xc_rho_set_type), INTENT(IN) :: rho_set
701 : TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set
702 : INTEGER, INTENT(IN) :: deriv_order
703 :
704 : CHARACTER(LEN=default_string_length) :: libxc_names(2), xc_fun_name
705 : INTEGER :: ifunc, nfunc
706 :
707 0 : CALL gauxc_model_none_libxc_names(functional, xc_fun_name, libxc_names, nfunc)
708 0 : DO ifunc = 1, nfunc
709 0 : IF (lsd) THEN
710 : CALL libxc_spin_polarized_eval(rho_set, deriv_set, deriv_order, functional, &
711 0 : func_name_override=TRIM(libxc_names(ifunc)))
712 : ELSE
713 : CALL libxc_spin_unpolarized_eval(rho_set, deriv_set, deriv_order, functional, &
714 0 : func_name_override=TRIM(libxc_names(ifunc)))
715 : END IF
716 : END DO
717 0 : END SUBROUTINE gauxc_model_none_xc_eval
718 :
719 : ! **************************************************************************************************
720 : !> \brief ...
721 : !> \param functionals a section containing the functional combination to be
722 : !> applied
723 : !> \param lsd if a local spin desnity is performed
724 : !> \param rho_set a rho set where all the arguments needed by this functional
725 : !> should be valid (which argument are needed can be found with
726 : !> xc_functional_get_info)
727 : !> \param deriv_set place where to store the functional derivatives (they are
728 : !> added to the derivatives)
729 : !> \param deriv_order degree of the derivative that should be evaluated,
730 : !> if positive all the derivatives up to the given degree are evaluated,
731 : !> if negative only the given degree is requested (but to simplify
732 : !> the code all the derivatives might be calculated, you should ignore
733 : !> them when adding derivatives of various functionals they might contain
734 : !> the derivative of just one functional)
735 : !> \author fawzi
736 : ! **************************************************************************************************
737 292291 : SUBROUTINE xc_functionals_eval(functionals, lsd, rho_set, deriv_set, &
738 : deriv_order)
739 : TYPE(section_vals_type), POINTER :: functionals
740 : LOGICAL, INTENT(in) :: lsd
741 : TYPE(xc_rho_set_type), INTENT(IN) :: rho_set
742 : TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set
743 : INTEGER, INTENT(in) :: deriv_order
744 :
745 : INTEGER :: ifun
746 : TYPE(section_vals_type), POINTER :: xc_fun
747 :
748 292291 : CPASSERT(ASSOCIATED(functionals))
749 292291 : ifun = 0
750 325692 : DO
751 617983 : ifun = ifun + 1
752 617983 : xc_fun => section_vals_get_subs_vals2(functionals, i_section=ifun)
753 617983 : IF (.NOT. ASSOCIATED(xc_fun)) EXIT
754 : CALL xc_functional_eval(xc_fun, &
755 : lsd=lsd, &
756 : rho_set=rho_set, &
757 : deriv_set=deriv_set, &
758 325692 : deriv_order=deriv_order)
759 : END DO
760 292291 : END SUBROUTINE xc_functionals_eval
761 :
762 : ! **************************************************************************************************
763 : !> \brief ...
764 : !> \param functionals a section containing the functional combination to be
765 : !> applied
766 : !> \param lsd if a local spin desnity is performed
767 : !> \param calc_potential set, if potential calculation will be carried out later.
768 : !> helps to save memory and flops. defaults to false.
769 : !> \return ...
770 : !> \author fawzi
771 : ! **************************************************************************************************
772 276917 : FUNCTION xc_functionals_get_needs(functionals, lsd, calc_potential) &
773 : RESULT(needs)
774 : TYPE(section_vals_type), POINTER :: functionals
775 : LOGICAL, INTENT(in) :: lsd
776 : LOGICAL, INTENT(in), OPTIONAL :: calc_potential
777 : TYPE(xc_rho_cflags_type) :: needs
778 :
779 : INTEGER :: ifun
780 : LOGICAL :: my_calc_potential
781 : TYPE(section_vals_type), POINTER :: xc_fun
782 :
783 276917 : my_calc_potential = .FALSE.
784 276917 : IF (PRESENT(calc_potential)) my_calc_potential = calc_potential
785 :
786 276917 : CPASSERT(ASSOCIATED(functionals))
787 276917 : CALL xc_rho_cflags_setall(needs, .FALSE.)
788 :
789 276917 : ifun = 0
790 296452 : DO
791 573369 : ifun = ifun + 1
792 573369 : xc_fun => section_vals_get_subs_vals2(functionals, i_section=ifun)
793 573369 : IF (.NOT. ASSOCIATED(xc_fun)) EXIT
794 296452 : CALL xc_functional_get_info(xc_fun, lsd=lsd, needs=needs)
795 : END DO
796 :
797 276917 : IF (my_calc_potential) THEN
798 221601 : IF (lsd) THEN
799 42811 : needs%rho_spin = .TRUE.
800 84242 : needs%tau_spin = needs%tau_spin .OR. needs%tau
801 : ELSE
802 178790 : needs%rho = .TRUE.
803 : END IF
804 221601 : IF (needs%norm_drho .OR. needs%norm_drho_spin) THEN
805 133881 : IF (lsd) THEN
806 26510 : needs%drho_spin = .TRUE.
807 : ELSE
808 107371 : needs%drho = .TRUE.
809 : END IF
810 : END IF
811 : END IF
812 276917 : END FUNCTION xc_functionals_get_needs
813 :
814 : END MODULE xc_derivatives
|
