(git:58e3e09)
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-2024 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
27  keyword_type
32  section_type
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 
62 CONTAINS
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(section_type), POINTER :: subsection
76 
77 ! ------------------------------------------------------------------------
78 
79  cpassert(.NOT. ASSOCIATED(section))
80  CALL section_create(section, __location__, name="PW_DFT", &
81  description="DFT calculation using plane waves basis can be set in this section. "// &
82  "The backend called SIRIUS, computes the basic properties of the system, "// &
83  "such as ground state, forces and stresses tensors which can be used by "// &
84  "cp2k afterwards. The engine has all these features build-in, support of "// &
85  "pseudo-potentials and full-potentials, spin-orbit coupling, collinear and "// &
86  "non collinear magnetism, Hubbard correction, all exchange functionals "// &
87  "supported by libxc and Van der Waals corrections (libvdwxc).")
88 
89  NULLIFY (subsection)
90  CALL create_sirius_section(subsection, 'control')
91  CALL section_add_subsection(section, subsection)
92  CALL section_release(subsection)
93 
94  CALL create_sirius_section(subsection, 'parameters')
95  CALL section_add_subsection(section, subsection)
96  CALL section_release(subsection)
97 
98  CALL create_sirius_section(subsection, 'settings')
99  CALL section_add_subsection(section, subsection)
100  CALL section_release(subsection)
101 
102  CALL create_sirius_section(subsection, 'mixer')
103  CALL section_add_subsection(section, subsection)
104  CALL section_release(subsection)
105 
106  CALL create_sirius_section(subsection, 'iterative_solver')
107  CALL section_add_subsection(section, subsection)
108  CALL section_release(subsection)
109 
110  !
111  ! uncomment these lines when nlcg is officialy supported in cp2k
112  !
113 
114  ! CALL create_sirius_section(subsection, 'nlcg')
115  ! CALL section_add_subsection(section, subsection)
116  ! CALL section_release(subsection)
117 
118  CALL create_print_section(subsection)
119  CALL section_add_subsection(section, subsection)
120  CALL section_release(subsection)
121 
122  END SUBROUTINE create_pwdft_section
123 
124 ! **************************************************************************************************
125 !> \brief input section for PWDFT control
126 !> \param section will contain the CONTROL section
127 !> \param section_name ...
128 !> \author JHU
129 ! **************************************************************************************************
130  SUBROUTINE create_sirius_section(section, section_name)
131  TYPE(section_type), POINTER :: section
132  CHARACTER(len=*), INTENT(in) :: section_name
133 
134  INTEGER :: length
135 
136  cpassert(.NOT. ASSOCIATED(section))
137  CALL sirius_option_get_section_length(trim(adjustl(section_name)), length)
138 
139  CALL section_create(section, __location__, &
140  name=trim(adjustl(section_name)), &
141  description=trim(section_name)//" section", &
142  n_subsections=0, &
143  n_keywords=length, &
144  repeats=.false.)
145 
146  CALL fill_in_section(section, trim(adjustl(section_name)))
147  END SUBROUTINE create_sirius_section
148 
149 ! **************************************************************************************************
150 !> \brief ...
151 !> \param section ...
152 !> \param section_name ...
153 ! **************************************************************************************************
154  SUBROUTINE fill_in_section(section, section_name)
155  TYPE(section_type), POINTER :: section
156  CHARACTER(len=*), INTENT(in) :: section_name
157 
158  CHARACTER(len=128) :: name
159  CHARACTER(len=128), TARGET :: possible_values(1:16)
160  CHARACTER(len=4096) :: description, usage
161  INTEGER :: ctype, enum_i_val(1:16), enum_length, i, &
162  j, length, num_possible_values
163  INTEGER, ALLOCATABLE, DIMENSION(:), TARGET :: ivec
164  INTEGER, TARGET :: dummy_i
165  LOGICAL :: lvecl(1:16)
166  LOGICAL(4), ALLOCATABLE, DIMENSION(:), TARGET :: lvec
167  LOGICAL(4), TARGET :: dummy_l
168  REAL(kind=dp), ALLOCATABLE, DIMENSION(:), TARGET :: rvec
169  REAL(kind=dp), TARGET :: dummy_r
170  TYPE(keyword_type), POINTER :: keyword
171 
172  ALLOCATE (ivec(1:16))
173  ALLOCATE (rvec(1:16))
174  ALLOCATE (lvec(1:16))
175 
176 #ifdef __LIBVDWXC
177  IF (section_name == "parameters") THEN
178  NULLIFY (keyword)
179  CALL keyword_create(keyword, __location__, name="VDW_FUNCTIONAL", &
180  description="Select the Van der Walls functionals corrections type", &
181  default_i_val=sirius_no_vdw, &
183  enum_c_vals=s2a("NONE", "FUNC_VDWDF", "FUNC_VDWDF2", "FUNC_VDWDFCX"), &
184  enum_desc=s2a("No VdW correction", &
185  "FUNC_VDWDF", &
186  "FUNC_VDWDF2", &
187  "FUNC_VDWDFCX"))
188  CALL section_add_keyword(section, keyword)
189  CALL keyword_release(keyword)
190  END IF
191 #endif
192 
193  CALL sirius_option_get_section_length(section_name, length)
194 
195  DO i = 1, length
196  NULLIFY (keyword)
197  name = ''
198  description = ''
199  usage = ''
200  CALL sirius_option_get_info(section_name, &
201  i, &
202  name, &
203  128, &
204  ctype, &
205  num_possible_values, &
206  enum_length, &
207  description, &
208  4096, &
209  usage, &
210  4096)
211  ! description and usage are ignored here
212  ! it is a minor inconvenience from the api.
213 
214  name = trim(adjustl(name))
215  ! I exclude these three keywords because one of them is for debugging
216  ! purpose the other are replaced by a dedicated call in cp2k
217  !
218  ! Moreover xc_functionals would need a special treatment.
219 
220  IF ((name /= 'xc_functionals') .AND. (name /= 'memory_usage') .AND. (name /= 'vk')) THEN
221  ! we need to null char since SIRIUS interface is basically C
222  SELECT CASE (ctype)
223  CASE (sirius_integer_type)
224  CALL sirius_option_get(section_name, name, ctype, c_loc(dummy_i))
225  CALL keyword_create(keyword, __location__, &
226  name=trim(name), &
227  description=trim(adjustl(description)), &
228  ! usage=TRIM(ADJUSTL(usage)), &
229  type_of_var=integer_t, &
230  repeats=.false., &
231  default_i_val=dummy_i)
232  CALL section_add_keyword(section, keyword)
233  CALL keyword_release(keyword)
234  CASE (sirius_number_type)
235  CALL sirius_option_get(section_name, name, ctype, c_loc(dummy_r))
236  CALL keyword_create(keyword, __location__, &
237  name=name, &
238  description=trim(adjustl(description)), &
239  ! usage=TRIM(ADJUSTL(usage)), &
240  type_of_var=real_t, &
241  repeats=.false., &
242  default_r_val=dummy_r)
243  CALL section_add_keyword(section, keyword)
244  CALL keyword_release(keyword)
245  CASE (sirius_logical_type)
246  dummy_l = .false.
247  CALL sirius_option_get(section_name, name, ctype, c_loc(dummy_l))
248  IF (dummy_l) THEN
249  CALL keyword_create(keyword, __location__, &
250  name=name, &
251  description=trim(adjustl(description)), &
252  ! usage=TRIM(ADJUSTL(usage)), &
253  type_of_var=logical_t, &
254  repeats=.false., &
255  default_l_val=.true., &
256  lone_keyword_l_val=.true.)
257  ELSE
258  CALL keyword_create(keyword, __location__, &
259  name=name, &
260  description=trim(adjustl(description)), &
261  ! usage=TRIM(ADJUSTL(usage)), &
262  type_of_var=logical_t, &
263  repeats=.false., &
264  default_l_val=.false., &
265  lone_keyword_l_val=.true.)
266  END IF
267  CALL section_add_keyword(section, keyword)
268  CALL keyword_release(keyword)
269  CASE (sirius_string_type)
270  IF (enum_length >= 1) THEN
271  DO j = 1, enum_length
272  possible_values(j) = ''
273  CALL sirius_option_get(section_name, name, ctype, c_loc(possible_values(j)), max_length=128, enum_idx=j)
274  enum_i_val(j) = j
275  possible_values(j) = trim(adjustl(possible_values(j)))
276  END DO
277 
278  IF (enum_length > 1) THEN
279  CALL keyword_create(keyword, __location__, &
280  name=name, &
281  description=trim(adjustl(description)), &
282  ! usage=TRIM(ADJUSTL(usage)), &
283  repeats=.false., &
284  enum_i_vals=enum_i_val(1:enum_length), &
285  enum_c_vals=possible_values(1:enum_length), &
286  default_i_val=1)
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=char_t, &
293  default_c_val=possible_values(1), &
294  repeats=.false.)
295  END IF
296  ELSE
297  CALL keyword_create(keyword, __location__, &
298  name=name, &
299  description=trim(adjustl(description)), &
300  ! usage=TRIM(ADJUSTL(usage)), &
301  type_of_var=char_t, &
302  default_c_val='', &
303  repeats=.false.)
304  END IF
305  CALL section_add_keyword(section, keyword)
306  CALL keyword_release(keyword)
307  CASE (sirius_integer_array_type)
308  CALL sirius_option_get(section_name, name, ctype, c_loc(ivec(1)), max_length=16)
309 
310  IF (num_possible_values .EQ. 0) THEN
311  CALL keyword_create(keyword, __location__, &
312  name=name, &
313  description=trim(adjustl(description)), &
314  type_of_var=integer_t, &
315  n_var=-1, &
316  repeats=.false.)
317  ELSE
318  CALL keyword_create(keyword, __location__, &
319  name=name, &
320  description=trim(adjustl(description)), &
321  type_of_var=integer_t, &
322  repeats=.false., &
323  n_var=num_possible_values, &
324  default_i_vals=ivec(1:num_possible_values))
325  END IF
326  CALL section_add_keyword(section, keyword)
327  CALL keyword_release(keyword)
328  CASE (sirius_logical_array_type)
329  CALL sirius_option_get(section_name, name, ctype, c_loc(lvec(1)), max_length=16)
330  DO j = 1, num_possible_values
331  lvecl(j) = lvec(j)
332  END DO
333  IF (num_possible_values > 0) THEN
334  CALL keyword_create(keyword, __location__, &
335  name=name, &
336  description=trim(adjustl(description)), &
337  !usage=TRIM(ADJUSTL(usage)), &
338  type_of_var=logical_t, &
339  repeats=.false., &
340  n_var=num_possible_values, &
341  default_l_vals=lvecl(1:num_possible_values))
342  ELSE
343  CALL keyword_create(keyword, __location__, &
344  name=name, &
345  description=trim(adjustl(description)), &
346  !usage=TRIM(ADJUSTL(usage)), &
347  type_of_var=logical_t, &
348  repeats=.false., &
349  n_var=-1)
350  END IF
351  CALL section_add_keyword(section, keyword)
352  CALL keyword_release(keyword)
353  CASE (sirius_number_array_type)
354  CALL sirius_option_get(section_name, name, ctype, c_loc(rvec(1)), max_length=16)
355 
356  IF (num_possible_values .EQ. 0) THEN
357  CALL keyword_create(keyword, __location__, &
358  name=name, &
359  description=trim(adjustl(description)), &
360  ! usage=TRIM(ADJUSTL(usage)), &
361  type_of_var=real_t, &
362  repeats=.false., &
363  n_var=-1)
364  ELSE
365  CALL keyword_create(keyword, __location__, &
366  name=name, &
367  description=trim(adjustl(description)), &
368  ! usage=TRIM(ADJUSTL(usage)), &
369  type_of_var=real_t, &
370  repeats=.false., &
371  n_var=num_possible_values, &
372  default_r_vals=rvec(1:num_possible_values))
373  END IF
374  CALL section_add_keyword(section, keyword)
375  CALL keyword_release(keyword)
376  CASE default
377  END SELECT
378  END IF
379  END DO
380  END SUBROUTINE fill_in_section
381 
382 ! **************************************************************************************************
383 !> \brief Create the print section for sirius
384 !> \param section the section to create
385 !> \author jgh
386 ! **************************************************************************************************
387  SUBROUTINE create_print_section(section)
388  TYPE(section_type), POINTER :: section
389 
390  TYPE(section_type), POINTER :: print_key
391 
392  cpassert(.NOT. ASSOCIATED(section))
393  CALL section_create(section, __location__, name="PRINT", &
394  description="Section of possible print options in PW_DFT code.", &
395  n_keywords=0, n_subsections=1, repeats=.false.)
396 
397  NULLIFY (print_key)
398  CALL create_dos_section(print_key)
399  CALL section_add_subsection(section, print_key)
400  CALL section_release(print_key)
401 
402  END SUBROUTINE create_print_section
403 
404 ! **************************************************************************************************
405 !> \brief ...
406 !> \param print_key ...
407 ! **************************************************************************************************
408  SUBROUTINE create_dos_section(print_key)
409 
410  TYPE(section_type), POINTER :: print_key
411 
412  TYPE(keyword_type), POINTER :: keyword
413 
414  NULLIFY (keyword)
415 
416  CALL cp_print_key_section_create(print_key, __location__, "DOS", &
417  description="Print Density of States (DOS) (only available states from SCF)", &
418  print_level=debug_print_level, common_iter_levels=1, filename="")
419 
420  CALL keyword_create(keyword, __location__, name="APPEND", &
421  description="Append the DOS obtained at different iterations to the output file. "// &
422  "By default the file is overwritten", &
423  usage="APPEND", default_l_val=.false., &
424  lone_keyword_l_val=.true.)
425  CALL section_add_keyword(print_key, keyword)
426  CALL keyword_release(keyword)
427 
428  CALL keyword_create(keyword, __location__, name="DELTA_E", &
429  description="Histogramm energy spacing.", &
430  usage="DELTA_E 0.0005", type_of_var=real_t, default_r_val=0.001_dp)
431  CALL section_add_keyword(print_key, keyword)
432  CALL keyword_release(keyword)
433 
434  END SUBROUTINE create_dos_section
435 
436 #else
437 ! **************************************************************************************************
438 !> \brief ...
439 !> \param section ...
440 ! **************************************************************************************************
441  SUBROUTINE create_pwdft_section(section)
442  TYPE(section_type), POINTER :: section
443 
444  cpassert(.NOT. ASSOCIATED(section))
445 
446  CALL section_create(section, __location__, name="PW_DFT", &
447  description="This section contains all information to run an "// &
448  "SIRIUS PW calculation.", &
449  n_subsections=0, &
450  repeats=.false.)
451 
452  END SUBROUTINE create_pwdft_section
453 
454 #endif
455 
456 END 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)
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.