(git:b279b6b)
xc_libxc_wrap.F
Go to the documentation of this file.
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  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  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  i_ref = 0
174  i_ref_old = -1
175  length = 0
176  DO WHILE (i_ref >= 0 .AND. i_ref /= i_ref_old)
177  ! information about functional references
178  xc_ref = xc_f03_func_info_get_references(xc_info, i_ref)
179  ref_string = xc_f03_func_reference_get_ref(xc_ref)
180  doi_string = xc_f03_func_reference_get_doi(xc_ref)
181  length = length + len_trim(ref_string) + len_trim(doi_string) + 11
182  IF (mod(length, maxlen) /= 0) length = length + maxlen - mod(length, maxlen)
183  ! information about (optional) external parameters
184  n_params = xc_f03_func_info_get_n_ext_params(xc_info)
185  IF (n_params > 0) THEN
186  length = length + maxlen
187  END IF
188  DO i = 1, n_params
189  descr_string = xc_f03_func_info_get_ext_params_description(xc_info, i - 1)
190  length = length + len_trim(descr_string) + 3
191  IF (mod(length, maxlen) /= 0) length = length + maxlen - mod(length, maxlen)
192  END DO
193  i_ref_old = i_ref
194  END DO
195  ! two additional lines for spin polarization, scaling factor and buffer
196  length = length + 2*maxlen
197 
198  CALL timestop(handle)
199 
200  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  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  CALL timeset(routinen, handle)
229 
230  i_ref = 0
231  i_ref_old = -1
232  idx = 1
233  first = 1
234  DO WHILE (i_ref >= 0 .AND. i_ref /= i_ref_old)
235  ! information about functional references
236  xc_ref = xc_f03_func_info_get_references(xc_info, i_ref)
237  ref_string = xc_f03_func_reference_get_ref(xc_ref)
238  doi_string = xc_f03_func_reference_get_doi(xc_ref)
239  WRITE (tmp_string, '(a1,i1,a2,a,a7,a)') '[', idx, '] ', &
240  trim(ref_string), ', doi: ', trim(doi_string)
241  last = first + len_trim(tmp_string) - 1
242  reference(first:last) = trim(tmp_string)
243  first = last + 1
244  empty = last + (maxlen - 1) - mod(last - 1, maxlen)
245  ! fill up line with 'spaces'
246  IF (empty /= last) THEN
247  reference(first:empty) = ' '
248  first = empty + 1
249  END IF
250  ! information about (optional) external parameters
251  n_params = xc_f03_func_info_get_n_ext_params(xc_info)
252  IF (n_params > 0) THEN
253  reference(first:first + maxlen - 1) = 'Optional external parameters:'//repeat(' ', maxlen - 28)
254  first = first + maxlen
255  END IF
256  DO i = 1, n_params
257  descr_string = xc_f03_func_info_get_ext_params_description(xc_info, i - 1)
258  last = first + len_trim(descr_string) - 1 + 3
259  reference(first:last) = ' * '//trim(descr_string)
260  first = last + 1
261  empty = last + (maxlen - 1) - mod(last - 1, maxlen)
262  ! fill up line with 'spaces'
263 
264  IF (empty /= last) THEN
265  reference(first:empty) = ' '
266  first = empty + 1
267  END IF
268  END DO
269  idx = idx + 1
270  i_ref_old = i_ref
271  END DO
272  SELECT CASE (polarized)
273  CASE (xc_unpolarized)
274  WRITE (tmp_string, "('{scale=',f5.3,', spin-unpolarized}')") sc
275  CASE (xc_polarized)
276  WRITE (tmp_string, "('{scale=',f5.3,', spin-polarized}')") sc
277  CASE default
278  cpabort("Unsupported value for variable 'polarized'.")
279  END SELECT
280  last = first + len_trim(tmp_string) - 1
281  reference(first:last) = trim(tmp_string)
282  first = last + 1
283  ! fill with 'spaces'
284  reference(first:len(reference)) = ' '
285 
286  IF (last > len(reference)) &
287  cpabort("Faulty reference length.")
288 
289  CALL timestop(handle)
290 
291  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  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  CALL timeset(routinen, handle)
307 
308  version = trim(libxc_version)
309 
310  CALL timestop(handle)
311 
312  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  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  CALL timeset(routinen, handle)
334 
335  IF (func_string(1:3) == "XC_") THEN
336  func_id = xc_f03_functional_get_number(func_string(4:len_trim(func_string)))
337  ELSE
338  func_id = xc_f03_functional_get_number(func_string(1:len_trim(func_string)))
339  END IF
340 
341  exists = .true.
342  IF (func_id == -1) exists = .false.
343 
344  CALL timestop(handle)
345 
346  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  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  CALL timeset(routinen, handle)
368 
369  IF (func_string(1:3) == "XC_") THEN
370  func_id = xc_f03_functional_get_number(func_string(4:len_trim(func_string)))
371  ELSE
372  func_id = xc_f03_functional_get_number(func_string(1:len_trim(func_string)))
373  END IF
374  IF (func_id == -1) THEN
375  cpabort(trim(func_string)//": wrong functional name")
376  END IF
377 
378  CALL timestop(handle)
379 
380  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  LOGICAL FUNCTION xc_libxc_wrap_is_under_development(xc_info)
390  TYPE(xc_f03_func_info_t) :: xc_info
391 
392  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  xc_libxc_wrap_is_under_development = .false.
396  END IF
397 
398  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  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  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 !$OMP CRITICAL(libxc_init)
430  CALL xc_f03_func_init(xc_func, func_id, xc_unpolarized)
431  xc_info = xc_f03_func_get_info(xc_func)
432 !$OMP END CRITICAL(libxc_init)
433 !$OMP BARRIER
434  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  xc_libxc_wrap_needs_laplace = .false.
438  END IF
439 
440  CALL xc_f03_func_end(xc_func)
441 
442  CALL timestop(handle)
443 
444  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  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  REAL(KIND=dp), DIMENSION(:), ALLOCATABLE :: params
465  CHARACTER(LEN=128) :: param_name
466 
467  CALL timeset(routinen, handle)
468 
469  n_params = xc_f03_func_info_get_n_ext_params(xc_info)
470  IF (n_params > 0) THEN
471  ALLOCATE (params(n_params))
472  DO i = 1, n_params
473  param_name = xc_f03_func_info_get_ext_params_name(xc_info, i - 1)
474 
475  CALL section_vals_val_get(libxc_params, trim(param_name), r_val=params(i))
476  END DO
477 
478  CALL xc_f03_func_set_ext_params(xc_func, params)
479  END IF
480 
481  IF (iand(xc_f03_func_info_get_flags(xc_info), xc_flags_have_exc) == xc_flags_have_exc) THEN
482  no_exc = .false.
483  ELSE
484  no_exc = .true.
485  END IF
486 
487  CALL timestop(handle)
488 
489  END SUBROUTINE xc_libxc_wrap_functional_set_params
490 
491 #endif
492 #endif
493 END MODULE xc_libxc_wrap
cp2k
program cp2k
Main program of CP2K.
Definition: cp2k.F:42
cp_log_handling
various routines to log and control the output. The idea is that decisions about where to log should ...
Definition: cp_log_handling.F:41
input_section_types
objects that represent the structure of input sections and the data contained in an input section
Definition: input_section_types.F:15
input_section_types::section_create
subroutine, public section_create(section, location, name, description, n_keywords, n_subsections, repeats, citations)
creates a list of keywords
Definition: input_section_types.F:156
input_section_types::section_add_keyword
subroutine, public section_add_keyword(section, keyword)
adds a keyword to the given section
Definition: input_section_types.F:504
input_section_types::section_add_subsection
subroutine, public section_add_subsection(section, subsection)
adds a subsection to the given section
Definition: input_section_types.F:560
input_section_types::section_release
recursive subroutine, public section_release(section)
releases the given keyword list (see doc/ReferenceCounting.html)
Definition: input_section_types.F:231
input_section_types::section_vals_val_get
subroutine, public section_vals_val_get(section_vals, keyword_name, i_rep_section, i_rep_val, n_rep_val, val, l_val, i_val, r_val, c_val, l_vals, i_vals, r_vals, c_vals, explicit)
returns the requested value
Definition: input_section_types.F:1040
kinds
Defines the basic variable types.
Definition: kinds.F:23
kinds::dp
integer, parameter, public dp
Definition: kinds.F:34
xc_libxc_wrap
Includes all necessary routines, functions and parameters from libxc. Provides CP2K routines/function...
Definition: xc_libxc_wrap.F:22