(git:97501a3)
Loading...
Searching...
No Matches
input_cp2k_pwdft.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7!
8! **************************************************************************************************
9! > \brief Creates the PW section of the input
10! > \par History
11! > 07.2018 created
12! > \author JHU
13! **************************************************************************************************
14
16#if defined(__SIRIUS)
17 USE iso_c_binding, ONLY: c_loc
18 USE sirius, ONLY: &
19 sirius_option_get, &
20 sirius_option_get_section_length, sirius_option_get_info, &
21 sirius_integer_type, sirius_number_type, sirius_string_type, &
22 sirius_logical_type, sirius_array_type, sirius_integer_array_type, sirius_logical_array_type, &
23 sirius_number_array_type, sirius_string_array_type, string_f2c
24#endif
33 USE input_val_types, ONLY: char_t, &
34 integer_t, &
35 lchar_t, &
36 logical_t, &
37 real_t
45 USE kinds, ONLY: dp
46 USE string_utilities, ONLY: s2a
47#include "./base/base_uses.f90"
48
49 IMPLICIT NONE
50 PRIVATE
51
52 LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .true.
53 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'input_cp2k_pwdft'
54
55 PUBLIC :: create_pwdft_section
56
57 INTEGER, PARAMETER, PUBLIC :: sirius_no_vdw = -1
58 INTEGER, PARAMETER, PUBLIC :: sirius_func_vdwdf = 1
59 INTEGER, PARAMETER, PUBLIC :: sirius_func_vdwdf2 = 2
60 INTEGER, PARAMETER, PUBLIC :: sirius_func_vdwdfcx = 3
61
62CONTAINS
63
64#if defined(__SIRIUS)
65! **************************************************************************************************
66!> \brief Create the input section for PW calculations using SIRIUS
67!> \param section the section to create
68!> \par History
69!> 07.2018 created
70!> \author JHU
71! **************************************************************************************************
72 SUBROUTINE create_pwdft_section(section)
73 TYPE(section_type), POINTER :: section
74
75 TYPE(keyword_type), POINTER :: keyword
76 TYPE(section_type), POINTER :: subsection
77
78! ------------------------------------------------------------------------
79
80 cpassert(.NOT. ASSOCIATED(section))
81 CALL section_create(section, __location__, name="PW_DFT", &
82 description="DFT calculation using plane waves basis can be set in this section. "// &
83 "The backend called SIRIUS, computes the basic properties of the system, "// &
84 "such as ground state, forces and stresses tensors which can be used by "// &
85 "cp2k afterwards. The engine has all these features build-in, support of "// &
86 "pseudo-potentials and full-potentials, spin-orbit coupling, collinear and "// &
87 "non collinear magnetism, Hubbard correction, all exchange functionals "// &
88 "supported by libxc and Van der Waals corrections (libvdwxc).")
89
90 NULLIFY (keyword)
91 CALL keyword_create(keyword, __location__, &
92 name='ignore_convergence_failure', &
93 description="when set to true, calculation will continue irrespectively "// &
94 "of the convergence status of SIRIUS", &
95 type_of_var=logical_t, &
96 repeats=.false., &
97 default_l_val=.false., &
98 lone_keyword_l_val=.true.)
99 CALL section_add_keyword(section, keyword)
100 CALL keyword_release(keyword)
101
102 NULLIFY (subsection)
103 CALL create_sirius_section(subsection, 'control')
104 CALL section_add_subsection(section, subsection)
105 CALL section_release(subsection)
106
107 CALL create_sirius_section(subsection, 'parameters')
108 CALL section_add_subsection(section, subsection)
109 CALL section_release(subsection)
110
111 CALL create_sirius_section(subsection, 'settings')
112 CALL section_add_subsection(section, subsection)
113 CALL section_release(subsection)
114
115 CALL create_sirius_section(subsection, 'mixer')
116 CALL section_add_subsection(section, subsection)
117 CALL section_release(subsection)
118
119 CALL create_sirius_section(subsection, 'iterative_solver')
120 CALL section_add_subsection(section, subsection)
121 CALL section_release(subsection)
122
123 !
124 ! uncomment these lines when nlcg is officialy supported in cp2k
125 !
126#if defined(__SIRIUS_NLCG)
127 CALL create_sirius_section(subsection, 'nlcg')
128 CALL section_add_subsection(section, subsection)
129 CALL section_release(subsection)
130#endif
131
132#if defined(__SIRIUS_VCSQNM)
133 CALL create_sirius_section(subsection, 'vcsqnm')
134 CALL section_add_subsection(section, subsection)
135 CALL section_release(subsection)
136#endif
137
138#if defined(__SIRIUS_DFTD4)
139 CALL create_sirius_section(subsection, "dftd4")
140 CALL section_add_subsection(section, subsection)
141 CALL section_release(subsection)
142
143 CALL create_sirius_section(subsection, "dftd3")
144 CALL section_add_subsection(section, subsection)
145 CALL section_release(subsection)
146#endif
147
148 CALL create_print_section(subsection)
149 CALL section_add_subsection(section, subsection)
150 CALL section_release(subsection)
151
152 END SUBROUTINE create_pwdft_section
153
154! **************************************************************************************************
155!> \brief input section for PWDFT control
156!> \param section will contain the CONTROL section
157!> \param section_name ...
158!> \author JHU
159! **************************************************************************************************
160 SUBROUTINE create_sirius_section(section, section_name)
161 TYPE(section_type), POINTER :: section
162 CHARACTER(len=*), INTENT(in) :: section_name
163
164 INTEGER :: length
165
166 cpassert(.NOT. ASSOCIATED(section))
167 CALL sirius_option_get_section_length(trim(adjustl(section_name)), length)
168
169 CALL section_create(section, __location__, &
170 name=trim(adjustl(section_name)), &
171 description=trim(section_name)//" section", &
172 n_subsections=0, &
173 n_keywords=length, &
174 repeats=.false.)
175
176 CALL fill_in_section(section, trim(adjustl(section_name)))
177 END SUBROUTINE create_sirius_section
178
179! **************************************************************************************************
180!> \brief ...
181!> \param section ...
182!> \param section_name ...
183! **************************************************************************************************
184 SUBROUTINE fill_in_section(section, section_name)
185 TYPE(section_type), POINTER :: section
186 CHARACTER(len=*), INTENT(in) :: section_name
187
188 CHARACTER(len=128) :: name
189 CHARACTER(len=128), TARGET :: possible_values(1:16)
190 CHARACTER(len=4096) :: description, usage
191 INTEGER :: ctype, enum_i_val(1:16), enum_length, i, &
192 j, length, num_possible_values
193 INTEGER, ALLOCATABLE, DIMENSION(:), TARGET :: ivec
194 INTEGER, TARGET :: dummy_i
195 LOGICAL :: lvecl(1:16)
196 LOGICAL(4), ALLOCATABLE, DIMENSION(:), TARGET :: lvec
197 LOGICAL(4), TARGET :: dummy_l
198 REAL(kind=dp), ALLOCATABLE, DIMENSION(:), TARGET :: rvec
199 REAL(kind=dp), TARGET :: dummy_r
200 TYPE(keyword_type), POINTER :: keyword
201
202 ALLOCATE (ivec(1:16))
203 ALLOCATE (rvec(1:16))
204 ALLOCATE (lvec(1:16))
205
206#ifdef __LIBVDWXC
207 IF (section_name == "parameters") THEN
208 NULLIFY (keyword)
209 CALL keyword_create(keyword, __location__, name="VDW_FUNCTIONAL", &
210 description="Select the Van der Walls functionals corrections type", &
211 default_i_val=sirius_no_vdw, &
213 enum_c_vals=s2a("NONE", "FUNC_VDWDF", "FUNC_VDWDF2", "FUNC_VDWDFCX"), &
214 enum_desc=s2a("No VdW correction", &
215 "FUNC_VDWDF", &
216 "FUNC_VDWDF2", &
217 "FUNC_VDWDFCX"))
218 CALL section_add_keyword(section, keyword)
219 CALL keyword_release(keyword)
220 END IF
221#endif
222
223 CALL sirius_option_get_section_length(section_name, length)
224
225 DO i = 1, length
226 NULLIFY (keyword)
227 name = ''
228 description = ''
229 usage = ''
230 CALL sirius_option_get_info(section_name, &
231 i, &
232 name, &
233 128, &
234 ctype, &
235 num_possible_values, &
236 enum_length, &
237 description, &
238 4096, &
239 usage, &
240 4096)
241 ! description and usage are ignored here
242 ! it is a minor inconvenience from the api.
243
244 name = trim(adjustl(name))
245 ! I exclude these three keywords because one of them is for debugging
246 ! purpose the other are replaced by a dedicated call in cp2k
247 !
248 ! Moreover xc_functionals would need a special treatment.
249
250 IF ((name /= 'xc_functionals') .AND. (name /= 'memory_usage') .AND. (name /= 'vk')) THEN
251 ! we need to null char since SIRIUS interface is basically C
252 SELECT CASE (ctype)
253 CASE (sirius_integer_type)
254 CALL sirius_option_get(section_name, name, ctype, c_loc(dummy_i))
255 CALL keyword_create(keyword, __location__, &
256 name=trim(name), &
257 description=trim(adjustl(description)), &
258 ! usage=TRIM(ADJUSTL(usage)), &
259 type_of_var=integer_t, &
260 repeats=.false., &
261 default_i_val=dummy_i)
262 CALL section_add_keyword(section, keyword)
263 CALL keyword_release(keyword)
264 CASE (sirius_number_type)
265 CALL sirius_option_get(section_name, name, ctype, c_loc(dummy_r))
266 CALL keyword_create(keyword, __location__, &
267 name=name, &
268 description=trim(adjustl(description)), &
269 ! usage=TRIM(ADJUSTL(usage)), &
270 type_of_var=real_t, &
271 repeats=.false., &
272 default_r_val=dummy_r)
273 CALL section_add_keyword(section, keyword)
274 CALL keyword_release(keyword)
275 CASE (sirius_logical_type)
276 dummy_l = .false.
277 CALL sirius_option_get(section_name, name, ctype, c_loc(dummy_l))
278 IF (dummy_l) THEN
279 CALL keyword_create(keyword, __location__, &
280 name=name, &
281 description=trim(adjustl(description)), &
282 ! usage=TRIM(ADJUSTL(usage)), &
283 type_of_var=logical_t, &
284 repeats=.false., &
285 default_l_val=.true., &
286 lone_keyword_l_val=.true.)
287 ELSE
288 CALL keyword_create(keyword, __location__, &
289 name=name, &
290 description=trim(adjustl(description)), &
291 ! usage=TRIM(ADJUSTL(usage)), &
292 type_of_var=logical_t, &
293 repeats=.false., &
294 default_l_val=.false., &
295 lone_keyword_l_val=.true.)
296 END IF
297 CALL section_add_keyword(section, keyword)
298 CALL keyword_release(keyword)
299 CASE (sirius_string_type)
300 IF (enum_length >= 1) THEN
301 DO j = 1, enum_length
302 possible_values(j) = ''
303 CALL sirius_option_get(section_name, name, ctype, c_loc(possible_values(j)), max_length=128, enum_idx=j)
304 enum_i_val(j) = j
305 possible_values(j) = trim(adjustl(possible_values(j)))
306 END DO
307
308 IF (enum_length > 1) THEN
309 CALL keyword_create(keyword, __location__, &
310 name=name, &
311 description=trim(adjustl(description)), &
312 ! usage=TRIM(ADJUSTL(usage)), &
313 repeats=.false., &
314 enum_i_vals=enum_i_val(1:enum_length), &
315 enum_c_vals=possible_values(1:enum_length), &
316 default_i_val=1)
317 ELSE
318 CALL keyword_create(keyword, __location__, &
319 name=name, &
320 description=trim(adjustl(description)), &
321 ! usage=TRIM(ADJUSTL(usage)), &
322 type_of_var=char_t, &
323 default_c_val=possible_values(1), &
324 repeats=.false.)
325 END IF
326 ELSE
327 CALL keyword_create(keyword, __location__, &
328 name=name, &
329 description=trim(adjustl(description)), &
330 ! usage=TRIM(ADJUSTL(usage)), &
331 type_of_var=char_t, &
332 default_c_val='', &
333 repeats=.false.)
334 END IF
335 CALL section_add_keyword(section, keyword)
336 CALL keyword_release(keyword)
337 CASE (sirius_integer_array_type)
338 CALL sirius_option_get(section_name, name, ctype, c_loc(ivec(1)), max_length=16)
339
340 IF (num_possible_values .EQ. 0) THEN
341 CALL keyword_create(keyword, __location__, &
342 name=name, &
343 description=trim(adjustl(description)), &
344 type_of_var=integer_t, &
345 n_var=-1, &
346 repeats=.false.)
347 ELSE
348 CALL keyword_create(keyword, __location__, &
349 name=name, &
350 description=trim(adjustl(description)), &
351 type_of_var=integer_t, &
352 repeats=.false., &
353 n_var=num_possible_values, &
354 default_i_vals=ivec(1:num_possible_values))
355 END IF
356 CALL section_add_keyword(section, keyword)
357 CALL keyword_release(keyword)
358 CASE (sirius_logical_array_type)
359 CALL sirius_option_get(section_name, name, ctype, c_loc(lvec(1)), max_length=16)
360 DO j = 1, num_possible_values
361 lvecl(j) = lvec(j)
362 END DO
363 IF (num_possible_values > 0) THEN
364 CALL keyword_create(keyword, __location__, &
365 name=name, &
366 description=trim(adjustl(description)), &
367 !usage=TRIM(ADJUSTL(usage)), &
368 type_of_var=logical_t, &
369 repeats=.false., &
370 n_var=num_possible_values, &
371 default_l_vals=lvecl(1:num_possible_values))
372 ELSE
373 CALL keyword_create(keyword, __location__, &
374 name=name, &
375 description=trim(adjustl(description)), &
376 !usage=TRIM(ADJUSTL(usage)), &
377 type_of_var=logical_t, &
378 repeats=.false., &
379 n_var=-1)
380 END IF
381 CALL section_add_keyword(section, keyword)
382 CALL keyword_release(keyword)
383 CASE (sirius_number_array_type)
384 CALL sirius_option_get(section_name, name, ctype, c_loc(rvec(1)), max_length=16)
385
386 IF (num_possible_values .EQ. 0) THEN
387 CALL keyword_create(keyword, __location__, &
388 name=name, &
389 description=trim(adjustl(description)), &
390 ! usage=TRIM(ADJUSTL(usage)), &
391 type_of_var=real_t, &
392 repeats=.false., &
393 n_var=-1)
394 ELSE
395 CALL keyword_create(keyword, __location__, &
396 name=name, &
397 description=trim(adjustl(description)), &
398 ! usage=TRIM(ADJUSTL(usage)), &
399 type_of_var=real_t, &
400 repeats=.false., &
401 n_var=num_possible_values, &
402 default_r_vals=rvec(1:num_possible_values))
403 END IF
404 CALL section_add_keyword(section, keyword)
405 CALL keyword_release(keyword)
406 CASE default
407 END SELECT
408 END IF
409 END DO
410 END SUBROUTINE fill_in_section
411
412! **************************************************************************************************
413!> \brief Create the print section for sirius
414!> \param section the section to create
415!> \author jgh
416! **************************************************************************************************
417 SUBROUTINE create_print_section(section)
418 TYPE(section_type), POINTER :: section
419
420 TYPE(section_type), POINTER :: print_key
421
422 cpassert(.NOT. ASSOCIATED(section))
423 CALL section_create(section, __location__, name="PRINT", &
424 description="Section of possible print options in PW_DFT code.", &
425 n_keywords=0, n_subsections=1, repeats=.false.)
426
427 NULLIFY (print_key)
428 CALL create_dos_section(print_key)
429 CALL section_add_subsection(section, print_key)
430 CALL section_release(print_key)
431
432 END SUBROUTINE create_print_section
433
434! **************************************************************************************************
435!> \brief ...
436!> \param print_key ...
437! **************************************************************************************************
438 SUBROUTINE create_dos_section(print_key)
439
440 TYPE(section_type), POINTER :: print_key
441
442 TYPE(keyword_type), POINTER :: keyword
443
444 NULLIFY (keyword)
445
446 CALL cp_print_key_section_create(print_key, __location__, "DOS", &
447 description="Print Density of States (DOS) (only available states from SCF)", &
448 print_level=debug_print_level, common_iter_levels=1, filename="")
449
450 CALL keyword_create(keyword, __location__, name="APPEND", &
451 description="Append the DOS obtained at different iterations to the output file. "// &
452 "By default the file is overwritten", &
453 usage="APPEND", default_l_val=.false., &
454 lone_keyword_l_val=.true.)
455 CALL section_add_keyword(print_key, keyword)
456 CALL keyword_release(keyword)
457
458 CALL keyword_create(keyword, __location__, name="DELTA_E", &
459 description="Histogramm energy spacing.", &
460 usage="DELTA_E 0.0005", type_of_var=real_t, default_r_val=0.001_dp)
461 CALL section_add_keyword(print_key, keyword)
462 CALL keyword_release(keyword)
463
464 END SUBROUTINE create_dos_section
465
466#else
467! **************************************************************************************************
468!> \brief ...
469!> \param section ...
470! **************************************************************************************************
471 SUBROUTINE create_pwdft_section(section)
472 TYPE(section_type), POINTER :: section
473
474 cpassert(.NOT. ASSOCIATED(section))
475
476 CALL section_create(section, __location__, name="PW_DFT", &
477 description="This section contains all information to run an "// &
478 "SIRIUS PW calculation.", &
479 n_subsections=0, &
480 repeats=.false.)
481
482 END SUBROUTINE create_pwdft_section
483
484#endif
485
486END MODULE input_cp2k_pwdft
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
integer, parameter, public debug_print_level
integer, parameter, public low_print_level
integer, parameter, public medium_print_level
integer, parameter, public high_print_level
integer, parameter, public add_last_numeric
integer, parameter, public silent_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
subroutine, public create_pwdft_section(section)
...
integer, parameter, public sirius_func_vdwdfcx
integer, parameter, public sirius_func_vdwdf2
integer, parameter, public sirius_no_vdw
integer, parameter, public sirius_func_vdwdf
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, deprecation_notice)
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
integer, parameter, public lchar_t
integer, parameter, public logical_t
integer, parameter, public char_t
integer, parameter, public integer_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