(git:04040e4)
Loading...
Searching...
No Matches
input_cp2k_mm.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief creates the mm section of the input
10!> \note
11!> moved out of input_cp2k
12!> \par History
13!> 04.2004 created
14!> \author fawzi
15! **************************************************************************************************
17 USE bibliography, ONLY: &
27 USE cp_units, ONLY: cp_unit_to_cp2k
28 USE force_field_kind_types, ONLY: &
46 USE input_val_types, ONLY: char_t,&
47 integer_t,&
48 lchar_t,&
49 real_t
50 USE kinds, ONLY: default_string_length,&
51 dp
52 USE string_utilities, ONLY: newline,&
53 s2a
54#include "./base/base_uses.f90"
55
56 IMPLICIT NONE
57 PRIVATE
58
59 LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .true.
60 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_cp2k_mm'
61
66 PUBLIC :: create_charge_section
67!***
68CONTAINS
69
70! **************************************************************************************************
71!> \brief Create the input section for FIST.. Come on.. Let's get woohooo
72!> \param section the section to create
73!> \author teo
74! **************************************************************************************************
75 SUBROUTINE create_mm_section(section)
76 TYPE(section_type), POINTER :: section
77
78 TYPE(section_type), POINTER :: subsection
79
80 cpassert(.NOT. ASSOCIATED(section))
81 CALL section_create(section, __location__, name="mm", &
82 description="This section contains all information to run a MM calculation.", &
83 n_keywords=5, n_subsections=0, repeats=.false.)
84
85 NULLIFY (subsection)
86
87 CALL create_forcefield_section(subsection)
88 CALL section_add_subsection(section, subsection)
89 CALL section_release(subsection)
90
91 CALL create_neighbor_lists_section(subsection)
92 CALL section_add_subsection(section, subsection)
93 CALL section_release(subsection)
94
95 CALL create_poisson_section(subsection)
96 CALL section_add_subsection(section, subsection)
97 CALL section_release(subsection)
98
99 CALL create_per_efield_section(subsection)
100 CALL section_add_subsection(section, subsection)
101 CALL section_release(subsection)
102
103 CALL create_print_mm_section(subsection)
104 CALL section_add_subsection(section, subsection)
105 CALL section_release(subsection)
106
107 END SUBROUTINE create_mm_section
108
109! **************************************************************************************************
110!> \brief Create the print mm section
111!> \param section the section to create
112!> \author teo
113! **************************************************************************************************
114 SUBROUTINE create_print_mm_section(section)
115 TYPE(section_type), POINTER :: section
116
117 TYPE(keyword_type), POINTER :: keyword
118 TYPE(section_type), POINTER :: print_key
119
120 cpassert(.NOT. ASSOCIATED(section))
121 CALL section_create(section, __location__, name="print", &
122 description="Section of possible print options in MM code.", &
123 n_keywords=0, n_subsections=1, repeats=.false.)
124
125 NULLIFY (print_key, keyword)
126
127 CALL cp_print_key_section_create(print_key, __location__, "DERIVATIVES", &
128 description="Controls the printing of derivatives.", &
129 print_level=high_print_level, filename="__STD_OUT__")
130 CALL section_add_subsection(section, print_key)
131 CALL section_release(print_key)
132
133 CALL cp_print_key_section_create(print_key, __location__, "EWALD_INFO", &
134 description="Controls the printing of Ewald energy components during the "// &
135 "evaluation of the electrostatics.", &
136 print_level=high_print_level, filename="__STD_OUT__")
137 CALL section_add_subsection(section, print_key)
138 CALL section_release(print_key)
139
140 CALL create_dipoles_section(print_key, "DIPOLE", medium_print_level)
141 CALL section_add_subsection(section, print_key)
142 CALL section_release(print_key)
143
144 CALL cp_print_key_section_create(print_key, __location__, "NEIGHBOR_LISTS", &
145 description="Activates the printing of the neighbor lists.", &
146 print_level=high_print_level, filename="", unit_str="angstrom")
147 CALL section_add_subsection(section, print_key)
148 CALL section_release(print_key)
149
150 CALL cp_print_key_section_create(print_key, __location__, "ITER_INFO", &
151 description="Activates the printing of iteration info during the self-consistent "// &
152 "calculation of a polarizable forcefield.", &
153 print_level=medium_print_level, filename="__STD_OUT__")
154 CALL section_add_subsection(section, print_key)
155 CALL section_release(print_key)
156
157 CALL cp_print_key_section_create(print_key, __location__, "SUBCELL", &
158 description="Activates the printing of the subcells used for the "// &
159 "generation of neighbor lists.", &
160 print_level=high_print_level, filename="__STD_OUT__")
161 CALL section_add_subsection(section, print_key)
162 CALL section_release(print_key)
163
164 CALL cp_print_key_section_create(print_key, __location__, "PROGRAM_BANNER", &
165 description="Controls the printing of the banner of the MM program", &
166 print_level=silent_print_level, filename="__STD_OUT__")
167 CALL section_add_subsection(section, print_key)
168 CALL section_release(print_key)
169
170 CALL cp_print_key_section_create(print_key, __location__, "PROGRAM_RUN_INFO", &
171 description="Controls the printing of information regarding the run.", &
172 print_level=low_print_level, filename="__STD_OUT__")
173 CALL section_add_subsection(section, print_key)
174 CALL section_release(print_key)
175
176 CALL cp_print_key_section_create(print_key, __location__, "FF_PARAMETER_FILE", description= &
177 "Controls the printing of Force Field parameter file", &
178 print_level=debug_print_level + 1, filename="", common_iter_levels=2)
179 CALL section_add_subsection(section, print_key)
180 CALL section_release(print_key)
181
182 CALL cp_print_key_section_create(print_key, __location__, "FF_INFO", description= &
183 "Controls the printing of information in the forcefield settings", &
184 print_level=high_print_level, filename="__STD_OUT__")
185
186 CALL keyword_create(keyword, __location__, name="spline_info", &
187 description="if the printkey is active prints information regarding the splines"// &
188 " used in the nonbonded interactions", &
189 default_l_val=.true., lone_keyword_l_val=.true.)
190 CALL section_add_keyword(print_key, keyword)
191 CALL keyword_release(keyword)
192
193 CALL keyword_create(keyword, __location__, name="spline_data", &
194 description="if the printkey is active prints on separated files the splined function"// &
195 " together with the reference one. Useful to check the spline behavior.", &
196 default_l_val=.false., lone_keyword_l_val=.true.)
197 CALL section_add_keyword(print_key, keyword)
198 CALL keyword_release(keyword)
199
200 CALL section_add_subsection(section, print_key)
201 CALL section_release(print_key)
202
203 END SUBROUTINE create_print_mm_section
204
205! **************************************************************************************************
206!> \brief Create the forcefield section. This section is useful to set up the
207!> proper force_field for FIST calculations
208!> \param section the section to create
209!> \author teo
210! **************************************************************************************************
211 SUBROUTINE create_forcefield_section(section)
212 TYPE(section_type), POINTER :: section
213
214 TYPE(keyword_type), POINTER :: keyword
215 TYPE(section_type), POINTER :: subsection
216
217 cpassert(.NOT. ASSOCIATED(section))
218 CALL section_create(section, __location__, name="FORCEFIELD", &
219 description="Section specifying information regarding how to set up properly"// &
220 " a force_field for the classical calculations.", &
221 n_keywords=2, n_subsections=2, repeats=.false.)
222
223 NULLIFY (subsection, keyword)
224
225 CALL keyword_create( &
226 keyword, __location__, name="PARMTYPE", &
227 description="Define the kind of torsion potential", &
228 usage="PARMTYPE {OFF,CHM,G87,G96}", &
229 enum_c_vals=s2a("OFF", "CHM", "G87", "G96", "AMBER"), &
230 enum_desc=s2a("Provides force field parameters through the input file", &
231 "Provides force field parameters through an external file with CHARMM format", &
232 "Provides force field parameters through an external file with GROMOS 87 format", &
233 "Provides force field parameters through an external file with GROMOS 96 format", &
234 "Provides force field parameters through an external file with AMBER format (from v.8 on)"), &
235 enum_i_vals=[do_ff_undef, &
236 do_ff_charmm, &
237 do_ff_g87, &
238 do_ff_g96, &
239 do_ff_amber], &
240 default_i_val=do_ff_undef)
241 CALL section_add_keyword(section, keyword)
242 CALL keyword_release(keyword)
243
244 CALL keyword_create(keyword, __location__, name="PARM_FILE_NAME", &
245 description="Specifies the filename that contains the parameters of the FF.", &
246 usage="PARM_FILE_NAME {FILENAME}", type_of_var=lchar_t)
247 CALL section_add_keyword(section, keyword)
248 CALL keyword_release(keyword)
249
250 CALL keyword_create(keyword, __location__, name="VDW_SCALE14", &
251 description="Scaling factor for the VDW 1-4 ", &
252 usage="VDW_SCALE14 1.0", default_r_val=1.0_dp)
253 CALL section_add_keyword(section, keyword)
254 CALL keyword_release(keyword)
255
256 CALL keyword_create(keyword, __location__, name="EI_SCALE14", &
257 description="Scaling factor for the electrostatics 1-4 ", &
258 usage="EI_SCALE14 1.0", default_r_val=0.0_dp)
259 CALL section_add_keyword(section, keyword)
260 CALL keyword_release(keyword)
261
262 CALL keyword_create(keyword, __location__, name="SHIFT_CUTOFF", &
263 description="Add a constant energy shift to the real-space "// &
264 "non-bonding interactions (both Van der Waals and "// &
265 "electrostatic) such that the energy at the cutoff radius is "// &
266 "zero. This makes the non-bonding interactions continuous at "// &
267 "the cutoff.", &
268 usage="SHIFT_CUTOFF <LOGICAL>", default_l_val=.true.)
269 CALL section_add_keyword(section, keyword)
270 CALL keyword_release(keyword)
271
272 CALL keyword_create(keyword, __location__, name="DO_NONBONDED", &
273 description="Controls the computation of all the real-space "// &
274 "(short-range) nonbonded interactions. This also "// &
275 "includes the real-space corrections for excluded "// &
276 "or scaled 1-2, 1-3 and 1-4 interactions. When set "// &
277 "to F, the neighborlists are not created and all "// &
278 "interactions that depend on them are not computed.", &
279 usage="DO_NONBONDED T", default_l_val=.true., lone_keyword_l_val=.true.)
280 CALL section_add_keyword(section, keyword)
281 CALL keyword_release(keyword)
282
283 CALL keyword_create(keyword, __location__, name="DO_ELECTROSTATICS", &
284 description="Controls the computation of all the real-space "// &
285 "(short-range) electrostatics interactions. This does not "// &
286 "affect the QM/MM electrostatic coupling when turned off.", &
287 usage="DO_ELECTROSTATICS T", default_l_val=.true., lone_keyword_l_val=.true.)
288 CALL section_add_keyword(section, keyword)
289 CALL keyword_release(keyword)
290
291 CALL keyword_create(keyword, __location__, name="IGNORE_MISSING_CRITICAL_PARAMS", &
292 description="Do not abort when critical force-field parameters "// &
293 "are missing. CP2K will run as if the terms containing the "// &
294 "missing parameters are zero.", &
295 usage="IGNORE_MISSING_CRITICAL_PARAMS .TRUE.", default_l_val=.false., &
296 lone_keyword_l_val=.true.)
297 CALL section_add_keyword(section, keyword)
298 CALL keyword_release(keyword)
299
300 CALL keyword_create(keyword, __location__, name="MULTIPLE_POTENTIAL", &
301 description="Enables the possibility to define NONBONDED and NONBONDED14 as a"// &
302 " sum of different kinds of potential. Useful for piecewise defined potentials.", &
303 usage="MULTIPLE_POTENTIAL T", default_l_val=.false., lone_keyword_l_val=.true.)
304 CALL section_add_keyword(section, keyword)
305 CALL keyword_release(keyword)
306 !Universal scattering potential at very short distances
307 CALL keyword_create(keyword, __location__, name="ZBL_SCATTERING", &
308 description="A short range repulsive potential is added, to simulate "// &
309 "collisions and scattering.", &
310 usage="ZBL_SCATTERING T", default_l_val=.false., lone_keyword_l_val=.true.)
311 CALL section_add_keyword(section, keyword)
312 CALL keyword_release(keyword)
313
314 !
315 ! subsections
316 !
317 CALL create_spline_section(subsection)
318 CALL section_add_subsection(section, subsection)
319 CALL section_release(subsection)
320
321 CALL create_nonbonded_section(subsection)
322 CALL section_add_subsection(section, subsection)
323 CALL section_release(subsection)
324
325 CALL create_nonbonded14_section(subsection)
326 CALL section_add_subsection(section, subsection)
327 CALL section_release(subsection)
328
329 CALL create_charge_section(subsection)
330 CALL section_add_subsection(section, subsection)
331 CALL section_release(subsection)
332
333 CALL create_charges_section(subsection)
334 CALL section_add_subsection(section, subsection)
335 CALL section_release(subsection)
336
337 CALL create_shell_section(subsection)
338 CALL section_add_subsection(section, subsection)
339 CALL section_release(subsection)
340
341 CALL create_bond_section(subsection, "BOND")
342 CALL section_add_subsection(section, subsection)
343 CALL section_release(subsection)
344
345 CALL create_bend_section(subsection)
346 CALL section_add_subsection(section, subsection)
347 CALL section_release(subsection)
348
349 CALL create_torsion_section(subsection)
350 CALL section_add_subsection(section, subsection)
351 CALL section_release(subsection)
352
353 CALL create_improper_section(subsection)
354 CALL section_add_subsection(section, subsection)
355 CALL section_release(subsection)
356
357 CALL create_opbend_section(subsection)
358 CALL section_add_subsection(section, subsection)
359 CALL section_release(subsection)
360
361 CALL create_dipole_section(subsection)
362 CALL section_add_subsection(section, subsection)
363 CALL section_release(subsection)
364
365 CALL create_quadrupole_section(subsection)
366 CALL section_add_subsection(section, subsection)
367 CALL section_release(subsection)
368
369 END SUBROUTINE create_forcefield_section
370
371! **************************************************************************************************
372!> \brief This section specifies the parameters for the splines
373!> \param section the section to create
374!> \author teo
375! **************************************************************************************************
376 SUBROUTINE create_spline_section(section)
377 TYPE(section_type), POINTER :: section
378
379 TYPE(keyword_type), POINTER :: keyword
380
381 cpassert(.NOT. ASSOCIATED(section))
382 CALL section_create(section, __location__, name="SPLINE", &
383 description="specifies parameters to set up the splines used in the"// &
384 " nonboned interactions (both pair body potential and many body potential)", &
385 n_keywords=1, n_subsections=0, repeats=.true.)
386
387 NULLIFY (keyword)
388
389 CALL keyword_create(keyword, __location__, name="R0_NB", &
390 description="Specify the minimum value of the distance interval "// &
391 "that brackets the value of emax_spline.", &
392 usage="R0_NB <REAL>", default_r_val=cp_unit_to_cp2k(value=0.9_dp, &
393 unit_str="bohr"), &
394 unit_str="angstrom")
395 CALL section_add_keyword(section, keyword)
396 CALL keyword_release(keyword)
397
398 CALL keyword_create(keyword, __location__, name="RCUT_NB", &
399 description="Cutoff radius for nonbonded interactions. This value overrides"// &
400 " the value specified in the potential definition and is global for all potentials.", &
401 usage="RCUT_NB {real}", default_r_val=cp_unit_to_cp2k(value=-1.0_dp, &
402 unit_str="angstrom"), &
403 unit_str="angstrom")
404 CALL section_add_keyword(section, keyword)
405 CALL keyword_release(keyword)
406
407 CALL keyword_create(keyword, __location__, name="EMAX_SPLINE", &
408 description="Specify the maximum value of the potential up to which"// &
409 " splines will be constructed", &
410 usage="EMAX_SPLINE <REAL>", &
411 default_r_val=0.5_dp, unit_str="hartree")
412 CALL section_add_keyword(section, keyword)
413 CALL keyword_release(keyword)
414
415 CALL keyword_create(keyword, __location__, name="EMAX_ACCURACY", &
416 description="Specify the maximum value of energy used to check the accuracy"// &
417 " requested through EPS_SPLINE. Energy values larger than EMAX_ACCURACY"// &
418 " generally do not satisfy the requested accuracy", &
419 usage="EMAX_ACCURACY <REAL>", default_r_val=0.02_dp, unit_str="hartree")
420 CALL section_add_keyword(section, keyword)
421 CALL keyword_release(keyword)
422
423 CALL keyword_create(keyword, __location__, name="EPS_SPLINE", &
424 description="Specify the threshold for the choice of the number of"// &
425 " points used in the splines (comparing the splined value with the"// &
426 " analytically evaluated one)", &
427 usage="EPS_SPLINE <REAL>", default_r_val=1.0e-7_dp, unit_str="hartree")
428 CALL section_add_keyword(section, keyword)
429 CALL keyword_release(keyword)
430
431 CALL keyword_create( &
432 keyword, __location__, name="NPOINTS", &
433 description="Override the default search for an accurate spline by specifying a fixed number of spline points.", &
434 usage="NPOINTS 1024", default_i_val=-1)
435 CALL section_add_keyword(section, keyword)
436 CALL keyword_release(keyword)
437
438 CALL keyword_create(keyword, __location__, name="UNIQUE_SPLINE", &
439 description="For few potentials (Lennard-Jones) one global optimal spline is generated instead"// &
440 " of different optimal splines for each kind of potential", &
441 usage="UNIQUE_SPLINE <LOGICAL>", lone_keyword_l_val=.true., default_l_val=.false.)
442 CALL section_add_keyword(section, keyword)
443 CALL keyword_release(keyword)
444
445 END SUBROUTINE create_spline_section
446
447! **************************************************************************************************
448!> \brief This section specifies the torsion of the MM atoms
449!> \param section the section to create
450!> \author teo
451! **************************************************************************************************
452 SUBROUTINE create_torsion_section(section)
453 TYPE(section_type), POINTER :: section
454
455 TYPE(keyword_type), POINTER :: keyword
456
457 cpassert(.NOT. ASSOCIATED(section))
458 CALL section_create(section, __location__, name="TORSION", &
459 description="Specifies the torsion potential of the MM system.", &
460 n_keywords=1, n_subsections=0, repeats=.true.)
461
462 NULLIFY (keyword)
463 CALL keyword_create(keyword, __location__, name="ATOMS", &
464 description="Defines the atomic kinds involved in the tors.", &
465 usage="ATOMS {KIND1} {KIND2} {KIND3} {KIND4}", type_of_var=char_t, &
466 n_var=4)
467 CALL section_add_keyword(section, keyword)
468 CALL keyword_release(keyword)
469
470 CALL keyword_create(keyword, __location__, name="KIND", &
471 description="Define the kind of torsion potential", &
472 usage="KIND CHARMM", &
473 enum_c_vals=s2a("CHARMM", "G87", "G96", "AMBER", "OPLS"), &
474 enum_desc=s2a("Functional Form (CHARMM|G87|G96|AMBER): K * [ 1 + cos[M*PHI - PHI0]]", &
475 "Functional Form (CHARMM|G87|G96|AMBER): K * [ 1 + cos[M*PHI - PHI0]]", &
476 "Functional Form (CHARMM|G87|G96|AMBER): K * [ 1 + cos[M*PHI - PHI0]]", &
477 "Functional Form (CHARMM|G87|G96|AMBER): K * [ 1 + cos[M*PHI - PHI0]]", &
478 "Functional Form: K / 2 * [ 1 + (-1)^(M-1) * cos[M*PHI]]"), &
479 enum_i_vals=[do_ff_charmm, &
480 do_ff_g87, &
481 do_ff_g96, &
482 do_ff_amber, &
483 do_ff_opls], &
484 default_i_val=do_ff_charmm)
485 CALL section_add_keyword(section, keyword)
486 CALL keyword_release(keyword)
487
488 CALL keyword_create(keyword, __location__, name="K", &
489 description="Defines the force constant of the potential", &
490 usage="K {real}", type_of_var=real_t, &
491 n_var=1, unit_str="hartree")
492 CALL section_add_keyword(section, keyword)
493 CALL keyword_release(keyword)
494
495 CALL keyword_create(keyword, __location__, name="PHI0", &
496 description="Defines the phase of the potential.", &
497 usage="PHI0 {real}", type_of_var=real_t, &
498 n_var=1, unit_str="rad", default_r_val=0.0_dp)
499 CALL section_add_keyword(section, keyword)
500 CALL keyword_release(keyword)
501
502 CALL keyword_create(keyword, __location__, name="M", &
503 description="Defines the multiplicity of the potential.", &
504 usage="M {integer}", type_of_var=integer_t, &
505 n_var=1)
506 CALL section_add_keyword(section, keyword)
507 CALL keyword_release(keyword)
508
509 END SUBROUTINE create_torsion_section
510
511! **************************************************************************************************
512!> \brief This section specifies the improper torsion of the MM atoms
513!> \param section the section to create
514!> \author louis vanduyfhuys
515! **************************************************************************************************
516 SUBROUTINE create_improper_section(section)
517 TYPE(section_type), POINTER :: section
518
519 TYPE(keyword_type), POINTER :: keyword
520
521 cpassert(.NOT. ASSOCIATED(section))
522 CALL section_create(section, __location__, name="IMPROPER", &
523 description="Specifies the improper torsion potential of the MM system.", &
524 n_keywords=1, n_subsections=0, repeats=.true.)
525
526 NULLIFY (keyword)
527 CALL keyword_create(keyword, __location__, name="ATOMS", &
528 description="Defines the atomic kinds involved in the improper tors.", &
529 usage="ATOMS {KIND1} {KIND2} {KIND3} {KIND4}", type_of_var=char_t, &
530 n_var=4)
531 CALL section_add_keyword(section, keyword)
532 CALL keyword_release(keyword)
533
534 CALL keyword_create(keyword, __location__, name="KIND", &
535 description="Define the kind of improper torsion potential", &
536 usage="KIND CHARMM", &
537 enum_c_vals=s2a("CHARMM", "G87", "G96", "HARMONIC"), &
538 enum_desc=s2a("Functional Form (CHARMM): K * [ PHI - PHI0 ]**2", &
539 "Functional Form (G87|G96|HARMONIC): 0.5 * K * [ PHI - PHI0 ]**2", &
540 "Functional Form (G87|G96|HARMONIC): 0.5 * K * [ PHI - PHI0 ]**2", &
541 "Functional Form (G87|G96|HARMONIC): 0.5 * K * [ PHI - PHI0 ]**2"), &
542 enum_i_vals=[do_ff_charmm, &
543 do_ff_g87, &
544 do_ff_g96, &
546 default_i_val=do_ff_charmm)
547 CALL section_add_keyword(section, keyword)
548 CALL keyword_release(keyword)
549
550 CALL keyword_create(keyword, __location__, name="K", &
551 description="Defines the force constant of the potential", &
552 usage="K {real}", type_of_var=real_t, &
553 n_var=1, unit_str="hartree*rad^-2")
554 CALL section_add_keyword(section, keyword)
555 CALL keyword_release(keyword)
556
557 CALL keyword_create(keyword, __location__, name="PHI0", &
558 description="Defines the phase of the potential.", &
559 usage="PHI0 {real}", type_of_var=real_t, &
560 n_var=1, unit_str="rad")
561 CALL section_add_keyword(section, keyword)
562 CALL keyword_release(keyword)
563
564 END SUBROUTINE create_improper_section
565
566! **************************************************************************************************
567!> \brief This section specifies the out of plane bend of the MM atoms
568!> \param section the section to create
569!> \author louis vanduyfhuys
570! **************************************************************************************************
571 SUBROUTINE create_opbend_section(section)
572 TYPE(section_type), POINTER :: section
573
574 TYPE(keyword_type), POINTER :: keyword
575
576 cpassert(.NOT. ASSOCIATED(section))
577 CALL section_create(section, __location__, name="OPBEND", &
578 description="Specifies the out of plane bend potential of the MM system."// &
579 " (Only defined for atom quadruples which are also defined as an improper"// &
580 " pattern in the topology.)", &
581 n_keywords=1, n_subsections=0, repeats=.true.)
582
583 NULLIFY (keyword)
584 CALL keyword_create(keyword, __location__, name="ATOMS", &
585 description="Defines the atomic kinds involved in the opbend.", &
586 usage="ATOMS {KIND1} {KIND2} {KIND3} {KIND4}", type_of_var=char_t, &
587 n_var=4)
588 CALL section_add_keyword(section, keyword)
589 CALL keyword_release(keyword)
590
591 CALL keyword_create(keyword, __location__, name="KIND", &
592 description="Define the kind of out of plane bend potential", &
593 usage="KIND HARMONIC", &
594 enum_c_vals=s2a("HARMONIC", "MM2", "MM3", "MM4"), &
595 enum_desc=s2a("Functional Form (HARMONIC): 0.5 * K * [ PHI - PHI0 ]**2", &
596 "Functional Form (MM2|MM3|MM4): K * [ PHI - PHI0 ]**2", &
597 "Functional Form (MM2|MM3|MM4): K * [ PHI - PHI0 ]**2", &
598 "Functional Form (MM2|MM3|MM4): K * [ PHI - PHI0 ]**2"), &
599 enum_i_vals=[do_ff_harmonic, &
600 do_ff_mm2, &
601 do_ff_mm3, &
602 do_ff_mm4], &
603 default_i_val=do_ff_harmonic)
604 CALL section_add_keyword(section, keyword)
605 CALL keyword_release(keyword)
606
607 CALL keyword_create(keyword, __location__, name="K", &
608 description="Defines the force constant of the potential", &
609 usage="K {real}", type_of_var=real_t, &
610 n_var=1, unit_str="hartree*rad^-2")
611 CALL section_add_keyword(section, keyword)
612 CALL keyword_release(keyword)
613
614 CALL keyword_create(keyword, __location__, name="PHI0", &
615 description="Defines the phase of the potential.", &
616 usage="PHI0 {real}", type_of_var=real_t, &
617 n_var=1, unit_str="rad")
618 CALL section_add_keyword(section, keyword)
619 CALL keyword_release(keyword)
620
621 END SUBROUTINE create_opbend_section
622
623! **************************************************************************************************
624!> \brief This section specifies the bend of the MM atoms
625!> \param section the section to create
626!> \author teo
627! **************************************************************************************************
628 SUBROUTINE create_bend_section(section)
629 TYPE(section_type), POINTER :: section
630
631 TYPE(keyword_type), POINTER :: keyword
632 TYPE(section_type), POINTER :: subsection
633
634 cpassert(.NOT. ASSOCIATED(section))
635 CALL section_create(section, __location__, name="BEND", &
636 description="Specifies the bend potential of the MM system.", &
637 n_keywords=11, n_subsections=1, repeats=.true.)
638
639 NULLIFY (keyword, subsection)
640
641 CALL keyword_create(keyword, __location__, name="ATOMS", &
642 description="Defines the atomic kinds involved in the bend.", &
643 usage="ATOMS {KIND1} {KIND2} {KIND3}", type_of_var=char_t, &
644 n_var=3)
645 CALL section_add_keyword(section, keyword)
646 CALL keyword_release(keyword)
647
648 CALL keyword_create( &
649 keyword, __location__, name="KIND", &
650 description="Define the kind of bend potential", &
651 usage="KIND HARMONIC", &
652 enum_c_vals=s2a("HARMONIC", "CHARMM", "AMBER", "G87", "G96", "CUBIC", "MIXED_BEND_STRETCH", "MM3", &
653 "LEGENDRE"), &
654 enum_desc=s2a("Functional Form (HARMONIC|G87): 1/2*K*(THETA-THETA0)^2", &
655 "Functional Form (CHARMM|AMBER): K*(THETA-THETA0)^2", &
656 "Functional Form (CHARMM|AMBER): K*(THETA-THETA0)^2", &
657 "Functional Form (HARMONIC|G87): 1/2*K*(THETA-THETA0)^2", &
658 "Functional Form (G96): 1/2*K*(COS(THETA)-THETA0)^2", &
659 "Functional Form (CUBIC): K*(THETA-THETA0)**2*(1+CB*(THETA-THETA0))", &
660 "Functional Form (MIXED_BEND_STRETCH): K*(THETA-THETA0)**2*(1+CB*(THETA-THETA0))+"// &
661 " KSS*(R12-R012)*(R32-R032)+KBS12*(R12-R012)*(THETA-THETA0)+KBS32*(R32-R032)*(THETA-THETA0)", &
662 "Functional Form (MM3): 1/2*K*(THETA-THETA0)**2*(1-0.014*(THETA-THETA0)+5.6E-5*(THETA-THETA0)**2"// &
663 " -7.0E-7*(THETA-THETA0)**3+9.0E-10*(THETA-THETA0)**4)+KBS12*(R12-R012)*(THETA-THETA0)+"// &
664 " KBS32*(R32-R032)*(THETA-THETA0)", &
665 "Functional Form (LEGENDRE): sum_{i=0}^N c_i*P_i(COS(THETA)) "), &
666 enum_i_vals=[do_ff_harmonic, &
667 do_ff_charmm, &
668 do_ff_amber, &
669 do_ff_g87, &
670 do_ff_g96, &
671 do_ff_cubic, &
673 do_ff_mm3, &
675 default_i_val=do_ff_charmm)
676 CALL section_add_keyword(section, keyword)
677 CALL keyword_release(keyword)
678
679 CALL keyword_create(keyword, __location__, name="K", &
680 description="Defines the force constant of the potential", &
681 usage="K {real}", type_of_var=real_t, &
682 n_var=1, unit_str="hartree*rad^-2")
683 CALL section_add_keyword(section, keyword)
684 CALL keyword_release(keyword)
685
686 CALL keyword_create(keyword, __location__, name="CB", &
687 description="Defines the the cubic force constant of the bend", &
688 usage="CB {real}", default_r_val=0.0_dp, type_of_var=real_t, &
689 n_var=1, unit_str="rad^-1")
690 CALL section_add_keyword(section, keyword)
691 CALL keyword_release(keyword)
692
693 CALL keyword_create(keyword, __location__, name="R012", &
694 description="Mixed bend stretch parameter", &
695 usage="R012 {real}", default_r_val=0.0_dp, type_of_var=real_t, &
696 n_var=1, unit_str="bohr")
697 CALL section_add_keyword(section, keyword)
698 CALL keyword_release(keyword)
699 CALL keyword_create(keyword, __location__, name="R032", &
700 description="Mixed bend stretch parameter", &
701 usage="R032 {real}", default_r_val=0.0_dp, type_of_var=real_t, &
702 n_var=1, unit_str="bohr")
703 CALL section_add_keyword(section, keyword)
704 CALL keyword_release(keyword)
705 CALL keyword_create(keyword, __location__, name="KBS12", &
706 description="Mixed bend stretch parameter", &
707 usage="KBS12 {real}", default_r_val=0.0_dp, type_of_var=real_t, &
708 n_var=1, unit_str="hartree*bohr^-1*rad^-1")
709 CALL section_add_keyword(section, keyword)
710 CALL keyword_release(keyword)
711 CALL keyword_create(keyword, __location__, name="KBS32", &
712 description="Mixed bend stretch parameter", &
713 usage="KBS32 {real}", default_r_val=0.0_dp, type_of_var=real_t, &
714 n_var=1, unit_str="hartree*bohr^-1*rad^-1")
715 CALL section_add_keyword(section, keyword)
716 CALL keyword_release(keyword)
717 CALL keyword_create(keyword, __location__, name="KSS", &
718 description="Mixed bend stretch parameter", &
719 usage="KSS {real}", default_r_val=0.0_dp, type_of_var=real_t, &
720 n_var=1, unit_str="hartree*bohr^-2")
721 CALL section_add_keyword(section, keyword)
722 CALL keyword_release(keyword)
723
724 CALL keyword_create(keyword, __location__, name="THETA0", &
725 description="Defines the equilibrium angle.", &
726 usage="THETA0 {real}", type_of_var=real_t, &
727 n_var=1, unit_str='rad')
728 CALL section_add_keyword(section, keyword)
729 CALL keyword_release(keyword)
730
731 CALL keyword_create(keyword, __location__, name="LEGENDRE", &
732 description="Specifies the coefficients for the legendre"// &
733 " expansion of the bending potential."// &
734 " 'THETA0' and 'K' are not used, but need to be specified."// &
735 " Use an arbitrary value.", usage="LEGENDRE {REAL} {REAL} ...", &
736 default_r_val=0.0d0, type_of_var=real_t, &
737 n_var=-1, unit_str="hartree")
738 CALL section_add_keyword(section, keyword)
739 CALL keyword_release(keyword)
740
741 ! Create the Urey-Bradley section
742 CALL create_bond_section(subsection, "UB")
743 CALL section_add_subsection(section, subsection)
744 CALL section_release(subsection)
745
746 END SUBROUTINE create_bend_section
747
748! **************************************************************************************************
749!> \brief This section specifies the bond of the MM atoms
750!> \param section the section to create
751!> \param label ...
752!> \author teo
753! **************************************************************************************************
754 SUBROUTINE create_bond_section(section, label)
755 TYPE(section_type), POINTER :: section
756 CHARACTER(LEN=*), INTENT(IN) :: label
757
758 CHARACTER(LEN=default_string_length) :: tag
759 TYPE(keyword_type), POINTER :: keyword
760
761 cpassert(.NOT. ASSOCIATED(section))
762 NULLIFY (keyword)
763
764 IF (trim(label) == "UB") THEN
765 tag = " Urey-Bradley "
766 CALL section_create(section, __location__, name=trim(label), &
767 description="Specifies the Urey-Bradley potential between the external atoms"// &
768 " defining the angle", &
769 n_keywords=1, n_subsections=0, repeats=.false.)
770
771 ELSE
772 tag = " Bond "
773 CALL section_create(section, __location__, name=trim(label), &
774 description="Specifies the bond potential", &
775 n_keywords=1, n_subsections=0, repeats=.true.)
776
777 CALL keyword_create(keyword, __location__, name="ATOMS", &
778 description="Defines the atomic kinds involved in the bond.", &
779 usage="ATOMS {KIND1} {KIND2}", type_of_var=char_t, &
780 n_var=2)
781 CALL section_add_keyword(section, keyword)
782 CALL keyword_release(keyword)
783 END IF
784
785 CALL keyword_create(keyword, __location__, name="KIND", &
786 description="Define the kind of"//trim(tag)//"potential.", &
787 usage="KIND HARMONIC", &
788 enum_c_vals=s2a("HARMONIC", "CHARMM", "AMBER", "G87", "G96", "QUARTIC", &
789 "MORSE", "CUBIC", "FUES"), &
790 enum_desc=s2a("Functional Form (HARMONIC|G87): 1/2*K*(R-R0)^2", &
791 "Functional Form (CHARMM|AMBER): K*(R-R0)^2", &
792 "Functional Form (CHARMM|AMBER): K*(R-R0)^2", &
793 "Functional Form (HARMONIC|G87): 1/2*K*(R-R0)^2", &
794 "Functional Form (G96): 1/4*K*(R^2-R0^2)^2", &
795 "Functional Form (QUARTIC): (1/2*K1+[1/3*K2+1/4*K3*|R-R0|]*|R-R0|)(R-R0)^2", &
796 "Functional Form (MORSE): K1*[(1-exp(-K2*(R-R0)))^2-1])", &
797 "Functional Form (CUBIC): K*(R-R0)^2*(1+cs*(R-R0)+7/12*(cs^2*(R-R0)^2))", &
798 "Functional Form (FUES): 1/2*K*R0^2*(1+R0/R*(R0/R-2))"), &
799 enum_i_vals=[do_ff_harmonic, &
800 do_ff_charmm, &
801 do_ff_amber, &
802 do_ff_g87, &
803 do_ff_g96, &
805 do_ff_morse, &
806 do_ff_cubic, &
807 do_ff_fues], &
808 default_i_val=do_ff_charmm)
809 CALL section_add_keyword(section, keyword)
810 CALL keyword_release(keyword)
811
812 CALL keyword_create(keyword, __location__, name="K", &
813 description="Defines the force constant of the potential. "// &
814 "For MORSE potentials 2 numbers are expected. "// &
815 "For QUARTIC potentials 3 numbers are expected.", &
816 usage="K {real}", type_of_var=real_t, &
817 n_var=-1, unit_str="internal_cp2k")
818 CALL section_add_keyword(section, keyword)
819 CALL keyword_release(keyword)
820
821 CALL keyword_create(keyword, __location__, name="CS", &
822 description="Defines the cubic stretch term.", &
823 usage="CS {real}", default_r_val=0.0_dp, type_of_var=real_t, &
824 n_var=1, unit_str="bohr^-1")
825 CALL section_add_keyword(section, keyword)
826 CALL keyword_release(keyword)
827
828 CALL keyword_create(keyword, __location__, name="R0", &
829 description="Defines the equilibrium distance.", &
830 usage="R0 {real}", type_of_var=real_t, &
831 n_var=1, unit_str="bohr")
832 CALL section_add_keyword(section, keyword)
833 CALL keyword_release(keyword)
834
835 END SUBROUTINE create_bond_section
836
837! **************************************************************************************************
838!> \brief This section specifies the charge of the MM atoms
839!> \param section the section to create
840!> \author teo
841! **************************************************************************************************
842 SUBROUTINE create_charges_section(section)
843 TYPE(section_type), POINTER :: section
844
845 TYPE(keyword_type), POINTER :: keyword
846
847 cpassert(.NOT. ASSOCIATED(section))
848 CALL section_create(section, __location__, name="charges", &
849 description="Allow to specify an array of classical charges, thus avoiding the"// &
850 " packing and permitting the usage of different charges for same atomic types.", &
851 n_keywords=1, n_subsections=0, repeats=.false.)
852
853 NULLIFY (keyword)
854 CALL keyword_create(keyword, __location__, name="_DEFAULT_KEYWORD_", &
855 description="Value of the charge for the individual atom. Order MUST reflect"// &
856 " the one specified for the geometry.", repeats=.true., usage="{Real}", &
857 type_of_var=real_t)
858 CALL section_add_keyword(section, keyword)
859 CALL keyword_release(keyword)
860
861 END SUBROUTINE create_charges_section
862
863! **************************************************************************************************
864!> \brief This section specifies the charge of the MM atoms
865!> \param section the section to create
866!> \author teo
867! **************************************************************************************************
868 SUBROUTINE create_charge_section(section)
869 TYPE(section_type), POINTER :: section
870
871 TYPE(keyword_type), POINTER :: keyword
872
873 cpassert(.NOT. ASSOCIATED(section))
874 CALL section_create(section, __location__, name="charge", &
875 description="This section specifies the charge of the MM atoms", &
876 n_keywords=1, n_subsections=0, repeats=.true.)
877
878 NULLIFY (keyword)
879
880 CALL keyword_create(keyword, __location__, name="ATOM", &
881 description="Defines the atomic kind of the charge.", &
882 usage="ATOM {KIND1}", type_of_var=char_t, &
883 n_var=1)
884 CALL section_add_keyword(section, keyword)
885 CALL keyword_release(keyword)
886
887 CALL keyword_create(keyword, __location__, name="CHARGE", &
888 description="Defines the charge of the MM atom in electron charge unit.", &
889 usage="CHARGE {real}", type_of_var=real_t, &
890 n_var=1)
891 CALL section_add_keyword(section, keyword)
892 CALL keyword_release(keyword)
893
894 END SUBROUTINE create_charge_section
895
896! **************************************************************************************************
897!> \brief This section specifies the isotropic polarizability of the MM atoms
898!> \param section the section to create
899!> \author Marcel Baer
900! **************************************************************************************************
901 SUBROUTINE create_quadrupole_section(section)
902 TYPE(section_type), POINTER :: section
903
904 TYPE(keyword_type), POINTER :: keyword
905
906 cpassert(.NOT. ASSOCIATED(section))
907 CALL section_create( &
908 section, __location__, name="QUADRUPOLE", &
909 description="This section specifies that we will perform an SCF quadrupole calculation of the MM atoms. "// &
910 "Needs KEYWORD POL_SCF in POISSON secton", &
911 n_keywords=1, n_subsections=0, repeats=.true.)
912
913 NULLIFY (keyword)
914
915 CALL keyword_create(keyword, __location__, name="ATOM", &
916 description="Defines the atomic kind of the SCF quadrupole.", &
917 usage="ATOM {KIND1}", type_of_var=char_t, &
918 n_var=1)
919 CALL section_add_keyword(section, keyword)
920 CALL keyword_release(keyword)
921
922 CALL keyword_create(keyword, __location__, name="CPOL", &
923 description="Defines the isotropic polarizability of the MM atom.", &
924 usage="CPOL {real}", type_of_var=real_t, &
925 n_var=1, unit_str='internal_cp2k')
926 CALL section_add_keyword(section, keyword)
927 CALL keyword_release(keyword)
928
929 END SUBROUTINE create_quadrupole_section
930
931! **************************************************************************************************
932!> \brief This section specifies the isotropic polarizability of the MM atoms
933!> \param section the section to create
934!> \author Marcel Baer
935! **************************************************************************************************
936 SUBROUTINE create_dipole_section(section)
937 TYPE(section_type), POINTER :: section
938
939 TYPE(keyword_type), POINTER :: keyword
940 TYPE(section_type), POINTER :: subsection
941
942 cpassert(.NOT. ASSOCIATED(section))
943 CALL section_create(section, __location__, name="DIPOLE", &
944 description="This section specifies that we will perform an SCF dipole calculation of the MM atoms. "// &
945 "Needs KEYWORD POL_SCF in POISSON secton", &
946 n_keywords=1, n_subsections=1, repeats=.true.)
947
948 NULLIFY (subsection, keyword)
949
950 CALL keyword_create(keyword, __location__, name="ATOM", &
951 description="Defines the atomic kind of the SCF dipole.", &
952 usage="ATOM {KIND1}", type_of_var=char_t, &
953 n_var=1)
954 CALL section_add_keyword(section, keyword)
955 CALL keyword_release(keyword)
956
957 CALL keyword_create(keyword, __location__, name="APOL", &
958 description="Defines the isotropic polarizability of the MM atom.", &
959 usage="APOL {real}", type_of_var=real_t, &
960 n_var=1, unit_str='angstrom^3')
961 CALL section_add_keyword(section, keyword)
962 CALL keyword_release(keyword)
963
964 CALL create_damping_section(subsection)
965 CALL section_add_subsection(section, subsection)
966 CALL section_release(subsection)
967 END SUBROUTINE create_dipole_section
968
969! **************************************************************************************************
970!> \brief This section specifies the idamping parameters for polarizable atoms
971!> \param section the section to create
972!> \author Rodolphe Vuilleumier
973! **************************************************************************************************
974 SUBROUTINE create_damping_section(section)
975 TYPE(section_type), POINTER :: section
976
977 TYPE(keyword_type), POINTER :: keyword
978
979 cpassert(.NOT. ASSOCIATED(section))
980 CALL section_create(section, __location__, name="DAMPING", &
981 description="This section specifies optional electric field damping for the polarizable atoms. ", &
982 n_keywords=4, n_subsections=0, repeats=.true.)
983
984 NULLIFY (keyword)
985
986 CALL keyword_create(keyword, __location__, name="ATOM", &
987 description="Defines the atomic kind for this damping function.", &
988 usage="ATOM {KIND1}", type_of_var=char_t, &
989 n_var=1)
990 CALL section_add_keyword(section, keyword)
991 CALL keyword_release(keyword)
992
993 CALL keyword_create(keyword, __location__, name="TYPE", &
994 description="Defines the damping type.", &
995 usage="TYPE {string}", type_of_var=char_t, &
996 n_var=1, default_c_val="TANG-TOENNIES")
997 CALL section_add_keyword(section, keyword)
998 CALL keyword_release(keyword)
999
1000 CALL keyword_create(keyword, __location__, name="ORDER", &
1001 description="Defines the order for this damping.", &
1002 usage="ORDER {integer}", type_of_var=integer_t, &
1003 n_var=1, default_i_val=3)
1004 CALL section_add_keyword(section, keyword)
1005 CALL keyword_release(keyword)
1006
1007 CALL keyword_create(keyword, __location__, name="BIJ", &
1008 description="Defines the BIJ parameter for this damping.", &
1009 usage="BIJ {real}", type_of_var=real_t, &
1010 n_var=1, unit_str='angstrom^-1')
1011 CALL section_add_keyword(section, keyword)
1012 CALL keyword_release(keyword)
1013
1014 CALL keyword_create(keyword, __location__, name="CIJ", &
1015 description="Defines the CIJ parameter for this damping.", &
1016 usage="CIJ {real}", type_of_var=real_t, &
1017 n_var=1, unit_str='')
1018 CALL section_add_keyword(section, keyword)
1019 CALL keyword_release(keyword)
1020
1021 END SUBROUTINE create_damping_section
1022
1023! **************************************************************************************************
1024!> \brief This section specifies the charge of the MM atoms
1025!> \param section the section to create
1026!> \author teo
1027! **************************************************************************************************
1028 SUBROUTINE create_shell_section(section)
1029 TYPE(section_type), POINTER :: section
1030
1031 TYPE(keyword_type), POINTER :: keyword
1032
1033 cpassert(.NOT. ASSOCIATED(section))
1034 CALL section_create(section, __location__, name="SHELL", &
1035 description="This section specifies the parameters for shell-model potentials", &
1036 n_keywords=6, n_subsections=0, repeats=.true., &
1037 citations=[dick1958, mitchell1993, devynck2012])
1038
1039 NULLIFY (keyword)
1040
1041 CALL keyword_create(keyword, __location__, name="_SECTION_PARAMETERS_", &
1042 description="The kind for which the shell potential parameters are given ", &
1043 usage="H", default_c_val="DEFAULT")
1044 CALL section_add_keyword(section, keyword)
1045 CALL keyword_release(keyword)
1046
1047 CALL keyword_create(keyword, __location__, name="CORE_CHARGE", &
1048 variants=["CORE"], &
1049 description="Partial charge assigned to the core (electron charge units)", &
1050 usage="CORE_CHARGE {real}", &
1051 default_r_val=0.0_dp)
1052 CALL section_add_keyword(section, keyword)
1053 CALL keyword_release(keyword)
1054
1055 CALL keyword_create(keyword, __location__, name="SHELL_CHARGE", &
1056 variants=["SHELL"], &
1057 description="Partial charge assigned to the shell (electron charge units)", &
1058 usage="SHELL_CHARGE {real}", &
1059 default_r_val=0.0_dp)
1060 CALL section_add_keyword(section, keyword)
1061 CALL keyword_release(keyword)
1062
1063 CALL keyword_create(keyword, __location__, name="MASS_FRACTION", &
1064 variants=["MASS"], &
1065 description="Fraction of the mass of the atom to be assigned to the shell", &
1066 usage="MASS_FRACTION {real}", &
1067 default_r_val=0.1_dp)
1068 CALL section_add_keyword(section, keyword)
1069 CALL keyword_release(keyword)
1070
1071 CALL keyword_create(keyword, __location__, name="K2_SPRING", &
1072 variants=s2a("K2", "SPRING"), &
1073 description="Force constant k2 of the spring potential 1/2*k2*r^2 + 1/24*k4*r^4 "// &
1074 "binding a core-shell pair when a core-shell potential is employed.", &
1075 repeats=.false., &
1076 usage="K2_SPRING {real}", &
1077 default_r_val=-1.0_dp, &
1078 unit_str="hartree*bohr^-2")
1079 CALL section_add_keyword(section, keyword)
1080 CALL keyword_release(keyword)
1081
1082 CALL keyword_create(keyword, __location__, name="K4_SPRING", &
1083 variants=s2a("K4"), &
1084 description="Force constant k4 of the spring potential 1/2*k2*r^2 + 1/24*k4*r^4 "// &
1085 "binding a core-shell pair when a core-shell potential is employed. "// &
1086 "By default a harmonic spring potential is used, i.e. k4 is zero.", &
1087 repeats=.false., &
1088 usage="K4_SPRING {real}", &
1089 default_r_val=0.0_dp, &
1090 unit_str="hartree*bohr^-4")
1091 CALL section_add_keyword(section, keyword)
1092 CALL keyword_release(keyword)
1093
1094 CALL keyword_create(keyword, __location__, name="MAX_DISTANCE", &
1095 description="Assign a maximum elongation of the spring, "// &
1096 "if negative no limit is imposed", &
1097 usage="MAX_DISTANCE 0.0", &
1098 default_r_val=-1.0_dp, &
1099 unit_str="angstrom")
1100 CALL section_add_keyword(section, keyword)
1101 CALL keyword_release(keyword)
1102
1103 CALL keyword_create(keyword, __location__, name="SHELL_CUTOFF", &
1104 description="Define a screening function to exclude some neighbors "// &
1105 "of the shell when electrostatic interaction are considered, "// &
1106 "if negative no screening is operated", &
1107 usage="SHELL_CUTOFF -1.0", &
1108 default_r_val=-1.0_dp, &
1109 unit_str="angstrom")
1110 CALL section_add_keyword(section, keyword)
1111 CALL keyword_release(keyword)
1112
1113 END SUBROUTINE create_shell_section
1114
1115! **************************************************************************************************
1116!> \brief This section specifies the input parameters for 1-4 NON-BONDED
1117!> Interactions
1118!> \param section the section to create
1119!> \author teo
1120! **************************************************************************************************
1121 SUBROUTINE create_nonbonded14_section(section)
1122 TYPE(section_type), POINTER :: section
1123
1124 TYPE(section_type), POINTER :: subsection
1125
1126 cpassert(.NOT. ASSOCIATED(section))
1127 CALL section_create(section, __location__, name="nonbonded14", &
1128 description="This section specifies the input parameters for 1-4 NON-BONDED interactions.", &
1129 n_keywords=1, n_subsections=0, repeats=.false.)
1130
1131 NULLIFY (subsection)
1132 CALL create_lj_section(subsection)
1133 CALL section_add_subsection(section, subsection)
1134 CALL section_release(subsection)
1135
1136 CALL create_williams_section(subsection)
1137 CALL section_add_subsection(section, subsection)
1138 CALL section_release(subsection)
1139
1140 CALL create_goodwin_section(subsection)
1141 CALL section_add_subsection(section, subsection)
1142 CALL section_release(subsection)
1143
1144 CALL create_genpot_section(subsection)
1145 CALL section_add_subsection(section, subsection)
1146 CALL section_release(subsection)
1147
1148 END SUBROUTINE create_nonbonded14_section
1149
1150! **************************************************************************************************
1151!> \brief This section specifies the input parameters for 1-4 NON-BONDED
1152!> Interactions
1153!> \param section the section to create
1154!> \author teo
1155! **************************************************************************************************
1156 SUBROUTINE create_nonbonded_section(section)
1157 TYPE(section_type), POINTER :: section
1158
1159 TYPE(section_type), POINTER :: subsection
1160
1161 cpassert(.NOT. ASSOCIATED(section))
1162 CALL section_create(section, __location__, name="nonbonded", &
1163 description="This section specifies the input parameters for NON-BONDED interactions.", &
1164 n_keywords=1, n_subsections=0, repeats=.false.)
1165
1166 NULLIFY (subsection)
1167 CALL create_lj_section(subsection)
1168 CALL section_add_subsection(section, subsection)
1169 CALL section_release(subsection)
1170
1171 CALL create_williams_section(subsection)
1172 CALL section_add_subsection(section, subsection)
1173 CALL section_release(subsection)
1174
1175 CALL create_eam_section(subsection)
1176 CALL section_add_subsection(section, subsection)
1177 CALL section_release(subsection)
1178
1179 CALL create_nequip_section(subsection)
1180 CALL section_add_subsection(section, subsection)
1181 CALL section_release(subsection)
1182
1183 CALL create_allegro_section(subsection)
1184 CALL section_add_subsection(section, subsection)
1185 CALL section_release(subsection)
1186
1187 CALL create_ace_section(subsection)
1188 CALL section_add_subsection(section, subsection)
1189 CALL section_release(subsection)
1190
1191 CALL create_deepmd_section(subsection)
1192 CALL section_add_subsection(section, subsection)
1193 CALL section_release(subsection)
1194
1195 CALL create_goodwin_section(subsection)
1196 CALL section_add_subsection(section, subsection)
1197 CALL section_release(subsection)
1198
1199 CALL create_ipbv_section(subsection)
1200 CALL section_add_subsection(section, subsection)
1201 CALL section_release(subsection)
1202
1203 CALL create_bmhft_section(subsection)
1204 CALL section_add_subsection(section, subsection)
1205 CALL section_release(subsection)
1206
1207 CALL create_bmhftd_section(subsection)
1208 CALL section_add_subsection(section, subsection)
1209 CALL section_release(subsection)
1210
1211 CALL create_buck4r_section(subsection)
1212 CALL section_add_subsection(section, subsection)
1213 CALL section_release(subsection)
1214
1215 CALL create_buckmorse_section(subsection)
1216 CALL section_add_subsection(section, subsection)
1217 CALL section_release(subsection)
1218
1219 CALL create_genpot_section(subsection)
1220 CALL section_add_subsection(section, subsection)
1221 CALL section_release(subsection)
1222
1223 CALL create_tersoff_section(subsection)
1224 CALL section_add_subsection(section, subsection)
1225 CALL section_release(subsection)
1226
1227 CALL create_siepmann_section(subsection)
1228 CALL section_add_subsection(section, subsection)
1229 CALL section_release(subsection)
1230
1231 CALL create_gal_section(subsection)
1232 CALL section_add_subsection(section, subsection)
1233 CALL section_release(subsection)
1234
1235 CALL create_gal21_section(subsection)
1236 CALL section_add_subsection(section, subsection)
1237 CALL section_release(subsection)
1238
1239 CALL create_tabpot_section(subsection)
1240 CALL section_add_subsection(section, subsection)
1241 CALL section_release(subsection)
1242
1243 END SUBROUTINE create_nonbonded_section
1244
1245! **************************************************************************************************
1246!> \brief This section specifies the input parameters for generation of
1247!> neighbor lists
1248!> \param section the section to create
1249!> \author teo [07.2007] - Zurich University
1250! **************************************************************************************************
1252 TYPE(section_type), POINTER :: section
1253
1254 TYPE(keyword_type), POINTER :: keyword
1255
1256 NULLIFY (keyword)
1257 cpassert(.NOT. ASSOCIATED(section))
1258 CALL section_create(section, __location__, name="neighbor_lists", &
1259 description="This section specifies the input parameters for the construction of"// &
1260 " neighbor lists.", &
1261 n_keywords=1, n_subsections=0, repeats=.false.)
1262
1263 CALL keyword_create(keyword, __location__, name="VERLET_SKIN", &
1264 description="Defines the Verlet Skin for the generation of the neighbor lists", &
1265 usage="VERLET_SKIN {real}", default_r_val=cp_unit_to_cp2k(value=1.0_dp, &
1266 unit_str="angstrom"), &
1267 unit_str="angstrom")
1268 CALL section_add_keyword(section, keyword)
1269 CALL keyword_release(keyword)
1270
1271 CALL keyword_create(keyword, __location__, name="neighbor_lists_from_scratch", &
1272 description="This keyword enables the building of the neighbouring list from scratch.", &
1273 usage="neighbor_lists_from_scratch logical", &
1274 default_l_val=.false., lone_keyword_l_val=.true.)
1275 CALL section_add_keyword(section, keyword)
1276 CALL keyword_release(keyword)
1277
1278 CALL keyword_create(keyword, __location__, name="GEO_CHECK", &
1279 description="This keyword enables the check that two atoms are never below the minimum"// &
1280 " value used to construct the splines during the construction of the neighbouring list."// &
1281 " Disabling this keyword avoids CP2K to abort in case two atoms are below the minimum"// &
1282 " value of the radius used to generate the splines.", &
1283 usage="GEO_CHECK", &
1284 default_l_val=.true., lone_keyword_l_val=.true.)
1285 CALL section_add_keyword(section, keyword)
1286 CALL keyword_release(keyword)
1287
1288 END SUBROUTINE create_neighbor_lists_section
1289
1290! **************************************************************************************************
1291!> \brief This section specifies the input parameters for a generic potential form
1292!> \param section the section to create
1293!> \author teo
1294! **************************************************************************************************
1295 SUBROUTINE create_genpot_section(section)
1296 TYPE(section_type), POINTER :: section
1297
1298 TYPE(keyword_type), POINTER :: keyword
1299
1300 cpassert(.NOT. ASSOCIATED(section))
1301 CALL section_create(section, __location__, name="GENPOT", &
1302 description="This section specifies the input parameters for a generic potential type. "// &
1303 "A functional form is specified. Mathematical Operators recognized are +, -, *, /, ** "// &
1304 "or alternatively ^, whereas symbols for brackets must be (). "// &
1305 "The function parser recognizes the (single argument) Fortran 90 intrinsic functions "// &
1306 "abs, exp, log10, log, sqrt, sinh, cosh, tanh, sin, cos, tan, asin, acos, atan, erf, erfc. "// &
1307 "Parsing for intrinsic functions is not case sensitive.", &
1308 n_keywords=1, n_subsections=0, repeats=.true.)
1309
1310 NULLIFY (keyword)
1311
1312 CALL keyword_create(keyword, __location__, name="ATOMS", &
1313 description="Defines the atomic kind involved in the generic potential", &
1314 usage="ATOMS {KIND1} {KIND2}", type_of_var=char_t, &
1315 n_var=2)
1316 CALL section_add_keyword(section, keyword)
1317 CALL keyword_release(keyword)
1318
1319 CALL keyword_create(keyword, __location__, name="FUNCTION", &
1320 description="Specifies the functional form in mathematical notation.", &
1321 usage="FUNCTION a*EXP(-b*x^2)/x+D*log10(x)", type_of_var=lchar_t, &
1322 n_var=1)
1323 CALL section_add_keyword(section, keyword)
1324 CALL keyword_release(keyword)
1325
1326 CALL keyword_create(keyword, __location__, name="VARIABLES", &
1327 description="Defines the variable of the functional form.", &
1328 usage="VARIABLES x", type_of_var=char_t, &
1329 n_var=-1)
1330 CALL section_add_keyword(section, keyword)
1331 CALL keyword_release(keyword)
1332
1333 CALL keyword_create(keyword, __location__, name="PARAMETERS", &
1334 description="Defines the parameters of the functional form", &
1335 usage="PARAMETERS a b D", type_of_var=char_t, &
1336 n_var=-1, repeats=.true.)
1337 CALL section_add_keyword(section, keyword)
1338 CALL keyword_release(keyword)
1339
1340 CALL keyword_create(keyword, __location__, name="VALUES", &
1341 description="Defines the values of parameter of the functional form", &
1342 usage="VALUES ", type_of_var=real_t, &
1343 n_var=-1, repeats=.true., unit_str="internal_cp2k")
1344 CALL section_add_keyword(section, keyword)
1345 CALL keyword_release(keyword)
1346
1347 CALL keyword_create(keyword, __location__, name="UNITS", &
1348 description="Optionally, allows to define valid CP2K unit strings for each parameter value. "// &
1349 "It is assumed that the corresponding parameter value is specified in this unit.", &
1350 usage="UNITS angstrom eV*angstrom^-1 angstrom^1 K", type_of_var=char_t, &
1351 n_var=-1, repeats=.true.)
1352 CALL section_add_keyword(section, keyword)
1353 CALL keyword_release(keyword)
1354
1355 CALL keyword_create(keyword, __location__, name="RCUT", &
1356 description="Defines the cutoff parameter of the generic potential", &
1357 usage="RCUT {real}", default_r_val=cp_unit_to_cp2k(value=10.0_dp, &
1358 unit_str="angstrom"), &
1359 unit_str="angstrom")
1360 CALL section_add_keyword(section, keyword)
1361 CALL keyword_release(keyword)
1362
1363 CALL keyword_create(keyword, __location__, name="RMIN", &
1364 description="Defines the lower bound of the potential. If not set the range is the"// &
1365 " full range generate by the spline", usage="RMIN {real}", &
1366 type_of_var=real_t, unit_str="angstrom")
1367 CALL section_add_keyword(section, keyword)
1368 CALL keyword_release(keyword)
1369
1370 CALL keyword_create(keyword, __location__, name="RMAX", &
1371 description="Defines the upper bound of the potential. If not set the range is the"// &
1372 " full range generate by the spline", usage="RMAX {real}", &
1373 type_of_var=real_t, unit_str="angstrom")
1374 CALL section_add_keyword(section, keyword)
1375 CALL keyword_release(keyword)
1376
1377 END SUBROUTINE create_genpot_section
1378
1379! **************************************************************************************************
1380!> \brief This section specifies the input parameters for EAM potential type
1381!> \param section the section to create
1382!> \author teo
1383! **************************************************************************************************
1384 SUBROUTINE create_eam_section(section)
1385 TYPE(section_type), POINTER :: section
1386
1387 TYPE(keyword_type), POINTER :: keyword
1388
1389 cpassert(.NOT. ASSOCIATED(section))
1390 CALL section_create(section, __location__, name="EAM", &
1391 description="This section specifies the input parameters for EAM potential type.", &
1392 citations=[foiles1986], n_keywords=1, n_subsections=0, repeats=.true.)
1393
1394 NULLIFY (keyword)
1395
1396 CALL keyword_create(keyword, __location__, name="ATOMS", &
1397 description="Defines the atomic kind involved in the nonbond potential", &
1398 usage="ATOMS {KIND1} {KIND2}", type_of_var=char_t, &
1399 n_var=2)
1400 CALL section_add_keyword(section, keyword)
1401 CALL keyword_release(keyword)
1402
1403 CALL keyword_create(keyword, __location__, name="PARM_FILE_NAME", &
1404 variants=["PARMFILE"], &
1405 description="Specifies the filename that contains the tabulated EAM potential. "// &
1406 "File structure: the first line of the potential file contains a title. "// &
1407 "The second line contains: atomic number, mass and lattice constant. "// &
1408 "These information are parsed but not used in CP2K. The third line contains: "// &
1409 "dr: increment of r for the tabulated values of density and phi (assuming r starts in 0) [angstrom]; "// &
1410 "drho: increment of density for the tabulated values of the embedding function (assuming rho starts "// &
1411 "in 0) [au_c]; cutoff: cutoff of the EAM potential; npoints: number of points in tabulated. Follow "// &
1412 "in order npoints lines for rho [au_c] and its derivative [au_c*angstrom^-1]; npoints lines for "// &
1413 "PHI [ev] and its derivative [ev*angstrom^-1] and npoint lines for the embedded function [ev] "// &
1414 "and its derivative [ev*au_c^-1].", &
1415 usage="PARM_FILE_NAME {FILENAME}", default_lc_val=" ")
1416 CALL section_add_keyword(section, keyword)
1417 CALL keyword_release(keyword)
1418
1419 END SUBROUTINE create_eam_section
1420
1421! **************************************************************************************************
1422!> \brief This section specifies the input parameters for NEQUIP potential type
1423!> \param section the section to create
1424!> \author teo
1425! **************************************************************************************************
1426 SUBROUTINE create_nequip_section(section)
1427 TYPE(section_type), POINTER :: section
1428
1429 TYPE(keyword_type), POINTER :: keyword
1430
1431 cpassert(.NOT. ASSOCIATED(section))
1432 CALL section_create(section, __location__, name="NEQUIP", &
1433 description="This section specifies the input parameters for NEQUIP potential type "// &
1434 "based on equivariant neural networks with message passing. Starting from the NequIP 0.6.0, "// &
1435 "one can predict stress if the config.yaml file has the StressForceOutput keyword, "// &
1436 "regardless of whether the model has been trained on the stress. "// &
1437 "Requires linking with libtorch library from <https://pytorch.org/cppdocs/installing.html>.", &
1438 citations=[batzner2022], n_keywords=1, n_subsections=0, repeats=.false.)
1439
1440 NULLIFY (keyword)
1441
1442 CALL keyword_create(keyword, __location__, name="ATOMS", &
1443 description="Defines the atomic kinds involved in the NEQUIP potential. "// &
1444 "Provide a list of each element, making sure that the mapping from the ATOMS list "// &
1445 "to NequIP atom types is correct. This mapping should also be consistent for the "// &
1446 "atomic coordinates as specified in the sections COORDS or TOPOLOGY.", &
1447 usage="ATOMS {KIND 1} {KIND 2} .. {KIND N}", type_of_var=char_t, &
1448 n_var=-1)
1449 CALL section_add_keyword(section, keyword)
1450 CALL keyword_release(keyword)
1451
1452 CALL keyword_create(keyword, __location__, name="PARM_FILE_NAME", &
1453 variants=["PARMFILE"], &
1454 description="Specifies the filename that contains the NEQUIP model.", &
1455 usage="PARM_FILE_NAME {FILENAME}", default_lc_val="model.pth")
1456 CALL section_add_keyword(section, keyword)
1457 CALL keyword_release(keyword)
1458
1459 CALL keyword_create(keyword, __location__, name="UNIT_COORDS", &
1460 description="Units of coordinates in the NEQUIP model.pth file. "// &
1461 "The units of positions, energies and forces must be self-consistent: "// &
1462 "e.g. coordinates in Angstrom, energies in eV, forces in eV/Angstrom. ", &
1463 usage="UNIT_COORDS angstrom", default_c_val="angstrom")
1464 CALL section_add_keyword(section, keyword)
1465 CALL keyword_release(keyword)
1466
1467 CALL keyword_create(keyword, __location__, name="UNIT_ENERGY", &
1468 description="Units of energy in the NEQUIP model.pth file. "// &
1469 "The units of positions, energies and forces must be self-consistent: "// &
1470 "e.g. coordinates in Angstrom, energies in eV, forces in eV/Angstrom. ", &
1471 usage="UNIT_ENERGY hartree", default_c_val="eV")
1472 CALL section_add_keyword(section, keyword)
1473 CALL keyword_release(keyword)
1474
1475 CALL keyword_create(keyword, __location__, name="UNIT_FORCES", &
1476 description="Units of the forces in the NEQUIP model.pth file. "// &
1477 "The units of positions, energies and forces must be self-consistent: "// &
1478 "e.g. coordinates in Angstrom, energies in eV, forces in eV/Angstrom. ", &
1479 usage="UNIT_FORCES hartree/bohr", default_c_val="eV/Angstrom")
1480 CALL section_add_keyword(section, keyword)
1481 CALL keyword_release(keyword)
1482
1483 CALL keyword_create(keyword, __location__, name="UNIT_CELL", &
1484 description="Units of the cell vectors in the NEQUIP model.pth file. "// &
1485 "The units of positions, energies and forces must be self-consistent: "// &
1486 "e.g. coordinates in Angstrom, energies in eV, forces in eV/Angstrom. ", &
1487 usage="UNIT_CELL angstrom", default_c_val="angstrom")
1488 CALL section_add_keyword(section, keyword)
1489 CALL keyword_release(keyword)
1490
1491 END SUBROUTINE create_nequip_section
1492
1493! **************************************************************************************************
1494!> \brief This section specifies the input parameters for ALLEGRO potential type
1495!> \param section the section to create
1496!> \author teo
1497! **************************************************************************************************
1498 SUBROUTINE create_allegro_section(section)
1499 TYPE(section_type), POINTER :: section
1500
1501 TYPE(keyword_type), POINTER :: keyword
1502
1503 cpassert(.NOT. ASSOCIATED(section))
1504 CALL section_create(section, __location__, name="ALLEGRO", &
1505 description="This section specifies the input parameters for ALLEGRO potential type "// &
1506 "based on equivariant neural network potentials. Starting from the NequIP 0.6.0, "// &
1507 "one can predict stress if the config.yaml file has the StressForceOutput keyword, "// &
1508 "regardless of whether the model has been trained on the stress. "// &
1509 "Requires linking with libtorch library from <https://pytorch.org/cppdocs/installing.html>.", &
1510 citations=[musaelian2023], n_keywords=1, n_subsections=0, repeats=.false.)
1511
1512 NULLIFY (keyword)
1513
1514 CALL keyword_create(keyword, __location__, name="ATOMS", &
1515 description="Defines the atomic kinds involved in the ALLEGRO potential. "// &
1516 "Provide a list of each element, making sure that the mapping from the ATOMS list "// &
1517 "to NequIP atom types is correct. This mapping should also be consistent for the "// &
1518 "atomic coordinates as specified in the sections COORDS or TOPOLOGY.", &
1519 usage="ATOMS {KIND 1} {KIND 2} .. {KIND N}", type_of_var=char_t, &
1520 n_var=-1)
1521 CALL section_add_keyword(section, keyword)
1522 CALL keyword_release(keyword)
1523
1524 CALL keyword_create(keyword, __location__, name="PARM_FILE_NAME", &
1525 variants=["PARMFILE"], &
1526 description="Specifies the filename that contains the ALLEGRO model.", &
1527 usage="PARM_FILE_NAME {FILENAME}", default_lc_val="model.pth")
1528 CALL section_add_keyword(section, keyword)
1529 CALL keyword_release(keyword)
1530
1531 CALL keyword_create(keyword, __location__, name="UNIT_COORDS", &
1532 description="Units of coordinates in the ALLEGRO model.pth file. "// &
1533 "The units of positions, energies and forces must be self-consistent: "// &
1534 "e.g. coordinates in Angstrom, energies in eV, forces in eV/Angstrom. ", &
1535 usage="UNIT_COORDS angstrom", default_c_val="angstrom")
1536 CALL section_add_keyword(section, keyword)
1537 CALL keyword_release(keyword)
1538
1539 CALL keyword_create(keyword, __location__, name="UNIT_ENERGY", &
1540 description="Units of energy in the ALLEGRO model.pth file. "// &
1541 "The units of positions, energies and forces must be self-consistent: "// &
1542 "e.g. coordinates in Angstrom, energies in eV, forces in eV/Angstrom. ", &
1543 usage="UNIT_ENERGY hartree", default_c_val="eV")
1544 CALL section_add_keyword(section, keyword)
1545 CALL keyword_release(keyword)
1546
1547 CALL keyword_create(keyword, __location__, name="UNIT_FORCES", &
1548 description="Units of the forces in the ALLEGRO model.pth file. "// &
1549 "The units of positions, energies and forces must be self-consistent: "// &
1550 "e.g. coordinates in Angstrom, energies in eV, forces in eV/Angstrom. ", &
1551 usage="UNIT_FORCES hartree/bohr", default_c_val="eV/Angstrom")
1552 CALL section_add_keyword(section, keyword)
1553 CALL keyword_release(keyword)
1554
1555 CALL keyword_create(keyword, __location__, name="UNIT_CELL", &
1556 description="Units of the cell vectors in the ALLEGRO model.pth file. "// &
1557 "The units of positions, energies and forces must be self-consistent: "// &
1558 "e.g. coordinates in Angstrom, energies in eV, forces in eV/Angstrom. ", &
1559 usage="UNIT_CELL angstrom", default_c_val="angstrom")
1560 CALL section_add_keyword(section, keyword)
1561 CALL keyword_release(keyword)
1562
1563 END SUBROUTINE create_allegro_section
1564
1565! **************************************************************************************************
1566!> \brief This section specifies the input parameters for ACE potential type
1567!> \param section the section to create
1568!> \author
1569! **************************************************************************************************
1570 SUBROUTINE create_ace_section(section)
1571 TYPE(section_type), POINTER :: section
1572
1573 TYPE(keyword_type), POINTER :: keyword
1574
1575 CALL section_create(section, __location__, name="ACE", &
1576 description="This section specifies the input parameters for Atomic Cluster Expansion type. "// &
1577 "Mainly intended for accurate representation of "// &
1578 "potential energy surfaces. "// &
1579 "Requires linking with ACE library from "// &
1580 "<a href=""https://github.com/ICAMS/lammps-user-pace"" "// &
1581 "target=""_blank"">https://github.com/ICAMS/lammps-user-pace</a> .", &
1583 n_keywords=1, n_subsections=0, repeats=.false.)
1584 NULLIFY (keyword)
1585
1586 CALL keyword_create(keyword, __location__, name="ATOMS", &
1587 description="Defines the atomic species. "// &
1588 "Provide a list of each element, "// &
1589 "making sure that the mapping from the ATOMS list to ACE atom types is correct.", &
1590 usage="ATOMS {KIND 1} {KIND 2} .. {KIND N}", type_of_var=char_t, &
1591 n_var=-1)
1592 CALL section_add_keyword(section, keyword)
1593 CALL keyword_release(keyword)
1594 CALL keyword_create(keyword, __location__, name="POT_FILE_NAME", &
1595 variants=["PARMFILE"], &
1596 description="Specifies the filename that contains the ACE potential parameters.", &
1597 usage="POT_FILE_NAME {FILENAME}", default_lc_val="test.yaml")
1598 CALL section_add_keyword(section, keyword)
1599 CALL keyword_release(keyword)
1600 END SUBROUTINE create_ace_section
1601
1602! **************************************************************************************************
1603!> \brief This section specifies the input parameters for DEEPMD potential type
1604!> \param section the section to create
1605!> \author ybzhuang
1606! **************************************************************************************************
1607 SUBROUTINE create_deepmd_section(section)
1608 TYPE(section_type), POINTER :: section
1609
1610 TYPE(keyword_type), POINTER :: keyword
1611
1612 CALL section_create(section, __location__, name="DEEPMD", &
1613 description="This section specifies the input parameters for Deep Potential type. "// &
1614 "Mainly intended for things like neural network to DFT "// &
1615 "to achieve correlated-wavefunction-like accuracy. "// &
1616 "Requires linking with DeePMD-kit library from "// &
1617 "<a href=""https://docs.deepmodeling.com/projects/deepmd/en/master"" "// &
1618 "target=""_blank"">https://docs.deepmodeling.com/projects/deepmd/en/master</a> .", &
1619 citations=[wang2018, zeng2023], n_keywords=1, n_subsections=0, repeats=.false.)
1620 NULLIFY (keyword)
1621 CALL keyword_create(keyword, __location__, name="ATOMS", &
1622 description="Defines the atomic kinds involved in the Deep Potential. "// &
1623 "Provide a list of each element, "// &
1624 "making sure that the mapping from the ATOMS list to DeePMD atom types is correct.", &
1625 usage="ATOMS {KIND 1} {KIND 2} .. {KIND N}", type_of_var=char_t, &
1626 n_var=-1)
1627 CALL section_add_keyword(section, keyword)
1628 CALL keyword_release(keyword)
1629 CALL keyword_create(keyword, __location__, name="POT_FILE_NAME", &
1630 variants=["PARMFILE"], &
1631 description="Specifies the filename that contains the DeePMD-kit potential.", &
1632 usage="POT_FILE_NAME {FILENAME}", default_lc_val="graph.pb")
1633 CALL section_add_keyword(section, keyword)
1634 CALL keyword_release(keyword)
1635 CALL keyword_create(keyword, __location__, name="ATOMS_DEEPMD_TYPE", &
1636 description="Specifies the atomic TYPE for the DeePMD-kit potential. "// &
1637 "Provide a list of index, making sure that the mapping "// &
1638 "from the ATOMS list to DeePMD atom types is correct. ", &
1639 usage="ATOMS_DEEPMD_TYPE {TYPE INTEGER 1} {TYPE INTEGER 2} .. "// &
1640 "{TYPE INTEGER N}", type_of_var=integer_t, &
1641 n_var=-1)
1642 CALL section_add_keyword(section, keyword)
1643 CALL keyword_release(keyword)
1644 END SUBROUTINE create_deepmd_section
1645
1646! **************************************************************************************************
1647!> \brief This section specifies the input parameters for Lennard-Jones potential type
1648!> \param section the section to create
1649!> \author teo
1650! **************************************************************************************************
1651 SUBROUTINE create_lj_section(section)
1652 TYPE(section_type), POINTER :: section
1653
1654 TYPE(keyword_type), POINTER :: keyword
1655
1656 cpassert(.NOT. ASSOCIATED(section))
1657 CALL section_create(section, __location__, name="lennard-jones", &
1658 description="This section specifies the input parameters for LENNARD-JONES potential type. "// &
1659 "Functional form: V(r) = 4.0 * EPSILON * [(SIGMA/r)^12-(SIGMA/r)^6].", &
1660 n_keywords=1, n_subsections=0, repeats=.true.)
1661
1662 NULLIFY (keyword)
1663
1664 CALL keyword_create(keyword, __location__, name="ATOMS", &
1665 description="Defines the atomic kind involved in the nonbond potential", &
1666 usage="ATOMS {KIND1} {KIND2}", type_of_var=char_t, &
1667 n_var=2)
1668 CALL section_add_keyword(section, keyword)
1669 CALL keyword_release(keyword)
1670
1671 CALL keyword_create(keyword, __location__, name="EPSILON", &
1672 description="Defines the EPSILON parameter of the LJ potential", &
1673 usage="EPSILON {real}", type_of_var=real_t, &
1674 n_var=1, unit_str="K_e")
1675 CALL section_add_keyword(section, keyword)
1676 CALL keyword_release(keyword)
1677
1678 CALL keyword_create(keyword, __location__, name="SIGMA", &
1679 description="Defines the SIGMA parameter of the LJ potential", &
1680 usage="SIGMA {real}", type_of_var=real_t, &
1681 n_var=1, unit_str="angstrom")
1682 CALL section_add_keyword(section, keyword)
1683 CALL keyword_release(keyword)
1684
1685 CALL keyword_create(keyword, __location__, name="RCUT", &
1686 description="Defines the cutoff parameter of the LJ potential", &
1687 usage="RCUT {real}", default_r_val=cp_unit_to_cp2k(value=10.0_dp, &
1688 unit_str="angstrom"), &
1689 unit_str="angstrom")
1690 CALL section_add_keyword(section, keyword)
1691 CALL keyword_release(keyword)
1692
1693 CALL keyword_create(keyword, __location__, name="RMIN", &
1694 description="Defines the lower bound of the potential. If not set the range is the"// &
1695 " full range generate by the spline", usage="RMIN {real}", &
1696 type_of_var=real_t, unit_str="angstrom")
1697 CALL section_add_keyword(section, keyword)
1698 CALL keyword_release(keyword)
1699
1700 CALL keyword_create(keyword, __location__, name="RMAX", &
1701 description="Defines the upper bound of the potential. If not set the range is the"// &
1702 " full range generate by the spline", usage="RMAX {real}", &
1703 type_of_var=real_t, unit_str="angstrom")
1704 CALL section_add_keyword(section, keyword)
1705 CALL keyword_release(keyword)
1706
1707 END SUBROUTINE create_lj_section
1708
1709! **************************************************************************************************
1710!> \brief This section specifies the input parameters for Williams potential type
1711!> \param section the section to create
1712!> \author teo
1713! **************************************************************************************************
1714 SUBROUTINE create_williams_section(section)
1715 TYPE(section_type), POINTER :: section
1716
1717 TYPE(keyword_type), POINTER :: keyword
1718
1719 cpassert(.NOT. ASSOCIATED(section))
1720 CALL section_create(section, __location__, name="williams", &
1721 description="This section specifies the input parameters for WILLIAMS potential type. "// &
1722 "Functional form: V(r) = A*EXP(-B*r) - C / r^6 .", &
1723 n_keywords=1, n_subsections=0, repeats=.true.)
1724
1725 NULLIFY (keyword)
1726
1727 CALL keyword_create(keyword, __location__, name="ATOMS", &
1728 description="Defines the atomic kind involved in the nonbond potential", &
1729 usage="ATOMS {KIND1} {KIND2}", type_of_var=char_t, &
1730 n_var=2)
1731 CALL section_add_keyword(section, keyword)
1732 CALL keyword_release(keyword)
1733
1734 CALL keyword_create(keyword, __location__, name="A", &
1735 description="Defines the A parameter of the Williams potential", &
1736 usage="A {real}", type_of_var=real_t, &
1737 n_var=1, unit_str="K_e")
1738 CALL section_add_keyword(section, keyword)
1739 CALL keyword_release(keyword)
1740
1741 CALL keyword_create(keyword, __location__, name="B", &
1742 description="Defines the B parameter of the Williams potential", &
1743 usage="B {real}", type_of_var=real_t, &
1744 n_var=1, unit_str="angstrom^-1")
1745 CALL section_add_keyword(section, keyword)
1746 CALL keyword_release(keyword)
1747
1748 CALL keyword_create(keyword, __location__, name="C", &
1749 description="Defines the C parameter of the Williams potential", &
1750 usage="C {real}", type_of_var=real_t, &
1751 n_var=1, unit_str="K_e*angstrom^6")
1752 CALL section_add_keyword(section, keyword)
1753 CALL keyword_release(keyword)
1754
1755 CALL keyword_create(keyword, __location__, name="RCUT", &
1756 description="Defines the cutoff parameter of the Williams potential", &
1757 usage="RCUT {real}", default_r_val=cp_unit_to_cp2k(value=10.0_dp, &
1758 unit_str="angstrom"), &
1759 unit_str="angstrom")
1760 CALL section_add_keyword(section, keyword)
1761 CALL keyword_release(keyword)
1762
1763 CALL keyword_create(keyword, __location__, name="RMIN", &
1764 description="Defines the lower bound of the potential. If not set the range is the"// &
1765 " full range generate by the spline", usage="RMIN {real}", &
1766 type_of_var=real_t, unit_str="angstrom")
1767 CALL section_add_keyword(section, keyword)
1768 CALL keyword_release(keyword)
1769
1770 CALL keyword_create(keyword, __location__, name="RMAX", &
1771 description="Defines the upper bound of the potential. If not set the range is the"// &
1772 " full range generate by the spline", usage="RMAX {real}", &
1773 type_of_var=real_t, unit_str="angstrom")
1774 CALL section_add_keyword(section, keyword)
1775 CALL keyword_release(keyword)
1776
1777 END SUBROUTINE create_williams_section
1778
1779! **************************************************************************************************
1780!> \brief This section specifies the input parameters for Goodwin potential type
1781!> \param section the section to create
1782!> \author teo
1783! **************************************************************************************************
1784 SUBROUTINE create_goodwin_section(section)
1785 TYPE(section_type), POINTER :: section
1786
1787 TYPE(keyword_type), POINTER :: keyword
1788
1789 cpassert(.NOT. ASSOCIATED(section))
1790 CALL section_create(section, __location__, name="goodwin", &
1791 description="This section specifies the input parameters for GOODWIN potential type. "// &
1792 "Functional form: V(r) = EXP(M*(-(r/DC)**MC+(D/DC)**MC))*VR0*(D/r)**M.", &
1793 n_keywords=1, n_subsections=0, repeats=.true.)
1794
1795 NULLIFY (keyword)
1796 CALL keyword_create(keyword, __location__, name="ATOMS", &
1797 description="Defines the atomic kind involved in the nonbond potential", &
1798 usage="ATOMS {KIND1} {KIND2}", type_of_var=char_t, &
1799 n_var=2)
1800 CALL section_add_keyword(section, keyword)
1801 CALL keyword_release(keyword)
1802
1803 CALL keyword_create(keyword, __location__, name="VR0", &
1804 description="Defines the VR0 parameter of the Goodwin potential", &
1805 usage="VR0 {real}", type_of_var=real_t, &
1806 n_var=1, unit_str="K_e")
1807 CALL section_add_keyword(section, keyword)
1808 CALL keyword_release(keyword)
1809
1810 CALL keyword_create(keyword, __location__, name="D", &
1811 description="Defines the D parameter of the Goodwin potential", &
1812 usage="D {real}", type_of_var=real_t, &
1813 n_var=1, unit_str="angstrom")
1814 CALL section_add_keyword(section, keyword)
1815 CALL keyword_release(keyword)
1816
1817 CALL keyword_create(keyword, __location__, name="DC", &
1818 description="Defines the DC parameter of the Goodwin potential", &
1819 usage="DC {real}", type_of_var=real_t, &
1820 n_var=1, unit_str="angstrom")
1821 CALL section_add_keyword(section, keyword)
1822 CALL keyword_release(keyword)
1823
1824 CALL keyword_create(keyword, __location__, name="M", &
1825 description="Defines the M parameter of the Goodwin potential", &
1826 usage="M {real}", type_of_var=integer_t, &
1827 n_var=1)
1828 CALL section_add_keyword(section, keyword)
1829 CALL keyword_release(keyword)
1830
1831 CALL keyword_create(keyword, __location__, name="MC", &
1832 description="Defines the MC parameter of the Goodwin potential", &
1833 usage="MC {real}", type_of_var=integer_t, &
1834 n_var=1)
1835 CALL section_add_keyword(section, keyword)
1836 CALL keyword_release(keyword)
1837
1838 CALL keyword_create(keyword, __location__, name="RCUT", &
1839 description="Defines the cutoff parameter of the Goodwin potential", &
1840 usage="RCUT {real}", default_r_val=cp_unit_to_cp2k(value=10.0_dp, &
1841 unit_str="angstrom"), &
1842 unit_str="angstrom")
1843 CALL section_add_keyword(section, keyword)
1844 CALL keyword_release(keyword)
1845
1846 CALL keyword_create(keyword, __location__, name="RMIN", &
1847 description="Defines the lower bound of the potential. If not set the range is the"// &
1848 " full range generate by the spline", usage="RMIN {real}", &
1849 type_of_var=real_t, unit_str="angstrom")
1850 CALL section_add_keyword(section, keyword)
1851 CALL keyword_release(keyword)
1852
1853 CALL keyword_create(keyword, __location__, name="RMAX", &
1854 description="Defines the upper bound of the potential. If not set the range is the"// &
1855 " full range generate by the spline", usage="RMAX {real}", &
1856 type_of_var=real_t, unit_str="angstrom")
1857 CALL section_add_keyword(section, keyword)
1858 CALL keyword_release(keyword)
1859
1860 END SUBROUTINE create_goodwin_section
1861
1862! **************************************************************************************************
1863!> \brief This section specifies the input parameters for IPBV potential type
1864!> \param section the section to create
1865!> \author teo
1866! **************************************************************************************************
1867 SUBROUTINE create_ipbv_section(section)
1868 TYPE(section_type), POINTER :: section
1869
1870 TYPE(keyword_type), POINTER :: keyword
1871
1872 cpassert(.NOT. ASSOCIATED(section))
1873 CALL section_create(section, __location__, name="ipbv", &
1874 description="This section specifies the input parameters for IPBV potential type. "// &
1875 "Functional form: Implicit table function.", &
1876 n_keywords=1, n_subsections=0, repeats=.true.)
1877
1878 NULLIFY (keyword)
1879
1880 CALL keyword_create(keyword, __location__, name="ATOMS", &
1881 description="Defines the atomic kind involved in the IPBV nonbond potential", &
1882 usage="ATOMS {KIND1} {KIND2}", type_of_var=char_t, &
1883 n_var=2)
1884 CALL section_add_keyword(section, keyword)
1885 CALL keyword_release(keyword)
1886
1887 CALL keyword_create(keyword, __location__, name="RCUT", &
1888 description="Defines the cutoff parameter of the IPBV potential", &
1889 usage="RCUT {real}", default_r_val=cp_unit_to_cp2k(value=10.0_dp, &
1890 unit_str="angstrom"), &
1891 unit_str="angstrom")
1892 CALL section_add_keyword(section, keyword)
1893 CALL keyword_release(keyword)
1894
1895 CALL keyword_create(keyword, __location__, name="RMIN", &
1896 description="Defines the lower bound of the potential. If not set the range is the"// &
1897 " full range generate by the spline", usage="RMIN {real}", &
1898 type_of_var=real_t, unit_str="angstrom")
1899 CALL section_add_keyword(section, keyword)
1900 CALL keyword_release(keyword)
1901
1902 CALL keyword_create(keyword, __location__, name="RMAX", &
1903 description="Defines the upper bound of the potential. If not set the range is the"// &
1904 " full range generate by the spline", usage="RMAX {real}", &
1905 type_of_var=real_t, unit_str="angstrom")
1906 CALL section_add_keyword(section, keyword)
1907 CALL keyword_release(keyword)
1908
1909 END SUBROUTINE create_ipbv_section
1910
1911! **************************************************************************************************
1912!> \brief This section specifies the input parameters for BMHFT potential type
1913!> \param section the section to create
1914!> \author teo
1915! **************************************************************************************************
1916 SUBROUTINE create_bmhft_section(section)
1917 TYPE(section_type), POINTER :: section
1918
1919 TYPE(keyword_type), POINTER :: keyword
1920
1921 cpassert(.NOT. ASSOCIATED(section))
1922 CALL section_create(section, __location__, name="BMHFT", &
1923 description="This section specifies the input parameters for BMHFT potential type. "// &
1924 "Functional form: V(r) = A * EXP(-B*r) - C/r^6 - D/r^8. "// &
1925 "Values available inside cp2k only for the Na/Cl pair.", &
1926 citations=[tosi1964a, tosi1964b], n_keywords=1, n_subsections=0, repeats=.true.)
1927
1928 NULLIFY (keyword)
1929
1930 CALL keyword_create(keyword, __location__, name="ATOMS", &
1931 description="Defines the atomic kind involved in the BMHFT nonbond potential", &
1932 usage="ATOMS {KIND1} {KIND2}", type_of_var=char_t, &
1933 n_var=2)
1934 CALL section_add_keyword(section, keyword)
1935 CALL keyword_release(keyword)
1936
1937 CALL keyword_create(keyword, __location__, name="MAP_ATOMS", &
1938 description="Defines the kinds for which internally is defined the BMHFT nonbond potential"// &
1939 " at the moment only Na and Cl.", &
1940 usage="MAP_ATOMS {KIND1} {KIND2}", type_of_var=char_t, &
1941 n_var=2)
1942 CALL section_add_keyword(section, keyword)
1943 CALL keyword_release(keyword)
1944
1945 CALL keyword_create(keyword, __location__, name="RCUT", &
1946 description="Defines the cutoff parameter of the BMHFT potential", &
1947 usage="RCUT {real}", default_r_val=7.8_dp, &
1948 unit_str="angstrom")
1949 CALL section_add_keyword(section, keyword)
1950 CALL keyword_release(keyword)
1951
1952 CALL keyword_create(keyword, __location__, name="A", &
1953 description="Defines the A parameter of the Fumi-Tosi Potential", &
1954 usage="A {real}", type_of_var=real_t, &
1955 n_var=1, unit_str="hartree")
1956 CALL section_add_keyword(section, keyword)
1957 CALL keyword_release(keyword)
1958
1959 CALL keyword_create(keyword, __location__, name="B", &
1960 description="Defines the B parameter of the Fumi-Tosi Potential", &
1961 usage="B {real}", type_of_var=real_t, &
1962 n_var=1, unit_str="angstrom^-1")
1963 CALL section_add_keyword(section, keyword)
1964 CALL keyword_release(keyword)
1965
1966 CALL keyword_create(keyword, __location__, name="C", &
1967 description="Defines the C parameter of the Fumi-Tosi Potential", &
1968 usage="C {real}", type_of_var=real_t, &
1969 n_var=1, unit_str="hartree*angstrom^6")
1970 CALL section_add_keyword(section, keyword)
1971 CALL keyword_release(keyword)
1972
1973 CALL keyword_create(keyword, __location__, name="D", &
1974 description="Defines the D parameter of the Fumi-Tosi Potential", &
1975 usage="D {real}", type_of_var=real_t, &
1976 n_var=1, unit_str="hartree*angstrom^8")
1977 CALL section_add_keyword(section, keyword)
1978 CALL keyword_release(keyword)
1979
1980 CALL keyword_create(keyword, __location__, name="RMIN", &
1981 description="Defines the lower bound of the potential. If not set the range is the"// &
1982 " full range generate by the spline", usage="RMIN {real}", &
1983 type_of_var=real_t, unit_str="angstrom")
1984 CALL section_add_keyword(section, keyword)
1985 CALL keyword_release(keyword)
1986
1987 CALL keyword_create(keyword, __location__, name="RMAX", &
1988 description="Defines the upper bound of the potential. If not set the range is the"// &
1989 " full range generate by the spline", usage="RMAX {real}", &
1990 type_of_var=real_t, unit_str="angstrom")
1991 CALL section_add_keyword(section, keyword)
1992 CALL keyword_release(keyword)
1993
1994 END SUBROUTINE create_bmhft_section
1995
1996! **************************************************************************************************
1997!> \brief This section specifies the input parameters for BMHFTD potential type
1998!> \param section the section to create
1999!> \par History
2000!> - Unused input keyword ORDER removed (18.10.2021, MK)
2001!> \author Mathieu Salanne 05.2010
2002! **************************************************************************************************
2003 SUBROUTINE create_bmhftd_section(section)
2004 TYPE(section_type), POINTER :: section
2005
2006 TYPE(keyword_type), POINTER :: keyword
2007
2008 cpassert(.NOT. ASSOCIATED(section))
2009 CALL section_create(section, __location__, name="BMHFTD", &
2010 description="This section specifies the input parameters for the BMHFTD potential type. "// &
2011 "Functional form: V(r) = A*exp(-B*r) - f_6*(r)C/r^6 - f_8(r)*D/r^8 "// &
2012 "where f_order(r) = 1 - exp(-BD*r)*\sum_{k=0}^order (BD*r)^k/k! "// &
2013 "(Tang-Toennies damping function). No pre-defined parameter values are available.", &
2014 citations=[tosi1964a, tosi1964b], n_keywords=1, n_subsections=0, repeats=.true.)
2015
2016 NULLIFY (keyword)
2017
2018 CALL keyword_create(keyword, __location__, name="ATOMS", &
2019 description="Defines the atomic kind involved in the BMHFTD nonbond potential", &
2020 usage="ATOMS {KIND1} {KIND2}", type_of_var=char_t, &
2021 n_var=2)
2022 CALL section_add_keyword(section, keyword)
2023 CALL keyword_release(keyword)
2024
2025 CALL keyword_create(keyword, __location__, name="MAP_ATOMS", &
2026 description="Defines the kinds for which internally is defined the BMHFTD nonbond potential"// &
2027 " at the moment no species included.", &
2028 usage="MAP_ATOMS {KIND1} {KIND2}", type_of_var=char_t, &
2029 n_var=2)
2030 CALL section_add_keyword(section, keyword)
2031 CALL keyword_release(keyword)
2032
2033 CALL keyword_create(keyword, __location__, name="RCUT", &
2034 description="Defines the cutoff parameter of the BMHFTD potential", &
2035 usage="RCUT {real}", default_r_val=7.8_dp, &
2036 unit_str="angstrom")
2037 CALL section_add_keyword(section, keyword)
2038 CALL keyword_release(keyword)
2039
2040 CALL keyword_create(keyword, __location__, name="A", &
2041 description="Defines the A parameter of the dispersion-damped Fumi-Tosi potential", &
2042 usage="A {real}", type_of_var=real_t, &
2043 n_var=1, unit_str="hartree")
2044 CALL section_add_keyword(section, keyword)
2045 CALL keyword_release(keyword)
2046
2047 CALL keyword_create(keyword, __location__, name="B", &
2048 description="Defines the B parameter of the dispersion-damped Fumi-Tosi potential", &
2049 usage="B {real}", type_of_var=real_t, &
2050 n_var=1, unit_str="angstrom^-1")
2051 CALL section_add_keyword(section, keyword)
2052 CALL keyword_release(keyword)
2053
2054 CALL keyword_create(keyword, __location__, name="C", &
2055 description="Defines the C parameter of the dispersion-damped Fumi-Tosi potential", &
2056 usage="C {real}", type_of_var=real_t, &
2057 n_var=1, unit_str="hartree*angstrom^6")
2058 CALL section_add_keyword(section, keyword)
2059 CALL keyword_release(keyword)
2060
2061 CALL keyword_create(keyword, __location__, name="D", &
2062 description="Defines the D parameter of the dispersion-damped Fumi-Tosi potential", &
2063 usage="D {real}", type_of_var=real_t, &
2064 n_var=1, unit_str="hartree*angstrom^8")
2065 CALL section_add_keyword(section, keyword)
2066 CALL keyword_release(keyword)
2067
2068 CALL keyword_create(keyword, __location__, name="BD", &
2069 description="Defines the BD parameters of the dispersion-damped Fumi-Tosi potential. "// &
2070 "One or two parameter values are expected. If only one value is provided, then this "// &
2071 "value will be used both for the 6th and the 8th order term.", &
2072 usage="BD {real} {real}", type_of_var=real_t, &
2073 n_var=-1, unit_str="angstrom^-1")
2074 CALL section_add_keyword(section, keyword)
2075 CALL keyword_release(keyword)
2076
2077 CALL keyword_create(keyword, __location__, name="RMIN", &
2078 description="Defines the lower bound of the potential. If not set the range is the"// &
2079 " full range generate by the spline", usage="RMIN {real}", &
2080 type_of_var=real_t, unit_str="angstrom")
2081 CALL section_add_keyword(section, keyword)
2082 CALL keyword_release(keyword)
2083
2084 CALL keyword_create(keyword, __location__, name="RMAX", &
2085 description="Defines the upper bound of the potential. If not set the range is the"// &
2086 " full range generate by the spline", usage="RMAX {real}", &
2087 type_of_var=real_t, unit_str="angstrom")
2088 CALL section_add_keyword(section, keyword)
2089 CALL keyword_release(keyword)
2090
2091 END SUBROUTINE create_bmhftd_section
2092
2093! **************************************************************************************************
2094!> \brief This section specifies the input parameters for Buckingham 4 ranges potential type
2095!> \param section the section to create
2096!> \author MI
2097! **************************************************************************************************
2098 SUBROUTINE create_buck4r_section(section)
2099 TYPE(section_type), POINTER :: section
2100
2101 TYPE(keyword_type), POINTER :: keyword
2102
2103 cpassert(.NOT. ASSOCIATED(section))
2104 CALL section_create(section, __location__, name="BUCK4RANGES", &
2105 description="This section specifies the input parameters for the Buckingham 4-ranges"// &
2106 " potential type."//newline// &
2107 "| Range | Functional Form |"//newline// &
2108 "| ----- | --------------- |"//newline// &
2109 "| $ r < r_1 $ | $ V(r) = A\exp(-Br) $ |"//newline// &
2110 "| $ r_1 \leq r < r_2 $ | $ V(r) = \sum_n \operatorname{POLY1}(n)r_n $ |"//newline// &
2111 "| $ r_2 \leq r < r_3 $ | $ V(r) = \sum_n \operatorname{POLY2}(n)r_n $ |"//newline// &
2112 "| $ r \geq r_3 $ | $ V(r) = -C/r_6 $ |"//newline, &
2113 n_keywords=1, n_subsections=0, repeats=.true.)
2114
2115 NULLIFY (keyword)
2116
2117 CALL keyword_create(keyword, __location__, name="ATOMS", &
2118 description="Defines the atomic kind involved in the nonbond potential", &
2119 usage="ATOMS {KIND1} {KIND2}", type_of_var=char_t, &
2120 n_var=2)
2121 CALL section_add_keyword(section, keyword)
2122 CALL keyword_release(keyword)
2123
2124 CALL keyword_create(keyword, __location__, name="A", &
2125 description="Defines the A parameter of the Buckingham potential", &
2126 usage="A {real}", type_of_var=real_t, &
2127 n_var=1, unit_str="K_e")
2128 CALL section_add_keyword(section, keyword)
2129 CALL keyword_release(keyword)
2130
2131 CALL keyword_create(keyword, __location__, name="B", &
2132 description="Defines the B parameter of the Buckingham potential", &
2133 usage="B {real}", type_of_var=real_t, &
2134 n_var=1, unit_str="angstrom^-1")
2135 CALL section_add_keyword(section, keyword)
2136 CALL keyword_release(keyword)
2137
2138 CALL keyword_create(keyword, __location__, name="C", &
2139 description="Defines the C parameter of the Buckingham potential", &
2140 usage="C {real}", type_of_var=real_t, &
2141 n_var=1, unit_str="K_e*angstrom^6")
2142 CALL section_add_keyword(section, keyword)
2143 CALL keyword_release(keyword)
2144
2145 CALL keyword_create(keyword, __location__, name="R1", &
2146 description="Defines the upper bound of the first range ", &
2147 usage="R1 {real}", type_of_var=real_t, &
2148 n_var=1, unit_str="angstrom")
2149 CALL section_add_keyword(section, keyword)
2150 CALL keyword_release(keyword)
2151
2152 CALL keyword_create(keyword, __location__, name="R2", &
2153 description="Defines the upper bound of the second range ", &
2154 usage="R2 {real}", type_of_var=real_t, &
2155 n_var=1, unit_str="angstrom")
2156 CALL section_add_keyword(section, keyword)
2157 CALL keyword_release(keyword)
2158
2159 CALL keyword_create(keyword, __location__, name="R3", &
2160 description="Defines the upper bound of the third range ", &
2161 usage="R3 {real}", type_of_var=real_t, &
2162 n_var=1, unit_str="angstrom")
2163 CALL section_add_keyword(section, keyword)
2164 CALL keyword_release(keyword)
2165
2166 CALL keyword_create(keyword, __location__, name="POLY1", &
2167 description="Coefficients of the polynomial used in the second range "// &
2168 "This keyword can be repeated several times.", &
2169 usage="POLY1 C1 C2 C3 ..", &
2170 n_var=-1, unit_str="K_e", type_of_var=real_t, repeats=.true.)
2171 CALL section_add_keyword(section, keyword)
2172 CALL keyword_release(keyword)
2173
2174 CALL keyword_create(keyword, __location__, name="POLY2", &
2175 description="Coefficients of the polynomial used in the third range "// &
2176 "This keyword can be repeated several times.", &
2177 usage="POLY2 C1 C2 C3 ..", &
2178 n_var=-1, unit_str="K_e", type_of_var=real_t, repeats=.true.)
2179 CALL section_add_keyword(section, keyword)
2180 CALL keyword_release(keyword)
2181
2182 CALL keyword_create(keyword, __location__, name="RCUT", &
2183 description="Defines the cutoff parameter of the Buckingham potential", &
2184 usage="RCUT {real}", default_r_val=cp_unit_to_cp2k(value=10.0_dp, &
2185 unit_str="angstrom"), &
2186 unit_str="angstrom")
2187 CALL section_add_keyword(section, keyword)
2188 CALL keyword_release(keyword)
2189
2190 CALL keyword_create(keyword, __location__, name="RMIN", &
2191 description="Defines the lower bound of the potential. If not set the range is the"// &
2192 " full range generate by the spline", usage="RMIN {real}", &
2193 type_of_var=real_t, unit_str="angstrom")
2194 CALL section_add_keyword(section, keyword)
2195 CALL keyword_release(keyword)
2196
2197 CALL keyword_create(keyword, __location__, name="RMAX", &
2198 description="Defines the upper bound of the potential. If not set the range is the"// &
2199 " full range generate by the spline", usage="RMAX {real}", &
2200 type_of_var=real_t, unit_str="angstrom")
2201 CALL section_add_keyword(section, keyword)
2202 CALL keyword_release(keyword)
2203
2204 END SUBROUTINE create_buck4r_section
2205
2206! **************************************************************************************************
2207!> \brief This section specifies the input parameters for Buckingham + Morse potential type
2208!> \param section the section to create
2209!> \author MI
2210! **************************************************************************************************
2211 SUBROUTINE create_buckmorse_section(section)
2212 TYPE(section_type), POINTER :: section
2213
2214 TYPE(keyword_type), POINTER :: keyword
2215
2216 cpassert(.NOT. ASSOCIATED(section))
2217 CALL section_create( &
2218 section, __location__, name="BUCKMORSE", &
2219 description="This section specifies the input parameters for"// &
2220 " Buckingham plus Morse potential type"// &
2221 " Functional Form: V(r) = F0*(B1+B2)*EXP([A1+A2-r]/[B1+B2])-C/r^6+D*{EXP[-2*beta*(r-R0)]-2*EXP[-beta*(r-R0)]}.", &
2222 citations=[yamada2000], n_keywords=1, n_subsections=0, repeats=.true.)
2223
2224 NULLIFY (keyword)
2225
2226 CALL keyword_create(keyword, __location__, name="ATOMS", &
2227 description="Defines the atomic kind involved in the nonbond potential", &
2228 usage="ATOMS {KIND1} {KIND2}", type_of_var=char_t, &
2229 n_var=2)
2230 CALL section_add_keyword(section, keyword)
2231 CALL keyword_release(keyword)
2232
2233 CALL keyword_create(keyword, __location__, name="F0", &
2234 description="Defines the f0 parameter of Buckingham+Morse potential", &
2235 usage="F0 {real}", type_of_var=real_t, &
2236 n_var=1, unit_str="K_e*angstrom^-1")
2237 CALL section_add_keyword(section, keyword)
2238 CALL keyword_release(keyword)
2239
2240 CALL keyword_create(keyword, __location__, name="A1", &
2241 description="Defines the A1 parameter of Buckingham+Morse potential", &
2242 usage="A1 {real}", type_of_var=real_t, &
2243 n_var=1, unit_str="angstrom")
2244 CALL section_add_keyword(section, keyword)
2245 CALL keyword_release(keyword)
2246
2247 CALL keyword_create(keyword, __location__, name="A2", &
2248 description="Defines the A2 parameter of Buckingham+Morse potential", &
2249 usage="A2 {real}", type_of_var=real_t, &
2250 n_var=1, unit_str="angstrom")
2251 CALL section_add_keyword(section, keyword)
2252 CALL keyword_release(keyword)
2253
2254 CALL keyword_create(keyword, __location__, name="B1", &
2255 description="Defines the B1 parameter of Buckingham+Morse potential", &
2256 usage="B1 {real}", type_of_var=real_t, &
2257 n_var=1, unit_str="angstrom")
2258 CALL section_add_keyword(section, keyword)
2259 CALL keyword_release(keyword)
2260
2261 CALL keyword_create(keyword, __location__, name="B2", &
2262 description="Defines the B2 parameter of Buckingham+Morse potential", &
2263 usage="B2 {real}", type_of_var=real_t, &
2264 n_var=1, unit_str="angstrom")
2265 CALL section_add_keyword(section, keyword)
2266 CALL keyword_release(keyword)
2267
2268 CALL keyword_create(keyword, __location__, name="C", &
2269 description="Defines the C parameter of Buckingham+Morse potential", &
2270 usage="C {real}", type_of_var=real_t, &
2271 n_var=1, unit_str="K_e*angstrom^6")
2272 CALL section_add_keyword(section, keyword)
2273 CALL keyword_release(keyword)
2274
2275 CALL keyword_create(keyword, __location__, name="D", &
2276 description="Defines the amplitude for the Morse part ", &
2277 usage="D {real}", type_of_var=real_t, &
2278 n_var=1, unit_str="K_e")
2279 CALL section_add_keyword(section, keyword)
2280 CALL keyword_release(keyword)
2281
2282 CALL keyword_create(keyword, __location__, name="R0", &
2283 description="Defines the equilibrium distance for the Morse part ", &
2284 usage="R0 {real}", type_of_var=real_t, &
2285 n_var=1, unit_str="angstrom")
2286 CALL section_add_keyword(section, keyword)
2287 CALL keyword_release(keyword)
2288
2289 CALL keyword_create(keyword, __location__, name="Beta", &
2290 description="Defines the width for the Morse part ", &
2291 usage="Beta {real}", type_of_var=real_t, &
2292 n_var=1, unit_str="angstrom^-1")
2293 CALL section_add_keyword(section, keyword)
2294 CALL keyword_release(keyword)
2295
2296 CALL keyword_create(keyword, __location__, name="RCUT", &
2297 description="Defines the cutoff parameter of the Buckingham potential", &
2298 usage="RCUT {real}", default_r_val=cp_unit_to_cp2k(value=10.0_dp, &
2299 unit_str="angstrom"), &
2300 unit_str="angstrom")
2301 CALL section_add_keyword(section, keyword)
2302 CALL keyword_release(keyword)
2303
2304 CALL keyword_create(keyword, __location__, name="RMIN", &
2305 description="Defines the lower bound of the potential. If not set the range is the"// &
2306 " full range generate by the spline", usage="RMIN {real}", &
2307 type_of_var=real_t, unit_str="angstrom")
2308 CALL section_add_keyword(section, keyword)
2309 CALL keyword_release(keyword)
2310
2311 CALL keyword_create(keyword, __location__, name="RMAX", &
2312 description="Defines the upper bound of the potential. If not set the range is the"// &
2313 " full range generate by the spline", usage="RMAX {real}", &
2314 type_of_var=real_t, unit_str="angstrom")
2315 CALL section_add_keyword(section, keyword)
2316 CALL keyword_release(keyword)
2317
2318 END SUBROUTINE create_buckmorse_section
2319
2320! **************************************************************************************************
2321!> \brief This section specifies the input parameters for Tersoff potential type
2322!> (Tersoff, J. PRB 39(8), 5566, 1989)
2323!> \param section ...
2324! **************************************************************************************************
2325 SUBROUTINE create_tersoff_section(section)
2326 TYPE(section_type), POINTER :: section
2327
2328 TYPE(keyword_type), POINTER :: keyword
2329
2330 cpassert(.NOT. ASSOCIATED(section))
2331 CALL section_create(section, __location__, name="TERSOFF", &
2332 description="This section specifies the input parameters for Tersoff potential type.", &
2333 citations=[tersoff1988], n_keywords=1, n_subsections=0, repeats=.true.)
2334
2335 NULLIFY (keyword)
2336
2337 CALL keyword_create(keyword, __location__, name="ATOMS", &
2338 description="Defines the atomic kind involved in the nonbond potential", &
2339 usage="ATOMS {KIND1} {KIND2}", type_of_var=char_t, &
2340 n_var=2)
2341 CALL section_add_keyword(section, keyword)
2342 CALL keyword_release(keyword)
2343
2344 CALL keyword_create(keyword, __location__, name="A", &
2345 description="Defines the A parameter of Tersoff potential", &
2346 usage="A {real}", type_of_var=real_t, &
2347 default_r_val=cp_unit_to_cp2k(value=1.8308e3_dp, &
2348 unit_str="eV"), &
2349 n_var=1, unit_str="eV")
2350 CALL section_add_keyword(section, keyword)
2351 CALL keyword_release(keyword)
2352
2353 CALL keyword_create(keyword, __location__, name="B", &
2354 description="Defines the B parameter of Tersoff potential", &
2355 usage="B {real}", type_of_var=real_t, &
2356 default_r_val=cp_unit_to_cp2k(value=4.7118e2_dp, &
2357 unit_str="eV"), &
2358 n_var=1, unit_str="eV")
2359 CALL section_add_keyword(section, keyword)
2360 CALL keyword_release(keyword)
2361
2362 CALL keyword_create(keyword, __location__, name="lambda1", &
2363 description="Defines the lambda1 parameter of Tersoff potential", &
2364 usage="lambda1 {real}", type_of_var=real_t, &
2365 default_r_val=cp_unit_to_cp2k(value=2.4799_dp, &
2366 unit_str="angstrom^-1"), &
2367 n_var=1, unit_str="angstrom^-1")
2368 CALL section_add_keyword(section, keyword)
2369 CALL keyword_release(keyword)
2370
2371 CALL keyword_create(keyword, __location__, name="lambda2", &
2372 description="Defines the lambda2 parameter of Tersoff potential", &
2373 usage="lambda2 {real}", type_of_var=real_t, &
2374 default_r_val=cp_unit_to_cp2k(value=1.7322_dp, &
2375 unit_str="angstrom^-1"), &
2376 n_var=1, unit_str="angstrom^-1")
2377 CALL section_add_keyword(section, keyword)
2378 CALL keyword_release(keyword)
2379
2380 CALL keyword_create(keyword, __location__, name="alpha", &
2381 description="Defines the alpha parameter of Tersoff potential", &
2382 usage="alpha {real}", type_of_var=real_t, &
2383 default_r_val=0.0_dp, &
2384 n_var=1)
2385 CALL section_add_keyword(section, keyword)
2386 CALL keyword_release(keyword)
2387
2388 CALL keyword_create(keyword, __location__, name="beta", &
2389 description="Defines the beta parameter of Tersoff potential", &
2390 usage="beta {real}", type_of_var=real_t, &
2391 default_r_val=1.0999e-6_dp, &
2392 n_var=1, unit_str="")
2393 CALL section_add_keyword(section, keyword)
2394 CALL keyword_release(keyword)
2395
2396 CALL keyword_create(keyword, __location__, name="n", &
2397 description="Defines the n parameter of Tersoff potential", &
2398 usage="n {real}", type_of_var=real_t, &
2399 default_r_val=7.8734e-1_dp, &
2400 n_var=1, unit_str="")
2401 CALL section_add_keyword(section, keyword)
2402 CALL keyword_release(keyword)
2403
2404 CALL keyword_create(keyword, __location__, name="c", &
2405 description="Defines the c parameter of Tersoff potential", &
2406 usage="c {real}", type_of_var=real_t, &
2407 default_r_val=1.0039e5_dp, &
2408 n_var=1, unit_str="")
2409 CALL section_add_keyword(section, keyword)
2410 CALL keyword_release(keyword)
2411
2412 CALL keyword_create(keyword, __location__, name="d", &
2413 description="Defines the d parameter of Tersoff potential", &
2414 usage="d {real}", type_of_var=real_t, &
2415 default_r_val=1.6218e1_dp, &
2416 n_var=1, unit_str="")
2417 CALL section_add_keyword(section, keyword)
2418 CALL keyword_release(keyword)
2419
2420 CALL keyword_create(keyword, __location__, name="h", &
2421 description="Defines the h parameter of Tersoff potential", &
2422 usage="h {real}", type_of_var=real_t, &
2423 default_r_val=-5.9826e-1_dp, &
2424 n_var=1, unit_str="")
2425 CALL section_add_keyword(section, keyword)
2426 CALL keyword_release(keyword)
2427
2428 CALL keyword_create(keyword, __location__, name="lambda3", &
2429 description="Defines the lambda3 parameter of Tersoff potential", &
2430 usage="lambda3 {real}", type_of_var=real_t, &
2431 default_r_val=cp_unit_to_cp2k(value=1.7322_dp, &
2432 unit_str="angstrom^-1"), &
2433 n_var=1, unit_str="angstrom^-1")
2434 CALL section_add_keyword(section, keyword)
2435 CALL keyword_release(keyword)
2436
2437 CALL keyword_create(keyword, __location__, name="bigR", &
2438 description="Defines the bigR parameter of Tersoff potential", &
2439 usage="bigR {real}", type_of_var=real_t, &
2440 default_r_val=cp_unit_to_cp2k(value=2.85_dp, &
2441 unit_str="angstrom"), &
2442 n_var=1, unit_str="angstrom")
2443 CALL section_add_keyword(section, keyword)
2444 CALL keyword_release(keyword)
2445
2446 CALL keyword_create(keyword, __location__, name="bigD", &
2447 description="Defines the D parameter of Tersoff potential", &
2448 usage="bigD {real}", type_of_var=real_t, &
2449 default_r_val=cp_unit_to_cp2k(value=0.15_dp, &
2450 unit_str="angstrom"), &
2451 n_var=1, unit_str="angstrom")
2452 CALL section_add_keyword(section, keyword)
2453 CALL keyword_release(keyword)
2454
2455 CALL keyword_create(keyword, __location__, name="RCUT", &
2456 description="Defines the cutoff parameter of the tersoff potential."// &
2457 " This parameter is in principle already defined by the values of"// &
2458 " bigD and bigR. But it is necessary to define it when using the tersoff"// &
2459 " in conjunction with other potentials (for the same atomic pair) in order to have"// &
2460 " the same consistent definition of RCUT for all potentials.", &
2461 usage="RCUT {real}", type_of_var=real_t, &
2462 n_var=1, unit_str="angstrom")
2463 CALL section_add_keyword(section, keyword)
2464 CALL keyword_release(keyword)
2465
2466 END SUBROUTINE create_tersoff_section
2467
2468! **************************************************************************************************
2469!> \brief This section specifies the input parameters for Siepmann-Sprik
2470!> potential type
2471!> (Siepmann and Sprik, J. Chem. Phys. 102(1) 511, 1995)
2472!> \param section ...
2473! **************************************************************************************************
2474 SUBROUTINE create_siepmann_section(section)
2475 TYPE(section_type), POINTER :: section
2476
2477 TYPE(keyword_type), POINTER :: keyword
2478
2479 cpassert(.NOT. ASSOCIATED(section))
2480 CALL section_create(section, __location__, name="SIEPMANN", &
2481 description="This section specifies the input parameters for the"// &
2482 " Siepmann-Sprik potential type. Consists of 4 terms:"// &
2483 " T1+T2+T3+T4. The terms T1=A/rij^alpha and T2=-C/rij^6"// &
2484 " have to be given via the GENPOT section. The terms T3+T4"// &
2485 " are obtained from the SIEPMANN section. The Siepmann-Sprik"// &
2486 " potential is designed for water-metal chemisorption.", &
2487 citations=[siepmann1995], n_keywords=1, n_subsections=0, repeats=.true.)
2488
2489 NULLIFY (keyword)
2490
2491 CALL keyword_create(keyword, __location__, name="ATOMS", &
2492 description="Defines the atomic kind involved in the nonbond potential", &
2493 usage="ATOMS {KIND1} {KIND2}", type_of_var=char_t, &
2494 n_var=2)
2495 CALL section_add_keyword(section, keyword)
2496 CALL keyword_release(keyword)
2497
2498 CALL keyword_create(keyword, __location__, name="B", &
2499 description="Defines the B parameter of Siepmann potential", &
2500 usage="B {real}", type_of_var=real_t, &
2501 default_r_val=cp_unit_to_cp2k(value=0.6_dp, &
2502 unit_str="angstrom"), &
2503 n_var=1, unit_str="angstrom")
2504 CALL section_add_keyword(section, keyword)
2505 CALL keyword_release(keyword)
2506
2507 CALL keyword_create(keyword, __location__, name="D", &
2508 description="Defines the D parameter of Siepmann potential", &
2509 usage="D {real}", type_of_var=real_t, &
2510 default_r_val=cp_unit_to_cp2k(value=3.688388_dp, &
2511 unit_str="internal_cp2k"), &
2512 n_var=1, unit_str="internal_cp2k")
2513 CALL section_add_keyword(section, keyword)
2514 CALL keyword_release(keyword)
2515
2516 CALL keyword_create(keyword, __location__, name="E", &
2517 description="Defines the E parameter of Siepmann potential", &
2518 usage="E {real}", type_of_var=real_t, &
2519 default_r_val=cp_unit_to_cp2k(value=9.069025_dp, &
2520 unit_str="internal_cp2k"), &
2521 n_var=1, unit_str="internal_cp2k")
2522 CALL section_add_keyword(section, keyword)
2523 CALL keyword_release(keyword)
2524
2525 CALL keyword_create(keyword, __location__, name="F", &
2526 description="Defines the F parameter of Siepmann potential", &
2527 usage="F {real}", type_of_var=real_t, &
2528 default_r_val=13.3_dp, n_var=1)
2529 CALL section_add_keyword(section, keyword)
2530 CALL keyword_release(keyword)
2531!
2532 CALL keyword_create(keyword, __location__, name="beta", &
2533 description="Defines the beta parameter of Siepmann potential", &
2534 usage="beta {real}", type_of_var=real_t, &
2535 default_r_val=10.0_dp, n_var=1)
2536 CALL section_add_keyword(section, keyword)
2537 CALL keyword_release(keyword)
2538!
2539 CALL keyword_create(keyword, __location__, name="RCUT", &
2540 description="Defines the cutoff parameter of Siepmann potential", &
2541 usage="RCUT {real}", type_of_var=real_t, &
2542 default_r_val=cp_unit_to_cp2k(value=3.2_dp, &
2543 unit_str="angstrom"), &
2544 n_var=1, unit_str="angstrom")
2545 CALL section_add_keyword(section, keyword)
2546 CALL keyword_release(keyword)
2547!
2548 CALL keyword_create(keyword, __location__, name="ALLOW_OH_FORMATION", &
2549 description=" The Siepmann-Sprik potential is actually designed for intact"// &
2550 " water molecules only. If water is treated at the QM level,"// &
2551 " water molecules can potentially dissociate, i.e."// &
2552 " some O-H bonds might be stretched leading temporarily"// &
2553 " to the formation of OH- ions. This keyword allows the"// &
2554 " the formation of such ions. The T3 term (dipole term)"// &
2555 " is then switched off for evaluating the interaction"// &
2556 " between the OH- ion and the metal.", &
2557 usage="ALLOW_OH_FORMATION TRUE", &
2558 default_l_val=.false., lone_keyword_l_val=.true.)
2559 CALL section_add_keyword(section, keyword)
2560 CALL keyword_release(keyword)
2561
2562 CALL keyword_create(keyword, __location__, name="ALLOW_H3O_FORMATION", &
2563 description=" The Siepmann-Sprik potential is designed for intact water"// &
2564 " molecules only. If water is treated at the QM level"// &
2565 " and an acid is present, hydronium ions might occur."// &
2566 " This keyword allows the formation of hydronium ions."// &
2567 " The T3 term (dipole term) is switched off for evaluating"// &
2568 " the interaction between hydronium and the metal.", &
2569 usage="ALLOW_H3O_FORMATION TRUE", &
2570 default_l_val=.false., lone_keyword_l_val=.true.)
2571 CALL section_add_keyword(section, keyword)
2572 CALL keyword_release(keyword)
2573
2574 CALL keyword_create(keyword, __location__, name="ALLOW_O_FORMATION", &
2575 description=" The Siepmann-Sprik potential is actually designed for intact"// &
2576 " water molecules only. If water is treated at the QM level,"// &
2577 " water molecules can potentially dissociate, i.e."// &
2578 " some O-H bonds might be stretched leading temporarily"// &
2579 " to the formation of O^2- ions. This keyword allows the"// &
2580 " the formation of such ions. The T3 term (dipole term)"// &
2581 " is then switched off for evaluating the interaction"// &
2582 " between the O^2- ion and the metal.", &
2583 usage="ALLOW_O_FORMATION .TRUE.", &
2584 default_l_val=.false., lone_keyword_l_val=.true.)
2585 CALL section_add_keyword(section, keyword)
2586 CALL keyword_release(keyword)
2587
2588 END SUBROUTINE create_siepmann_section
2589
2590! **************************************************************************************************
2591!> \brief This section specifies the input parameters for GAL19
2592!> potential type
2593!> (??)
2594!> \param section ...
2595! **************************************************************************************************
2596 SUBROUTINE create_gal_section(section)
2597 TYPE(section_type), POINTER :: section
2598
2599 TYPE(keyword_type), POINTER :: keyword
2600 TYPE(section_type), POINTER :: subsection
2601
2602 cpassert(.NOT. ASSOCIATED(section))
2603 CALL section_create(section, __location__, name="GAL19", &
2604 description="Implementation of the GAL19 forcefield, see associated paper", &
2605 citations=[clabaut2020], n_keywords=1, n_subsections=1, repeats=.true.)
2606
2607 NULLIFY (keyword, subsection)
2608
2609 CALL keyword_create(keyword, __location__, name="ATOMS", &
2610 description="Defines the atomic kind involved in the nonbond potential", &
2611 usage="ATOMS {KIND1} {KIND2}", type_of_var=char_t, &
2612 n_var=2)
2613 CALL section_add_keyword(section, keyword)
2614 CALL keyword_release(keyword)
2615
2616 CALL keyword_create(keyword, __location__, name="METALS", &
2617 description="Defines the two atomic kinds to be considered as part of the metallic phase in the system", &
2618 usage="METALS {KIND1} {KIND2} ..", type_of_var=char_t, &
2619 n_var=2)
2620 CALL section_add_keyword(section, keyword)
2621 CALL keyword_release(keyword)
2622
2623 CALL keyword_create(keyword, __location__, name="epsilon", &
2624 description="Defines the epsilon_a parameter of GAL19 potential", &
2625 usage="epsilon {real}", type_of_var=real_t, &
2626 default_r_val=cp_unit_to_cp2k(value=0.6_dp, &
2627 unit_str="kcalmol"), &
2628 n_var=1, unit_str="kcalmol")
2629 CALL section_add_keyword(section, keyword)
2630 CALL keyword_release(keyword)
2631
2632 CALL keyword_create(keyword, __location__, name="bxy", &
2633 description="Defines the b perpendicular parameter of GAL19 potential", &
2634 usage="bxy {real}", type_of_var=real_t, &
2635 default_r_val=cp_unit_to_cp2k(value=3.688388_dp, &
2636 unit_str="internal_cp2k"), &
2637 n_var=1, unit_str="angstrom^-2")
2638 CALL section_add_keyword(section, keyword)
2639 CALL keyword_release(keyword)
2640
2641 CALL keyword_create(keyword, __location__, name="bz", &
2642 description="Defines the b parallel parameter of GAL19 potential", &
2643 usage="bz {real}", type_of_var=real_t, &
2644 default_r_val=cp_unit_to_cp2k(value=9.069025_dp, &
2645 unit_str="internal_cp2k"), &
2646 n_var=1, unit_str="angstrom^-2")
2647 CALL section_add_keyword(section, keyword)
2648 CALL keyword_release(keyword)
2649
2650 CALL keyword_create(keyword, __location__, name="r", &
2651 description="Defines the R_0 parameters of GAL19 potential for the two METALS. "// &
2652 "This is the only parameter that is shared between the two section of the "// &
2653 "forcefield in the case of two metals (alloy). "// &
2654 "If one metal only is present, a second number should be given but won't be read", &
2655 usage="r {real} {real}", type_of_var=real_t, n_var=2, unit_str="angstrom")
2656 CALL section_add_keyword(section, keyword)
2657 CALL keyword_release(keyword)
2658
2659 CALL keyword_create(keyword, __location__, name="a1", &
2660 description="Defines the a1 parameter of GAL19 potential", &
2661 usage="a1 {real}", type_of_var=real_t, &
2662 default_r_val=10.0_dp, n_var=1, unit_str="kcalmol")
2663 CALL section_add_keyword(section, keyword)
2664 CALL keyword_release(keyword)
2665
2666 CALL keyword_create(keyword, __location__, name="a2", &
2667 description="Defines the a2 parameter of GAL19 potential", &
2668 usage="a2 {real}", type_of_var=real_t, &
2669 default_r_val=10.0_dp, n_var=1, unit_str="kcalmol")
2670 CALL section_add_keyword(section, keyword)
2671 CALL keyword_release(keyword)
2672
2673 CALL keyword_create(keyword, __location__, name="a3", &
2674 description="Defines the a3 parameter of GAL19 potential", &
2675 usage="a3 {real}", type_of_var=real_t, &
2676 default_r_val=10.0_dp, n_var=1, unit_str="kcalmol")
2677 CALL section_add_keyword(section, keyword)
2678 CALL keyword_release(keyword)
2679
2680 CALL keyword_create(keyword, __location__, name="a4", &
2681 description="Defines the a4 parameter of GAL19 potential", &
2682 usage="a4 {real}", type_of_var=real_t, &
2683 default_r_val=10.0_dp, n_var=1, unit_str="kcalmol")
2684 CALL section_add_keyword(section, keyword)
2685 CALL keyword_release(keyword)
2686
2687 CALL keyword_create(keyword, __location__, name="A", &
2688 description="Defines the A parameter of GAL19 potential", &
2689 usage="A {real}", type_of_var=real_t, &
2690 default_r_val=10.0_dp, n_var=1, unit_str="kcalmol")
2691 CALL section_add_keyword(section, keyword)
2692 CALL keyword_release(keyword)
2693
2694 CALL keyword_create(keyword, __location__, name="B", &
2695 description="Defines the B parameter of GAL19 potential", &
2696 usage="B {real}", type_of_var=real_t, &
2697 default_r_val=10.0_dp, n_var=1, unit_str="angstrom^-1")
2698 CALL section_add_keyword(section, keyword)
2699 CALL keyword_release(keyword)
2700
2701 CALL keyword_create(keyword, __location__, name="C", &
2702 description="Defines the C parameter of GAL19 potential", &
2703 usage="C {real}", type_of_var=real_t, &
2704 default_r_val=10.0_dp, n_var=1, unit_str="angstrom^6*kcalmol")
2705 CALL section_add_keyword(section, keyword)
2706 CALL keyword_release(keyword)
2707
2708 CALL keyword_create(keyword, __location__, name="RCUT", &
2709 description="Defines the cutoff parameter of GAL19 potential", &
2710 usage="RCUT {real}", type_of_var=real_t, &
2711 default_r_val=cp_unit_to_cp2k(value=3.2_dp, &
2712 unit_str="angstrom"), &
2713 n_var=1, unit_str="angstrom")
2714 CALL section_add_keyword(section, keyword)
2715 CALL keyword_release(keyword)
2716 CALL keyword_create(keyword, __location__, name="Fit_express", &
2717 description="Demands the particular output needed to a least square fit", &
2718 usage="Fit_express TRUE", &
2719 default_l_val=.false., lone_keyword_l_val=.true.)
2720 CALL section_add_keyword(section, keyword)
2721 CALL keyword_release(keyword)
2722 CALL create_gcn_section(subsection)
2723 CALL section_add_subsection(section, subsection)
2724 CALL section_release(subsection)
2725
2726 END SUBROUTINE create_gal_section
2727
2728! **************************************************************************************************
2729!> \brief This section specifies the input parameters for GAL21
2730!> potential type
2731!> (??)
2732!> \param section ...
2733! **************************************************************************************************
2734 SUBROUTINE create_gal21_section(section)
2735 TYPE(section_type), POINTER :: section
2736
2737 TYPE(keyword_type), POINTER :: keyword
2738 TYPE(section_type), POINTER :: subsection
2739
2740 cpassert(.NOT. ASSOCIATED(section))
2741 CALL section_create(section, __location__, name="GAL21", &
2742 description="Implementation of the GAL21 forcefield, see associated paper", &
2743 citations=[clabaut2021], n_keywords=1, n_subsections=1, repeats=.true.)
2744
2745 NULLIFY (keyword, subsection)
2746
2747 CALL keyword_create(keyword, __location__, name="ATOMS", &
2748 description="Defines the atomic kind involved in the nonbond potential", &
2749 usage="ATOMS {KIND1} {KIND2}", type_of_var=char_t, &
2750 n_var=2)
2751 CALL section_add_keyword(section, keyword)
2752 CALL keyword_release(keyword)
2753
2754 CALL keyword_create(keyword, __location__, name="METALS", &
2755 description="Defines the two atomic kinds to be considered as part of the metallic phase in the system", &
2756 usage="METALS {KIND1} {KIND2} ..", type_of_var=char_t, &
2757 n_var=2)
2758 CALL section_add_keyword(section, keyword)
2759 CALL keyword_release(keyword)
2760
2761 CALL keyword_create(keyword, __location__, name="epsilon", &
2762 description="Defines the epsilon parameter of GAL21 potential", &
2763 usage="epsilon {real} {real} {real}", type_of_var=real_t, &
2764 n_var=3, unit_str="kcalmol")
2765 CALL section_add_keyword(section, keyword)
2766 CALL keyword_release(keyword)
2767
2768 CALL keyword_create(keyword, __location__, name="bxy", &
2769 description="Defines the b perpendicular parameter of GAL21 potential", &
2770 usage="bxy {real} {real}", type_of_var=real_t, &
2771 n_var=2, unit_str="angstrom^-2")
2772 CALL section_add_keyword(section, keyword)
2773 CALL keyword_release(keyword)
2774
2775 CALL keyword_create(keyword, __location__, name="bz", &
2776 description="Defines the b parallel parameter of GAL21 potential", &
2777 usage="bz {real} {real}", type_of_var=real_t, &
2778 n_var=2, unit_str="angstrom^-2")
2779 CALL section_add_keyword(section, keyword)
2780 CALL keyword_release(keyword)
2781
2782 CALL keyword_create(keyword, __location__, name="r", &
2783 description="Defines the R_0 parameters of GAL21 potential for the two METALS. "// &
2784 "This is the only parameter that is shared between the two section of "// &
2785 "the forcefield in the case of two metals (alloy). "// &
2786 "If one metal only is present, a second number should be given but won't be read", &
2787 usage="r {real} {real}", type_of_var=real_t, n_var=2, unit_str="angstrom")
2788 CALL section_add_keyword(section, keyword)
2789 CALL keyword_release(keyword)
2790
2791 CALL keyword_create(keyword, __location__, name="a1", &
2792 description="Defines the a1 parameter of GAL21 potential", &
2793 usage="a1 {real} {real} {real}", type_of_var=real_t, &
2794 n_var=3, unit_str="kcalmol")
2795 CALL section_add_keyword(section, keyword)
2796 CALL keyword_release(keyword)
2797
2798 CALL keyword_create(keyword, __location__, name="a2", &
2799 description="Defines the a2 parameter of GAL21 potential", &
2800 usage="a2 {real} {real} {real}", type_of_var=real_t, &
2801 n_var=3, unit_str="kcalmol")
2802 CALL section_add_keyword(section, keyword)
2803 CALL keyword_release(keyword)
2804
2805 CALL keyword_create(keyword, __location__, name="a3", &
2806 description="Defines the a3 parameter of GAL21 potential", &
2807 usage="a3 {real} {real} {real}", type_of_var=real_t, &
2808 n_var=3, unit_str="kcalmol")
2809 CALL section_add_keyword(section, keyword)
2810 CALL keyword_release(keyword)
2811
2812 CALL keyword_create(keyword, __location__, name="a4", &
2813 description="Defines the a4 parameter of GAL21 potential", &
2814 usage="a4 {real} {real} {real}", type_of_var=real_t, &
2815 n_var=3, unit_str="kcalmol")
2816 CALL section_add_keyword(section, keyword)
2817 CALL keyword_release(keyword)
2818
2819 CALL keyword_create(keyword, __location__, name="A", &
2820 description="Defines the A parameter of GAL21 potential", &
2821 usage="A {real} {real}", type_of_var=real_t, &
2822 n_var=2, unit_str="kcalmol")
2823 CALL section_add_keyword(section, keyword)
2824 CALL keyword_release(keyword)
2825
2826 CALL keyword_create(keyword, __location__, name="B", &
2827 description="Defines the B parameter of GAL21 potential", &
2828 usage="B {real} {real}", type_of_var=real_t, &
2829 n_var=2, unit_str="angstrom^-1")
2830 CALL section_add_keyword(section, keyword)
2831 CALL keyword_release(keyword)
2832
2833 CALL keyword_create(keyword, __location__, name="C", &
2834 description="Defines the C parameter of GAL21 potential", &
2835 usage="C {real}", type_of_var=real_t, &
2836 n_var=1, unit_str="angstrom^6*kcalmol")
2837 CALL section_add_keyword(section, keyword)
2838 CALL keyword_release(keyword)
2839
2840 CALL keyword_create(keyword, __location__, name="AH", &
2841 description="Defines the AH parameter of GAL21 potential", &
2842 usage="AH {real} {real}", type_of_var=real_t, &
2843 n_var=2, unit_str="kcalmol")
2844 CALL section_add_keyword(section, keyword)
2845 CALL keyword_release(keyword)
2846
2847 CALL keyword_create(keyword, __location__, name="BH", &
2848 description="Defines the BH parameter of GAL21 potential", &
2849 usage="BH {real} {real}", type_of_var=real_t, &
2850 n_var=2, unit_str="angstrom^-1")
2851 CALL section_add_keyword(section, keyword)
2852 CALL keyword_release(keyword)
2853
2854 CALL keyword_create(keyword, __location__, name="RCUT", &
2855 description="Defines the cutoff parameter of GAL21 potential", &
2856 usage="RCUT {real}", type_of_var=real_t, &
2857 default_r_val=cp_unit_to_cp2k(value=3.2_dp, &
2858 unit_str="angstrom"), &
2859 n_var=1, unit_str="angstrom")
2860 CALL section_add_keyword(section, keyword)
2861 CALL keyword_release(keyword)
2862
2863 CALL keyword_create(keyword, __location__, name="Fit_express", &
2864 description="Demands the particular output needed to a least square fit", &
2865 usage="Fit_express TRUE", &
2866 default_l_val=.false., lone_keyword_l_val=.true.)
2867 CALL section_add_keyword(section, keyword)
2868 CALL keyword_release(keyword)
2869
2870 CALL create_gcn_section(subsection)
2871 CALL section_add_subsection(section, subsection)
2872 CALL section_release(subsection)
2873
2874 END SUBROUTINE create_gal21_section
2875
2876! **************************************************************************************************
2877!> \brief This section specifies the input parameters for TABPOT potential type
2878!> \param section the section to create
2879!> \author teo, Alex Mironenko, Da Teng
2880! **************************************************************************************************
2881 SUBROUTINE create_tabpot_section(section)
2882
2883 TYPE(section_type), POINTER :: section
2884
2885 TYPE(keyword_type), POINTER :: keyword
2886
2887 cpassert(.NOT. ASSOCIATED(section))
2888
2889 CALL section_create(section, __location__, name="TABPOT", &
2890 description="This section specifies the input parameters for TABPOT potential type.", &
2891 n_keywords=1, n_subsections=0, repeats=.true.)
2892
2893 NULLIFY (keyword)
2894 CALL keyword_create(keyword, __location__, name="ATOMS", &
2895 description="Defines the atomic kind involved", &
2896 usage="ATOMS {KIND1} {KIND2}", type_of_var=char_t, &
2897 n_var=2)
2898 CALL section_add_keyword(section, keyword)
2899 CALL keyword_release(keyword)
2900
2901 CALL keyword_create(keyword, __location__, name="PARM_FILE_NAME", &
2902 variants=["PARMFILE"], &
2903 description="Specifies the filename that contains the tabulated NONBONDED potential. "// &
2904 "File structure: the third line of the potential file contains a title. "// &
2905 "The 4th line contains: 'N', number of data points, 'R', lower bound of distance, distance cutoff. "// &
2906 "Follow "// &
2907 "in order npoints lines for index, distance [A], energy [kcal/mol], and force [kcal/mol/A]", &
2908 usage="PARM_FILE_NAME {FILENAME}", default_lc_val="")
2909 CALL section_add_keyword(section, keyword)
2910 CALL keyword_release(keyword)
2911
2912 END SUBROUTINE create_tabpot_section
2913
2914! **************************************************************************************************
2915!> \brief This section specifies the input parameters for the subsection GCN of GAL19 and GAL21
2916!> potential type
2917!> (??)
2918!> \param section ...
2919! **************************************************************************************************
2920 SUBROUTINE create_gcn_section(section)
2921 TYPE(section_type), POINTER :: section
2922
2923 TYPE(keyword_type), POINTER :: keyword
2924
2925 cpassert(.NOT. ASSOCIATED(section))
2926 CALL section_create(section, __location__, name="GCN", &
2927 description="Allow to specify the generalized coordination number of the atoms. "// &
2928 "Those numbers msust be generated by another program ", &
2929 n_keywords=1, n_subsections=0, repeats=.false.)
2930
2931 NULLIFY (keyword)
2932 CALL keyword_create(keyword, __location__, name="_DEFAULT_KEYWORD_", &
2933 description="Value of the GCN for the individual atom. Order MUST reflect"// &
2934 " the one specified for the geometry.", repeats=.true., usage="{Real}", &
2935 default_r_val=0.0_dp, type_of_var=real_t)
2936 CALL section_add_keyword(section, keyword)
2937 CALL keyword_release(keyword)
2938
2939 END SUBROUTINE create_gcn_section
2940
2941! **************************************************************************************************
2942!> \brief creates the input section for the qs part
2943!> \param print_key ...
2944!> \param label ...
2945!> \param print_level ...
2946!> \author teo
2947! **************************************************************************************************
2948 SUBROUTINE create_dipoles_section(print_key, label, print_level)
2949 TYPE(section_type), POINTER :: print_key
2950 CHARACTER(LEN=*), INTENT(IN) :: label
2951 INTEGER, INTENT(IN) :: print_level
2952
2953 TYPE(keyword_type), POINTER :: keyword
2954
2955 cpassert(.NOT. ASSOCIATED(print_key))
2956 CALL cp_print_key_section_create(print_key, __location__, name=trim(label), &
2957 description="Section controlling the calculation of "//trim(label)//"."// &
2958 " Note that the result in the periodic case might be defined modulo a certain period,"// &
2959 " determined by the lattice vectors. During MD, this can lead to jumps.", &
2960 print_level=print_level, filename="__STD_OUT__")
2961
2962 NULLIFY (keyword)
2963 CALL keyword_create(keyword, __location__, &
2964 name="PERIODIC", &
2965 description="Use Berry phase formula (PERIODIC=T) or simple operator (PERIODIC=F). "// &
2966 "The latter normally requires that the CELL is periodic NONE.", &
2967 usage="PERIODIC {logical}", &
2968 repeats=.false., &
2969 n_var=1, &
2970 default_l_val=.true., lone_keyword_l_val=.true.)
2971 CALL section_add_keyword(print_key, keyword)
2972 CALL keyword_release(keyword)
2973
2974 CALL keyword_create(keyword, __location__, name="REFERENCE", &
2975 variants=s2a("REF"), &
2976 description="Define the reference point for the calculation of the electrostatic moment.", &
2977 usage="REFERENCE COM", &
2978 enum_c_vals=s2a("COM", "COAC", "USER_DEFINED", "ZERO"), &
2979 enum_desc=s2a("Use Center of Mass", &
2980 "Use Center of Atomic Charges", &
2981 "Use User Defined Point (Keyword:REF_POINT)", &
2982 "Use Origin of Coordinate System"), &
2983 enum_i_vals=[use_mom_ref_com, &
2987 default_i_val=use_mom_ref_zero)
2988 CALL section_add_keyword(print_key, keyword)
2989 CALL keyword_release(keyword)
2990
2991 CALL keyword_create(keyword, __location__, name="REFERENCE_POINT", &
2992 variants=s2a("REF_POINT"), &
2993 description="Fixed reference point for the calculations of the electrostatic moment.", &
2994 usage="REFERENCE_POINT x y z", &
2995 repeats=.false., &
2996 n_var=3, default_r_vals=[0._dp, 0._dp, 0._dp], &
2997 type_of_var=real_t, &
2998 unit_str='bohr')
2999 CALL section_add_keyword(print_key, keyword)
3000 CALL keyword_release(keyword)
3001 END SUBROUTINE create_dipoles_section
3002
3003END MODULE input_cp2k_mm
collects all references to literature in CP2K as new algorithms / method are included from literature...
integer, save, public tosi1964b
integer, save, public drautz2019
integer, save, public lysogorskiy2021
integer, save, public tersoff1988
integer, save, public dick1958
integer, save, public foiles1986
integer, save, public devynck2012
integer, save, public tosi1964a
integer, save, public bochkarev2024
integer, save, public siepmann1995
integer, save, public zeng2023
integer, save, public yamada2000
integer, save, public batzner2022
integer, save, public mitchell1993
integer, save, public musaelian2023
integer, save, public clabaut2021
integer, save, public wang2018
integer, save, public clabaut2020
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 silent_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:1149
Define all structure types related to force field kinds.
integer, parameter, public do_ff_legendre
integer, parameter, public do_ff_undef
integer, parameter, public do_ff_mm4
integer, parameter, public do_ff_charmm
integer, parameter, public do_ff_mm3
integer, parameter, public do_ff_g87
integer, parameter, public do_ff_g96
integer, parameter, public do_ff_morse
integer, parameter, public do_ff_mm2
integer, parameter, public do_ff_harmonic
integer, parameter, public do_ff_amber
integer, parameter, public do_ff_mixed_bend_stretch
integer, parameter, public do_ff_cubic
integer, parameter, public do_ff_quartic
integer, parameter, public do_ff_fues
integer, parameter, public do_ff_opls
collects all constants needed in input so that they can be used without circular dependencies
integer, parameter, public use_mom_ref_coac
integer, parameter, public use_mom_ref_user
integer, parameter, public use_mom_ref_com
integer, parameter, public use_mom_ref_zero
function that build the field section of the input
subroutine, public create_per_efield_section(section)
creates the section for static periodic fields
creates the mm section of the input
subroutine, public create_genpot_section(section)
This section specifies the input parameters for a generic potential form.
subroutine, public create_williams_section(section)
This section specifies the input parameters for Williams potential type.
subroutine, public create_goodwin_section(section)
This section specifies the input parameters for Goodwin potential type.
subroutine, public create_dipoles_section(print_key, label, print_level)
creates the input section for the qs part
subroutine, public create_charge_section(section)
This section specifies the charge of the MM atoms.
subroutine, public create_nonbonded14_section(section)
This section specifies the input parameters for 1-4 NON-BONDED Interactions.
subroutine, public create_mm_section(section)
Create the input section for FIST.. Come on.. Let's get woohooo.
subroutine, public create_lj_section(section)
This section specifies the input parameters for Lennard-Jones potential type.
subroutine, public create_neighbor_lists_section(section)
This section specifies the input parameters for generation of neighbor lists.
subroutine, public create_tabpot_section(section)
This section specifies the input parameters for TABPOT potential type.
function that build the poisson section of the input
subroutine, public create_poisson_section(section)
Creates the Poisson 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, deprecation_notice)
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
integer, parameter, public default_string_length
Definition kinds.F:57
Utilities for string manipulations.
character(len=1), parameter, public newline
represent a keyword in the input
represent a section of the input file