1!--------------------------------------------------------------------------------------------------!
2!   CP2K: A general program to perform molecular dynamics simulations                              !
3!   Copyright (C) 2000 - 2019  CP2K developers group                                               !
4!--------------------------------------------------------------------------------------------------!
5!
6! **************************************************************************************************
7! > \brief Creates the PW section of the input
8! > \par History
9! >      07.2018 created
10! > \author JHU
11! **************************************************************************************************
12
13MODULE input_cp2k_pwdft
14#if defined(__SIRIUS)
15   USE SIRIUS, ONLY: &
16      sirius_option_get_description_usage, sirius_option_get_double, sirius_option_get_int, &
17      sirius_option_get_length, sirius_option_get_logical, sirius_option_get_name_and_type, &
18      sirius_option_get_number_of_possible_values, sirius_option_get_string, &
19      sirius_option_string_get_value
20#endif
21   USE input_keyword_types, ONLY: keyword_create, &
22                                  keyword_release, &
23                                  keyword_type
24   USE input_section_types, ONLY: section_add_keyword, &
25                                  section_add_subsection, &
26                                  section_create, &
27                                  section_release, &
28                                  section_type
29   USE kinds, ONLY: dp
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_pwdft'
37
38   PUBLIC :: create_pwdft_section
39
40CONTAINS
41
42#if defined(__SIRIUS)
43! **************************************************************************************************
44!> \brief Create the input section for PW calculations using SIRIUS
45!> \param section the section to create
46!> \par History
47!>      07.2018 created
48!> \author JHU
49! **************************************************************************************************
50   SUBROUTINE create_pwdft_section(section)
51      TYPE(section_type), POINTER                        :: section
52
53      CHARACTER(len=*), PARAMETER :: routineN = 'create_pwdft_section', &
54         routineP = moduleN//':'//routineN
55
56      CHARACTER(len=32)                                  :: section_name
57      TYPE(section_type), POINTER                        :: subsection
58
59!     ------------------------------------------------------------------------
60
61      CPASSERT(.NOT. ASSOCIATED(section))
62      CALL section_create(section, __LOCATION__, name="PW_DFT", &
63                          description="DFT calculation using plane waves basis can be set in this section. "// &
64                          "The backend called SIRIUS, computes the basic properties of the system, "// &
65                          "such as ground state, forces and stresses tensors which can be used by "// &
66                          "cp2k afterwards. The engine has all these features build-in, support of "// &
67                          "pseudo-potentials and full-potentials, spin-orbit coupling, collinear and "// &
68                          "non collinear magnetism, Hubbard correction, all exchange functionals "// &
69                          "supported by libxc and Van der Waals corrections (libvdwxc).")
70
71      NULLIFY (subsection)
72      section_name = ''
73      section_name = 'control'
74      CALL create_sirius_section(subsection, section_name)
75      CALL section_add_subsection(section, subsection)
76      CALL section_release(subsection)
77      section_name = ''
78      section_name = 'parameters'
79
80      CALL create_sirius_section(subsection, section_name)
81      CALL section_add_subsection(section, subsection)
82      CALL section_release(subsection)
83      section_name = ''
84      section_name = 'mixer'
85
86      CALL create_sirius_section(subsection, section_name)
87      CALL section_add_subsection(section, subsection)
88      CALL section_release(subsection)
89      section_name = ''
90      section_name = 'iterative_solver'
91
92      CALL create_sirius_section(subsection, section_name)
93      CALL section_add_subsection(section, subsection)
94      CALL section_release(subsection)
95
96   END SUBROUTINE create_pwdft_section
97
98! **************************************************************************************************
99!> \brief input section for PWDFT control
100!> \param section will contain the CONTROL section
101!> \param section_name ...
102!> \author JHU
103! **************************************************************************************************
104   SUBROUTINE create_sirius_section(section, section_name)
105      TYPE(section_type), POINTER                        :: section
106      CHARACTER(len=32), INTENT(in)                      :: section_name
107
108      CHARACTER(len=*), PARAMETER :: routineN = 'create_sirius_section', &
109         routineP = moduleN//':'//routineN
110
111      INTEGER                                            :: length
112
113      CPASSERT(.NOT. ASSOCIATED(section))
114      CALL sirius_option_get_length(TRIM(ADJUSTL(section_name))//CHAR(0), length)
115      CALL section_create(section, __LOCATION__, &
116                          name=TRIM(ADJUSTL(section_name)), &
117                          description=TRIM(section_name)//" section", &
118                          n_subsections=0, &
119                          n_keywords=length, &
120                          repeats=.FALSE.)
121
122      CALL fill_in_section(section, TRIM(ADJUSTL(section_name))//CHAR(0))
123   END SUBROUTINE create_sirius_section
124
125! **************************************************************************************************
126!> \brief ...
127!> \param section ...
128!> \param section_name ...
129! **************************************************************************************************
130   SUBROUTINE fill_in_section(section, section_name)
131      TYPE(section_type), POINTER                        :: section
132      CHARACTER(len=32), INTENT(in)                      :: section_name
133
134      CHARACTER(len=*), PARAMETER :: routineN = 'fill_in_section', &
135         routineP = moduleN//':'//routineN
136
137      CHARACTER(len=128)                                 :: name, name1, possible_values(1:16)
138      CHARACTER(len=512)                                 :: default_string_val, description, usage
139      INTEGER                                            :: ctype, dummy_i, enum_i_val(1:16), i, j, &
140                                                            length, num_possible_values, vec_length
141      INTEGER, ALLOCATABLE, DIMENSION(:)                 :: ivec
142      LOGICAL                                            :: lvecl(1:16)
143      LOGICAL(1)                                         :: dummy_l
144      LOGICAL(1), ALLOCATABLE, DIMENSION(:)              :: lvec
145      REAL(kind=dp)                                      :: dummy_r
146      REAL(kind=dp), ALLOCATABLE, DIMENSION(:)           :: rvec
147      TYPE(keyword_type), POINTER                        :: keyword
148
149      ALLOCATE (ivec(1:16))
150      ALLOCATE (rvec(1:16))
151      ALLOCATE (lvec(1:16))
152      CALL sirius_option_get_length(section_name, length)
153      DO i = 0, length - 1
154         NULLIFY (keyword)
155         name = CHAR(0)
156         ! return a non null terminated string. Stupid fortran does not understand the \0 terminated string when comparing things
157         CALL sirius_option_get_name_and_type(section_name, i, name, ctype)
158
159!     do not invert these two lines
160         name1 = TRIM(ADJUSTL(name))
161
162!     we need to null char since SIRIUS interface is basically C
163         name = TRIM(ADJUSTL(name))//CHAR(0)
164         description = CHAR(0)
165         usage = CHAR(0)
166         CALL sirius_option_get_description_usage(section_name, name, description, usage)
167         SELECT CASE (ctype)
168         CASE (1)
169            CALL sirius_option_get_int(section_name, name, dummy_i, vec_length)
170            CALL keyword_create(keyword, __LOCATION__, &
171                                name=TRIM(name1), &
172                                description=TRIM(ADJUSTL(description)), &
173                                usage=TRIM(ADJUSTL(usage)), &
174                                repeats=.FALSE., &
175                                default_i_val=dummy_i)
176         CASE (11)
177            CALL sirius_option_get_int(section_name, name, ivec(1), vec_length)
178            CALL keyword_create(keyword, __LOCATION__, &
179                                name=name1, &
180                                description=TRIM(ADJUSTL(description)), &
181                                usage=TRIM(ADJUSTL(usage)), &
182                                repeats=.FALSE., &
183                                n_var=vec_length, &
184                                default_i_vals=ivec(1:vec_length))
185         CASE (2)
186            CALL sirius_option_get_double(section_name, name, dummy_r, vec_length)
187            CALL keyword_create(keyword, __LOCATION__, &
188                                name=name1, &
189                                description=TRIM(ADJUSTL(description)), &
190                                usage=TRIM(ADJUSTL(usage)), &
191                                repeats=.FALSE., &
192                                default_r_val=dummy_r)
193         CASE (12)
194            CALL sirius_option_get_double(section_name, name, rvec(1), vec_length)
195            CALL keyword_create(keyword, __LOCATION__, &
196                                name=name1, &
197                                description=TRIM(ADJUSTL(description)), &
198                                usage=TRIM(ADJUSTL(usage)), &
199                                repeats=.FALSE., &
200                                n_var=vec_length, &
201                                default_r_vals=rvec(1:vec_length))
202         CASE (3)
203            CALL sirius_option_get_logical(section_name, name, dummy_l, vec_length)
204            IF (dummy_l) THEN
205               CALL keyword_create(keyword, __LOCATION__, &
206                                   name=name1, &
207                                   description=TRIM(ADJUSTL(description)), &
208                                   usage=TRIM(ADJUSTL(usage)), &
209                                   repeats=.FALSE., &
210                                   default_l_val=.TRUE., &
211                                   lone_keyword_l_val=.TRUE.)
212            ELSE
213               CALL keyword_create(keyword, __LOCATION__, &
214                                   name=name1, &
215                                   description=TRIM(ADJUSTL(description)), &
216                                   usage=TRIM(ADJUSTL(usage)), &
217                                   repeats=.FALSE., &
218                                   default_l_val=.FALSE., &
219                                   lone_keyword_l_val=.TRUE.)
220            ENDIF
221         CASE (13)
222            CALL sirius_option_get_logical(section_name, name, lvec(1), vec_length)
223            DO j = 1, vec_length
224               lvecl(j) = lvec(j)
225            ENDDO
226            CALL keyword_create(keyword, __LOCATION__, &
227                                name=name1, &
228                                description=TRIM(ADJUSTL(description)), &
229                                usage=TRIM(ADJUSTL(usage)), &
230                                repeats=.FALSE., &
231                                n_var=vec_length, &
232                                default_l_vals=lvecl(1:vec_length))
233         CASE (4)
234            !     string need a special treatment because the parameters can only have dedicated values
235            default_string_val = CHAR(0)
236            CALL sirius_option_get_string(section_name, name, default_string_val)
237            default_string_val = TRIM(ADJUSTL(default_string_val))
238            CALL sirius_option_get_number_of_possible_values(section_name, name, num_possible_values)
239            IF (num_possible_values > 0) THEN
240               DO j = 0, num_possible_values - 1
241                  possible_values(j + 1) = CHAR(0)
242                  CALL sirius_option_string_get_value(section_name, name, j, possible_values(j + 1))
243                  enum_i_val(j + 1) = j
244               END DO
245               CALL keyword_create(keyword, __LOCATION__, &
246                                   name=name1, &
247                                   description=TRIM(ADJUSTL(description)), &
248                                   usage=TRIM(ADJUSTL(usage)), &
249                                   repeats=.FALSE., &
250                                   enum_i_vals=enum_i_val(1:num_possible_values), &
251                                   enum_c_vals=possible_values(1:num_possible_values), &
252                                   default_i_val=0)
253            ELSE
254               CALL keyword_create(keyword, __LOCATION__, &
255                                   name=name1, &
256                                   description=TRIM(ADJUSTL(description)), &
257                                   usage=TRIM(ADJUSTL(usage)), &
258                                   repeats=.FALSE.)
259            END IF
260         CASE default
261         END SELECT
262         CALL section_add_keyword(section, keyword)
263         CALL keyword_release(keyword)
264      END DO
265   END SUBROUTINE fill_in_section
266#else
267! **************************************************************************************************
268!> \brief ...
269!> \param section ...
270! **************************************************************************************************
271   SUBROUTINE create_pwdft_section(section)
272      TYPE(section_type), POINTER                        :: section
273
274      CHARACTER(len=*), PARAMETER :: routineN = 'create_pwdft_section', &
275         routineP = moduleN//':'//routineN
276
277      CPASSERT(.NOT. ASSOCIATED(section))
278
279      CALL section_create(section, __LOCATION__, name="PW_DFT", &
280                          description="This section contains all information to run an "// &
281                          "SIRIUS PW calculation.", &
282                          n_subsections=0, &
283                          repeats=.FALSE.)
284
285   END SUBROUTINE create_pwdft_section
286
287#endif
288
289END MODULE input_cp2k_pwdft
290