LCOV - code coverage report
Current view: top level - src/xc - xc_libxc_wrap.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 88.4 % 121 107
Test Date: 2025-07-25 12:55:17 Functions: 75.0 % 8 6

            Line data    Source code
       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2025 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           76 :    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           76 :       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           76 :       i_ref = 0
     174           76 :       i_ref_old = -1
     175           76 :       length = 0
     176          152 :       DO WHILE (i_ref >= 0 .AND. i_ref /= i_ref_old)
     177              :          ! information about functional references
     178           76 :          xc_ref = xc_f03_func_info_get_references(xc_info, i_ref)
     179           76 :          ref_string = xc_f03_func_reference_get_ref(xc_ref)
     180           76 :          doi_string = xc_f03_func_reference_get_doi(xc_ref)
     181           76 :          length = length + LEN_TRIM(ref_string) + LEN_TRIM(doi_string) + 11
     182           76 :          IF (MOD(length, maxlen) /= 0) length = length + maxlen - MOD(length, maxlen)
     183              :          ! information about (optional) external parameters
     184           76 :          n_params = xc_f03_func_info_get_n_ext_params(xc_info)
     185           76 :          IF (n_params > 0) THEN
     186           57 :             length = length + maxlen
     187              :          END IF
     188          411 :          DO i = 1, n_params
     189          335 :             descr_string = xc_f03_func_info_get_ext_params_description(xc_info, i - 1)
     190          335 :             length = length + LEN_TRIM(descr_string) + 3
     191          411 :             IF (MOD(length, maxlen) /= 0) length = length + maxlen - MOD(length, maxlen)
     192              :          END DO
     193           76 :          i_ref_old = i_ref
     194              :       END DO
     195              :       ! two additional lines for spin polarization, scaling factor and buffer
     196           76 :       length = length + 2*maxlen
     197              : 
     198           76 :       CALL timestop(handle)
     199              : 
     200           76 :    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           76 :    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           76 :       CALL timeset(routineN, handle)
     229              : 
     230           76 :       i_ref = 0
     231           76 :       i_ref_old = -1
     232           76 :       idx = 1
     233           76 :       first = 1
     234          152 :       DO WHILE (i_ref >= 0 .AND. i_ref /= i_ref_old)
     235              :          ! information about functional references
     236           76 :          xc_ref = xc_f03_func_info_get_references(xc_info, i_ref)
     237           76 :          ref_string = xc_f03_func_reference_get_ref(xc_ref)
     238           76 :          doi_string = xc_f03_func_reference_get_doi(xc_ref)
     239           76 :          WRITE (tmp_string, '(a1,i1,a2,a,a7,a)') '[', idx, '] ', &
     240          152 :             TRIM(ref_string), ', doi: ', TRIM(doi_string)
     241           76 :          last = first + LEN_TRIM(tmp_string) - 1
     242           76 :          reference(first:last) = TRIM(tmp_string)
     243           76 :          first = last + 1
     244           76 :          empty = last + (maxlen - 1) - MOD(last - 1, maxlen)
     245              :          ! fill up line with 'spaces'
     246           76 :          IF (empty /= last) THEN
     247           76 :             reference(first:empty) = ' '
     248           76 :             first = empty + 1
     249              :          END IF
     250              :          ! information about (optional) external parameters
     251           76 :          n_params = xc_f03_func_info_get_n_ext_params(xc_info)
     252           76 :          IF (n_params > 0) THEN
     253           57 :             reference(first:first + maxlen - 1) = 'Optional external parameters:'//REPEAT(' ', maxlen - 28)
     254           57 :             first = first + maxlen
     255              :          END IF
     256          411 :          DO i = 1, n_params
     257          335 :             descr_string = xc_f03_func_info_get_ext_params_description(xc_info, i - 1)
     258          335 :             last = first + LEN_TRIM(descr_string) - 1 + 3
     259          335 :             reference(first:last) = ' * '//TRIM(descr_string)
     260          335 :             first = last + 1
     261          335 :             empty = last + (maxlen - 1) - MOD(last - 1, maxlen)
     262              :             ! fill up line with 'spaces'
     263              : 
     264          411 :             IF (empty /= last) THEN
     265          335 :                reference(first:empty) = ' '
     266          335 :                first = empty + 1
     267              :             END IF
     268              :          END DO
     269           76 :          idx = idx + 1
     270           76 :          i_ref_old = i_ref
     271              :       END DO
     272          116 :       SELECT CASE (polarized)
     273              :       CASE (XC_UNPOLARIZED)
     274           40 :          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           76 :          CPABORT("Unsupported value for variable 'polarized'.")
     279              :       END SELECT
     280           76 :       last = first + LEN_TRIM(tmp_string) - 1
     281           76 :       reference(first:last) = TRIM(tmp_string)
     282           76 :       first = last + 1
     283              :       ! fill with 'spaces'
     284           76 :       reference(first:LEN(reference)) = ' '
     285              : 
     286           76 :       IF (last > LEN(reference)) &
     287            0 :          CPABORT("Faulty reference length.")
     288              : 
     289           76 :       CALL timestop(handle)
     290              : 
     291           76 :    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         1867 :    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         1867 :       CALL timeset(routineN, handle)
     334              : 
     335         1867 :       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         1867 :          func_id = xc_f03_functional_get_number(func_string(1:LEN_TRIM(func_string)))
     339              :       END IF
     340              : 
     341         1867 :       exists = .TRUE.
     342         1867 :       IF (func_id == -1) exists = .FALSE.
     343              : 
     344         1867 :       CALL timestop(handle)
     345              : 
     346         1867 :    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        25956 :    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        25956 :       CALL timeset(routineN, handle)
     368              : 
     369        25956 :       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        25956 :          func_id = xc_f03_functional_get_number(func_string(1:LEN_TRIM(func_string)))
     373              :       END IF
     374        25956 :       IF (func_id == -1) THEN
     375            0 :          CPABORT(TRIM(func_string)//": wrong functional name")
     376              :       END IF
     377              : 
     378        25956 :       CALL timestop(handle)
     379              : 
     380        25956 :    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        18146 :    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        18146 :       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        36292 : !$OMP CRITICAL(libxc_init)
     430        18146 :       CALL xc_f03_func_init(xc_func, func_id, XC_UNPOLARIZED)
     431        18146 :       xc_info = xc_f03_func_get_info(xc_func)
     432              : !$OMP END CRITICAL(libxc_init)
     433        18146 : !$OMP BARRIER
     434        18146 :       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        16344 :          xc_libxc_wrap_needs_laplace = .FALSE.
     438              :       END IF
     439              : 
     440        18146 :       CALL xc_f03_func_end(xc_func)
     441              : 
     442        18146 :       CALL timestop(handle)
     443              : 
     444        18146 :    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        14644 :    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        14644 :       REAL(KIND=dp), DIMENSION(:), ALLOCATABLE           :: params
     465              :       CHARACTER(LEN=128)                                 :: param_name
     466              : 
     467        14644 :       CALL timeset(routineN, handle)
     468              : 
     469        14644 :       n_params = xc_f03_func_info_get_n_ext_params(xc_info)
     470        14644 :       IF (n_params > 0) THEN
     471        28794 :          ALLOCATE (params(n_params))
     472        59152 :          DO i = 1, n_params
     473        49554 :             param_name = xc_f03_func_info_get_ext_params_name(xc_info, i - 1)
     474              : 
     475        59152 :             CALL section_vals_val_get(libxc_params, TRIM(param_name), r_val=params(i))
     476              :          END DO
     477              : 
     478         9598 :          CALL xc_f03_func_set_ext_params(xc_func, params)
     479              :       END IF
     480              : 
     481        14644 :       IF (IAND(xc_f03_func_info_get_flags(xc_info), XC_FLAGS_HAVE_EXC) == XC_FLAGS_HAVE_EXC) THEN
     482        14644 :          no_exc = .FALSE.
     483              :       ELSE
     484            0 :          no_exc = .TRUE.
     485              :       END IF
     486              : 
     487        14644 :       CALL timestop(handle)
     488              : 
     489        14644 :    END SUBROUTINE xc_libxc_wrap_functional_set_params
     490              : 
     491              : #endif
     492              : #endif
     493              : END MODULE xc_libxc_wrap
        

Generated by: LCOV version 2.0-1