(git:374b731)
Loading...
Searching...
No Matches
input_cp2k_free_energy.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!> \par History
10!> 10.2005 split input_cp2k into smaller modules [fawzi]
11!> \author teo & fawzi
12! **************************************************************************************************
14 USE bibliography, ONLY: barducbus2008,&
20 USE cp_units, ONLY: cp_unit_to_cp2k
21 USE input_constants, ONLY: &
32 USE input_val_types, ONLY: char_t,&
33 integer_t,&
34 lchar_t,&
35 real_t
36 USE kinds, ONLY: dp
37 USE string_utilities, ONLY: s2a
38#include "./base/base_uses.f90"
39
40 IMPLICIT NONE
41 PRIVATE
42
43 LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .true.
44 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_cp2k_free_energy'
45
46 PUBLIC :: create_metavar_section, &
48
49!***
50CONTAINS
51
52! **************************************************************************************************
53!> \brief creates the free energy section
54!> \param section the section to be created
55!> \author teo
56! **************************************************************************************************
57 SUBROUTINE create_fe_section(section)
58 TYPE(section_type), POINTER :: section
59
60 TYPE(keyword_type), POINTER :: keyword
61 TYPE(section_type), POINTER :: print_key, subsection
62
63 NULLIFY (subsection, keyword, print_key)
64 cpassert(.NOT. ASSOCIATED(section))
65 CALL section_create(section, __location__, name="free_energy", &
66 description="Controls the calculation of free energy and free energy derivatives"// &
67 " with different possible methods", &
68 n_keywords=0, n_subsections=1, repeats=.false.)
69
70 CALL keyword_create(keyword, __location__, name="METHOD", &
71 description="Defines the method to use to compute free energy.", &
72 usage="METHOD (METADYN|UI|AC)", &
73 enum_c_vals=s2a("METADYN", "UI", "AC"), &
74 enum_i_vals=(/do_fe_meta, do_fe_ui, do_fe_ac/), &
75 enum_desc=s2a("Metadynamics", &
76 "Umbrella Integration", &
77 "Alchemical Change"), &
78 default_i_val=do_fe_meta, repeats=.false.)
79 CALL section_add_keyword(section, keyword)
80 CALL keyword_release(keyword)
81
82 CALL create_metadyn_section(subsection)
83 CALL section_add_subsection(section, subsection)
84 CALL section_release(subsection)
85
86 CALL create_ui_section(subsection)
87 CALL section_add_subsection(section, subsection)
88 CALL section_release(subsection)
89
90 CALL create_ac_section(subsection)
91 CALL section_add_subsection(section, subsection)
92 CALL section_release(subsection)
93
94 CALL cp_print_key_section_create(print_key, __location__, "free_energy_info", &
95 description="Controls the printing of basic and summary information during the"// &
96 " Free Energy calculation", &
97 print_level=low_print_level, each_iter_names=s2a("MD"), &
98 each_iter_values=(/1/), add_last=add_last_numeric, filename="__STD_OUT__")
99 CALL section_add_subsection(section, print_key)
100 CALL section_release(print_key)
101
102 END SUBROUTINE create_fe_section
103
104! **************************************************************************************************
105!> \brief creates the metadynamics section
106!> \param section the section to be created
107!> \author teo
108! **************************************************************************************************
109 SUBROUTINE create_metadyn_section(section)
110 TYPE(section_type), POINTER :: section
111
112 TYPE(keyword_type), POINTER :: keyword
113 TYPE(section_type), POINTER :: print_key, subsection
114
115 cpassert(.NOT. ASSOCIATED(section))
116 CALL section_create(section, __location__, name="metadyn", &
117 description="This section sets parameters to set up a calculation of metadynamics.", &
118 n_keywords=1, n_subsections=1, repeats=.false., &
119 citations=(/vandencic2006/))
120
121 NULLIFY (subsection, keyword, print_key)
122
123 CALL keyword_create(keyword, __location__, name="USE_PLUMED", &
124 description="Specify whether to use plumed as an external metadynamics driver.", &
125 usage="USE_PLUMED .FALSE./.TRUE.", &
126 default_l_val=.false., lone_keyword_l_val=.true.)
127 CALL section_add_keyword(section, keyword)
128 CALL keyword_release(keyword)
129
130 CALL keyword_create(keyword, __location__, name="PLUMED_INPUT_FILE", &
131 description="Specify the file name of the external plumed input file", &
132 usage="PLUMED_INPUT_FILE ./FILENAME", &
133 default_c_val="./plumed.dat")
134 CALL section_add_keyword(section, keyword)
135 CALL keyword_release(keyword)
136
137 CALL keyword_create(keyword, __location__, name="MIN_NT_HILLS", &
138 description="Specify the minimum MD step interval between spawning "// &
139 "two hills. If specified, it must be >= than NT_HILLS. In case MIN_DISP "// &
140 "is used, if MIN_DISP is satisfied before MIN_NT_HILLS MD steps have been "// &
141 "performed, the MD will continue without any spawning until MIN_NT_HILLS is "// &
142 "reached. The default value has the net effect of skipping this check.", &
143 usage="MIN_NT_HILLS {integer}", default_i_val=1)
144 CALL section_add_keyword(section, keyword)
145 CALL keyword_release(keyword)
146
147 CALL keyword_create(keyword, __location__, name="NT_HILLS", &
148 description="Specify the maximum MD step interval between spawning "// &
149 "two hills. When negative, no new hills are spawned and only "// &
150 "the hills read from SPAWNED_HILLS_* are in effect. The latter "// &
151 "is useful when one wants to add a custom constant bias potential.", &
152 usage="NT_HILLS {integer}", default_i_val=30)
153 CALL section_add_keyword(section, keyword)
154 CALL keyword_release(keyword)
155
156 CALL keyword_create(keyword, __location__, name="TEMPERATURE", &
157 description="If a Lagrangian scheme is used the temperature for the collective "// &
158 "variables is specified. ", usage="TEMPERATURE <REAL>", &
159 default_r_val=0.0_dp, unit_str='K')
160 CALL section_add_keyword(section, keyword)
161 CALL keyword_release(keyword)
162
163 !RG Adaptive hills
164 CALL keyword_create(keyword, __location__, name="MIN_DISP", &
165 description="Minimum displacement between hills before placing a new hill.", &
166 usage="MIN_DISP <REAL>", &
167 default_r_val=-1.0_dp)
168 CALL section_add_keyword(section, keyword)
169 CALL keyword_release(keyword)
170
171 CALL keyword_create(keyword, __location__, name="OLD_HILL_NUMBER", &
172 description="Index of the last hill spawned for this walker.Needed to calculate MIN_DISP", &
173 usage="OLD_HILL_NUMBER <INT>", &
174 default_i_val=0)
175 CALL section_add_keyword(section, keyword)
176 CALL keyword_release(keyword)
177 CALL keyword_create(keyword, __location__, name="OLD_HILL_STEP", &
178 description="Timestep of the last hill spawned for this walker.Needed to calculate MIN_DISP", &
179 usage="OLD_HILL_STEP <INT>", &
180 default_i_val=0)
181 CALL section_add_keyword(section, keyword)
182 CALL keyword_release(keyword)
183 !RG Adaptive hills
184
185 !Hills tail damping
186 CALL keyword_create(keyword, __location__, name="HILL_TAIL_CUTOFF", &
187 description="By setting this variable larger than 0 the tail of the Gaussian hill"// &
188 " is damped to zero faster. The Gaussian function is multiplied by a cutoff function"// &
189 " that becomes active at |x-X0|>HILL_TAIL_CUTOFF*SCALE, where X0 is the location of "// &
190 "the Gaussian and SCALE is the width of the Gaussian. For more than one METAVAR"// &
191 " X0 and SCALE are METAVAR-dependent."// &
192 " (1-(|x-X0|/HILL_TAIL_CUTOFF*SCALE)^P_EXP)/(1-(|x-X0|/HILL_TAIL_CUTOFF*SCALE)^Q_EXP)", &
193 usage="HILL_TAIL_CUTOFF <REAL>", &
194 default_r_val=-1.0_dp)
195 CALL section_add_keyword(section, keyword)
196 CALL keyword_release(keyword)
197 CALL keyword_create(keyword, __location__, name="P_EXPONENT", &
198 description="Exponent at the numerator of the cutoff function to damp the tail of the Gaussian.", &
199 usage="P_EXPONENT <INT>", &
200 default_i_val=8)
201 CALL section_add_keyword(section, keyword)
202 CALL keyword_release(keyword)
203 CALL keyword_create(keyword, __location__, name="Q_EXPONENT", &
204 description="Exponent at the denominator of the cutoff function to damp the tail of the Gaussian.", &
205 usage="Q_EXPONENT <INT>", &
206 default_i_val=20)
207 CALL section_add_keyword(section, keyword)
208 CALL keyword_release(keyword)
209
210 CALL keyword_create(keyword, __location__, name="SLOW_GROWTH", &
211 description="Let the last hill grow slowly over NT_HILLS. ", &
212 usage="SLOW_GROWTH {logical}", &
213 default_l_val=.false., lone_keyword_l_val=.true.)
214 CALL section_add_keyword(section, keyword)
215 CALL keyword_release(keyword)
216
217 CALL keyword_create(keyword, __location__, name="TEMP_TOL", &
218 description="If a Lagrangian scheme is used the temperature tolerance for the collective "// &
219 "variables is specified.", usage="TEMP_TOL <REAL>", &
220 unit_str='K', default_r_val=0.0_dp)
221 CALL section_add_keyword(section, keyword)
222 CALL keyword_release(keyword)
223
224 CALL keyword_create(keyword, __location__, name="LANGEVIN", &
225 description="If a Lagrangian scheme is used the eq. motion of the COLVARS are integrated "// &
226 "with a LANGEVIN scheme.", &
227 usage="LANGEVIN {logical}", &
228 citations=(/vandencic2006/), &
229 default_l_val=.false., lone_keyword_l_val=.true.)
230 CALL section_add_keyword(section, keyword)
231 CALL keyword_release(keyword)
232
233 CALL keyword_create(keyword, __location__, name="WW", &
234 description="Specifies the height of the gaussian to spawn. Default 0.1 .", &
235 usage="WW <REAL>", unit_str='hartree', default_r_val=0.1_dp)
236 CALL section_add_keyword(section, keyword)
237 CALL keyword_release(keyword)
238
239 CALL keyword_create(keyword, __location__, name="DO_HILLS", &
240 description="This keyword enables the spawning of the hills. Default .FALSE.", &
241 usage="DO_HILLS", default_l_val=.false., lone_keyword_l_val=.true.)
242 CALL section_add_keyword(section, keyword)
243 CALL keyword_release(keyword)
244
245 CALL keyword_create(keyword, __location__, name="WELL_TEMPERED", &
246 description="This keyword enables Well-tempered metadynamics. Default .FALSE.", &
247 usage="WELL_TEMPERED", citations=(/barducbus2008/), &
248 default_l_val=.false., lone_keyword_l_val=.true.)
249 CALL section_add_keyword(section, keyword)
250 CALL keyword_release(keyword)
251
252 CALL keyword_create(keyword, __location__, name="DELTA_T", &
253 description="If Well-tempered metaD is used, the temperature parameter "// &
254 "must be specified.", usage="DELTA_T <REAL>", &
255 unit_str='K', default_r_val=0.0_dp)
256 CALL section_add_keyword(section, keyword)
257 CALL keyword_release(keyword)
258
259 CALL keyword_create(keyword, __location__, name="WTGAMMA", &
260 description="If Well-tempered metaD is used, the gamma parameter "// &
261 "must be specified if not DELTA_T.", usage="WTGAMMA <REAL>", &
262 default_r_val=0.0_dp)
263 CALL section_add_keyword(section, keyword)
264 CALL keyword_release(keyword)
265
266 CALL keyword_create(keyword, __location__, name="LAGRANGE", &
267 description="Specifies whether an extended-lagrangian should be used. Default .FALSE.", &
268 usage="LAGRANGE", default_l_val=.false., lone_keyword_l_val=.true.)
269 CALL section_add_keyword(section, keyword)
270 CALL keyword_release(keyword)
271
272 CALL keyword_create(keyword, __location__, name="step_start_val", &
273 description="The starting step value for metadynamics", &
274 usage="step_start_val <integer>", default_i_val=0)
275 CALL section_add_keyword(section, keyword)
276 CALL keyword_release(keyword)
277
278 CALL keyword_create(keyword, __location__, name="nhills_start_val", &
279 description="The starting value of previously spawned hills", &
280 usage="nhills_start_val <integer>", default_i_val=0)
281 CALL section_add_keyword(section, keyword)
282 CALL keyword_release(keyword)
283
284 CALL keyword_create(keyword, __location__, name="COLVAR_AVG_TEMPERATURE_RESTART", &
285 description="COLVAR average temperature. Only for restarting purposes.", &
286 usage="COLVAR_AVG_TEMPERATURE_RESTART 0.0", default_r_val=0.0_dp)
287 CALL section_add_keyword(section, keyword)
288 CALL keyword_release(keyword)
289
290 CALL keyword_create(keyword, __location__, name="TAMCSteps", &
291 description="Number of sampling points for z", &
292 usage="TAMCSteps <integer>", default_i_val=1)
293 CALL section_add_keyword(section, keyword)
294 CALL keyword_release(keyword)
295
296 CALL keyword_create(keyword, __location__, name="timestep", &
297 description="The length of an integration step for colvars (TAMC only)", &
298 usage="timestep <real>", default_r_val=cp_unit_to_cp2k(value=0.5_dp, unit_str="fs"), &
299 unit_str="fs")
300
301 CALL section_add_keyword(section, keyword)
302 CALL keyword_release(keyword)
303
304 CALL create_metavar_section(subsection)
305 CALL section_add_subsection(section, subsection)
306 CALL section_release(subsection)
307
308 CALL create_multiple_walkers_section(subsection)
309 CALL section_add_subsection(section, subsection)
310 CALL section_release(subsection)
311
312 CALL section_create(subsection, __location__, name="print", &
313 description="Controls the printing properties during an metadynamics run", &
314 n_keywords=0, n_subsections=1, repeats=.true.)
315 NULLIFY (print_key)
316
317 CALL cp_print_key_section_create(print_key, __location__, "program_run_info", &
318 description="Controls the printing of basic and summary information during"// &
319 " metadynamics.", &
320 print_level=low_print_level, each_iter_names=s2a("MD", "METADYNAMICS"), &
321 each_iter_values=(/1, 1/), add_last=add_last_numeric, filename="__STD_OUT__")
322 CALL section_add_subsection(subsection, print_key)
323 CALL section_release(print_key)
324
325 CALL cp_print_key_section_create(print_key, __location__, "temperature_colvar", &
326 description="Controls the printing of the temperature of COLVARS in an "// &
327 "extended lagrangian scheme.", &
328 print_level=low_print_level, each_iter_names=s2a("MD", "METADYNAMICS"), &
329 each_iter_values=(/1, 1/), add_last=add_last_numeric, filename="__STD_OUT__")
330 CALL section_add_subsection(subsection, print_key)
331 CALL section_release(print_key)
332
333 CALL cp_print_key_section_create(print_key, __location__, "COLVAR", &
334 description="Controls the printing of COLVAR summary information during"// &
335 " metadynamics. When an extended Lagrangian use used, the files"// &
336 " contain (in order): colvar value of the extended Lagrangian,"// &
337 " instantaneous colvar value, force due to the harmonic term of the extended"// &
338 " Lagrangian and the force due to the previously spawned hills,"// &
339 " the force due to the walls, the velocities in the extended"// &
340 " Lagrangian, the potential of the harmonic term of the"// &
341 " Lagrangian, the potential energy of the hills, the potential"// &
342 " energy of the walls and the temperature of the extended"// &
343 " Lagrangian. When the extended Lagrangian is not used, all"// &
344 " related fields are omitted.", &
345 print_level=low_print_level, each_iter_names=s2a("MD", "METADYNAMICS"), &
346 each_iter_values=(/1, 1/), add_last=add_last_numeric, filename="COLVAR")
347 CALL section_add_subsection(subsection, print_key)
348 CALL section_release(print_key)
349
350 CALL cp_print_key_section_create(print_key, __location__, "HILLS", &
351 description="Controls the printing of HILLS summary information during"// &
352 " metadynamics. The file contains: instantaneous colvar value, width of"// &
353 " the spawned gaussian and height of the gaussian. According the value of"// &
354 " the EACH keyword this file may not be synchronized with the COLVAR file.", &
355 print_level=high_print_level, each_iter_names=s2a("MD", "METADYNAMICS"), &
356 each_iter_values=(/1, 1/), add_last=add_last_numeric, filename="HILLS")
357 CALL section_add_subsection(subsection, print_key)
358 CALL section_release(print_key)
359
360 CALL section_add_subsection(section, subsection)
361 CALL section_release(subsection)
362
363 CALL create_metadyn_history(subsection, section)
364 END SUBROUTINE create_metadyn_section
365
366! **************************************************************************************************
367!> \brief creates the multiple walker section
368!> \param section the section to be created
369!> \author teodoro laino [tlaino] 10.2008
370! **************************************************************************************************
371 SUBROUTINE create_multiple_walkers_section(section)
372 TYPE(section_type), POINTER :: section
373
374 TYPE(keyword_type), POINTER :: keyword
375 TYPE(section_type), POINTER :: subsection
376
377 cpassert(.NOT. ASSOCIATED(section))
378 CALL section_create(section, __location__, name="MULTIPLE_WALKERS", &
379 description="Enables and configures the metadynamics using multiple walkers.", &
380 n_keywords=0, n_subsections=0, repeats=.false.)
381
382 NULLIFY (subsection, keyword)
383 CALL keyword_create(keyword, __location__, name="_SECTION_PARAMETERS_", &
384 description="Controls the usage of the multiple walkers in a metadynamics run.", &
385 usage="&MULTIPLE_WALKERS T", default_l_val=.false., lone_keyword_l_val=.true.)
386 CALL section_add_keyword(section, keyword)
387 CALL keyword_release(keyword)
388
389 CALL keyword_create(keyword, __location__, name="WALKER_ID", &
390 description="Sets the walker ID for the local metadynamics run.", &
391 usage="WALKER_ID <INTEGER>", type_of_var=integer_t)
392 CALL section_add_keyword(section, keyword)
393 CALL keyword_release(keyword)
394
395 CALL keyword_create(keyword, __location__, name="NUMBER_OF_WALKERS", &
396 description="Sets the total number of walkers in the metadynamic run.", &
397 usage="NUMBER_OF_WALKERS <INTEGER>", type_of_var=integer_t)
398 CALL section_add_keyword(section, keyword)
399 CALL keyword_release(keyword)
400
401 CALL keyword_create(keyword, __location__, name="WALKER_COMM_FREQUENCY", &
402 description="Sets the frequency (in unit of spawned hills) for the "// &
403 "communication between the several walkers, in order to update the "// &
404 "local list of hills with the ones coming from the other walkers", &
405 usage="WALKER_COMM_FREQUENCY <INTEGER>", default_i_val=1)
406 CALL section_add_keyword(section, keyword)
407 CALL keyword_release(keyword)
408
409 CALL keyword_create(keyword, __location__, name="WALKERS_STATUS", &
410 description="Stores the status of the several walkers in the local run.", &
411 usage="WALKERS_STATUS <INTEGER> .. <INTEGER>", type_of_var=integer_t, n_var=-1)
412 CALL section_add_keyword(section, keyword)
413 CALL keyword_release(keyword)
414
415 CALL section_create(subsection, __location__, name="WALKERS_FILE_NAME", &
416 description="Specify the basename for the NUMBER_OF_WALKERS files used to "// &
417 "communicate between the walkers. Absolute path can be input as well "// &
418 "together with the filename. One file will be created for each spawned hill.", &
419 n_keywords=1, n_subsections=0, repeats=.false.)
420 CALL keyword_create(keyword, __location__, name="_DEFAULT_KEYWORD_", &
421 description="Specified the communication filename for each walker.", repeats=.true., &
422 usage="{String}", type_of_var=lchar_t, n_var=1)
423 CALL section_add_keyword(subsection, keyword)
424 CALL keyword_release(keyword)
425 CALL section_add_subsection(section, subsection)
426 CALL section_release(subsection)
427 END SUBROUTINE create_multiple_walkers_section
428
429! **************************************************************************************************
430!> \brief creates the alchemical section for free energy evaluation
431!> \param section the section to be created
432!> \author teodoro laino [tlaino] 04.2007
433! **************************************************************************************************
434 SUBROUTINE create_ac_section(section)
435 TYPE(section_type), POINTER :: section
436
437 TYPE(keyword_type), POINTER :: keyword
438
439 NULLIFY (keyword)
440 cpassert(.NOT. ASSOCIATED(section))
441 CALL section_create(section, __location__, name="ALCHEMICAL_CHANGE", &
442 description="Controls the calculation of delta free energies"// &
443 " with the alchemical change method.", &
444 n_keywords=0, n_subsections=0, repeats=.false.)
445
446 CALL keyword_create(keyword, __location__, name="PARAMETER", &
447 description="Defines the perturbing parameter of the alchemical change transformation", &
448 usage="PARAMETERS k", type_of_var=char_t, &
449 n_var=1)
450 CALL section_add_keyword(section, keyword)
451 CALL keyword_release(keyword)
452
453 CALL keyword_create(keyword, __location__, name="WEIGHTING_FUNCTION", &
454 description="Specifies the weighting function (umbrella potential, part of the mixing function)", &
455 usage="WEIGHTING_FUNCTION (E1+E2-LOG(E1/E2))", type_of_var=lchar_t, &
456 n_var=1, default_lc_val="0")
457 CALL section_add_keyword(section, keyword)
458 CALL keyword_release(keyword)
459
460 CALL keyword_create(keyword, __location__, name="EPS_CONV", &
461 description="Set the relative tolerance for the convergence of the free energy derivative", &
462 usage="EPS_CONV <REAL>", &
463 default_r_val=1.0e-2_dp)
464 CALL section_add_keyword(section, keyword)
465 CALL keyword_release(keyword)
466
467 CALL keyword_create(keyword, __location__, name="NEQUIL_STEPS", &
468 description="Set the number of equilibration steps, skipped to compute averages", &
469 usage="NEQUIL_STEPS <INTEGER>", &
470 default_i_val=0)
471 CALL section_add_keyword(section, keyword)
472 CALL keyword_release(keyword)
473
474 END SUBROUTINE create_ac_section
475
476! **************************************************************************************************
477!> \brief creates the umbrella integration section
478!> \param section the section to be created
479!> \author teodoro laino [tlaino] 01.2007
480! **************************************************************************************************
481 SUBROUTINE create_ui_section(section)
482 TYPE(section_type), POINTER :: section
483
484 TYPE(section_type), POINTER :: subsection
485
486 cpassert(.NOT. ASSOCIATED(section))
487 CALL section_create(section, __location__, name="umbrella_integration", &
488 description="Controls the calculation of free energy derivatives"// &
489 " with the umbrella integration method.", &
490 n_keywords=0, n_subsections=0, repeats=.false.)
491
492 NULLIFY (subsection)
493 CALL create_uvar_conv_section(subsection)
494 CALL section_add_subsection(section, subsection)
495 CALL section_release(subsection)
496
497 CALL create_uvar_section(subsection)
498 CALL section_add_subsection(section, subsection)
499 CALL section_release(subsection)
500
501 END SUBROUTINE create_ui_section
502
503! **************************************************************************************************
504!> \brief Creates the velocity section
505!> \param section the section to create
506!> \param metadyn_section ...
507!> \author teo
508! **************************************************************************************************
509 SUBROUTINE create_metadyn_history(section, metadyn_section)
510 TYPE(section_type), POINTER :: section, metadyn_section
511
512 TYPE(keyword_type), POINTER :: keyword
513
514 cpassert(.NOT. ASSOCIATED(section))
515 CALL section_create(section, __location__, name="SPAWNED_HILLS_POS", &
516 description="The position of the spawned hills during metadynamics. "// &
517 "Used for RESTART.", &
518 n_keywords=1, n_subsections=0, repeats=.false.)
519 NULLIFY (keyword)
520 CALL keyword_create(keyword, __location__, name="_DEFAULT_KEYWORD_", &
521 description="Specify the spawned hills", repeats=.true., &
522 usage="{Real} ...", type_of_var=real_t, n_var=-1)
523 CALL section_add_keyword(section, keyword)
524 CALL keyword_release(keyword)
525 CALL section_add_subsection(metadyn_section, section)
526 CALL section_release(section)
527
528 CALL section_create(section, __location__, name="SPAWNED_HILLS_SCALE", &
529 description="The scales of the spawned hills during metadynamics. "// &
530 "Used for RESTART. When a scale is zero in one or more "// &
531 "directions, the Gaussian hill is assumed to be infinitely wide "// &
532 "in those directions. The latter can be used to combine spawned "// &
533 "hills from multiple 1D metadynamics runs in one multidimensional "// &
534 "metadynamics run.", &
535 n_keywords=1, n_subsections=0, repeats=.false.)
536 NULLIFY (keyword)
537 CALL keyword_create(keyword, __location__, name="_DEFAULT_KEYWORD_", &
538 description="Specify the spawned hills", repeats=.true., &
539 usage="{Real} ...", type_of_var=real_t, n_var=-1)
540 CALL section_add_keyword(section, keyword)
541 CALL keyword_release(keyword)
542 CALL section_add_subsection(metadyn_section, section)
543 CALL section_release(section)
544
545 CALL section_create(section, __location__, name="SPAWNED_HILLS_HEIGHT", &
546 description="The height of the spawned hills during metadynamics. "// &
547 "Used for RESTART.", &
548 n_keywords=1, n_subsections=0, repeats=.false.)
549 NULLIFY (keyword)
550 CALL keyword_create(keyword, __location__, name="_DEFAULT_KEYWORD_", &
551 description="Specify the spawned hills", repeats=.true., &
552 usage="{Real}", type_of_var=real_t, n_var=1)
553 CALL section_add_keyword(section, keyword)
554 CALL keyword_release(keyword)
555 CALL section_add_subsection(metadyn_section, section)
556 CALL section_release(section)
557
558 CALL section_create(section, __location__, name="SPAWNED_HILLS_INVDT", &
559 description="The inverse of the DELTA_T parameter used for Well-Tempered metadynamics. "// &
560 "Used for RESTART.", &
561 n_keywords=1, n_subsections=0, repeats=.false.)
562 NULLIFY (keyword)
563 CALL keyword_create(keyword, __location__, name="_DEFAULT_KEYWORD_", &
564 description="Specify the spawned hills", repeats=.true., &
565 usage="{Real}", type_of_var=real_t, n_var=1)
566 CALL section_add_keyword(section, keyword)
567 CALL keyword_release(keyword)
568 CALL section_add_subsection(metadyn_section, section)
569 CALL section_release(section)
570 !
571 ! Extended Lagrangian
572 !
573 CALL section_create(section, __location__, name="EXT_LAGRANGE_SS0", &
574 description="Colvar position within an extended Lagrangian formalism. "// &
575 "Used for RESTART.", &
576 n_keywords=1, n_subsections=0, repeats=.false.)
577 NULLIFY (keyword)
578 CALL keyword_create(keyword, __location__, name="_DEFAULT_KEYWORD_", &
579 description="Specified the positions", repeats=.true., &
580 usage="{Real}", type_of_var=real_t, n_var=1)
581 CALL section_add_keyword(section, keyword)
582 CALL keyword_release(keyword)
583 CALL section_add_subsection(metadyn_section, section)
584 CALL section_release(section)
585
586 CALL section_create(section, __location__, name="EXT_LAGRANGE_VVP", &
587 description="Colvar velocities within an extended Lagrangian formalism. "// &
588 "Used for RESTART.", &
589 n_keywords=1, n_subsections=0, repeats=.false.)
590 NULLIFY (keyword)
591 CALL keyword_create(keyword, __location__, name="_DEFAULT_KEYWORD_", &
592 description="Specified the velocities", repeats=.true., &
593 usage="{Real}", type_of_var=real_t, n_var=1)
594 CALL section_add_keyword(section, keyword)
595 CALL keyword_release(keyword)
596 CALL section_add_subsection(metadyn_section, section)
597 CALL section_release(section)
598
599 CALL section_create(section, __location__, name="EXT_LAGRANGE_SS", &
600 description="Colvar Theta within an extended Lagrangian formalism. "// &
601 "Used for RESTART.", &
602 n_keywords=1, n_subsections=0, repeats=.false.)
603 NULLIFY (keyword)
604 CALL keyword_create(keyword, __location__, name="_DEFAULT_KEYWORD_", &
605 description="Specified the theta", repeats=.true., &
606 usage="{Real}", type_of_var=real_t, n_var=1)
607 CALL section_add_keyword(section, keyword)
608 CALL keyword_release(keyword)
609 CALL section_add_subsection(metadyn_section, section)
610 CALL section_release(section)
611
612 CALL section_create(section, __location__, name="EXT_LAGRANGE_FS", &
613 description="Colvar force within an extended Lagrangian formalism. "// &
614 "Used for RESTART.", &
615 n_keywords=1, n_subsections=0, repeats=.false.)
616 NULLIFY (keyword)
617 CALL keyword_create(keyword, __location__, name="_DEFAULT_KEYWORD_", &
618 description="Specified the theta", repeats=.true., &
619 usage="{Real}", type_of_var=real_t, n_var=1)
620 CALL section_add_keyword(section, keyword)
621 CALL keyword_release(keyword)
622 CALL section_add_subsection(metadyn_section, section)
623 CALL section_release(section)
624
625 END SUBROUTINE create_metadyn_history
626
627! **************************************************************************************************
628!> \brief creates the metavar section
629!> \param section the section to be created
630!> \author teo
631! **************************************************************************************************
632 SUBROUTINE create_metavar_section(section)
633 TYPE(section_type), POINTER :: section
634
635 TYPE(keyword_type), POINTER :: keyword
636 TYPE(section_type), POINTER :: subsection, wall_section
637
638 cpassert(.NOT. ASSOCIATED(section))
639 CALL section_create(section, __location__, name="METAVAR", &
640 description="This section specify the nature of the collective variables.", &
641 n_keywords=1, n_subsections=1, repeats=.true.)
642
643 NULLIFY (keyword)
644 CALL keyword_create(keyword, __location__, name="LAMBDA", &
645 description="Specifies the lambda parameter for the coupling of the collective variable with the system coordinates in the"// &
646 " extended lagrangian scheme.", &
647 usage="LAMBDA <REAL>", unit_str='internal_cp2k', type_of_var=real_t)
648 CALL section_add_keyword(section, keyword)
649 CALL keyword_release(keyword)
650
651 CALL keyword_create(keyword, __location__, name="MASS", &
652 description="Specifies the mass parameter of the collective variable in the"// &
653 " extended lagrangian scheme.", usage="MASS <REAL>", unit_str='amu', type_of_var=real_t)
654 CALL section_add_keyword(section, keyword)
655 CALL keyword_release(keyword)
656
657 CALL keyword_create(keyword, __location__, name="GAMMA", &
658 description="Specifies the friction term in Langevin integration of the collective variable in the"// &
659 " extended lagrangian scheme.", &
660 citations=(/vandencic2006/), &
661 usage="GAMMA {real}", type_of_var=real_t, unit_str="fs^-1")
662 CALL section_add_keyword(section, keyword)
663 CALL keyword_release(keyword)
664
665 CALL keyword_create(keyword, __location__, name="SCALE", &
666 variants=(/"WIDTH"/), &
667 description="Specifies the scale factor for the following collective variable. The history "// &
668 "dependent term has the expression: WW * Sum_{j=1}^{nhills} Prod_{k=1}^{ncolvar} "// &
669 "[EXP[-0.5*((ss-ss0(k,j))/SCALE(k))^2]], "// &
670 "where ncolvar is the number of defined METAVAR and nhills is the number of spawned hills. ", &
671 usage="SCALE <REAL>", type_of_var=real_t, unit_str='internal_cp2k')
672 CALL section_add_keyword(section, keyword)
673 CALL keyword_release(keyword)
674
675 CALL keyword_create(keyword, __location__, name="COLVAR", &
676 description="Specifies the colvar on which to apply metadynamics.", &
677 usage="COLVAR {integer}", type_of_var=integer_t)
678 CALL section_add_keyword(section, keyword)
679 CALL keyword_release(keyword)
680
681 ! Wall section
682 NULLIFY (wall_section, subsection)
683 CALL section_create(wall_section, __location__, name="WALL", &
684 description="Controls the activation of walls on COLVAR during a metadynamic run.", &
685 n_keywords=0, n_subsections=1, repeats=.true.)
686
687 CALL keyword_create( &
688 keyword, __location__, name="TYPE", &
689 description="Specify the type of wall", &
690 usage=" TYPE (REFLECTIVE|QUADRATIC|QUARTIC|GAUSSIAN|NONE)", &
691 enum_c_vals=s2a("REFLECTIVE", "QUADRATIC", "QUARTIC", "GAUSSIAN", "NONE"), &
692 enum_desc=s2a("Reflective wall. Colvar velocity is inverted when the colvar is beyond the wall position.", &
693 "Applies a quadratic potential at the wall position.", &
694 "Applies a quartic potential at the wall position.", &
695 "Applies a gaussian potential at the wall position.", &
696 "No walls are applied."), &
698 default_i_val=do_wall_none)
699 CALL section_add_keyword(wall_section, keyword)
700 CALL keyword_release(keyword)
701
702 CALL keyword_create(keyword, __location__, name="POSITION", &
703 description="Specify the value of the colvar for the wall position", &
704 usage="POSITION <REAL>", unit_str='internal_cp2k', &
705 type_of_var=real_t)
706 CALL section_add_keyword(wall_section, keyword)
707 CALL keyword_release(keyword)
708
709 ! Reflective wall
710 CALL section_create(subsection, __location__, name="REFLECTIVE", &
711 description="Parameters controlling the reflective wall", &
712 n_keywords=0, n_subsections=1, repeats=.false.)
713
714 CALL keyword_create(keyword, __location__, name="DIRECTION", &
715 description="Specify the direction of the wall.", &
716 usage=" TYPE (WALL_PLUS|WALL_MINUS)", &
717 enum_c_vals=s2a("WALL_PLUS", "WALL_MINUS"), &
718 enum_desc=s2a("Wall extends from the position towards larger values of COLVAR", &
719 "Wall extends from the position towards smaller values of COLVAR"), &
720 enum_i_vals=(/do_wall_p, do_wall_m/), default_i_val=do_wall_p)
721 CALL section_add_keyword(subsection, keyword)
722 CALL keyword_release(keyword)
723 CALL section_add_subsection(wall_section, subsection)
724 CALL section_release(subsection)
725
726 ! Quadratic wall
727 CALL section_create(subsection, __location__, name="QUADRATIC", &
728 description="Parameters controlling the quadratic wall", &
729 n_keywords=0, n_subsections=1, repeats=.false.)
730
731 CALL keyword_create(keyword, __location__, name="DIRECTION", &
732 description="Specify the direction of the wall.", &
733 usage=" TYPE (WALL_PLUS|WALL_MINUS)", &
734 enum_c_vals=s2a("WALL_PLUS", "WALL_MINUS"), &
735 enum_desc=s2a("Wall extends from the position towards larger values of COLVAR", &
736 "Wall extends from the position towards smaller values of COLVAR"), &
737 enum_i_vals=(/do_wall_p, do_wall_m/), default_i_val=do_wall_p)
738 CALL section_add_keyword(subsection, keyword)
739 CALL keyword_release(keyword)
740
741 CALL keyword_create(keyword, __location__, name="K", &
742 description="Specify the value of the quadratic potential constant: K*(CV-POS)^2", &
743 usage="K <REAL>", unit_str='hartree', &
744 type_of_var=real_t)
745 CALL section_add_keyword(subsection, keyword)
746 CALL keyword_release(keyword)
747
748 CALL section_add_subsection(wall_section, subsection)
749 CALL section_release(subsection)
750
751 ! Quartic wall
752 CALL section_create(subsection, __location__, name="QUARTIC", &
753 description="Parameters controlling the quartic wall", &
754 n_keywords=0, n_subsections=1, repeats=.false.)
755
756 CALL keyword_create(keyword, __location__, name="DIRECTION", &
757 description="Specify the direction of the wall.", &
758 usage=" TYPE (WALL_PLUS|WALL_MINUS)", &
759 enum_c_vals=s2a("WALL_PLUS", "WALL_MINUS"), &
760 enum_desc=s2a("Wall extends from the position towards larger values of COLVAR", &
761 "Wall extends from the position towards smaller values of COLVAR"), &
762 enum_i_vals=(/do_wall_p, do_wall_m/), default_i_val=do_wall_p)
763 CALL section_add_keyword(subsection, keyword)
764 CALL keyword_release(keyword)
765
766 CALL keyword_create(keyword, __location__, name="K", &
767 description="Specify the value of the quartic potential constant: K*(CV-(POS+/-(1/K^(1/4))))^4", &
768 usage="K <REAL>", unit_str='hartree', &
769 type_of_var=real_t)
770 CALL section_add_keyword(subsection, keyword)
771 CALL keyword_release(keyword)
772
773 CALL section_add_subsection(wall_section, subsection)
774 CALL section_release(subsection)
775
776 ! Gaussian wall
777 CALL section_create(subsection, __location__, name="GAUSSIAN", &
778 description="Parameters controlling the gaussian wall.", &
779 n_keywords=0, n_subsections=1, repeats=.false.)
780
781 CALL keyword_create(keyword, __location__, name="WW", &
782 description="Specify the height of the gaussian: WW*e^(-((CV-POS)/sigma)^2)", &
783 usage="K <REAL>", unit_str='hartree', &
784 type_of_var=real_t)
785 CALL section_add_keyword(subsection, keyword)
786 CALL keyword_release(keyword)
787
788 CALL keyword_create(keyword, __location__, name="SIGMA", &
789 description="Specify the width of the gaussian: WW*e^(-((CV-POS)/sigma)^2)", &
790 usage="SIGMA <REAL>", unit_str='internal_cp2k', &
791 type_of_var=real_t)
792 CALL section_add_keyword(subsection, keyword)
793 CALL keyword_release(keyword)
794
795 CALL section_add_subsection(wall_section, subsection)
796 CALL section_release(subsection)
797
798 CALL section_add_subsection(section, wall_section)
799 CALL section_release(wall_section)
800
801 END SUBROUTINE create_metavar_section
802
803! **************************************************************************************************
804!> \brief creates the uvar section
805!> \param section the section to be created
806!> \author teo
807! **************************************************************************************************
808 SUBROUTINE create_uvar_section(section)
809 TYPE(section_type), POINTER :: section
810
811 TYPE(keyword_type), POINTER :: keyword
812
813 cpassert(.NOT. ASSOCIATED(section))
814 CALL section_create(section, __location__, name="UVAR", &
815 description="This section specify the nature of the collective variables"// &
816 " used in computing the free energy.", &
817 n_keywords=1, n_subsections=1, repeats=.true.)
818
819 NULLIFY (keyword)
820
821 CALL keyword_create(keyword, __location__, name="COLVAR", &
822 description="Specifies the colvar used to compute free energy", &
823 usage="COLVAR {integer}", type_of_var=integer_t)
824 CALL section_add_keyword(section, keyword)
825 CALL keyword_release(keyword)
826 END SUBROUTINE create_uvar_section
827
828! **************************************************************************************************
829!> \brief creates the section specifying parameters to control the convergence
830!> of the free energy
831!> \param section the section to be created
832!> \author teodoro laino [tlaino] 01.2007
833! **************************************************************************************************
834 SUBROUTINE create_uvar_conv_section(section)
835 TYPE(section_type), POINTER :: section
836
837 TYPE(keyword_type), POINTER :: keyword
838
839 cpassert(.NOT. ASSOCIATED(section))
840 CALL section_create(section, __location__, name="CONVERGENCE_CONTROL", &
841 description="This section specify parameters controlling the convergence"// &
842 " of the free energy.", &
843 n_keywords=1, n_subsections=1, repeats=.true.)
844
845 NULLIFY (keyword)
846 CALL keyword_create(keyword, __location__, name="COARSE_GRAINED_WIDTH", &
847 variants=(/"CG_WIDTH"/), &
848 description="Width of segments in MD steps to generate the set of"// &
849 " coarse grained data, providing a correlation independent data set.", &
850 usage="COARSE_GRAINED_WIDTH <INTEGER>", default_i_val=50)
851 CALL section_add_keyword(section, keyword)
852 CALL keyword_release(keyword)
853
854 CALL keyword_create(keyword, __location__, name="MAX_COARSE_GRAINED_WIDTH", &
855 variants=(/"MAX_CG_WIDTH"/), &
856 description="Max Width of segments in MD steps to generate the set of"// &
857 " coarse grained data.", &
858 usage="MAX_COARSE_GRAINED_WIDTH <INTEGER>", default_i_val=200)
859 CALL section_add_keyword(section, keyword)
860 CALL keyword_release(keyword)
861
862 CALL keyword_create(keyword, __location__, name="COARSE_GRAINED_POINTS", &
863 variants=(/"CG_POINTS"/), &
864 description="Set the minimum amount of coarse grained points to collect"// &
865 " before starting the statistical analysis", &
866 usage="COARSE_GRAINED_POINTS <INTEGER>", default_i_val=30)
867 CALL section_add_keyword(section, keyword)
868 CALL keyword_release(keyword)
869
870 CALL keyword_create(keyword, __location__, name="EPS_CONV", &
871 description="Set the relative tolerance for the convergence of the collective"// &
872 " variable averages used to compute the free energy.", &
873 usage="EPS_CONV <REAL>", &
874 default_r_val=1.0e-2_dp)
875 CALL section_add_keyword(section, keyword)
876 CALL keyword_release(keyword)
877
878 CALL keyword_create(keyword, __location__, name="K_CONFIDENCE_LIMIT", &
879 description="Set the confidence limit for the Mann-Kendall trend test.", &
880 usage="K_CONFIDENCE_LIMIT <REAL>", &
881 default_r_val=0.90_dp)
882 CALL section_add_keyword(section, keyword)
883 CALL keyword_release(keyword)
884
885 CALL keyword_create(keyword, __location__, name="SW_CONFIDENCE_LIMIT", &
886 description="Set the confidence limit for the Shapiro-Wilks normality test.", &
887 usage="SW_CONFIDENCE_LIMIT <REAL>", &
888 default_r_val=0.90_dp)
889 CALL section_add_keyword(section, keyword)
890 CALL keyword_release(keyword)
891
892 CALL keyword_create(keyword, __location__, name="VN_CONFIDENCE_LIMIT", &
893 description="Set the confidence limit for the Von Neumann serial correlation test.", &
894 usage="VN_CONFIDENCE_LIMIT <REAL>", &
895 default_r_val=0.90_dp)
896 CALL section_add_keyword(section, keyword)
897 CALL keyword_release(keyword)
898 END SUBROUTINE create_uvar_conv_section
899
900END MODULE input_cp2k_free_energy
collects all references to literature in CP2K as new algorithms / method are included from literature...
integer, save, public barducbus2008
integer, save, public vandencic2006
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
integer, parameter, public low_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_wall_p
integer, parameter, public do_wall_m
integer, parameter, public do_fe_ac
integer, parameter, public do_wall_none
integer, parameter, public do_wall_gaussian
integer, parameter, public do_fe_ui
integer, parameter, public do_wall_quartic
integer, parameter, public do_wall_reflective
integer, parameter, public do_wall_quadratic
integer, parameter, public do_fe_meta
integer, parameter, public gaussian
subroutine, public create_metavar_section(section)
creates the metavar section
subroutine, public create_fe_section(section)
creates the free energy section
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