(git:374b731)
Loading...
Searching...
No Matches
input_cp2k_neb.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \par History
10!> - taken out of input_cp2k_motion
11!> \author Ole Schuett
12! **************************************************************************************************
13
15 USE bibliography, ONLY: elber1987,&
25 USE cp_units, ONLY: cp_unit_to_cp2k
26 USE input_constants, ONLY: &
39 USE input_val_types, ONLY: real_t
40 USE kinds, ONLY: dp
41 USE string_utilities, ONLY: s2a
42#include "./base/base_uses.f90"
43
44 IMPLICIT NONE
45 PRIVATE
46
47 LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .true.
48 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_cp2k_neb'
49
50 PUBLIC :: create_band_section
51
52CONTAINS
53
54! **************************************************************************************************
55!> \brief creates the section for a BAND run
56!> \param section will contain the pint section
57!> \author Teodoro Laino 09.2006 [tlaino]
58! **************************************************************************************************
59 SUBROUTINE create_band_section(section)
60 TYPE(section_type), POINTER :: section
61
62 TYPE(keyword_type), POINTER :: keyword
63 TYPE(section_type), POINTER :: print_key, subsection, subsubsection
64
65 cpassert(.NOT. ASSOCIATED(section))
66 CALL section_create(section, __location__, name="band", &
67 description="The section that controls a BAND run", &
68 n_keywords=1, n_subsections=0, repeats=.false., &
70 NULLIFY (keyword, print_key, subsection, subsubsection)
71
72 CALL keyword_create(keyword, __location__, name="NPROC_REP", &
73 description="Specify the number of processors to be used per replica "// &
74 "environment (for parallel runs)", &
75 default_i_val=1)
76 CALL section_add_keyword(section, keyword)
77 CALL keyword_release(keyword)
78
79 CALL keyword_create(keyword, __location__, name="PROC_DIST_TYPE", &
80 description="Specify the topology of the mapping of processors into replicas.", &
81 usage="PROC_DIST_TYPE (INTERLEAVED|BLOCKED)", &
82 enum_c_vals=s2a("INTERLEAVED", &
83 "BLOCKED"), &
84 enum_desc=s2a("Interleaved distribution", &
85 "Blocked distribution"), &
86 enum_i_vals=(/do_rep_interleaved, do_rep_blocked/), &
87 default_i_val=do_rep_blocked)
88 CALL section_add_keyword(section, keyword)
89 CALL keyword_release(keyword)
90
91 CALL keyword_create(keyword, __location__, name="BAND_TYPE", &
92 description="Specifies the type of BAND calculation", &
93 usage="BAND_TYPE (B-NEB|IT-NEB|CI-NEB|D-NEB|SM|EB)", &
94 default_i_val=do_it_neb, &
95 enum_c_vals=s2a("B-NEB", &
96 "IT-NEB", &
97 "CI-NEB", &
98 "D-NEB", &
99 "SM", &
100 "EB"), &
101 enum_desc=s2a("Bisection nudged elastic band", &
102 "Improved tangent nudged elastic band", &
103 "Climbing image nudged elastic band", &
104 "Doubly nudged elastic band", &
105 "String Method", &
106 "Elastic band (Hamiltonian formulation)"), &
107 enum_i_vals=(/do_b_neb, do_it_neb, do_ci_neb, do_d_neb, do_sm, do_eb/))
108 CALL section_add_keyword(section, keyword)
109 CALL keyword_release(keyword)
110
111 CALL keyword_create(keyword, __location__, name="NUMBER_OF_REPLICA", &
112 description="Specify the number of Replica to use in the BAND", &
113 default_i_val=10)
114 CALL section_add_keyword(section, keyword)
115 CALL keyword_release(keyword)
116
117 CALL keyword_create(keyword, __location__, name="USE_COLVARS", &
118 description="Uses a version of the band scheme projected in a subspace of colvars.", &
119 default_l_val=.false., lone_keyword_l_val=.true.)
120 CALL section_add_keyword(section, keyword)
121 CALL keyword_release(keyword)
122
123 CALL keyword_create(keyword, __location__, name="POT_TYPE", &
124 description="Specifies the type of potential used in the BAND calculation", &
125 usage="POT_TYPE (FULL|FE|ME)", &
126 default_i_val=pot_neb_full, &
127 enum_c_vals=s2a("FULL", &
128 "FE", &
129 "ME"), &
130 enum_desc=s2a("Full potential (no projections in a subspace of colvars)", &
131 "Free energy (requires a projections in a subspace of colvars)", &
132 "Minimum energy (requires a projections in a subspace of colvars)"), &
133 enum_i_vals=(/pot_neb_full, pot_neb_fe, pot_neb_me/))
134 CALL section_add_keyword(section, keyword)
135 CALL keyword_release(keyword)
136
137 CALL keyword_create(keyword, __location__, name="ROTATE_FRAMES", &
138 description="Compute at each BAND step the RMSD and rotate the frames in order"// &
139 " to minimize it.", &
140 default_l_val=.true., lone_keyword_l_val=.true.)
141 CALL section_add_keyword(section, keyword)
142 CALL keyword_release(keyword)
143
144 CALL keyword_create(keyword, __location__, name="ALIGN_FRAMES", &
145 description="Enables the alignment of the frames at the beginning of a BAND calculation. "// &
146 "This keyword does not affect the rotation of the replicas during a BAND calculation.", &
147 default_l_val=.true., lone_keyword_l_val=.true.)
148 CALL section_add_keyword(section, keyword)
149 CALL keyword_release(keyword)
150
151 CALL keyword_create(keyword, __location__, name="K_SPRING", &
152 variants=(/"K"/), &
153 description="Specify the value of the spring constant", &
154 default_r_val=0.02_dp)
155 CALL section_add_keyword(section, keyword)
156 CALL keyword_release(keyword)
157
158 ! Convergence_control
159 CALL section_create(subsection, __location__, name="CONVERGENCE_CONTROL", &
160 description="Setup parameters to control the convergence criteria for BAND", &
161 repeats=.false.)
162 CALL keyword_create(keyword, __location__, name="MAX_DR", &
163 description="Tolerance on the maximum value of the displacement on the BAND.", &
164 usage="MAX_DR {real}", &
165 default_r_val=0.0002_dp)
166 CALL section_add_keyword(subsection, keyword)
167 CALL keyword_release(keyword)
168
169 CALL keyword_create(keyword, __location__, name="MAX_FORCE", &
170 description="Tolerance on the maximum value of Forces on the BAND.", &
171 usage="MAX_FORCE {real}", &
172 default_r_val=0.00045_dp)
173 CALL section_add_keyword(subsection, keyword)
174 CALL keyword_release(keyword)
175
176 CALL keyword_create(keyword, __location__, name="RMS_DR", &
177 description="Tolerance on RMS displacements on the BAND.", &
178 usage="RMS_DR {real}", &
179 default_r_val=0.0001_dp)
180 CALL section_add_keyword(subsection, keyword)
181 CALL keyword_release(keyword)
182
183 CALL keyword_create(keyword, __location__, name="RMS_FORCE", &
184 description="Tolerance on RMS Forces on the BAND.", &
185 usage="RMS_FORCE {real}", &
186 default_r_val=0.00030_dp)
187 CALL section_add_keyword(subsection, keyword)
188 CALL keyword_release(keyword)
189 CALL section_add_subsection(section, subsection)
190 CALL section_release(subsection)
191
192 NULLIFY (subsection, subsubsection)
193 ! CI-NEB section
194 CALL section_create(subsection, __location__, name="CI_NEB", &
195 description="Controls parameters for CI-NEB type calculation only.", &
196 repeats=.false.)
197 CALL keyword_create(keyword, __location__, name="NSTEPS_IT", &
198 description="Specify the number of steps of IT-NEB to perform before "// &
199 "switching on the CI algorithm", &
200 default_i_val=5)
201 CALL section_add_keyword(subsection, keyword)
202 CALL keyword_release(keyword)
203 CALL section_add_subsection(section, subsection)
204 CALL section_release(subsection)
205
206 ! String Method section
207 CALL section_create(subsection, __location__, name="STRING_METHOD", &
208 description="Controls parameters for String Method type calculation only.", &
209 repeats=.false.)
210
211 CALL keyword_create(keyword, __location__, name="SPLINE_ORDER", &
212 description="Specify the oder of the spline used in the String Method.", &
213 default_i_val=1)
214 CALL section_add_keyword(subsection, keyword)
215 CALL keyword_release(keyword)
216 CALL keyword_create(keyword, __location__, name="SMOOTHING", &
217 description="Smoothing parameter for the reparametrization of the frames.", &
218 default_r_val=0.2_dp)
219 CALL section_add_keyword(subsection, keyword)
220 CALL keyword_release(keyword)
221
222 CALL section_add_subsection(section, subsection)
223 CALL section_release(subsection)
224
225 ! Optimization section
226 CALL section_create(subsection, __location__, name="optimize_band", &
227 description="Specify the optimization method for the band", &
228 repeats=.true.)
229 CALL create_opt_band_section(subsection)
230 CALL section_add_subsection(section, subsection)
231 CALL section_release(subsection)
232
233 ! replica section: to specify coordinates and velocities (possibly) of the
234 ! different replica used in the BAND
235 CALL section_create(subsection, __location__, name="replica", &
236 description="Specify coordinates and velocities (possibly) of the replica", &
237 repeats=.true.)
238 ! Colvar
239 CALL keyword_create(keyword, __location__, name="COLLECTIVE", &
240 description="Specifies the value of the collective variables used in the projected"// &
241 " BAND method. The order of the values is the order of the COLLECTIVE section in the"// &
242 " constraints/restraints section", &
243 usage="COLLECTIVE {real} .. {real}", &
244 type_of_var=real_t, n_var=-1)
245 CALL section_add_keyword(subsection, keyword)
246 CALL keyword_release(keyword)
247 ! Coordinates read through an external file
248 CALL keyword_create(keyword, __location__, name="COORD_FILE_NAME", &
249 description="Name of the xyz file with coordinates (alternative to &COORD section)", &
250 usage="COORD_FILE_NAME <CHAR>", &
251 default_lc_val="")
252 CALL section_add_keyword(subsection, keyword)
253 CALL keyword_release(keyword)
254 ! Coordinates and velocities
255 CALL create_coord_section(subsubsection, "BAND")
256 CALL section_add_subsection(subsection, subsubsection)
257 CALL section_release(subsubsection)
258 CALL create_velocity_section(subsubsection, "BAND")
259 CALL section_add_subsection(subsection, subsubsection)
260 CALL section_release(subsubsection)
261
262 CALL section_add_subsection(section, subsection)
263 CALL section_release(subsection)
264
265 ! Print key section
266 CALL cp_print_key_section_create(print_key, __location__, "program_run_info", &
267 description="Controls the printing basic info about the BAND run", &
268 print_level=medium_print_level, add_last=add_last_numeric, filename="__STD_OUT__")
269
270 CALL keyword_create(keyword, __location__, name="INITIAL_CONFIGURATION_INFO", &
271 description="Print information for the setup of the initial configuration.", &
272 usage="INITIAL_CONFIGURATION_INFO <LOGICAL>", &
273 default_l_val=.false., lone_keyword_l_val=.true.)
274 CALL section_add_keyword(print_key, keyword)
275 CALL keyword_release(keyword)
276
277 CALL section_add_subsection(section, print_key)
278 CALL section_release(print_key)
279
280 CALL cp_print_key_section_create(print_key, __location__, "convergence_info", &
281 description="Controls the printing of the convergence criteria during a BAND run", &
282 print_level=medium_print_level, add_last=add_last_numeric, filename="__STD_OUT__")
283 CALL section_add_subsection(section, print_key)
284 CALL section_release(print_key)
285
286 CALL cp_print_key_section_create(print_key, __location__, "replica_info", &
287 description="Controls the printing of each replica info during a BAND run", &
288 print_level=medium_print_level, add_last=add_last_numeric, filename="__STD_OUT__")
289 CALL section_add_subsection(section, print_key)
290 CALL section_release(print_key)
291
292 CALL cp_print_key_section_create(print_key, __location__, "ENERGY", &
293 description="Controls the printing of the ENER file in a BAND run", &
294 print_level=low_print_level, common_iter_levels=1, &
295 filename="")
296 CALL section_add_subsection(section, print_key)
297 CALL section_release(print_key)
298
299 CALL cp_print_key_section_create(print_key, __location__, "BANNER", &
300 description="Controls the printing of the BAND banner", &
301 print_level=low_print_level, common_iter_levels=1, &
302 filename="__STD_OUT__")
303 CALL section_add_subsection(section, print_key)
304 CALL section_release(print_key)
305 END SUBROUTINE create_band_section
306
307! **************************************************************************************************
308!> \brief creates the optimization section for a BAND run
309!> \param section will contain the pint section
310!> \author Teodoro Laino 02.2007 [tlaino]
311! **************************************************************************************************
312 SUBROUTINE create_opt_band_section(section)
313 TYPE(section_type), POINTER :: section
314
315 TYPE(keyword_type), POINTER :: keyword
316 TYPE(section_type), POINTER :: print_key, subsection, subsubsection
317
318 cpassert(ASSOCIATED(section))
319 NULLIFY (keyword, print_key, subsection, subsubsection)
320
321 CALL keyword_create(keyword, __location__, name="OPT_TYPE", &
322 description="Specifies the type optimizer used for the band", &
323 usage="OPT_TYPE (MD|DIIS)", &
324 default_i_val=band_diis_opt, &
325 enum_c_vals=s2a("MD", &
326 "DIIS"), &
327 enum_desc=s2a("Molecular dynamics-based optimizer", &
328 "Coupled steepest descent / direct inversion in the iterative subspace"), &
329 enum_i_vals=(/band_md_opt, band_diis_opt/))
330 CALL section_add_keyword(section, keyword)
331 CALL keyword_release(keyword)
332
333 CALL keyword_create(keyword, __location__, name="OPTIMIZE_END_POINTS", &
334 description="Performs also an optimization of the end points of the band.", &
335 default_l_val=.false., lone_keyword_l_val=.true.)
336 CALL section_add_keyword(section, keyword)
337 CALL keyword_release(keyword)
338
339 ! MD optimization section
340 CALL section_create(subsection, __location__, name="MD", &
341 description="Activate the MD based optimization procedure for BAND", &
342 repeats=.false.)
343
344 CALL keyword_create(keyword, __location__, name="MAX_STEPS", &
345 description="Specify the maximum number of MD steps", &
346 default_i_val=100)
347 CALL section_add_keyword(subsection, keyword)
348 CALL keyword_release(keyword)
349
350 CALL keyword_create( &
351 keyword, __location__, &
352 name="timestep", &
353 description="The length of an integration step", &
354 usage="timestep 1.0", &
355 default_r_val=cp_unit_to_cp2k(value=0.5_dp, &
356 unit_str="fs"), &
357 unit_str="fs")
358 CALL section_add_keyword(subsection, keyword)
359 CALL keyword_release(keyword)
360
361 CALL keyword_create(keyword, __location__, name="TEMPERATURE", &
362 description="Specify the initial temperature", &
363 default_r_val=cp_unit_to_cp2k(value=0.0_dp, &
364 unit_str="K"), &
365 unit_str="K")
366 CALL section_add_keyword(subsection, keyword)
367 CALL keyword_release(keyword)
368
369 ! Temp_control
370 CALL section_create(subsubsection, __location__, name="TEMP_CONTROL", &
371 description="Setup parameters to control the temperature during a BAND MD run.", &
372 repeats=.false.)
373 CALL keyword_create(keyword, __location__, name="TEMPERATURE", &
374 description="Specify the target temperature", &
375 type_of_var=real_t, unit_str="K")
376 CALL section_add_keyword(subsubsection, keyword)
377 CALL keyword_release(keyword)
378
379 CALL keyword_create(keyword, __location__, name="TEMP_TOL", &
380 description="Specify the tolerance on the temperature for rescaling", &
381 default_r_val=cp_unit_to_cp2k(value=0.0_dp, &
382 unit_str="K"), &
383 unit_str="K")
384 CALL section_add_keyword(subsubsection, keyword)
385 CALL keyword_release(keyword)
386
387 CALL keyword_create(keyword, __location__, name="TEMP_TOL_STEPS", &
388 description="Specify the number of steps to apply a temperature control", &
389 default_i_val=0)
390 CALL section_add_keyword(subsubsection, keyword)
391 CALL keyword_release(keyword)
392 CALL section_add_subsection(subsection, subsubsection)
393 CALL section_release(subsubsection)
394
395 ! Vel_control
396 CALL section_create(subsubsection, __location__, name="VEL_CONTROL", &
397 description="Setup parameters to control the velocity during a BAND MD run.", &
398 repeats=.false.)
399 CALL keyword_create(keyword, __location__, name="ANNEALING", &
400 description="Specify the annealing coefficient", &
401 default_r_val=1.0_dp)
402 CALL section_add_keyword(subsubsection, keyword)
403 CALL keyword_release(keyword)
404 CALL keyword_create(keyword, __location__, name="PROJ_VELOCITY_VERLET", &
405 description="Uses a Projected Velocity Verlet instead of a normal Velocity Verlet."// &
406 " Every time the cosine between velocities and forces is < 0 velocities are"// &
407 " zeroed.", &
408 usage="PROJ_VELOCITY_VERLET <LOGICAL>", &
409 default_l_val=.true., lone_keyword_l_val=.true.)
410 CALL section_add_keyword(subsubsection, keyword)
411 CALL keyword_release(keyword)
412 CALL keyword_create(keyword, __location__, name="SD_LIKE", &
413 description="Zeros velocity at each MD step emulating a steepest descent like "// &
414 "(SD_LIKE) approach", &
415 usage="SD_LIKE <LOGICAL>", &
416 default_l_val=.false., lone_keyword_l_val=.true.)
417 CALL section_add_keyword(subsubsection, keyword)
418 CALL keyword_release(keyword)
419 CALL section_add_subsection(subsection, subsubsection)
420 CALL section_release(subsubsection)
421 ! End of MD
422 CALL section_add_subsection(section, subsection)
423 CALL section_release(subsection)
424
425 ! DIIS optimization section
426 CALL section_create(subsection, __location__, name="DIIS", &
427 description="Activate the DIIS based optimization procedure for BAND", &
428 repeats=.false.)
429
430 CALL keyword_create(keyword, __location__, name="MAX_SD_STEPS", &
431 description="Specify the maximum number of SD steps to perform"// &
432 " before switching on DIIS (the minimum number will always be equal to N_DIIS).", &
433 default_i_val=1)
434 CALL section_add_keyword(subsection, keyword)
435 CALL keyword_release(keyword)
436
437 CALL keyword_create(keyword, __location__, name="MAX_STEPS", &
438 description="Specify the maximum number of optimization steps", &
439 default_i_val=100)
440 CALL section_add_keyword(subsection, keyword)
441 CALL keyword_release(keyword)
442
443 CALL keyword_create(keyword, __location__, name="N_DIIS", &
444 variants=(/"NDIIS"/), &
445 description="Number of history vectors to be used with DIIS", &
446 usage="N_DIIS 4", &
447 default_i_val=7)
448 CALL section_add_keyword(subsection, keyword)
449 CALL keyword_release(keyword)
450
451 CALL keyword_create(keyword, __location__, name="STEPSIZE", &
452 description="Initial stepsize used for the line search, sometimes this parameter "// &
453 "can be reduced to stabilize DIIS", &
454 usage="STEPSIZE <REAL>", &
455 default_r_val=1.0_dp)
456 CALL section_add_keyword(subsection, keyword)
457 CALL keyword_release(keyword)
458
459 CALL keyword_create(keyword, __location__, name="MAX_STEPSIZE", &
460 description="Maximum stepsize used for the line search, sometimes this parameter "// &
461 "can be reduced to stabilize the LS for particularly difficult initial geometries", &
462 usage="MAX_STEPSIZE <REAL>", &
463 default_r_val=2.0_dp)
464 CALL section_add_keyword(subsection, keyword)
465 CALL keyword_release(keyword)
466
467 CALL keyword_create(keyword, __location__, name="NP_LS", &
468 description="Number of points used in the line search SD.", &
469 usage="NP_LS <INTEGER>", &
470 default_i_val=2)
471 CALL section_add_keyword(subsection, keyword)
472 CALL keyword_release(keyword)
473
474 CALL keyword_create(keyword, __location__, name="NO_LS", &
475 description="Does not perform LS during SD. Useful in combination with a proper STEPSIZE"// &
476 " for particularly out of equilibrium starting geometries.", &
477 default_l_val=.false., lone_keyword_l_val=.true.)
478 CALL section_add_keyword(subsection, keyword)
479 CALL keyword_release(keyword)
480
481 CALL keyword_create(keyword, __location__, name="CHECK_DIIS", &
482 description="Performs a series of checks on the DIIS solution in order to accept the DIIS step."// &
483 " If set to .FALSE. the only check performed is that the angle between the DIIS solution and the"// &
484 " reference vector is less than Pi/2. Can be useful if many DIIS steps are rejected.", &
485 default_l_val=.true., lone_keyword_l_val=.true.)
486 CALL section_add_keyword(subsection, keyword)
487 CALL keyword_release(keyword)
488
489 CALL cp_print_key_section_create(print_key, __location__, "diis_info", &
490 description="Controls the printing of DIIS info during a BAND run", &
491 print_level=high_print_level, add_last=add_last_numeric, filename="__STD_OUT__")
492 CALL section_add_subsection(subsection, print_key)
493 CALL section_release(print_key)
494
495 CALL section_add_subsection(section, subsection)
496 CALL section_release(subsection)
497 END SUBROUTINE create_opt_band_section
498
499END MODULE input_cp2k_neb
collects all references to literature in CP2K as new algorithms / method are included from literature...
integer, save, public elber1987
integer, save, public jonsson2000_1
integer, save, public jonsson1998
integer, save, public jonsson2000_2
integer, save, public wales2004
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
integer, parameter, public low_print_level
integer, parameter, public medium_print_level
integer, parameter, public high_print_level
integer, parameter, public add_last_numeric
subroutine, public cp_print_key_section_create(print_key_section, location, name, description, print_level, each_iter_names, each_iter_values, add_last, filename, common_iter_levels, citations, unit_str)
creates a print_key section
unit conversion facility
Definition cp_units.F:30
real(kind=dp) function, public cp_unit_to_cp2k(value, unit_str, defaults, power)
converts to the internal cp2k units to the given unit
Definition cp_units.F:1150
collects all constants needed in input so that they can be used without circular dependencies
integer, parameter, public pot_neb_me
integer, parameter, public band_md_opt
integer, parameter, public pot_neb_fe
integer, parameter, public do_rep_interleaved
integer, parameter, public do_rep_blocked
integer, parameter, public do_sm
integer, parameter, public do_b_neb
integer, parameter, public do_d_neb
integer, parameter, public do_eb
integer, parameter, public band_diis_opt
integer, parameter, public do_ci_neb
integer, parameter, public do_it_neb
integer, parameter, public pot_neb_full
subroutine, public create_band_section(section)
creates the section for a BAND run
subroutine, public create_coord_section(section, name)
Creates the coord section.
subroutine, public create_velocity_section(section, name)
Creates the velocity section.
represents keywords in an input
subroutine, public keyword_release(keyword)
releases the given keyword (see doc/ReferenceCounting.html)
subroutine, public keyword_create(keyword, location, name, description, usage, type_of_var, n_var, repeats, variants, default_val, default_l_val, default_r_val, default_lc_val, default_c_val, default_i_val, default_l_vals, default_r_vals, default_c_vals, default_i_vals, lone_keyword_val, lone_keyword_l_val, lone_keyword_r_val, lone_keyword_c_val, lone_keyword_i_val, lone_keyword_l_vals, lone_keyword_r_vals, lone_keyword_c_vals, lone_keyword_i_vals, enum_c_vals, enum_i_vals, enum, enum_strict, enum_desc, unit_str, citations, deprecation_notice, removed)
creates a keyword object
objects that represent the structure of input sections and the data contained in an input section
subroutine, public section_create(section, location, name, description, n_keywords, n_subsections, repeats, citations)
creates a list of keywords
subroutine, public section_add_keyword(section, keyword)
adds a keyword to the given section
subroutine, public section_add_subsection(section, subsection)
adds a subsection to the given section
recursive subroutine, public section_release(section)
releases the given keyword list (see doc/ReferenceCounting.html)
a wrapper for basic fortran types.
integer, parameter, public real_t
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