LCOV - code coverage report
Current view: top level - src/xc - xc_libxc_wrap.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:0de0cc2) Lines: 107 121 88.4 %
Date: 2024-03-28 07:31:50 Functions: 6 8 75.0 %

          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        1807 :    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        1807 :       CALL timeset(routineN, handle)
     334             : 
     335        1807 :       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        1807 :          func_id = xc_f03_functional_get_number(func_string(1:LEN_TRIM(func_string)))
     339             :       END IF
     340             : 
     341        1807 :       exists = .TRUE.
     342        1807 :       IF (func_id == -1) exists = .FALSE.
     343             : 
     344        1807 :       CALL timestop(handle)
     345             : 
     346        1807 :    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       27738 :    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       27738 :       CALL timeset(routineN, handle)
     368             : 
     369       27738 :       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       27738 :          func_id = xc_f03_functional_get_number(func_string(1:LEN_TRIM(func_string)))
     373             :       END IF
     374       27738 :       IF (func_id == -1) THEN
     375           0 :          CPABORT(TRIM(func_string)//": wrong functional name")
     376             :       END IF
     377             : 
     378       27738 :       CALL timestop(handle)
     379             : 
     380       27738 :    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       18454 :    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       18454 :       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       36908 : !$OMP CRITICAL(libxc_init)
     430       18454 :       CALL xc_f03_func_init(xc_func, func_id, XC_UNPOLARIZED)
     431       18454 :       xc_info = xc_f03_func_get_info(xc_func)
     432             : !$OMP END CRITICAL(libxc_init)
     433       18454 : !$OMP BARRIER
     434       18454 :       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       18454 :       CALL xc_f03_func_end(xc_func)
     441             : 
     442       18454 :       CALL timestop(handle)
     443             : 
     444       18454 :    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       15048 :    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       15048 :       REAL(KIND=dp), DIMENSION(:), ALLOCATABLE           :: params
     465             :       CHARACTER(LEN=128)                                 :: param_name
     466             : 
     467       15048 :       CALL timeset(routineN, handle)
     468             : 
     469       15048 :       n_params = xc_f03_func_info_get_n_ext_params(xc_info)
     470       15048 :       IF (n_params > 0) THEN
     471       27222 :          ALLOCATE (params(n_params))
     472       57046 :          DO i = 1, n_params
     473       47972 :             param_name = xc_f03_func_info_get_ext_params_name(xc_info, i - 1)
     474             : 
     475       57046 :             CALL section_vals_val_get(libxc_params, TRIM(param_name), r_val=params(i))
     476             :          END DO
     477             : 
     478        9074 :          CALL xc_f03_func_set_ext_params(xc_func, params)
     479             :       END IF
     480             : 
     481       15048 :       IF (IAND(xc_f03_func_info_get_flags(xc_info), XC_FLAGS_HAVE_EXC) == XC_FLAGS_HAVE_EXC) THEN
     482       15048 :          no_exc = .FALSE.
     483             :       ELSE
     484           0 :          no_exc = .TRUE.
     485             :       END IF
     486             : 
     487       15048 :       CALL timestop(handle)
     488             : 
     489       15048 :    END SUBROUTINE xc_libxc_wrap_functional_set_params
     490             : 
     491             : #endif
     492             : #endif
     493             : END MODULE xc_libxc_wrap

Generated by: LCOV version 1.15