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: dp
15 : USE xc_b97, ONLY: b97_lda_eval,&
16 : b97_lda_info,&
17 : b97_lsd_eval,&
18 : b97_lsd_info
19 : USE xc_cs1, ONLY: cs1_lda_eval,&
20 : cs1_lda_info,&
21 : cs1_lsd_eval,&
22 : cs1_lsd_info
23 : USE xc_derivative_set_types, ONLY: xc_derivative_set_type
24 : USE xc_exchange_gga, ONLY: xgga_eval,&
25 : xgga_info
26 : USE xc_gauxc_functional, ONLY: skala_info
27 : USE xc_hcth, ONLY: hcth_lda_eval,&
28 : hcth_lda_info
29 : USE xc_ke_gga, ONLY: ke_gga_info,&
30 : ke_gga_lda_eval,&
31 : ke_gga_lsd_eval
32 : USE xc_libxc, ONLY: libxc_lda_eval,&
33 : libxc_lda_info,&
34 : libxc_lsd_eval,&
35 : libxc_lsd_info
36 : USE xc_lyp, ONLY: lyp_lda_eval,&
37 : lyp_lda_info,&
38 : lyp_lsd_eval,&
39 : lyp_lsd_info
40 : USE xc_lyp_adiabatic, ONLY: lyp_adiabatic_lda_eval,&
41 : lyp_adiabatic_lda_info,&
42 : lyp_adiabatic_lsd_eval,&
43 : lyp_adiabatic_lsd_info
44 : USE xc_optx, ONLY: optx_lda_eval,&
45 : optx_lda_info,&
46 : optx_lsd_eval,&
47 : optx_lsd_info
48 : USE xc_pade, ONLY: pade_info,&
49 : pade_init,&
50 : pade_lda_pw_eval,&
51 : pade_lsd_pw_eval
52 : USE xc_pbe, ONLY: pbe_lda_eval,&
53 : pbe_lda_info,&
54 : pbe_lsd_eval,&
55 : pbe_lsd_info
56 : USE xc_perdew86, ONLY: p86_lda_eval,&
57 : p86_lda_info
58 : USE xc_perdew_wang, ONLY: perdew_wang_info,&
59 : perdew_wang_lda_eval,&
60 : perdew_wang_lsd_eval
61 : USE xc_perdew_zunger, ONLY: pz_info,&
62 : pz_lda_eval,&
63 : pz_lsd_eval
64 : USE xc_rho_cflags_types, ONLY: xc_rho_cflags_setall,&
65 : xc_rho_cflags_type
66 : USE xc_rho_set_types, ONLY: xc_rho_set_get,&
67 : xc_rho_set_type
68 : USE xc_tfw, ONLY: tfw_lda_eval,&
69 : tfw_lda_info,&
70 : tfw_lsd_eval,&
71 : tfw_lsd_info
72 : USE xc_thomas_fermi, ONLY: thomas_fermi_info,&
73 : thomas_fermi_lda_eval,&
74 : thomas_fermi_lsd_eval
75 : USE xc_tpss, ONLY: tpss_lda_eval,&
76 : tpss_lda_info
77 : USE xc_vwn, ONLY: vwn_lda_eval,&
78 : vwn_lda_info,&
79 : vwn_lsd_eval,&
80 : vwn_lsd_info
81 : USE xc_xalpha, ONLY: xalpha_info,&
82 : xalpha_lda_eval,&
83 : xalpha_lsd_eval
84 : USE xc_xbecke88, ONLY: xb88_lda_eval,&
85 : xb88_lda_info,&
86 : xb88_lsd_eval,&
87 : xb88_lsd_info
88 : USE xc_xbecke88_long_range, ONLY: xb88_lr_lda_eval,&
89 : xb88_lr_lda_info,&
90 : xb88_lr_lsd_eval,&
91 : xb88_lr_lsd_info
92 : USE xc_xbecke88_lr_adiabatic, ONLY: xb88_lr_adiabatic_lda_eval,&
93 : xb88_lr_adiabatic_lda_info,&
94 : xb88_lr_adiabatic_lsd_eval,&
95 : xb88_lr_adiabatic_lsd_info
96 : USE xc_xbecke_roussel, ONLY: xbecke_roussel_lda_eval,&
97 : xbecke_roussel_lda_info,&
98 : xbecke_roussel_lsd_eval,&
99 : xbecke_roussel_lsd_info
100 : USE xc_xbeef, ONLY: xbeef_lda_eval,&
101 : xbeef_lda_info,&
102 : xbeef_lsd_eval,&
103 : xbeef_lsd_info
104 : USE xc_xbr_pbe_lda_hole_t_c_lr, ONLY: xbr_pbe_lda_hole_tc_lr_lda_eval,&
105 : xbr_pbe_lda_hole_tc_lr_lda_info,&
106 : xbr_pbe_lda_hole_tc_lr_lsd_eval,&
107 : xbr_pbe_lda_hole_tc_lr_lsd_info
108 : USE xc_xlda_hole_t_c_lr, ONLY: xlda_hole_t_c_lr_lda_eval,&
109 : xlda_hole_t_c_lr_lda_info,&
110 : xlda_hole_t_c_lr_lsd_eval,&
111 : xlda_hole_t_c_lr_lsd_info
112 : USE xc_xpbe_hole_t_c_lr, ONLY: xpbe_hole_t_c_lr_lda_eval,&
113 : xpbe_hole_t_c_lr_lda_info,&
114 : xpbe_hole_t_c_lr_lsd_eval,&
115 : xpbe_hole_t_c_lr_lsd_info
116 : USE xc_xwpbe, ONLY: xwpbe_lda_eval,&
117 : xwpbe_lda_info,&
118 : xwpbe_lsd_eval,&
119 : xwpbe_lsd_info
120 : #include "../base/base_uses.f90"
121 :
122 : IMPLICIT NONE
123 :
124 : PRIVATE
125 :
126 : LOGICAL, PARAMETER :: debug_this_module = .FALSE.
127 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xc_derivatives'
128 :
129 : PUBLIC :: xc_functional_get_info, xc_functionals_eval, xc_functionals_get_needs
130 :
131 : CONTAINS
132 :
133 : ! **************************************************************************************************
134 : !> \brief get the information about the given functional
135 : !> \param functional the functional you want info about
136 : !> \param lsd if you are using lsd or lda
137 : !> \param reference the reference to the acticle where the functional is
138 : !> explained
139 : !> \param shortform the short definition of the functional
140 : !> \param needs the flags corresponding to the inputs needed by this
141 : !> functional are set to true (the flags not needed aren't touched)
142 : !> \param max_deriv the maximal derivative available
143 : !> \param print_warn whether to print warnings (mainly relevant for libxc)
144 : !> \author fawzi
145 : ! **************************************************************************************************
146 273724 : SUBROUTINE xc_functional_get_info(functional, lsd, reference, shortform, &
147 : needs, max_deriv, print_warn)
148 : TYPE(section_vals_type), POINTER :: functional
149 : LOGICAL, INTENT(in) :: lsd
150 : CHARACTER(LEN=*), INTENT(OUT), OPTIONAL :: reference, shortform
151 : TYPE(xc_rho_cflags_type), INTENT(inout), OPTIONAL :: needs
152 : INTEGER, INTENT(out), OPTIONAL :: max_deriv
153 : LOGICAL, INTENT(IN), OPTIONAL :: print_warn
154 :
155 : INTEGER :: i_param
156 : REAL(kind=dp) :: r_param
157 :
158 273724 : CPASSERT(ASSOCIATED(functional))
159 274347 : SELECT CASE (functional%section%name)
160 : CASE ("BECKE97")
161 623 : IF (lsd) THEN
162 : CALL b97_lsd_info(reference=reference, shortform=shortform, &
163 0 : needs=needs, max_deriv=max_deriv, b97_params=functional)
164 : ELSE
165 : CALL b97_lda_info(reference=reference, shortform=shortform, &
166 1861 : needs=needs, max_deriv=max_deriv, b97_params=functional)
167 : END IF
168 : CASE ("BECKE88_LR_ADIABATIC")
169 186 : IF (lsd) THEN
170 : CALL xb88_lr_adiabatic_lsd_info(reference=reference, shortform=shortform, &
171 325 : needs=needs, max_deriv=max_deriv)
172 : ELSE
173 : CALL xb88_lr_adiabatic_lda_info(reference=reference, shortform=shortform, &
174 229 : needs=needs, max_deriv=max_deriv)
175 : END IF
176 : CASE ("LYP_ADIABATIC")
177 186 : IF (lsd) THEN
178 : CALL lyp_adiabatic_lsd_info(reference=reference, shortform=shortform, &
179 325 : needs=needs, max_deriv=max_deriv)
180 : ELSE
181 : CALL lyp_adiabatic_lda_info(reference=reference, shortform=shortform, &
182 229 : needs=needs, max_deriv=max_deriv)
183 : END IF
184 : CASE ("BEEF")
185 23 : IF (lsd) THEN
186 : CALL xbeef_lsd_info(reference=reference, shortform=shortform, &
187 0 : needs=needs, max_deriv=max_deriv)
188 : ELSE
189 : CALL xbeef_lda_info(reference=reference, shortform=shortform, &
190 67 : needs=needs, max_deriv=max_deriv)
191 : END IF
192 : CASE ("BECKE88")
193 12784 : IF (lsd) THEN
194 : CALL xb88_lsd_info(reference=reference, shortform=shortform, &
195 8700 : needs=needs, max_deriv=max_deriv)
196 : ELSE
197 : CALL xb88_lda_info(reference=reference, shortform=shortform, &
198 29382 : needs=needs, max_deriv=max_deriv)
199 : END IF
200 : CASE ("BECKE88_LR")
201 1411 : IF (lsd) THEN
202 : CALL xb88_lr_lsd_info(reference=reference, shortform=shortform, &
203 169 : needs=needs, max_deriv=max_deriv)
204 : ELSE
205 : CALL xb88_lr_lda_info(reference=reference, shortform=shortform, &
206 4046 : needs=needs, max_deriv=max_deriv)
207 : END IF
208 : CASE ("LYP")
209 10607 : IF (lsd) THEN
210 : CALL lyp_lsd_info(reference=reference, shortform=shortform, &
211 8497 : needs=needs, max_deriv=max_deriv)
212 : ELSE
213 : CALL lyp_lda_info(reference=reference, shortform=shortform, &
214 23060 : needs=needs, max_deriv=max_deriv)
215 : END IF
216 : CASE ("PADE")
217 261091 : CALL pade_info(reference, shortform, lsd=lsd, needs=needs)
218 : CASE ("HCTH")
219 589 : CALL section_vals_val_get(functional, "PARAMETER_SET", i_val=i_param)
220 589 : CPASSERT(.NOT. lsd)
221 1763 : CALL hcth_lda_info(i_param, reference, shortform, needs, max_deriv)
222 : CASE ("OPTX")
223 916 : IF (lsd) THEN
224 1441 : CALL optx_lsd_info(reference, shortform, needs, max_deriv)
225 : ELSE
226 1299 : CALL optx_lda_info(reference, shortform, needs, max_deriv)
227 : END IF
228 : CASE ("CS1")
229 33 : IF (lsd) THEN
230 0 : CALL cs1_lsd_info(reference, shortform, needs, max_deriv)
231 : ELSE
232 97 : CALL cs1_lda_info(reference, shortform, needs=needs, max_deriv=max_deriv)
233 : END IF
234 : CASE ("XGGA")
235 28 : CALL section_vals_val_get(functional, "FUNCTIONAL", i_val=i_param)
236 76 : CALL xgga_info(i_param, lsd, reference, shortform, needs, max_deriv)
237 : CASE ("KE_GGA")
238 2192 : CALL section_vals_val_get(functional, "FUNCTIONAL", i_val=i_param)
239 6576 : CALL ke_gga_info(i_param, lsd, reference, shortform, needs, max_deriv)
240 : CASE ("P86C")
241 9 : IF (lsd) THEN
242 0 : CPABORT("BP functional not implemented with LSD")
243 : END IF
244 25 : CALL p86_lda_info(reference, shortform, needs, max_deriv)
245 : CASE ("PW92")
246 343 : CALL section_vals_val_get(functional, "PARAMETRIZATION", i_val=i_param)
247 343 : CALL section_vals_val_get(functional, "SCALE", r_val=r_param)
248 : CALL perdew_wang_info(i_param, lsd, reference, shortform, needs, max_deriv, &
249 1003 : r_param)
250 : CASE ("PZ81")
251 41 : CALL section_vals_val_get(functional, "PARAMETRIZATION", i_val=i_param)
252 121 : CALL pz_info(i_param, lsd, reference, shortform, needs, max_deriv)
253 : CASE ("TFW")
254 0 : IF (lsd) THEN
255 0 : CALL tfw_lsd_info(reference, shortform, needs, max_deriv)
256 : ELSE
257 0 : CALL tfw_lda_info(reference, shortform, needs, max_deriv)
258 : END IF
259 : CASE ("TF")
260 672 : CALL thomas_fermi_info(lsd, reference, shortform, needs, max_deriv)
261 : CASE ("VWN")
262 622 : IF (lsd) THEN
263 56 : CALL vwn_lsd_info(reference, shortform, needs, max_deriv)
264 : ELSE
265 1776 : CALL vwn_lda_info(reference, shortform, needs, max_deriv)
266 : END IF
267 : CASE ("XALPHA")
268 2440 : CALL section_vals_val_get(functional, "XA", r_val=r_param)
269 : CALL xalpha_info(lsd, reference, shortform, needs, max_deriv, &
270 7258 : xa_parameter=r_param)
271 : CASE ("TPSS")
272 1779 : IF (lsd) THEN
273 0 : CPABORT("TPSS functional not implemented with LSD. Use the LIBXC version instead.")
274 : ELSE
275 5303 : CALL tpss_lda_info(functional, reference, shortform, needs, max_deriv)
276 : END IF
277 : CASE ("PBE")
278 127663 : IF (lsd) THEN
279 63745 : CALL pbe_lsd_info(functional, reference, shortform, needs, max_deriv)
280 : ELSE
281 317148 : CALL pbe_lda_info(functional, reference, shortform, needs, max_deriv)
282 : END IF
283 : CASE ("GAUXC")
284 188 : CALL skala_info(functional, lsd, reference, shortform, needs, max_deriv)
285 : ! Note: SKALA functional routes through apply_gauxc in qs_ks_methods.F
286 : ! when USE_GAUXC = .TRUE. (requires dft_control%use_gauxc to be set)
287 : CASE ("XWPBE")
288 3943 : IF (lsd) THEN
289 3086 : CALL xwpbe_lsd_info(reference, shortform, needs, max_deriv)
290 : ELSE
291 8721 : CALL xwpbe_lda_info(reference, shortform, needs, max_deriv)
292 : END IF
293 : CASE ("BECKE_ROUSSEL")
294 191 : IF (lsd) THEN
295 272 : CALL xbecke_roussel_lsd_info(reference, shortform, needs, max_deriv)
296 : ELSE
297 291 : CALL xbecke_roussel_lda_info(reference, shortform, needs, max_deriv)
298 : END IF
299 : CASE ("LDA_HOLE_T_C_LR")
300 90 : IF (lsd) THEN
301 187 : CALL xlda_hole_t_c_lr_lsd_info(reference, shortform, needs, max_deriv)
302 : ELSE
303 79 : CALL xlda_hole_t_c_lr_lda_info(reference, shortform, needs, max_deriv)
304 : END IF
305 : CASE ("PBE_HOLE_T_C_LR")
306 3554 : IF (lsd) THEN
307 3104 : CALL xpbe_hole_t_c_lr_lsd_info(reference, shortform, needs, max_deriv)
308 : ELSE
309 7550 : CALL xpbe_hole_t_c_lr_lda_info(reference, shortform, needs, max_deriv)
310 : END IF
311 : CASE ("GV09")
312 268 : IF (lsd) THEN
313 187 : CALL xbr_pbe_lda_hole_tc_lr_lsd_info(reference, shortform, needs, max_deriv)
314 : ELSE
315 613 : CALL xbr_pbe_lda_hole_tc_lr_lda_info(reference, shortform, needs, max_deriv)
316 : END IF
317 : CASE default
318 : ! If the functional has not been implemented internally, it's from LibXC
319 273724 : IF (lsd) THEN
320 7312 : CALL libxc_lsd_info(functional, reference, shortform, needs, max_deriv, print_warn)
321 : ELSE
322 39012 : CALL libxc_lda_info(functional, reference, shortform, needs, max_deriv, print_warn)
323 : END IF
324 : END SELECT
325 273724 : END SUBROUTINE xc_functional_get_info
326 :
327 : ! **************************************************************************************************
328 : !> \brief evaluate a functional (and its derivatives)
329 : !> \param functional a section that describes the functional to be added
330 : !> \param lsd if a local spin desnity is performed
331 : !> \param rho_set a rho set where all the arguments needed by this functional
332 : !> should be valid (which argument are needed can be found with
333 : !> xc_functional_get_info)
334 : !> \param deriv_set place where to store the functional derivatives (they are
335 : !> added to the derivatives)
336 : !> \param deriv_order degree of the derivative that should be evaluated,
337 : !> if positive all the derivatives up to the given degree are evaluated,
338 : !> if negative only the given degree is requested (but to simplify
339 : !> the code all the derivatives might be calculated, you should ignore
340 : !> them when adding derivatives of various functionals they might contain
341 : !> the derivative of just one functional)
342 : !> \par History
343 : !> 11.2003 created [fawzi]
344 : !> \author fawzi
345 : ! **************************************************************************************************
346 902139 : SUBROUTINE xc_functional_eval(functional, lsd, rho_set, deriv_set, deriv_order)
347 :
348 : TYPE(section_vals_type), POINTER :: functional
349 : LOGICAL, INTENT(in) :: lsd
350 : TYPE(xc_rho_set_type), INTENT(IN) :: rho_set
351 : TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set
352 : INTEGER, INTENT(IN) :: deriv_order
353 :
354 : CHARACTER(len=*), PARAMETER :: abort_message_skala = &
355 : "GauXC functionals are evaluated only through the QS GauXC path. "// &
356 : "Higher XC derivatives for response and kernel properties are not implemented.", &
357 : routineN = 'xc_functional_eval'
358 :
359 : INTEGER :: handle, i_param
360 : LOGICAL :: fun_active
361 : REAL(KIND=dp) :: density_cut, gradient_cut, r_param
362 :
363 300713 : CALL timeset(routineN, handle)
364 :
365 : CALL xc_rho_set_get(rho_set, rho_cutoff=density_cut, &
366 300713 : drho_cutoff=gradient_cut)
367 : CALL section_vals_val_get(functional, "_SECTION_PARAMETERS_", &
368 300713 : l_val=fun_active)
369 300713 : IF (.NOT. fun_active) THEN
370 28 : CALL timestop(handle)
371 28 : RETURN
372 : END IF
373 :
374 301292 : SELECT CASE (functional%section%name)
375 : CASE ("BECKE97")
376 607 : IF (lsd) THEN
377 0 : CALL b97_lsd_eval(rho_set, deriv_set, deriv_order, functional)
378 : ELSE
379 607 : CALL b97_lda_eval(rho_set, deriv_set, deriv_order, functional)
380 : END IF
381 : CASE ("BECKE88_LR_ADIABATIC")
382 176 : IF (lsd) THEN
383 104 : CALL xb88_lr_adiabatic_lsd_eval(rho_set, deriv_set, deriv_order, functional)
384 : ELSE
385 72 : CALL xb88_lr_adiabatic_lda_eval(rho_set, deriv_set, deriv_order, functional)
386 : END IF
387 : CASE ("LYP_ADIABATIC")
388 176 : IF (lsd) THEN
389 104 : CALL lyp_adiabatic_lsd_eval(rho_set, deriv_set, deriv_order, functional)
390 : ELSE
391 72 : CALL lyp_adiabatic_lda_eval(rho_set, deriv_set, deriv_order, functional)
392 : END IF
393 : CASE ("BECKE88")
394 12287 : IF (lsd) THEN
395 3182 : CALL xb88_lsd_eval(rho_set, deriv_set, deriv_order, functional)
396 : ELSE
397 9105 : CALL xb88_lda_eval(rho_set, deriv_set, deriv_order, functional)
398 : END IF
399 : CASE ("BEEF")
400 18 : IF (lsd) THEN
401 0 : CALL xbeef_lsd_eval(rho_set, deriv_set, deriv_order, functional)
402 : ELSE
403 18 : CALL xbeef_lda_eval(rho_set, deriv_set, deriv_order, functional)
404 : END IF
405 : CASE ("BECKE88_LR")
406 1274 : IF (lsd) THEN
407 52 : CALL xb88_lr_lsd_eval(rho_set, deriv_set, deriv_order, functional)
408 : ELSE
409 1222 : CALL xb88_lr_lda_eval(rho_set, deriv_set, deriv_order, functional)
410 : END IF
411 : CASE ("LYP")
412 10953 : IF (lsd) THEN
413 3128 : CALL lyp_lsd_eval(rho_set, deriv_set, deriv_order, functional)
414 : ELSE
415 7825 : CALL lyp_lda_eval(rho_set, deriv_set, deriv_order, functional)
416 : END IF
417 : CASE ("PADE")
418 92774 : CALL pade_init(density_cut)
419 92774 : IF (lsd) THEN
420 13965 : CALL pade_lsd_pw_eval(deriv_set, rho_set, deriv_order)
421 : ELSE
422 78809 : CALL pade_lda_pw_eval(deriv_set, rho_set, deriv_order)
423 : END IF
424 : CASE ("HCTH")
425 565 : CPASSERT(.NOT. lsd)
426 565 : CALL section_vals_val_get(functional, "PARAMETER_SET", i_val=i_param)
427 565 : CALL hcth_lda_eval(i_param, rho_set, deriv_set, deriv_order)
428 : CASE ("OPTX")
429 1040 : IF (lsd) THEN
430 476 : CALL optx_lsd_eval(rho_set, deriv_set, deriv_order, functional)
431 : ELSE
432 564 : CALL optx_lda_eval(rho_set, deriv_set, deriv_order, functional)
433 : END IF
434 : CASE ("CS1")
435 32 : IF (lsd) THEN
436 0 : CALL cs1_lsd_eval(rho_set, deriv_set, deriv_order)
437 : ELSE
438 32 : CALL cs1_lda_eval(rho_set, deriv_set, deriv_order)
439 : END IF
440 : CASE ("XGGA")
441 8 : CALL section_vals_val_get(functional, "FUNCTIONAL", i_val=i_param)
442 8 : CALL xgga_eval(i_param, lsd, rho_set, deriv_set, deriv_order)
443 : CASE ("KE_GGA")
444 1888 : CALL section_vals_val_get(functional, "FUNCTIONAL", i_val=i_param)
445 1888 : IF (lsd) THEN
446 0 : CALL ke_gga_lsd_eval(i_param, rho_set, deriv_set, deriv_order)
447 : ELSE
448 1888 : CALL ke_gga_lda_eval(i_param, rho_set, deriv_set, deriv_order)
449 : END IF
450 : CASE ("P86C")
451 4 : CPASSERT(.NOT. lsd)
452 4 : CALL p86_lda_eval(rho_set, deriv_set, deriv_order, functional)
453 : CASE ("PW92")
454 236 : CALL section_vals_val_get(functional, "PARAMETRIZATION", i_val=i_param)
455 236 : CALL section_vals_val_get(functional, "SCALE", r_val=r_param)
456 236 : IF (lsd) THEN
457 : CALL perdew_wang_lsd_eval(i_param, rho_set, deriv_set, deriv_order, &
458 20 : r_param)
459 : ELSE
460 : CALL perdew_wang_lda_eval(i_param, rho_set, deriv_set, deriv_order, &
461 216 : r_param)
462 : END IF
463 : CASE ("PZ81")
464 54 : CALL section_vals_val_get(functional, "PARAMETRIZATION", i_val=i_param)
465 54 : IF (lsd) THEN
466 12 : CALL pz_lsd_eval(i_param, rho_set, deriv_set, deriv_order, functional)
467 : ELSE
468 42 : CALL pz_lda_eval(i_param, rho_set, deriv_set, deriv_order, functional)
469 : END IF
470 : CASE ("TFW")
471 0 : IF (lsd) THEN
472 0 : CALL tfw_lsd_eval(rho_set, deriv_set, deriv_order)
473 : ELSE
474 0 : CALL tfw_lda_eval(rho_set, deriv_set, deriv_order)
475 : END IF
476 : CASE ("TF")
477 216 : IF (lsd) THEN
478 0 : CALL thomas_fermi_lsd_eval(rho_set, deriv_set, deriv_order)
479 : ELSE
480 216 : CALL thomas_fermi_lda_eval(rho_set, deriv_set, deriv_order)
481 : END IF
482 : CASE ("VWN")
483 859 : IF (lsd) THEN
484 32 : CALL vwn_lsd_eval(rho_set, deriv_set, deriv_order, functional)
485 : ELSE
486 827 : CALL vwn_lda_eval(rho_set, deriv_set, deriv_order, functional)
487 : END IF
488 : CASE ("XALPHA")
489 2519 : CALL section_vals_val_get(functional, "XA", r_val=r_param)
490 2519 : IF (lsd) THEN
491 : CALL xalpha_lsd_eval(rho_set, deriv_set, deriv_order, &
492 166 : xa_parameter=r_param, xa_params=functional)
493 : ELSE
494 : CALL xalpha_lda_eval(rho_set, deriv_set, deriv_order, &
495 2353 : xa_parameter=r_param, xa_params=functional)
496 : END IF
497 : CASE ("TPSS")
498 2566 : IF (lsd) THEN
499 0 : CPABORT("TPSS functional not implemented with LSD. Use the LIBXC version instead.")
500 : ELSE
501 2566 : CALL tpss_lda_eval(rho_set, deriv_set, deriv_order, functional)
502 : END IF
503 : CASE ("PBE")
504 142243 : IF (lsd) THEN
505 21943 : CALL pbe_lsd_eval(rho_set, deriv_set, deriv_order, functional)
506 : ELSE
507 120300 : CALL pbe_lda_eval(rho_set, deriv_set, deriv_order, functional)
508 : END IF
509 : CASE ("GAUXC")
510 0 : CPABORT(abort_message_skala)
511 : CASE ("XWPBE")
512 5004 : IF (lsd) THEN
513 1190 : CALL xwpbe_lsd_eval(rho_set, deriv_set, deriv_order, functional)
514 : ELSE
515 3814 : CALL xwpbe_lda_eval(rho_set, deriv_set, deriv_order, functional)
516 : END IF
517 : CASE ("BECKE_ROUSSEL")
518 166 : IF (lsd) THEN
519 82 : CALL xbecke_roussel_lsd_eval(rho_set, deriv_set, deriv_order, functional)
520 : ELSE
521 84 : CALL xbecke_roussel_lda_eval(rho_set, deriv_set, deriv_order, functional)
522 : END IF
523 : CASE ("LDA_HOLE_T_C_LR")
524 80 : IF (lsd) THEN
525 58 : CALL xlda_hole_t_c_lr_lsd_eval(rho_set, deriv_set, deriv_order, functional)
526 : ELSE
527 22 : CALL xlda_hole_t_c_lr_lda_eval(rho_set, deriv_set, deriv_order, functional)
528 : END IF
529 : CASE ("PBE_HOLE_T_C_LR")
530 4262 : IF (lsd) THEN
531 1178 : CALL xpbe_hole_t_c_lr_lsd_eval(rho_set, deriv_set, deriv_order, functional)
532 : ELSE
533 3084 : CALL xpbe_hole_t_c_lr_lda_eval(rho_set, deriv_set, deriv_order, functional)
534 : END IF
535 : CASE ("GV09")
536 258 : IF (lsd) THEN
537 : CALL xbr_pbe_lda_hole_tc_lr_lsd_eval(rho_set, deriv_set, deriv_order, &
538 58 : functional)
539 : ELSE
540 : CALL xbr_pbe_lda_hole_tc_lr_lda_eval(rho_set, deriv_set, deriv_order, &
541 200 : functional)
542 : END IF
543 : CASE default
544 : ! If functional not natively supported, ask LibXC
545 301250 : IF (lsd) THEN
546 2750 : CALL libxc_lsd_eval(rho_set, deriv_set, deriv_order, functional)
547 : ELSE
548 17670 : CALL libxc_lda_eval(rho_set, deriv_set, deriv_order, functional)
549 : END IF
550 : END SELECT
551 :
552 300685 : CALL timestop(handle)
553 : END SUBROUTINE xc_functional_eval
554 :
555 : ! **************************************************************************************************
556 : !> \brief ...
557 : !> \param functionals a section containing the functional combination to be
558 : !> applied
559 : !> \param lsd if a local spin desnity is performed
560 : !> \param rho_set a rho set where all the arguments needed by this functional
561 : !> should be valid (which argument are needed can be found with
562 : !> xc_functional_get_info)
563 : !> \param deriv_set place where to store the functional derivatives (they are
564 : !> added to the derivatives)
565 : !> \param deriv_order degree of the derivative that should be evaluated,
566 : !> if positive all the derivatives up to the given degree are evaluated,
567 : !> if negative only the given degree is requested (but to simplify
568 : !> the code all the derivatives might be calculated, you should ignore
569 : !> them when adding derivatives of various functionals they might contain
570 : !> the derivative of just one functional)
571 : !> \author fawzi
572 : ! **************************************************************************************************
573 270124 : SUBROUTINE xc_functionals_eval(functionals, lsd, rho_set, deriv_set, &
574 : deriv_order)
575 : TYPE(section_vals_type), POINTER :: functionals
576 : LOGICAL, INTENT(in) :: lsd
577 : TYPE(xc_rho_set_type), INTENT(IN) :: rho_set
578 : TYPE(xc_derivative_set_type), INTENT(IN) :: deriv_set
579 : INTEGER, INTENT(in) :: deriv_order
580 :
581 : INTEGER :: ifun
582 : TYPE(section_vals_type), POINTER :: xc_fun
583 :
584 270124 : CPASSERT(ASSOCIATED(functionals))
585 270124 : ifun = 0
586 300713 : DO
587 570837 : ifun = ifun + 1
588 570837 : xc_fun => section_vals_get_subs_vals2(functionals, i_section=ifun)
589 570837 : IF (.NOT. ASSOCIATED(xc_fun)) EXIT
590 : CALL xc_functional_eval(xc_fun, &
591 : lsd=lsd, &
592 : rho_set=rho_set, &
593 : deriv_set=deriv_set, &
594 300713 : deriv_order=deriv_order)
595 : END DO
596 270124 : END SUBROUTINE xc_functionals_eval
597 :
598 : ! **************************************************************************************************
599 : !> \brief ...
600 : !> \param functionals a section containing the functional combination to be
601 : !> applied
602 : !> \param lsd if a local spin desnity is performed
603 : !> \param calc_potential set, if potential calculation will be carried out later.
604 : !> helps to save memory and flops. defaults to false.
605 : !> \return ...
606 : !> \author fawzi
607 : ! **************************************************************************************************
608 256090 : FUNCTION xc_functionals_get_needs(functionals, lsd, calc_potential) &
609 : RESULT(needs)
610 : TYPE(section_vals_type), POINTER :: functionals
611 : LOGICAL, INTENT(in) :: lsd
612 : LOGICAL, INTENT(in), OPTIONAL :: calc_potential
613 : TYPE(xc_rho_cflags_type) :: needs
614 :
615 : INTEGER :: ifun
616 : LOGICAL :: my_calc_potential
617 : TYPE(section_vals_type), POINTER :: xc_fun
618 :
619 256090 : my_calc_potential = .FALSE.
620 256090 : IF (PRESENT(calc_potential)) my_calc_potential = calc_potential
621 :
622 256090 : CPASSERT(ASSOCIATED(functionals))
623 256090 : CALL xc_rho_cflags_setall(needs, .FALSE.)
624 :
625 256090 : ifun = 0
626 271609 : DO
627 527699 : ifun = ifun + 1
628 527699 : xc_fun => section_vals_get_subs_vals2(functionals, i_section=ifun)
629 527699 : IF (.NOT. ASSOCIATED(xc_fun)) EXIT
630 271609 : CALL xc_functional_get_info(xc_fun, lsd=lsd, needs=needs)
631 : END DO
632 :
633 256090 : IF (my_calc_potential) THEN
634 204509 : IF (lsd) THEN
635 34163 : needs%rho_spin = .TRUE.
636 67524 : needs%tau_spin = needs%tau_spin .OR. needs%tau
637 : ELSE
638 170346 : needs%rho = .TRUE.
639 : END IF
640 204509 : IF (needs%norm_drho .OR. needs%norm_drho_spin) THEN
641 118263 : IF (lsd) THEN
642 21048 : needs%drho_spin = .TRUE.
643 : ELSE
644 97215 : needs%drho = .TRUE.
645 : END IF
646 : END IF
647 : END IF
648 256090 : END FUNCTION xc_functionals_get_needs
649 :
650 : END MODULE xc_derivatives
|
