LCOV - code coverage report
Current view: top level - src - input_cp2k_function.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:9ccafda) Lines: 82.2 % 129 106
Test Date: 2026-10-15 00:55:44 Functions: 100.0 % 2 2

            Line data    Source code
       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2026 CP2K developers group <https://cp2k.org>                                   !
       4              : !                                                                                                  !
       5              : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6              : !--------------------------------------------------------------------------------------------------!
       7              : 
       8              : ! **************************************************************************************************
       9              : !> \brief Creates and parses an input section to define a generic function
      10              : !> \note
      11              : !>      This module handles the input definition and retrieval, while the task of actually parsing
      12              : !>      and evaluating a function is handled by common/fparser module. The general workflow is:
      13              : !>      1. In the module that creates input sections, use the subroutine to add the subsection
      14              : !>         &GENERIC_FUNCTION with keywords FUNCTION, PARAMETERS, UNITS, VALUES and (optionally)
      15              : !>         VARIABLES. If a list of symbols has been specified (like input_variables=["X", "Y", "Z"])
      16              : !>         then they will be reserved as the variables and the VARIABLES keyword will not appear.
      17              : !>         If no such list is given then the VARIABLES keyword requesting input of symbol(s) for
      18              : !>         the variable(s) will appear, with no restriction on the number of symbols.
      19              : !>            NULLIFY(subsection)
      20              : !>            CALL create_function_section(subsection, "GENERIC_FUNCTION", "FUNCTION", &
      21              : !>                                         "This subsection defines a generic function.")
      22              : !>            ! Add extra keywords here if needed
      23              : !>            ! NULLIFY (keyword)
      24              : !>            ! CALL keyword_create(keyword, __LOCATION__, ...)
      25              : !>            ! CALL section_add_keyword(print_key, keyword)
      26              : !>            ! CALL keyword_release(keyword)
      27              : !>            ! ...
      28              : !>            ! Done adding extra keywords
      29              : !>            CALL section_add_subsection(section, subsection)
      30              : !>            CALL section_release(subsection)
      31              : !>      2. Define a type that stores information about the function.
      32              : !>            TYPE my_func_type
      33              : !>               CHARACTER(LEN=default_path_length) :: function = ""
      34              : !>               CHARACTER(LEN=default_string_length), DIMENSION(:), POINTER :: parameters => NULL()
      35              : !>               REAL(KIND=dp), DIMENSION(:), POINTER :: values => NULL()
      36              : !>            END TYPE my_func_type
      37              : !>      3. In the module that parses input, use the subroutine to get and save the definitions. The
      38              : !>         usage of input_variables should be consistent with above. Note that the variables and the
      39              : !>         parameters are all saved in my_func%parameters and my_func%values; with n_var variables
      40              : !>         and n_par parameters, both my_func%parameters and my_func%values will have a dimension of
      41              : !>         (n_var + n_par), variables first.
      42              : !>            TYPE(my_func_type), POINTER :: my_func
      43              : !>            NULLIFY (my_func)
      44              : !>            CALL parse_function_section(gen_section, "FUNCTION", my_func%function, &
      45              : !>                                        my_func%parameters, my_func%values)
      46              : !>      4. Use the subroutines from the fparser module to evaluate the function.
      47              : !>            CALL initf(1)
      48              : !>            CALL parsef(1, TRIM(my_func%function), my_func%parameters)
      49              : !>            ! Substitute new values for the variables if needed
      50              : !>            ! my_func%values(1) = ...
      51              : !>            ! Done substituting
      52              : !>            result = evalf(1, my_func%values)
      53              : !>            CPASSERT(EvalErrType <= 0)
      54              : !>            CALL finalizef()
      55              : !> \par History
      56              : !>      10.2026 created
      57              : !> \author Zilong He
      58              : ! **************************************************************************************************
      59              : MODULE input_cp2k_function
      60              :    USE cp_units,                        ONLY: cp_unit_to_cp2k
      61              :    USE fparser,                         ONLY: docf
      62              :    USE input_keyword_types,             ONLY: keyword_create,&
      63              :                                               keyword_release,&
      64              :                                               keyword_type
      65              :    USE input_section_types,             ONLY: section_add_keyword,&
      66              :                                               section_create,&
      67              :                                               section_type,&
      68              :                                               section_vals_type,&
      69              :                                               section_vals_val_get
      70              :    USE input_val_types,                 ONLY: char_t,&
      71              :                                               lchar_t,&
      72              :                                               real_t
      73              :    USE kinds,                           ONLY: default_path_length,&
      74              :                                               default_string_length,&
      75              :                                               dp
      76              :    USE memory_utilities,                ONLY: reallocate
      77              :    USE string_utilities,                ONLY: compress,&
      78              :                                               integer_to_string,&
      79              :                                               newline
      80              : #include "./base/base_uses.f90"
      81              : 
      82              :    IMPLICIT NONE
      83              :    PRIVATE
      84              : 
      85              :    LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
      86              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_cp2k_function'
      87              : 
      88              :    CHARACTER(len=*), PARAMETER, PRIVATE :: name_kw_parameters = "PARAMETERS", &
      89              :                                            name_kw_units = "UNITS", &
      90              :                                            name_kw_values = "VALUES", &
      91              :                                            name_kw_variables = "VARIABLES"
      92              : 
      93              :    PUBLIC :: create_function_section, parse_function_section
      94              : 
      95              : CONTAINS
      96              : 
      97              : ! **************************************************************************************************
      98              : !> \brief Create the input section for a generic function
      99              : !> \param gen_section the section to be created for the generic function
     100              : !> \param section_name the name of the subsection for the generic function
     101              : !> \param func_name the name of the keyword for the function
     102              : !> \param description a custom description for the subsection
     103              : !> \param repeats whether the section can be repeated
     104              : !> \param input_variables a list of symbols that will be parsed as variables
     105              : !> \par History
     106              : !>      10.2026 created from scratch matching argument names with parse_function_section
     107              : ! **************************************************************************************************
     108        21896 :    SUBROUTINE create_function_section(gen_section, section_name, func_name, description, &
     109        21896 :                                       repeats, input_variables)
     110              :       TYPE(section_type), POINTER                        :: gen_section
     111              :       CHARACTER(LEN=*), INTENT(IN)                       :: section_name, func_name, description
     112              :       LOGICAL, INTENT(IN), OPTIONAL                      :: repeats
     113              :       CHARACTER(LEN=*), DIMENSION(:), OPTIONAL           :: input_variables
     114              : 
     115              :       CHARACTER(LEN=*), PARAMETER :: default_values_unit_str = "internal_cp2k"
     116              : 
     117        21896 :       CHARACTER(LEN=:), ALLOCATABLE                      :: input_variables_info, my_description
     118              :       CHARACTER(LEN=default_string_length)               :: my_size_default, my_size_var
     119              :       INTEGER                                            :: i, mydim
     120              :       LOGICAL                                            :: has_kw_variables, my_repeats
     121              :       TYPE(keyword_type), POINTER                        :: keyword
     122              : 
     123        21896 :       my_repeats = .FALSE.
     124        21896 :       IF (PRESENT(repeats)) my_repeats = repeats
     125        21896 :       has_kw_variables = .FALSE.
     126        21896 :       my_description = TRIM(description)
     127              :       mydim = 0
     128        21896 :       CALL integer_to_string(default_string_length, my_size_default)
     129              : 
     130        21896 :       IF (PRESENT(input_variables)) THEN
     131        21896 :          has_kw_variables = .TRUE.
     132        21896 :          mydim = SIZE(input_variables)
     133        21896 :          CALL integer_to_string(mydim, my_size_var)
     134              :          input_variables_info = "The following "//TRIM(my_size_var)//" symbol(s) will be reserved "// &
     135        21896 :                                 "as the variable(s) to be substituted for internal evaluation: "
     136        65688 :          DO i = 1, SIZE(input_variables)
     137        43792 :             input_variables_info = input_variables_info//"`"//TRIM(input_variables(i))//"`"
     138        65688 :             IF (i < SIZE(input_variables)) THEN
     139        21896 :                input_variables_info = input_variables_info//", "
     140              :             ELSE
     141        21896 :                input_variables_info = input_variables_info//". "
     142              :             END IF
     143              :          END DO
     144        21896 :          input_variables_info = input_variables_info//"They cannot be used as parameters."
     145        21896 :          my_description = my_description//newline//newline//input_variables_info
     146              :       END IF
     147              : 
     148        21896 :       NULLIFY (keyword)
     149        21896 :       CPASSERT(.NOT. ASSOCIATED(gen_section))
     150              : 
     151              :       CALL section_create(gen_section, __LOCATION__, name=TRIM(section_name), &
     152              :                           description=my_description, &
     153        21896 :                           n_keywords=0, n_subsections=0, repeats=my_repeats)
     154              : 
     155              :       CALL keyword_create(keyword, __LOCATION__, name=TRIM(func_name), &
     156              :                           description=docf(), &
     157              :                           usage=TRIM(func_name)//" A*X+B*(2/(1+EXP(-0.001*Y))-1)", &
     158        21896 :                           type_of_var=lchar_t, n_var=1)
     159        21896 :       CALL section_add_keyword(gen_section, keyword)
     160        21896 :       CALL keyword_release(keyword)
     161              : 
     162              :       CALL keyword_create(keyword, __LOCATION__, name=name_kw_parameters, &
     163              :                           description="Defines the symbols for the parameter(s) in the functional "// &
     164              :                           "form, delimited by whitespaces. Symbols are case sensitive and each is "// &
     165              :                           "at most "//TRIM(my_size_default)//" characters long.", &
     166              :                           usage=name_kw_parameters//" A B", type_of_var=char_t, &
     167        21896 :                           n_var=-1, repeats=.TRUE.)
     168        21896 :       CALL section_add_keyword(gen_section, keyword)
     169        21896 :       CALL keyword_release(keyword)
     170              : 
     171              :       CALL keyword_create(keyword, __LOCATION__, name=name_kw_units, &
     172              :                           description="Optionally, defines CP2K unit string for each of the given "// &
     173              :                           "parameter value(s). A valid CP2K unit string is one of the strings that "// &
     174              :                           "is listed under the References/Units section of the CP2K manual, or a "// &
     175              :                           "combination of multiple of these strings with `*`, `/` and `^`. It is "// &
     176              :                           "assumed that the corresponding parameter value is specified in this unit "// &
     177              :                           "which needs to be converted first to the internal unit during input parsing. "// &
     178              :                           "Note that the meaningfulness of the unit is not checked. If omitted, all "// &
     179              :                           "values will be treated as already in the internal unit and used literally.", &
     180              :                           usage=name_kw_units//" eV*angstrom^-1 angstrom", type_of_var=char_t, &
     181        21896 :                           n_var=-1, repeats=.TRUE.)
     182        21896 :       CALL section_add_keyword(gen_section, keyword)
     183        21896 :       CALL keyword_release(keyword)
     184              : 
     185              :       CALL keyword_create(keyword, __LOCATION__, name=name_kw_values, &
     186              :                           description="Defines the value(s) of the parameter in the functional form.", &
     187              :                           usage=name_kw_values//" 50 1.0E+2", type_of_var=real_t, &
     188        21896 :                           n_var=-1, repeats=.TRUE., unit_str=default_values_unit_str)
     189        21896 :       CALL section_add_keyword(gen_section, keyword)
     190        21896 :       CALL keyword_release(keyword)
     191              : 
     192        21896 :       IF (.NOT. has_kw_variables) THEN
     193              :          CALL keyword_create(keyword, __LOCATION__, name=name_kw_variables, &
     194              :                              description="Defines the symbols for the variable(s) in the functional "// &
     195              :                              "form, delimited by whitespaces. Symbols are case sensitive and each is "// &
     196              :                              "at most "//TRIM(my_size_default)//" characters long.", &
     197              :                              usage=name_kw_variables//" X Y", type_of_var=char_t, &
     198            0 :                              n_var=-1)
     199            0 :          CALL section_add_keyword(gen_section, keyword)
     200            0 :          CALL keyword_release(keyword)
     201              :       END IF
     202              : 
     203        21896 :    END SUBROUTINE create_function_section
     204              : 
     205              : ! **************************************************************************************************
     206              : !> \brief Reads from the input structure all information for generic functions
     207              : !> \param gen_section ...
     208              : !> \param func_name ...
     209              : !> \param xfunction ...
     210              : !> \param parameters ...
     211              : !> \param values ...
     212              : !> \param var_values ...
     213              : !> \param i_rep_sec ...
     214              : !> \param input_variables ...
     215              : !> \par History
     216              : !>      10.2026 created by migrating the get_generic_info in force_fields_util.F to here
     217              : ! **************************************************************************************************
     218            4 :    SUBROUTINE parse_function_section(gen_section, func_name, xfunction, parameters, values, &
     219            4 :                                      var_values, i_rep_sec, input_variables)
     220              :       TYPE(section_vals_type), POINTER                   :: gen_section
     221              :       CHARACTER(LEN=*), INTENT(IN)                       :: func_name
     222              :       CHARACTER(LEN=default_path_length), INTENT(OUT)    :: xfunction
     223              :       CHARACTER(LEN=default_string_length), &
     224              :          DIMENSION(:), POINTER                           :: parameters
     225              :       REAL(KIND=dp), DIMENSION(:), POINTER               :: values
     226              :       REAL(KIND=dp), DIMENSION(:), OPTIONAL, POINTER     :: var_values
     227              :       INTEGER, INTENT(IN), OPTIONAL                      :: i_rep_sec
     228              :       CHARACTER(LEN=*), DIMENSION(:), OPTIONAL           :: input_variables
     229              : 
     230              :       CHARACTER(LEN=default_string_length), &
     231            4 :          DIMENSION(:), POINTER                           :: my_par, my_par_tmp, my_units, &
     232            4 :                                                             my_units_tmp, my_var
     233              :       INTEGER                                            :: i, ind, irep, isize, j, mydim, n_par, &
     234              :                                                             n_units, n_val, nblank
     235              :       LOGICAL                                            :: check
     236            4 :       REAL(KIND=dp), DIMENSION(:), POINTER               :: my_val, my_val_tmp
     237              : 
     238            4 :       NULLIFY (my_var, my_par, my_val, my_par_tmp, my_val_tmp)
     239            4 :       NULLIFY (my_units)
     240            4 :       NULLIFY (my_units_tmp)
     241            4 :       IF (ASSOCIATED(parameters)) THEN
     242            0 :          DEALLOCATE (parameters)
     243              :       END IF
     244            4 :       IF (ASSOCIATED(values)) THEN
     245            0 :          DEALLOCATE (values)
     246              :       END IF
     247            4 :       irep = 1
     248            4 :       IF (PRESENT(i_rep_sec)) irep = i_rep_sec
     249            4 :       mydim = 0
     250            4 :       CALL section_vals_val_get(gen_section, TRIM(func_name), i_rep_section=irep, c_val=xfunction)
     251            4 :       CALL compress(xfunction, full=.TRUE.)
     252            4 :       IF (PRESENT(input_variables)) THEN
     253           12 :          ALLOCATE (my_var(SIZE(input_variables)))
     254           12 :          my_var = input_variables
     255              :       ELSE
     256            0 :          CALL section_vals_val_get(gen_section, name_kw_variables, i_rep_section=irep, c_vals=my_var)
     257              :       END IF
     258            4 :       IF (ASSOCIATED(my_var)) THEN
     259            4 :          mydim = SIZE(my_var)
     260              :       END IF
     261              :       ! Check for presence of Parameters
     262            4 :       CALL section_vals_val_get(gen_section, name_kw_parameters, i_rep_section=irep, n_rep_val=n_par)
     263            4 :       CALL section_vals_val_get(gen_section, name_kw_values, i_rep_section=irep, n_rep_val=n_val)
     264            4 :       check = (n_par > 0) .EQV. (n_val > 0)
     265            4 :       CPASSERT(check)
     266            4 :       CALL section_vals_val_get(gen_section, name_kw_units, i_rep_section=irep, n_rep_val=n_units)
     267            4 :       IF (n_par > 0) THEN
     268              :          ! Parameters
     269            4 :          ALLOCATE (my_par(0))
     270            4 :          ALLOCATE (my_val(0))
     271            8 :          DO i = 1, n_par
     272            4 :             isize = SIZE(my_par)
     273            4 :             CALL section_vals_val_get(gen_section, name_kw_parameters, i_rep_section=irep, i_rep_val=i, c_vals=my_par_tmp)
     274           10 :             nblank = COUNT(my_par_tmp == "")
     275            4 :             CALL reallocate(my_par, 1, isize + SIZE(my_par_tmp) - nblank)
     276            4 :             ind = 0
     277           14 :             DO j = 1, SIZE(my_par_tmp)
     278            6 :                IF (my_par_tmp(j) == "") CYCLE
     279            6 :                ind = ind + 1
     280           10 :                my_par(isize + ind) = my_par_tmp(j)
     281              :             END DO
     282              :          END DO
     283            8 :          DO i = 1, n_val
     284            4 :             isize = SIZE(my_val)
     285            4 :             CALL section_vals_val_get(gen_section, name_kw_values, i_rep_section=irep, i_rep_val=i, r_vals=my_val_tmp)
     286            4 :             CALL reallocate(my_val, 1, isize + SIZE(my_val_tmp))
     287           20 :             my_val(isize + 1:isize + SIZE(my_val_tmp)) = my_val_tmp
     288              :          END DO
     289            4 :          CPASSERT(SIZE(my_par) == SIZE(my_val))
     290              :          ! Optionally read the units for each parameter value
     291            4 :          ALLOCATE (my_units(0))
     292            4 :          IF (n_units > 0) THEN
     293            0 :             DO i = 1, n_units
     294            0 :                isize = SIZE(my_units)
     295            0 :                CALL section_vals_val_get(gen_section, name_kw_units, i_rep_section=irep, i_rep_val=i, c_vals=my_units_tmp)
     296            0 :                nblank = COUNT(my_units_tmp == "")
     297            0 :                CALL reallocate(my_units, 1, isize + SIZE(my_units_tmp) - nblank)
     298            0 :                ind = 0
     299            0 :                DO j = 1, SIZE(my_units_tmp)
     300            0 :                   IF (my_units_tmp(j) == "") CYCLE
     301            0 :                   ind = ind + 1
     302            0 :                   my_units(isize + ind) = my_units_tmp(j)
     303              :                END DO
     304              :             END DO
     305            0 :             CPASSERT(SIZE(my_units) == SIZE(my_val))
     306              :          END IF
     307            4 :          mydim = mydim + SIZE(my_val)
     308            4 :          IF (SIZE(my_val) == 0) THEN
     309            0 :             DEALLOCATE (my_par)
     310            0 :             DEALLOCATE (my_val)
     311            0 :             DEALLOCATE (my_units)
     312              :          END IF
     313              :       END IF
     314              :       ! Handle trivial case of a null function defined
     315           12 :       ALLOCATE (parameters(mydim))
     316           12 :       ALLOCATE (values(mydim))
     317            4 :       IF (mydim > 0) THEN
     318           20 :          parameters(1:SIZE(my_var)) = my_var
     319           12 :          values(1:SIZE(my_var)) = 0.0_dp
     320            4 :          IF (PRESENT(var_values)) THEN
     321            0 :             CPASSERT(SIZE(var_values) == SIZE(my_var))
     322            0 :             values(1:SIZE(my_var)) = var_values
     323              :          END IF
     324            4 :          IF (ASSOCIATED(my_val)) THEN
     325           10 :             DO i = 1, SIZE(my_val)
     326            6 :                parameters(SIZE(my_var) + i) = my_par(i)
     327           10 :                IF (n_units > 0) THEN
     328            0 :                   values(SIZE(my_var) + i) = cp_unit_to_cp2k(my_val(i), TRIM(ADJUSTL(my_units(i))))
     329              :                ELSE
     330            6 :                   values(SIZE(my_var) + i) = my_val(i)
     331              :                END IF
     332              :             END DO
     333              :          END IF
     334              :       END IF
     335            4 :       IF (ASSOCIATED(my_par)) THEN
     336            4 :          DEALLOCATE (my_par)
     337              :       END IF
     338            4 :       IF (ASSOCIATED(my_val)) THEN
     339            4 :          DEALLOCATE (my_val)
     340              :       END IF
     341            4 :       IF (ASSOCIATED(my_units)) THEN
     342            4 :          DEALLOCATE (my_units)
     343              :       END IF
     344            4 :       IF (PRESENT(input_variables)) THEN
     345            4 :          DEALLOCATE (my_var)
     346              :       END IF
     347           12 :    END SUBROUTINE parse_function_section
     348              : 
     349       131376 : END MODULE input_cp2k_function
        

Generated by: LCOV version 2.0-1