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