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
|