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