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 : !> \brief Includes all necessary routines, functions and parameters from
10 : !> libxc. Provides CP2K routines/functions where the LibXC calling list
11 : !> is version dependent (>=4.0.3). The naming convention for such
12 : !> routines/functions is xc_f03_XXX --> 'xc_libxc_wrap_XXX'. All version
13 : !> independent routines/functions are just bypassed to higher level
14 : !> module file 'xc_libxc'.
15 : !>
16 : !> \par History
17 : !> 08.2015 created [A. Gloess (agloess)]
18 : !> 01.2018 refactoring [A. Gloess (agloess)]
19 : !> 10.2018/04.2019 added hyb_mgga [S. Simko, included by F. Stein]
20 : !> \author A. Gloess (agloess)
21 : ! **************************************************************************************************
22 : MODULE xc_libxc_wrap
23 : #if defined (__LIBXC)
24 : #include <xc_version.h>
25 : ! check for LibXC version
26 : #if (XC_MAJOR_VERSION < 5 || (XC_MAJOR_VERSION == 5 && XC_MINOR_VERSION < 1))
27 : This version of CP2K ONLY works with libxc versions 5.1.0 and above.
28 : Furthermore, -I${LIBXC_DIR}/include needs to be added to FCFLAGS.
29 : #else
30 : ! Functionals which require parameters
31 : USE cp_log_handling, ONLY: cp_to_string
32 : USE kinds, ONLY: dp
33 : USE xc_f03_lib_m, ONLY: xc_f03_func_end, &
34 : xc_f03_func_init, &
35 : xc_f03_functional_get_name, &
36 : xc_f03_func_set_ext_params, &
37 : xc_f03_functional_get_number, &
38 : xc_f03_available_functional_numbers, &
39 : xc_f03_available_functional_names, &
40 : xc_f03_maximum_name_length, &
41 : xc_f03_number_of_functionals, &
42 : !
43 : xc_f03_gga_exc, &
44 : xc_f03_gga_exc_vxc, &
45 : xc_f03_gga_exc_vxc_fxc, &
46 : xc_f03_gga_fxc, &
47 : xc_f03_gga_vxc, &
48 : xc_f03_gga_vxc_fxc, &
49 : !
50 : xc_f03_func_get_info, &
51 : xc_f03_func_info_get_family, &
52 : xc_f03_func_info_get_kind, &
53 : xc_f03_func_info_get_name, &
54 : xc_f03_func_info_get_references, &
55 : xc_f03_func_info_get_flags, &
56 : xc_f03_func_info_get_n_ext_params, &
57 : xc_f03_func_info_get_ext_params_name, &
58 : xc_f03_func_info_get_ext_params_default_value, &
59 : xc_f03_func_info_get_ext_params_description, &
60 : !
61 : xc_f03_func_reference_get_ref, &
62 : xc_f03_func_reference_get_doi, &
63 : !
64 : xc_f03_lda => xc_f03_lda_exc_vxc_fxc_kxc, &
65 : xc_f03_lda_exc, &
66 : xc_f03_lda_exc_vxc, &
67 : xc_f03_lda_exc_vxc_fxc, &
68 : xc_f03_lda_fxc, &
69 : xc_f03_lda_kxc, &
70 : xc_f03_lda_vxc, &
71 : !
72 : xc_f03_mgga => xc_f03_mgga_exc_vxc_fxc, &
73 : xc_f03_mgga_exc, &
74 : xc_f03_mgga_exc_vxc, &
75 : xc_f03_mgga_fxc, &
76 : xc_f03_mgga_vxc, &
77 : xc_f03_mgga_vxc_fxc, &
78 : !
79 : xc_f03_func_t, &
80 : xc_f03_func_info_t, &
81 : xc_f03_func_reference_t, &
82 : !
83 : XC_FAMILY_LDA, &
84 : XC_FAMILY_GGA, &
85 : XC_FAMILY_MGGA, &
86 : XC_FAMILY_HYB_LDA, &
87 : XC_FAMILY_HYB_GGA, &
88 : XC_FAMILY_HYB_MGGA, &
89 : !
90 : XC_UNPOLARIZED, &
91 : XC_POLARIZED, &
92 : !
93 : XC_EXCHANGE, &
94 : XC_CORRELATION, &
95 : XC_EXCHANGE_CORRELATION, &
96 : XC_KINETIC, &
97 : !
98 : XC_FLAGS_NEEDS_LAPLACIAN, &
99 : XC_FLAGS_HAVE_EXC, &
100 : XC_FLAGS_DEVELOPMENT
101 :
102 : USE input_section_types, ONLY: section_add_keyword, &
103 : section_add_subsection, &
104 : section_create, &
105 : section_release, &
106 : section_type, section_vals_type, section_vals_val_get
107 : #include "../base/base_uses.f90"
108 : #endif
109 : IMPLICIT NONE
110 : PRIVATE
111 : #if defined (__LIBXC)
112 :
113 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xc_libxc_wrap'
114 :
115 : CHARACTER(LEN=*), PARAMETER, PUBLIC :: libxc_version = XC_VERSION
116 :
117 : PUBLIC :: xc_f03_func_t, xc_f03_func_info_t
118 : PUBLIC :: xc_f03_func_init, xc_f03_func_end
119 : PUBLIC :: xc_f03_functional_get_name, xc_f03_available_functional_numbers, xc_f03_maximum_name_length, &
120 : xc_f03_number_of_functionals, xc_f03_available_functional_names
121 : PUBLIC :: xc_f03_func_get_info, xc_f03_func_info_get_family, xc_f03_func_info_get_kind, &
122 : xc_f03_func_info_get_name, xc_f03_func_info_get_ext_params_name, &
123 : xc_f03_func_info_get_ext_params_description, xc_f03_func_info_get_ext_params_default_value, &
124 : xc_f03_func_info_get_n_ext_params
125 : PUBLIC :: xc_f03_gga_exc, xc_f03_gga_exc_vxc, xc_f03_gga_exc_vxc_fxc, xc_f03_gga_fxc, &
126 : xc_f03_gga_vxc, xc_f03_gga_vxc_fxc
127 : PUBLIC :: xc_f03_lda, &
128 : xc_f03_lda_exc, xc_f03_lda_exc_vxc, xc_f03_lda_exc_vxc_fxc, &
129 : xc_f03_lda_fxc, xc_f03_lda_kxc, xc_f03_lda_vxc
130 : PUBLIC :: xc_f03_mgga, xc_f03_mgga_exc, xc_f03_mgga_exc_vxc, xc_f03_mgga_fxc, &
131 : xc_f03_mgga_vxc, xc_f03_mgga_vxc_fxc
132 :
133 : PUBLIC :: XC_FAMILY_LDA, XC_FAMILY_GGA, XC_FAMILY_MGGA, &
134 : XC_FAMILY_HYB_LDA, XC_FAMILY_HYB_GGA, XC_FAMILY_HYB_MGGA
135 :
136 : PUBLIC :: XC_UNPOLARIZED, XC_POLARIZED
137 :
138 : PUBLIC :: XC_EXCHANGE, XC_CORRELATION, XC_EXCHANGE_CORRELATION, XC_KINETIC
139 :
140 : ! wrappers for routines
141 : PUBLIC :: xc_libxc_wrap_info_refs, &
142 : xc_libxc_wrap_version, &
143 : xc_libxc_wrap_functional_get_number, &
144 : xc_libxc_wrap_needs_laplace, &
145 : xc_libxc_wrap_functional_set_params, &
146 : xc_libxc_wrap_is_under_development, &
147 : xc_libxc_get_reference_length, &
148 : xc_libxc_check_functional
149 :
150 : CONTAINS
151 :
152 : ! **************************************************************************************************
153 : !> \brief Provides the reference(s) for this functional.
154 : !> \param xc_info func_info object of the functional
155 : !> \return upper bound for the length of the reference string
156 : !> \author F. Stein
157 : ! **************************************************************************************************
158 98 : FUNCTION xc_libxc_get_reference_length(xc_info) RESULT(length)
159 :
160 : TYPE(xc_f03_func_info_t), INTENT(IN) :: xc_info
161 : INTEGER :: length
162 :
163 : CHARACTER(LEN=*), PARAMETER :: routineN = 'xc_libxc_get_reference_length'
164 : INTEGER, PARAMETER :: maxlen = 67
165 :
166 : CHARACTER(LEN=128) :: descr_string
167 : CHARACTER(LEN=1024) :: doi_string, ref_string
168 : INTEGER :: i, i_ref, i_ref_old, n_params, handle
169 : TYPE(xc_f03_func_reference_t) :: xc_ref
170 :
171 98 : CALL timeset(routineN, handle)
172 :
173 : ! We are counting the number of necessary lines by carrying out a dry run of xc_libxc_wrap_info_refs
174 98 : i_ref = 0
175 98 : i_ref_old = -1
176 98 : length = 0
177 196 : DO WHILE (i_ref >= 0 .AND. i_ref /= i_ref_old)
178 : ! information about functional references
179 98 : xc_ref = xc_f03_func_info_get_references(xc_info, i_ref)
180 98 : ref_string = xc_f03_func_reference_get_ref(xc_ref)
181 98 : doi_string = xc_f03_func_reference_get_doi(xc_ref)
182 98 : length = length + LEN_TRIM(ref_string) + LEN_TRIM(doi_string) + 11
183 98 : IF (MOD(length, maxlen) /= 0) length = length + maxlen - MOD(length, maxlen)
184 : ! information about (optional) external parameters
185 98 : n_params = xc_f03_func_info_get_n_ext_params(xc_info)
186 98 : IF (n_params > 0) THEN
187 75 : length = length + maxlen
188 : END IF
189 503 : DO i = 1, n_params
190 405 : descr_string = xc_f03_func_info_get_ext_params_description(xc_info, i - 1)
191 405 : length = length + LEN_TRIM(descr_string) + 3
192 503 : IF (MOD(length, maxlen) /= 0) length = length + maxlen - MOD(length, maxlen)
193 : END DO
194 98 : i_ref_old = i_ref
195 : END DO
196 : ! two additional lines for spin polarization, scaling factor and buffer
197 98 : length = length + 2*maxlen
198 :
199 98 : CALL timestop(handle)
200 :
201 98 : END FUNCTION xc_libxc_get_reference_length
202 :
203 : ! **************************************************************************************************
204 : !> \brief Provides the reference(s) for this functional.
205 : !> \param xc_info ...
206 : !> \param polarized ...
207 : !> \param sc ...
208 : !> \param reference ...
209 : !>
210 : !> \author A. Gloess (agloess)
211 : ! **************************************************************************************************
212 98 : SUBROUTINE xc_libxc_wrap_info_refs(xc_info, polarized, sc, reference)
213 : TYPE(xc_f03_func_info_t), INTENT(IN) :: xc_info
214 : INTEGER, INTENT(IN) :: polarized
215 : REAL(KIND=dp), INTENT(IN) :: sc
216 : CHARACTER(LEN=*), INTENT(OUT) :: reference
217 :
218 : CHARACTER(LEN=*), PARAMETER :: routineN = 'xc_libxc_wrap_info_refs'
219 : INTEGER, PARAMETER :: maxlen = 67
220 :
221 : CHARACTER(LEN=128) :: descr_string
222 : CHARACTER(LEN=1028) :: doi_string, ref_string
223 : ! conservative estimate of the necessary length: 2*1028+11=2067
224 : CHARACTER(LEN=2067) :: tmp_string
225 : INTEGER :: empty, first, handle, i, i_ref, i_ref_old, idx, &
226 : last, n_params
227 : TYPE(xc_f03_func_reference_t) :: xc_ref
228 :
229 98 : CALL timeset(routineN, handle)
230 :
231 98 : i_ref = 0
232 98 : i_ref_old = -1
233 98 : idx = 1
234 98 : first = 1
235 196 : DO WHILE (i_ref >= 0 .AND. i_ref /= i_ref_old)
236 : ! information about functional references
237 98 : xc_ref = xc_f03_func_info_get_references(xc_info, i_ref)
238 98 : ref_string = xc_f03_func_reference_get_ref(xc_ref)
239 98 : doi_string = xc_f03_func_reference_get_doi(xc_ref)
240 98 : WRITE (tmp_string, '(a1,i1,a2,a,a7,a)') '[', idx, '] ', &
241 196 : TRIM(ref_string), ', doi: ', TRIM(doi_string)
242 98 : last = first + LEN_TRIM(tmp_string) - 1
243 98 : reference(first:last) = TRIM(tmp_string)
244 98 : first = last + 1
245 98 : empty = last + (maxlen - 1) - MOD(last - 1, maxlen)
246 : ! fill up line with 'spaces'
247 98 : IF (empty /= last) THEN
248 98 : reference(first:empty) = ' '
249 98 : first = empty + 1
250 : END IF
251 : ! information about (optional) external parameters
252 98 : n_params = xc_f03_func_info_get_n_ext_params(xc_info)
253 98 : IF (n_params > 0) THEN
254 75 : reference(first:first + maxlen - 1) = 'Optional external parameters:'//REPEAT(' ', maxlen - 28)
255 75 : first = first + maxlen
256 : END IF
257 503 : DO i = 1, n_params
258 405 : descr_string = xc_f03_func_info_get_ext_params_description(xc_info, i - 1)
259 405 : last = first + LEN_TRIM(descr_string) - 1 + 3
260 405 : reference(first:last) = ' * '//TRIM(descr_string)
261 405 : first = last + 1
262 405 : empty = last + (maxlen - 1) - MOD(last - 1, maxlen)
263 : ! fill up line with 'spaces'
264 :
265 503 : IF (empty /= last) THEN
266 405 : reference(first:empty) = ' '
267 405 : first = empty + 1
268 : END IF
269 : END DO
270 98 : idx = idx + 1
271 98 : i_ref_old = i_ref
272 : END DO
273 150 : SELECT CASE (polarized)
274 : CASE (XC_UNPOLARIZED)
275 52 : WRITE (tmp_string, "('{scale=',f5.3,', spin-unpolarized}')") sc
276 : CASE (XC_POLARIZED)
277 46 : WRITE (tmp_string, "('{scale=',f5.3,', spin-polarized}')") sc
278 : CASE default
279 98 : CPABORT("Unsupported value for variable 'polarized'.")
280 : END SELECT
281 98 : last = first + LEN_TRIM(tmp_string) - 1
282 98 : reference(first:last) = TRIM(tmp_string)
283 98 : first = last + 1
284 : ! fill with 'spaces'
285 98 : reference(first:LEN(reference)) = ' '
286 :
287 98 : IF (last > LEN(reference)) &
288 0 : CPABORT("Faulty reference length.")
289 :
290 98 : CALL timestop(handle)
291 :
292 98 : END SUBROUTINE xc_libxc_wrap_info_refs
293 :
294 : ! **************************************************************************************************
295 : !> \brief Provides a version string.
296 : !> \param version ...
297 : !> \author A. Gloess (agloess)
298 : !>
299 : ! **************************************************************************************************
300 0 : SUBROUTINE xc_libxc_wrap_version(version)
301 : CHARACTER(LEN=*), INTENT(OUT) :: version
302 :
303 : CHARACTER(LEN=*), PARAMETER :: routineN = 'xc_libxc_wrap_version'
304 :
305 : INTEGER :: handle
306 :
307 0 : CALL timeset(routineN, handle)
308 :
309 0 : version = TRIM(libxc_version)
310 :
311 0 : CALL timestop(handle)
312 :
313 0 : END SUBROUTINE xc_libxc_wrap_version
314 :
315 : ! **************************************************************************************************
316 : !> \brief Checks existence of functional in LibXC
317 : !> \param func_string ...
318 : !> \return ...
319 : !> \author F. Stein
320 : !> \note Remove prefix to keep compatibility, functionals can be specified (in
321 : !> LIBXC section) as:
322 : !> GGA_X_... or XC_GGA_X_...
323 : !> Starting from version 2.2.0 both name conventions are allowed, before
324 : !> the 'XC_' prefix was necessary.
325 : !>
326 : ! **************************************************************************************************
327 2211 : LOGICAL FUNCTION xc_libxc_check_functional(func_string) RESULT(exists)
328 : CHARACTER(LEN=*), INTENT(IN) :: func_string
329 :
330 : CHARACTER(LEN=*), PARAMETER :: routineN = 'xc_libxc_check_functional'
331 :
332 : INTEGER :: func_id, handle
333 :
334 2211 : CALL timeset(routineN, handle)
335 :
336 2211 : IF (func_string(1:3) == "XC_") THEN
337 0 : func_id = xc_f03_functional_get_number(func_string(4:LEN_TRIM(func_string)))
338 : ELSE
339 2211 : func_id = xc_f03_functional_get_number(func_string(1:LEN_TRIM(func_string)))
340 : END IF
341 :
342 2211 : exists = .TRUE.
343 2211 : IF (func_id == -1) exists = .FALSE.
344 :
345 2211 : CALL timestop(handle)
346 :
347 2211 : END FUNCTION xc_libxc_check_functional
348 :
349 : ! **************************************************************************************************
350 : !> \brief Provides the functional ID.
351 : !> \param func_string ...
352 : !> \return ...
353 : !> \author A. Gloess (agloess)
354 : !> \note Remove prefix to keep compatibility, functionals can be specified (in
355 : !> LIBXC section) as:
356 : !> GGA_X_... or XC_GGA_X_...
357 : !> Starting from version 2.2.0 both name conventions are allowed, before
358 : !> the 'XC_' prefix was necessary.
359 : !>
360 : ! **************************************************************************************************
361 36740 : INTEGER FUNCTION xc_libxc_wrap_functional_get_number(func_string) RESULT(func_id)
362 : CHARACTER(LEN=*), INTENT(IN) :: func_string
363 :
364 : CHARACTER(LEN=*), PARAMETER :: routineN = 'xc_libxc_wrap_functional_get_number'
365 :
366 : INTEGER :: handle
367 :
368 36740 : CALL timeset(routineN, handle)
369 :
370 36740 : IF (func_string(1:3) == "XC_") THEN
371 0 : func_id = xc_f03_functional_get_number(func_string(4:LEN_TRIM(func_string)))
372 : ELSE
373 36740 : func_id = xc_f03_functional_get_number(func_string(1:LEN_TRIM(func_string)))
374 : END IF
375 36740 : IF (func_id == -1) THEN
376 0 : CPABORT(TRIM(func_string)//": wrong functional name")
377 : END IF
378 :
379 36740 : CALL timestop(handle)
380 :
381 36740 : END FUNCTION xc_libxc_wrap_functional_get_number
382 :
383 : ! **************************************************************************************************
384 : !> \brief Wrapper to test wether functional is considered under development in Libxc
385 : !> \param xc_info ...
386 : !>
387 : !> \return ...
388 : !> \author F. Stein (fstein93)
389 : ! **************************************************************************************************
390 0 : LOGICAL FUNCTION xc_libxc_wrap_is_under_development(xc_info)
391 : TYPE(xc_f03_func_info_t) :: xc_info
392 :
393 0 : IF (IAND(xc_f03_func_info_get_flags(xc_info), XC_FLAGS_DEVELOPMENT) == XC_FLAGS_DEVELOPMENT) THEN
394 : xc_libxc_wrap_is_under_development = .TRUE.
395 : ELSE
396 0 : xc_libxc_wrap_is_under_development = .FALSE.
397 : END IF
398 :
399 0 : END FUNCTION xc_libxc_wrap_is_under_development
400 :
401 : ! **************************************************************************************************
402 : !> \brief Wrapper for functionals that need the Laplacian, all others can use
403 : !> a dummy array.
404 : !> \param func_id ...
405 : !>
406 : !> \return ...
407 : !> \author A. Gloess (agloess)
408 : ! **************************************************************************************************
409 24630 : LOGICAL FUNCTION xc_libxc_wrap_needs_laplace(func_id)
410 : ! Only some MGGA functionals needs the laplacian
411 : INTEGER, INTENT(IN) :: func_id
412 :
413 : CHARACTER(LEN=*), PARAMETER :: routineN = 'xc_libxc_wrap_needs_laplace'
414 :
415 : INTEGER :: handle
416 : TYPE(xc_f03_func_info_t) :: xc_info
417 : TYPE(xc_f03_func_t) :: xc_func
418 :
419 24630 : CALL timeset(routineN, handle)
420 :
421 : ! Some MGGa need the laplace explicit and some just need an arbitrary array
422 : ! of the correct size.
423 : !
424 : ! Assumption (.true. in v2.1.0 - v4.0.x):
425 : ! if
426 : ! functional is Laplace-dependent for XC_UNPOLARIZED
427 : ! then
428 : ! functional will be Laplace-dependent for XC_POLARIZED too.
429 : !
430 49260 : !$OMP CRITICAL(libxc_init)
431 24630 : CALL xc_f03_func_init(xc_func, func_id, XC_UNPOLARIZED)
432 24630 : xc_info = xc_f03_func_get_info(xc_func)
433 : !$OMP END CRITICAL(libxc_init)
434 24630 : !$OMP BARRIER
435 24630 : IF (IAND(xc_f03_func_info_get_flags(xc_info), XC_FLAGS_NEEDS_LAPLACIAN) == XC_FLAGS_NEEDS_LAPLACIAN) THEN
436 : xc_libxc_wrap_needs_laplace = .TRUE.
437 : ELSE
438 22812 : xc_libxc_wrap_needs_laplace = .FALSE.
439 : END IF
440 :
441 24630 : CALL xc_f03_func_end(xc_func)
442 :
443 24630 : CALL timestop(handle)
444 :
445 24630 : END FUNCTION xc_libxc_wrap_needs_laplace
446 :
447 : ! **************************************************************************************************
448 : !> \brief Wrapper for functionals that need special parameters.
449 : !> \param xc_func ...
450 : !> \param xc_info ...
451 : !> \param libxc_params ...
452 : !> \param no_exc ...
453 : !>
454 : !> \author A. Gloess (agloess)
455 : ! **************************************************************************************************
456 20692 : SUBROUTINE xc_libxc_wrap_functional_set_params(xc_func, xc_info, libxc_params, no_exc)
457 : TYPE(xc_f03_func_t), INTENT(INOUT) :: xc_func
458 : TYPE(xc_f03_func_info_t), INTENT(IN) :: xc_info
459 : TYPE(section_vals_type), POINTER, INTENT(IN) :: libxc_params
460 : LOGICAL, INTENT(INOUT) :: no_exc
461 :
462 : CHARACTER(LEN=*), PARAMETER :: routineN = 'xc_libxc_wrap_functional_set_params'
463 :
464 : INTEGER :: handle, i, n_params
465 20692 : REAL(KIND=dp), DIMENSION(:), ALLOCATABLE :: params
466 : CHARACTER(LEN=128) :: param_name
467 :
468 20692 : CALL timeset(routineN, handle)
469 :
470 20692 : n_params = xc_f03_func_info_get_n_ext_params(xc_info)
471 20692 : IF (n_params > 0) THEN
472 37398 : ALLOCATE (params(n_params))
473 77164 : DO i = 1, n_params
474 64698 : param_name = xc_f03_func_info_get_ext_params_name(xc_info, i - 1)
475 :
476 77164 : CALL section_vals_val_get(libxc_params, TRIM(param_name), r_val=params(i))
477 : END DO
478 :
479 12466 : CALL xc_f03_func_set_ext_params(xc_func, params)
480 : END IF
481 :
482 20692 : IF (IAND(xc_f03_func_info_get_flags(xc_info), XC_FLAGS_HAVE_EXC) == XC_FLAGS_HAVE_EXC) THEN
483 20692 : no_exc = .FALSE.
484 : ELSE
485 0 : no_exc = .TRUE.
486 : END IF
487 :
488 20692 : CALL timestop(handle)
489 :
490 20692 : END SUBROUTINE xc_libxc_wrap_functional_set_params
491 :
492 : #endif
493 : #endif
494 : END MODULE xc_libxc_wrap
|
