(git:ed6f26b)
Loading...
Searching...
No Matches
input_cp2k_opt.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!> 10.2005 moved out of input_cp2k [fawzi]
12!> \author fawzi
13! **************************************************************************************************
19 USE input_constants, ONLY: &
31 USE input_val_types, ONLY: integer_t,&
32 lchar_t,&
34 USE kinds, ONLY: dp
35 USE string_utilities, ONLY: s2a
36#include "./base/base_uses.f90"
37
38 IMPLICIT NONE
39 PRIVATE
40
41 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_cp2k_opt'
42
44 PUBLIC :: create_optimize_embed
45 PUBLIC :: create_optimize_dmfet
46
47CONTAINS
48
49! **************************************************************************************************
50!> \brief input section for optimization of the auxililary basis for LRIGPW
51!> \param section the section to create
52!> \author Dorothea Golze [05.2014]
53! **************************************************************************************************
55 TYPE(section_type), POINTER :: section
56
57 TYPE(keyword_type), POINTER :: keyword
58 TYPE(section_type), POINTER :: subsection
59
60 cpassert(.NOT. ASSOCIATED(section))
61 CALL section_create(section, __location__, name="OPTIMIZE_LRI_BASIS", &
62 description="This section specifies the parameters for optimizing "// &
63 "the lri auxiliary basis sets for LRIGPW. The Powell optimizer is used.", &
64 n_keywords=1, n_subsections=0, repeats=.false.)
65
66 NULLIFY (keyword, subsection)
67
68 CALL keyword_create(keyword, __location__, name="ACCURACY", &
69 description="Target accuracy for the objective function (RHOEND)", &
70 usage="ACCURACY 5.0E-4", default_r_val=1.0e-5_dp)
71 CALL section_add_keyword(section, keyword)
72 CALL keyword_release(keyword)
73
74 CALL keyword_create(keyword, __location__, name="MAX_FUN", &
75 description="Maximum number of function evaluations", &
76 usage="MAX_FUN 200", default_i_val=4000)
77 CALL section_add_keyword(section, keyword)
78 CALL keyword_release(keyword)
79
80 CALL keyword_create(keyword, __location__, name="STEP_SIZE", &
81 description="Initial step size for search algorithm (RHOBEG)", &
82 usage="STEP_SIZE 1.0E-1", default_r_val=5.0e-2_dp)
83 CALL section_add_keyword(section, keyword)
84 CALL keyword_release(keyword)
85
86 CALL keyword_create(keyword, __location__, name="CONDITION_WEIGHT", &
87 description="This keyword allows to give different weight "// &
88 "factors to the condition number (LOG(cond) is used).", &
89 usage="CONDITION_WEIGHT 1.0E-4", default_r_val=1.0e-6_dp)
90 CALL section_add_keyword(section, keyword)
91 CALL keyword_release(keyword)
92
93 CALL keyword_create(keyword, __location__, name="USE_CONDITION_NUMBER", &
94 description="Determines whether condition number should be part "// &
95 "of optimization or not", &
96 usage="USE_CONDITION_NUMBER", &
97 default_l_val=.false., lone_keyword_l_val=.true.)
98 CALL section_add_keyword(section, keyword)
99 CALL keyword_release(keyword)
100
101 CALL keyword_create(keyword, __location__, name="GEOMETRIC_SEQUENCE", &
102 description="Exponents are assumed to be a geometric sequence. "// &
103 "Only the minimal and maximal exponents of one set are optimized and "// &
104 "the other exponents are obtained by geometric progression.", &
105 usage="GEOMETRIC_SEQUENCE", &
106 default_l_val=.false., lone_keyword_l_val=.true.)
107 CALL section_add_keyword(section, keyword)
108 CALL keyword_release(keyword)
109
110 CALL keyword_create(keyword, __location__, name="DEGREES_OF_FREEDOM", &
111 description="Specifies the degrees of freedom in the basis "// &
112 "optimization.", &
113 usage="DEGREES_OF_FREEDOM ALL", &
114 enum_c_vals=s2a("ALL", "COEFFICIENTS", "EXPONENTS"), &
115 enum_desc=s2a("Set all parameters in the basis to be variable.", &
116 "Set all coefficients in the basis set to be variable.", &
117 "Set all exponents in the basis to be variable."), &
119 default_i_val=do_lri_opt_exps)
120 CALL section_add_keyword(section, keyword)
121 CALL keyword_release(keyword)
122
123 CALL create_constrain_exponents_section(subsection)
124 CALL section_add_subsection(section, subsection)
125 CALL section_release(subsection)
126
128
129! **************************************************************************************************
130!> \brief Input for DFT embedding
131!> \param section ...
132!> \author Vladimir Rybkin [08.2017]
133! **************************************************************************************************
134 SUBROUTINE create_optimize_embed(section)
135 TYPE(section_type), POINTER :: section
136
137 TYPE(keyword_type), POINTER :: keyword
138
139 cpassert(.NOT. ASSOCIATED(section))
140 CALL section_create(section, __location__, name="OPT_EMBED", &
141 description="This section specifies optional parameters for DFT embedding potential optimization.", &
142 n_keywords=19, n_subsections=4, repeats=.false.)
143
144 NULLIFY (keyword)
145
146 CALL keyword_create(keyword, __location__, name="REG_LAMBDA", &
147 description="Parameter for Yang's regularization "// &
148 "involving kinetic matrix.", &
149 usage="REG_LAMBDA 0.0001", default_r_val=0.0001_dp)
150 CALL section_add_keyword(section, keyword)
151 CALL keyword_release(keyword)
152
153 CALL keyword_create(keyword, __location__, name="N_ITER", &
154 description="Maximum number of iterations "// &
155 "in the optimization procedure.", &
156 usage="N_ITER 75", default_i_val=50)
157 CALL section_add_keyword(section, keyword)
158 CALL keyword_release(keyword)
159
160 CALL keyword_create(keyword, __location__, name="TRUST_RAD", &
161 description="Maximum number of iterations "// &
162 "in the optimization procedure.", &
163 usage="TRUST_RAD 0.5", default_r_val=0.5_dp)
164 CALL section_add_keyword(section, keyword)
165 CALL keyword_release(keyword)
166
167 CALL keyword_create(keyword, __location__, name="DENS_CONV_MAX", &
168 description="Convergence criterion for "// &
169 "the maximum electron density difference.", &
170 usage="DENS_CONV_MAX 0.01", default_r_val=0.01_dp)
171 CALL section_add_keyword(section, keyword)
172 CALL keyword_release(keyword)
173
174 CALL keyword_create(keyword, __location__, name="DENS_CONV_INT", &
175 description="Convergence criterion for "// &
176 "the integrated electron density difference.", &
177 usage="DENS_CONV_INT 0.1", default_r_val=0.1_dp)
178 CALL section_add_keyword(section, keyword)
179 CALL keyword_release(keyword)
180
181 CALL keyword_create(keyword, __location__, name="SPIN_DENS_CONV_MAX", &
182 description="Convergence criterion for "// &
183 "the maximum electron density difference.", &
184 usage="SPIN_DENS_CONV_MAX 0.01", default_r_val=0.01_dp)
185 CALL section_add_keyword(section, keyword)
186 CALL keyword_release(keyword)
187
188 CALL keyword_create(keyword, __location__, name="SPIN_DENS_CONV_INT", &
189 description="Convergence criterion for "// &
190 "the integrated electron density difference.", &
191 usage="SPIN_DENS_CONV_INT 0.1", default_r_val=0.1_dp)
192 CALL section_add_keyword(section, keyword)
193 CALL keyword_release(keyword)
194
195 CALL keyword_create(keyword, __location__, name="OPTIMIZER", &
196 description="Optimize embedding potential.", &
197 usage="OPTIMIZER LEVEL_SHIFT", &
198 default_i_val=embed_steep_desc, &
199 enum_c_vals=s2a("STEEPEST_DESCENT", "QUASI_NEWTON", "LEVEL_SHIFT"), &
200 enum_desc=s2a("Steepest descent.", "Quasi-Newton.", "Level shift."), &
202 CALL section_add_keyword(section, keyword)
203 CALL keyword_release(keyword)
204
205 CALL keyword_create(keyword, __location__, name="GRID_OPT", &
206 description="Optimize embedding potential on the grid. ", &
207 usage="GRID_OPT .TRUE.", &
208 default_l_val=.true.)
209 CALL section_add_keyword(section, keyword)
210 CALL keyword_release(keyword)
211
212 CALL keyword_create(keyword, __location__, name="LEEUWEN-BAERENDS", &
213 description="Van Leeuwen-Baerends iterative update. Alternative to Wu-Yang "// &
214 "optimizer. Use only with ADD_CONTST_POT.", &
215 usage="LEEUWEN-BAERENDS .TRUE.", &
216 default_l_val=.false.)
217 CALL section_add_keyword(section, keyword)
218 CALL keyword_release(keyword)
219
220 CALL keyword_create(keyword, __location__, name="FAB", &
221 description="Finzel-Ayers-Bultinck iterative update. Generally, not reliable. ", &
222 usage="FAB .TRUE.", &
223 default_l_val=.false.)
224 CALL section_add_keyword(section, keyword)
225 CALL keyword_release(keyword)
226
227 CALL keyword_create(keyword, __location__, name="VW_CUTOFF", &
228 description="Cutoff for von Weizsacker potential in "// &
229 "the FAB optimization procedure.", &
230 usage="VW_CUTOFF 0.01", default_r_val=0.01_dp)
231 CALL section_add_keyword(section, keyword)
232 CALL keyword_release(keyword)
233
234 CALL keyword_create(keyword, __location__, name="VW_SMOOTH_CUT_RANGE", &
235 description="Smooth cutoff range for von Weizsacker potential in "// &
236 "the FAB optimization procedure.", &
237 usage="VW_SMOOTH_CUT_RANGE 1.0", default_r_val=1.0_dp)
238 CALL section_add_keyword(section, keyword)
239 CALL keyword_release(keyword)
240
241 CALL keyword_create(keyword, __location__, name="POT_GUESS", &
242 description="Specifies the guess of the embedding "// &
243 "potential. For optimization in finite basis (not grid optimization) "// &
244 "in is a constant part to be added to the one in finite basis. ", &
245 usage="POT_GUESS NONE", &
246 enum_c_vals=s2a("NONE", "DIFF", "Fermi_Amaldi", "RESP"), &
247 enum_desc=s2a("Initial guess is zero grid.", &
248 "Initial density difference. A euristic but working approach.", &
249 "Fermi-Amaldi potential. More rigorous than DIFF, although less efficient.", &
250 "Coulomb interaction between the subsystem using RESP charges)"// &
251 " on the total system."), &
252 enum_i_vals=(/embed_none, embed_diff, embed_fa, embed_resp/), &
253 default_i_val=embed_none)
254 CALL section_add_keyword(section, keyword)
255 CALL keyword_release(keyword)
256
257 CALL keyword_create(keyword, __location__, name="CHARGE_DISTR_WIDTH", &
258 description="Width of the Gaussian representing "// &
259 "point charges. To be used with ADD_COULOMB_POT.", &
260 usage="CHARGE_DISTR_WIDTH 3.000", default_r_val=1.12490_dp)
261 CALL section_add_keyword(section, keyword)
262 CALL keyword_release(keyword)
263
264 CALL keyword_create(keyword, __location__, name="READ_EMBED_POT", &
265 description="Read the embedding potential "// &
266 "restart vector as a guess.", &
267 usage="READ_EMBED_POT .FALSE.", default_l_val=.false.)
268 CALL section_add_keyword(section, keyword)
269 CALL keyword_release(keyword)
270
271 CALL keyword_create(keyword, __location__, name="READ_EMBED_POT_CUBE", &
272 description="Read the embedding potential "// &
273 "(restart) from the cube file.", &
274 usage="READ_EMBED_POT_CUBE .FALSE.", default_l_val=.false.)
275 CALL section_add_keyword(section, keyword)
276 CALL keyword_release(keyword)
277
278 CALL keyword_create(keyword, __location__, name="EMBED_RESTART_FILE_NAME", &
279 description="Root of the file name where to read the embedding "// &
280 "potential guess.", &
281 usage="EMBED_RESTART_FILE_NAME <FILENAME>", &
282 type_of_var=lchar_t)
283 CALL section_add_keyword(section, keyword)
284 CALL keyword_release(keyword)
285
286 CALL keyword_create(keyword, __location__, name="EMBED_CUBE_FILE_NAME", &
287 description="Root of the file name where to read the embedding "// &
288 "potential (guess) as a cube.", &
289 usage="EMBED_CUBE_FILE_NAME <FILENAME>", &
290 type_of_var=lchar_t)
291 CALL section_add_keyword(section, keyword)
292 CALL keyword_release(keyword)
293
294 CALL keyword_create(keyword, __location__, name="EMBED_SPIN_CUBE_FILE_NAME", &
295 description="Root of the file name where to read the spin part "// &
296 "of the embedding potential (guess) as a cube.", &
297 usage="EMBED_SPIN_CUBE_FILE_NAME <FILENAME>", &
298 type_of_var=lchar_t)
299 CALL section_add_keyword(section, keyword)
300 CALL keyword_release(keyword)
301
302 CALL create_print_embed_diff(section)
303
304 CALL create_print_embed_pot_cube(section)
305
306 CALL create_print_embed_restart_vec(section)
307
308 CALL create_print_simple_grid(section)
309
310 END SUBROUTINE create_optimize_embed
311
312! **************************************************************************************************
313!> \brief Input for density matrix functional embedding, DMFET
314!> \param section ...
315!> \author Vladimir Rybkin [08.2018]
316! **************************************************************************************************
317 SUBROUTINE create_optimize_dmfet(section)
318 TYPE(section_type), POINTER :: section
319
320 TYPE(keyword_type), POINTER :: keyword
321
322 cpassert(.NOT. ASSOCIATED(section))
323 CALL section_create(section, __location__, name="OPT_DMFET", &
324 description="This section specifies optional parameters for DMFET matrix potential optimization.", &
325 n_keywords=8, n_subsections=4, repeats=.false.)
326
327 NULLIFY (keyword)
328
329 CALL keyword_create(keyword, __location__, name="N_ITER", &
330 description="Maximum number of iterations "// &
331 "in the optimization procedure.", &
332 usage="N_ITER 75", default_i_val=50)
333 CALL section_add_keyword(section, keyword)
334 CALL keyword_release(keyword)
335
336 CALL keyword_create(keyword, __location__, name="TRUST_RAD", &
337 description="Step length "// &
338 "in the optimization procedure.", &
339 usage="TRUST_RAD 0.5", default_r_val=0.5_dp)
340 CALL section_add_keyword(section, keyword)
341 CALL keyword_release(keyword)
342
343 CALL keyword_create(keyword, __location__, name="DM_CONV_MAX", &
344 description="Convergence criterion for "// &
345 "the maximum element of density matrix difference.", &
346 usage="DM_CONV_MAX 0.01", default_r_val=0.01_dp)
347 CALL section_add_keyword(section, keyword)
348 CALL keyword_release(keyword)
349
350 CALL keyword_create(keyword, __location__, name="DM_CONV_INT", &
351 description="Convergence criterion for "// &
352 "the total density matrix difference.", &
353 usage="DM_CONV_INT 0.1", default_r_val=0.1_dp)
354 CALL section_add_keyword(section, keyword)
355 CALL keyword_release(keyword)
356
357 CALL keyword_create(keyword, __location__, name="BETA_DM_CONV_MAX", &
358 description="Convergence criterion for "// &
359 "the maximum element of the beta-spin density "// &
360 "matrix difference.", &
361 usage="BETA_DM_CONV_MAX 0.01", default_r_val=0.01_dp)
362 CALL section_add_keyword(section, keyword)
363 CALL keyword_release(keyword)
364
365 CALL keyword_create(keyword, __location__, name="BETA_DM_CONV_INT", &
366 description="Convergence criterion for "// &
367 "the total beta-spin density matrix difference.", &
368 usage="BETA_DM_CONV_INT 0.1", default_r_val=0.1_dp)
369 CALL section_add_keyword(section, keyword)
370 CALL keyword_release(keyword)
371
372 CALL keyword_create(keyword, __location__, name="READ_DMFET_POT", &
373 description="Read the matrix embedding potential "// &
374 "(restart) from the cube file.", &
375 usage="READ_DMFET_POT .FALSE.", default_l_val=.false.)
376 CALL section_add_keyword(section, keyword)
377 CALL keyword_release(keyword)
378
379 CALL keyword_create(keyword, __location__, name="DMFET_RESTART_FILE_NAME", &
380 description="Root of the file name where to read the matrix "// &
381 "potential guess.", &
382 usage="DMFET_RESTART_FILE_NAME <FILENAME>", &
383 type_of_var=lchar_t)
384 CALL section_add_keyword(section, keyword)
385 CALL keyword_release(keyword)
386
387 END SUBROUTINE create_optimize_dmfet
388
389! **************************************************************************************************
390!> \brief ...
391!> \param section ...
392! **************************************************************************************************
393 SUBROUTINE create_print_embed_diff(section)
394 TYPE(section_type), POINTER :: section
395
396 TYPE(keyword_type), POINTER :: keyword
397 TYPE(section_type), POINTER :: print_key
398
399 NULLIFY (print_key, keyword)
400 CALL cp_print_key_section_create(print_key, __location__, "EMBED_DENS_DIFF", &
401 description="Controls the printing of cube files with "// &
402 "embedding densisty differences", &
403 print_level=high_print_level, add_last=add_last_numeric, filename="")
404 CALL keyword_create(keyword, __location__, name="stride", &
405 description="The stride (X,Y,Z) used to write the cube file "// &
406 "(larger values result in smaller cube files). You can provide 3 numbers (for X,Y,Z) or"// &
407 " 1 number valid for all components.", &
408 usage="STRIDE 2 2 2", n_var=-1, default_i_vals=(/2, 2, 2/), type_of_var=integer_t)
409 CALL section_add_keyword(print_key, keyword)
410 CALL keyword_release(keyword)
411
412 CALL section_add_subsection(section, print_key)
413 CALL section_release(print_key)
414
415 END SUBROUTINE create_print_embed_diff
416
417! **************************************************************************************************
418!> \brief ...
419!> \param section ...
420! **************************************************************************************************
421 SUBROUTINE create_print_embed_pot_cube(section)
422 TYPE(section_type), POINTER :: section
423
424 TYPE(keyword_type), POINTER :: keyword
425 TYPE(section_type), POINTER :: print_key
426
427 NULLIFY (print_key, keyword)
428 CALL cp_print_key_section_create(print_key, __location__, "EMBED_POT_CUBE", &
429 description="Controls the printing of cube files with "// &
430 "with embedding potential", &
431 print_level=high_print_level, add_last=add_last_numeric, filename="")
432 CALL keyword_create(keyword, __location__, name="stride", &
433 description="The stride (X,Y,Z) used to write the cube file "// &
434 "(larger values result in smaller cube files). You can provide 3 numbers (for X,Y,Z) or"// &
435 " 1 number valid for all components.", &
436 usage="STRIDE 1 1 1", n_var=-1, default_i_vals=(/1, 1, 1/), type_of_var=integer_t)
437 CALL section_add_keyword(print_key, keyword)
438 CALL keyword_release(keyword)
439
440 CALL section_add_subsection(section, print_key)
441 CALL section_release(print_key)
442
443 END SUBROUTINE create_print_embed_pot_cube
444
445! **************************************************************************************************
446!> \brief ...
447!> \param section ...
448! **************************************************************************************************
449 SUBROUTINE create_print_embed_restart_vec(section)
450 TYPE(section_type), POINTER :: section
451
452 TYPE(section_type), POINTER :: print_key
453
454 NULLIFY (print_key)
455 CALL cp_print_key_section_create(print_key, __location__, "EMBED_POT_VECTOR", &
456 description="Controls the printing of cube files with "// &
457 "with embedding potential", &
458 print_level=silent_print_level, add_last=add_last_numeric, filename="")
459 CALL section_add_subsection(section, print_key)
460 CALL section_release(print_key)
461
462 END SUBROUTINE create_print_embed_restart_vec
463
464! **************************************************************************************************
465!> \brief ...
466!> \param section ...
467! **************************************************************************************************
468 SUBROUTINE create_print_simple_grid(section)
469 TYPE(section_type), POINTER :: section
470
471 TYPE(keyword_type), POINTER :: keyword
472 TYPE(section_type), POINTER :: print_key
473
474 NULLIFY (print_key, keyword)
475 CALL cp_print_key_section_create(print_key, __location__, "WRITE_SIMPLE_GRID", &
476 description="Controls the printing of simple grid "// &
477 "files with embedding potential: X Y Z value", &
478 print_level=high_print_level, add_last=add_last_numeric, filename="")
479
480 CALL keyword_create(keyword, __location__, name="STRIDE", &
481 description="The stride (X,Y,Z) used to write the cube file "// &
482 "(larger values result in smaller cube files). You can provide 3 numbers (for X,Y,Z) or"// &
483 " 1 number valid for all components.", &
484 usage="STRIDE 1 1 1", n_var=-1, default_i_vals=(/1, 1, 1/), type_of_var=integer_t)
485 CALL section_add_keyword(print_key, keyword)
486 CALL keyword_release(keyword)
487
488 CALL keyword_create(keyword, __location__, name="UNITS", &
489 description="Units of the volumetric file: Angstrom or Bohr.", &
490 usage="UNITS BOHR", &
491 default_i_val=embed_grid_bohr, &
492 enum_c_vals=s2a("BOHR", "ANGSTROM"), &
493 enum_desc=s2a("Atomic units: Bohr", "Metric units: Angstrom."), &
494 enum_i_vals=(/embed_grid_bohr, embed_grid_angstrom/))
495 CALL section_add_keyword(print_key, keyword)
496 CALL keyword_release(keyword)
497
498 CALL keyword_create(keyword, __location__, name="FOLD_COORD", &
499 description="Activates printing folded coordinates corresponding "// &
500 "to the simple grid. Used as input for external programs.", &
501 usage="FOLD_COORD .TRUE.", n_var=1, type_of_var=logical_t, &
502 default_l_val=.true., lone_keyword_l_val=.true.)
503 CALL section_add_keyword(print_key, keyword)
504
505 CALL keyword_release(keyword)
506 CALL section_add_subsection(section, print_key)
507 CALL section_release(print_key)
508
509 END SUBROUTINE create_print_simple_grid
510
511! **************************************************************************************************
512!> \brief input section for constraints for auxiliary basis set optimization
513!> \param section the section to create
514!> \author Dorothea Golze [11.2014]
515! **************************************************************************************************
516 SUBROUTINE create_constrain_exponents_section(section)
517 TYPE(section_type), POINTER :: section
518
519 TYPE(keyword_type), POINTER :: keyword
520
521 CALL section_create(section, __location__, name="CONSTRAIN_EXPONENTS", &
522 description="specifies constraints for the exponents of the "// &
523 "lri auxiliary basis sets in the optimization.", &
524 n_keywords=1, n_subsections=0, repeats=.false.)
525
526 NULLIFY (keyword)
527
528 CALL keyword_create(keyword, __location__, name="SCALE", &
529 description="Defines the upper and lower boundaries as "// &
530 "(1+scale)*exp and (1-scale)*exp. Fermi-like constraint "// &
531 "function", &
532 usage="SCALE 0.3", default_r_val=0.3_dp)
533 CALL section_add_keyword(section, keyword)
534 CALL keyword_release(keyword)
535
536 CALL keyword_create(keyword, __location__, name="FERMI_EXP", &
537 description="Exponent in the fermi-like constraint function. ", &
538 usage="FERMI_EXP 2.63", default_r_val=2.63391_dp)
539 CALL section_add_keyword(section, keyword)
540 CALL keyword_release(keyword)
541
542 END SUBROUTINE create_constrain_exponents_section
543
544END MODULE input_cp2k_opt
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
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
collects all constants needed in input so that they can be used without circular dependencies
integer, parameter, public embed_grid_angstrom
integer, parameter, public embed_steep_desc
integer, parameter, public do_lri_opt_coeff
integer, parameter, public do_lri_opt_all
integer, parameter, public embed_level_shift
integer, parameter, public embed_resp
integer, parameter, public embed_quasi_newton
integer, parameter, public do_lri_opt_exps
integer, parameter, public embed_none
integer, parameter, public embed_fa
integer, parameter, public embed_diff
integer, parameter, public gaussian
integer, parameter, public embed_grid_bohr
function that build the dft section of the input
subroutine, public create_optimize_lri_basis_section(section)
input section for optimization of the auxililary basis for LRIGPW
subroutine, public create_optimize_dmfet(section)
Input for density matrix functional embedding, DMFET.
subroutine, public create_optimize_embed(section)
Input for DFT embedding.
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 lchar_t
integer, parameter, public logical_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