(git:374b731)
Loading...
Searching...
No Matches
input_cp2k_qmmm.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief creates the qmmm section of the input
10!> \note
11!> moved out of input_cp2k
12!> \par History
13!> 10.2005 split out of input_cp2k
14!> \author teo & fawzi
15! **************************************************************************************************
17 USE bibliography, ONLY: bernstein2009,&
19 golze2013,&
20 laino2005,&
22 USE cell_types, ONLY: use_perd_none
32 USE cp_units, ONLY: cp_unit_to_cp2k
33 USE input_constants, ONLY: &
59 USE input_val_types, ONLY: char_t,&
60 integer_t,&
61 lchar_t,&
62 logical_t,&
63 real_t
64 USE kinds, ONLY: dp
65 USE pw_spline_utils, ONLY: no_precond,&
71 USE string_utilities, ONLY: s2a
72#include "./base/base_uses.f90"
73
74 IMPLICIT NONE
75 PRIVATE
76
77 LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .true.
78 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_cp2k_qmmm'
79
80 PUBLIC :: create_qmmm_section
81
82!***
83CONTAINS
84
85! **************************************************************************************************
86!> \brief Creates the QM/MM section
87!> \param section the section to create
88!> \author teo
89! **************************************************************************************************
90 SUBROUTINE create_qmmm_section(section)
91 TYPE(section_type), POINTER :: section
92
93 TYPE(keyword_type), POINTER :: keyword
94 TYPE(section_type), POINTER :: subsection
95
96 cpassert(.NOT. ASSOCIATED(section))
97 CALL section_create(section, __location__, name="qmmm", &
98 description="Input for QM/MM calculations.", &
99 n_keywords=6, n_subsections=3, repeats=.false., &
100 citations=(/laino2005, laino2006/))
101
102 NULLIFY (keyword, subsection)
103 CALL keyword_create(keyword, __location__, name="E_COUPL", &
104 variants=s2a("QMMM_COUPLING", "ECOUPL"), &
105 description="Specifies the type of the QM - MM electrostatic coupling.", &
106 usage="E_COUPL GAUSS", &
107 enum_c_vals=s2a("NONE", "COULOMB", "GAUSS", "S-WAVE", "POINT_CHARGE"), &
109 enum_desc=s2a("Mechanical coupling (i.e. classical point charge based)", &
110 "Using analytical 1/r potential (Coulomb) - not available for GPW/GAPW", &
111 "Using fast gaussian expansion of the electrostatic potential (Erf(r/rc)/r) "// &
112 "- not available for DFTB.", &
113 "Using fast gaussian expansion of the s-wave electrostatic potential", &
114 "Using quantum mechanics derived point charges interacting with MM charges"), &
115 default_i_val=do_qmmm_none)
116 CALL section_add_keyword(section, keyword)
117 CALL keyword_release(keyword)
118
119 CALL keyword_create(keyword, __location__, name="MM_POTENTIAL_FILE_NAME", &
120 description="Name of the file containing the potential expansion in gaussians. See the "// &
121 "USE_GEEP_LIB keyword.", &
122 usage="MM_POTENTIAL_FILE_NAME {filename}", &
123 default_lc_val="MM_POTENTIAL")
124 CALL section_add_keyword(section, keyword)
125 CALL keyword_release(keyword)
126
127 CALL keyword_create(keyword, __location__, name="use_geep_lib", &
128 description=" This keyword enables the use of the internal GEEP library to generate the "// &
129 "gaussian expansion of the MM potential. Using this keyword there's no need to provide "// &
130 "the MM_POTENTIAL_FILENAME. It expects a number from 2 to 15 (the number of gaussian functions"// &
131 " to be used in the expansion.", &
132 usage="use_geep_lib INTEGER", &
133 default_i_val=0)
134 CALL section_add_keyword(section, keyword)
135 CALL keyword_release(keyword)
136
137 CALL keyword_create(keyword, __location__, name="nocompatibility", &
138 description="This keyword disables the compatibility of QM/MM "// &
139 "potential between CPMD and CP2K implementations. The compatibility"// &
140 " is achieved using an MM potential of the form: Erf[x/rc]/x + (1/rc -2/(pi^1/2*rc))*Exp[-(x/rc)^2]. "// &
141 "This keyword has effect only selecting GAUSS E_COUPLING type.", &
142 usage="nocompatibility LOGICAL", &
143 default_l_val=.false., lone_keyword_l_val=.true.)
144 CALL section_add_keyword(section, keyword)
145 CALL keyword_release(keyword)
146
147 CALL keyword_create(keyword, __location__, name="eps_mm_rspace", &
148 description="Set the threshold for the collocation of the GEEP gaussian functions. "// &
149 "this keyword affects only the GAUSS E_COUPLING.", &
150 usage="eps_mm_rspace real", &
151 default_r_val=1.0e-10_dp)
152 CALL section_add_keyword(section, keyword)
153 CALL keyword_release(keyword)
154
155 CALL keyword_create(keyword, __location__, name="SPHERICAL_CUTOFF", &
156 description="Set the spherical cutoff for the QMMM electrostatic interaction. "// &
157 "This acts like a charge multiplicative factor dependent on cutoff. For MM atoms "// &
158 "farther than the SPHERICAL_CUTOFF(1) their charge is zero. The switch is performed "// &
159 "with a smooth function: 0.5*(1-TANH((r-[SPH_CUT(1)-20*SPH_CUT(2)])/(SPH_CUT(2)))). "// &
160 "Two values are required: the first one is the distance cutoff. The second one controls "// &
161 "the stiffness of the smoothing.", &
162 usage="SPHERICAL_CUTOFF <REAL>", default_r_vals=(/-1.0_dp, 0.0_dp/), n_var=2, &
163 unit_str="angstrom")
164 CALL section_add_keyword(section, keyword)
165 CALL keyword_release(keyword)
166
167 CALL keyword_create(keyword, __location__, name="parallel_scheme", &
168 description="Chooses the parallel_scheme for the long range Potential ", &
169 usage="parallel_scheme (ATOM|GRID)", &
170 enum_c_vals=s2a("ATOM", "GRID"), &
171 enum_desc=s2a("parallelizes on atoms. grids replicated. "// &
172 "Replication of the grids can be quite expensive memory wise if running on a system "// &
173 "with limited memory per core. The grid option may be preferred in this case.", &
174 "parallelizes on grid slices. atoms replicated."), &
175 enum_i_vals=(/do_par_atom, do_par_grid/), &
176 default_i_val=do_par_atom)
177 CALL section_add_keyword(section, keyword)
178 CALL keyword_release(keyword)
179
180 ! Centering keywords
181 CALL keyword_create(keyword, __location__, name="CENTER", &
182 description="This keyword sets when the QM system is automatically "// &
183 "centered. Default is EVERY_STEP.", &
184 usage="center (EVERY_STEP|SETUP_ONLY|NEVER)", &
185 enum_c_vals=s2a("EVERY_STEP", "SETUP_ONLY", "NEVER"), &
186 enum_desc=s2a("Re-center every step", &
187 "Center at first step only", &
188 "Never center"), &
190 default_i_val=do_qmmm_center_every_step)
191 CALL section_add_keyword(section, keyword)
192 CALL keyword_release(keyword)
193
194 CALL keyword_create(keyword, __location__, name="CENTER_TYPE", &
195 description="This keyword specifies how to do the QM system centering.", &
196 usage="center_type (MAX_MINUS_MIN|PBC_AWARE_MAX_MINUS_MIN)", &
197 enum_c_vals=s2a("MAX_MINUS_MIN", "PBC_AWARE_MAX_MINUS_MIN"), &
198 enum_desc=s2a("Center of box defined by maximum coordinate minus minimum coordinate", &
199 "PBC-aware centering (useful for &QMMM&FORCE_MIXING)"), &
201 default_i_val=do_qmmm_center_max_minus_min)
202 CALL section_add_keyword(section, keyword)
203 CALL keyword_release(keyword)
204
205 CALL keyword_create(keyword, __location__, name="CENTER_GRID", &
206 description="This keyword specifies whether the QM system is centered in units of the grid spacing.", &
207 usage="grid_center LOGICAL", &
208 default_l_val=.false.)
209 CALL section_add_keyword(section, keyword)
210 CALL keyword_release(keyword)
211
212 CALL keyword_create(keyword, __location__, name="initial_translation_vector", &
213 description="This keyword specify the initial translation vector to be applied to the system.", &
214 usage="initial_translation_vector <REAL> <REAL> <REAL>", &
215 n_var=3, default_r_vals=(/0.0_dp, 0.0_dp, 0.0_dp/))
216 CALL section_add_keyword(section, keyword)
217 CALL keyword_release(keyword)
218
219 CALL keyword_create( &
220 keyword, __location__, name="DELTA_CHARGE", &
221 description="Additional net charge relative to that specified in DFT section. Used automatically by force mixing", &
222 usage="DELTA_CHARGE q", default_i_val=0, &
223 n_var=1, type_of_var=integer_t, repeats=.false.)
224 CALL section_add_keyword(section, keyword)
225 CALL keyword_release(keyword)
226
227 ! NB: remember to create these
228 CALL create_qmmm_force_mixing_section(subsection)
229 CALL section_add_subsection(section, subsection)
230 CALL section_release(subsection)
231
232 CALL create_qmmm_qm_kinds(subsection)
233 CALL section_add_subsection(section, subsection)
234 CALL section_release(subsection)
235
236 CALL create_qmmm_mm_kinds(subsection)
237 CALL section_add_subsection(section, subsection)
238 CALL section_release(subsection)
239
240 CALL create_cell_section(subsection, periodic=use_perd_none)
241 CALL section_add_subsection(section, subsection)
242 CALL section_release(subsection)
243
244 CALL create_qmmm_periodic_section(subsection)
245 CALL section_add_subsection(section, subsection)
246 CALL section_release(subsection)
247
248 CALL create_qmmm_link_section(subsection)
249 CALL section_add_subsection(section, subsection)
250 CALL section_release(subsection)
251
252 CALL create_qmmm_interp_section(subsection)
253 CALL section_add_subsection(section, subsection)
254 CALL section_release(subsection)
255
256 CALL create_qmmm_forcefield_section(subsection)
257 CALL section_add_subsection(section, subsection)
258 CALL section_release(subsection)
259
260 CALL create_qmmm_walls_section(subsection)
261 CALL section_add_subsection(section, subsection)
262 CALL section_release(subsection)
263
264 CALL create_qmmm_image_charge_section(subsection)
265 CALL section_add_subsection(section, subsection)
266 CALL section_release(subsection)
267
268 CALL create_print_qmmm_section(subsection)
269 CALL section_add_subsection(section, subsection)
270 CALL section_release(subsection)
271
272 END SUBROUTINE create_qmmm_section
273
274! **************************************************************************************************
275!> \brief Input section to create MM kinds sections
276!> \param section ...
277!> \author tlaino
278! **************************************************************************************************
279 SUBROUTINE create_qmmm_mm_kinds(section)
280 TYPE(section_type), POINTER :: section
281
282 TYPE(keyword_type), POINTER :: keyword
283
284 NULLIFY (keyword)
285 cpassert(.NOT. ASSOCIATED(section))
286 CALL section_create(section, __location__, name="MM_KIND", &
287 description="Information about the MM kind in the QM/MM scheme", &
288 n_keywords=2, n_subsections=0, repeats=.true.)
289
290 CALL keyword_create(keyword, __location__, name="_SECTION_PARAMETERS_", &
291 description="The MM kind", usage="O", n_var=1, type_of_var=char_t)
292 CALL section_add_keyword(section, keyword)
293 CALL keyword_release(keyword)
294
295 CALL keyword_create(keyword, __location__, name="RADIUS", &
296 description="Specifies the radius of the atomic kinds", &
297 usage="RADIUS real", n_var=1, type_of_var=real_t, unit_str="angstrom", &
298 default_r_val=cp_unit_to_cp2k(radius_qmmm_default, "angstrom"))
299 CALL section_add_keyword(section, keyword)
300 CALL keyword_release(keyword)
301
302 CALL keyword_create(keyword, __location__, name="CORR_RADIUS", &
303 description="Specifies the correction radius of the atomic kinds"// &
304 " The correction radius is connected to the use of the compatibility keyword.", &
305 usage="RADIUS real", n_var=1, type_of_var=real_t, unit_str="angstrom")
306 CALL section_add_keyword(section, keyword)
307 CALL keyword_release(keyword)
308
309 END SUBROUTINE create_qmmm_mm_kinds
310
311! **************************************************************************************************
312!> \brief Input section to create FORCE_MIXING sections
313!> \param section ...
314!> \author noam
315! **************************************************************************************************
316 SUBROUTINE create_qmmm_force_mixing_section(section)
317 TYPE(section_type), POINTER :: section
318
319 TYPE(keyword_type), POINTER :: keyword
320 TYPE(section_type), POINTER :: link_subsection, print_key, &
321 qm_kinds_subsection, subsection
322
323 NULLIFY (keyword)
324 cpassert(.NOT. ASSOCIATED(section))
325 CALL section_create(section, __location__, name="FORCE_MIXING", &
326 description="This section enables and defines parameters for force-mixing based QM/MM,"// &
327 " which actually does two conventional QM/MM calculations, on a small"// &
328 " and a large QM region, and combines the MM forces from one and QM"// &
329 " forces from the other to create a complete set of forces. Energy is"// &
330 " not conserved (although the QM/MM energy from the large QM region calculation is reported)"// &
331 " so a proper thermostat (i.e. massive, and able to handle dissipation, such as"// &
332 " Adaptive Langevin (AD_LANGEVIN)) must be used. For some propagation algorithms"// &
333 " (NVT and REFTRAJ MD ensembles) algorithm is adaptive,"// &
334 " including molecules hysteretically based on their instantaneous distance from the core region."// &
335 " Information on core/QM/buffer labels can be written in PDB file using"// &
336 " MOTION&PRINT&FORCE_MIXING_LABELS. Will fail if calculation requires a"// &
337 " meaningfull stress, or an energy that is consistent with the forces."// &
338 " For GEO_OPT this means"// &
339 " only MOTION&GEO_OPT&TYPE CG, MOTION&GEO_OPT&CG&LINE_SEARCH&TYPE 2PNT, and"// &
340 " MOTION&GEO_OPT&CG&LINE_SEARCH&2PNT&LINMIN_GRAD_ONLY T", &
341 n_keywords=5, n_subsections=3, repeats=.false., &
342 citations=(/bernstein2009, bernstein2012/))
343
344 CALL keyword_create(keyword, __location__, name="_SECTION_PARAMETERS_", &
345 description="Enables force-mixing", &
346 default_l_val=.false., lone_keyword_l_val=.true.)
347 CALL section_add_keyword(section, keyword)
348 CALL keyword_release(keyword)
349
350 CALL keyword_create(keyword, __location__, name="MOMENTUM_CONSERVATION_TYPE", &
351 description="How to apply force to get momentum conservation", &
352 usage="MOMENTUM_CONSERVATION_TYPE <type>", &
353 enum_c_vals=s2a("NONE", "EQUAL_F", "EQUAL_A"), &
355 enum_desc=s2a("No momentum conservation", &
356 "Equal force on each atom", &
357 "Equal acceleration on each atom"), &
358 default_i_val=do_fm_mom_conserv_equal_a)
359 CALL section_add_keyword(section, keyword)
360 CALL keyword_release(keyword)
361
362 CALL keyword_create(keyword, __location__, name="MOMENTUM_CONSERVATION_REGION", &
363 description="Region to apply correction force to for momentum conservation", &
364 usage="MOMENTUM_CONSERVATION_REGION <label>", &
365 enum_c_vals=s2a("CORE", "QM", "BUFFER"), &
367 enum_desc=s2a("Apply to QM core region", &
368 "Apply to full QM (dynamics) region", &
369 "Apply to QM+buffer regions"), &
370 default_i_val=do_fm_mom_conserv_qm)
371 CALL section_add_keyword(section, keyword)
372 CALL keyword_release(keyword)
373
374 CALL keyword_create(keyword, __location__, name="R_CORE", &
375 description="Specify the inner and outer radii of core QM region."// &
376 " All molecules with any atoms within this distance (hysteretically) of any atoms"// &
377 " specified as QM in enclosing QM/MM section will be core QM atoms in the force-mixing calculation.", &
378 usage="R_CORE <real> <real>", n_var=2, type_of_var=real_t, &
379 default_r_vals=(/cp_unit_to_cp2k(0.0_dp, "angstrom"), &
380 cp_unit_to_cp2k(0.0_dp, "angstrom")/), &
381 unit_str="angstrom")
382 CALL section_add_keyword(section, keyword)
383 CALL keyword_release(keyword)
384
385 CALL keyword_create(keyword, __location__, name="R_QM", &
386 description="Specify the inner and outer radii of QM dynamics region."// &
387 " All molecules with atoms within this distance (hysteretically) of any atoms in"// &
388 " core will follow QM dynamics in the force-mixing calculation.", &
389 usage="R_QM <real> <real>", n_var=2, type_of_var=real_t, &
390 default_r_vals=(/cp_unit_to_cp2k(0.5_dp, "angstrom"), &
391 cp_unit_to_cp2k(1.0_dp, "angstrom")/), &
392 unit_str="angstrom")
393 CALL section_add_keyword(section, keyword)
394 CALL keyword_release(keyword)
395
396 CALL keyword_create(keyword, __location__, name="QM_EXTENDED_SEED_IS_ONLY_CORE_LIST", &
397 description="Makes the extended QM zone be defined hysterestically"// &
398 " by distance from QM core list (i.e. atoms specified explicitly by"// &
399 " user) instead of from full QM core region (specified by user + hysteretic"// &
400 " selection + unbreakable bonds)", &
401 usage="QM_EXTENDED_SEED_IS_ONLY_CORE_LIST <logical>", n_var=1, type_of_var=logical_t, &
402 default_l_val=.false., repeats=.false.)
403 CALL section_add_keyword(section, keyword)
404 CALL keyword_release(keyword)
405
406 CALL keyword_create(keyword, __location__, name="R_BUF", &
407 description="Specify the inner and outer radii of buffer region."// &
408 " All atoms within this distance (hysteretically) of any QM atoms"// &
409 " will be buffer atoms in the force-mixing calculation.", &
410 usage="R_BUF <real> <real>", n_var=2, type_of_var=real_t, &
411 default_r_vals=(/cp_unit_to_cp2k(0.5_dp, "angstrom"), &
412 cp_unit_to_cp2k(1.0_dp, "angstrom")/), &
413 unit_str="angstrom")
414 CALL section_add_keyword(section, keyword)
415 CALL keyword_release(keyword)
416
417 CALL keyword_create(keyword, __location__, name="QM_KIND_ELEMENT_MAPPING", &
418 description="Mapping from elements to QM_KINDs for adaptively included atoms.", &
419 usage="QM_KIND_ELEMENT_MAPPING {El} {QM_KIND}", &
420 n_var=2, type_of_var=char_t, repeats=.true.)
421 CALL section_add_keyword(section, keyword)
422 CALL keyword_release(keyword)
423
424 CALL keyword_create(keyword, __location__, name="MAX_N_QM", &
425 description="Maximum number of QM atoms, for detection of runaway adaptive selection.", &
426 usage="MAX_N_QM int", default_i_val=300, &
427 n_var=1, type_of_var=integer_t, repeats=.false.)
428 CALL section_add_keyword(section, keyword)
429 CALL keyword_release(keyword)
430
431 CALL keyword_create(keyword, __location__, name="ADAPTIVE_EXCLUDE_MOLECULES", &
432 description="List of molecule names to exclude from adaptive regions (e.g. big things like proteins)", &
433 usage="ADAPTIVE_EXCLUDE_MOLECULES molec1 molec2 ...", &
434 n_var=-1, type_of_var=char_t, repeats=.false.)
435 CALL section_add_keyword(section, keyword)
436 CALL keyword_release(keyword)
437
438 CALL keyword_create(keyword, __location__, name="EXTENDED_DELTA_CHARGE", &
439 description="Additional net charge in extended region relative to core (core charge is"// &
440 " specified in DFT section, as usual for a convetional QM/MM calculation)", &
441 usage="EXTENDED_DELTA_CHARGE q", default_i_val=0, &
442 n_var=1, type_of_var=integer_t, repeats=.false.)
443 CALL section_add_keyword(section, keyword)
444 CALL keyword_release(keyword)
445
446 ! QM_NON_ADAPTIVE subsection
447 NULLIFY (subsection)
448 CALL section_create(subsection, __location__, name="QM_NON_ADAPTIVE", &
449 description="List of atoms always in QM region, non-adaptively", &
450 n_keywords=0, n_subsections=1, repeats=.true.)
451
452 NULLIFY (qm_kinds_subsection)
453 CALL create_qmmm_qm_kinds(qm_kinds_subsection)
454 CALL section_add_subsection(subsection, qm_kinds_subsection)
455 CALL section_release(qm_kinds_subsection)
456
457 CALL section_add_subsection(section, subsection)
458 CALL section_release(subsection)
459
460 ! BUFFER_NON_ADAPTIVE subsection
461 NULLIFY (subsection)
462 CALL section_create(subsection, __location__, name="BUFFER_NON_ADAPTIVE", &
463 description="List of atoms always in buffer region, non-adaptively, and any needed LINK sections", &
464 n_keywords=0, n_subsections=1, repeats=.true.)
465
466 NULLIFY (qm_kinds_subsection)
467 CALL create_qmmm_qm_kinds(qm_kinds_subsection)
468 CALL section_add_subsection(subsection, qm_kinds_subsection)
469 CALL section_release(qm_kinds_subsection)
470 NULLIFY (link_subsection)
471 CALL create_qmmm_link_section(link_subsection)
472 CALL section_add_subsection(subsection, link_subsection)
473 CALL section_release(link_subsection)
474
475 CALL section_add_subsection(section, subsection)
476 CALL section_release(subsection)
477
478 ![NB] also need a list?
479 ![NB] maybe not list+links , but some sort of link template
480 ![NB] also, breakable bonds?
481 ! BUFFER_LINKS subsection
482 NULLIFY (subsection)
483 CALL section_create( &
484 subsection, __location__, name="BUFFER_LINKS", &
485 description="Information about possible links for automatic covalent bond breaking for the buffer QM/MM calculation. "// &
486 "Ignored - need to implement buffer selection by atom and walking of connectivity data.", &
487 n_keywords=0, n_subsections=1, repeats=.true.)
488
489 NULLIFY (link_subsection)
490 CALL create_qmmm_link_section(link_subsection)
491 CALL section_add_subsection(subsection, link_subsection)
492 CALL section_release(link_subsection)
493
494 CALL section_add_subsection(section, subsection)
495 CALL section_release(subsection)
496
497 ! RESTART_INFO subsection
498 NULLIFY (subsection)
499 CALL section_create(subsection, __location__, name="RESTART_INFO", &
500 description="This section provides information about old force-mixing indices and labels, "// &
501 "for restarts.", &
502 n_keywords=2, n_subsections=0, repeats=.false.)
503
504 CALL keyword_create(keyword, __location__, name="INDICES", &
505 description="Indices of atoms in previous step QM regions.", &
506 usage="INDICES 1 2 ...", &
507 n_var=-1, type_of_var=integer_t, repeats=.true.)
508 CALL section_add_keyword(subsection, keyword)
509 CALL keyword_release(keyword)
510
511 CALL keyword_create(keyword, __location__, name="LABELS", &
512 description="Labels of atoms in previous step QM regions.", &
513 usage="LABELS 1 1 ...", &
514 n_var=-1, type_of_var=integer_t, repeats=.true.)
515 CALL section_add_keyword(subsection, keyword)
516 CALL keyword_release(keyword)
517
518 CALL section_add_subsection(section, subsection)
519 CALL section_release(subsection)
520
521 ! PRINT subsection, with keys for neighbor list
522 CALL section_create(subsection, __location__, name="print", &
523 description="Section of possible print options in FORCE_MIXING.", &
524 n_keywords=0, n_subsections=2, repeats=.false.)
525 NULLIFY (print_key)
526 CALL cp_print_key_section_create(print_key, __location__, "SUBCELL", &
527 description="Activates the printing of the subcells used for the "// &
528 "generation of neighbor lists.", unit_str="angstrom", &
529 print_level=high_print_level, filename="__STD_OUT__")
530 CALL section_add_subsection(subsection, print_key)
531 CALL section_release(print_key)
532
533 CALL cp_print_key_section_create(print_key, __location__, "NEIGHBOR_LISTS", &
534 description="Activates the printing of the neighbor lists used"// &
535 " for the hysteretic region calculations.", &
536 print_level=high_print_level, filename="", unit_str="angstrom")
537 CALL section_add_subsection(subsection, print_key)
538 CALL section_release(print_key)
539
540 CALL section_add_subsection(section, subsection)
541 CALL section_release(subsection)
542
543 END SUBROUTINE create_qmmm_force_mixing_section
544
545! **************************************************************************************************
546!> \brief Input section to create QM kinds sections
547!> \param section ...
548!> \author tlaino
549! **************************************************************************************************
550 SUBROUTINE create_qmmm_qm_kinds(section)
551 TYPE(section_type), POINTER :: section
552
553 TYPE(keyword_type), POINTER :: keyword
554
555 NULLIFY (keyword)
556 cpassert(.NOT. ASSOCIATED(section))
557 CALL section_create(section, __location__, name="QM_KIND", &
558 description="Information about the QM kind in the QM/MM scheme", &
559 n_keywords=3, n_subsections=0, repeats=.true.)
560
561 CALL keyword_create(keyword, __location__, name="_SECTION_PARAMETERS_", &
562 description="The QM kind", usage="O", n_var=1, type_of_var=char_t)
563 CALL section_add_keyword(section, keyword)
564 CALL keyword_release(keyword)
565
566 CALL keyword_create(keyword, __location__, name="MM_INDEX", &
567 description="The indexes of the MM atoms that have this kind. This keyword can be"// &
568 " repeated several times (useful if you have to specify many indexes).", &
569 usage="MM_INDEX 1 2", &
570 n_var=-1, type_of_var=integer_t, repeats=.true.)
571 CALL section_add_keyword(section, keyword)
572 CALL keyword_release(keyword)
573
574 END SUBROUTINE create_qmmm_qm_kinds
575
576! **************************************************************************************************
577!> \brief Input section to set QM/MM periodic boundary conditions
578!> \param section ...
579!> \author tlaino
580! **************************************************************************************************
581 SUBROUTINE create_qmmm_walls_section(section)
582 TYPE(section_type), POINTER :: section
583
584 TYPE(keyword_type), POINTER :: keyword
585
586 NULLIFY (keyword)
587 cpassert(.NOT. ASSOCIATED(section))
588 CALL section_create(section, __location__, name="WALLS", &
589 description="Enables Walls for the QM box. This can be used to avoid that QM"// &
590 " atoms move out of the QM box.", &
591 n_keywords=0, n_subsections=0, repeats=.false.)
592
593 CALL keyword_create(keyword, __location__, name="WALL_SKIN", &
594 description="Specify the value of the skin of the Wall in each dimension. "// &
595 "The wall's effect is felt when atoms fall within the skin of the Wall.", &
596 usage="WALL_SKIN <real> <real> <real>", n_var=3, type_of_var=real_t, &
597 default_r_vals=(/cp_unit_to_cp2k(0.5_dp, "angstrom"), &
598 cp_unit_to_cp2k(0.5_dp, "angstrom"), &
599 cp_unit_to_cp2k(0.5_dp, "angstrom")/), &
600 unit_str="angstrom")
601 CALL section_add_keyword(section, keyword)
602 CALL keyword_release(keyword)
603
604 CALL keyword_create(keyword, __location__, name="TYPE", &
605 description="Specifies the type of wall", &
606 usage="TYPE REFLECTIVE", &
607 enum_c_vals=s2a("NONE", "REFLECTIVE", "QUADRATIC"), &
609 enum_desc=s2a("No Wall around QM box", &
610 "Reflective Wall around QM box", &
611 "Quadratic Wall around QM box"), &
612 default_i_val=do_qmmm_wall_reflective)
613 CALL section_add_keyword(section, keyword)
614 CALL keyword_release(keyword)
615
616 CALL keyword_create(keyword, __location__, name="K", &
617 description="Specify the value of the the force constant for the quadratic wall", &
618 usage="K <real>", unit_str='internal_cp2k', &
619 type_of_var=real_t)
620 CALL section_add_keyword(section, keyword)
621 CALL keyword_release(keyword)
622
623 END SUBROUTINE create_qmmm_walls_section
624
625! ****************************************************************************
626!> \brief Input section for QM/MM image charge calculations
627!> \param section ...
628!> \author Dorothea Golze
629! **************************************************************************************************
630 SUBROUTINE create_qmmm_image_charge_section(section)
631 TYPE(section_type), POINTER :: section
632
633 TYPE(keyword_type), POINTER :: keyword
634 TYPE(section_type), POINTER :: subsection
635
636 NULLIFY (keyword, subsection)
637 cpassert(.NOT. ASSOCIATED(section))
638 CALL section_create(section, __location__, name="IMAGE_CHARGE", &
639 description="Inclusion of polarization effects within the image charge "// &
640 "approach for systems where QM molecules are physisorbed on e.g. metal "// &
641 "surfaces described by MM. This correction introduces only a very small overhead. "// &
642 "QM box size has to be equal to MM box size.", &
643 n_keywords=3, n_subsections=1, repeats=.false., &
644 citations=(/golze2013/))
645
646 CALL keyword_create(keyword, __location__, name="MM_ATOM_LIST", &
647 description="List of MM atoms carrying an induced Gaussian charge. "// &
648 "If this keyword is not given, all MM atoms will carry an image charge.", &
649 usage="MM_ATOM_LIST 1 2 3 or 1..3 ", n_var=-1, type_of_var=integer_t, &
650 repeats=.true.)
651 CALL section_add_keyword(section, keyword)
652 CALL keyword_release(keyword)
653
654 CALL keyword_create(keyword, __location__, name="WIDTH", &
655 description="Specifies the value of the width of the (induced) Gaussian "// &
656 "charge distribution carried by each MM atom.", &
657 usage="WIDTH <real> ", n_var=1, type_of_var=real_t, &
658 default_r_val=cp_unit_to_cp2k(value=3.0_dp, unit_str="angstrom^-2"), &
659 unit_str="angstrom^-2")
660 CALL section_add_keyword(section, keyword)
661 CALL keyword_release(keyword)
662
663 CALL keyword_create(keyword, __location__, name="EXT_POTENTIAL", &
664 description="External potential applied to the metal electrode ", &
665 usage="EXT_POTENTIAL <real> ", n_var=1, type_of_var=real_t, &
666 default_r_val=0.0_dp, &
667 unit_str="volt")
668 CALL section_add_keyword(section, keyword)
669 CALL keyword_release(keyword)
670
671 CALL keyword_create(keyword, __location__, name="DETERM_COEFF", &
672 description="Specifies how the coefficients are determined.", &
673 usage="DETERM_COEFF ITERATIVE", &
674 enum_c_vals=s2a("CALC_MATRIX", "ITERATIVE"), &
676 enum_desc=s2a("Calculates image matrix and solves linear set of equations", &
677 "Uses an iterative scheme to calculate the coefficients"), &
678 default_i_val=do_qmmm_image_calcmatrix)
679 CALL section_add_keyword(section, keyword)
680 CALL keyword_release(keyword)
681
682 CALL keyword_create(keyword, __location__, name="RESTART_IMAGE_MATRIX", &
683 description="Restart the image matrix. Useful when "// &
684 "calculating coefficients iteratively (the image matrix "// &
685 "is used as preconditioner in that case)", &
686 usage="RESTART_IMAGE_MATRIX", default_l_val=.false., &
687 lone_keyword_l_val=.true.)
688 CALL section_add_keyword(section, keyword)
689 CALL keyword_release(keyword)
690
691 CALL keyword_create(keyword, __location__, name="IMAGE_RESTART_FILE_NAME", &
692 description="File name where to read the image matrix used "// &
693 "as preconditioner in the iterative scheme", &
694 usage="IMAGE_RESTART_FILE_NAME <FILENAME>", &
695 type_of_var=lchar_t)
696 CALL section_add_keyword(section, keyword)
697 CALL keyword_release(keyword)
698
699 CALL keyword_create(keyword, __location__, name="IMAGE_MATRIX_METHOD", &
700 description="Method for calculating the image matrix.", &
701 usage="IMAGE_MATRIX_METHOD MME", &
702 enum_c_vals=s2a("GPW", "MME"), &
703 enum_i_vals=(/do_eri_gpw, do_eri_mme/), &
704 enum_desc=s2a("Uses Gaussian Plane Wave method [Golze2013]", &
705 "Uses MiniMax-Ewald method (ERI_MME subsection)"), &
706 default_i_val=do_eri_mme)
707 CALL section_add_keyword(section, keyword)
708 CALL keyword_release(keyword)
709
710 ! for qmmm image charges we can afford taking the most accurate minimax approximation
711 CALL create_eri_mme_section(subsection, default_n_minimax=53)
712 CALL section_add_subsection(section, subsection)
713 CALL section_release(subsection)
714
715 END SUBROUTINE create_qmmm_image_charge_section
716
717! **************************************************************************************************
718!> \brief Input section to set QM/MM periodic boundary conditions
719!> \param section ...
720!> \author tlaino
721! **************************************************************************************************
722 SUBROUTINE create_qmmm_periodic_section(section)
723 TYPE(section_type), POINTER :: section
724
725 TYPE(keyword_type), POINTER :: keyword
726 TYPE(section_type), POINTER :: subsection
727
728 NULLIFY (keyword, subsection)
729 cpassert(.NOT. ASSOCIATED(section))
730 CALL section_create(section, __location__, name="PERIODIC", &
731 description="Specify parameters for QM/MM periodic boundary conditions calculations", &
732 n_keywords=0, n_subsections=0, repeats=.false., &
733 citations=(/laino2006/))
734
735 CALL keyword_create( &
736 keyword, __location__, name="GMAX", &
737 description="Specifies the maximum value of G in the reciprocal space over which perform the Ewald sum.", &
738 usage="GMAX <real>", n_var=1, default_r_val=1.0_dp)
739 CALL section_add_keyword(section, keyword)
740 CALL keyword_release(keyword)
741
742 CALL keyword_create(keyword, __location__, name="REPLICA", &
743 description="Specifies the number of replica to take into consideration for the real part of the "// &
744 "calculation. Default is letting the qmmm module decide how many replica you really need.", &
745 usage="REPLICA <integer>", n_var=1, default_i_val=-1)
746 CALL section_add_keyword(section, keyword)
747 CALL keyword_release(keyword)
748
749 CALL keyword_create(keyword, __location__, name="NGRIDS", &
750 description="Specifies the number of grid points used for the Interpolation of the G-space term", &
751 usage="NGRIDS <integer> <integer> <integer> ", n_var=3, default_i_vals=(/50, 50, 50/))
752 CALL section_add_keyword(section, keyword)
753 CALL keyword_release(keyword)
754
755 CALL create_multipole_qmmm_section(subsection)
756 CALL section_add_subsection(section, subsection)
757 CALL section_release(subsection)
758
759 CALL create_gspace_interp_section(subsection)
760 CALL section_add_subsection(section, subsection)
761 CALL section_release(subsection)
762
763 CALL create_poisson_section(subsection)
764 CALL section_add_subsection(section, subsection)
765 CALL section_release(subsection)
766
767 CALL cp_print_key_section_create(subsection, __location__, "check_spline", &
768 description="Controls the checking of the G-space term Spline Interpolation.", &
769 print_level=medium_print_level, filename="GSpace-SplInterp")
770 CALL section_add_subsection(section, subsection)
771 CALL section_release(subsection)
772
773 END SUBROUTINE create_qmmm_periodic_section
774
775! **************************************************************************************************
776!> \brief Section to set-up parameters for decoupling using the Bloechl scheme
777!> \param section the section to create
778!> \par History
779!> Dorothea Golze [04.2014] copied from input_cp2k_poisson.F and
780!> enabled switch-on/off
781!> \author teo
782! **************************************************************************************************
783 SUBROUTINE create_multipole_qmmm_section(section)
784 TYPE(section_type), POINTER :: section
785
786 TYPE(keyword_type), POINTER :: keyword
787 TYPE(section_type), POINTER :: subsection
788
789 cpassert(.NOT. ASSOCIATED(section))
790
791 CALL section_create(section, __location__, name="MULTIPOLE", &
792 description="This section is used to set up the decoupling of QM periodic images with "// &
793 "the use of density derived atomic point charges. Switched on by default even if not "// &
794 "explicitly given. Can be switched off if e.g. QM and MM box are of the same size.", &
795 n_keywords=1, n_subsections=0, repeats=.false.)
796
797 NULLIFY (keyword, subsection)
798 CALL keyword_create(keyword, __location__, name="_SECTION_PARAMETERS_", &
799 description="Defines the usage of the multipole section", &
800 usage="ON", &
801 enum_c_vals=s2a("ON", "OFF"), &
803 enum_desc=s2a("switch on MULTIPOLE section", &
804 "switch off MULTIPOLE section"), &
805 default_i_val=do_multipole_section_on, lone_keyword_i_val=do_multipole_section_on)
806 CALL section_add_keyword(section, keyword)
807 CALL keyword_release(keyword)
808
809 CALL keyword_create(keyword, __location__, name="RCUT", &
810 description="Real space cutoff for the Ewald sum.", &
811 usage="RCUT {real}", n_var=1, type_of_var=real_t, &
812 unit_str="angstrom")
813 CALL section_add_keyword(section, keyword)
814 CALL keyword_release(keyword)
815
816 CALL keyword_create(keyword, __location__, name="EWALD_PRECISION", &
817 description="Precision achieved in the Ewald sum.", &
818 usage="EWALD_PRECISION {real}", n_var=1, type_of_var=real_t, &
819 unit_str="hartree", default_r_val=1.0e-6_dp)
820 CALL section_add_keyword(section, keyword)
821 CALL keyword_release(keyword)
822
823 CALL keyword_create(keyword, __location__, name="ANALYTICAL_GTERM", &
824 description="Evaluates the Gterm in the Ewald Scheme analytically instead of using Splines.", &
825 usage="ANALYTICAL_GTERM <LOGICAL>", &
826 default_l_val=.false., lone_keyword_l_val=.true.)
827 CALL section_add_keyword(section, keyword)
828 CALL keyword_release(keyword)
829
830 CALL keyword_create(keyword, __location__, name="NGRIDS", &
831 description="Specifies the number of grid points used for the Interpolation of the G-space term", &
832 usage="NGRIDS <integer> <integer> <integer> ", n_var=3, default_i_vals=(/50, 50, 50/))
833 CALL section_add_keyword(section, keyword)
834 CALL keyword_release(keyword)
835
836 CALL create_gspace_interp_section(subsection)
837 CALL section_add_subsection(section, subsection)
838 CALL section_release(subsection)
839
840 CALL cp_print_key_section_create(subsection, __location__, "check_spline", &
841 description="Controls the checking of the G-space term Spline Interpolation.", &
842 print_level=medium_print_level, filename="GSpace-SplInterp")
843 CALL section_add_subsection(section, subsection)
844 CALL section_release(subsection)
845
846 CALL cp_print_key_section_create(subsection, __location__, "program_run_info", &
847 description="Controls the printing of basic information during the run", &
848 print_level=low_print_level, add_last=add_last_numeric, filename="__STD_OUT__")
849 CALL section_add_subsection(section, subsection)
850 CALL section_release(subsection)
851
852 END SUBROUTINE create_multipole_qmmm_section
853
854! **************************************************************************************************
855!> \brief creates the qm/mm forcefield section to override to the FF specification
856!> given in the FIST input
857!> \param section ...
858!> \author tlaino
859! **************************************************************************************************
860 SUBROUTINE create_qmmm_forcefield_section(section)
861 TYPE(section_type), POINTER :: section
862
863 TYPE(keyword_type), POINTER :: keyword
864 TYPE(section_type), POINTER :: subsection
865
866 NULLIFY (subsection, keyword)
867 cpassert(.NOT. ASSOCIATED(section))
868 CALL section_create(section, __location__, name="FORCEFIELD", &
869 description="Specify information on the QM/MM forcefield", &
870 n_keywords=0, n_subsections=2, repeats=.true.)
871
872 CALL keyword_create(keyword, __location__, name="MULTIPLE_POTENTIAL", &
873 description="Enables the possibility to define NONBONDED and NONBONDED14 as a"// &
874 " sum of different kinds of potential. Useful for piecewise defined potentials.", &
875 usage="MULTIPLE_POTENTIAL T", default_l_val=.false., lone_keyword_l_val=.true.)
876 CALL section_add_keyword(section, keyword)
877 CALL keyword_release(keyword)
878
879 CALL create_qmmm_ff_nb_section(subsection)
880 CALL section_add_subsection(section, subsection)
881 CALL section_release(subsection)
882
883 CALL create_nonbonded14_section(subsection)
884 CALL section_add_subsection(section, subsection)
885 CALL section_release(subsection)
886
887 END SUBROUTINE create_qmmm_forcefield_section
888
889! **************************************************************************************************
890!> \brief creates the qm/mm forcefield section to override to the FF specification
891!> given in the FIST input - NONBONDED PART
892!> \param section ...
893!> \author tlaino
894! **************************************************************************************************
895 SUBROUTINE create_qmmm_ff_nb_section(section)
896 TYPE(section_type), POINTER :: section
897
898 TYPE(section_type), POINTER :: subsection
899
900 NULLIFY (subsection)
901 cpassert(.NOT. ASSOCIATED(section))
902 CALL section_create(section, __location__, name="NONBONDED", &
903 description="Specify information on the QM/MM non-bonded forcefield", &
904 n_keywords=0, n_subsections=2, repeats=.true.)
905
906 CALL create_lj_section(subsection)
907 CALL section_add_subsection(section, subsection)
908 CALL section_release(subsection)
909
910 CALL create_williams_section(subsection)
911 CALL section_add_subsection(section, subsection)
912 CALL section_release(subsection)
913
914 CALL create_goodwin_section(subsection)
915 CALL section_add_subsection(section, subsection)
916 CALL section_release(subsection)
917
918 CALL create_genpot_section(subsection)
919 CALL section_add_subsection(section, subsection)
920 CALL section_release(subsection)
921
922 END SUBROUTINE create_qmmm_ff_nb_section
923
924! **************************************************************************************************
925!> \brief creates the qm/mm link section
926!> \param section ...
927!> \author tlaino
928! **************************************************************************************************
929 SUBROUTINE create_qmmm_link_section(section)
930 TYPE(section_type), POINTER :: section
931
932 TYPE(keyword_type), POINTER :: keyword
933 TYPE(section_type), POINTER :: subsection
934
935 NULLIFY (keyword, subsection)
936 cpassert(.NOT. ASSOCIATED(section))
937 CALL section_create(section, __location__, name="LINK", &
938 description="Specify information on the QM/MM link treatment", &
939 n_keywords=7, n_subsections=2, repeats=.true.)
940
941 CALL keyword_create(keyword, __location__, name="QM_INDEX", &
942 variants=(/"QM"/), &
943 description="Specifies the index of the QM atom involved in the QM/MM link", &
944 usage="QM_INDEX integer", n_var=1, type_of_var=integer_t)
945 CALL section_add_keyword(section, keyword)
946 CALL keyword_release(keyword)
947
948 CALL keyword_create(keyword, __location__, name="QM_KIND", &
949 description="Specifies the element of the QM capping atom involved in the QM/MM link", &
950 usage="QM_KIND char", n_var=1, type_of_var=char_t, &
951 default_c_val="H")
952 CALL section_add_keyword(section, keyword)
953 CALL keyword_release(keyword)
954
955 CALL keyword_create(keyword, __location__, name="MM_INDEX", &
956 variants=(/"MM"/), &
957 description="Specifies the index of the MM atom involved in the QM/MM link, Default hydrogen.", &
958 usage="MM_INDEX integer", n_var=1, type_of_var=integer_t)
959 CALL section_add_keyword(section, keyword)
960 CALL keyword_release(keyword)
961
962 CALL keyword_create(keyword, __location__, name="RADIUS", &
963 description="Overwrite the specification of the radius only for the MM atom involved in the link. "// &
964 "Default is to use the same radius as for the specified type.", &
965 usage="RADIUS real", n_var=1, type_of_var=real_t, unit_str="angstrom")
966 CALL section_add_keyword(section, keyword)
967 CALL keyword_release(keyword)
968
969 CALL keyword_create( &
970 keyword, __location__, name="CORR_RADIUS", &
971 description="Overwrite the specification of the correction radius only for the MM atom involved in the link. "// &
972 "Default is to use the same correction radius as for the specified type.", &
973 usage="RADIUS real", n_var=1, type_of_var=real_t, unit_str="angstrom")
974 CALL section_add_keyword(section, keyword)
975 CALL keyword_release(keyword)
976
977 CALL keyword_create(keyword, __location__, name="LINK_TYPE", &
978 variants=(/"LINK ", "TYPE ", "LTYPE"/), &
979 description="Specifies the method to use to treat the defined QM/MM link", &
980 usage="LINK_TYPE char", &
981 enum_c_vals=s2a("IMOMM", "GHO", "PSEUDO"), &
983 enum_desc=s2a("Use Integrated Molecular Orbital Molecular Mechanics method", &
984 "Use Generalized Hybrid Orbital method", &
985 "Use a monovalent pseudo-potential"), &
986 default_i_val=do_qmmm_link_imomm)
987 CALL section_add_keyword(section, keyword)
988 CALL keyword_release(keyword)
989
990 CALL keyword_create(keyword, __location__, name="ALPHA_IMOMM", &
991 variants=s2a("ALPHA"), &
992 description="Specifies the scaling factor to be used for projecting the forces "// &
993 "on the capping hydrogen in the IMOMM QM/MM link scheme to the MM atom of the link. "// &
994 "A good guess can be derived from the bond distances of the forcefield: "// &
995 "alpha = r_eq(QM-MM) / r_eq(QM-H).", &
996 usage="ALPHA_IMOMM real", n_var=1, type_of_var=real_t, &
997 default_r_val=alpha_imomm_default)
998 CALL section_add_keyword(section, keyword)
999 CALL keyword_release(keyword)
1000
1001 CALL keyword_create(keyword, __location__, name="QMMM_SCALE_FACTOR", &
1002 variants=(/"QMMM_CHARGE_SCALE ", &
1003 "QMMM_CHARGE_FACTOR", &
1004 "QMMM_SCALE_CHARGE "/), &
1005 description="Specifies the scaling factor for the MM charge involved in the link QM/MM."// &
1006 " This keyword affects only the QM/MM potential, it doesn't affect the electrostatic in"// &
1007 " the classical part of the code."// &
1008 " Default 1.0 i.e. no charge rescaling of the MM atom of the QM/MM link bond.", &
1009 usage="SCALE_FACTOR real", n_var=1, type_of_var=real_t, &
1010 default_r_val=charge_scale_factor)
1011 CALL section_add_keyword(section, keyword)
1012 CALL keyword_release(keyword)
1013
1014 CALL keyword_create(keyword, __location__, name="FIST_SCALE_FACTOR", &
1015 variants=(/"FIST_CHARGE_SCALE ", &
1016 "FIST_CHARGE_FACTOR", &
1017 "FIST_SCALE_CHARGE "/), &
1018 description="Specifies the scaling factor for the MM charge involved in the link QM/MM."// &
1019 " This keyword modifies the MM charge in FIST. The modified charge will be used then also"// &
1020 " for the generation of the QM/MM potential. "// &
1021 "Default 1.0 i.e. no charge rescaling of the MM atom of the QM/MM link bond.", &
1022 usage="SCALE_FACTOR real", n_var=1, type_of_var=real_t, &
1023 default_r_val=charge_scale_factor)
1024 CALL section_add_keyword(section, keyword)
1025 CALL keyword_release(keyword)
1026
1027 CALL section_create(subsection, __location__, name="MOVE_MM_CHARGE", &
1028 description="Specify information to move a classical charge before the"// &
1029 " QM/MM energies and forces evaluation", &
1030 n_keywords=4, n_subsections=0, repeats=.true.)
1031
1032 CALL keyword_create(keyword, __location__, name="ATOM_INDEX_1", &
1033 variants=(/"MM1"/), &
1034 description="Specifies the index of the MM atom involved in the QM/MM link to be moved", &
1035 usage="ATOM_INDEX_1 integer", n_var=1, type_of_var=integer_t)
1036 CALL section_add_keyword(subsection, keyword)
1037 CALL keyword_release(keyword)
1038
1039 CALL keyword_create(keyword, __location__, name="ATOM_INDEX_2", &
1040 variants=(/"MM2"/), &
1041 description="Specifies the index of the second atom defining the direction along which"// &
1042 " the atom will be moved", &
1043 usage="ATOM_INDEX_2 integer", n_var=1, type_of_var=integer_t)
1044 CALL section_add_keyword(subsection, keyword)
1045 CALL keyword_release(keyword)
1046
1047 CALL keyword_create(keyword, __location__, name="ALPHA", &
1048 description="Specifies the scaling factor that defines the movement along the defined direction", &
1049 usage="ALPHA real", n_var=1, type_of_var=real_t)
1050 CALL section_add_keyword(subsection, keyword)
1051 CALL keyword_release(keyword)
1052
1053 CALL keyword_create(keyword, __location__, name="RADIUS", &
1054 description="Specifies the radius used for the QM/MM electrostatic coupling after movement", &
1055 usage="RADIUS real", n_var=1, type_of_var=real_t, unit_str="angstrom", default_r_val=0.0_dp)
1056 CALL section_add_keyword(subsection, keyword)
1057 CALL keyword_release(keyword)
1058
1059 CALL keyword_create(keyword, __location__, name="CORR_RADIUS", &
1060 description="Specifies the correction radius used for the QM/MM electrostatic coupling after movement", &
1061 usage="RADIUS real", n_var=1, type_of_var=real_t, unit_str="angstrom", default_r_val=0.0_dp)
1062 CALL section_add_keyword(subsection, keyword)
1063 CALL keyword_release(keyword)
1064
1065 CALL section_add_subsection(section, subsection)
1066 CALL section_release(subsection)
1067
1068 CALL section_create(subsection, __location__, name="ADD_MM_CHARGE", &
1069 description="Specify information to add a classical charge before the"// &
1070 " QM/MM energies and forces evaluation", &
1071 n_keywords=5, n_subsections=0, repeats=.true.)
1072
1073 CALL keyword_create(keyword, __location__, name="ATOM_INDEX_1", &
1074 variants=(/"MM1"/), &
1075 description="Specifies the index of the first atom defining the direction along which"// &
1076 " the atom will be added", &
1077 usage="ATOM_INDEX_1 integer", n_var=1, type_of_var=integer_t)
1078 CALL section_add_keyword(subsection, keyword)
1079 CALL keyword_release(keyword)
1080
1081 CALL keyword_create(keyword, __location__, name="ATOM_INDEX_2", &
1082 variants=(/"MM2"/), &
1083 description="Specifies the index of the second atom defining the direction along which"// &
1084 " the atom will be added", &
1085 usage="ATOM_INDEX_2 integer", n_var=1, type_of_var=integer_t)
1086 CALL section_add_keyword(subsection, keyword)
1087 CALL keyword_release(keyword)
1088
1089 CALL keyword_create(keyword, __location__, name="ALPHA", &
1090 description="Specifies the scaling factor that defines the movement along the defined direction", &
1091 usage="ALPHA real", n_var=1, type_of_var=real_t)
1092 CALL section_add_keyword(subsection, keyword)
1093 CALL keyword_release(keyword)
1094
1095 CALL keyword_create(keyword, __location__, name="RADIUS", &
1096 description="Specifies the radius used for the QM/MM electrostatic coupling for the added source", &
1097 usage="RADIUS real", n_var=1, unit_str="angstrom", &
1098 default_r_val=cp_unit_to_cp2k(radius_qmmm_default, "angstrom"))
1099 CALL section_add_keyword(subsection, keyword)
1100 CALL keyword_release(keyword)
1101
1102 CALL keyword_create( &
1103 keyword, __location__, name="CORR_RADIUS", &
1104 description="Specifies the correction radius used for the QM/MM electrostatic coupling for the added source", &
1105 usage="RADIUS real", n_var=1, unit_str="angstrom", &
1106 default_r_val=cp_unit_to_cp2k(radius_qmmm_default, "angstrom"))
1107 CALL section_add_keyword(subsection, keyword)
1108 CALL keyword_release(keyword)
1109
1110 CALL keyword_create(keyword, __location__, name="CHARGE", &
1111 description="Specifies the charge for the added source of QM/MM potential", &
1112 usage="CHARGE real", default_r_val=0.0_dp, n_var=1, type_of_var=real_t)
1113 CALL section_add_keyword(subsection, keyword)
1114 CALL keyword_release(keyword)
1115
1116 CALL section_add_subsection(section, subsection)
1117 CALL section_release(subsection)
1118 END SUBROUTINE create_qmmm_link_section
1119
1120! **************************************************************************************************
1121!> \brief creates the interpolation section
1122!> \param section ...
1123!> \author tlaino
1124! **************************************************************************************************
1125 SUBROUTINE create_qmmm_interp_section(section)
1126 TYPE(section_type), POINTER :: section
1127
1128 TYPE(keyword_type), POINTER :: keyword
1129 TYPE(section_type), POINTER :: print_key
1130
1131 cpassert(.NOT. ASSOCIATED(section))
1132 CALL section_create(section, __location__, name="interpolator", &
1133 description="kind of interpolation used between the multigrids", &
1134 n_keywords=5, n_subsections=0, repeats=.false.)
1135
1136 NULLIFY (keyword, print_key)
1137
1138 CALL keyword_create(keyword, __location__, name="kind", &
1139 description="the interpolator to use", &
1140 usage="kind spline3", &
1141 default_i_val=spline3_nopbc_interp, &
1142 enum_c_vals=s2a("spline3_nopbc"), &
1143 enum_i_vals=(/spline3_nopbc_interp/))
1144 CALL section_add_keyword(section, keyword)
1145 CALL keyword_release(keyword)
1146
1147 CALL keyword_create(keyword, __location__, name="safe_computation", &
1148 description="if a non unrolled calculation is to be performed in parallel", &
1149 usage="safe_computation OFF", &
1150 default_l_val=.false., &
1151 lone_keyword_l_val=.true.)
1152 CALL section_add_keyword(section, keyword)
1153 CALL keyword_release(keyword)
1154
1155 CALL keyword_create(keyword, __location__, name="aint_precond", &
1156 description="the approximate inverse to use to get the starting point"// &
1157 " for the linear solver of the spline3 methods", &
1158 usage="kind spline3", &
1159 default_i_val=precond_spl3_aint, &
1160 enum_c_vals=s2a("copy", "spl3_nopbc_aint1", "spl3_nopbc_precond1", &
1161 "spl3_nopbc_aint2", "spl3_nopbc_precond2", "spl3_nopbc_precond3"), &
1164 CALL section_add_keyword(section, keyword)
1165 CALL keyword_release(keyword)
1166
1167 CALL keyword_create(keyword, __location__, name="precond", &
1168 description="The preconditioner used"// &
1169 " for the linear solver of the spline3 methods", &
1170 usage="kind spline3", &
1171 default_i_val=precond_spl3_3, &
1172 enum_c_vals=s2a("copy", "spl3_nopbc_aint1", "spl3_nopbc_precond1", &
1173 "spl3_nopbc_aint2", "spl3_nopbc_precond2", "spl3_nopbc_precond3"), &
1176 CALL section_add_keyword(section, keyword)
1177 CALL keyword_release(keyword)
1178
1179 CALL keyword_create(keyword, __location__, name="eps_x", &
1180 description="accuracy on the solution for spline3 the interpolators", &
1181 usage="eps_x 1.e-15", default_r_val=1.e-10_dp)
1182 CALL section_add_keyword(section, keyword)
1183 CALL keyword_release(keyword)
1184
1185 CALL keyword_create(keyword, __location__, name="eps_r", &
1186 description="accuracy on the residual for spline3 the interpolators", &
1187 usage="eps_r 1.e-15", default_r_val=1.e-10_dp)
1188 CALL section_add_keyword(section, keyword)
1189 CALL keyword_release(keyword)
1190
1191 CALL keyword_create(keyword, __location__, name="max_iter", &
1192 variants=(/'maxiter'/), &
1193 description="the maximum number of iterations", &
1194 usage="max_iter 200", default_i_val=100)
1195 CALL section_add_keyword(section, keyword)
1196 CALL keyword_release(keyword)
1197
1198 NULLIFY (print_key)
1199 CALL cp_print_key_section_create(print_key, __location__, "conv_info", &
1200 description="if convergence information about the linear solver"// &
1201 " of the spline methods should be printed", &
1202 print_level=medium_print_level, each_iter_names=s2a("SPLINE_FIND_COEFFS"), &
1203 each_iter_values=(/10/), filename="__STD_OUT__", &
1204 add_last=add_last_numeric)
1205 CALL section_add_subsection(section, print_key)
1206 CALL section_release(print_key)
1207
1208 CALL cp_print_key_section_create(print_key, __location__, "spl_coeffs", &
1209 description="outputs a cube with the coefficients calculated for "// &
1210 "the spline interpolation", &
1211 print_level=debug_print_level)
1212 CALL section_add_subsection(section, print_key)
1213 CALL section_release(print_key)
1214 END SUBROUTINE create_qmmm_interp_section
1215
1216! **************************************************************************************************
1217!> \brief Create the print qmmm section
1218!> \param section the section to create
1219!> \author teo
1220! **************************************************************************************************
1221 SUBROUTINE create_print_qmmm_section(section)
1222 TYPE(section_type), POINTER :: section
1223
1224 TYPE(keyword_type), POINTER :: keyword
1225 TYPE(section_type), POINTER :: print_key
1226
1227 cpassert(.NOT. ASSOCIATED(section))
1228 NULLIFY (keyword, print_key)
1229 CALL section_create(section, __location__, name="print", &
1230 description="Section of possible print options specific of the QMMM code.", &
1231 n_keywords=0, n_subsections=1, repeats=.false.)
1232
1233 NULLIFY (print_key)
1234
1235 CALL cp_print_key_section_create(print_key, __location__, "DIPOLE", &
1236 description="Controls the printing of the DIPOLE in a QM/MM calculations."// &
1237 " It requires that the DIPOLE calculations is"// &
1238 " requested both for the QS and for the MM part.", &
1239 print_level=high_print_level, filename="__STD_OUT__")
1240 CALL section_add_subsection(section, print_key)
1241 CALL section_release(print_key)
1242
1243 CALL cp_print_key_section_create(print_key, __location__, "PGF", &
1244 description="Controls the printing of the gaussian expansion basis set of the"// &
1245 " electrostatic potential", &
1246 print_level=high_print_level, filename="__STD_OUT__")
1247 CALL section_add_subsection(section, print_key)
1248 CALL section_release(print_key)
1249
1250 CALL cp_print_key_section_create(print_key, __location__, "POTENTIAL", &
1251 description="Controls the printing of the QMMM potential", &
1252 print_level=high_print_level, filename="MM_ELPOT_QMMM", &
1253 common_iter_levels=1)
1254
1255 CALL keyword_create(keyword, __location__, name="stride", &
1256 description="The stride (X,Y,Z) used to write the cube file "// &
1257 "(larger values result in smaller cube files). You can provide 3 numbers (for X,Y,Z) or"// &
1258 " 1 number valid for all components.", &
1259 usage="STRIDE 2 2 2", n_var=-1, default_i_vals=(/2, 2, 2/), type_of_var=integer_t)
1260 CALL section_add_keyword(print_key, keyword)
1261 CALL keyword_release(keyword)
1262
1263 CALL section_add_subsection(section, print_key)
1264 CALL section_release(print_key)
1265
1266 CALL cp_print_key_section_create(print_key, __location__, "MM_POTENTIAL", &
1267 description="Controls the printing of the MM unidimensional potential on file", &
1268 print_level=high_print_level, filename="MM_ELPOT", &
1269 common_iter_levels=1)
1270 CALL section_add_subsection(section, print_key)
1271 CALL section_release(print_key)
1272
1273 CALL cp_print_key_section_create(print_key, __location__, "QMMM_MATRIX", &
1274 description="Controls the printing of the QMMM 1 electron Hamiltonian Matrix"// &
1275 " for methods like semiempirical and DFTB", &
1276 print_level=high_print_level, filename="__STD_OUT__", &
1277 common_iter_levels=1)
1278 CALL section_add_subsection(section, print_key)
1279 CALL section_release(print_key)
1280
1281 CALL cp_print_key_section_create(print_key, __location__, "PROGRAM_BANNER", &
1282 description="Controls the printing of the banner of the MM program", &
1283 print_level=silent_print_level, filename="__STD_OUT__")
1284 CALL section_add_subsection(section, print_key)
1285 CALL section_release(print_key)
1286
1287 CALL cp_print_key_section_create(print_key, __location__, "PROGRAM_RUN_INFO", &
1288 description="Controls the printing of information regarding the run.", &
1289 print_level=medium_print_level, filename="__STD_OUT__")
1290 CALL section_add_subsection(section, print_key)
1291 CALL section_release(print_key)
1292
1294 print_key, __location__, "PERIODIC_INFO", &
1295 description="Controls the printing of information regarding the periodic boundary condition.", &
1296 print_level=medium_print_level, filename="__STD_OUT__")
1297 CALL section_add_subsection(section, print_key)
1298 CALL section_release(print_key)
1299
1300 CALL cp_print_key_section_create(print_key, __location__, "GRID_INFORMATION", &
1301 description="Controls the printing of information regarding the PW grid structures"// &
1302 " for PERIODIC QM/MM calculations.", &
1303 print_level=medium_print_level, filename="__STD_OUT__")
1304 CALL section_add_subsection(section, print_key)
1305 CALL section_release(print_key)
1306
1307 CALL cp_print_key_section_create(print_key, __location__, "derivatives", &
1308 description="Print all derivatives after QM/MM calculation", &
1309 print_level=high_print_level, filename="__STD_OUT__")
1310 CALL section_add_subsection(section, print_key)
1311 CALL section_release(print_key)
1312
1313 CALL cp_print_key_section_create(print_key, __location__, "qmmm_charges", &
1314 description="Print all charges generating the QM/MM potential", &
1315 print_level=medium_print_level, filename="__STD_OUT__")
1316 CALL section_add_subsection(section, print_key)
1317 CALL section_release(print_key)
1318
1319 CALL cp_print_key_section_create(print_key, __location__, "qmmm_link_info", &
1320 description="Print all information on QM/MM links", &
1321 print_level=medium_print_level, filename="__STD_OUT__")
1322 CALL section_add_subsection(section, print_key)
1323 CALL section_release(print_key)
1324
1325 CALL cp_print_key_section_create(print_key, __location__, "qs_derivatives", &
1326 description="Print QM derivatives after QS calculation", &
1327 print_level=medium_print_level, filename="__STD_OUT__")
1328 CALL section_add_subsection(section, print_key)
1329 CALL section_release(print_key)
1330
1331 CALL cp_print_key_section_create(print_key, __location__, "image_charge_info", &
1332 description="Prints image charge coefficients and detailed energy info", &
1333 print_level=high_print_level, filename="__STD_OUT__")
1334 CALL section_add_subsection(section, print_key)
1335 CALL section_release(print_key)
1336
1337 CALL cp_print_key_section_create(print_key, __location__, "image_charge_restart", &
1338 description="Controls the printing of the restart file for "// &
1339 "the image matrix when using the iterative scheme", &
1340 print_level=low_print_level, add_last=add_last_numeric, filename="RESTART", &
1341 common_iter_levels=3)
1342 CALL section_add_subsection(section, print_key)
1343 CALL section_release(print_key)
1344
1345 END SUBROUTINE create_print_qmmm_section
1346
1347END MODULE input_cp2k_qmmm
collects all references to literature in CP2K as new algorithms / method are included from literature...
integer, save, public bernstein2012
integer, save, public bernstein2009
integer, save, public laino2006
integer, save, public golze2013
integer, save, public laino2005
Handles all functions related to the CELL.
Definition cell_types.F:15
integer, parameter, public use_perd_none
Definition cell_types.F:42
Interface to Minimax-Ewald method for periodic ERI's to be used in CP2K.
subroutine, public create_eri_mme_section(section, default_n_minimax)
Create main input section.
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
integer, parameter, public debug_print_level
integer, parameter, public low_print_level
integer, parameter, public medium_print_level
integer, parameter, public high_print_level
integer, parameter, public add_last_numeric
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
utils to manipulate splines on the regular grid of a pw
integer, parameter, public spline3_nopbc_interp
unit conversion facility
Definition cp_units.F:30
real(kind=dp) function, public cp_unit_to_cp2k(value, unit_str, defaults, power)
converts to the internal cp2k units to the given unit
Definition cp_units.F:1150
collects all constants needed in input so that they can be used without circular dependencies
integer, parameter, public do_par_atom
integer, parameter, public do_qmmm_image_calcmatrix
integer, parameter, public do_qmmm_none
integer, parameter, public do_qmmm_center_every_step
integer, parameter, public do_qmmm_pcharge
real(kind=dp), parameter, public alpha_imomm_default
integer, parameter, public do_fm_mom_conserv_none
integer, parameter, public do_qmmm_image_iter
integer, parameter, public do_fm_mom_conserv_buffer
integer, parameter, public do_qmmm_link_pseudo
integer, parameter, public do_qmmm_center_pbc_aware
integer, parameter, public do_eri_mme
integer, parameter, public do_fm_mom_conserv_equal_f
real(kind=dp), parameter, public radius_qmmm_default
integer, parameter, public do_qmmm_coulomb
integer, parameter, public do_qmmm_center_never
integer, parameter, public do_multipole_section_off
integer, parameter, public do_qmmm_link_gho
integer, parameter, public do_qmmm_wall_quadratic
integer, parameter, public do_qmmm_wall_reflective
integer, parameter, public do_qmmm_swave
real(kind=dp), parameter, public charge_scale_factor
integer, parameter, public do_fm_mom_conserv_qm
integer, parameter, public do_qmmm_center_setup_only
integer, parameter, public do_multipole_section_on
integer, parameter, public do_fm_mom_conserv_equal_a
integer, parameter, public do_fm_mom_conserv_core
integer, parameter, public do_qmmm_gauss
integer, parameter, public gaussian
integer, parameter, public do_par_grid
integer, parameter, public do_qmmm_wall_none
integer, parameter, public do_qmmm_link_imomm
integer, parameter, public do_qmmm_center_max_minus_min
integer, parameter, public do_eri_gpw
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_nonbonded14_section(section)
This section specifies the input parameters for 1-4 NON-BONDED Interactions.
subroutine, public create_lj_section(section)
This section specifies the input parameters for Lennard-Jones potential type.
function that build the poisson section of the input
subroutine, public create_poisson_section(section)
Creates the Poisson section.
subroutine, public create_gspace_interp_section(section)
creates the interpolation section for the periodic QM/MM
creates the qmmm section of the input
subroutine, public create_qmmm_section(section)
Creates the QM/MM section.
builds the subsystem section of the input
subroutine, public create_cell_section(section, periodic)
creates the cell section
represents keywords in an input
subroutine, public keyword_release(keyword)
releases the given keyword (see doc/ReferenceCounting.html)
subroutine, public keyword_create(keyword, location, name, description, usage, type_of_var, n_var, repeats, variants, default_val, default_l_val, default_r_val, default_lc_val, default_c_val, default_i_val, default_l_vals, default_r_vals, default_c_vals, default_i_vals, lone_keyword_val, lone_keyword_l_val, lone_keyword_r_val, lone_keyword_c_val, lone_keyword_i_val, lone_keyword_l_vals, lone_keyword_r_vals, lone_keyword_c_vals, lone_keyword_i_vals, enum_c_vals, enum_i_vals, enum, enum_strict, enum_desc, unit_str, citations, deprecation_notice, removed)
creates a keyword object
objects that represent the structure of input sections and the data contained in an input section
subroutine, public section_create(section, location, name, description, n_keywords, n_subsections, repeats, citations)
creates a list of keywords
subroutine, public section_add_keyword(section, keyword)
adds a keyword to the given section
subroutine, public section_add_subsection(section, subsection)
adds a subsection to the given section
recursive subroutine, public section_release(section)
releases the given keyword list (see doc/ReferenceCounting.html)
a wrapper for basic fortran types.
integer, parameter, public real_t
integer, parameter, public lchar_t
integer, parameter, public logical_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
different utils that are useful to manipulate splines on the regular grid of a pw
integer, parameter, public precond_spl3_3
integer, parameter, public precond_spl3_aint
integer, parameter, public no_precond
integer, parameter, public precond_spl3_2
integer, parameter, public precond_spl3_aint2
integer, parameter, public precond_spl3_1
Utilities for string manipulations.
represent a keyword in the input
represent a section of the input file