(git:58e3e09)
input_cp2k_eip.F
Go to the documentation of this file.
1 !--------------------------------------------------------------------------------------------------!
2 ! CP2K: A general program to perform molecular dynamics simulations !
3 ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 ! !
5 ! SPDX-License-Identifier: GPL-2.0-or-later !
6 !--------------------------------------------------------------------------------------------------!
7 
8 ! **************************************************************************************************
9 !> \brief Creates the EIP section of the input
10 !> \par History
11 !> 03.2006 created
12 !> \author Thomas D. Kuehne (tkuehne@phys.chem.ethz.ch)
13 ! **************************************************************************************************
18  USE input_constants, ONLY: use_bazant_eip,&
22  keyword_type
27  section_type
28  USE input_val_types, ONLY: enum_t
29  USE string_utilities, ONLY: s2a
30 #include "./base/base_uses.f90"
31 
32  IMPLICIT NONE
33  PRIVATE
34 
35  LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .true.
36  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_cp2k_eip'
37 
38  PUBLIC :: create_eip_section
39 
40 CONTAINS
41 
42 ! **************************************************************************************************
43 !> \brief Create the input section for EIP
44 !> \param section the section to create
45 !> \par History
46 !> 03.2006 created
47 !> \author Thomas D. Kuehne (tkuehne@phys.chem.ethz.ch)
48 ! **************************************************************************************************
49  SUBROUTINE create_eip_section(section)
50  TYPE(section_type), POINTER :: section
51 
52  TYPE(keyword_type), POINTER :: keyword
53  TYPE(section_type), POINTER :: subsection
54 
55 ! ------------------------------------------------------------------------
56 
57  cpassert(.NOT. ASSOCIATED(section))
58  CALL section_create(section, __location__, name="EIP", &
59  description="This section contains all information to run an "// &
60  "Empirical Interatomic Potential (EIP) calculation.", &
61  n_keywords=1, n_subsections=1, repeats=.false.)
62 
63  NULLIFY (subsection, keyword)
64 
65  CALL keyword_create(keyword, __location__, name="EIP_MODEL", &
66  description="Selects the empirical interaction potential model", &
67  usage="EIP_MODEL BAZANT", type_of_var=enum_t, &
68  n_var=1, repeats=.false., variants=(/"EIP-MODEL"/), &
69  enum_c_vals=s2a("BAZANT", "EDIP", "LENOSKY"), &
70  enum_i_vals=(/use_bazant_eip, use_bazant_eip, use_lenosky_eip/), &
71  enum_desc=s2a("Bazant potentials", &
72  "Environment-Dependent Interatomic Potential", &
73  "Lenosky potentials"), &
74  default_i_val=use_lenosky_eip)
75  CALL section_add_keyword(section, keyword)
76  CALL keyword_release(keyword)
77 
78  CALL create_eip_print_section(subsection)
79  CALL section_add_subsection(section, subsection)
80  CALL section_release(subsection)
81 
82  END SUBROUTINE create_eip_section
83 
84 ! **************************************************************************************************
85 !> \brief Creates the print section for the eip subsection
86 !> \param section the section to create
87 !> \par History
88 !> 03.2006 created
89 !> \author Thomas D. Kuehne (tkuehne@phys.chem.ethz.ch)
90 ! **************************************************************************************************
91  SUBROUTINE create_eip_print_section(section)
92  TYPE(section_type), POINTER :: section
93 
94  TYPE(section_type), POINTER :: print_key
95 
96 ! ------------------------------------------------------------------------
97 
98  cpassert(.NOT. ASSOCIATED(section))
99  CALL section_create(section, __location__, name="PRINT", &
100  description="Section of possible print options in EIP code.", &
101  n_keywords=0, n_subsections=6, repeats=.false.)
102 
103  NULLIFY (print_key)
104 
105  CALL cp_print_key_section_create(print_key, __location__, "ENERGIES", &
106  description="Controls the printing of the EIP energies.", &
107  print_level=medium_print_level, filename="__STD_OUT__")
108  CALL section_add_subsection(section, print_key)
109  CALL section_release(print_key)
110 
111  CALL cp_print_key_section_create(print_key, __location__, "ENERGIES_VAR", &
112  description="Controls the printing of the variance of the EIP energies.", &
113  print_level=high_print_level, filename="__STD_OUT__")
114  CALL section_add_subsection(section, print_key)
115  CALL section_release(print_key)
116 
117  CALL cp_print_key_section_create(print_key, __location__, "FORCES", &
118  description="Controls the printing of the EIP forces.", &
119  print_level=medium_print_level, filename="__STD_OUT__")
120  CALL section_add_subsection(section, print_key)
121  CALL section_release(print_key)
122 
123  CALL cp_print_key_section_create(print_key, __location__, "COORD_AVG", &
124  description="Controls the printing of the average coordination number.", &
125  print_level=high_print_level, filename="__STD_OUT__")
126  CALL section_add_subsection(section, print_key)
127  CALL section_release(print_key)
128 
129  CALL cp_print_key_section_create(print_key, __location__, "COORD_VAR", &
130  description="Controls the printing of the variance of the coordination number.", &
131  print_level=high_print_level, filename="__STD_OUT__")
132  CALL section_add_subsection(section, print_key)
133  CALL section_release(print_key)
134 
135  CALL cp_print_key_section_create(print_key, __location__, "COUNT", &
136  description="Controls the printing of the number of function calls.", &
137  print_level=high_print_level, filename="__STD_OUT__")
138  CALL section_add_subsection(section, print_key)
139  CALL section_release(print_key)
140 
141  END SUBROUTINE create_eip_print_section
142 
143 END MODULE input_cp2k_eip
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
integer, parameter, public medium_print_level
integer, parameter, public high_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 use_bazant_eip
integer, parameter, public use_lenosky_eip
Creates the EIP section of the input.
subroutine, public create_eip_section(section)
Create the input section for EIP.
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 enum_t
Utilities for string manipulations.