(git:0de0cc2)
scf_control_types.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 parameters that control an scf iteration
10 !> \note
11 !> not in cp_control_types, to separate operator related parameters from
12 !> method related parameters (as suggested by Matthias)
13 !> \par History
14 !> 09.2002 created [fawzi]
15 !> \author Fawzi Mohamed
16 ! **************************************************************************************************
18 
20  cp_logger_type
23  USE cp_units, ONLY: cp_unit_from_cp2k
24  USE input_constants, ONLY: &
33  enumeration_type
34  USE input_keyword_types, ONLY: keyword_get,&
35  keyword_type
38  section_type,&
41  section_vals_type,&
43  USE kinds, ONLY: dp
44  USE outer_scf_control_types, ONLY: outer_scf_control_type,&
47  USE qs_ot_types, ONLY: ot_readwrite_input,&
49  qs_ot_settings_type
50 #include "./base/base_uses.f90"
51 
52  IMPLICIT NONE
53 
54  PRIVATE
55 
56  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'scf_control_types'
57  LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .true.
58 
59  ! Public data types
60 
61  PUBLIC :: scf_control_type, &
62  smear_type
63 
64  ! Public subroutines
65 
66  PUBLIC :: scf_c_create, &
68  scf_c_release, &
70 
71 ! **************************************************************************************************
72 !> \brief contains the parameters needed by a scf run
73 !> \param density_guess how to choose the initial density
74 !> (CORE,RANDOM,RESTART,ATOMIC,FROZEN)
75 !> \param eps_eigval wanted error on the eigenvalues
76 !> \param eps_scf whanted error on the whole scf
77 !> \param level_shift amount of level shift
78 !> \param p_mix how to mix the new and old densities in non diss iterations
79 !> \param eps_lumos error on the lumos calculated at the end of the scf
80 !> \param max_iter_lumus maxumum number of iterations used to calculate
81 !> the lumos at the end of the scf
82 !> \param max_scf max scf iterations
83 !> \param added_mos additional number of MOs that might be used in the SCF
84 !> \param step_size the optimizer step size
85 !> \param cdft_opt_control settings for optimizers that work only together with CDFT constraints
86 !> \par History
87 !> 09.2002 created [fawzi]
88 !> \author Fawzi Mohamed
89 ! **************************************************************************************************
90  TYPE smear_type
91  LOGICAL :: do_smear
92  LOGICAL :: common_mu
93  INTEGER :: method
94  REAL(KIND=dp) :: electronic_temperature, &
95  fixed_mag_mom, &
96  eps_fermi_dirac, &
97  window_size
98  REAL(KIND=dp), DIMENSION(:), POINTER :: list
99  END TYPE smear_type
100 
101  TYPE diagonalization_type
102  INTEGER :: method
103  REAL(KIND=dp) :: eps_jacobi
104  REAL(KIND=dp) :: jacobi_threshold
105  INTEGER :: max_iter, nkrylov, nblock_krylov
106  ! Maximum Overlap Method
107  LOGICAL :: mom, mom_didguess
108  INTEGER :: mom_proj_formula
109  ! indices of de-occupied and newly occupied alpha / beta molecular orbitals
110  INTEGER, DIMENSION(:), POINTER :: mom_deoccA, mom_deoccB, mom_occA, mom_occB
111  ! determines on SCF which iteration MOM will be switched on;
112  ! since MOs from the previous iteration should be available, it might be at least
113  ! 1 when wave-function has been read from restart file, or
114  ! 2 when the atomic guess method has been used
115  INTEGER :: mom_start
116  INTEGER :: mom_type
117  REAL(KIND=dp) :: eps_iter
118  REAL(KIND=dp) :: eps_adapt
119  TYPE(qs_ot_settings_type) :: ot_settings
120  END TYPE diagonalization_type
121 
122  TYPE scf_control_type
123  TYPE(outer_scf_control_type) :: outer_scf
124  TYPE(smear_type), POINTER :: smear
125  TYPE(diagonalization_type) :: diagonalization
126  INTEGER :: density_guess, mixing_method
127  REAL(KIND=dp) :: eps_eigval, eps_scf, eps_scf_hist, &
128  level_shift, &
129  eps_lumos, eps_diis
130  INTEGER :: max_iter_lumos, max_diis, nmixing
131  INTEGER :: max_scf, max_scf_hist, &
132  maxl, nkind
133  LOGICAL :: do_diag_sub, &
134  use_cholesky, use_ot, use_diag, do_outer_scf_reortho, &
135  ignore_convergence_failure
136  INTEGER, DIMENSION(2) :: added_mos
137  INTEGER :: roks_scheme
138  REAL(KIND=dp) :: roks_f
139  REAL(KIND=dp), DIMENSION(0:2, 0:2, 1:2) :: roks_parameter
140  END TYPE scf_control_type
141 
142 CONTAINS
143 
144 ! **************************************************************************************************
145 !> \brief allocates and initializes an scf control object with the default values
146 !> \param scf_control the object to initialize
147 !> \par History
148 !> 09.2002 created [fawzi]
149 !> - Default ROKS parameters added (05.04.06,MK)
150 !> \author Fawzi Mohamed
151 ! **************************************************************************************************
152  SUBROUTINE scf_c_create(scf_control)
153 
154  TYPE(scf_control_type), INTENT(OUT) :: scf_control
155 
156  CHARACTER(LEN=*), PARAMETER :: routinen = 'scf_c_create'
157 
158  INTEGER :: handle
159 
160  CALL timeset(routinen, handle)
161 
162  ! Load the default values
163 
164  scf_control%density_guess = atomic_guess
165  scf_control%eps_eigval = 1.0e-5_dp
166  scf_control%eps_scf = 1.0e-5_dp
167  scf_control%eps_scf_hist = 0.0_dp
168  scf_control%eps_lumos = 1.0e-5_dp
169  scf_control%max_iter_lumos = 2999
170  scf_control%eps_diis = 0.1_dp
171  scf_control%level_shift = 0.0_dp
172  scf_control%max_diis = 4
173  scf_control%max_scf = 50
174  scf_control%nmixing = 2
175  scf_control%use_cholesky = .true.
176  scf_control%use_diag = .true.
177  scf_control%do_diag_sub = .false.
178  scf_control%use_ot = .false.
179  scf_control%ignore_convergence_failure = .false.
180  scf_control%do_outer_scf_reortho = .true.
181  scf_control%max_diis = 4
182  scf_control%eps_diis = 0.1_dp
183  scf_control%added_mos(:) = 0
184  scf_control%max_scf_hist = 0
185 
186  !Mixing
187  scf_control%mixing_method = direct_p_mix
188 
189  ! Diagonalization
190  scf_control%diagonalization%method = 0
191  scf_control%diagonalization%eps_jacobi = 0.0_dp
192  scf_control%diagonalization%jacobi_threshold = 1.0e-7_dp
193  scf_control%diagonalization%max_iter = 0
194  scf_control%diagonalization%eps_iter = 0.0_dp
195  scf_control%diagonalization%eps_adapt = 0.0_dp
196  scf_control%diagonalization%nkrylov = 0
197  scf_control%diagonalization%nblock_krylov = 0
198  CALL qs_ot_settings_init(scf_control%diagonalization%ot_settings)
199 
200  scf_control%diagonalization%mom = .false.
201  scf_control%diagonalization%mom_didguess = .false.
202  scf_control%diagonalization%mom_proj_formula = 0
203  NULLIFY (scf_control%diagonalization%mom_deoccA)
204  NULLIFY (scf_control%diagonalization%mom_deoccB)
205  NULLIFY (scf_control%diagonalization%mom_occA)
206  NULLIFY (scf_control%diagonalization%mom_occB)
207  scf_control%diagonalization%mom_start = 0
208 
209  ! ROKS
210 
211  scf_control%roks_scheme = high_spin_roks
212  scf_control%roks_f = 0.5_dp
213 
214  ! Initialize the diagonal blocks with the default ROKS parameters
215  ! 0 = v)irtual, 1 = o)pen shell, 2 = c)losed shell
216 
217  scf_control%roks_parameter(0, 0, 1) = 1.5_dp ! avv
218  scf_control%roks_parameter(0, 0, 2) = -0.5_dp ! bvv
219  scf_control%roks_parameter(1, 1, 1) = 0.5_dp ! aoo
220  scf_control%roks_parameter(1, 1, 2) = 0.5_dp ! boo
221  scf_control%roks_parameter(2, 2, 1) = -0.5_dp ! acc
222  scf_control%roks_parameter(2, 2, 2) = 1.5_dp ! bcc
223 
224  ! Initialize off-diagonal blocks (fixed)
225 
226  scf_control%roks_parameter(0, 1, 1) = 1.0_dp ! avo
227  scf_control%roks_parameter(0, 1, 2) = 0.0_dp ! bvo
228  scf_control%roks_parameter(0, 2, 1) = 0.5_dp ! avc
229  scf_control%roks_parameter(0, 2, 2) = 0.5_dp ! bvc
230  scf_control%roks_parameter(1, 2, 1) = 0.0_dp ! aoc
231  scf_control%roks_parameter(1, 2, 2) = 1.0_dp ! boc
232 
233  ! Symmetry enforces
234 
235  scf_control%roks_parameter(1, 0, 1) = scf_control%roks_parameter(0, 1, 1) ! aov
236  scf_control%roks_parameter(1, 0, 2) = scf_control%roks_parameter(0, 1, 2) ! bov
237  scf_control%roks_parameter(2, 0, 1) = scf_control%roks_parameter(0, 2, 1) ! acv
238  scf_control%roks_parameter(2, 0, 2) = scf_control%roks_parameter(0, 2, 2) ! bcv
239  scf_control%roks_parameter(2, 1, 1) = scf_control%roks_parameter(1, 2, 1) ! aco
240  scf_control%roks_parameter(2, 1, 2) = scf_control%roks_parameter(1, 2, 2) ! bco
241 
242  ! Outer SCF default settings
243 
244  scf_control%outer_scf%have_scf = .false.
245  scf_control%outer_scf%max_scf = 0
246  scf_control%outer_scf%eps_scf = 0.0_dp
247  scf_control%outer_scf%step_size = 0.0_dp
248  scf_control%outer_scf%type = -1
249  scf_control%outer_scf%optimizer = -1
250  scf_control%outer_scf%diis_buffer_length = -1
251  NULLIFY (scf_control%outer_scf%cdft_opt_control)
252 
253  ! Smearing of the MO occupations
254 
255  NULLIFY (scf_control%smear)
256 
257  CALL timestop(handle)
258 
259  END SUBROUTINE scf_c_create
260 
261 ! **************************************************************************************************
262 !> \brief releases the given scf_control (see cp2k/doc/ReferenceCounting.html)
263 !> \param scf_control the object to free
264 !> \par History
265 !> 09.2002 created [fawzi]
266 !> \author Fawzi Mohamed
267 !> \note
268 !> at the moment does nothing
269 ! **************************************************************************************************
270  SUBROUTINE scf_c_release(scf_control)
271 
272  TYPE(scf_control_type), INTENT(INOUT) :: scf_control
273 
274  IF (ASSOCIATED(scf_control%smear%list)) THEN
275  DEALLOCATE (scf_control%smear%list)
276  END IF
277  DEALLOCATE (scf_control%smear)
278 
279  IF (ASSOCIATED(scf_control%outer_scf%cdft_opt_control)) &
280  CALL cdft_opt_type_release(scf_control%outer_scf%cdft_opt_control)
281 
282  ! Maximum overlap method orbital indices lists
283  ! mom_deoccA, mom_deoccB, mom_occA, mom_occB
284  ! points to memory allocated by input file parser,
285  ! so they do not have to be deallocated
286 
287  END SUBROUTINE scf_c_release
288 
289 ! **************************************************************************************************
290 !> \brief reads the parameters of the scf section into the given scf_control
291 !> \param scf_control the object that wil contain the values read
292 !> \param inp_section ...
293 !> \par History
294 !> 05.2001 created [Matthias]
295 !> 09.2002 creaded separated scf_control type [fawzi]
296 !> \author Matthias Krack
297 ! **************************************************************************************************
298  SUBROUTINE scf_c_read_parameters(scf_control, inp_section)
299 
300  TYPE(scf_control_type), INTENT(INOUT) :: scf_control
301  TYPE(section_vals_type), POINTER :: inp_section
302 
303  CHARACTER(LEN=*), PARAMETER :: routinen = 'scf_c_read_parameters'
304 
305  INTEGER :: cholesky_flag, handle, ialgo
306  INTEGER, DIMENSION(:), POINTER :: added_mos
307  LOGICAL :: do_mixing
308  REAL(kind=dp), DIMENSION(:), POINTER :: roks_parameter
309  TYPE(section_vals_type), POINTER :: mixing_section, outer_scf_section, &
310  scf_section, smear_section
311 
312  CALL timeset(routinen, handle)
313 
314  scf_section => section_vals_get_subs_vals(inp_section, "SCF")
315  CALL section_vals_val_get(scf_section, "DIAGONALIZATION%_SECTION_PARAMETERS_", &
316  l_val=scf_control%use_diag)
317  IF (scf_control%use_diag) THEN
318  CALL section_vals_val_get(scf_section, "DIAGONALIZATION%DIAG_SUB_SCF%_SECTION_PARAMETERS_", &
319  l_val=scf_control%do_diag_sub)
320  END IF
321  CALL section_vals_val_get(scf_section, "OT%_SECTION_PARAMETERS_", l_val=scf_control%use_ot)
322  IF (scf_control%use_diag .AND. scf_control%use_ot) THEN
323  ! don't allow both options to be true
324  cpabort("Don't activate OT and Diagonaliztion together")
325  ELSEIF (.NOT. (scf_control%use_diag .OR. scf_control%use_ot)) THEN
326  ! set default to diagonalization
327  scf_control%use_diag = .true.
328  END IF
329  CALL section_vals_val_get(scf_section, "OT%ALGORITHM", i_val=ialgo)
330  scf_control%do_outer_scf_reortho = ialgo .EQ. ot_algo_taylor_or_diag
331  CALL section_vals_val_get(scf_section, "SCF_GUESS", i_val=scf_control%density_guess)
332  CALL section_vals_val_get(scf_section, "EPS_DIIS", r_val=scf_control%eps_diis)
333  CALL section_vals_val_get(scf_section, "eps_eigval", r_val=scf_control%eps_eigval)
334  CALL section_vals_val_get(scf_section, "cholesky", i_val=cholesky_flag)
335  IF (cholesky_flag > 0) THEN
336  scf_control%use_cholesky = .true.
337  END IF
338  CALL section_vals_val_get(scf_section, "IGNORE_CONVERGENCE_FAILURE", l_val=scf_control%ignore_convergence_failure)
339  CALL section_vals_val_get(scf_section, "eps_scf", r_val=scf_control%eps_scf)
340  CALL section_vals_val_get(scf_section, "level_shift", r_val=scf_control%level_shift)
341  CALL section_vals_val_get(scf_section, "max_diis", i_val=scf_control%max_diis)
342  CALL section_vals_val_get(scf_section, "max_scf", i_val=scf_control%max_scf)
343 
344  ! Diagonaliztion section
345  IF (scf_control%use_diag) THEN
346  CALL section_vals_val_get(scf_section, "DIAGONALIZATION%ALGORITHM", &
347  i_val=scf_control%diagonalization%method)
348  CALL section_vals_val_get(scf_section, "DIAGONALIZATION%EPS_JACOBI", &
349  r_val=scf_control%diagonalization%eps_jacobi)
350  CALL section_vals_val_get(scf_section, "DIAGONALIZATION%JACOBI_THRESHOLD", &
351  r_val=scf_control%diagonalization%jacobi_threshold)
352  CALL section_vals_val_get(scf_section, "DIAGONALIZATION%MAX_ITER", &
353  i_val=scf_control%diagonalization%max_iter)
354  CALL section_vals_val_get(scf_section, "DIAGONALIZATION%EPS_ITER", &
355  r_val=scf_control%diagonalization%eps_iter)
356  CALL section_vals_val_get(scf_section, "DIAGONALIZATION%EPS_ADAPT", &
357  r_val=scf_control%diagonalization%eps_adapt)
358  CALL section_vals_val_get(scf_section, "DIAGONALIZATION%KRYLOV%NKRYLOV", &
359  i_val=scf_control%diagonalization%nkrylov)
360  CALL section_vals_val_get(scf_section, "DIAGONALIZATION%KRYLOV%NBLOCK", &
361  i_val=scf_control%diagonalization%nblock_krylov)
362  IF (scf_control%diagonalization%method == diag_ot) THEN
363  ! read OT section
364  CALL ot_diag_read_input(scf_control%diagonalization%ot_settings, scf_section)
365  END IF
366  ! read maximum overlap method's parameters
367  CALL section_vals_val_get(scf_section, "MOM%_SECTION_PARAMETERS_", &
368  l_val=scf_control%diagonalization%MOM)
369  IF (scf_control%diagonalization%mom) THEN
370  CALL section_vals_val_get(scf_section, "MOM%MOM_TYPE", &
371  i_val=scf_control%diagonalization%mom_type)
372 
373  CALL section_vals_val_get(scf_section, "MOM%START_ITER", &
374  i_val=scf_control%diagonalization%mom_start)
375 
376  CALL section_vals_val_get(scf_section, "MOM%DEOCC_ALPHA", &
377  i_vals=scf_control%diagonalization%mom_deoccA)
378 
379  CALL section_vals_val_get(scf_section, "MOM%DEOCC_BETA", &
380  i_vals=scf_control%diagonalization%mom_deoccB)
381 
382  CALL section_vals_val_get(scf_section, "MOM%OCC_ALPHA", &
383  i_vals=scf_control%diagonalization%mom_occA)
384 
385  CALL section_vals_val_get(scf_section, "MOM%OCC_BETA", &
386  i_vals=scf_control%diagonalization%mom_occB)
387 
388  CALL section_vals_val_get(scf_section, "MOM%PROJ_FORMULA", &
389  i_val=scf_control%diagonalization%mom_proj_formula)
390  END IF
391  END IF
392 
393  ! Read ROKS parameters
394  CALL section_vals_val_get(scf_section, "ROKS_SCHEME", i_val=scf_control%roks_scheme)
395 
396  SELECT CASE (scf_control%roks_scheme)
397  CASE (general_roks)
398  ! Read parameters for the general ROKS scheme
399  CALL section_vals_val_get(scf_section, "ROKS_F", r_val=scf_control%roks_f)
400  CASE (high_spin_roks)
401  ! Read high-spin ROKS parameters for the diagonal block
402  ! 0 = v)irtual, 1 = o)pen shell, 2 = c)losed shell
403  NULLIFY (roks_parameter)
404  CALL section_vals_val_get(scf_section, "ROKS_PARAMETERS", r_vals=roks_parameter)
405  IF (ASSOCIATED(roks_parameter)) THEN
406  scf_control%roks_parameter(2, 2, 1) = roks_parameter(1) ! acc
407  scf_control%roks_parameter(2, 2, 2) = roks_parameter(2) ! bcc
408  scf_control%roks_parameter(1, 1, 1) = roks_parameter(3) ! aoo
409  scf_control%roks_parameter(1, 1, 2) = roks_parameter(4) ! boo
410  scf_control%roks_parameter(0, 0, 1) = roks_parameter(5) ! avv
411  scf_control%roks_parameter(0, 0, 2) = roks_parameter(6) ! bvv
412  END IF
413  END SELECT
414 
415  ! should be moved to printkey
416  CALL section_vals_val_get(scf_section, "eps_lumo", r_val=scf_control%eps_lumos)
417  CALL section_vals_val_get(scf_section, "max_iter_lumo", i_val=scf_control%max_iter_lumos)
418 
419  ! Extra MOs, e.g. for smearing
420  CALL section_vals_val_get(scf_section, "added_mos", i_vals=added_mos)
421  cpassert(ASSOCIATED(added_mos))
422  IF (SIZE(added_mos) > 0) THEN
423  scf_control%added_mos(1) = added_mos(1)
424  IF (SIZE(added_mos) > 1) THEN
425  scf_control%added_mos(2) = added_mos(2)
426  END IF
427  END IF
428 
429  CALL section_vals_val_get(scf_section, "max_scf_history", i_val=scf_control%max_scf_hist)
430  CALL section_vals_val_get(scf_section, "eps_scf_history", r_val=scf_control%eps_scf_hist)
431 
432  IF (scf_control%level_shift /= 0.0_dp) scf_control%use_cholesky = .false.
433 
434  ! Outer SCF subsection
435  outer_scf_section => section_vals_get_subs_vals(scf_section, "OUTER_SCF")
436  CALL outer_scf_read_parameters(scf_control%outer_scf, outer_scf_section)
437 
438  smear_section => section_vals_get_subs_vals(scf_section, "SMEAR")
439  CALL init_smear(scf_control%smear)
440  CALL read_smear_section(scf_control%smear, smear_section)
441 
442  do_mixing = .false.
443  mixing_section => section_vals_get_subs_vals(scf_section, "MIXING")
444  CALL section_vals_val_get(mixing_section, "_SECTION_PARAMETERS_", &
445  l_val=do_mixing)
446  IF (do_mixing) THEN
447  CALL section_vals_val_get(mixing_section, "METHOD", &
448  i_val=scf_control%mixing_method)
449  CALL section_vals_val_get(mixing_section, "NMIXING", i_val=scf_control%nmixing)
450  END IF ! do mixing
451 
452  CALL timestop(handle)
453 
454  END SUBROUTINE scf_c_read_parameters
455 
456 ! **************************************************************************************************
457 !> \brief ...
458 !> \param smear ...
459 ! **************************************************************************************************
460  SUBROUTINE init_smear(smear)
461  TYPE(smear_type), POINTER :: smear
462 
463  cpassert(.NOT. ASSOCIATED(smear))
464  ALLOCATE (smear)
465  smear%do_smear = .false.
466  smear%method = smear_energy_window
467  smear%electronic_temperature = 0.0_dp
468  smear%eps_fermi_dirac = 1.0e-5_dp
469  smear%fixed_mag_mom = -100.0_dp
470  smear%window_size = 0.0_dp
471  NULLIFY (smear%list)
472  END SUBROUTINE init_smear
473 
474 ! **************************************************************************************************
475 !> \brief ...
476 !> \param smear ...
477 !> \param smear_section ...
478 ! **************************************************************************************************
479  SUBROUTINE read_smear_section(smear, smear_section)
480  TYPE(smear_type), POINTER :: smear
481  TYPE(section_vals_type), POINTER :: smear_section
482 
483  REAL(kind=dp), DIMENSION(:), POINTER :: r_vals
484 
485  NULLIFY (r_vals)
486 
487  CALL section_vals_val_get(smear_section, "_SECTION_PARAMETERS_", &
488  l_val=smear%do_smear)
489  IF (smear%do_smear) THEN
490  CALL section_vals_val_get(smear_section, "METHOD", &
491  i_val=smear%method)
492  CALL section_vals_val_get(smear_section, "ELECTRONIC_TEMPERATURE", &
493  r_val=smear%electronic_temperature)
494  CALL section_vals_val_get(smear_section, "EPS_FERMI_DIRAC", &
495  r_val=smear%eps_fermi_dirac)
496  CALL section_vals_val_get(smear_section, "WINDOW_SIZE", &
497  r_val=smear%window_size)
498  IF (smear%method == smear_list) THEN
499  CALL section_vals_val_get(smear_section, "LIST", &
500  r_vals=r_vals)
501  cpassert(ASSOCIATED(r_vals))
502  ALLOCATE (smear%list(SIZE(r_vals)))
503  smear%list = r_vals
504  END IF
505  CALL section_vals_val_get(smear_section, "FIXED_MAGNETIC_MOMENT", &
506  r_val=smear%fixed_mag_mom)
507  END IF ! do smear
508  END SUBROUTINE read_smear_section
509 
510 ! **************************************************************************************************
511 !> \brief writes out the scf parameters
512 !> \param scf_control the object you want to print
513 !> \param dft_section ...
514 !> \par History
515 !> 05.2001 created [Matthias]
516 !> 09.2002 created separated scf_control type [fawzi]
517 !> \author Matthias Krack
518 ! **************************************************************************************************
519  SUBROUTINE scf_c_write_parameters(scf_control, dft_section)
520 
521  TYPE(scf_control_type), INTENT(IN) :: scf_control
522  TYPE(section_vals_type), POINTER :: dft_section
523 
524  CHARACTER(LEN=*), PARAMETER :: routinen = 'scf_c_write_parameters'
525 
526  INTEGER :: handle, output_unit, roks_scheme
527  LOGICAL :: roks
528  REAL(kind=dp) :: elec_temp
529  TYPE(cp_logger_type), POINTER :: logger
530  TYPE(enumeration_type), POINTER :: enum
531  TYPE(keyword_type), POINTER :: keyword
532  TYPE(section_type), POINTER :: section
533  TYPE(section_vals_type), POINTER :: scf_section
534 
535  CALL timeset(routinen, handle)
536 
537  NULLIFY (logger)
538  logger => cp_get_default_logger()
539 
540  NULLIFY (scf_section)
541  NULLIFY (section)
542 
543  scf_section => section_vals_get_subs_vals(dft_section, "SCF")
544  output_unit = cp_print_key_unit_nr(logger, scf_section, "PRINT%PROGRAM_RUN_INFO", &
545  extension=".scfLog")
546 
547  IF (output_unit > 0) THEN
548 
549  IF (scf_control%max_scf > 0) THEN
550 
551  CALL create_scf_section(section)
552 
553  keyword => section_get_keyword(section, "SCF_GUESS")
554  CALL keyword_get(keyword, enum=enum)
555 
556  WRITE (unit=output_unit, &
557  fmt="(/,/,T2,A,T25,A,T51,A30,/,T25,56('-'),3(/,T25,A,T76,I5),/, "// &
558  "T25,56('-'),4(/,T25,A,T72,ES9.2),/,T25,56('-'), "// &
559  "1(/,T25,A,T71,F10.6))") &
560  "SCF PARAMETERS", &
561  "Density guess: ", adjustr(trim(enum_i2c(enum, scf_control%density_guess))), &
562  "max_scf: ", scf_control%max_scf, &
563  "max_scf_history: ", scf_control%max_scf_hist, &
564  "max_diis: ", scf_control%max_diis, &
565  "eps_scf: ", scf_control%eps_scf, &
566  "eps_scf_history: ", scf_control%eps_scf_hist, &
567  "eps_diis: ", scf_control%eps_diis, &
568  "eps_eigval: ", scf_control%eps_eigval, &
569  "level_shift [a.u.]:", scf_control%level_shift
570  IF (sum(abs(scf_control%added_mos)) > 0) THEN
571  WRITE (unit=output_unit, fmt="(T25,A,T71,2I5)") &
572  "added MOs ", scf_control%added_mos
573  END IF
574 
575  IF (scf_control%diagonalization%mom) THEN
576  ! TODO extend the output with further parameters
577  WRITE (unit=output_unit, fmt="(T25,A)") "MOM enabled"
578  END IF
579 
580  IF (scf_control%mixing_method > 0 .AND. .NOT. scf_control%use_ot) THEN
581  keyword => section_get_keyword(section, "MIXING%METHOD")
582  CALL keyword_get(keyword, enum=enum)
583  WRITE (unit=output_unit, fmt="(T25,A,/,T25,A,T51,A30)") &
584  repeat("-", 56), &
585  "Mixing method: ", adjustr(trim(enum_i2c(enum, scf_control%mixing_method)))
586  IF (scf_control%mixing_method > 1) THEN
587  WRITE (unit=output_unit, fmt="(T47,A34)") "charge density mixing in g-space"
588  END IF
589  END IF
590  IF (scf_control%smear%do_smear) THEN
591  keyword => section_get_keyword(section, "SMEAR%METHOD")
592  CALL keyword_get(keyword, enum=enum)
593  WRITE (unit=output_unit, fmt="(T25,A,/,T25,A,T51,A30)") &
594  repeat("-", 56), &
595  "Smear method: ", adjustr(trim(enum_i2c(enum, scf_control%smear%method)))
596  SELECT CASE (scf_control%smear%method)
597  CASE (smear_fermi_dirac)
598  elec_temp = cp_unit_from_cp2k(scf_control%smear%electronic_temperature, &
599  "K")
600  WRITE (unit=output_unit, fmt="(T25,A,T61,F20.1)") &
601  "Electronic temperature [K]:", elec_temp
602  WRITE (unit=output_unit, fmt="(T25,A,T71,ES10.2)") &
603  "Electronic temperature [a.u.]:", scf_control%smear%electronic_temperature, &
604  "Accuracy threshold:", scf_control%smear%eps_fermi_dirac
605  IF (scf_control%smear%fixed_mag_mom > 0.0_dp) WRITE (unit=output_unit, fmt="(T25,A,F10.5)") &
606  "Spin channel alpha and spin channel beta are smeared independently, keeping"// &
607  " fixed difference in number of electrons equal to ", scf_control%smear%fixed_mag_mom
608  CASE (smear_energy_window)
609  WRITE (unit=output_unit, fmt="(T25,A,T71,F10.6)") &
610  "Smear window [a.u.]: ", scf_control%smear%window_size
611  END SELECT
612  END IF
613 
614  CALL section_vals_val_get(dft_section, "ROKS", l_val=roks)
615  IF (roks .AND. (.NOT. scf_control%use_ot)) THEN
616  CALL section_vals_val_get(scf_section, "ROKS_SCHEME", &
617  i_val=roks_scheme)
618  keyword => section_get_keyword(section, "ROKS_SCHEME")
619  CALL keyword_get(keyword, enum=enum)
620  WRITE (unit=output_unit, fmt="(T25,A,/,T25,A,T51,A30)") &
621  repeat("-", 56), &
622  "ROKS scheme:", adjustr(trim(enum_i2c(enum, roks_scheme)))
623  SELECT CASE (roks_scheme)
624  CASE (general_roks)
625  WRITE (unit=output_unit, fmt="(T25,A,T71,F10.6)") &
626  "ROKS parameter f:", scf_control%roks_f
627  CASE (high_spin_roks)
628  WRITE (unit=output_unit, &
629  fmt="(T25,A,6(/,T25,A,T71,F10.6))") &
630  "ROKS parameters: a)lpha, b)eta; c)losed, o)pen, v)irtual", &
631  "acc", scf_control%roks_parameter(2, 2, 1), &
632  "bcc", scf_control%roks_parameter(2, 2, 2), &
633  "aoo", scf_control%roks_parameter(1, 1, 1), &
634  "boo", scf_control%roks_parameter(1, 1, 2), &
635  "avv", scf_control%roks_parameter(0, 0, 1), &
636  "bvv", scf_control%roks_parameter(0, 0, 2)
637  END SELECT
638  END IF
639  CALL section_release(section)
640 
641  IF (scf_control%outer_scf%have_scf) THEN
642  WRITE (output_unit, "(T25,56('-'),/,T25,A)") "Outer loop SCF in use "
643  SELECT CASE (scf_control%outer_scf%type)
644  CASE (outer_scf_none)
645  WRITE (output_unit, '(T25,A)') "No variables optimised in outer loop"
647  WRITE (output_unit, '(T25,A)') "DDAPC constraint enforced"
649  WRITE (output_unit, '(T25,A)') "S2 constraint enforced"
651  WRITE (output_unit, '(T25,A)') "Floating basis function optimization enforced"
653  cpabort("CDFT constraints must be defined in QS&CDFT")
654  CASE DEFAULT
655  cpabort("")
656  END SELECT
657  WRITE (output_unit, '(T25,A,T72,ES9.2)') "eps_scf", scf_control%outer_scf%eps_scf
658  WRITE (output_unit, '(T25,A,T72,I9)') "max_scf", scf_control%outer_scf%max_scf
659  SELECT CASE (scf_control%outer_scf%optimizer)
661  WRITE (output_unit, '(T25,A)') "No outer loop optimization"
663  WRITE (output_unit, '(T25,A)') "Steepest descent optimization"
665  WRITE (output_unit, '(T25,A)') "Gradient bisection"
666  WRITE (output_unit, '(T25,A,T72,I9)') "bisect_trust_count", scf_control%outer_scf%bisect_trust_count
668  WRITE (output_unit, '(T25,A)') "DIIS optimization"
669  WRITE (output_unit, '(T25,A,T72,I9)') "DIIS buffer length", &
670  scf_control%outer_scf%diis_buffer_length
673  cpabort("Selected optimizer only compatible with CDFT")
675  WRITE (output_unit, '(T25,A)') "Optimization with the secant method"
676  CASE DEFAULT
677  cpabort("")
678  END SELECT
679  WRITE (output_unit, '(T25,A,T72,ES9.2)') "step_size", scf_control%outer_scf%step_size
680  ELSE
681  WRITE (output_unit, "(T25,56('-'),/,T25,A)") "No outer SCF"
682  END IF
683 
684  END IF ! max_scf > 0
685 
686  END IF ! output_unit > 0
687 
688  CALL cp_print_key_finished_output(output_unit, logger, scf_section, &
689  "PRINT%PROGRAM_RUN_INFO")
690 
691  CALL timestop(handle)
692 
693  END SUBROUTINE scf_c_write_parameters
694 
695 ! **************************************************************************************************
696 
697 ! **************************************************************************************************
698 !> \brief ...
699 !> \param settings ...
700 !> \param scf_section ...
701 ! **************************************************************************************************
702  SUBROUTINE ot_diag_read_input(settings, scf_section)
703  TYPE(qs_ot_settings_type) :: settings
704  TYPE(section_vals_type), POINTER :: scf_section
705 
706  CHARACTER(len=*), PARAMETER :: routinen = 'ot_diag_read_input'
707 
708  INTEGER :: handle, output_unit
709  LOGICAL :: explicit
710  TYPE(cp_logger_type), POINTER :: logger
711  TYPE(section_vals_type), POINTER :: ot_section
712 
713  CALL timeset(routinen, handle)
714 
715  logger => cp_get_default_logger()
716  output_unit = cp_print_key_unit_nr(logger, scf_section, "PRINT%PROGRAM_RUN_INFO", &
717  extension=".log")
718 
719  ! decide default settings
720  CALL qs_ot_settings_init(settings)
721 
722  ! use ot input new style
723  ot_section => section_vals_get_subs_vals(scf_section, "DIAGONALIZATION%OT")
724  CALL section_vals_get(ot_section, explicit=explicit)
725 
726  CALL ot_readwrite_input(settings, ot_section, output_unit)
727 
728  CALL cp_print_key_finished_output(output_unit, logger, scf_section, &
729  "PRINT%PROGRAM_RUN_INFO")
730 
731  CALL timestop(handle)
732 
733  END SUBROUTINE ot_diag_read_input
734 
735 ! **************************************************************************************************
736 
737 END MODULE scf_control_types
various routines to log and control the output. The idea is that decisions about where to log should ...
type(cp_logger_type) function, pointer, public cp_get_default_logger()
returns the default logger
routines to handle the output, The idea is to remove the decision of wheter to output and what to out...
integer function, public cp_print_key_unit_nr(logger, basis_section, print_key_path, extension, middle_name, local, log_filename, ignore_should_output, file_form, file_position, file_action, file_status, do_backup, on_file, is_new_file, mpi_io, fout)
...
subroutine, public cp_print_key_finished_output(unit_nr, logger, basis_section, print_key_path, local, ignore_should_output, on_file, mpi_io)
should be called after you finish working with a unit obtained with cp_print_key_unit_nr,...
unit conversion facility
Definition: cp_units.F:30
real(kind=dp) function, public cp_unit_from_cp2k(value, unit_str, defaults, power)
converts from the internal cp2k units to the given unit
Definition: cp_units.F:1179
collects all constants needed in input so that they can be used without circular dependencies
integer, parameter, public smear_fermi_dirac
integer, parameter, public outer_scf_optimizer_sd
integer, parameter, public outer_scf_optimizer_bisect
integer, parameter, public outer_scf_optimizer_secant
integer, parameter, public smear_energy_window
integer, parameter, public outer_scf_cdft_constraint
integer, parameter, public outer_scf_optimizer_broyden
integer, parameter, public atomic_guess
integer, parameter, public outer_scf_basis_center_opt
integer, parameter, public direct_p_mix
integer, parameter, public outer_scf_s2_constraint
integer, parameter, public ot_algo_taylor_or_diag
integer, parameter, public smear_list
integer, parameter, public high_spin_roks
integer, parameter, public diag_ot
integer, parameter, public outer_scf_ddapc_constraint
integer, parameter, public outer_scf_optimizer_newton_ls
integer, parameter, public outer_scf_optimizer_none
integer, parameter, public outer_scf_optimizer_newton
integer, parameter, public general_roks
integer, parameter, public outer_scf_none
integer, parameter, public outer_scf_optimizer_diis
function that build the dft section of the input
subroutine, public create_scf_section(section)
creates the structure of the section with the DFT SCF parameters
represents an enumeration, i.e. a mapping between integers and strings
character(len=default_string_length) function, public enum_i2c(enum, i)
maps an integer to a string
represents keywords in an input
subroutine, public keyword_get(keyword, names, usage, description, type_of_var, n_var, default_value, lone_keyword_value, repeats, enum, citations)
...
objects that represent the structure of input sections and the data contained in an input section
recursive type(section_vals_type) function, pointer, public section_vals_get_subs_vals(section_vals, subsection_name, i_rep_section, can_return_null)
returns the values of the requested subsection
recursive subroutine, public section_release(section)
releases the given keyword list (see doc/ReferenceCounting.html)
recursive type(keyword_type) function, pointer, public section_get_keyword(section, keyword_name)
returns the requested keyword
subroutine, public section_vals_get(section_vals, ref_count, n_repetition, n_subs_vals_rep, section, explicit)
returns various attributes about the section_vals
subroutine, public section_vals_val_get(section_vals, keyword_name, i_rep_section, i_rep_val, n_rep_val, val, l_val, i_val, r_val, c_val, l_vals, i_vals, r_vals, c_vals, explicit)
returns the requested value
Defines the basic variable types.
Definition: kinds.F:23
integer, parameter, public dp
Definition: kinds.F:34
An array-based list which grows on demand. When the internal array is full, a new array of twice the ...
Definition: list.F:24
parameters that control the outer loop of an SCF iteration
subroutine, public outer_scf_read_parameters(outer_scf, outer_scf_section)
reads the parameters of the outer_scf section into the given outer_scf
Control parameters for optimizers that work with CDFT constraints.
subroutine, public cdft_opt_type_release(cdft_opt_control)
releases the CDFT optimizer control object
orbital transformations
Definition: qs_ot_types.F:15
subroutine, public qs_ot_settings_init(settings)
sets default values for the settings type
Definition: qs_ot_types.F:215
subroutine, public ot_readwrite_input(settings, ot_section, output_unit)
...
Definition: qs_ot_types.F:733
parameters that control an scf iteration
subroutine, public scf_c_read_parameters(scf_control, inp_section)
reads the parameters of the scf section into the given scf_control
subroutine, public scf_c_release(scf_control)
releases the given scf_control (see cp2k/doc/ReferenceCounting.html)
subroutine, public scf_c_write_parameters(scf_control, dft_section)
writes out the scf parameters
subroutine, public scf_c_create(scf_control)
allocates and initializes an scf control object with the default values