(git:374b731)
Loading...
Searching...
No Matches
input_cp2k_force_eval.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief builds the input structure for the FORCE_EVAL section of cp2k
10!> \par History
11!> 06.2004 created [fawzi]
12!> \author fawzi
13! **************************************************************************************************
21 USE cp_units, ONLY: cp_unit_to_cp2k
22 USE input_constants, ONLY: &
45 USE input_val_types, ONLY: char_t,&
46 integer_t,&
47 lchar_t,&
48 real_t
49 USE kinds, ONLY: dp
50 USE string_utilities, ONLY: s2a
51#include "./base/base_uses.f90"
52
53 IMPLICIT NONE
54 PRIVATE
55
56 LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .true.
57 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_cp2k_force_eval'
58
60
61CONTAINS
62
63! **************************************************************************************************
64!> \brief creates the force_eval section
65!> \param section the section to be created
66!> \author fawzi
67! **************************************************************************************************
68 SUBROUTINE create_force_eval_section(section)
69 TYPE(section_type), POINTER :: section
70
71 TYPE(keyword_type), POINTER :: keyword
72 TYPE(section_type), POINTER :: subsection
73
74 cpassert(.NOT. ASSOCIATED(section))
75 CALL section_create(section, __location__, name="force_eval", &
76 description="parameters needed to calculate energy and forces and"// &
77 " describe the system you want to analyze.", &
78 n_keywords=1, n_subsections=10, repeats=.true.)
79
80 NULLIFY (subsection)
81 NULLIFY (keyword)
82 CALL keyword_create(keyword, __location__, name="METHOD", &
83 description="Which method should be used to compute forces", &
84 usage="METHOD <STRING>", &
85 enum_c_vals=s2a("QS", &
86 "SIRIUS", &
87 "FIST", &
88 "QMMM", &
89 "EIP", &
90 "QUICKSTEP", &
91 "NNP", &
92 "MIXED", &
93 "EMBED"), &
94 enum_desc=s2a("Alias for QUICKSTEP", &
95 "PW DFT using the SIRIUS library", &
96 "Molecular Mechanics", &
97 "Hybrid quantum classical", &
98 "Empirical Interatomic Potential", &
99 "Electronic structure methods (DFT, ...)", &
100 "Neural Network Potentials", &
101 "Use a combination of two of the above", &
102 "Perform an embedded calculation"), &
104 default_i_val=do_qs)
105 CALL section_add_keyword(section, keyword)
106 CALL keyword_release(keyword)
107
108 CALL keyword_create(keyword, __location__, name="STRESS_TENSOR", &
109 description="Controls the calculation of the stress tensor. The combinations defined below"// &
110 " are not implemented for all methods.", &
111 usage="stress_tensor (NONE|ANALYTICAL|NUMERICAL|DIAGONAL_ANA|DIAGONAL_NUM)", &
112 default_i_val=do_stress_none, &
113 enum_c_vals=s2a("NONE", "ANALYTICAL", "NUMERICAL", "DIAGONAL_ANALYTICAL", "DIAGONAL_NUMERICAL"), &
116 enum_desc=s2a("Do not compute stress tensor", &
117 "Compute the stress tensor analytically (if available).", &
118 "Compute the stress tensor numerically.", &
119 "Compute the diagonal part only of the stress tensor analytically (if available).", &
120 "Compute the diagonal part only of the stress tensor numerically"))
121
122 CALL section_add_keyword(section, keyword)
123 CALL keyword_release(keyword)
124
125 CALL create_ext_pot_section(subsection)
126 CALL section_add_subsection(section, subsection)
127 CALL section_release(subsection)
128
129 CALL create_rescale_force_section(subsection)
130 CALL section_add_subsection(section, subsection)
131 CALL section_release(subsection)
132
133 CALL create_mix_section(subsection)
134 CALL section_add_subsection(section, subsection)
135 CALL section_release(subsection)
136
137 CALL create_embed_section(subsection)
138 CALL section_add_subsection(section, subsection)
139 CALL section_release(subsection)
140
141 CALL create_dft_section(subsection)
142 CALL section_add_subsection(section, subsection)
143 CALL section_release(subsection)
144
145 CALL create_pwdft_section(subsection)
146 CALL section_add_subsection(section, subsection)
147 CALL section_release(subsection)
148
149 CALL create_mm_section(subsection)
150 CALL section_add_subsection(section, subsection)
151 CALL section_release(subsection)
152
153 CALL create_nnp_section(subsection)
154 CALL section_add_subsection(section, subsection)
155 CALL section_release(subsection)
156
157 CALL create_qmmm_section(subsection)
158 CALL section_add_subsection(section, subsection)
159 CALL section_release(subsection)
160
161 CALL create_eip_section(subsection)
162 CALL section_add_subsection(section, subsection)
163 CALL section_release(subsection)
164
165 CALL create_bsse_section(subsection)
166 CALL section_add_subsection(section, subsection)
167 CALL section_release(subsection)
168
169 CALL create_subsys_section(subsection)
170 CALL section_add_subsection(section, subsection)
171 CALL section_release(subsection)
172
173 CALL create_properties_section(subsection)
174 CALL section_add_subsection(section, subsection)
175 CALL section_release(subsection)
176
177 CALL create_f_env_print_section(subsection)
178 CALL section_add_subsection(section, subsection)
179 CALL section_release(subsection)
180
181 END SUBROUTINE create_force_eval_section
182
183! **************************************************************************************************
184!> \brief Creates the section for applying an external potential
185!> \param section ...
186!> \date 03.2008
187!> \author teo
188! **************************************************************************************************
189 SUBROUTINE create_ext_pot_section(section)
190 TYPE(section_type), POINTER :: section
191
192 TYPE(keyword_type), POINTER :: keyword
193
194 cpassert(.NOT. ASSOCIATED(section))
195 CALL section_create(section, __location__, name="EXTERNAL_POTENTIAL", &
196 description="Section controlling the presence of an external potential dependent "// &
197 "on the atomic positions (X,Y,Z)", &
198 n_keywords=7, n_subsections=0, repeats=.true.)
199 NULLIFY (keyword)
200
201 CALL keyword_create(keyword, __location__, name="ATOMS_LIST", &
202 description="Specifies the atoms on which the external potential will act", &
203 usage="ATOMS_LIST {INT} {INT} ..", repeats=.true., &
204 n_var=-1, type_of_var=integer_t)
205 CALL section_add_keyword(section, keyword)
206 CALL keyword_release(keyword)
207
208 CALL keyword_create(keyword, __location__, name="FUNCTION", &
209 description="Specifies the functional form in mathematical notation. Variables must be the atomic "// &
210 "coordinates (X,Y,Z).", usage="FUNCTION X^2+Y^2+Z^2+LOG(ABS(X+Y))", &
211 type_of_var=lchar_t, n_var=1)
212 CALL section_add_keyword(section, keyword)
213 CALL keyword_release(keyword)
214
215 CALL keyword_create(keyword, __location__, name="PARAMETERS", &
216 description="Defines the parameters of the functional form", &
217 usage="PARAMETERS a b D", type_of_var=char_t, &
218 n_var=-1, repeats=.true.)
219 CALL section_add_keyword(section, keyword)
220 CALL keyword_release(keyword)
221
222 CALL keyword_create(keyword, __location__, name="VALUES", &
223 description="Defines the values of parameter of the functional form", &
224 usage="VALUES ", type_of_var=real_t, &
225 n_var=-1, repeats=.true., unit_str="internal_cp2k")
226 CALL section_add_keyword(section, keyword)
227 CALL keyword_release(keyword)
228
229 CALL keyword_create(keyword, __location__, name="UNITS", &
230 description="Optionally, allows to define valid CP2K unit strings for each parameter value. "// &
231 "It is assumed that the corresponding parameter value is specified in this unit.", &
232 usage="UNITS angstrom eV*angstrom^-1 angstrom^1 K", type_of_var=char_t, &
233 n_var=-1, repeats=.true.)
234 CALL section_add_keyword(section, keyword)
235 CALL keyword_release(keyword)
236
237 CALL keyword_create(keyword, __location__, name="DX", &
238 description="Parameter used for computing the derivative with the Ridders' method.", &
239 usage="DX <REAL>", default_r_val=0.1_dp, unit_str="bohr")
240 CALL section_add_keyword(section, keyword)
241 CALL keyword_release(keyword)
242
243 CALL keyword_create(keyword, __location__, name="ERROR_LIMIT", &
244 description="Checks that the error in computing the derivative is not larger than "// &
245 "the value set; in case error is larger a warning message is printed.", &
246 usage="ERROR_LIMIT <REAL>", default_r_val=1.0e-12_dp)
247 CALL section_add_keyword(section, keyword)
248 CALL keyword_release(keyword)
249
250 END SUBROUTINE create_ext_pot_section
251
252! **************************************************************************************************
253!> \brief Creates the section controlling the rescaling of forces
254!> \param section the section to create
255!> \author teo
256! **************************************************************************************************
257 SUBROUTINE create_rescale_force_section(section)
258 TYPE(section_type), POINTER :: section
259
260 TYPE(keyword_type), POINTER :: keyword
261
262 cpassert(.NOT. ASSOCIATED(section))
263 CALL section_create(section, __location__, name="RESCALE_FORCES", &
264 description="Section controlling the rescaling of forces. Useful when"// &
265 " starting from quite bad geometries with unphysically large forces.", &
266 n_keywords=1, n_subsections=0, repeats=.false.)
267 NULLIFY (keyword)
268
269 CALL keyword_create(keyword, __location__, name="MAX_FORCE", &
270 description="Specify the Maximum Values of the force. If the force"// &
271 " of one atom exceed this value it's rescaled to the MAX_FORCE"// &
272 " value.", &
273 default_r_val=cp_unit_to_cp2k(value=50.0_dp, &
274 unit_str="kcalmol*angstrom^-1"), &
275 unit_str="hartree*bohr^-1")
276 CALL section_add_keyword(section, keyword)
277 CALL keyword_release(keyword)
278
279 END SUBROUTINE create_rescale_force_section
280
281! **************************************************************************************************
282!> \brief ...
283!> \param section ...
284!> \author fawzi
285! **************************************************************************************************
286 SUBROUTINE create_f_env_print_section(section)
287 TYPE(section_type), POINTER :: section
288
289 TYPE(keyword_type), POINTER :: keyword
290 TYPE(section_type), POINTER :: print_key
291
292 NULLIFY (keyword)
293 NULLIFY (print_key)
294
295 cpassert(.NOT. ASSOCIATED(section))
296
297 CALL section_create(section, __location__, name="PRINT", &
298 description="Properties that you want to output and that are common to all methods", &
299 n_keywords=0, n_subsections=5, repeats=.false.)
300
301 CALL cp_print_key_section_create(print_key, __location__, "PROGRAM_RUN_INFO", &
302 description="Controls the printing of basic information generated by force_eval", &
303 print_level=low_print_level, add_last=add_last_numeric, filename="__STD_OUT__")
304 CALL section_add_subsection(section, print_key)
305 CALL section_release(print_key)
306
307 CALL cp_print_key_section_create(print_key, __location__, "FORCES", &
308 description="Controls the printing of the forces after each force evaluation", &
309 print_level=high_print_level, filename="__STD_OUT__")
310 CALL keyword_create(keyword, __location__, &
311 name="NDIGITS", &
312 description="Specifies the number of digits used "// &
313 "for the printing of the forces", &
314 usage="NDIGITS 6", &
315 default_i_val=8, &
316 repeats=.false.)
317 CALL section_add_keyword(print_key, keyword)
318 CALL keyword_release(keyword)
319 CALL section_add_subsection(section, print_key)
320 CALL section_release(print_key)
321
323 print_key, __location__, "GRID_INFORMATION", &
324 description="Controls the printing of information regarding the PW and RS grid structures.", &
325 print_level=medium_print_level, filename="__STD_OUT__")
326 CALL section_add_subsection(section, print_key)
327 CALL section_release(print_key)
328
329 CALL cp_print_key_section_create(print_key, __location__, "TOTAL_NUMBERS", &
330 description="Controls the printing of the total number of atoms, kinds,...", &
331 print_level=low_print_level, filename="__STD_OUT__")
332 CALL section_add_subsection(section, print_key)
333 CALL section_release(print_key)
334
335 CALL cp_print_key_section_create(print_key, __location__, "DISTRIBUTION", &
336 description="Controls the printing of the distribution of molecules, atoms, ...", &
337 print_level=high_print_level, filename="__STD_OUT__")
338 CALL section_add_subsection(section, print_key)
339 CALL section_release(print_key)
340
341 CALL cp_print_key_section_create(print_key, __location__, "DISTRIBUTION2D", &
342 description="Controls the printing of the distribution of matrix blocks, ...", &
343 print_level=high_print_level, filename="__STD_OUT__")
344 CALL section_add_subsection(section, print_key)
345 CALL section_release(print_key)
346
347 CALL cp_print_key_section_create(print_key, __location__, "DISTRIBUTION1D", &
348 description="Each node prints out its distribution info ...", &
349 print_level=high_print_level, filename="__STD_OUT__")
350 CALL section_add_subsection(section, print_key)
351 CALL section_release(print_key)
352
353 CALL cp_print_key_section_create(print_key, __location__, "STRESS_TENSOR", &
354 description="Controls the printing of the stress tensor", &
355 print_level=high_print_level, filename="__STD_OUT__")
356 CALL keyword_create(keyword, __location__, &
357 name="COMPONENTS", &
358 description="Print all GPW/GAPW components contributing to the stress tensor", &
359 usage="COMPONENTS", &
360 default_l_val=.false., &
361 lone_keyword_l_val=.true.)
362 CALL section_add_keyword(print_key, keyword)
363 CALL keyword_release(keyword)
364 CALL section_add_subsection(section, print_key)
365 CALL section_release(print_key)
366
367 CALL cp_print_key_section_create(print_key, __location__, "GRRM", &
368 description="Controls the printing of the GRRM interface file", &
369 print_level=debug_print_level + 1, filename="CP2K_GRRM")
370 CALL section_add_subsection(section, print_key)
371 CALL section_release(print_key)
372
373 CALL cp_print_key_section_create(print_key, __location__, "SCINE", &
374 description="Controls the printing of the SCINE interface file", &
375 print_level=debug_print_level + 1, filename="")
376 CALL section_add_subsection(section, print_key)
377 CALL section_release(print_key)
378
379 END SUBROUTINE create_f_env_print_section
380
381END MODULE input_cp2k_force_eval
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
integer, parameter, public debug_print_level
integer, parameter, public low_print_level
integer, parameter, public medium_print_level
integer, parameter, public high_print_level
integer, parameter, public add_last_numeric
subroutine, public cp_print_key_section_create(print_key_section, location, name, description, print_level, each_iter_names, each_iter_values, add_last, filename, common_iter_levels, citations, unit_str)
creates a print_key section
unit conversion facility
Definition cp_units.F:30
real(kind=dp) function, public cp_unit_to_cp2k(value, unit_str, defaults, power)
converts to the internal cp2k units to the given unit
Definition cp_units.F:1150
collects all constants needed in input so that they can be used without circular dependencies
integer, parameter, public do_stress_analytical
integer, parameter, public do_nnp
integer, parameter, public do_stress_diagonal_anal
integer, parameter, public do_eip
integer, parameter, public do_fist
integer, parameter, public do_qmmm
integer, parameter, public do_embed
integer, parameter, public do_sirius
integer, parameter, public do_stress_diagonal_numer
integer, parameter, public do_stress_none
integer, parameter, public do_qs
integer, parameter, public do_mixed
integer, parameter, public do_stress_numerical
integer, parameter, public numerical
function that build the dft section of the input
subroutine, public create_bsse_section(section)
Create the BSSE section for counterpoise correction.
subroutine, public create_dft_section(section)
creates the dft section
Creates the EIP section of the input.
subroutine, public create_eip_section(section)
Create the input section for EIP.
builds the input structure for the EMBED environment: clone of MIXED environment
subroutine, public create_embed_section(section)
Create the input section for EMBED: clone of the subroutines for MIXED.
builds the input structure for the FORCE_EVAL section of cp2k
subroutine, public create_force_eval_section(section)
creates the force_eval section
builds the input structure for the MIXED environment
subroutine, public create_mix_section(section)
Create the input section for MIXED.
creates the mm section of the input
subroutine, public create_mm_section(section)
Create the input section for FIST.. Come on.. Let's get woohooo.
Creates the NNP section of the input.
subroutine, public create_nnp_section(section)
Create the input section for NNP.
function that build the dft section of the input
subroutine, public create_properties_section(section)
Create the PROPERTIES section.
subroutine, public create_pwdft_section(section)
...
creates the qmmm section of the input
subroutine, public create_qmmm_section(section)
Creates the QM/MM section.
builds the subsystem section of the input
subroutine, public create_subsys_section(section)
creates the structure of a subsys, i.e. a full set of atoms+mol+bounds+cell
represents keywords in an input
subroutine, public keyword_release(keyword)
releases the given keyword (see doc/ReferenceCounting.html)
subroutine, public keyword_create(keyword, location, name, description, usage, type_of_var, n_var, repeats, variants, default_val, default_l_val, default_r_val, default_lc_val, default_c_val, default_i_val, default_l_vals, default_r_vals, default_c_vals, default_i_vals, lone_keyword_val, lone_keyword_l_val, lone_keyword_r_val, lone_keyword_c_val, lone_keyword_i_val, lone_keyword_l_vals, lone_keyword_r_vals, lone_keyword_c_vals, lone_keyword_i_vals, enum_c_vals, enum_i_vals, enum, enum_strict, enum_desc, unit_str, citations, deprecation_notice, removed)
creates a keyword object
objects that represent the structure of input sections and the data contained in an input section
subroutine, public section_create(section, location, name, description, n_keywords, n_subsections, repeats, citations)
creates a list of keywords
subroutine, public section_add_keyword(section, keyword)
adds a keyword to the given section
subroutine, public section_add_subsection(section, subsection)
adds a subsection to the given section
recursive subroutine, public section_release(section)
releases the given keyword list (see doc/ReferenceCounting.html)
a wrapper for basic fortran types.
integer, parameter, public real_t
integer, parameter, public lchar_t
integer, parameter, public char_t
integer, parameter, public integer_t
Defines the basic variable types.
Definition kinds.F:23
integer, parameter, public dp
Definition kinds.F:34
Utilities for string manipulations.
represent a keyword in the input
represent a section of the input file