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 : !> \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 :
109 : IMPLICIT NONE
110 : PRIVATE
111 :
112 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xc_libxc_wrap'
113 :
114 : CHARACTER(LEN=*), PARAMETER, PUBLIC :: libxc_version = XC_VERSION
115 :
116 : PUBLIC :: xc_f03_func_t, xc_f03_func_info_t
117 : PUBLIC :: xc_f03_func_init, xc_f03_func_end
118 : PUBLIC :: xc_f03_functional_get_name, xc_f03_available_functional_numbers, xc_f03_maximum_name_length, &
119 : xc_f03_number_of_functionals, xc_f03_available_functional_names
120 : PUBLIC :: xc_f03_func_get_info, xc_f03_func_info_get_family, xc_f03_func_info_get_kind, &
121 : xc_f03_func_info_get_name, xc_f03_func_info_get_ext_params_name, &
122 : xc_f03_func_info_get_ext_params_description, xc_f03_func_info_get_ext_params_default_value, &
123 : xc_f03_func_info_get_n_ext_params
124 : PUBLIC :: xc_f03_gga_exc, xc_f03_gga_exc_vxc, xc_f03_gga_exc_vxc_fxc, xc_f03_gga_fxc, &
125 : xc_f03_gga_vxc, xc_f03_gga_vxc_fxc
126 : PUBLIC :: xc_f03_lda, &
127 : xc_f03_lda_exc, xc_f03_lda_exc_vxc, xc_f03_lda_exc_vxc_fxc, &
128 : xc_f03_lda_fxc, xc_f03_lda_kxc, xc_f03_lda_vxc
129 : PUBLIC :: xc_f03_mgga, xc_f03_mgga_exc, xc_f03_mgga_exc_vxc, xc_f03_mgga_fxc, &
130 : xc_f03_mgga_vxc, xc_f03_mgga_vxc_fxc
131 :
132 : PUBLIC :: XC_FAMILY_LDA, XC_FAMILY_GGA, XC_FAMILY_MGGA, &
133 : XC_FAMILY_HYB_LDA, XC_FAMILY_HYB_GGA, XC_FAMILY_HYB_MGGA
134 :
135 : PUBLIC :: XC_UNPOLARIZED, XC_POLARIZED
136 :
137 : PUBLIC :: XC_EXCHANGE, XC_CORRELATION, XC_EXCHANGE_CORRELATION, XC_KINETIC
138 :
139 : ! wrappers for routines
140 : PUBLIC :: xc_libxc_wrap_info_refs, &
141 : xc_libxc_wrap_version, &
142 : xc_libxc_wrap_functional_get_number, &
143 : xc_libxc_wrap_needs_laplace, &
144 : xc_libxc_wrap_functional_set_params, &
145 : xc_libxc_wrap_is_under_development, &
146 : xc_libxc_get_reference_length, &
147 : xc_libxc_check_functional
148 :
149 : CONTAINS
150 :
151 : ! **************************************************************************************************
152 : !> \brief Provides the reference(s) for this functional.
153 : !> \param xc_info func_info object of the functional
154 : !> \return upper bound for the length of the reference string
155 : !> \author F. Stein
156 : ! **************************************************************************************************
157 70 : FUNCTION xc_libxc_get_reference_length(xc_info) RESULT(length)
158 :
159 : TYPE(xc_f03_func_info_t), INTENT(IN) :: xc_info
160 : INTEGER :: length
161 :
162 : CHARACTER(LEN=*), PARAMETER :: routineN = 'xc_libxc_get_reference_length'
163 : INTEGER, PARAMETER :: maxlen = 67
164 :
165 : CHARACTER(LEN=128) :: descr_string
166 : CHARACTER(LEN=1024) :: doi_string, ref_string
167 : INTEGER :: i, i_ref, i_ref_old, n_params, handle
168 : TYPE(xc_f03_func_reference_t) :: xc_ref
169 :
170 70 : CALL timeset(routineN, handle)
171 :
172 : ! We are counting the number of necessary lines by carrying out a dry run of xc_libxc_wrap_info_refs
173 70 : i_ref = 0
174 70 : i_ref_old = -1
175 70 : length = 0
176 140 : DO WHILE (i_ref >= 0 .AND. i_ref /= i_ref_old)
177 : ! information about functional references
178 70 : xc_ref = xc_f03_func_info_get_references(xc_info, i_ref)
179 70 : ref_string = xc_f03_func_reference_get_ref(xc_ref)
180 70 : doi_string = xc_f03_func_reference_get_doi(xc_ref)
181 70 : length = length + LEN_TRIM(ref_string) + LEN_TRIM(doi_string) + 11
182 70 : IF (MOD(length, maxlen) /= 0) length = length + maxlen - MOD(length, maxlen)
183 : ! information about (optional) external parameters
184 70 : n_params = xc_f03_func_info_get_n_ext_params(xc_info)
185 70 : IF (n_params > 0) THEN
186 51 : length = length + maxlen
187 : END IF
188 390 : DO i = 1, n_params
189 320 : descr_string = xc_f03_func_info_get_ext_params_description(xc_info, i - 1)
190 320 : length = length + LEN_TRIM(descr_string) + 3
191 390 : IF (MOD(length, maxlen) /= 0) length = length + maxlen - MOD(length, maxlen)
192 : END DO
193 70 : i_ref_old = i_ref
194 : END DO
195 : ! two additional lines for spin polarization, scaling factor and buffer
196 70 : length = length + 2*maxlen
197 :
198 70 : CALL timestop(handle)
199 :
200 70 : END FUNCTION xc_libxc_get_reference_length
201 :
202 : ! **************************************************************************************************
203 : !> \brief Provides the reference(s) for this functional.
204 : !> \param xc_info ...
205 : !> \param polarized ...
206 : !> \param sc ...
207 : !> \param reference ...
208 : !>
209 : !> \author A. Gloess (agloess)
210 : ! **************************************************************************************************
211 70 : SUBROUTINE xc_libxc_wrap_info_refs(xc_info, polarized, sc, reference)
212 : TYPE(xc_f03_func_info_t), INTENT(IN) :: xc_info
213 : INTEGER, INTENT(IN) :: polarized
214 : REAL(KIND=dp), INTENT(IN) :: sc
215 : CHARACTER(LEN=*), INTENT(OUT) :: reference
216 :
217 : CHARACTER(LEN=*), PARAMETER :: routineN = 'xc_libxc_wrap_info_refs'
218 : INTEGER, PARAMETER :: maxlen = 67
219 :
220 : CHARACTER(LEN=128) :: descr_string
221 : CHARACTER(LEN=1028) :: doi_string, ref_string
222 : ! conservative estimate of the necessary length: 2*1028+11=2067
223 : CHARACTER(LEN=2067) :: tmp_string
224 : INTEGER :: empty, first, handle, i, i_ref, i_ref_old, idx, &
225 : last, n_params
226 : TYPE(xc_f03_func_reference_t) :: xc_ref
227 :
228 70 : CALL timeset(routineN, handle)
229 :
230 70 : i_ref = 0
231 70 : i_ref_old = -1
232 70 : idx = 1
233 70 : first = 1
234 140 : DO WHILE (i_ref >= 0 .AND. i_ref /= i_ref_old)
235 : ! information about functional references
236 70 : xc_ref = xc_f03_func_info_get_references(xc_info, i_ref)
237 70 : ref_string = xc_f03_func_reference_get_ref(xc_ref)
238 70 : doi_string = xc_f03_func_reference_get_doi(xc_ref)
239 70 : WRITE (tmp_string, '(a1,i1,a2,a,a7,a)') '[', idx, '] ', &
240 140 : TRIM(ref_string), ', doi: ', TRIM(doi_string)
241 70 : last = first + LEN_TRIM(tmp_string) - 1
242 70 : reference(first:last) = TRIM(tmp_string)
243 70 : first = last + 1
244 70 : empty = last + (maxlen - 1) - MOD(last - 1, maxlen)
245 : ! fill up line with 'spaces'
246 70 : IF (empty /= last) THEN
247 70 : reference(first:empty) = ' '
248 70 : first = empty + 1
249 : END IF
250 : ! information about (optional) external parameters
251 70 : n_params = xc_f03_func_info_get_n_ext_params(xc_info)
252 70 : IF (n_params > 0) THEN
253 51 : reference(first:first + maxlen - 1) = 'Optional external parameters:'//REPEAT(' ', maxlen - 28)
254 51 : first = first + maxlen
255 : END IF
256 390 : DO i = 1, n_params
257 320 : descr_string = xc_f03_func_info_get_ext_params_description(xc_info, i - 1)
258 320 : last = first + LEN_TRIM(descr_string) - 1 + 3
259 320 : reference(first:last) = ' * '//TRIM(descr_string)
260 320 : first = last + 1
261 320 : empty = last + (maxlen - 1) - MOD(last - 1, maxlen)
262 : ! fill up line with 'spaces'
263 :
264 390 : IF (empty /= last) THEN
265 320 : reference(first:empty) = ' '
266 320 : first = empty + 1
267 : END IF
268 : END DO
269 70 : idx = idx + 1
270 70 : i_ref_old = i_ref
271 : END DO
272 104 : SELECT CASE (polarized)
273 : CASE (XC_UNPOLARIZED)
274 34 : WRITE (tmp_string, "('{scale=',f5.3,', spin-unpolarized}')") sc
275 : CASE (XC_POLARIZED)
276 36 : WRITE (tmp_string, "('{scale=',f5.3,', spin-polarized}')") sc
277 : CASE default
278 70 : CPABORT("Unsupported value for variable 'polarized'.")
279 : END SELECT
280 70 : last = first + LEN_TRIM(tmp_string) - 1
281 70 : reference(first:last) = TRIM(tmp_string)
282 70 : first = last + 1
283 : ! fill with 'spaces'
284 70 : reference(first:LEN(reference)) = ' '
285 :
286 70 : IF (last > LEN(reference)) &
287 0 : CPABORT("Faulty reference length.")
288 :
289 70 : CALL timestop(handle)
290 :
291 70 : END SUBROUTINE xc_libxc_wrap_info_refs
292 :
293 : ! **************************************************************************************************
294 : !> \brief Provides a version string.
295 : !> \param version ...
296 : !> \author A. Gloess (agloess)
297 : !>
298 : ! **************************************************************************************************
299 0 : SUBROUTINE xc_libxc_wrap_version(version)
300 : CHARACTER(LEN=*), INTENT(OUT) :: version
301 :
302 : CHARACTER(LEN=*), PARAMETER :: routineN = 'xc_libxc_wrap_version'
303 :
304 : INTEGER :: handle
305 :
306 0 : CALL timeset(routineN, handle)
307 :
308 0 : version = TRIM(libxc_version)
309 :
310 0 : CALL timestop(handle)
311 :
312 0 : END SUBROUTINE xc_libxc_wrap_version
313 :
314 : ! **************************************************************************************************
315 : !> \brief Checks existence of functional in LibXC
316 : !> \param func_string ...
317 : !> \return ...
318 : !> \author F. Stein
319 : !> \note Remove prefix to keep compatibility, functionals can be specified (in
320 : !> LIBXC section) as:
321 : !> GGA_X_... or XC_GGA_X_...
322 : !> Starting from version 2.2.0 both name conventions are allowed, before
323 : !> the 'XC_' prefix was necessary.
324 : !>
325 : ! **************************************************************************************************
326 1843 : LOGICAL FUNCTION xc_libxc_check_functional(func_string) RESULT(exists)
327 : CHARACTER(LEN=*), INTENT(IN) :: func_string
328 :
329 : CHARACTER(LEN=*), PARAMETER :: routineN = 'xc_libxc_check_functional'
330 :
331 : INTEGER :: func_id, handle
332 :
333 1843 : CALL timeset(routineN, handle)
334 :
335 1843 : IF (func_string(1:3) == "XC_") THEN
336 0 : func_id = xc_f03_functional_get_number(func_string(4:LEN_TRIM(func_string)))
337 : ELSE
338 1843 : func_id = xc_f03_functional_get_number(func_string(1:LEN_TRIM(func_string)))
339 : END IF
340 :
341 1843 : exists = .TRUE.
342 1843 : IF (func_id == -1) exists = .FALSE.
343 :
344 1843 : CALL timestop(handle)
345 :
346 1843 : END FUNCTION xc_libxc_check_functional
347 :
348 : ! **************************************************************************************************
349 : !> \brief Provides the functional ID.
350 : !> \param func_string ...
351 : !> \return ...
352 : !> \author A. Gloess (agloess)
353 : !> \note Remove prefix to keep compatibility, functionals can be specified (in
354 : !> LIBXC section) as:
355 : !> GGA_X_... or XC_GGA_X_...
356 : !> Starting from version 2.2.0 both name conventions are allowed, before
357 : !> the 'XC_' prefix was necessary.
358 : !>
359 : ! **************************************************************************************************
360 27900 : INTEGER FUNCTION xc_libxc_wrap_functional_get_number(func_string) RESULT(func_id)
361 : CHARACTER(LEN=*), INTENT(IN) :: func_string
362 :
363 : CHARACTER(LEN=*), PARAMETER :: routineN = 'xc_libxc_wrap_functional_get_number'
364 :
365 : INTEGER :: handle
366 :
367 27900 : CALL timeset(routineN, handle)
368 :
369 27900 : IF (func_string(1:3) == "XC_") THEN
370 0 : func_id = xc_f03_functional_get_number(func_string(4:LEN_TRIM(func_string)))
371 : ELSE
372 27900 : func_id = xc_f03_functional_get_number(func_string(1:LEN_TRIM(func_string)))
373 : END IF
374 27900 : IF (func_id == -1) THEN
375 0 : CPABORT(TRIM(func_string)//": wrong functional name")
376 : END IF
377 :
378 27900 : CALL timestop(handle)
379 :
380 27900 : END FUNCTION xc_libxc_wrap_functional_get_number
381 :
382 : ! **************************************************************************************************
383 : !> \brief Wrapper to test wether functional is considered under development in Libxc
384 : !> \param xc_info ...
385 : !>
386 : !> \return ...
387 : !> \author F. Stein (fstein93)
388 : ! **************************************************************************************************
389 0 : LOGICAL FUNCTION xc_libxc_wrap_is_under_development(xc_info)
390 : TYPE(xc_f03_func_info_t) :: xc_info
391 :
392 0 : IF (IAND(xc_f03_func_info_get_flags(xc_info), XC_FLAGS_DEVELOPMENT) == XC_FLAGS_DEVELOPMENT) THEN
393 : xc_libxc_wrap_is_under_development = .TRUE.
394 : ELSE
395 0 : xc_libxc_wrap_is_under_development = .FALSE.
396 : END IF
397 :
398 0 : END FUNCTION xc_libxc_wrap_is_under_development
399 :
400 : ! **************************************************************************************************
401 : !> \brief Wrapper for functionals that need the Laplacian, all others can use
402 : !> a dummy array.
403 : !> \param func_id ...
404 : !>
405 : !> \return ...
406 : !> \author A. Gloess (agloess)
407 : ! **************************************************************************************************
408 18616 : LOGICAL FUNCTION xc_libxc_wrap_needs_laplace(func_id)
409 : ! Only some MGGA functionals needs the laplacian
410 : INTEGER, INTENT(IN) :: func_id
411 :
412 : CHARACTER(LEN=*), PARAMETER :: routineN = 'xc_libxc_wrap_needs_laplace'
413 :
414 : INTEGER :: handle
415 : TYPE(xc_f03_func_info_t) :: xc_info
416 : TYPE(xc_f03_func_t) :: xc_func
417 :
418 18616 : CALL timeset(routineN, handle)
419 :
420 : ! Some MGGa need the laplace explicit and some just need an arbitrary array
421 : ! of the correct size.
422 : !
423 : ! Assumption (.true. in v2.1.0 - v4.0.x):
424 : ! if
425 : ! functional is Laplace-dependent for XC_UNPOLARIZED
426 : ! then
427 : ! functional will be Laplace-dependent for XC_POLARIZED too.
428 : !
429 37232 : !$OMP CRITICAL(libxc_init)
430 18616 : CALL xc_f03_func_init(xc_func, func_id, XC_UNPOLARIZED)
431 18616 : xc_info = xc_f03_func_get_info(xc_func)
432 : !$OMP END CRITICAL(libxc_init)
433 18616 : !$OMP BARRIER
434 18616 : IF (IAND(xc_f03_func_info_get_flags(xc_info), XC_FLAGS_NEEDS_LAPLACIAN) == XC_FLAGS_NEEDS_LAPLACIAN) THEN
435 : xc_libxc_wrap_needs_laplace = .TRUE.
436 : ELSE
437 16814 : xc_libxc_wrap_needs_laplace = .FALSE.
438 : END IF
439 :
440 18616 : CALL xc_f03_func_end(xc_func)
441 :
442 18616 : CALL timestop(handle)
443 :
444 18616 : END FUNCTION xc_libxc_wrap_needs_laplace
445 :
446 : ! **************************************************************************************************
447 : !> \brief Wrapper for functionals that need special parameters.
448 : !> \param xc_func ...
449 : !> \param xc_info ...
450 : !> \param libxc_params ...
451 : !> \param no_exc ...
452 : !>
453 : !> \author A. Gloess (agloess)
454 : ! **************************************************************************************************
455 15114 : SUBROUTINE xc_libxc_wrap_functional_set_params(xc_func, xc_info, libxc_params, no_exc)
456 : TYPE(xc_f03_func_t), INTENT(INOUT) :: xc_func
457 : TYPE(xc_f03_func_info_t), INTENT(IN) :: xc_info
458 : TYPE(section_vals_type), POINTER, INTENT(IN) :: libxc_params
459 : LOGICAL, INTENT(INOUT) :: no_exc
460 :
461 : CHARACTER(LEN=*), PARAMETER :: routineN = 'xc_libxc_wrap_functional_set_params'
462 :
463 : INTEGER :: handle, i, n_params
464 15114 : REAL(KIND=dp), DIMENSION(:), ALLOCATABLE :: params
465 : CHARACTER(LEN=128) :: param_name
466 :
467 15114 : CALL timeset(routineN, handle)
468 :
469 15114 : n_params = xc_f03_func_info_get_n_ext_params(xc_info)
470 15114 : IF (n_params > 0) THEN
471 27420 : ALLOCATE (params(n_params))
472 57244 : DO i = 1, n_params
473 48104 : param_name = xc_f03_func_info_get_ext_params_name(xc_info, i - 1)
474 :
475 57244 : CALL section_vals_val_get(libxc_params, TRIM(param_name), r_val=params(i))
476 : END DO
477 :
478 9140 : CALL xc_f03_func_set_ext_params(xc_func, params)
479 : END IF
480 :
481 15114 : IF (IAND(xc_f03_func_info_get_flags(xc_info), XC_FLAGS_HAVE_EXC) == XC_FLAGS_HAVE_EXC) THEN
482 15114 : no_exc = .FALSE.
483 : ELSE
484 0 : no_exc = .TRUE.
485 : END IF
486 :
487 15114 : CALL timestop(handle)
488 :
489 15114 : END SUBROUTINE xc_libxc_wrap_functional_set_params
490 :
491 : #endif
492 : #endif
493 : END MODULE xc_libxc_wrap
|
