(git:15c1bfc)
Loading...
Searching...
No Matches
input_cp2k_properties_dft.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief function that build the dft section of the input
10!> \par History
11!> 01.2013 moved out of input_cp2k_dft [MI]
12!> \author MI
13! **************************************************************************************************
15 USE bibliography, ONLY: futera2017, &
17 kondov2007, &
18 luber2014, &
22 weber2009, &
31 USE cp_units, ONLY: cp_unit_to_cp2k
32 USE input_constants, ONLY: &
60 USE input_val_types, ONLY: char_t, &
61 integer_t, &
62 lchar_t, &
63 logical_t, &
64 real_t
66 USE kinds, ONLY: dp
67 USE string_utilities, ONLY: s2a
68#include "./base/base_uses.f90"
69
70 IMPLICIT NONE
71 PRIVATE
72
73 LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .true.
74 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_cp2k_properties_dft'
75
77
78CONTAINS
79
80! **************************************************************************************************
81!> \brief Create the PROPERTIES section
82!> \param section the section to create
83!> \author teo
84! **************************************************************************************************
85 SUBROUTINE create_properties_section(section)
86 TYPE(section_type), POINTER :: section
87
88 TYPE(keyword_type), POINTER :: keyword
89 TYPE(section_type), POINTER :: subsection
90
91 cpassert(.NOT. ASSOCIATED(section))
92 CALL section_create(section, __location__, name="PROPERTIES", &
93 description="This section is used to set up the PROPERTIES calculation.", &
94 n_keywords=0, n_subsections=6, repeats=.false.)
95
96 NULLIFY (subsection, keyword)
97
98 CALL create_linres_section(subsection, create_subsections=.true.)
99 CALL section_add_subsection(section, subsection)
100 CALL section_release(subsection)
101
102 CALL create_et_coupling_section(subsection)
103 CALL section_add_subsection(section, subsection)
104 CALL section_release(subsection)
105
106 CALL create_resp_section(subsection)
107 CALL section_add_subsection(section, subsection)
108 CALL section_release(subsection)
109
110 CALL create_atprop_section(subsection)
111 CALL section_add_subsection(section, subsection)
112 CALL section_release(subsection)
113
114 CALL cp_print_key_section_create(subsection, __location__, name="FIT_CHARGE", &
115 description="This section is used to print the density derived atomic point charges. "// &
116 "The fit of the charges is controlled through the DENSITY_FITTING section", &
117 print_level=high_print_level, filename="__STD_OUT__")
118 CALL keyword_create(keyword, __location__, name="TYPE_OF_DENSITY", &
119 description="Specifies the type of density used for the fitting", &
120 usage="TYPE_OF_DENSITY (FULL|SPIN)", &
121 enum_c_vals=s2a("FULL", "SPIN"), &
122 enum_i_vals=(/do_full_density, do_spin_density/), &
123 enum_desc=s2a("Full density", "Spin density"), &
124 default_i_val=do_full_density)
125 CALL section_add_keyword(subsection, keyword)
126 CALL keyword_release(keyword)
127 CALL section_add_subsection(section, subsection)
128 CALL section_release(subsection)
129
130 CALL create_tddfpt2_section(subsection)
131 CALL section_add_subsection(section, subsection)
132 CALL section_release(subsection)
133
134 CALL create_rixs_section(subsection)
135 CALL section_add_subsection(section, subsection)
136 CALL section_release(subsection)
137
138 CALL create_bandstructure_section(subsection)
139 CALL section_add_subsection(section, subsection)
140 CALL section_release(subsection)
141
142 CALL create_tipscan_section(subsection)
143 CALL section_add_subsection(section, subsection)
144 CALL section_release(subsection)
145
146 END SUBROUTINE create_properties_section
147
148! **************************************************************************************************
149!> \brief creates the input structure used to activate
150!> a resonant inelastic xray scattering (RIXS) calculation
151! **************************************************************************************************
152
153 SUBROUTINE create_rixs_section(section)
154 TYPE(section_type), POINTER :: section
155 TYPE(section_type), POINTER :: subsection, print_key
156 TYPE(keyword_type), POINTER :: keyword
157
158 cpassert(.NOT. ASSOCIATED(section))
159
160 NULLIFY (keyword, subsection, print_key)
161
162 CALL section_create(section, __location__, name="RIXS", &
163 description="Resonant Inelastic Xray Scattering using XAS_TDP and TDDFPT.", &
164 n_keywords=1, n_subsections=3, repeats=.false., &
165 citations=(/vazdacruz2021/))
166
167 CALL create_tddfpt2_section(subsection)
168 CALL section_add_subsection(section, subsection)
169 CALL section_release(subsection)
170
171 CALL create_xas_tdp_section(subsection)
172 CALL section_add_subsection(section, subsection)
173 CALL section_release(subsection)
174
175 CALL section_create(subsection, __location__, "PRINT", "Controls the printing of information "// &
176 "during RIXS calculations", repeats=.false.)
177
178 CALL cp_print_key_section_create(print_key, __location__, name="SPECTRUM", &
179 description="Controles the printing of the RIXS spectrum "// &
180 "in output files", &
181 print_level=low_print_level, filename="", &
182 common_iter_levels=3)
183 CALL section_add_subsection(subsection, print_key)
184 CALL section_release(print_key)
185
186 CALL section_add_subsection(section, subsection)
187 CALL section_release(subsection)
188
189 END SUBROUTINE create_rixs_section
190
191! **************************************************************************************************
192!> \brief creates the input structure used to activate
193!> a linear response calculation
194!> Available properties : none
195!> \param section the section to create
196!> \param create_subsections indicates whether or not subsections should be created
197!> \param default_set_tdlr default parameters to be used if called from TDDFPT
198!> \author MI
199! **************************************************************************************************
200 SUBROUTINE create_linres_section(section, create_subsections, default_set_tdlr)
201 TYPE(section_type), POINTER :: section
202 LOGICAL, INTENT(in) :: create_subsections
203 LOGICAL, INTENT(IN), OPTIONAL :: default_set_tdlr
204
205 INTEGER :: def_max_iter, def_precond
206 REAL(kind=dp) :: def_egap, def_eps, def_eps_filter
207 TYPE(keyword_type), POINTER :: keyword
208 TYPE(section_type), POINTER :: print_key, subsection
209
210 NULLIFY (keyword, print_key)
211
212 IF (PRESENT(default_set_tdlr)) THEN
213 def_egap = 0.02_dp
214 def_eps = 1.0e-10_dp
215 def_eps_filter = 1.0e-15_dp
216 def_max_iter = 100
218 ELSE
219 def_egap = 0.2_dp
220 def_eps = 1.e-6_dp
221 def_eps_filter = 0.0_dp
222 def_max_iter = 50
223 def_precond = ot_precond_none
224 END IF
225
226 cpassert(.NOT. ASSOCIATED(section))
227 CALL section_create(section, __location__, name="linres", &
228 description="The linear response is used to calculate one of the "// &
229 "following properties: nmr, epr, raman, ... ", &
230 n_keywords=5, n_subsections=2, repeats=.false., &
231 citations=(/putrino2000/))
232
233 CALL keyword_create(keyword, __location__, name="EPS", &
234 description="target accuracy for the convergence of the conjugate gradient.", &
235 usage="EPS 1.e-6", default_r_val=def_eps)
236 CALL section_add_keyword(section, keyword)
237 CALL keyword_release(keyword)
238
239 CALL keyword_create(keyword, __location__, name="EPS_FILTER", &
240 description="Filter threshold for response density matrix.", &
241 usage="EPS_FILTER 1.e-8", default_r_val=def_eps_filter)
242 CALL section_add_keyword(section, keyword)
243 CALL keyword_release(keyword)
244
245 CALL keyword_create(keyword, __location__, name="MAX_ITER", &
246 description="Maximum number of conjugate gradient iteration to be performed for one optimization.", &
247 usage="MAX_ITER 200", default_i_val=def_max_iter)
248 CALL section_add_keyword(section, keyword)
249 CALL keyword_release(keyword)
250
251 CALL keyword_create(keyword, __location__, name="RESTART_EVERY", &
252 description="Restart the conjugate gradient after the specified number of iterations.", &
253 usage="RESTART_EVERY 200", default_i_val=50)
254 CALL section_add_keyword(section, keyword)
255 CALL keyword_release(keyword)
256
257 CALL keyword_create( &
258 keyword, __location__, name="PRECONDITIONER", &
259 description="Type of preconditioner to be used with all minimization schemes. "// &
260 "They differ in effectiveness, cost of construction, cost of application. "// &
261 "Properly preconditioned minimization can be orders of magnitude faster than doing nothing.", &
262 usage="PRECONDITIONER FULL_ALL", &
263 default_i_val=def_precond, &
264 enum_c_vals=s2a("FULL_ALL", "FULL_SINGLE_INVERSE", "FULL_SINGLE", "FULL_KINETIC", "FULL_S_INVERSE", &
265 "NONE"), &
266 enum_desc=s2a("Most effective state selective preconditioner based on diagonalization, "// &
267 "requires the ENERGY_GAP parameter to be an underestimate of the HOMO-LUMO gap. "// &
268 "This preconditioner is recommended for almost all systems, except very large systems where "// &
269 "make_preconditioner would dominate the total computational cost.", &
270 "Based on H-eS cholesky inversion, similar to FULL_SINGLE in preconditioning efficiency "// &
271 "but cheaper to construct, "// &
272 "might be somewhat less robust. Recommended for large systems.", &
273 "Based on H-eS diagonalisation, not as good as FULL_ALL, but somewhat cheaper to apply. ", &
274 "Cholesky inversion of S and T, fast construction, robust, and relatively good, "// &
275 "use for very large systems.", &
276 "Cholesky inversion of S, not as good as FULL_KINETIC, yet equally expensive.", &
277 "skip preconditioning"), &
280 CALL section_add_keyword(section, keyword)
281 CALL keyword_release(keyword)
282
283 CALL keyword_create(keyword, __location__, name="ENERGY_GAP", &
284 description="Energy gap estimate [a.u.] for preconditioning", &
285 usage="ENERGY_GAP 0.1", &
286 default_r_val=def_egap)
287 CALL section_add_keyword(section, keyword)
288 CALL keyword_release(keyword)
289
290 CALL keyword_create(keyword, __location__, name="EVERY_N_STEP", &
291 description="Perform a linear response calculation every N-th step for MD run", &
292 usage="EVERY_N_STEP 50", default_i_val=1)
293 CALL section_add_keyword(section, keyword)
294 CALL keyword_release(keyword)
295
296 CALL keyword_create(keyword, __location__, name="RESTART", &
297 description="Restart the response calculation if the restart file exists", &
298 usage="RESTART", &
299 default_l_val=.false., lone_keyword_l_val=.true.)
300 CALL section_add_keyword(section, keyword)
301 CALL keyword_release(keyword)
302
303 CALL keyword_create(keyword, __location__, name="WFN_RESTART_FILE_NAME", &
304 variants=(/"RESTART_FILE_NAME"/), &
305 description="Root of the file names where to read the response functions from "// &
306 "which to restart the calculation of the linear response", &
307 usage="WFN_RESTART_FILE_NAME <FILENAME>", &
308 type_of_var=lchar_t)
309 CALL section_add_keyword(section, keyword)
310 CALL keyword_release(keyword)
311
312 IF (create_subsections) THEN
313 NULLIFY (subsection)
314
315 CALL create_localize_section(subsection)
316 CALL section_add_subsection(section, subsection)
317 CALL section_release(subsection)
318
319 CALL create_current_section(subsection)
320 CALL section_add_subsection(section, subsection)
321 CALL section_release(subsection)
322
323 CALL create_nmr_section(subsection)
324 CALL section_add_subsection(section, subsection)
325 CALL section_release(subsection)
326
327 CALL create_spin_spin_section(subsection)
328 CALL section_add_subsection(section, subsection)
329 CALL section_release(subsection)
330
331 CALL create_epr_section(subsection)
332 CALL section_add_subsection(section, subsection)
333 CALL section_release(subsection)
334
335 CALL create_polarizability_section(subsection)
336 CALL section_add_subsection(section, subsection)
337 CALL section_release(subsection)
338
339 CALL create_dcdr_section(subsection)
340 CALL section_add_subsection(section, subsection)
341 CALL section_release(subsection)
342
343 CALL create_vcd_section(subsection)
344 CALL section_add_subsection(section, subsection)
345 CALL section_release(subsection)
346
347 CALL section_create(subsection, __location__, name="PRINT", &
348 description="printing of information during the linear response calculation", &
349 repeats=.false.)
350
352 print_key, __location__, "program_run_info", &
353 description="Controls the printing of basic iteration information during the LINRES calculation", &
354 print_level=low_print_level, add_last=add_last_numeric, filename="__STD_OUT__")
355 CALL section_add_subsection(subsection, print_key)
356 CALL section_release(print_key)
357
358 CALL cp_print_key_section_create(print_key, __location__, "RESTART", &
359 description="Controls the dumping of restart file of the response wavefunction. "// &
360 "For each set of response functions, i.e. for each perturbation, "// &
361 "one different restart file is dumped. These restart files should be "// &
362 "employed only to restart the same type of LINRES calculation, "// &
363 "i.e. with the same perturbation.", &
364 print_level=low_print_level, common_iter_levels=3, each_iter_names=s2a("ITER"), &
365 add_last=add_last_numeric, each_iter_values=(/3/), filename="")
366 CALL section_add_subsection(subsection, print_key)
367 CALL section_release(print_key)
368
369 CALL section_add_subsection(section, subsection)
370 CALL section_release(subsection)
371
372 END IF
373
374 END SUBROUTINE create_linres_section
375
376! **************************************************************************************************
377!> \brief creates the input structure used to activate
378!> calculation of position perturbation DFPT
379!> \param section ...
380!> \author Sandra Luber, Edward Ditler
381! **************************************************************************************************
382 SUBROUTINE create_dcdr_section(section)
383
384 TYPE(section_type), POINTER :: section
385
386 LOGICAL :: failure
387 TYPE(keyword_type), POINTER :: keyword
388 TYPE(section_type), POINTER :: print_key, subsection
389
390 failure = .false.
391 NULLIFY (keyword, print_key, subsection)
392
393 cpassert(.NOT. ASSOCIATED(section))
394
395 IF (.NOT. failure) THEN
396 CALL section_create(section, __location__, name="DCDR", &
397 description="Compute analytical gradients the dipole moments.", &
398 n_keywords=50, n_subsections=1, repeats=.false.)
399
400 CALL keyword_create(keyword, __location__, name="_SECTION_PARAMETERS_", &
401 description="controls the activation of the APT calculation", &
402 usage="&DCDR T", &
403 default_l_val=.false., &
404 lone_keyword_l_val=.true.)
405 CALL section_add_keyword(section, keyword)
406 CALL keyword_release(keyword)
407
408 CALL keyword_create(keyword, __location__, name="LIST_OF_ATOMS", &
409 description="Specifies a list of atoms.", &
410 usage="LIST_OF_ATOMS {integer} {integer} .. {integer}", repeats=.true., &
411 n_var=-1, type_of_var=integer_t)
412 CALL section_add_keyword(section, keyword)
413 CALL keyword_release(keyword)
414
415 CALL keyword_create(keyword, __location__, name="DISTRIBUTED_ORIGIN", &
416 variants=(/"DO_GAUGE"/), &
417 description="Use the distributed origin (DO) gauge?", &
418 usage="DISTRIBUTED_ORIGIN T", &
419 default_l_val=.false., lone_keyword_l_val=.true.)
420 CALL section_add_keyword(section, keyword)
421 CALL keyword_release(keyword)
422
423 CALL keyword_create(keyword, __location__, name="ORBITAL_CENTER", &
424 description="The orbital center.", &
425 usage="ORBITAL_CENTER WANNIER", &
426 default_i_val=current_orb_center_wannier, &
427 enum_c_vals=s2a("WANNIER", "COMMON", "ATOM", "BOX"), &
428 enum_desc=s2a("Use the Wannier centers.", &
429 "Use a common center (works only for an isolate molecule).", &
430 "Use the atoms as center.", &
431 "Boxing."), &
434 CALL section_add_keyword(section, keyword)
435 CALL keyword_release(keyword)
436
437 CALL keyword_create(keyword, __location__, name="REFERENCE", &
438 description="Gauge origin of the velocity gauge factor.", &
439 enum_c_vals=s2a("COM", "COAC", "USER_DEFINED", "ZERO"), &
440 enum_desc=s2a("Use Center of Mass", &
441 "Use Center of Atomic Charges", &
442 "Use User-defined Point", &
443 "Use Origin of Coordinate System"), &
444 enum_i_vals=(/use_mom_ref_com, &
448 default_i_val=use_mom_ref_zero)
449 CALL section_add_keyword(section, keyword)
450 CALL keyword_release(keyword)
451
452 CALL keyword_create(keyword, __location__, name="REFERENCE_POINT", &
453 description="User-defined reference point of the velocity gauge factor.", &
454 usage="REFERENCE_POINT x y z", &
455 repeats=.false., n_var=3, type_of_var=real_t, unit_str='bohr')
456 CALL section_add_keyword(section, keyword)
457 CALL keyword_release(keyword)
458
459 CALL keyword_create(keyword, __location__, name="Z_MATRIX_METHOD", &
460 description="Use Z_matrix method to solve the response equation", &
461 usage="Z_MATRIX_METHOD T", &
462 default_l_val=.false., lone_keyword_l_val=.true.)
463 CALL section_add_keyword(section, keyword)
464 CALL keyword_release(keyword)
465
466 CALL keyword_create(keyword, __location__, name="APT_FD", &
467 description="Use numerical differentiation to compute the APT, "// &
468 "switches off the calculation of dcdr analytical derivatives. "// &
469 "Requires RUN_TYPE = ENERGY_FORCE or MD.", &
470 usage="APT_FD T", &
471 default_l_val=.false., lone_keyword_l_val=.true.)
472 CALL section_add_keyword(section, keyword)
473 CALL keyword_release(keyword)
474
475 CALL keyword_create(keyword, __location__, name="APT_FD_DE", &
476 description="Electric field strength (atomic units) to use for finite differences", &
477 repeats=.false., &
478 n_var=1, &
479 type_of_var=real_t, &
480 default_r_val=0.0003_dp, &
481 usage="APT_FD_DE 1.0E-4")
482 CALL section_add_keyword(section, keyword)
483 CALL keyword_release(keyword)
484
485 CALL keyword_create(keyword, __location__, name="APT_FD_METHOD", &
486 description="Numerical differentiation method", &
487 usage="APT_FD_METHOD FD", &
488 default_i_val=1, &
489 !enum_c_vals=s2a("FD", "2PNT"), &
490 enum_c_vals=s2a("2PNT"), &
491 !enum_desc=s2a("Forward differences.", &
492 ! "Symmetric two-point differences."), &
493 enum_desc=s2a("Symmetric two-point differences."), &
494 !enum_i_vals=(/0, 1/))
495 enum_i_vals=(/1/))
496 CALL section_add_keyword(section, keyword)
497 CALL keyword_release(keyword)
498
499 NULLIFY (subsection)
500 CALL section_create(subsection, __location__, name="PRINT", &
501 description="print results of the magnetic dipole moment calculation", &
502 repeats=.false.)
503
504 CALL cp_print_key_section_create(print_key, __location__, "APT", &
505 description="Controls the printing of the electric dipole gradient", &
506 print_level=low_print_level, add_last=add_last_numeric, filename="")
507 CALL section_add_subsection(subsection, print_key)
508 CALL section_release(print_key)
509
510 CALL section_add_subsection(section, subsection)
511 CALL section_release(subsection)
512
513 NULLIFY (subsection)
514 CALL create_interp_section(subsection)
515 CALL section_add_subsection(section, subsection)
516 CALL section_release(subsection)
517
518 END IF
519
520 END SUBROUTINE create_dcdr_section
521
522! **************************************************************************************************
523!> \brief creates the input structure used to activate
524!> calculation of VCD spectra using DFPT
525!> \param section ...
526!> \author Sandra Luber, Tomas Zimmermann, Edward Ditler
527! **************************************************************************************************
528 SUBROUTINE create_vcd_section(section)
529
530 TYPE(section_type), POINTER :: section
531
532 TYPE(keyword_type), POINTER :: keyword
533 TYPE(section_type), POINTER :: print_key, subsection
534
535 NULLIFY (keyword, print_key, subsection)
536
537 cpassert(.NOT. ASSOCIATED(section))
538
539 CALL section_create(section, __location__, name="VCD", &
540 description="Carry out a VCD calculation.", &
541 n_keywords=50, n_subsections=1, repeats=.false.)
542
543 CALL keyword_create(keyword, __location__, name="_SECTION_PARAMETERS_", &
544 description="controls the activation of the APT/AAT calculation", &
545 usage="&VCD T", &
546 default_l_val=.false., &
547 lone_keyword_l_val=.true.)
548 CALL section_add_keyword(section, keyword)
549 CALL keyword_release(keyword)
550
551 CALL keyword_create(keyword, __location__, name="LIST_OF_ATOMS", &
552 description="Specifies a list of atoms.", &
553 usage="LIST_OF_ATOMS {integer} {integer} .. {integer}", repeats=.true., &
554 n_var=-1, type_of_var=integer_t)
555 CALL section_add_keyword(section, keyword)
556 CALL keyword_release(keyword)
557
558 CALL keyword_create(keyword, __location__, name="DISTRIBUTED_ORIGIN", &
559 variants=(/"DO_GAUGE"/), &
560 description="Use the distributed origin (DO) gauge?", &
561 usage="DISTRIBUTED_ORIGIN T", &
562 default_l_val=.false., lone_keyword_l_val=.true.)
563 CALL section_add_keyword(section, keyword)
564 CALL keyword_release(keyword)
565
566 CALL keyword_create(keyword, __location__, name="ORIGIN_DEPENDENT_MFP", &
567 description="Use the origin dependent MFP operator.", &
568 usage="ORIGIN_DEPENDENT_MFP T", &
569 default_l_val=.false., lone_keyword_l_val=.true.)
570 CALL section_add_keyword(section, keyword)
571 CALL keyword_release(keyword)
572
573 CALL keyword_create(keyword, __location__, name="ORBITAL_CENTER", &
574 description="The orbital center.", &
575 usage="ORBITAL_CENTER WANNIER", &
576 default_i_val=current_orb_center_wannier, &
577 enum_c_vals=s2a("WANNIER", "COMMON", "ATOM", "BOX"), &
578 enum_desc=s2a("Use the Wannier centers.", &
579 "Use a common center (works only for an isolate molecule).", &
580 "Use the atoms as center.", &
581 "Boxing."), &
584 CALL section_add_keyword(section, keyword)
585 CALL keyword_release(keyword)
586
587 ! The origin of the magnetic dipole operator (r - MAGNETIC_ORIGIN) x momentum
588 CALL keyword_create(keyword, __location__, name="MAGNETIC_ORIGIN", &
589 description="Gauge origin of the magnetic dipole operator.", &
590 enum_c_vals=s2a("COM", "COAC", "USER_DEFINED", "ZERO"), &
591 enum_desc=s2a("Use Center of Mass", &
592 "Use Center of Atomic Charges", &
593 "Use User-defined Point", &
594 "Use Origin of Coordinate System"), &
595 enum_i_vals=(/use_mom_ref_com, &
599 default_i_val=use_mom_ref_zero)
600 CALL section_add_keyword(section, keyword)
601 CALL keyword_release(keyword)
602
603 CALL keyword_create(keyword, __location__, name="MAGNETIC_ORIGIN_REFERENCE", &
604 description="User-defined reference point of the magnetic dipole operator.", &
605 usage="MAGNETIC_ORIGIN_REFERENCE x y z", &
606 repeats=.false., n_var=3, type_of_var=real_t, unit_str='bohr')
607 CALL section_add_keyword(section, keyword)
608 CALL keyword_release(keyword)
609
610 ! The origin of the coordinate system
611 CALL keyword_create(keyword, __location__, name="SPATIAL_ORIGIN", &
612 description="Gauge origin of the velocity gauge factor/spatial origin.", &
613 enum_c_vals=s2a("COM", "COAC", "USER_DEFINED", "ZERO"), &
614 enum_desc=s2a("Use Center of Mass", &
615 "Use Center of Atomic Charges", &
616 "Use User-defined Point", &
617 "Use Origin of Coordinate System"), &
618 enum_i_vals=(/use_mom_ref_com, &
622 default_i_val=use_mom_ref_zero)
623 CALL section_add_keyword(section, keyword)
624 CALL keyword_release(keyword)
625
626 CALL keyword_create(keyword, __location__, name="SPATIAL_ORIGIN_REFERENCE", &
627 description="User-defined reference point of the velocity gauge factor/spatial origin.", &
628 usage="SPATIAL_ORIGIN_REFERENCE x y z", &
629 repeats=.false., n_var=3, type_of_var=real_t, unit_str='bohr')
630 CALL section_add_keyword(section, keyword)
631 CALL keyword_release(keyword)
632
633 NULLIFY (subsection)
634 CALL section_create(subsection, __location__, name="PRINT", &
635 description="print results of the magnetic dipole moment calculation", &
636 repeats=.false.)
637
638 CALL cp_print_key_section_create(print_key, __location__, "VCD", &
639 description="Controls the printing of the APTs and AATs", &
640 print_level=low_print_level, add_last=add_last_numeric, filename="")
641 CALL section_add_subsection(subsection, print_key)
642 CALL section_release(print_key)
643
644 CALL section_add_subsection(section, subsection)
645 CALL section_release(subsection)
646
647 NULLIFY (subsection)
648 CALL create_interp_section(subsection)
649 CALL section_add_subsection(section, subsection)
650 CALL section_release(subsection)
651
652 END SUBROUTINE create_vcd_section
653
654! **************************************************************************************************
655!> \brief creates the input structure used to activate
656!> calculation of induced current DFPT
657!> Available properties : none
658!> \param section the section to create
659!> \author MI/VW
660! **************************************************************************************************
661 SUBROUTINE create_current_section(section)
662 TYPE(section_type), POINTER :: section
663
664 TYPE(keyword_type), POINTER :: keyword
665 TYPE(section_type), POINTER :: print_key, subsection
666
667 NULLIFY (keyword, print_key, subsection)
668
669 cpassert(.NOT. ASSOCIATED(section))
670 CALL section_create(section, __location__, name="current", &
671 description="The induced current density is calculated by DFPT.", &
672 n_keywords=4, n_subsections=1, repeats=.false., &
673 citations=(/sebastiani2001, weber2009/))
674
675 CALL keyword_create(keyword, __location__, name="_SECTION_PARAMETERS_", &
676 description="controls the activation of the induced current calculation", &
677 usage="&CURRENT T", &
678 default_l_val=.false., &
679 lone_keyword_l_val=.true.)
680 CALL section_add_keyword(section, keyword)
681 CALL keyword_release(keyword)
682
683 CALL keyword_create(keyword, __location__, name="GAUGE", &
684 description="The gauge used to compute the induced current within GAPW.", &
685 usage="GAUGE R", &
686 default_i_val=current_gauge_r_and_step_func, &
687 enum_c_vals=s2a("R", "R_AND_STEP_FUNCTION", "ATOM"), &
688 enum_desc=s2a("Position gauge (doesnt work well).", &
689 "Position and step function for the soft and the local parts, respectively.", &
690 "Atoms."), &
692 CALL section_add_keyword(section, keyword)
693 CALL keyword_release(keyword)
694
695 CALL keyword_create(keyword, __location__, name="GAUGE_ATOM_RADIUS", &
696 description="Build the gauge=atom using only the atoms within this radius.", &
697 usage="GAUGE_ATOM_RADIUS 10.0", &
698 type_of_var=real_t, &
699 default_r_val=cp_unit_to_cp2k(value=4.0_dp, unit_str="angstrom"), &
700 unit_str="angstrom")
701 CALL section_add_keyword(section, keyword)
702 CALL keyword_release(keyword)
703
704 CALL keyword_create(keyword, __location__, name="USE_OLD_GAUGE_ATOM", &
705 description="Use the old way to compute the gauge.", &
706 usage="USE_OLD_GAUGE_ATOM T", &
707 default_l_val=.true., lone_keyword_l_val=.true.)
708 CALL section_add_keyword(section, keyword)
709 CALL keyword_release(keyword)
710
711 CALL keyword_create(keyword, __location__, name="ORBITAL_CENTER", &
712 description="The orbital center.", &
713 usage="ORBITAL_CENTER WANNIER", &
714 default_i_val=current_orb_center_wannier, &
715 enum_c_vals=s2a("WANNIER", "COMMON", "ATOM", "BOX"), &
716 enum_desc=s2a("Use the Wannier centers.", &
717 "Use a common center (works only for an isolate molecule).", &
718 "Use the atoms as center.", &
719 "Boxing."), &
722 CALL section_add_keyword(section, keyword)
723 CALL keyword_release(keyword)
724
725 CALL keyword_create(keyword, __location__, name="COMMON_CENTER", &
726 description="The common center ", usage="COMMON_CENTER 0.0 1.0 0.0", &
727 n_var=3, default_r_vals=(/0.0_dp, 0.0_dp, 0.0_dp/), type_of_var=real_t, &
728 unit_str="angstrom")
729 CALL section_add_keyword(section, keyword)
730 CALL keyword_release(keyword)
731
732 CALL keyword_create(keyword, __location__, name="NBOX", &
733 description="How many boxes along each directions ", usage="NBOX 6 6 5", &
734 n_var=3, default_i_vals=(/4, 4, 4/), type_of_var=integer_t)
735 CALL section_add_keyword(section, keyword)
736 CALL keyword_release(keyword)
737
738 CALL keyword_create(keyword, __location__, name="CHI_PBC", &
739 description="Calculate the succeptibility correction to the shift with PBC", &
740 usage="CHI_PBC T", &
741 default_l_val=.false., lone_keyword_l_val=.true.)
742 CALL section_add_keyword(section, keyword)
743 CALL keyword_release(keyword)
744
745 CALL keyword_create(keyword, __location__, name="FORCE_NO_FULL", &
746 description="Avoid the calculation of the state dependent perturbation term, "// &
747 "even if the orbital centers are set at Wannier centers or at Atom centers", &
748 usage="FORCE_NO_FULL T", &
749 default_l_val=.false., lone_keyword_l_val=.true.)
750 CALL section_add_keyword(section, keyword)
751 CALL keyword_release(keyword)
752
753 CALL keyword_create(keyword, __location__, name="SELECTED_STATES_ON_ATOM_LIST", &
754 description="Indexes of the atoms for selecting"// &
755 " the states to be used for the response calculations.", &
756 usage="SELECTED_STATES_ON_ATOM_LIST 1 2 10", &
757 n_var=-1, type_of_var=integer_t, repeats=.true.)
758 CALL section_add_keyword(section, keyword)
759 CALL keyword_release(keyword)
760
761 CALL keyword_create(keyword, __location__, name="SELECTED_STATES_ATOM_RADIUS", &
762 description="Select all the states included in the given radius around each atoms "// &
763 "in SELECTED_STATES_ON_ATOM_LIST.", &
764 usage="SELECTED_STATES_ATOM_RADIUS 2.0", &
765 type_of_var=real_t, &
766 default_r_val=cp_unit_to_cp2k(value=4.0_dp, unit_str="angstrom"), &
767 unit_str="angstrom")
768 CALL section_add_keyword(section, keyword)
769 CALL keyword_release(keyword)
770
771 CALL keyword_create(keyword, __location__, name="RESTART_CURRENT", &
772 description="Restart the induced current density calculation"// &
773 " from a previous run (not working yet).", &
774 usage="RESTART_CURRENT", default_l_val=.false., &
775 lone_keyword_l_val=.true.)
776 CALL section_add_keyword(section, keyword)
777 CALL keyword_release(keyword)
778
779 NULLIFY (subsection)
780 CALL section_create(subsection, __location__, name="PRINT", &
781 description="print results of induced current density calculation", &
782 repeats=.false.)
783
784 CALL cp_print_key_section_create(print_key, __location__, "CURRENT_CUBES", &
785 description="Controls the printing of the induced current density (not working yet).", &
786 print_level=high_print_level, add_last=add_last_numeric, filename="")
787 CALL keyword_create(keyword, __location__, name="stride", &
788 description="The stride (X,Y,Z) used to write the cube file "// &
789 "(larger values result in smaller cube files). You can provide 3 numbers (for X,Y,Z) or"// &
790 " 1 number valid for all components (not working yet).", &
791 usage="STRIDE 2 2 2", n_var=-1, default_i_vals=(/2, 2, 2/), type_of_var=integer_t)
792 CALL section_add_keyword(print_key, keyword)
793 CALL keyword_release(keyword)
794 CALL keyword_create(keyword, __location__, name="APPEND", &
795 description="append the cube files when they already exist", &
796 default_l_val=.false., lone_keyword_l_val=.true.)
797 CALL section_add_keyword(print_key, keyword)
798 CALL keyword_release(keyword)
799
800 CALL section_add_subsection(subsection, print_key)
801 CALL section_release(print_key)
802
803 CALL cp_print_key_section_create(print_key, __location__, "RESPONSE_FUNCTION_CUBES", &
804 description="Controls the printing of the response functions (not working yet).", &
805 print_level=high_print_level, add_last=add_last_numeric, filename="")
806 CALL keyword_create(keyword, __location__, name="stride", &
807 description="The stride (X,Y,Z) used to write the cube file "// &
808 "(larger values result in smaller cube files). You can provide 3 numbers (for X,Y,Z) or"// &
809 " 1 number valid for all components (not working yet).", &
810 usage="STRIDE 2 2 2", n_var=-1, default_i_vals=(/2, 2, 2/), type_of_var=integer_t)
811 CALL section_add_keyword(print_key, keyword)
812 CALL keyword_release(keyword)
813
814 CALL keyword_create(keyword, __location__, name="CUBES_LU_BOUNDS", &
815 variants=(/"CUBES_LU"/), &
816 description="The lower and upper index of the states to be printed as cube (not working yet).", &
817 usage="CUBES_LU_BOUNDS integer integer", &
818 n_var=2, default_i_vals=(/0, -2/), type_of_var=integer_t)
819 CALL section_add_keyword(print_key, keyword)
820 CALL keyword_release(keyword)
821
822 CALL keyword_create(keyword, __location__, name="CUBES_LIST", &
823 description="Indexes of the states to be printed as cube files "// &
824 "This keyword can be repeated several times "// &
825 "(useful if you have to specify many indexes) (not working yet).", &
826 usage="CUBES_LIST 1 2", &
827 n_var=-1, type_of_var=integer_t, repeats=.true.)
828 CALL section_add_keyword(print_key, keyword)
829 CALL keyword_release(keyword)
830 CALL keyword_create(keyword, __location__, name="APPEND", &
831 description="append the cube files when they already exist", &
832 default_l_val=.false., lone_keyword_l_val=.true.)
833 CALL section_add_keyword(print_key, keyword)
834 CALL keyword_release(keyword)
835
836 CALL section_add_subsection(subsection, print_key)
837 CALL section_release(print_key)
838
839 CALL section_add_subsection(section, subsection)
840 CALL section_release(subsection)
841
842 NULLIFY (subsection)
843 CALL create_interp_section(subsection)
844 CALL section_add_subsection(section, subsection)
845 CALL section_release(subsection)
846
847 END SUBROUTINE create_current_section
848
849! **************************************************************************************************
850!> \brief creates the input structure used to activate
851!> calculation of NMR chemical shift using
852!> the induced current obtained from DFPT
853!> Available properties : none
854!> \param section the section to create
855!> \author MI/VW
856! **************************************************************************************************
857 SUBROUTINE create_nmr_section(section)
858 TYPE(section_type), POINTER :: section
859
860 TYPE(keyword_type), POINTER :: keyword
861 TYPE(section_type), POINTER :: print_key, subsection
862
863 NULLIFY (keyword, print_key, subsection)
864
865 cpassert(.NOT. ASSOCIATED(section))
866 CALL section_create(section, __location__, name="nmr", &
867 description="The chemical shift is calculated by DFPT.", &
868 n_keywords=5, n_subsections=1, repeats=.false., &
869 citations=(/weber2009/))
870
871 CALL keyword_create(keyword, __location__, name="_SECTION_PARAMETERS_", &
872 description="controls the activation of the nmr calculation", &
873 usage="&NMR T", &
874 default_l_val=.false., &
875 lone_keyword_l_val=.true.)
876 CALL section_add_keyword(section, keyword)
877 CALL keyword_release(keyword)
878
879 CALL keyword_create(keyword, __location__, name="INTERPOLATE_SHIFT", &
880 description="Calculate the soft part of the chemical shift by interpolation ", &
881 usage="INTERPOLATE_SHIFT T", &
882 default_l_val=.false., lone_keyword_l_val=.true.)
883 CALL section_add_keyword(section, keyword)
884 CALL keyword_release(keyword)
885
886 CALL keyword_create(keyword, __location__, name="NICS", &
887 description="Calculate the chemical shift in a set of points"// &
888 " given from an external file", usage="NICS", &
889 default_l_val=.false., lone_keyword_l_val=.true.)
890 CALL section_add_keyword(section, keyword)
891 CALL keyword_release(keyword)
892
893 CALL keyword_create(keyword, __location__, name="NICS_FILE_NAME", &
894 description="Name of the file with the NICS points coordinates", &
895 usage="NICS_FILE_NAME nics_file", &
896 default_lc_val="nics_file")
897 CALL section_add_keyword(section, keyword)
898 CALL keyword_release(keyword)
899
900 CALL keyword_create(keyword, __location__, name="RESTART_NMR", &
901 description="Restart the NMR calculation from a previous run (NOT WORKING YET)", &
902 usage="RESTART_NMR", default_l_val=.false., &
903 lone_keyword_l_val=.true.)
904 CALL section_add_keyword(section, keyword)
905 CALL keyword_release(keyword)
906
907 CALL keyword_create(keyword, __location__, name="SHIFT_GAPW_RADIUS", &
908 description="While computing the local part of the shift (GAPW), "// &
909 "the integration is restricted to nuclei that are within this radius.", &
910 usage="SHIFT_GAPW_RADIUS 20.0", &
911 type_of_var=real_t, &
912 default_r_val=cp_unit_to_cp2k(value=60.0_dp, unit_str="angstrom"), &
913 unit_str="angstrom")
914 CALL section_add_keyword(section, keyword)
915 CALL keyword_release(keyword)
916
917 NULLIFY (subsection)
918 CALL section_create(subsection, __location__, name="PRINT", &
919 description="print results of nmr calculation", &
920 repeats=.false.)
921
922 CALL cp_print_key_section_create(print_key, __location__, "RESPONSE_FUNCTION_CUBES", &
923 description="Controls the printing of the response functions ", &
924 print_level=high_print_level, add_last=add_last_numeric, filename="")
925 CALL keyword_create(keyword, __location__, name="stride", &
926 description="The stride (X,Y,Z) used to write the cube file "// &
927 "(larger values result in smaller cube files). You can provide 3 numbers (for X,Y,Z) or"// &
928 " 1 number valid for all components.", &
929 usage="STRIDE 2 2 2", n_var=-1, default_i_vals=(/2, 2, 2/), type_of_var=integer_t)
930 CALL section_add_keyword(print_key, keyword)
931 CALL keyword_release(keyword)
932
933 CALL keyword_create(keyword, __location__, name="CUBES_LU_BOUNDS", &
934 variants=(/"CUBES_LU"/), &
935 description="The lower and upper index of the states to be printed as cube", &
936 usage="CUBES_LU_BOUNDS integer integer", &
937 n_var=2, default_i_vals=(/0, -2/), type_of_var=integer_t)
938 CALL section_add_keyword(print_key, keyword)
939 CALL keyword_release(keyword)
940
941 CALL keyword_create(keyword, __location__, name="CUBES_LIST", &
942 description="Indexes of the states to be printed as cube files "// &
943 "This keyword can be repeated several times "// &
944 "(useful if you have to specify many indexes).", &
945 usage="CUBES_LIST 1 2", &
946 n_var=-1, type_of_var=integer_t, repeats=.true.)
947 CALL section_add_keyword(print_key, keyword)
948 CALL keyword_release(keyword)
949 CALL keyword_create(keyword, __location__, name="APPEND", &
950 description="append the cube files when they already exist", &
951 default_l_val=.false., lone_keyword_l_val=.true.)
952 CALL section_add_keyword(print_key, keyword)
953 CALL keyword_release(keyword)
954
955 CALL section_add_subsection(subsection, print_key)
956 CALL section_release(print_key)
957
958 CALL cp_print_key_section_create(print_key, __location__, "CHI_TENSOR", &
959 description="Controls the printing of susceptibility", &
960 print_level=high_print_level, add_last=add_last_numeric, filename="")
961 CALL section_add_subsection(subsection, print_key)
962 CALL section_release(print_key)
963
964 CALL cp_print_key_section_create(print_key, __location__, "SHIELDING_TENSOR", &
965 description="Controls the printing of the chemical shift", &
966 print_level=low_print_level, add_last=add_last_numeric, filename="")
967
968 CALL keyword_create(keyword, __location__, name="ATOMS_LU_BOUNDS", &
969 variants=(/"ATOMS_LU"/), &
970 description="The lower and upper atomic index for which the tensor is printed", &
971 usage="ATOMS_LU_BOUNDS integer integer", &
972 n_var=2, default_i_vals=(/0, -2/), type_of_var=integer_t)
973 CALL section_add_keyword(print_key, keyword)
974 CALL keyword_release(keyword)
975
976 CALL keyword_create(keyword, __location__, name="ATOMS_LIST", &
977 description="list of atoms for which the shift is printed into a file ", &
978 usage="ATOMS_LIST 1 2", n_var=-1, &
979 type_of_var=integer_t, repeats=.true.)
980 CALL section_add_keyword(print_key, keyword)
981 CALL keyword_release(keyword)
982
983 CALL section_add_subsection(subsection, print_key)
984 CALL section_release(print_key)
985
986 CALL section_add_subsection(section, subsection)
987 CALL section_release(subsection)
988
989 NULLIFY (subsection)
990 CALL create_interp_section(subsection)
991 CALL section_add_subsection(section, subsection)
992 CALL section_release(subsection)
993
994 END SUBROUTINE create_nmr_section
995
996! **************************************************************************************************
997!> \brief creates the input structure used to activate
998!> calculation of NMR spin-spin coupling (implementation not operating)
999!> Available properties : none
1000!> \param section the section to create
1001!> \author VW
1002! **************************************************************************************************
1003 SUBROUTINE create_spin_spin_section(section)
1004 TYPE(section_type), POINTER :: section
1005
1006 TYPE(keyword_type), POINTER :: keyword
1007 TYPE(section_type), POINTER :: print_key, subsection
1008
1009 NULLIFY (keyword, print_key, subsection)
1010
1011 cpassert(.NOT. ASSOCIATED(section))
1012 CALL section_create(section, __location__, name="spinspin", &
1013 description="Compute indirect spin-spin coupling constants.", &
1014 n_keywords=5, n_subsections=1, repeats=.false.)
1015
1016 CALL keyword_create(keyword, __location__, name="_SECTION_PARAMETERS_", &
1017 description="controls the activation of the nmr calculation", &
1018 usage="&SPINSPIN T", &
1019 default_l_val=.false., &
1020 lone_keyword_l_val=.true.)
1021 CALL section_add_keyword(section, keyword)
1022 CALL keyword_release(keyword)
1023
1024 CALL keyword_create(keyword, __location__, name="RESTART_SPINSPIN", &
1025 description="Restart the spin-spin calculation from a previous run (NOT WORKING YET)", &
1026 usage="RESTART_SPINSPIN", default_l_val=.false., &
1027 lone_keyword_l_val=.true.)
1028 CALL section_add_keyword(section, keyword)
1029 CALL keyword_release(keyword)
1030
1031 CALL keyword_create(keyword, __location__, name="ISSC_ON_ATOM_LIST", &
1032 description="Atoms for which the issc is computed.", &
1033 usage="ISSC_ON_ATOM_LIST 1 2 10", &
1034 n_var=-1, type_of_var=integer_t, repeats=.true.)
1035 CALL section_add_keyword(section, keyword)
1036 CALL keyword_release(keyword)
1037
1038 CALL keyword_create(keyword, __location__, name="DO_FC", &
1039 description="Compute the Fermi contact contribution", &
1040 usage="DO_FC F", &
1041 default_l_val=.true., lone_keyword_l_val=.true.)
1042 CALL section_add_keyword(section, keyword)
1043 CALL keyword_release(keyword)
1044
1045 CALL keyword_create(keyword, __location__, name="DO_SD", &
1046 description="Compute the spin-dipolar contribution", &
1047 usage="DO_SD F", &
1048 default_l_val=.true., lone_keyword_l_val=.true.)
1049 CALL section_add_keyword(section, keyword)
1050 CALL keyword_release(keyword)
1051
1052 CALL keyword_create(keyword, __location__, name="DO_PSO", &
1053 description="Compute the paramagnetic spin-orbit contribution", &
1054 usage="DO_PSO F", &
1055 default_l_val=.true., lone_keyword_l_val=.true.)
1056 CALL section_add_keyword(section, keyword)
1057 CALL keyword_release(keyword)
1058
1059 CALL keyword_create(keyword, __location__, name="DO_DSO", &
1060 description="Compute the diamagnetic spin-orbit contribution (NOT YET IMPLEMENTED)", &
1061 usage="DO_DSO F", &
1062 default_l_val=.true., lone_keyword_l_val=.true.)
1063 CALL section_add_keyword(section, keyword)
1064 CALL keyword_release(keyword)
1065
1066 NULLIFY (subsection)
1067 CALL section_create(subsection, __location__, name="PRINT", &
1068 description="print results of the indirect spin-spin calculation", &
1069 repeats=.false.)
1070
1071 CALL cp_print_key_section_create(print_key, __location__, "K_MATRIX", &
1072 description="Controls the printing of the indirect spin-spin matrix", &
1073 print_level=low_print_level, add_last=add_last_numeric, filename="")
1074
1075 CALL keyword_create(keyword, __location__, name="ATOMS_LIST", &
1076 description="list of atoms for which the indirect spin-spin is printed into a file ", &
1077 usage="ATOMS_LIST 1 2", n_var=-1, &
1078 type_of_var=integer_t, repeats=.true.)
1079 CALL section_add_keyword(print_key, keyword)
1080 CALL keyword_release(keyword)
1081
1082 CALL section_add_subsection(subsection, print_key)
1083 CALL section_release(print_key)
1084
1085 CALL section_add_subsection(section, subsection)
1086 CALL section_release(subsection)
1087
1088 NULLIFY (subsection)
1089 CALL create_interp_section(subsection)
1090 CALL section_add_subsection(section, subsection)
1091 CALL section_release(subsection)
1092
1093 END SUBROUTINE create_spin_spin_section
1094
1095! **************************************************************************************************
1096!> \brief creates the input structure used to activate
1097!> calculation of EPR using
1098!> the induced current obtained from DFPT
1099!> Available properties : none
1100!> \param section the section to create
1101!> \author VW
1102! **************************************************************************************************
1103 SUBROUTINE create_epr_section(section)
1104 TYPE(section_type), POINTER :: section
1105
1106 TYPE(keyword_type), POINTER :: keyword
1107 TYPE(section_type), POINTER :: print_key, subsection, subsubsection
1108
1109 NULLIFY (keyword, print_key, subsection, subsubsection)
1110
1111 cpassert(.NOT. ASSOCIATED(section))
1112 CALL section_create(section, __location__, name="EPR", &
1113 description="The g tensor is calculated by DFPT ", &
1114 n_keywords=5, n_subsections=1, repeats=.false., &
1115 citations=(/weber2009/))
1116
1117 CALL keyword_create(keyword, __location__, name="_SECTION_PARAMETERS_", &
1118 description="controls the activation of the epr calculation", &
1119 usage="&EPR T", &
1120 default_l_val=.false., &
1121 lone_keyword_l_val=.true.)
1122 CALL section_add_keyword(section, keyword)
1123 CALL keyword_release(keyword)
1124
1125 CALL keyword_create(keyword, __location__, name="RESTART_EPR", &
1126 description="Restart the EPR calculation from a previous run (NOT WORKING)", &
1127 usage="RESTART_EPR", default_l_val=.false., &
1128 lone_keyword_l_val=.true.)
1129 CALL section_add_keyword(section, keyword)
1130 CALL keyword_release(keyword)
1131
1132 NULLIFY (subsection)
1133 CALL section_create(subsection, __location__, name="PRINT", &
1134 description="print results of epr calculation", &
1135 repeats=.false.)
1136
1137 CALL cp_print_key_section_create(print_key, __location__, "NABLAVKS_CUBES", &
1138 description="Controls the printing of the components of nabla v_ks ", &
1139 print_level=high_print_level, add_last=add_last_numeric, filename="")
1140 CALL keyword_create(keyword, __location__, name="stride", &
1141 description="The stride (X,Y,Z) used to write the cube file "// &
1142 "(larger values result in smaller cube files). You can provide 3 numbers (for X,Y,Z) or"// &
1143 " 1 number valid for all components.", &
1144 usage="STRIDE 2 2 2", n_var=-1, default_i_vals=(/2, 2, 2/), type_of_var=integer_t)
1145 CALL section_add_keyword(print_key, keyword)
1146 CALL keyword_release(keyword)
1147 CALL keyword_create(keyword, __location__, name="APPEND", &
1148 description="append the cube files when they already exist", &
1149 default_l_val=.false., lone_keyword_l_val=.true.)
1150 CALL section_add_keyword(print_key, keyword)
1151 CALL keyword_release(keyword)
1152
1153 CALL section_add_subsection(subsection, print_key)
1154 CALL section_release(print_key)
1155
1156 CALL cp_print_key_section_create(print_key, __location__, "G_TENSOR", &
1157 description="Controls the printing of the g tensor", &
1158 print_level=high_print_level, add_last=add_last_numeric, filename="")
1159 CALL create_xc_section(subsubsection)
1160 CALL section_add_subsection(print_key, subsubsection)
1161 CALL section_release(subsubsection)
1162
1163 CALL keyword_create(keyword, __location__, name="GAPW_MAX_ALPHA", &
1164 description="Maximum alpha of GTH potentials allowed on the soft grids ", &
1165 usage="GAPW_MAX_ALPHA real", default_r_val=5.0_dp)
1166 CALL section_add_keyword(print_key, keyword)
1167 CALL keyword_release(keyword)
1168
1169 CALL keyword_create(keyword, __location__, name="SOO_RHO_HARD", &
1170 description="Whether or not to include the atomic parts of the density "// &
1171 "in the SOO part of the g tensor", usage="SOO_RHO_HARD", &
1172 default_l_val=.false., lone_keyword_l_val=.true.)
1173 CALL section_add_keyword(print_key, keyword)
1174 CALL keyword_release(keyword)
1175
1176 CALL section_add_subsection(subsection, print_key)
1177 CALL section_release(print_key)
1178
1179 CALL cp_print_key_section_create(print_key, __location__, "RESPONSE_FUNCTION_CUBES", &
1180 description="Controls the printing of the response functions ", &
1181 print_level=high_print_level, add_last=add_last_numeric, filename="")
1182 CALL keyword_create(keyword, __location__, name="stride", &
1183 description="The stride (X,Y,Z) used to write the cube file "// &
1184 "(larger values result in smaller cube files). You can provide 3 numbers (for X,Y,Z) or"// &
1185 " 1 number valid for all components.", &
1186 usage="STRIDE 2 2 2", n_var=-1, default_i_vals=(/2, 2, 2/), type_of_var=integer_t)
1187 CALL section_add_keyword(print_key, keyword)
1188 CALL keyword_release(keyword)
1189
1190 CALL keyword_create(keyword, __location__, name="CUBES_LU_BOUNDS", &
1191 variants=(/"CUBES_LU"/), &
1192 description="The lower and upper index of the states to be printed as cube", &
1193 usage="CUBES_LU_BOUNDS integer integer", &
1194 n_var=2, default_i_vals=(/0, -2/), type_of_var=integer_t)
1195 CALL section_add_keyword(print_key, keyword)
1196 CALL keyword_release(keyword)
1197
1198 CALL keyword_create(keyword, __location__, name="CUBES_LIST", &
1199 description="Indexes of the states to be printed as cube files "// &
1200 "This keyword can be repeated several times "// &
1201 "(useful if you have to specify many indexes).", &
1202 usage="CUBES_LIST 1 2", &
1203 n_var=-1, type_of_var=integer_t, repeats=.true.)
1204 CALL section_add_keyword(print_key, keyword)
1205 CALL keyword_release(keyword)
1206 CALL keyword_create(keyword, __location__, name="APPEND", &
1207 description="append the cube files when they already exist", &
1208 default_l_val=.false., lone_keyword_l_val=.true.)
1209 CALL section_add_keyword(print_key, keyword)
1210 CALL keyword_release(keyword)
1211
1212 CALL section_add_subsection(subsection, print_key)
1213 CALL section_release(print_key)
1214
1215 CALL section_add_subsection(section, subsection)
1216 CALL section_release(subsection)
1217
1218 NULLIFY (subsection)
1219 CALL create_interp_section(subsection)
1220 CALL section_add_subsection(section, subsection)
1221 CALL section_release(subsection)
1222
1223 END SUBROUTINE create_epr_section
1224
1225! **************************************************************************************************
1226!> \brief creates the input structure used to activate
1227!> calculation of polarizability tensor DFPT
1228!> Available properties : none
1229!> \param section the section to create
1230!> \author SL
1231! **************************************************************************************************
1232 SUBROUTINE create_polarizability_section(section)
1233
1234 TYPE(section_type), POINTER :: section
1235
1236 TYPE(keyword_type), POINTER :: keyword
1237 TYPE(section_type), POINTER :: print_key, subsection
1238
1239 NULLIFY (keyword, print_key, subsection)
1240
1241 cpassert(.NOT. ASSOCIATED(section))
1242 CALL section_create(section, __location__, name="POLAR", &
1243 description="Compute polarizabilities.", &
1244 n_keywords=5, n_subsections=1, repeats=.false., &
1245 citations=(/putrino2002/))
1246
1247 CALL keyword_create(keyword, __location__, name="_SECTION_PARAMETERS_", &
1248 description="controls the activation of the polarizability calculation", &
1249 usage="&POLAR T", &
1250 default_l_val=.false., &
1251 lone_keyword_l_val=.true.)
1252 CALL section_add_keyword(section, keyword)
1253 CALL keyword_release(keyword)
1254
1255 CALL keyword_create(keyword, __location__, name="DO_RAMAN", &
1256 description="Compute the electric-dipole--electric-dipole polarizability", &
1257 usage="DO_RAMAN F", &
1258 citations=(/luber2014/), &
1259 default_l_val=.true., lone_keyword_l_val=.true.)
1260 CALL section_add_keyword(section, keyword)
1261 CALL keyword_release(keyword)
1262
1263 CALL keyword_create(keyword, __location__, name="PERIODIC_DIPOLE_OPERATOR", &
1264 description="Type of dipole operator: Berry phase(T) or Local(F)", &
1265 usage="PERIODIC_DIPOLE_OPERATOR T", &
1266 default_l_val=.true., lone_keyword_l_val=.true.)
1267 CALL section_add_keyword(section, keyword)
1268 CALL keyword_release(keyword)
1269
1270 NULLIFY (subsection)
1271 CALL section_create(subsection, __location__, name="PRINT", &
1272 description="print results of the polarizability calculation", &
1273 repeats=.false.)
1274
1275 CALL cp_print_key_section_create(print_key, __location__, "POLAR_MATRIX", &
1276 description="Controls the printing of the polarizabilities", &
1277 print_level=low_print_level, add_last=add_last_numeric, filename="")
1278
1279 CALL section_add_subsection(subsection, print_key)
1280 CALL section_release(print_key)
1281 CALL section_add_subsection(section, subsection)
1282 CALL section_release(subsection)
1283
1284 NULLIFY (subsection)
1285 CALL create_interp_section(subsection)
1286 CALL section_add_subsection(section, subsection)
1287 CALL section_release(subsection)
1288
1289 END SUBROUTINE create_polarizability_section
1290
1291! **************************************************************************************************
1292!> \brief creates the section for electron transfer coupling
1293!> \param section ...
1294!> \author fschiff
1295! **************************************************************************************************
1296 SUBROUTINE create_et_coupling_section(section)
1297 TYPE(section_type), POINTER :: section
1298
1299 TYPE(keyword_type), POINTER :: keyword
1300 TYPE(section_type), POINTER :: print_key, subsection
1301
1302 NULLIFY (keyword)
1303 cpassert(.NOT. ASSOCIATED(section))
1304 CALL section_create(section, __location__, name="ET_COUPLING", &
1305 description="specifies the two constraints/restraints for extracting ET coupling elements", &
1306 n_keywords=1, n_subsections=4, repeats=.false., citations=(/kondov2007, futera2017/))
1307
1308 NULLIFY (subsection)
1309 CALL create_ddapc_restraint_section(subsection, "DDAPC_RESTRAINT_A")
1310 CALL section_add_subsection(section, subsection)
1311 CALL section_release(subsection)
1312
1313 NULLIFY (subsection)
1314 CALL create_ddapc_restraint_section(subsection, "DDAPC_RESTRAINT_B")
1315 CALL section_add_subsection(section, subsection)
1316 CALL section_release(subsection)
1317
1318 NULLIFY (subsection)
1319 CALL create_projection(subsection, "PROJECTION")
1320 CALL section_add_subsection(section, subsection)
1321 CALL section_release(subsection)
1322
1323 CALL keyword_create(keyword, __location__, name="TYPE_OF_CONSTRAINT", &
1324 description="Specifies the type of constraint", &
1325 usage="TYPE_OF_CONSTRAINT DDAPC", &
1326 enum_c_vals=s2a("NONE", "DDAPC"), &
1327 enum_i_vals=(/do_no_et, do_et_ddapc/), &
1328 enum_desc=s2a("NONE", "DDAPC Constraint"), &
1329 default_i_val=do_no_et)
1330 CALL section_add_keyword(section, keyword)
1331 CALL keyword_release(keyword)
1332
1333 NULLIFY (print_key)
1334 CALL cp_print_key_section_create(print_key, __location__, "PROGRAM_RUN_INFO", &
1335 description="Controls the printing basic info about the method", &
1336 print_level=low_print_level, add_last=add_last_numeric, filename="__STD_OUT__")
1337 CALL section_add_subsection(section, print_key)
1338 CALL section_release(print_key)
1339
1340 END SUBROUTINE create_et_coupling_section
1341
1342! **************************************************************************************************
1343!> \brief defines input sections for specification of Hilbert space partitioning
1344!> in projection-operator approach of electronic coupling calulation
1345!> \param section pointer to the section data structure
1346!> \param section_name name of the projection section
1347!> \author Z. Futera (02.2017)
1348! **************************************************************************************************
1349 SUBROUTINE create_projection(section, section_name)
1350
1351 ! Routine arguments
1352 TYPE(section_type), POINTER :: section
1353 CHARACTER(len=*), INTENT(in) :: section_name
1354
1355 TYPE(keyword_type), POINTER :: keyword
1356 TYPE(section_type), POINTER :: print_key, section_block, section_print
1357
1358! Routine name for dubug purposes
1359
1360 ! Sanity check
1361 cpassert(.NOT. ASSOCIATED(section))
1362
1363 ! Initialization
1364 NULLIFY (keyword)
1365 NULLIFY (print_key)
1366 NULLIFY (section_block)
1367 NULLIFY (section_print)
1368
1369 ! Input-file section definition
1370 CALL section_create(section, __location__, name=trim(adjustl(section_name)), &
1371 description="Projection-operator approach fo ET coupling calculation", &
1372 n_keywords=0, n_subsections=2, repeats=.false.)
1373
1374 ! Subsection #0: Log printing
1375 CALL cp_print_key_section_create(print_key, __location__, 'PROGRAM_RUN_INFO', &
1376 description="Controls printing of data and informations to log file", &
1377 print_level=low_print_level, filename="__STD_OUT__")
1378 CALL section_add_subsection(section, print_key)
1379 CALL section_release(print_key)
1380
1381 ! Subsection #1: Atomic blocks
1382 CALL section_create(section_block, __location__, name='BLOCK', &
1383 description="Part of the system (donor, acceptor, bridge,...)", &
1384 n_keywords=2, n_subsections=1, repeats=.true.)
1385 CALL section_add_subsection(section, section_block)
1386
1387 ! S#1 - Keyword #1: Atom IDs defining a Hilbert space block
1388 CALL keyword_create(keyword, __location__, name='ATOMS', &
1389 description="Array of atom IDs in the system part", &
1390 usage="ATOMS {integer} {integer} .. {integer}", &
1391 n_var=-1, type_of_var=integer_t, repeats=.false.)
1392 CALL section_add_keyword(section_block, keyword)
1393 CALL keyword_release(keyword)
1394
1395 ! S#1 - Keyword #1: Atom IDs defining a Hilbert space block
1396 CALL keyword_create(keyword, __location__, name='NELECTRON', &
1397 description="Number of electrons expected in the system part", &
1398 usage="NELECTRON {integer}", default_i_val=0)
1399 CALL section_add_keyword(section_block, keyword)
1400 CALL keyword_release(keyword)
1401
1402 ! S#1 - Subsection #1: Printing setting
1403 CALL section_create(section_print, __location__, name='PRINT', &
1404 description="Possible printing options in ET system part", &
1405 n_keywords=0, n_subsections=0, repeats=.false.)
1406 CALL section_add_subsection(section_block, section_print)
1407
1408 ! S#1 - S#1 - Keyword #1: MO coefficient on specific atom
1409 CALL keyword_create(keyword, __location__, name='MO_COEFF_ATOM', &
1410 description="Print out MO coeffiecients on given atom", &
1411 usage="MO_COEFF_ATOM {integer} {integer} .. {integer}", &
1412 type_of_var=integer_t, n_var=-1, repeats=.true.)
1413 CALL section_add_keyword(section_print, keyword)
1414 CALL keyword_release(keyword)
1415
1416 ! S#1 - S#1 - Keyword #1: MO coefficient of specific state
1417 CALL keyword_create(keyword, __location__, name='MO_COEFF_ATOM_STATE', &
1418 description="Print out MO coeffiecients of specific state", &
1419 usage="MO_COEFF_ATOM_STATE {integer} {integer} .. {integer}", &
1420 type_of_var=integer_t, n_var=-1, repeats=.true.)
1421 CALL section_add_keyword(section_print, keyword)
1422 CALL keyword_release(keyword)
1423
1424 ! S#1 - S#1 - Subsection #1: Saving MOs to CUBE files
1425 CALL cp_print_key_section_create(print_key, __location__, 'MO_CUBES', &
1426 description="Controls saving of MO cube files", &
1427 print_level=high_print_level, filename="")
1428
1429 ! S#1 - S#1 - S#1 - Keyword #1: Stride
1430 CALL keyword_create(keyword, __location__, name='STRIDE', &
1431 description="The stride (X,Y,Z) used to write the cube file", &
1432 usage="STRIDE {integer} {integer} {integer}", n_var=-1, &
1433 default_i_vals=(/2, 2, 2/), type_of_var=integer_t)
1434 CALL section_add_keyword(print_key, keyword)
1435 CALL keyword_release(keyword)
1436
1437 ! S#1 - S#1 - S#1 - Keyword #2: List of MO IDs
1438 CALL keyword_create(keyword, __location__, name='MO_LIST', &
1439 description="Indices of molecular orbitals to save", &
1440 usage="MO_LIST {integer} {integer} .. {integer}", &
1441 type_of_var=integer_t, n_var=-1, repeats=.true.)
1442 CALL section_add_keyword(print_key, keyword)
1443 CALL keyword_release(keyword)
1444
1445 ! S#1 - S#1 - S#1 - Keyword #2: Number of unoccupied states
1446 CALL keyword_create(keyword, __location__, name='NLUMO', &
1447 description="Number of unoccupied molecular orbitals to save", &
1448 usage="NLUMO {integer}", default_i_val=1)
1449 CALL section_add_keyword(print_key, keyword)
1450 CALL keyword_release(keyword)
1451
1452 ! S#1 - S#1 - S#1 - Keyword #3: Number of occupied states
1453 CALL keyword_create(keyword, __location__, name='NHOMO', &
1454 description="Number of occupied molecular orbitals to save", &
1455 usage="NHOMO {integer}", default_i_val=1)
1456 CALL section_add_keyword(print_key, keyword)
1457 CALL keyword_release(keyword)
1458
1459 CALL section_add_subsection(section_print, print_key)
1460 CALL section_release(print_key)
1461
1462 ! S#1 - S#1 - Clean
1463 CALL section_release(section_print)
1464
1465 ! S#1 - Clean
1466 CALL section_release(section_block)
1467
1468 ! S#1 - Subsection #1: Printing setting
1469 CALL section_create(section_print, __location__, name='PRINT', &
1470 description="Possible printing options in ET", &
1471 n_keywords=0, n_subsections=0, repeats=.false.)
1472 CALL section_add_subsection(section, section_print)
1473
1474 ! Print couplings
1475 CALL cp_print_key_section_create(print_key, __location__, 'COUPLINGS', &
1476 description="Controls printing couplings onto file", &
1477 print_level=low_print_level, filename="")
1478
1479 CALL keyword_create(keyword, __location__, name="APPEND", &
1480 description="append the files when they already exist", &
1481 default_l_val=.false., lone_keyword_l_val=.true.)
1482 CALL section_add_keyword(print_key, keyword)
1483 CALL keyword_release(keyword)
1484
1485 CALL section_add_subsection(section_print, print_key)
1486 CALL section_release(print_key)
1487
1488 CALL section_release(section_print)
1489
1490 END SUBROUTINE create_projection
1491
1492! **************************************************************************************************
1493!> \brief creates an input section for tddfpt calculation
1494!> \param section section to create
1495!> \par History
1496!> * 05.2016 forked from create_tddfpt_section [Sergey Chulkov]
1497!> * 08.2016 moved from module input_cp2k_dft [Sergey Chulkov]
1498! **************************************************************************************************
1499 SUBROUTINE create_tddfpt2_section(section)
1500 TYPE(section_type), POINTER :: section
1501
1502 TYPE(keyword_type), POINTER :: keyword
1503 TYPE(section_type), POINTER :: print_key, subsection
1504
1505 cpassert(.NOT. ASSOCIATED(section))
1506 CALL section_create(section, __location__, name="TDDFPT", &
1507 description="Parameters needed to set up the Time-Dependent "// &
1508 "Density Functional Perturbation Theory. "// &
1509 "Current implementation works for hybrid functionals. "// &
1510 "Can be used with Gaussian and Plane Waves (GPW) method only.", &
1511 n_keywords=12, n_subsections=4, repeats=.false., &
1512 citations=(/iannuzzi2005/))
1513
1514 NULLIFY (keyword, print_key, subsection)
1515
1516 CALL keyword_create(keyword, __location__, &
1517 name="_SECTION_PARAMETERS_", &
1518 description="Controls the activation of the TDDFPT procedure", &
1519 default_l_val=.false., &
1520 lone_keyword_l_val=.true.)
1521 CALL section_add_keyword(section, keyword)
1522 CALL keyword_release(keyword)
1523
1524 ! Integer
1525 CALL keyword_create(keyword, __location__, name="NSTATES", &
1526 description="Number of excited states to converge.", &
1527 n_var=1, type_of_var=integer_t, &
1528 default_i_val=1)
1529 CALL section_add_keyword(section, keyword)
1530 CALL keyword_release(keyword)
1531
1532 CALL keyword_create(keyword, __location__, name="MAX_ITER", &
1533 description="Maximal number of iterations to be performed.", &
1534 n_var=1, type_of_var=integer_t, &
1535 default_i_val=50)
1536 CALL section_add_keyword(section, keyword)
1537 CALL keyword_release(keyword)
1538
1539 CALL keyword_create(keyword, __location__, name="MAX_KV", &
1540 description="Maximal number of Krylov space vectors. "// &
1541 "Davidson iterations will be restarted upon reaching this limit.", &
1542 n_var=1, type_of_var=integer_t, &
1543 default_i_val=5000)
1544 CALL section_add_keyword(section, keyword)
1545 CALL keyword_release(keyword)
1546
1547 CALL keyword_create(keyword, __location__, name="NLUMO", &
1548 description="Number of unoccupied orbitals to consider. "// &
1549 "Default is to use all unoccupied orbitals (-1).", &
1550 n_var=1, type_of_var=integer_t, &
1551 default_i_val=-1)
1552 CALL section_add_keyword(section, keyword)
1553 CALL keyword_release(keyword)
1554
1555 CALL keyword_create(keyword, __location__, name="NPROC_STATE", &
1556 description="Number of MPI processes to be used per excited state. "// &
1557 "Default is to use all processors (0).", &
1558 n_var=1, type_of_var=integer_t, &
1559 default_i_val=0)
1560 CALL section_add_keyword(section, keyword)
1561 CALL keyword_release(keyword)
1562
1563 ! kernel type
1564 CALL keyword_create(keyword, __location__, name="KERNEL", &
1565 description="Options to compute the kernel", &
1566 usage="KERNEL FULL", &
1567 enum_c_vals=s2a("FULL", "sTDA", "NONE"), &
1569 default_i_val=tddfpt_kernel_full)
1570 CALL section_add_keyword(section, keyword)
1571 CALL keyword_release(keyword)
1572
1573 CALL keyword_create(keyword, __location__, name="OE_CORR", &
1574 description="Orbital energy correction potential.", &
1575 enum_c_vals=s2a("NONE", "LB94", "GLLB", "SAOP", "SHIFT"), &
1576 enum_i_vals=(/oe_none, oe_lb, oe_gllb, oe_saop, oe_shift/), &
1577 enum_desc=s2a("No orbital correction scheme is used", &
1578 "van Leeuwen and Baerends. PRA, 49:2421, 1994", &
1579 "Gritsenko, van Leeuwen, van Lenthe, Baerends. PRA, 51:1944, 1995", &
1580 "Gritsenko, Schipper, Baerends. Chem. Phys. Lett., 302:199, 1999", &
1581 "Constant shift of virtual and/or open-shell orbitals"), &
1582 default_i_val=oe_none)
1583 CALL section_add_keyword(section, keyword)
1584 CALL keyword_release(keyword)
1585
1586 ! SHIFTS
1587 CALL keyword_create(keyword, __location__, name="EV_SHIFT", &
1588 variants=s2a("VIRTUAL_SHIFT"), &
1589 description="Constant shift of virtual state eigenvalues.", &
1590 usage="EV_SHIFT 0.500", &
1591 n_var=1, type_of_var=real_t, &
1592 unit_str="eV", &
1593 default_r_val=0.0_dp)
1594 CALL section_add_keyword(section, keyword)
1595 CALL keyword_release(keyword)
1596 !
1597 CALL keyword_create(keyword, __location__, name="EOS_SHIFT", &
1598 variants=s2a("OPEN_SHELL_SHIFT"), &
1599 description="Constant shift of open shell eigenvalues.", &
1600 usage="EOS_SHIFT 0.200", &
1601 n_var=1, type_of_var=real_t, &
1602 unit_str="eV", &
1603 default_r_val=0.0_dp)
1604 CALL section_add_keyword(section, keyword)
1605 CALL keyword_release(keyword)
1606
1607 ! Real
1608 CALL keyword_create(keyword, __location__, name="CONVERGENCE", &
1609 description="Target accuracy for excited state energies.", &
1610 n_var=1, type_of_var=real_t, unit_str="hartree", &
1611 default_r_val=1.0e-5_dp)
1612 CALL section_add_keyword(section, keyword)
1613 CALL keyword_release(keyword)
1614
1615 CALL keyword_create(keyword, __location__, name="MIN_AMPLITUDE", &
1616 description="The smallest excitation amplitude to print.", &
1617 n_var=1, type_of_var=real_t, &
1618 default_r_val=5.0e-2_dp)
1619 CALL section_add_keyword(section, keyword)
1620 CALL keyword_release(keyword)
1621
1622 CALL keyword_create(keyword, __location__, name="ORTHOGONAL_EPS", &
1623 description="The largest possible overlap between the ground state and "// &
1624 "orthogonalised excited state wave-functions. Davidson iterations "// &
1625 "will be restarted when the overlap goes beyond this threshold in "// &
1626 "order to prevent numerical instability.", &
1627 n_var=1, type_of_var=real_t, &
1628 default_r_val=1.0e-4_dp)
1629 CALL section_add_keyword(section, keyword)
1630 CALL keyword_release(keyword)
1631
1632 ! Logical
1633 CALL keyword_create(keyword, __location__, name="RESTART", &
1634 description="Restart the TDDFPT calculation if a restart file exists", &
1635 n_var=1, type_of_var=logical_t, &
1636 default_l_val=.false., lone_keyword_l_val=.true.)
1637 CALL section_add_keyword(section, keyword)
1638 CALL keyword_release(keyword)
1639
1640 CALL keyword_create(keyword, __location__, name="RKS_TRIPLETS", &
1641 description="Compute triplet excited states using spin-unpolarised molecular orbitals.", &
1642 n_var=1, type_of_var=logical_t, &
1643 default_l_val=.false.)
1644 CALL section_add_keyword(section, keyword)
1645 CALL keyword_release(keyword)
1646
1647 CALL keyword_create(keyword, __location__, name="ADMM_KERNEL_XC_CORRECTION", &
1648 description="Use/Ignore ADMM correction xc functional for TD kernel. "// &
1649 "XC correction functional is defined in ground state XC section.", &
1650 n_var=1, type_of_var=logical_t, &
1651 default_l_val=.true., lone_keyword_l_val=.true.)
1652 CALL section_add_keyword(section, keyword)
1653 CALL keyword_release(keyword)
1654
1655 CALL keyword_create(keyword, __location__, name="ADMM_KERNEL_CORRECTION_SYMMETRIC", &
1656 description="ADMM correction functional in kernel is applied symmetrically. "// &
1657 "Original implementation is using a non-symmetric formula.", &
1658 n_var=1, type_of_var=logical_t, &
1659 default_l_val=.true., lone_keyword_l_val=.true.)
1660 CALL section_add_keyword(section, keyword)
1661 CALL keyword_release(keyword)
1662
1663 CALL keyword_create(keyword, __location__, name="DO_LRIGPW", &
1664 description="Local resolution of identity for Coulomb contribution.", &
1665 n_var=1, type_of_var=logical_t, &
1666 default_l_val=.false.)
1667 CALL section_add_keyword(section, keyword)
1668 CALL keyword_release(keyword)
1669
1670 CALL keyword_create(keyword, __location__, name="AUTO_BASIS", &
1671 description="Specify size of automatically generated auxiliary basis sets: "// &
1672 "Options={small,medium,large,huge}", &
1673 usage="AUTO_BASIS {basis_type} {basis_size}", &
1674 type_of_var=char_t, repeats=.true., n_var=-1, default_c_vals=(/"X", "X"/))
1675 CALL section_add_keyword(section, keyword)
1676 CALL keyword_release(keyword)
1677
1678 CALL keyword_create(keyword, __location__, name="DO_SMEARING", &
1679 description="Implying smeared occupation. ", &
1680 n_var=1, type_of_var=logical_t, &
1681 default_l_val=.false., lone_keyword_l_val=.true.)
1682 CALL section_add_keyword(section, keyword)
1683 CALL keyword_release(keyword)
1684
1685 CALL keyword_create(keyword, __location__, name="EXCITON_DESCRIPTORS", &
1686 description="Compute exciton descriptors. "// &
1687 "Details given in Manual section about Bethe Salpeter equation.", &
1688 n_var=1, type_of_var=logical_t, &
1689 default_l_val=.false.)
1690 CALL section_add_keyword(section, keyword)
1691 CALL keyword_release(keyword)
1692
1693 CALL keyword_create(keyword, __location__, name="DIRECTIONAL_EXCITON_DESCRIPTORS", &
1694 description="Print cartesian components of exciton descriptors.", &
1695 n_var=1, type_of_var=logical_t, &
1696 default_l_val=.false.)
1697 CALL section_add_keyword(section, keyword)
1698 CALL keyword_release(keyword)
1699
1700 ! Strings
1701 CALL keyword_create(keyword, __location__, name="WFN_RESTART_FILE_NAME", &
1702 variants=(/"RESTART_FILE_NAME"/), &
1703 description="Name of the wave function restart file, may include a path."// &
1704 " If no file is specified, the default is to open the file as generated by"// &
1705 " the wave function restart print key.", &
1706 usage="WFN_RESTART_FILE_NAME <FILENAME>", &
1707 type_of_var=lchar_t)
1708 CALL section_add_keyword(section, keyword)
1709 CALL keyword_release(keyword)
1710
1711 ! DIPOLE subsection
1712 CALL section_create(subsection, __location__, name="DIPOLE_MOMENTS", &
1713 description="Parameters to compute oscillator strengths in the dipole approximation.", &
1714 n_keywords=3, n_subsections=0, repeats=.false.)
1715
1716 CALL keyword_create(keyword, __location__, name="DIPOLE_FORM", &
1717 description="Form of dipole transition integrals.", &
1718 enum_c_vals=s2a("BERRY", "LENGTH", "VELOCITY"), &
1719 enum_desc=s2a("Based on Berry phase formula (valid for fully periodic molecular systems only)", &
1720 "Length form &lang; i | r | j &rang; (valid for non-periodic molecular systems only)", &
1721 "Velocity form &lang; i | d/dr | j &rang;"), &
1723 default_i_val=tddfpt_dipole_velocity)
1724 CALL section_add_keyword(subsection, keyword)
1725 CALL keyword_release(keyword)
1726
1727 CALL keyword_create(keyword, __location__, name="REFERENCE", &
1728 description="Reference point to calculate electric "// &
1729 "dipole moments using the dipole integrals in the length form.", &
1730 enum_c_vals=s2a("COM", "COAC", "USER_DEFINED", "ZERO"), &
1731 enum_desc=s2a("Use Center of Mass", &
1732 "Use Center of Atomic Charges", &
1733 "Use User-defined Point", &
1734 "Use Origin of Coordinate System"), &
1735 enum_i_vals=(/use_mom_ref_com, &
1738 use_mom_ref_zero/), &
1739 default_i_val=use_mom_ref_com)
1740 CALL section_add_keyword(subsection, keyword)
1741 CALL keyword_release(keyword)
1742
1743 CALL keyword_create(keyword, __location__, name="REFERENCE_POINT", &
1744 description="User-defined reference point.", &
1745 usage="REFERENCE_POINT x y z", &
1746 repeats=.false., n_var=3, type_of_var=real_t, unit_str='bohr')
1747 CALL section_add_keyword(subsection, keyword)
1748 CALL keyword_release(keyword)
1749
1750 CALL section_add_subsection(section, subsection)
1751 CALL section_release(subsection)
1752
1753 ! SOC functional
1754
1755 CALL section_create(subsection, __location__, name="SOC", &
1756 description="Is jet to be implemented", &
1757 n_keywords=2, n_subsections=0, repeats=.false.)
1758
1759 CALL keyword_create(keyword, __location__, name="EPS_FILTER", &
1760 variants=s2a("EPS_FILTER_MATRIX"), &
1761 description="The threshold used for sparse matrix operations", &
1762 usage="EPS_FILTER {real}", &
1763 type_of_var=real_t, &
1764 default_r_val=1.0e-10_dp)
1765 CALL section_add_keyword(subsection, keyword)
1766 CALL keyword_release(keyword)
1767
1768 CALL keyword_create(keyword, __location__, name="GRID", &
1769 variants=(/"ATOMIC_GRID"/), &
1770 description="Specification of the atomic angular and radial grids for "// &
1771 "a atomic kind. This keyword must be repeated for all kinds! "// &
1772 "Usage: GRID < LEBEDEV_GRID > < RADIAL_GRID >", &
1773 usage="GRID {string} {integer} {integer}", &
1774 n_var=3, type_of_var=char_t, repeats=.true.)
1775 CALL section_add_keyword(subsection, keyword)
1776 CALL keyword_release(keyword)
1777
1778 CALL section_add_subsection(section, subsection)
1779 CALL section_release(subsection)
1780
1781 ! kernel XC functional
1782 CALL create_xc_section(subsection)
1783 CALL section_add_subsection(section, subsection)
1784 CALL section_release(subsection)
1785
1786 ! MGRID subsection
1787 CALL create_mgrid_section(subsection, create_subsections=.false.)
1788 CALL section_add_subsection(section, subsection)
1789 CALL section_release(subsection)
1790
1791 ! sTDA subsection
1792 CALL create_stda_section(subsection)
1793 CALL section_add_subsection(section, subsection)
1794 CALL section_release(subsection)
1795
1796 ! LRI subsection
1797 CALL create_lrigpw_section(subsection)
1798 CALL section_add_subsection(section, subsection)
1799 CALL section_release(subsection)
1800
1801 ! LINRES section
1802 CALL create_linres_section(subsection, create_subsections=.false., default_set_tdlr=.true.)
1803 CALL section_add_subsection(section, subsection)
1804 CALL section_release(subsection)
1805
1806 ! PRINT subsection
1807 CALL section_create(subsection, __location__, name="PRINT", &
1808 description="Printing of information during the TDDFT run.", repeats=.false.)
1809
1810 CALL cp_print_key_section_create(print_key, __location__, name="PROGRAM_BANNER", &
1811 description="Controls the printing of the banner for TDDFPT program", &
1812 print_level=silent_print_level, filename="__STD_OUT__")
1813 CALL section_add_subsection(subsection, print_key)
1814 CALL section_release(print_key)
1815
1816 CALL cp_print_key_section_create(print_key, __location__, name="GUESS_VECTORS", &
1817 description="Controls the printing of initial guess vectors.", &
1818 print_level=low_print_level, filename="__STD_OUT__")
1819 CALL section_add_subsection(subsection, print_key)
1820 CALL section_release(print_key)
1821
1822 CALL cp_print_key_section_create(print_key, __location__, name="ITERATION_INFO", &
1823 description="Controls the printing of basic iteration information "// &
1824 "during the TDDFT run.", &
1825 print_level=low_print_level, add_last=add_last_numeric, filename="__STD_OUT__")
1826 CALL section_add_subsection(subsection, print_key)
1827 CALL section_release(print_key)
1828
1829 CALL cp_print_key_section_create(print_key, __location__, name="DETAILED_ENERGY", &
1830 description="Controls the printing of detailed energy information "// &
1831 "during the TDDFT run.", &
1832 print_level=medium_print_level, add_last=add_last_numeric, filename="__STD_OUT__")
1833 CALL section_add_subsection(subsection, print_key)
1834 CALL section_release(print_key)
1835
1836 CALL cp_print_key_section_create(print_key, __location__, name="BASIS_SET_FILE", &
1837 description="Controls the printing of a file with all basis sets used.", &
1838 print_level=debug_print_level, filename="BASIS_SETS")
1839 CALL section_add_subsection(subsection, print_key)
1840 CALL section_release(print_key)
1841
1842 CALL cp_print_key_section_create(print_key, __location__, name="RESTART", &
1843 description="Controls the dumping of the MO restart file during TDDFPT. "// &
1844 "By default keeps a short history of three restarts.", &
1845 print_level=low_print_level, common_iter_levels=3, &
1846 each_iter_names=s2a("TDDFT_SCF"), each_iter_values=(/10/), &
1847 add_last=add_last_numeric, filename="RESTART")
1848 CALL keyword_create(keyword, __location__, name="BACKUP_COPIES", &
1849 description="Specifies the maximum number of backup copies.", &
1850 usage="BACKUP_COPIES {int}", &
1851 default_i_val=1)
1852 CALL section_add_keyword(print_key, keyword)
1853 CALL keyword_release(keyword)
1854 CALL section_add_subsection(subsection, print_key)
1855 CALL section_release(print_key)
1856
1857 CALL cp_print_key_section_create(print_key, __location__, name="NTO_ANALYSIS", &
1858 description="Perform a natural transition orbital analysis.", &
1859 print_level=medium_print_level)
1860 CALL keyword_create(keyword, __location__, name="THRESHOLD", &
1861 description="Threshold for sum of NTO eigenvalues considered", &
1862 usage="Threshold 0.95", &
1863 n_var=1, &
1864 type_of_var=real_t, &
1865 default_r_val=0.975_dp)
1866 CALL section_add_keyword(print_key, keyword)
1867 CALL keyword_release(keyword)
1868 CALL keyword_create(keyword, __location__, name="INTENSITY_THRESHOLD", &
1869 description="Threshold for oscillator strength to screen states.", &
1870 usage="Intensity_threshold 0.01", &
1871 n_var=1, &
1872 type_of_var=real_t, &
1873 default_r_val=0.0_dp)
1874 CALL section_add_keyword(print_key, keyword)
1875 CALL keyword_release(keyword)
1876 CALL keyword_create(keyword, __location__, name="STATE_LIST", &
1877 description="Specifies a list of states for the NTO calculations.", &
1878 usage="STATE_LIST {integer} {integer} .. {integer}", &
1879 n_var=-1, type_of_var=integer_t)
1880 CALL section_add_keyword(print_key, keyword)
1881 CALL keyword_release(keyword)
1882 CALL keyword_create(keyword, __location__, name="CUBE_FILES", &
1883 description="Print NTOs on Cube Files", &
1884 usage="CUBE_FILES {logical}", repeats=.false., n_var=1, &
1885 default_l_val=.false., lone_keyword_l_val=.true., type_of_var=logical_t)
1886 CALL section_add_keyword(print_key, keyword)
1887 CALL keyword_release(keyword)
1888 CALL keyword_create(keyword, __location__, name="STRIDE", &
1889 description="The stride (X,Y,Z) used to write the cube file "// &
1890 "(larger values result in smaller cube files). Provide 3 numbers (for X,Y,Z) or"// &
1891 " 1 number valid for all components.", &
1892 usage="STRIDE 2 2 2", n_var=-1, default_i_vals=(/2, 2, 2/), type_of_var=integer_t)
1893 CALL section_add_keyword(print_key, keyword)
1894 CALL keyword_release(keyword)
1895 CALL keyword_create(keyword, __location__, name="APPEND", &
1896 description="append the cube files when they already exist", &
1897 default_l_val=.false., lone_keyword_l_val=.true.)
1898 CALL section_add_keyword(print_key, keyword)
1899 CALL keyword_release(keyword)
1900 CALL section_add_subsection(subsection, print_key)
1901 CALL section_release(print_key)
1902
1903 CALL cp_print_key_section_create(print_key, __location__, "MOS_MOLDEN", &
1904 description="Write the NTO in Molden file format, for visualisation.", &
1905 print_level=debug_print_level + 1, add_last=add_last_numeric, filename="MOS")
1906 CALL keyword_create(keyword, __location__, name="NDIGITS", &
1907 description="Specifies the number of significant digits retained. 3 is OK for visualization.", &
1908 usage="NDIGITS {int}", &
1909 default_i_val=3)
1910 CALL section_add_keyword(print_key, keyword)
1911 CALL keyword_release(keyword)
1912 CALL keyword_create(keyword, __location__, name="GTO_KIND", &
1913 description="Representation of Gaussian-type orbitals", &
1914 default_i_val=gto_spherical, &
1915 enum_c_vals=s2a("CARTESIAN", "SPHERICAL"), &
1916 enum_desc=s2a( &
1917 "Cartesian Gaussian orbitals. Use with caution", &
1918 "Spherical Gaussian orbitals. Incompatible with VMD"), &
1919 enum_i_vals=(/gto_cartesian, gto_spherical/))
1920 CALL section_add_keyword(print_key, keyword)
1921 CALL keyword_release(keyword)
1922 CALL section_add_subsection(subsection, print_key)
1923 CALL section_release(print_key)
1924
1925 CALL cp_print_key_section_create(print_key, __location__, name="NAMD_PRINT", &
1926 description="Controls the printout required for NAMD with NEWTONX.", &
1927 print_level=debug_print_level + 1, filename="CP2K_NEWTONX")
1928 CALL keyword_create(keyword, __location__, name="PRINT_VIRTUALS", &
1929 description="Print occupied AND virtual molecular orbital coefficients", &
1930 default_l_val=.false., lone_keyword_l_val=.true.)
1931 CALL section_add_keyword(print_key, keyword)
1932 CALL keyword_release(keyword)
1933 CALL keyword_create(keyword, __location__, name="PRINT_PHASES", &
1934 description="Print phases of occupied and virtuals MOs.", &
1935 default_l_val=.false., lone_keyword_l_val=.true.)
1936 CALL section_add_keyword(print_key, keyword)
1937 CALL keyword_release(keyword)
1938 CALL keyword_create(keyword, __location__, name="SCALE_WITH_PHASES", &
1939 description="Scale ES eigenvectors with phases of occupied and virtuals MOs.", &
1940 default_l_val=.false., lone_keyword_l_val=.true.)
1941 CALL section_add_keyword(print_key, keyword)
1942 CALL keyword_release(keyword)
1943 CALL section_add_subsection(subsection, print_key)
1944 CALL section_release(print_key)
1945
1946 !! SOC PRINT SECTION
1947 CALL cp_print_key_section_create(print_key, __location__, name="SOC_PRINT", &
1948 description="Controls the printout of the tddfpt2_soc modul", &
1949 print_level=debug_print_level + 1, filename="SOC")
1950 CALL keyword_create(keyword, __location__, name="UNIT_eV", &
1951 description="Will detrement if output in eVolt will be printef.", &
1952 default_l_val=.true., lone_keyword_l_val=.true.)
1953 CALL section_add_keyword(print_key, keyword)
1954 CALL keyword_release(keyword)
1955 CALL keyword_create(keyword, __location__, name="UNIT_wn", &
1956 description="Will detrement if output in wavenumbers will be printed.", &
1957 default_l_val=.false., lone_keyword_l_val=.true.)
1958 CALL section_add_keyword(print_key, keyword)
1959 CALL keyword_release(keyword)
1960 CALL keyword_create(keyword, __location__, name="SPLITTING", &
1961 description="Will add the SOC-Splitting as additional output", &
1962 default_l_val=.false., lone_keyword_l_val=.true.)
1963 CALL section_add_keyword(print_key, keyword)
1964 CALL keyword_release(keyword)
1965 CALL keyword_create(keyword, __location__, name="SOME", &
1966 description="Will add the SOC-Matrix as additional output in a different file", &
1967 default_l_val=.false., lone_keyword_l_val=.true.)
1968 CALL section_add_keyword(print_key, keyword)
1969 CALL keyword_release(keyword)
1970 CALL section_add_subsection(subsection, print_key)
1971 CALL section_release(print_key)
1972
1973 CALL cp_print_key_section_create(print_key, __location__, name="FORCES", &
1974 description="Controls the calculation and printing of excited state forces. "// &
1975 "This needs a RUN_TYPE that includes force evaluation, e.g. ENERGY_FORCE", &
1976 print_level=debug_print_level, filename="TDFORCE")
1977 CALL keyword_create(keyword, __location__, name="LIST", &
1978 description="Specifies a list of states for the force calculations.", &
1979 usage="LIST {integer} {integer} .. {integer}", repeats=.true., &
1980 n_var=-1, type_of_var=integer_t)
1981 CALL section_add_keyword(print_key, keyword)
1982 CALL keyword_release(keyword)
1983 CALL keyword_create(keyword, __location__, name="THRESHOLD", &
1984 description="Threshold for oszillator strength to screen states.", &
1985 usage="Threshold 0.01", &
1986 n_var=1, &
1987 type_of_var=real_t, &
1988 default_r_val=0.0_dp)
1989 CALL section_add_keyword(print_key, keyword)
1990 CALL keyword_release(keyword)
1991 CALL section_add_subsection(subsection, print_key)
1992 CALL section_release(print_key)
1993
1994 CALL section_add_subsection(section, subsection)
1995 CALL section_release(subsection)
1996
1997 END SUBROUTINE create_tddfpt2_section
1998
1999! **************************************************************************************************
2000!> \brief creates the stda input section (simplified Tamm Dancoff Approximation)
2001!> \param section the section to create
2002! **************************************************************************************************
2003 SUBROUTINE create_stda_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="sTDA", &
2010 description="parameters needed and setup for sTDA calculations", &
2011 n_keywords=3, n_subsections=0, repeats=.false.)
2012 NULLIFY (keyword)
2013
2014 CALL keyword_create(keyword, __location__, name="FRACTION", &
2015 variants=(/"HFX_FRACTION"/), &
2016 description="The fraction of TB Hartree-Fock exchange to use in the Kernel. "// &
2017 "0.0 implies no HFX part is used in the kernel. ", &
2018 usage="FRACTION 0.0", default_r_val=0.0_dp)
2019 CALL section_add_keyword(section, keyword)
2020 CALL keyword_release(keyword)
2021
2022 ! even if scaling parameter for exchange FRACTION (see above) is zero, the semi-empirical electron repulsion
2023 ! operator for exchange is not, so that a keyword is required to switch off sTDA exchange (if wanted)
2024 CALL keyword_create(keyword, __location__, name="DO_EXCHANGE", &
2025 description="Explicitly including or switching off sTDA exchange", &
2026 usage="DO_EXCHANGE", default_l_val=.true., lone_keyword_l_val=.true.)
2027 CALL section_add_keyword(section, keyword)
2028 CALL keyword_release(keyword)
2029
2030 CALL keyword_create(keyword, __location__, name="DO_EWALD", &
2031 description="Use Ewald type method for Coulomb interaction", &
2032 usage="DO_EWALD", default_l_val=.false., lone_keyword_l_val=.true.)
2033 CALL section_add_keyword(section, keyword)
2034 CALL keyword_release(keyword)
2035
2036 CALL keyword_create(keyword, __location__, name="EPS_TD_FILTER", &
2037 description="Threshold for filtering the transition density matrix", &
2038 usage="EPS_TD_FILTER epsf", default_r_val=1.e-10_dp)
2039 CALL section_add_keyword(section, keyword)
2040 CALL keyword_release(keyword)
2041
2042 CALL keyword_create(keyword, __location__, name="MATAGA_NISHIMOTO_CEXP", &
2043 description="Exponent used in Mataga-Nishimoto formula for Coulomb (alpha). "// &
2044 "Default value is method dependent!", &
2045 usage="MATAGA_NISHIMOTO_CEXP cexp", default_r_val=-99.0_dp)
2046 CALL section_add_keyword(section, keyword)
2047 CALL keyword_release(keyword)
2048
2049 CALL keyword_create(keyword, __location__, name="MATAGA_NISHIMOTO_XEXP", &
2050 description="Exponent used in Mataga-Nishimoto formula for Exchange (beta). "// &
2051 "Default value is method dependent!", &
2052 usage="MATAGA_NISHIMOTO_XEXP xexp", default_r_val=-99.0_dp)
2053 CALL section_add_keyword(section, keyword)
2054 CALL keyword_release(keyword)
2055
2056 CALL keyword_create(keyword, __location__, name="COULOMB_SR_CUT", &
2057 description="Maximum range of short range part of Coulomb interaction.", &
2058 usage="COULOMB_SR_CUT rcut", default_r_val=20.0_dp)
2059 CALL section_add_keyword(section, keyword)
2060 CALL keyword_release(keyword)
2061
2062 CALL keyword_create(keyword, __location__, name="COULOMB_SR_EPS", &
2063 description="Threshold for short range part of Coulomb interaction.", &
2064 usage="COULOMB_SR_EPS sreps", default_r_val=1.e-03_dp)
2065 CALL section_add_keyword(section, keyword)
2066 CALL keyword_release(keyword)
2067
2068 END SUBROUTINE create_stda_section
2069
2070! **************************************************************************************************
2071!> \brief creates an input section for electronic band structure calculations
2072!> \param section section to create
2073!> \par History
2074!> * 07.2023 created [Jan Wilhelm]
2075! **************************************************************************************************
2076 SUBROUTINE create_bandstructure_section(section)
2077 TYPE(section_type), POINTER :: section
2078
2079 TYPE(keyword_type), POINTER :: keyword
2080 TYPE(section_type), POINTER :: subsection
2081
2082 cpassert(.NOT. ASSOCIATED(section))
2083 CALL section_create(section, __location__, name="BANDSTRUCTURE", &
2084 description="Parameters needed to set up a calculation for "// &
2085 "electronic level energies of molecules and the electronic band "// &
2086 "structure of materials from post-SCF schemes (GW, perturbative "// &
2087 "spin-orbit coupling). Also, the density of states (DOS), "// &
2088 "projected density of states (PDOS), local density of states (LDOS), "// &
2089 "local valence band maximum (LVBM), local conduction band minimum "// &
2090 "(LCBM) and local band gap can be calculated. Please note that "// &
2091 "all methods in this section start from a Gamma-only DFT SCF. "// &
2092 "You need to make sure that the cell chosen in the DFT SCF is "// &
2093 "converged in the cell size. Band structures are computed "// &
2094 "for the primitive cell (i.e. the smallest possible unit cell of "// &
2095 "the input structure which is detected automatically). Moreover, "// &
2096 "spin-orbit coupling (SOC) on eigenvalues and band structures is "// &
2097 "available using Hartwigsen-Goedecker-Hutter "// &
2098 "pseudopotentials.", &
2099 n_keywords=1, n_subsections=1, repeats=.false.)
2100
2101 NULLIFY (keyword, subsection)
2102 CALL keyword_create(keyword, __location__, &
2103 name="_SECTION_PARAMETERS_", &
2104 description="Controls the activation of the band structure calculation.", &
2105 default_l_val=.false., &
2106 lone_keyword_l_val=.true.)
2107 CALL section_add_keyword(section, keyword)
2108 CALL keyword_release(keyword)
2109
2110 ! here we generate a subsection for getting a k-point path for the bandstructure
2111 CALL create_kpoint_set_section(subsection, "BANDSTRUCTURE_PATH")
2112 CALL section_add_subsection(section, subsection)
2113 CALL section_release(subsection)
2114
2115 CALL create_gw_section(subsection)
2116 CALL section_add_subsection(section, subsection)
2117 CALL section_release(subsection)
2118
2119 CALL create_soc_section(subsection)
2120 CALL section_add_subsection(section, subsection)
2121 CALL section_release(subsection)
2122
2123 CALL create_dos_section(subsection)
2124 CALL section_add_subsection(section, subsection)
2125 CALL section_release(subsection)
2126
2127 END SUBROUTINE create_bandstructure_section
2128
2129! **************************************************************************************************
2130!> \brief creates an input section for a GW calculation for the electronic band structure
2131!> \param section section to create
2132!> \par History
2133!> * 07.2023 created [Jan Wilhelm]
2134! **************************************************************************************************
2135 SUBROUTINE create_gw_section(section)
2136 TYPE(section_type), POINTER :: section
2137
2138 TYPE(keyword_type), POINTER :: keyword
2139 TYPE(section_type), POINTER :: print_key, subsection
2140
2141 cpassert(.NOT. ASSOCIATED(section))
2142 CALL section_create(section, __location__, name="GW", &
2143 description="Parameters needed to set up a GW calculation for "// &
2144 "electronic level energies $\varepsilon_{n\mathbf{k}}^{G_0W_0}$ "// &
2145 "of molecules and the band structure of materials: "// &
2146 "$\varepsilon_{n\mathbf{k}}^{G_0W_0}= "// &
2147 "\varepsilon_{n\mathbf{k}}^\text{DFT}+\Sigma_{n\mathbf{k}} "// &
2148 "-v^\text{xc}_{n\mathbf{k}}$. "// &
2149 "For the GW algorithm for molecules, see "// &
2150 "<https://doi.org/10.1021/acs.jctc.0c01282>. "// &
2151 "For 2D materials, see <https://doi.org/10.1021/acs.jctc.3c01230>.", &
2152 n_keywords=1, n_subsections=1, repeats=.false.)
2153
2154 NULLIFY (keyword)
2155 CALL keyword_create(keyword, __location__, &
2156 name="_SECTION_PARAMETERS_", &
2157 description="Controls the activation of the GW calculation.", &
2158 default_l_val=.false., &
2159 lone_keyword_l_val=.true.)
2160 CALL section_add_keyword(section, keyword)
2161 CALL keyword_release(keyword)
2162
2163 CALL keyword_create(keyword, __location__, name="NUM_TIME_FREQ_POINTS", &
2164 description="Number of discrete points for the imaginary-time "// &
2165 "grid and the imaginary-frequency grid. The more points, the more "// &
2166 "precise is the calculation. Typically, 10 points are good "// &
2167 "for 0.1 eV precision of band structures and molecular energy "// &
2168 "levels, 20 points for 0.03 eV precision, "// &
2169 "and 30 points for 0.01 eV precision, see Table I in "// &
2170 "<https://doi.org/10.1021/acs.jctc.0c01282>. GW computation time "// &
2171 "increases linearly with `NUM_TIME_FREQ_POINTS`.", &
2172 usage="NUM_TIME_FREQ_POINTS 30", &
2173 default_i_val=30)
2174 CALL section_add_keyword(section, keyword)
2175 CALL keyword_release(keyword)
2176
2177 CALL keyword_create(keyword, __location__, name="EPS_FILTER", &
2178 description="Determines a threshold for the DBCSR based sparse "// &
2179 "multiplications. Normally, `EPS_FILTER` determines accuracy "// &
2180 "and timing of low-scaling GW calculations. (Lower filter means "// &
2181 "higher numerical precision, but higher computational cost.)", &
2182 usage="EPS_FILTER 1.0E-6", &
2183 default_r_val=1.0e-8_dp)
2184 CALL section_add_keyword(section, keyword)
2185 CALL keyword_release(keyword)
2186
2187 CALL keyword_create(keyword, __location__, name="REGULARIZATION_MINIMAX", &
2188 description="Parameter to regularize the Fourier transformation with minimax grids. "// &
2189 "In case the parameter 0.0 is chosen, no regularization is performed.", &
2190 usage="REGULARIZATION_MINIMAX 1.0E-4", &
2191 default_r_val=-1.0_dp)
2192 CALL section_add_keyword(section, keyword)
2193 CALL keyword_release(keyword)
2194
2195 CALL keyword_create(keyword, __location__, name="REGULARIZATION_RI", &
2196 description="Parameter for RI regularization, setting a negative "// &
2197 "value triggers the default value. Affects RI basis set convergence "// &
2198 "but in any case large RI basis will give RI basis set convergence.", &
2199 usage="REGULARIZATION_RI 1.0E-4", &
2200 default_r_val=-1.0_dp)
2201 CALL section_add_keyword(section, keyword)
2202 CALL keyword_release(keyword)
2203
2204 CALL keyword_create(keyword, __location__, name="CUTOFF_RADIUS_RI", &
2205 description="The cutoff radius (in Angstrom) for the truncated "// &
2206 "Coulomb operator. The larger the cutoff radius, the faster "// &
2207 "converges the resolution of the identity (RI) with respect to the "// &
2208 "RI basis set size. Larger cutoff radius means higher computational "// &
2209 "cost.", &
2210 usage="CUTOFF_RADIUS_RI 3.0", &
2211 default_r_val=cp_unit_to_cp2k(value=3.0_dp, unit_str="angstrom"), &
2212 type_of_var=real_t, unit_str="angstrom")
2213 CALL section_add_keyword(section, keyword)
2214 CALL keyword_release(keyword)
2215
2216 CALL keyword_create(keyword, __location__, name="MEMORY_PER_PROC", &
2217 description="Specify the available memory per MPI process. Set "// &
2218 "`MEMORY_PER_PROC` as accurately as possible for good performance. If "// &
2219 "`MEMORY_PER_PROC` is set lower as the actually available "// &
2220 "memory per MPI process, the performance will be "// &
2221 "bad; if `MEMORY_PER_PROC` is set higher as the actually "// &
2222 "available memory per MPI process, the program might run out of "// &
2223 "memory. You can calculate `MEMORY_PER_PROC` as follows: "// &
2224 "Get the memory per node on your machine, mem_per_node "// &
2225 "(for example, from a supercomputer website, typically between "// &
2226 "100 GB and 2 TB), get the number of "// &
2227 "MPI processes per node, n_MPI_proc_per_node"// &
2228 " (for example from your run-script; if you "// &
2229 "use slurm, the number behind '--ntasks-per-node' is the number "// &
2230 "of MPI processes per node). Then calculate "// &
2231 "`MEMORY_PER_PROC` = mem_per_node / n_MPI_proc_per_node "// &
2232 "(typically between 2 GB and 50 GB). Unit of keyword: Gigabyte (GB).", &
2233 usage="MEMORY_PER_PROC 16", &
2234 default_r_val=2.0_dp)
2235 CALL section_add_keyword(section, keyword)
2236 CALL keyword_release(keyword)
2237
2238 CALL keyword_create(keyword, __location__, name="APPROX_KP_EXTRAPOL", &
2239 description="If true, use only a 4x4 kpoint mesh for frequency "// &
2240 "points $\omega_j, j \ge 2$ (instead of a 4x4 and 6x6 k-point mesh). "// &
2241 "The k-point extrapolation of $W_{PQ}(i\omega_j,\mathbf{q})$ "// &
2242 "is done approximately from $W_{PQ}(i\omega_1,\mathbf{q})$.", &
2243 usage="APPROX_KP_EXTRAPOL", &
2244 default_l_val=.false., lone_keyword_l_val=.true.)
2245 CALL section_add_keyword(section, keyword)
2246 CALL keyword_release(keyword)
2247
2248 CALL keyword_create(keyword, __location__, name="SIZE_LATTICE_SUM", &
2249 description="Parameter determines how many neighbor cells $\mathbf{R}$ "// &
2250 "are used for computing "// &
2251 "$V_{PQ}(\mathbf{k}) = "// &
2252 "\sum_{\mathbf{R}} e^{i\mathbf{k}\cdot\mathbf{R}}\,\langle P, "// &
2253 "\text{cell}{=}\mathbf{0}|1/r|Q,\text{cell}{=}\mathbf{R}\rangle$. "// &
2254 "Normally, parameter does not need to be touched.", &
2255 usage="SIZE_LATTICE_SUM 4", &
2256 default_i_val=3)
2257 CALL section_add_keyword(section, keyword)
2258 CALL keyword_release(keyword)
2259
2260 CALL keyword_create( &
2261 keyword, __location__, name="KPOINTS_W", &
2262 description="Monkhorst-Pack k-point mesh of size N_x, N_y, N_z for calculating "// &
2263 "$W_{PQ}^\mathbf{R}=\int_\text{BZ}\frac{d\mathbf{k}}{\Omega_\text{BZ}}\, "// &
2264 "e^{-i\mathbf{k}\cdot\mathbf{R}}\,W_{PQ}(\mathbf{k})$. "// &
2265 αα"For non-periodic directions , choose N_ = 1. "// &
2266 "Automatic choice of the k-point mesh for negative "// &
2267 "values, i.e. KPOINTS_W -1 -1 -1. "// &
2268 "K-point extrapolation of W is automatically switched on.", &
2269 usage="KPOINTS_W N_x N_y N_z", &
2270 n_var=3, type_of_var=integer_t, default_i_vals=(/-1, -1, -1/))
2271 CALL section_add_keyword(section, keyword)
2272 CALL keyword_release(keyword)
2273
2274 CALL keyword_create(keyword, __location__, name="HEDIN_SHIFT", &
2275 description="If true, use Hedin's shift in G0W0, evGW and evGW0. "// &
2276 "Details see in Li et al. JCTC 18, 7570 "// &
2277 "(2022), Figure 1. G0W0 with Hedin's shift should give "// &
2278 "similar GW eigenvalues as evGW0; at a lower "// &
2279 "computational cost.", &
2280 usage="HEDIN_SHIFT", &
2281 default_l_val=.false., &
2282 lone_keyword_l_val=.true.)
2283 CALL section_add_keyword(section, keyword)
2284 CALL keyword_release(keyword)
2285
2286 CALL keyword_create(keyword, __location__, name="FREQ_MAX_FIT", &
2287 description=Σω"For analytic continuation, a fit on (i) is performed. "// &
2288 Σω"This fit is then evaluated at a real frequency, (), which is used "// &
2289 "in the quasiparticle equation "// &
2290 "$\varepsilon_{n\mathbf{k}}^{G_0W_0}= "// &
2291 "\varepsilon_{n\mathbf{k}}^\text{DFT}+\Sigma_{n\mathbf{k}} "// &
2292 "-v^\text{xc}_{n\mathbf{k}}$. The keyword FREQ_MAX_FIT "// &
2293 Σω"determines fitting range for the self-energy (i) on "// &
2294 ωω"imaginary axis: i*[0, _max] for empty orbitals/bands, i*[-_max,0] "// &
2295 ω"for occ orbitals. A smaller _max might lead to better numerical "// &
2296 "stability (i.e., if you observe clearly wrong GW eigenvalues/bands "// &
2297 ω"around HOMO/LUMO, decreasing _max might fix this issue). "// &
2298 ω"A small benchmark of _max is contained in Fig. 5 of "// &
2299 "J. Wilhelm et al., JCTC 12, 3623-3635 (2016). "// &
2300 ω"Note that we used _max = 1 Ha = 27.211 eV in the benchmark "// &
2301 "M. Azizi et al., PRB 109, 245101 (2024).", &
2302 unit_str="eV", &
2303 usage="FREQ_MAX_FIT 20.0", &
2304 default_r_val=cp_unit_to_cp2k(value=10.0_dp, unit_str="eV"))
2305 CALL section_add_keyword(section, keyword)
2306 CALL keyword_release(keyword)
2307
2308 NULLIFY (subsection, print_key)
2309 CALL section_create(subsection, __location__, name="PRINT", &
2310 description="Printing of GW restarts.", &
2311 n_keywords=0, n_subsections=1, repeats=.false.)
2312 CALL cp_print_key_section_create(print_key, __location__, "RESTART", &
2313 description="Controls the printing of restart files "// &
2314 χΣ"for , W, .", &
2315 filename="", print_level=low_print_level, &
2316 common_iter_levels=3)
2317 CALL section_add_subsection(subsection, print_key)
2318 CALL section_release(print_key)
2319
2320 CALL section_add_subsection(section, subsection)
2321 CALL section_release(subsection)
2322
2323 END SUBROUTINE create_gw_section
2324
2325! **************************************************************************************************
2326!> \brief creates an input section for calculation SOC for the electronic band structure
2327!> \param section section to create
2328!> \par History
2329!> * 09.2023 created [Jan Wilhelm]
2330! **************************************************************************************************
2331 SUBROUTINE create_soc_section(section)
2332 TYPE(section_type), POINTER :: section
2333
2334 TYPE(keyword_type), POINTER :: keyword
2335
2336 cpassert(.NOT. ASSOCIATED(section))
2337 CALL section_create(section, __location__, name="SOC", &
2338 description="Switch on or off spin-orbit coupling. Use SOC "// &
2339 "parameters from non-local pseudopotentials as given in "// &
2340 "Hartwigsen, Goedecker, Hutter, Eq.(18), (19), "// &
2341 "<https://doi.org/10.1103/PhysRevB.58.3641>, "// &
2342 "$V_{\mu\nu}^{\mathrm{SOC}, (\alpha)} = "// &
2343 "(\hbar/2) \langle \phi_\mu | \sum_l \Delta "// &
2344 "V_l^\mathrm{SO}(\mathbf{r},\mathbf{r}') "// &
2345 "L^{(\alpha)} | \phi_\nu \rangle, "// &
2346 "\alpha = x, y, z$.", &
2347 n_keywords=1, n_subsections=1, repeats=.false.)
2348
2349 NULLIFY (keyword)
2350 CALL keyword_create(keyword, __location__, &
2351 name="_SECTION_PARAMETERS_", &
2352 description="Controls the activation of the SOC calculation.", &
2353 default_l_val=.false., &
2354 lone_keyword_l_val=.true.)
2355 CALL section_add_keyword(section, keyword)
2356 CALL keyword_release(keyword)
2357
2358 CALL keyword_create(keyword, __location__, name="ENERGY_WINDOW", &
2359 description="Apply SOC only for states with eigenvalues in the "// &
2360 "interval $[\varepsilon_\mathrm{VBM}-E_\mathrm{window}/2, "// &
2361 "\varepsilon_\mathrm{CBM}+E_\mathrm{window}/2]$. Might be necessary "// &
2362 "to use for large systems to prevent numerical instabilities.", &
2363 usage="ENERGY_WINDOW 5.0", &
2364 default_r_val=cp_unit_to_cp2k(value=40.0_dp, unit_str="eV"), &
2365 unit_str="eV")
2366 CALL section_add_keyword(section, keyword)
2367 CALL keyword_release(keyword)
2368
2369 END SUBROUTINE create_soc_section
2370
2371! **************************************************************************************************
2372!> \brief input section for computing the density of states and the projected density of states
2373!> \param section section to create
2374!> \par History
2375!> * 09.2023 created [Jan Wilhelm]
2376! **************************************************************************************************
2377 SUBROUTINE create_dos_section(section)
2378 TYPE(section_type), POINTER :: section
2379
2380 TYPE(keyword_type), POINTER :: keyword
2381 TYPE(section_type), POINTER :: subsection
2382
2383 cpassert(.NOT. ASSOCIATED(section))
2384 CALL section_create(section, __location__, name="DOS", &
2385 description="Parameters needed to calculate the density of states "// &
2386 "(DOS) and the projected density of states (PDOS).", &
2387 n_keywords=1, n_subsections=1, repeats=.false.)
2388
2389 NULLIFY (keyword)
2390 CALL keyword_create(keyword, __location__, &
2391 name="_SECTION_PARAMETERS_", &
2392 description="Controls the activation of the DOS calculation.", &
2393 default_l_val=.false., &
2394 lone_keyword_l_val=.true.)
2395 CALL section_add_keyword(section, keyword)
2396 CALL keyword_release(keyword)
2397
2398 CALL keyword_create(keyword, __location__, name="ENERGY_WINDOW", &
2399 description="Print DOS and PDOS in the energy window "// &
2400 "$[\varepsilon_\mathrm{VBM}-E_\mathrm{window}/2, "// &
2401 "\varepsilon_\mathrm{CBM}+E_\mathrm{window}/2]$,"// &
2402 " where VBM is the valence "// &
2403 "band maximum (or highest occupied molecular orbital, HOMO, for "// &
2404 "molecules) and CBM the conduction band minimum (or lowest "// &
2405 "unoccupied molecular orbital, LUMO, for molecules).", &
2406 usage="ENERGY_WINDOW 5.0", &
2407 default_r_val=cp_unit_to_cp2k(value=10.0_dp, unit_str="eV"), &
2408 unit_str="eV")
2409 CALL section_add_keyword(section, keyword)
2410 CALL keyword_release(keyword)
2411
2412 CALL keyword_create(keyword, __location__, name="ENERGY_STEP", &
2413 description="Resolution of the energy E when computing the $\rho(E)$.", &
2414 usage="ENERGY_STEP 0.01", &
2415 default_r_val=cp_unit_to_cp2k(value=0.01_dp, unit_str="eV"), &
2416 unit_str="eV")
2417 CALL section_add_keyword(section, keyword)
2418 CALL keyword_release(keyword)
2419
2420 CALL keyword_create(keyword, __location__, name="BROADENING", &
2421 description=α"Broadening in Gaussians used in the DOS; "// &
2422 "$\rho(E) = \sum_n \exp(((E-\varepsilon_n)/\alpha)^2)/("// &
2423 " \sqrt{2\pi} \alpha)$.", &
2424 usage="BROADENING 0.01", &
2425 default_r_val=cp_unit_to_cp2k(value=0.01_dp, unit_str="eV"), &
2426 unit_str="eV")
2427 CALL section_add_keyword(section, keyword)
2428 CALL keyword_release(keyword)
2429
2430 CALL keyword_create( &
2431 keyword, __location__, name="KPOINTS", &
2432 description="Monkhorst-Pack k-point mesh of size N_x, N_y, N_z for calculating "// &
2433 "the density of states (DOS). In GW, the KPOINT_DOS mesh is thus used as k-point "// &
2434 αα"mesh for the self-energy. For non-periodic directions , choose N_ = 1. "// &
2435 "Automatic choice of the k-point mesh for negative "// &
2436 α"values, i.e. KPOINTS_DOS -1 -1 -1 (automatic choice: N_ = 1 in non-periodic "// &
2437 "direction, 8 k-points in periodic direction). If you like to compute a "// &
2438 "band structure along a k-path, you can specify the k-path in "// &
2439 "&KPOINT_SET.", &
2440 usage="KPOINTS N_x N_y N_z", &
2441 n_var=3, type_of_var=integer_t, default_i_vals=(/-1, -1, -1/))
2442 CALL section_add_keyword(section, keyword)
2443 CALL keyword_release(keyword)
2444
2445 NULLIFY (subsection)
2446 CALL create_ldos_section(subsection)
2447 CALL section_add_subsection(section, subsection)
2448 CALL section_release(subsection)
2449
2450 END SUBROUTINE create_dos_section
2451
2452! **************************************************************************************************
2453!> \brief ...
2454!> \param section ...
2455! **************************************************************************************************
2456 SUBROUTINE create_ldos_section(section)
2457 TYPE(section_type), POINTER :: section
2458
2459 TYPE(keyword_type), POINTER :: keyword
2460
2461 cpassert(.NOT. ASSOCIATED(section))
2462 CALL section_create(section, __location__, name="LDOS", &
2463 description="Parameters needed to calculate the local density "// &
2464 "of states (LDOS). "// &
2465 "The LDOS is computed as $\rho(\mathbf{r},E) = "// &
2466 "\sum\limits_{n,\mathbf{k}}"// &
2467 " |\psi_{n\mathbf{k}}(r)|^2\, w_\mathbf{k}\, g(E-\varepsilon_{n\mathbf{k}})$ "// &
2468 "using the Gaussian weight function "// &
2469 "$g(x) = \exp(x^2/\alpha^2)/(\sqrt{2\pi}\alpha)$, $\alpha$ is the broadening "// &
2470 "from the &DOS section, and the k-point weight "// &
2471 "$w_\mathbf{k}$. The k-mesh is taken from the &DOS section.", &
2472 n_keywords=2, repeats=.false.)
2473
2474 NULLIFY (keyword)
2475 CALL keyword_create(keyword, __location__, &
2476 name="_SECTION_PARAMETERS_", &
2477 description="Activates the local VBM CBM gap calculation.", &
2478 default_l_val=.false., &
2479 lone_keyword_l_val=.true.)
2480 CALL section_add_keyword(section, keyword)
2481 CALL keyword_release(keyword)
2482
2483 CALL keyword_create(keyword, __location__, name="INTEGRATION", &
2484 description="Defines whether the LDOS is integrated along a "// &
2485 "coordinate. As an example, for INTEGRATION Z, the LDOS "// &
2486 "$\rho(x,y,E) = \int dz\, \rho(x,y,z,E)$ is computed.", &
2487 usage="INTEGRATION Z", &
2488 enum_c_vals=s2a("X", "Y", "Z", "NONE"), &
2489 enum_i_vals=(/int_ldos_x, int_ldos_y, int_ldos_z, int_ldos_none/), &
2490 enum_desc=s2a("Integrate over x coordinate (not yet implemented).", &
2491 "Integrate over y coordinate (not yet implemented).", &
2492 "Integrate over z coordinate.", &
2493 "No integration, print cube file as function "// &
2494 "of x,y,z (not yet implemented)."), &
2495 default_i_val=int_ldos_z)
2496 CALL section_add_keyword(section, keyword)
2497 CALL keyword_release(keyword)
2498
2499 CALL keyword_create( &
2500 keyword, __location__, name="BIN_MESH", &
2501 description="Mesh of size n x m for binning the space coordinates x and y of "// &
2502 "the LDOS $\rho(x,y,E)$. If -1, no binning is performed and the "// &
2503 "fine x, y resolution of the electron density from SCF is used.", &
2504 usage="BIN_MESH n m", &
2505 n_var=2, type_of_var=integer_t, default_i_vals=(/10, 10/))
2506 CALL section_add_keyword(section, keyword)
2507 CALL keyword_release(keyword)
2508
2509 END SUBROUTINE create_ldos_section
2510
2511! **************************************************************************************************
2512!> \brief creates an input section for a tip scan calculation
2513!> \param section section to create
2514!> \par History
2515!> * 04.2021 created [JGH]
2516! **************************************************************************************************
2517 SUBROUTINE create_tipscan_section(section)
2518 TYPE(section_type), POINTER :: section
2519
2520 TYPE(keyword_type), POINTER :: keyword
2521
2522 cpassert(.NOT. ASSOCIATED(section))
2523 CALL section_create(section, __location__, name="TIP_SCAN", &
2524 description="Parameters needed to set up a Tip Scan. "// &
2525 "Needs external definition of tip induced field.", &
2526 n_keywords=1, n_subsections=1, repeats=.false.)
2527
2528 NULLIFY (keyword)
2529
2530 CALL keyword_create(keyword, __location__, &
2531 name="_SECTION_PARAMETERS_", &
2532 description="Controls the activation of the Tip Scan procedure", &
2533 default_l_val=.false., &
2534 lone_keyword_l_val=.true.)
2535 CALL section_add_keyword(section, keyword)
2536 CALL keyword_release(keyword)
2537
2538 CALL keyword_create(keyword, __location__, name="SCAN_DIRECTION", &
2539 description="Defines scan direction and scan type(line, plane).", &
2540 usage="SCAN_DIRECTION XY", &
2541 enum_c_vals=s2a("X", "Y", "Z", "XY", "XZ", "YZ", "XYZ"), &
2542 enum_i_vals=(/scan_x, scan_y, scan_z, scan_xy, scan_xz, scan_yz, scan_xyz/), &
2543 default_i_val=scan_xy)
2544 CALL section_add_keyword(section, keyword)
2545 CALL keyword_release(keyword)
2546
2547 CALL keyword_create(keyword, __location__, name="REFERENCE_POINT", &
2548 description="The reference point to define the absolute position of the scan. ", &
2549 usage="REFERENCE_POINT 0.0 0.0 1.0", &
2550 n_var=3, default_r_vals=(/0.0_dp, 0.0_dp, 0.0_dp/), type_of_var=real_t, &
2551 unit_str="angstrom")
2552 CALL section_add_keyword(section, keyword)
2553 CALL keyword_release(keyword)
2554
2555 CALL keyword_create(keyword, __location__, name="SCAN_POINTS", &
2556 description="Number of points calculated for each scan direction.", &
2557 usage="SCAN_POINTS 20 20", &
2558 n_var=-1, type_of_var=integer_t)
2559 CALL section_add_keyword(section, keyword)
2560 CALL keyword_release(keyword)
2561
2562 CALL keyword_create(keyword, __location__, name="SCAN_STEP", &
2563 description="Step size for each scan direction.", &
2564 usage="SCAN_STEP 0.01 0.01", &
2565 n_var=-1, type_of_var=real_t, unit_str="angstrom")
2566 CALL section_add_keyword(section, keyword)
2567 CALL keyword_release(keyword)
2568
2569 CALL keyword_create(keyword, __location__, name="TIP_FILENAME", &
2570 description="Filename of tip potential defined in cube file format.", &
2571 usage="TIP_FILENAME <filename>", &
2572 type_of_var=lchar_t)
2573 CALL section_add_keyword(section, keyword)
2574 CALL keyword_release(keyword)
2575
2576 END SUBROUTINE create_tipscan_section
2577
collects all references to literature in CP2K as new algorithms / method are included from literature...
integer, save, public putrino2000
integer, save, public weber2009
integer, save, public kondov2007
integer, save, public luber2014
integer, save, public iannuzzi2005
integer, save, public sebastiani2001
integer, save, public putrino2002
integer, save, public vazdacruz2021
integer, save, public futera2017
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
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
collects all constants needed in input so that they can be used without circular dependencies
integer, parameter, public int_ldos_y
integer, parameter, public use_mom_ref_coac
integer, parameter, public tddfpt_dipole_berry
integer, parameter, public oe_saop
integer, parameter, public do_no_et
integer, parameter, public current_orb_center_wannier
integer, parameter, public scan_x
integer, parameter, public scan_xyz
integer, parameter, public use_mom_ref_user
integer, parameter, public tddfpt_kernel_none
integer, parameter, public use_mom_ref_com
integer, parameter, public gto_cartesian
integer, parameter, public gto_spherical
integer, parameter, public current_gauge_atom
integer, parameter, public current_gauge_r
integer, parameter, public oe_none
integer, parameter, public ot_precond_full_kinetic
integer, parameter, public current_gauge_r_and_step_func
integer, parameter, public oe_shift
integer, parameter, public int_ldos_x
integer, parameter, public current_orb_center_box
integer, parameter, public tddfpt_dipole_velocity
integer, parameter, public current_orb_center_common
integer, parameter, public ot_precond_full_single
integer, parameter, public scan_xy
integer, parameter, public scan_xz
integer, parameter, public tddfpt_kernel_full
integer, parameter, public ot_precond_none
integer, parameter, public scan_y
integer, parameter, public int_ldos_z
integer, parameter, public ot_precond_full_single_inverse
integer, parameter, public current_orb_center_atom
integer, parameter, public scan_z
integer, parameter, public do_spin_density
integer, parameter, public tddfpt_dipole_length
integer, parameter, public use_mom_ref_zero
integer, parameter, public oe_lb
integer, parameter, public tddfpt_kernel_stda
integer, parameter, public int_ldos_none
integer, parameter, public do_et_ddapc
integer, parameter, public ot_precond_s_inverse
integer, parameter, public do_full_density
integer, parameter, public scan_yz
integer, parameter, public oe_gllb
integer, parameter, public ot_precond_full_all
input section for atomic properties
subroutine, public create_atprop_section(section)
Creates the ATOMIC section.
function that build the dft section of the input
subroutine, public create_mgrid_section(section, create_subsections)
creates the multigrid
subroutine, public create_interp_section(section)
creates the interpolation section
function that build the kpoints section of the input
subroutine, public create_kpoint_set_section(section, section_name)
...
subroutine, public create_localize_section(section)
parameters fo the localization of wavefunctions
function that build the dft section of the input
subroutine, public create_properties_section(section)
Create the PROPERTIES section.
function that build the QS section of the input
subroutine, public create_lrigpw_section(section)
input section for optional parameters for LRIGPW LRI: local resolution of identity
subroutine, public create_ddapc_restraint_section(section, section_name)
...
function that builds the resp section of the input
subroutine, public create_resp_section(section)
Creates the RESP section.
function that build the XAS section of the input
subroutine, public create_xas_tdp_section(section)
makes the input section for core-level spectroscopy simulations using linear response TDDFT
function that build the xc section of the input
subroutine, public create_xc_section(section)
creates the input section for the xc part
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 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
Utilities for string manipulations.
represent a keyword in the input
represent a section of the input file