17 USE iso_c_binding,
ONLY: c_loc
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
47#include "./base/base_uses.f90"
52 LOGICAL,
PRIVATE,
PARAMETER :: debug_this_module = .true.
53 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'input_cp2k_pwdft'
80 cpassert(.NOT.
ASSOCIATED(section))
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).")
92 name=
'ignore_convergence_failure', &
93 description=
"when set to true, calculation will continue irrespectively "// &
94 "of the convergence status of SIRIUS", &
97 default_l_val=.false., &
98 lone_keyword_l_val=.true.)
103 CALL create_sirius_section(subsection,
'control')
107 CALL create_sirius_section(subsection,
'parameters')
111 CALL create_sirius_section(subsection,
'settings')
115 CALL create_sirius_section(subsection,
'mixer')
119 CALL create_sirius_section(subsection,
'iterative_solver')
126#if defined(__SIRIUS_NLCG)
127 CALL create_sirius_section(subsection,
'nlcg')
132#if defined(__SIRIUS_VCSQNM)
133 CALL create_sirius_section(subsection,
'vcsqnm')
138#if defined(__SIRIUS_DFTD4)
139 CALL create_sirius_section(subsection,
"dftd4")
143 CALL create_sirius_section(subsection,
"dftd3")
148 CALL create_print_section(subsection)
160 SUBROUTINE create_sirius_section(section, section_name)
162 CHARACTER(len=*),
INTENT(in) :: section_name
166 cpassert(.NOT.
ASSOCIATED(section))
167 CALL sirius_option_get_section_length(trim(adjustl(section_name)), length)
170 name=trim(adjustl(section_name)), &
171 description=trim(section_name)//
" section", &
176 CALL fill_in_section(section, trim(adjustl(section_name)))
177 END SUBROUTINE create_sirius_section
184 SUBROUTINE fill_in_section(section, section_name)
186 CHARACTER(len=*),
INTENT(in) :: section_name
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
202 ALLOCATE (ivec(1:16))
203 ALLOCATE (rvec(1:16))
204 ALLOCATE (lvec(1:16))
207 IF (section_name ==
"parameters")
THEN
209 CALL keyword_create(keyword, __location__, name=
"VDW_FUNCTIONAL", &
210 description=
"Select the Van der Walls functionals corrections type", &
213 enum_c_vals=
s2a(
"NONE",
"FUNC_VDWDF",
"FUNC_VDWDF2",
"FUNC_VDWDFCX"), &
214 enum_desc=
s2a(
"No VdW correction", &
223 CALL sirius_option_get_section_length(section_name, length)
230 CALL sirius_option_get_info(section_name, &
235 num_possible_values, &
244 name = trim(adjustl(name))
250 IF ((name /=
'xc_functionals') .AND. (name /=
'memory_usage') .AND. (name /=
'vk'))
THEN
253 CASE (sirius_integer_type)
254 CALL sirius_option_get(section_name, name, ctype, c_loc(dummy_i))
257 description=trim(adjustl(description)), &
261 default_i_val=dummy_i)
264 CASE (sirius_number_type)
265 CALL sirius_option_get(section_name, name, ctype, c_loc(dummy_r))
268 description=trim(adjustl(description)), &
272 default_r_val=dummy_r)
275 CASE (sirius_logical_type)
277 CALL sirius_option_get(section_name, name, ctype, c_loc(dummy_l))
281 description=trim(adjustl(description)), &
285 default_l_val=.true., &
286 lone_keyword_l_val=.true.)
290 description=trim(adjustl(description)), &
294 default_l_val=.false., &
295 lone_keyword_l_val=.true.)
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)
305 possible_values(j) = trim(adjustl(possible_values(j)))
308 IF (enum_length > 1)
THEN
311 description=trim(adjustl(description)), &
314 enum_i_vals=enum_i_val(1:enum_length), &
315 enum_c_vals=possible_values(1:enum_length), &
320 description=trim(adjustl(description)), &
323 default_c_val=possible_values(1), &
329 description=trim(adjustl(description)), &
337 CASE (sirius_integer_array_type)
338 CALL sirius_option_get(section_name, name, ctype, c_loc(ivec(1)), max_length=16)
340 IF (num_possible_values .EQ. 0)
THEN
343 description=trim(adjustl(description)), &
350 description=trim(adjustl(description)), &
353 n_var=num_possible_values, &
354 default_i_vals=ivec(1:num_possible_values))
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
363 IF (num_possible_values > 0)
THEN
366 description=trim(adjustl(description)), &
370 n_var=num_possible_values, &
371 default_l_vals=lvecl(1:num_possible_values))
375 description=trim(adjustl(description)), &
383 CASE (sirius_number_array_type)
384 CALL sirius_option_get(section_name, name, ctype, c_loc(rvec(1)), max_length=16)
386 IF (num_possible_values .EQ. 0)
THEN
389 description=trim(adjustl(description)), &
397 description=trim(adjustl(description)), &
401 n_var=num_possible_values, &
402 default_r_vals=rvec(1:num_possible_values))
410 END SUBROUTINE fill_in_section
417 SUBROUTINE create_print_section(section)
422 cpassert(.NOT.
ASSOCIATED(section))
424 description=
"Section of possible print options in PW_DFT code.", &
425 n_keywords=0, n_subsections=1, repeats=.false.)
428 CALL create_dos_section(print_key)
432 END SUBROUTINE create_print_section
438 SUBROUTINE create_dos_section(print_key)
447 description=
"Print Density of States (DOS) (only available states from SCF)", &
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.)
459 description=
"Histogramm energy spacing.", &
460 usage=
"DELTA_E 0.0005", type_of_var=
real_t, default_r_val=0.001_dp)
464 END SUBROUTINE create_dos_section
474 cpassert(.NOT.
ASSOCIATED(section))
477 description=
"This section contains all information to run an "// &
478 "SIRIUS PW calculation.", &
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
Defines the basic variable types.
integer, parameter, public dp
Utilities for string manipulations.