1!--------------------------------------------------------------------------------------------------!
2!   CP2K: A general program to perform molecular dynamics simulations                              !
3!   Copyright (C) 2000 - 2019  CP2K developers group                                               !
4!--------------------------------------------------------------------------------------------------!
5
6! **************************************************************************************************
7!> \brief builds the input structure for the EMBED environment: clone of MIXED environment
8!> \author Vladimir Rybkin - University of Zurich
9! **************************************************************************************************
10MODULE input_cp2k_embed
11   USE bibliography,                    ONLY: Heaton_Burgess2007,&
12                                              Huang2011
13   USE cp_output_handling,              ONLY: add_last_numeric,&
14                                              cp_print_key_section_create,&
15                                              low_print_level
16   USE input_constants,                 ONLY: dfet,&
17                                              dmfet
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: integer_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_embed'
35
36   PUBLIC :: create_embed_section
37
38CONTAINS
39
40! **************************************************************************************************
41!> \brief Create the input section for EMBED: clone of the subroutines for MIXED
42!> \param section the section to create
43!> \author Vladimir Rybkin
44! **************************************************************************************************
45   SUBROUTINE create_embed_section(section)
46      TYPE(section_type), POINTER                        :: section
47
48      CHARACTER(len=*), PARAMETER :: routineN = 'create_embed_section', &
49         routineP = moduleN//':'//routineN
50
51      TYPE(keyword_type), POINTER                        :: keyword
52      TYPE(section_type), POINTER                        :: sub2section, sub3section, subsection
53
54      CPASSERT(.NOT. ASSOCIATED(section))
55      CALL section_create(section, __LOCATION__, name="EMBED", &
56                          description="This section contains all information to run embedded "// &
57                          "calculations.", &
58                          n_keywords=1, n_subsections=0, repeats=.FALSE., &
59                          citations=(/Huang2011, Heaton_Burgess2007/))
60      NULLIFY (keyword, subsection)
61
62      CALL keyword_create(keyword, __LOCATION__, name="EMBED_METHOD", &
63                          description="Select DFET or DMFET.", &
64                          usage="EMBED_METHOD DFET", &
65                          default_i_val=dfet, &
66                          enum_c_vals=s2a("DFET", "DMFET"), &
67                          enum_desc=s2a("DFET", "DMFET"), &
68                          enum_i_vals=(/dfet, dmfet/))
69      CALL section_add_keyword(section, keyword)
70      CALL keyword_release(keyword)
71
72      ! Group partitioning
73      CALL keyword_create(keyword, __LOCATION__, name="GROUP_PARTITION", &
74                          description="gives the exact number of processors for each group."// &
75                          " If not specified processors allocated will be equally distributed for"// &
76                          " the specified subforce_eval, trying to build a number of groups equal to the"// &
77                          " number of subforce_eval specified.", &
78                          usage="group_partition  2 2 4 2 4 ", type_of_var=integer_t, n_var=-1)
79      CALL section_add_keyword(section, keyword)
80      CALL keyword_release(keyword)
81
82      CALL keyword_create(keyword, __LOCATION__, name="NGROUPS", variants=(/"NGROUP"/), &
83                          description="Gives the wanted number of groups. Currently must be set to 1", &
84                          usage="ngroups 4", type_of_var=integer_t, default_i_val=1)
85      CALL section_add_keyword(section, keyword)
86      CALL keyword_release(keyword)
87
88      ! Mapping of atoms
89      NULLIFY (sub2section, sub3section)
90      CALL section_create(subsection, __LOCATION__, name="MAPPING", &
91                          description="Defines the mapping of atoms for the different force_eval with the mixed force_eval."// &
92                          " The default is to have a mapping 1-1 between atom index (i.e. all force_eval share the same"// &
93                          " geometrical structure). The mapping is based on defining fragments and the mapping the "// &
94                          " fragments between the several force_eval and the mixed force_eval", &
95                          n_keywords=1, n_subsections=0, repeats=.TRUE.)
96
97      ! Mixed force_eval
98      CALL section_create(sub2section, __LOCATION__, name="FORCE_EVAL_EMBED", &
99                          description="Defines the fragments for the embedding force_eval (reference)", &
100                          n_keywords=1, n_subsections=0, repeats=.TRUE.)
101
102      CALL section_create(sub3section, __LOCATION__, name="FRAGMENT", &
103                          description="Fragment definition", &
104                          n_keywords=1, n_subsections=0, repeats=.TRUE.)
105
106      CALL keyword_create(keyword, __LOCATION__, name="_SECTION_PARAMETERS_", &
107                          description="Defines the index of the fragment defined", &
108                          usage="<INTEGER>", type_of_var=integer_t, n_var=1)
109      CALL section_add_keyword(sub3section, keyword)
110      CALL keyword_release(keyword)
111
112      CALL keyword_create(keyword, __LOCATION__, name="_DEFAULT_KEYWORD_", &
113                          description="Starting and ending atomic index defining one fragment must be provided", &
114                          usage="{Integer} {Integer}", type_of_var=integer_t, n_var=2, repeats=.TRUE.)
115      CALL section_add_keyword(sub3section, keyword)
116      CALL keyword_release(keyword)
117
118      CALL section_add_subsection(sub2section, sub3section)
119      CALL section_release(sub3section)
120      CALL section_add_subsection(subsection, sub2section)
121      CALL section_release(sub2section)
122
123      ! All other force_eval
124      CALL section_create(sub2section, __LOCATION__, name="FORCE_EVAL", &
125                          description="Defines the fragments and the mapping for each force_eval (an integer index (ID) "// &
126                          "needs to be provided as parameter)", &
127                          n_keywords=1, n_subsections=0, repeats=.TRUE.)
128
129      CALL keyword_create( &
130         keyword, __LOCATION__, name="DEFINE_FRAGMENTS", &
131         description="Specify the fragments definition of the force_eval through the fragments of the"// &
132         " force_eval_embed. This avoids the pedantic definition of the fragments for the force_eval,"// &
133         " assuming the order of the fragments for the specified force_eval is the same as the sequence "// &
134         " of integers provided. Easier to USE should be preferred to the specification of the single fragments.", &
135         usage="DEFINE_FRAGMENTS <INTEGER> .. <INTEGER>", type_of_var=integer_t, n_var=-1)
136      CALL section_add_keyword(sub2section, keyword)
137      CALL keyword_release(keyword)
138
139      CALL keyword_create(keyword, __LOCATION__, name="_SECTION_PARAMETERS_", &
140                          description="Defines the index of the force_eval for which fragments and mappings are provided", &
141                          usage="<INTEGER>", type_of_var=integer_t, n_var=1)
142      CALL section_add_keyword(sub2section, keyword)
143      CALL keyword_release(keyword)
144
145      CALL section_create(sub3section, __LOCATION__, name="FRAGMENT", &
146                          description="Fragment definition", &
147                          n_keywords=1, n_subsections=0, repeats=.TRUE.)
148
149      CALL keyword_create(keyword, __LOCATION__, name="_SECTION_PARAMETERS_", &
150                          description="Defines the index of the fragment defined", &
151                          usage="<INTEGER>", type_of_var=integer_t, n_var=1)
152      CALL section_add_keyword(sub3section, keyword)
153      CALL keyword_release(keyword)
154
155      CALL keyword_create(keyword, __LOCATION__, name="_DEFAULT_KEYWORD_", &
156                          description="Starting and ending atomic index defining one fragment must be provided", &
157                          usage="{Integer} {Integer}", type_of_var=integer_t, n_var=2, repeats=.FALSE.)
158      CALL section_add_keyword(sub3section, keyword)
159      CALL keyword_release(keyword)
160
161      CALL keyword_create(keyword, __LOCATION__, name="MAP", &
162                          description="Provides the index of the fragment of the MIXED force_eval mapped on the"// &
163                          " locally defined fragment.", &
164                          usage="MAP <INTEGER>", type_of_var=integer_t, n_var=1, repeats=.FALSE.)
165      CALL section_add_keyword(sub3section, keyword)
166      CALL keyword_release(keyword)
167
168      CALL section_add_subsection(sub2section, sub3section)
169      CALL section_release(sub3section)
170      CALL section_add_subsection(subsection, sub2section)
171      CALL section_release(sub2section)
172
173      CALL section_add_subsection(section, subsection)
174      CALL section_release(subsection)
175
176      CALL create_print_embed_section(subsection)
177      CALL section_add_subsection(section, subsection)
178      CALL section_release(subsection)
179   END SUBROUTINE create_embed_section
180
181! **************************************************************************************************
182!> \brief Create the print section for embedding
183!> \param section the section to create
184!> \author Vladimir Rybkin
185! **************************************************************************************************
186   SUBROUTINE create_print_embed_section(section)
187      TYPE(section_type), POINTER                        :: section
188
189      CHARACTER(len=*), PARAMETER :: routineN = 'create_print_embed_section', &
190         routineP = moduleN//':'//routineN
191
192      TYPE(section_type), POINTER                        :: print_key
193
194      CPASSERT(.NOT. ASSOCIATED(section))
195      CALL section_create(section, __LOCATION__, name="print", &
196                          description="Section of possible print options in EMBED env.", &
197                          n_keywords=0, n_subsections=1, repeats=.FALSE.)
198
199      NULLIFY (print_key)
200
201      CALL cp_print_key_section_create(print_key, __LOCATION__, "PROGRAM_RUN_INFO", &
202                                       description="Controls the printing of information during the evaluation of "// &
203                                       "the embedding environment. ", &
204                                       print_level=low_print_level, add_last=add_last_numeric, filename="__STD_OUT__")
205      CALL section_add_subsection(section, print_key)
206      CALL section_release(print_key)
207
208   END SUBROUTINE create_print_embed_section
209
210END MODULE input_cp2k_embed
211