(git:0de0cc2)
input_cp2k_thermostats.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: bussi2007,&
15  ceriotti2009,&
17  jones2011,&
18  nose1984a,&
19  nose1984b
23  USE cp_units, ONLY: cp_unit_to_cp2k
24  USE input_constants, ONLY: &
31  keyword_type
36  section_type
37  USE input_val_types, ONLY: char_t,&
38  integer_t,&
39  real_t
40  USE kinds, ONLY: dp
41  USE string_utilities, ONLY: s2a
42 #include "./base/base_uses.f90"
43 
44  IMPLICIT NONE
45  PRIVATE
46 
47  LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .true.
48  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_cp2k_thermostats'
49 
50  PUBLIC :: create_thermostat_section, &
58 
59 !***
60 CONTAINS
61 ! **************************************************************************************************
62 !> \brief Specifies parameter for thermostat for constant temperature ensembles
63 !> \param section will contain the coeff section
64 !> \param coupled_thermostat ...
65 !> \author teo [tlaino] - University of Zurich - 09.2007
66 ! **************************************************************************************************
67  SUBROUTINE create_thermo_slow_section(section, coupled_thermostat)
68  TYPE(section_type), POINTER :: section
69  LOGICAL, INTENT(IN), OPTIONAL :: coupled_thermostat
70 
71  LOGICAL :: my_coupled_thermostat
72  TYPE(keyword_type), POINTER :: keyword
73  TYPE(section_type), POINTER :: nose_section, region_section
74 
75  cpassert(.NOT. ASSOCIATED(section))
76  my_coupled_thermostat = .false.
77  IF (PRESENT(coupled_thermostat)) my_coupled_thermostat = coupled_thermostat
78  NULLIFY (nose_section, region_section)
79 
80  CALL section_create(section, __location__, name="THERMOSTAT_SLOW", &
81  description="Specify thermostat type and parameters controlling the thermostat.", &
82  n_keywords=1, n_subsections=0, repeats=.false.)
83  NULLIFY (keyword)
84 
85  IF (.NOT. my_coupled_thermostat) THEN
86  CALL keyword_create(keyword, __location__, name="TYPE", &
87  description="Specify the thermostat used for the constant temperature ensembles.", &
88  usage="thermostat NOSE", &
89  default_i_val=do_thermo_nose, &
90  enum_c_vals=s2a("NOSE"), &
91  enum_i_vals=(/do_thermo_nose/), &
92  enum_desc=s2a("Uses only the Nose-Hoover thermostat."))
93  CALL section_add_keyword(section, keyword)
94  CALL keyword_release(keyword)
95 
96  CALL keyword_create(keyword, __location__, name="REGION", &
97  description="Determines the defined region for slow thermostat", &
98  usage="REGION (GLOBAL||MOLECULE||MASSIVE||DEFINED||NONE)", &
99  enum_c_vals=s2a("GLOBAL", "MOLECULE", "MASSIVE", "DEFINED", "NONE"), &
100  enum_i_vals=(/do_region_global, do_region_molecule, &
102  default_i_val=do_region_global)
103  CALL section_add_keyword(section, keyword)
104  CALL keyword_release(keyword)
105 
106  CALL create_region_section(region_section, "slow thermostat")
107  CALL section_add_subsection(section, region_section)
108  CALL section_release(region_section)
109  ELSE
110  CALL keyword_create(keyword, __location__, name="TYPE", &
111  description="Specify the thermostat used for the constant temperature ensembles.", &
112  usage="thermostat NOSE", &
113  default_i_val=do_thermo_same_as_part, &
114  enum_c_vals=s2a("SAME_AS_PARTICLE", "NOSE", "CSVR"), &
116  enum_desc=s2a("Use the same kind of thermostat used for particles.", &
117  "Uses the Nose-Hoover thermostat.", &
118  "Uses the canonical sampling through velocity rescaling."))
119  CALL section_add_keyword(section, keyword)
120  CALL keyword_release(keyword)
121  END IF
122 
123  CALL create_nose_section(nose_section)
124  CALL section_add_subsection(section, nose_section)
125  CALL section_release(nose_section)
126 
127  ! Print Section
128 ! CALL create_print_section(subsection)
129 ! CALL section_add_subsection(section, subsection)
130 ! CALL section_release(subsection)
131 
132  END SUBROUTINE create_thermo_slow_section
133 
134 ! **************************************************************************************************
135 !> \brief Specifies parameter for thermostat for constant temperature ensembles
136 !> \param section will contain the coeff section
137 !> \param coupled_thermostat ...
138 !> \author teo [tlaino] - University of Zurich - 09.2007
139 ! **************************************************************************************************
140  SUBROUTINE create_thermo_fast_section(section, coupled_thermostat)
141  TYPE(section_type), POINTER :: section
142  LOGICAL, INTENT(IN), OPTIONAL :: coupled_thermostat
143 
144  LOGICAL :: my_coupled_thermostat
145  TYPE(keyword_type), POINTER :: keyword
146  TYPE(section_type), POINTER :: nose_section, region_section
147 
148  cpassert(.NOT. ASSOCIATED(section))
149  my_coupled_thermostat = .false.
150  IF (PRESENT(coupled_thermostat)) my_coupled_thermostat = coupled_thermostat
151  NULLIFY (nose_section, region_section)
152 
153  CALL section_create(section, __location__, name="THERMOSTAT_FAST", &
154  description="Specify thermostat type and parameters controlling the thermostat.", &
155  n_keywords=1, n_subsections=0, repeats=.false.)
156  NULLIFY (keyword)
157 
158  IF (.NOT. my_coupled_thermostat) THEN
159  CALL keyword_create(keyword, __location__, name="TYPE", &
160  description="Specify the thermostat used for the constant temperature ensembles.", &
161  usage="thermostat NOSE", &
162  default_i_val=do_thermo_nose, &
163  enum_c_vals=s2a("NOSE"), &
164  enum_i_vals=(/do_thermo_nose/), &
165  enum_desc=s2a("Uses only the Nose-Hoover thermostat."))
166  CALL section_add_keyword(section, keyword)
167  CALL keyword_release(keyword)
168 
169  CALL keyword_create(keyword, __location__, name="REGION", &
170  description="Determines the defined region for fast thermostat", &
171  usage="REGION (GLOBAL||MOLECULE||MASSIVE||DEFINED||NONE)", &
172  enum_c_vals=s2a("GLOBAL", "MOLECULE", "MASSIVE", "DEFINED", "NONE"), &
173  enum_i_vals=(/do_region_global, do_region_molecule, &
175  default_i_val=do_region_global)
176  CALL section_add_keyword(section, keyword)
177  CALL keyword_release(keyword)
178 
179  CALL create_region_section(region_section, "fast thermostat")
180  CALL section_add_subsection(section, region_section)
181  CALL section_release(region_section)
182  ELSE
183  CALL keyword_create(keyword, __location__, name="TYPE", &
184  description="Specify the thermostat used for the constant temperature ensembles.", &
185  usage="thermostat NOSE", &
186  default_i_val=do_thermo_same_as_part, &
187  enum_c_vals=s2a("SAME_AS_PARTICLE", "NOSE", "CSVR"), &
189  enum_desc=s2a("Use the same kind of thermostat used for particles.", &
190  "Uses the Nose-Hoover thermostat.", &
191  "Uses the canonical sampling through velocity rescaling."))
192  CALL section_add_keyword(section, keyword)
193  CALL keyword_release(keyword)
194  END IF
195 
196  CALL create_nose_section(nose_section)
197  CALL section_add_subsection(section, nose_section)
198  CALL section_release(nose_section)
199 
200  ! Print Section
201 ! CALL create_print_section(subsection)
202 ! CALL section_add_subsection(section, subsection)
203 ! CALL section_release(subsection)
204 
205  END SUBROUTINE create_thermo_fast_section
206 
207 ! **************************************************************************************************
208 !> \brief Specifies parameter for thermostat for constant temperature ensembles
209 !> \param section will contain the coeff section
210 !> \param coupled_thermostat ...
211 !> \author teo [tlaino] - University of Zurich - 09.2007
212 ! **************************************************************************************************
213  SUBROUTINE create_thermostat_section(section, coupled_thermostat)
214  TYPE(section_type), POINTER :: section
215  LOGICAL, INTENT(IN), OPTIONAL :: coupled_thermostat
216 
217  LOGICAL :: my_coupled_thermostat
218  TYPE(keyword_type), POINTER :: keyword
219  TYPE(section_type), POINTER :: al_section, csvr_section, gle_section, &
220  nose_section, region_section, &
221  subsection
222 
223  cpassert(.NOT. ASSOCIATED(section))
224  my_coupled_thermostat = .false.
225  IF (PRESENT(coupled_thermostat)) my_coupled_thermostat = coupled_thermostat
226  NULLIFY (csvr_section, gle_section, al_section, nose_section, subsection, region_section)
227 
228  CALL section_create(section, __location__, name="THERMOSTAT", &
229  description="Specify thermostat type and parameters controlling the thermostat.", &
230  n_keywords=1, n_subsections=0, repeats=.false.)
231  NULLIFY (keyword)
232 
233  IF (.NOT. my_coupled_thermostat) THEN
234  CALL keyword_create(keyword, __location__, name="TYPE", &
235  description="Specify the thermostat used for the constant temperature ensembles.", &
236  usage="thermostat NOSE", &
237  default_i_val=do_thermo_nose, &
238  enum_c_vals=s2a("NOSE", "CSVR", "GLE", "AD_LANGEVIN"), &
239  enum_i_vals=(/do_thermo_nose, &
241  enum_desc=s2a("Uses the Nose-Hoover thermostat.", &
242  "Uses the canonical sampling through velocity rescaling.", &
243  "Uses GLE thermostat", &
244  "Uses adaptive-Langevin thermostat"))
245  CALL section_add_keyword(section, keyword)
246  CALL keyword_release(keyword)
247 
248  CALL keyword_create(keyword, __location__, name="REGION", &
249  description="Determines the region each thermostat is attached to.", &
250  usage="REGION (GLOBAL||MOLECULE||MASSIVE||DEFINED||NONE)", &
251  enum_c_vals=s2a("GLOBAL", "MOLECULE", "MASSIVE", "DEFINED", "NONE"), &
252  enum_i_vals=(/do_region_global, do_region_molecule, &
254  default_i_val=do_region_global)
255  CALL section_add_keyword(section, keyword)
256  CALL keyword_release(keyword)
257 
258  CALL create_region_section(region_section, "thermostat")
259  CALL section_add_subsection(section, region_section)
260  CALL section_release(region_section)
261  ELSE
262  CALL keyword_create(keyword, __location__, name="TYPE", &
263  description="Specify the thermostat used for the constant temperature ensembles.", &
264  usage="thermostat NOSE", &
265  default_i_val=do_thermo_same_as_part, &
266  enum_c_vals=s2a("SAME_AS_PARTICLE", "NOSE", "CSVR"), &
268  enum_desc=s2a("Use the same kind of thermostat used for particles.", &
269  "Uses the Nose-Hoover thermostat.", &
270  "Uses the canonical sampling through velocity rescaling."))
271  CALL section_add_keyword(section, keyword)
272  CALL keyword_release(keyword)
273  END IF
274 
275  CALL create_nose_section(nose_section)
276  CALL section_add_subsection(section, nose_section)
277  CALL section_release(nose_section)
278 
279  CALL create_csvr_section(csvr_section)
280  CALL section_add_subsection(section, csvr_section)
281  CALL section_release(csvr_section)
282 
283  CALL create_gle_section(gle_section)
284  CALL section_add_subsection(section, gle_section)
285  CALL section_release(gle_section)
286 
287  CALL create_al_section(al_section)
288  CALL section_add_subsection(section, al_section)
289  CALL section_release(al_section)
290 
291  ! Print Section
292  CALL create_print_section(subsection)
293  CALL section_add_subsection(section, subsection)
294  CALL section_release(subsection)
295 
296  END SUBROUTINE create_thermostat_section
297 
298 ! **************************************************************************************************
299 !> \brief Creates print section for thermostat section
300 !> \param section ...
301 !> \author teo [tlaino] - University of Zurich - 02.2008
302 ! **************************************************************************************************
303  SUBROUTINE create_print_section(section)
304  TYPE(section_type), POINTER :: section
305 
306  TYPE(section_type), POINTER :: print_key
307 
308  cpassert(.NOT. ASSOCIATED(section))
309  NULLIFY (print_key)
310  CALL section_create(section, __location__, name="PRINT", &
311  description="Collects all print_keys for thermostat", &
312  n_keywords=1, n_subsections=0, repeats=.false.)
313 
314  CALL cp_print_key_section_create(print_key, __location__, "THERMOSTAT_INFO", &
315  description="Controls output information of the corresponding thermostat.", &
316  print_level=low_print_level, common_iter_levels=1, &
317  filename="__STD_OUT__")
318  CALL section_add_subsection(section, print_key)
319  CALL section_release(print_key)
320 
321  CALL cp_print_key_section_create(print_key, __location__, "TEMPERATURE", &
322  description="Controls the output of the temperatures of the regions corresponding to "// &
323  "the present thermostat", &
324  print_level=high_print_level, common_iter_levels=1, &
325  filename="")
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__, "ENERGY", &
330  description="Controls the output of kinetic energy, and potential energy "// &
331  "of the defined thermostat.", print_level=high_print_level, common_iter_levels=1, &
332  filename="")
333  CALL section_add_subsection(section, print_key)
334  CALL section_release(print_key)
335  END SUBROUTINE create_print_section
336 
337 ! **************************************************************************************************
338 !> \brief Creates a section to arbitrary define a region to thermostat
339 !> \param section will contain the coeff section
340 !> \param label ...
341 !> \author teo
342 ! **************************************************************************************************
343  SUBROUTINE create_region_section(section, label)
344  TYPE(section_type), POINTER :: section
345  CHARACTER(LEN=*), INTENT(IN) :: label
346 
347  TYPE(keyword_type), POINTER :: keyword
348 
349  cpassert(.NOT. ASSOCIATED(section))
350 
351  CALL section_create(section, __location__, name="DEFINE_REGION", &
352  description="This section provides the possibility to define arbitrary region "// &
353  "for the "//trim(label)//".", &
354  n_keywords=1, n_subsections=0, repeats=.true.)
355 
356  NULLIFY (keyword)
357  CALL keyword_create(keyword, __location__, name="LIST", &
358  description="Specifies a list of atoms to thermostat.", &
359  usage="LIST {integer} {integer} .. {integer}", repeats=.true., &
360  n_var=-1, type_of_var=integer_t)
361  CALL section_add_keyword(section, keyword)
362  CALL keyword_release(keyword)
363 
364  CALL keyword_create(keyword, __location__, name="MOLNAME", &
365  variants=(/"SEGNAME"/), &
366  description="Specifies the name of the molecules to thermostat", &
367  usage="MOLNAME WAT MEOH", repeats=.true., &
368  n_var=-1, type_of_var=char_t)
369  CALL section_add_keyword(section, keyword)
370  CALL keyword_release(keyword)
371 
372  CALL keyword_create(keyword, __location__, name="MM_SUBSYS", &
373  variants=(/"PROTEIN"/), &
374  description="In a QM/MM run all MM atoms are specified as a whole ensemble to be thermostated", &
375  usage="MM_SUBSYS (NONE|ATOMIC|MOLECULAR)", &
376  enum_c_vals=s2a("NONE", "ATOMIC", "MOLECULAR"), &
377  enum_i_vals=(/do_constr_none, do_constr_atomic, do_constr_molec/), &
378  enum_desc=s2a("Thermostat nothing", &
379  "Only the MM atoms itself", &
380  "The full molecule/residue that contains a MM atom"), &
381  default_i_val=do_constr_none, repeats=.false.)
382  CALL section_add_keyword(section, keyword)
383  CALL keyword_release(keyword)
384 
385  CALL keyword_create(keyword, __location__, name="QM_SUBSYS", &
386  description="In a QM/MM run all QM atoms are specified as a whole ensemble to be thermostated", &
387  usage="QM_SUBSYS (NONE|ATOMIC|MOLECULAR)", &
388  enum_c_vals=s2a("NONE", "ATOMIC", "MOLECULAR"), &
389  enum_desc=s2a("Thermostat nothing", &
390  "Only the QM atoms itself", &
391  "The full molecule/residue that contains a QM atom"), &
392  enum_i_vals=(/do_constr_none, do_constr_atomic, do_constr_molec/), &
393  default_i_val=do_constr_none, repeats=.false.)
394  CALL section_add_keyword(section, keyword)
395  CALL keyword_release(keyword)
396 
397  END SUBROUTINE create_region_section
398 
399 ! **************************************************************************************************
400 !> \brief ...
401 !> \param section will contain the ewald section
402 !> \author gloria
403 ! **************************************************************************************************
404  SUBROUTINE create_nose_section(section)
405  TYPE(section_type), POINTER :: section
406 
407  TYPE(keyword_type), POINTER :: keyword
408  TYPE(section_type), POINTER :: subsection
409 
410  cpassert(.NOT. ASSOCIATED(section))
411  CALL section_create(section, __location__, name="nose", &
412  description="paramameters of the Nose Hoover thermostat chain", &
413  citations=(/nose1984a, nose1984b/))
414 
415  NULLIFY (keyword, subsection)
416  CALL keyword_create(keyword, __location__, name="length", &
417  description="length of the Nose-Hoover chain", usage="length integer", &
418  default_i_val=3)
419  CALL section_add_keyword(section, keyword)
420  CALL keyword_release(keyword)
421 
422  CALL keyword_create(keyword, __location__, name="Yoshida", &
423  description="order of the yoshida integrator used for the thermostat", &
424  usage="Yoshida integer", &
425  default_i_val=3)
426  CALL section_add_keyword(section, keyword)
427  CALL keyword_release(keyword)
428 
429  CALL keyword_create(keyword, __location__, name="timecon", &
430  description="timeconstant of the thermostat chain", &
431  usage="timecon <REAL>", &
432  default_r_val=cp_unit_to_cp2k(1000.0_dp, "fs"), &
433  unit_str="fs")
434  CALL section_add_keyword(section, keyword)
435  CALL keyword_release(keyword)
436 
437  CALL keyword_create(keyword, __location__, name="mts", &
438  variants=s2a("multiple_time_steps", "mult_t_steps"), &
439  description="number of multiple timesteps to be used for the NoseHoover chain", &
440  usage="mts integer", &
441  default_i_val=2)
442  CALL section_add_keyword(section, keyword)
443  CALL keyword_release(keyword)
444 
445  CALL create_coord_section(subsection, "NOSE HOOVER")
446  CALL section_add_subsection(section, subsection)
447  CALL section_release(subsection)
448 
449  CALL create_velocity_section(subsection, "NOSE HOOVER")
450  CALL section_add_subsection(section, subsection)
451  CALL section_release(subsection)
452 
453  CALL create_mass_section(subsection, "NOSE HOOVER")
454  CALL section_add_subsection(section, subsection)
455  CALL section_release(subsection)
456 
457  CALL create_force_section(subsection, "NOSE HOOVER")
458  CALL section_add_subsection(section, subsection)
459  CALL section_release(subsection)
460 
461  END SUBROUTINE create_nose_section
462 
463 ! **************************************************************************************************
464 !> \brief ...
465 !> \param section ...
466 !> \param
467 !> \author
468 ! **************************************************************************************************
469  SUBROUTINE create_gle_section(section)
470  TYPE(section_type), POINTER :: section
471 
472  TYPE(keyword_type), POINTER :: keyword
473  TYPE(section_type), POINTER :: subsection
474 
475  cpassert(.NOT. ASSOCIATED(section))
476  CALL section_create(section, __location__, name="GLE", &
477  description="paramameters of the gle thermostat. This section can be generated "// &
478  "from <https://gle4md.org/index.html?page=matrix>.", &
479  citations=(/ceriotti2009, ceriotti2009b/))
480 
481  NULLIFY (keyword, subsection)
482 
483  CALL keyword_create(keyword, __location__, name="NDIM", &
484  description="Size of the gle matrix", usage="NDIM 6", &
485  default_i_val=5)
486  CALL section_add_keyword(section, keyword)
487  CALL keyword_release(keyword)
488 
489  CALL keyword_create(keyword, __location__, name="A_SCALE", &
490  description="scaling factor for matrix A (for generic matrix A, depends "// &
491  "on the characteristic frequency of the system).", usage="A_SCALE 0.5", &
492  default_r_val=cp_unit_to_cp2k(1.0_dp, "ps^-1"), unit_str="ps^-1")
493  CALL section_add_keyword(section, keyword)
494  CALL keyword_release(keyword)
495 
496  CALL keyword_create(keyword, __location__, name="A_LIST", &
497  description="A matrix The defaults give optimal sampling for most "// &
498  "cristalline and liquid compounds. Generated with the parameters set kv_4-4.a "// &
499  "centered on w_0=40 cm^-1.", usage="A_LIST real real real", &
500  type_of_var=real_t, unit_str="internal_cp2k", &
501  n_var=-1, repeats=.true.)
502 ! default_r_vals=(/ &
503 ! 1.859575861256e+2_dp, 2.726385349840e-1_dp, 1.152610045461e+1_dp, -3.641457826260e+1_dp, 2.317337581602e+2_dp, &
504 ! -2.780952471206e-1_dp, 8.595159180871e-5_dp, 7.218904801765e-1_dp, -1.984453934386e-1_dp, 4.240925758342e-1_dp, &
505 ! -1.482580813121e+1_dp, -7.218904801765e-1_dp, 1.359090212128e+0_dp, 5.149889628035e+0_dp, -9.994926845099e+0_dp, &
506 ! -1.037218912688e+1_dp, 1.984453934386e-1_dp, -5.149889628035e+0_dp, 2.666191089117e+1_dp, 1.150771549531e+1_dp, &
507 ! 2.180134636042e+2_dp, -4.240925758342e-1_dp, 9.994926845099e+0_dp, -1.150771549531e+1_dp, 3.095839456559e+2_dp /), &
508  CALL section_add_keyword(section, keyword)
509  CALL keyword_release(keyword)
510 
511  CALL keyword_create(keyword, __location__, name="C_LIST", &
512  description="C matrix", usage="C_LIST real real real", &
513  unit_str="K_e", &
514  type_of_var=real_t, n_var=-1, repeats=.true.)
515  CALL section_add_keyword(section, keyword)
516  CALL keyword_release(keyword)
517 
518  CALL create_thermo_energy_section(subsection)
519  CALL section_add_subsection(section, subsection)
520  CALL section_release(subsection)
521 
522  CALL create_rng_section(subsection)
523  CALL section_add_subsection(section, subsection)
524  CALL section_release(subsection)
525 
526  CALL create_gles_section(subsection)
527  CALL section_add_subsection(section, subsection)
528  CALL section_release(subsection)
529 
530  END SUBROUTINE create_gle_section
531 
532 ! **************************************************************************************************
533 !> \brief Creates the gles section
534 !> \param section the section to create
535 !> \author teo
536 ! **************************************************************************************************
537  SUBROUTINE create_gles_section(section)
538  TYPE(section_type), POINTER :: section
539 
540  TYPE(keyword_type), POINTER :: keyword
541 
542  cpassert(.NOT. ASSOCIATED(section))
543  CALL section_create(section, __location__, name="s", &
544  description="The s variable for GLE used for restart", &
545  n_keywords=1, n_subsections=0, repeats=.false.)
546  NULLIFY (keyword)
547 
548  CALL keyword_create(keyword, __location__, name="_DEFAULT_KEYWORD_", &
549  description="Specify s variable for GLE thermostat ", repeats=.false., &
550  usage="{Real} ...", type_of_var=real_t, n_var=-1)
551  CALL section_add_keyword(section, keyword)
552  CALL keyword_release(keyword)
553 
554  END SUBROUTINE create_gles_section
555 
556 ! **************************************************************************************************
557 !> \brief ...
558 !> \param section will contain the ewald section
559 !> \author teo [tlaino] - University of Zurich - 09.2007
560 ! **************************************************************************************************
561  SUBROUTINE create_csvr_section(section)
562  TYPE(section_type), POINTER :: section
563 
564  TYPE(keyword_type), POINTER :: keyword
565  TYPE(section_type), POINTER :: subsection
566 
567  cpassert(.NOT. ASSOCIATED(section))
568  CALL section_create(section, __location__, name="csvr", &
569  description="Parameters of the canonical sampling through velocity rescaling thermostat.", &
570  citations=(/bussi2007/))
571 
572  NULLIFY (keyword, subsection)
573 
574  CALL keyword_create(keyword, __location__, name="timecon", &
575  description="Time constant of the CSVR thermostat. A small time "// &
576  "constant will result in strong thermostatting (useful for "// &
577  "initial equilibrations) and a large time constant would be adequate "// &
578  "to get weak thermostatting in production runs.", &
579  usage="timecon <REAL>", &
580  default_r_val=cp_unit_to_cp2k(1000.0_dp, "fs"), &
581  unit_str="fs")
582  CALL section_add_keyword(section, keyword)
583  CALL keyword_release(keyword)
584 
585  CALL create_thermo_energy_section(subsection)
586  CALL section_add_subsection(section, subsection)
587  CALL section_release(subsection)
588 
589  CALL create_rng_section(subsection)
590  CALL section_add_subsection(section, subsection)
591  CALL section_release(subsection)
592 
593  END SUBROUTINE create_csvr_section
594 
595 ! **************************************************************************************************
596 !> \brief ...
597 !> \param section will contain the adaptive langevin section
598 !> \author Noam [bernstei]
599 ! **************************************************************************************************
600  SUBROUTINE create_al_section(section)
601  TYPE(section_type), POINTER :: section
602 
603  TYPE(keyword_type), POINTER :: keyword
604  TYPE(section_type), POINTER :: subsection
605 
606  cpassert(.NOT. ASSOCIATED(section))
607  CALL section_create(section, __location__, name="ad_langevin", &
608  description="Parameters of the adaptive-Langevin thermostat."// &
609  " Known to work with NVT ensemble, but not tested with"// &
610  " other ensembles. Also tested with FIXED_ATOMS constraints, but"// &
611  " may not work with other constraints (restraints should be OK, but"// &
612  " haven't been well tested)", &
613  citations=(/jones2011/))
614 
615  NULLIFY (keyword, subsection)
616 
617  CALL keyword_create(keyword, __location__, name="timecon_nh", &
618  description="Time constant of the Nose-Hoover part of the AD_LANGEVIN thermostat. A small time "// &
619  "constant will result in strong thermostatting (useful for "// &
620  "initial equilibrations) and a large time constant would be adequate "// &
621  "to get weak thermostatting in production runs.", &
622  usage="timecon_nh <REAL>", &
623  default_r_val=cp_unit_to_cp2k(1000.0_dp, "fs"), &
624  unit_str="fs")
625  CALL section_add_keyword(section, keyword)
626  CALL keyword_release(keyword)
627 
628  CALL keyword_create(keyword, __location__, name="timecon_langevin", &
629  description="Time constant of the Langevin part of the AD_LANGEVIN thermostat. A small time "// &
630  "constant will result in strong thermostatting (useful for "// &
631  "initial equilibrations) and a large time constant would be adequate "// &
632  "to get weak thermostatting in production runs.", &
633  usage="timecon_langevin <REAL>", &
634  default_r_val=cp_unit_to_cp2k(1000.0_dp, "fs"), &
635  unit_str="fs")
636  CALL section_add_keyword(section, keyword)
637  CALL keyword_release(keyword)
638 
639  CALL create_thermo_chi_mass_section(subsection, "CHI")
640  CALL section_add_subsection(section, subsection)
641  CALL section_release(subsection)
642 
643  CALL create_thermo_chi_mass_section(subsection, "MASS")
644  CALL section_add_subsection(section, subsection)
645  CALL section_release(subsection)
646 
647  END SUBROUTINE create_al_section
648 
649 ! **************************************************************************************************
650 !> \brief Creates the thermostat chi restarting section
651 !> \param section the section to create
652 !> \param sec_name ...
653 !> \author teo
654 ! **************************************************************************************************
655  SUBROUTINE create_thermo_chi_mass_section(section, sec_name)
656  TYPE(section_type), POINTER :: section
657  CHARACTER(len=*) :: sec_name
658 
659  TYPE(keyword_type), POINTER :: keyword
660 
661  cpassert(.NOT. ASSOCIATED(section))
662  CALL section_create(section, __location__, name=trim(sec_name), &
663  description="Information to initialize the Ad-Langevin thermostat DOF "//trim(sec_name), &
664  n_keywords=1, n_subsections=0, repeats=.false.)
665  NULLIFY (keyword)
666 
667  CALL keyword_create(keyword, __location__, name="_DEFAULT_KEYWORD_", &
668  description="Specify an initial thermostat DOF "//trim(sec_name)// &
669  " for Ad-Langevin thermostat.", repeats=.true., &
670  unit_str="fs^-1", type_of_var=real_t)
671  CALL section_add_keyword(section, keyword)
672  CALL keyword_release(keyword)
673 
674  END SUBROUTINE create_thermo_chi_mass_section
675 
676 ! **************************************************************************************************
677 !> \brief Creates the thermostat energy restarting section
678 !> \param section the section to create
679 !> \author teo
680 ! **************************************************************************************************
681  SUBROUTINE create_thermo_energy_section(section)
682  TYPE(section_type), POINTER :: section
683 
684  TYPE(keyword_type), POINTER :: keyword
685 
686  cpassert(.NOT. ASSOCIATED(section))
687  CALL section_create(section, __location__, name="THERMOSTAT_ENERGY", &
688  description="Information to initialize the CSVR thermostat energy.", &
689  n_keywords=1, n_subsections=0, repeats=.false.)
690  NULLIFY (keyword)
691 
692  CALL keyword_create(keyword, __location__, name="_DEFAULT_KEYWORD_", &
693  description="Specify an initial thermostat energy for CSVR thermostat.", &
694  repeats=.true., unit_str="internal_cp2k", type_of_var=real_t)
695  CALL section_add_keyword(section, keyword)
696  CALL keyword_release(keyword)
697 
698  END SUBROUTINE create_thermo_energy_section
699 
700 ! **************************************************************************************************
701 !> \brief Creates the mass section
702 !> \param section the section to create
703 !> \param name ...
704 !> \author teo
705 ! **************************************************************************************************
706  SUBROUTINE create_force_section(section, name)
707  TYPE(section_type), POINTER :: section
708  CHARACTER(LEN=*), INTENT(IN) :: name
709 
710  TYPE(keyword_type), POINTER :: keyword
711 
712  cpassert(.NOT. ASSOCIATED(section))
713  CALL section_create(section, __location__, name="force", &
714  description="The forces for "//trim(name)//" used for restart", &
715  n_keywords=1, n_subsections=0, repeats=.false.)
716  NULLIFY (keyword)
717 
718  CALL keyword_create(keyword, __location__, name="_DEFAULT_KEYWORD_", &
719  description="Specify masses of the system", repeats=.false., &
720  usage="{Real} ...", type_of_var=real_t, n_var=-1)
721  CALL section_add_keyword(section, keyword)
722  CALL keyword_release(keyword)
723 
724  END SUBROUTINE create_force_section
725 
726 ! **************************************************************************************************
727 !> \brief Creates the mass section
728 !> \param section the section to create
729 !> \param name ...
730 !> \author teo
731 ! **************************************************************************************************
732  SUBROUTINE create_mass_section(section, name)
733  TYPE(section_type), POINTER :: section
734  CHARACTER(LEN=*), INTENT(IN) :: name
735 
736  TYPE(keyword_type), POINTER :: keyword
737 
738  cpassert(.NOT. ASSOCIATED(section))
739  CALL section_create(section, __location__, name="mass", &
740  description="The masses for "//trim(name)//" used for restart", &
741  n_keywords=1, n_subsections=0, repeats=.false.)
742  NULLIFY (keyword)
743 
744  CALL keyword_create(keyword, __location__, name="_DEFAULT_KEYWORD_", &
745  description="Specify masses of the system", repeats=.false., &
746  usage="{Real} ...", type_of_var=real_t, n_var=-1)
747  CALL section_add_keyword(section, keyword)
748  CALL keyword_release(keyword)
749 
750  END SUBROUTINE create_mass_section
751 
752 ! **************************************************************************************************
753 !> \brief Creates the velocity section
754 !> \param section the section to create
755 !> \param name ...
756 !> \author teo
757 ! **************************************************************************************************
758  SUBROUTINE create_velocity_section(section, name)
759  TYPE(section_type), POINTER :: section
760  CHARACTER(LEN=*), INTENT(IN) :: name
761 
762  TYPE(keyword_type), POINTER :: keyword
763 
764  cpassert(.NOT. ASSOCIATED(section))
765  CALL section_create(section, __location__, name="velocity", &
766  description="The velocities for "//trim(name)//" used for restart", &
767  n_keywords=1, n_subsections=0, repeats=.false.)
768  NULLIFY (keyword)
769 
770  CALL keyword_create(keyword, __location__, name="_DEFAULT_KEYWORD_", &
771  description="Specify velocities of the system", repeats=.true., &
772  usage="{Real} ...", type_of_var=real_t, n_var=-1)
773  CALL section_add_keyword(section, keyword)
774  CALL keyword_release(keyword)
775 
776  END SUBROUTINE create_velocity_section
777 
778 ! **************************************************************************************************
779 !> \brief Creates the coord section
780 !> \param section the section to create
781 !> \param name ...
782 !> \author teo
783 ! **************************************************************************************************
784  SUBROUTINE create_coord_section(section, name)
785  TYPE(section_type), POINTER :: section
786  CHARACTER(LEN=*), INTENT(IN) :: name
787 
788  TYPE(keyword_type), POINTER :: keyword
789 
790  cpassert(.NOT. ASSOCIATED(section))
791  CALL section_create(section, __location__, name="coord", &
792  description="The positions for "//trim(name)//" used for restart", &
793  n_keywords=1, n_subsections=0, repeats=.false.)
794  NULLIFY (keyword)
795 
796  CALL keyword_create(keyword, __location__, name="_DEFAULT_KEYWORD_", &
797  description="Specify positions of the system", repeats=.true., &
798  usage="{Real} ...", type_of_var=real_t, n_var=-1)
799  CALL section_add_keyword(section, keyword)
800  CALL keyword_release(keyword)
801 
802  END SUBROUTINE create_coord_section
803 
804 END MODULE input_cp2k_thermostats
collects all references to literature in CP2K as new algorithms / method are included from literature...
Definition: bibliography.F:28
integer, save, public nose1984a
Definition: bibliography.F:43
integer, save, public ceriotti2009
Definition: bibliography.F:43
integer, save, public jones2011
Definition: bibliography.F:43
integer, save, public nose1984b
Definition: bibliography.F:43
integer, save, public bussi2007
Definition: bibliography.F:43
integer, save, public ceriotti2009b
Definition: bibliography.F:43
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
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_thermo_nose
integer, parameter, public do_constr_atomic
integer, parameter, public do_region_molecule
integer, parameter, public do_thermo_al
integer, parameter, public do_constr_molec
integer, parameter, public do_thermo_csvr
integer, parameter, public do_thermo_gle
integer, parameter, public do_region_massive
integer, parameter, public do_region_global
integer, parameter, public do_region_defined
integer, parameter, public do_constr_none
integer, parameter, public do_region_none
integer, parameter, public do_thermo_same_as_part
builds the subsystem section of the input
subroutine, public create_rng_section(section)
Creates the random number restart section.
subroutine, public create_thermo_fast_section(section, coupled_thermostat)
Specifies parameter for thermostat for constant temperature ensembles.
subroutine, public create_thermo_slow_section(section, coupled_thermostat)
Specifies parameter for thermostat for constant temperature ensembles.
subroutine, public create_mass_section(section, name)
Creates the mass section.
subroutine, public create_gle_section(section)
...
subroutine, public create_coord_section(section, name)
Creates the coord section.
subroutine, public create_thermostat_section(section, coupled_thermostat)
Specifies parameter for thermostat for constant temperature ensembles.
subroutine, public create_region_section(section, label)
Creates a section to arbitrary define a region to thermostat.
subroutine, public create_velocity_section(section, name)
Creates the velocity 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 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.