LCOV - code coverage report
Current view: top level - src - qs_scf_initialization.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:4c33f95) Lines: 464 503 92.2 %
Date: 2025-01-30 06:53:08 Functions: 12 12 100.0 %

          Line data    Source code
       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 Utility routines for qs_scf
      10             : ! **************************************************************************************************
      11             : MODULE qs_scf_initialization
      12             :    USE cp_control_types,                ONLY: dft_control_type
      13             :    USE cp_dbcsr_api,                    ONLY: dbcsr_create,&
      14             :                                               dbcsr_init_p,&
      15             :                                               dbcsr_p_type,&
      16             :                                               dbcsr_type,&
      17             :                                               dbcsr_type_no_symmetry,&
      18             :                                               dbcsr_type_real_default
      19             :    USE cp_dbcsr_operations,             ONLY: copy_dbcsr_to_fm,&
      20             :                                               copy_fm_to_dbcsr,&
      21             :                                               cp_dbcsr_m_by_n_from_row_template,&
      22             :                                               cp_dbcsr_sm_fm_multiply
      23             :    USE cp_dbcsr_output,                 ONLY: write_fm_with_basis_info
      24             :    USE cp_fm_basic_linalg,              ONLY: cp_fm_column_scale,&
      25             :                                               cp_fm_row_scale,&
      26             :                                               cp_fm_transpose,&
      27             :                                               cp_fm_triangular_invert
      28             :    USE cp_fm_cholesky,                  ONLY: cp_fm_cholesky_decompose
      29             :    USE cp_fm_diag,                      ONLY: choose_eigv_solver,&
      30             :                                               cp_fm_power
      31             :    USE cp_fm_pool_types,                ONLY: cp_fm_pool_p_type,&
      32             :                                               fm_pool_get_el_struct
      33             :    USE cp_fm_struct,                    ONLY: cp_fm_struct_create,&
      34             :                                               cp_fm_struct_get,&
      35             :                                               cp_fm_struct_release,&
      36             :                                               cp_fm_struct_type
      37             :    USE cp_fm_types,                     ONLY: cp_fm_create,&
      38             :                                               cp_fm_get_info,&
      39             :                                               cp_fm_release,&
      40             :                                               cp_fm_set_all,&
      41             :                                               cp_fm_to_fm,&
      42             :                                               cp_fm_to_fm_triangular,&
      43             :                                               cp_fm_type
      44             :    USE cp_log_handling,                 ONLY: cp_get_default_logger,&
      45             :                                               cp_logger_type,&
      46             :                                               cp_to_string
      47             :    USE cp_output_handling,              ONLY: cp_p_file,&
      48             :                                               cp_print_key_finished_output,&
      49             :                                               cp_print_key_should_output,&
      50             :                                               cp_print_key_unit_nr
      51             :    USE input_constants,                 ONLY: &
      52             :         broy_mix, cholesky_dbcsr, cholesky_inverse, cholesky_off, diag_block_davidson, &
      53             :         diag_block_krylov, diag_filter_matrix, diag_ot, diag_standard, direct_p_mix, kerker_mix, &
      54             :         multisec_mix, no_mix, ot2cdft, outer_scf_none, plus_u_lowdin, pulay_mix, &
      55             :         smeagol_runtype_emtransport, wfi_frozen_method_nr, wfi_ps_method_nr, &
      56             :         wfi_use_guess_method_nr
      57             :    USE input_section_types,             ONLY: section_vals_get_subs_vals,&
      58             :                                               section_vals_type,&
      59             :                                               section_vals_val_get
      60             :    USE kinds,                           ONLY: dp
      61             :    USE kpoint_types,                    ONLY: kpoint_type
      62             :    USE message_passing,                 ONLY: mp_para_env_type
      63             :    USE parallel_gemm_api,               ONLY: parallel_gemm
      64             :    USE pw_types,                        ONLY: pw_c1d_gs_type
      65             :    USE qmmm_image_charge,               ONLY: conditional_calc_image_matrix
      66             :    USE qs_block_davidson_types,         ONLY: block_davidson_allocate,&
      67             :                                               block_davidson_env_create
      68             :    USE qs_cdft_opt_types,               ONLY: cdft_opt_type_copy
      69             :    USE qs_density_mixing_types,         ONLY: direct_mixing_nr,&
      70             :                                               mixing_storage_create,&
      71             :                                               mixing_storage_release,&
      72             :                                               no_mixing_nr
      73             :    USE qs_environment_types,            ONLY: get_qs_env,&
      74             :                                               qs_environment_type,&
      75             :                                               set_qs_env
      76             :    USE qs_fb_distribution_methods,      ONLY: fb_distribution_build
      77             :    USE qs_fb_env_methods,               ONLY: fb_env_build_atomic_halos,&
      78             :                                               fb_env_build_rcut_auto,&
      79             :                                               fb_env_read_input,&
      80             :                                               fb_env_write_info
      81             :    USE qs_fb_env_types,                 ONLY: fb_env_create,&
      82             :                                               fb_env_has_data
      83             :    USE qs_harris_types,                 ONLY: harris_type
      84             :    USE qs_harris_utils,                 ONLY: harris_density_update
      85             :    USE qs_initial_guess,                ONLY: calculate_first_density_matrix
      86             :    USE qs_kind_types,                   ONLY: get_qs_kind,&
      87             :                                               qs_kind_type,&
      88             :                                               set_qs_kind
      89             :    USE qs_ks_types,                     ONLY: qs_ks_did_change
      90             :    USE qs_matrix_pools,                 ONLY: mpools_get
      91             :    USE qs_mixing_utils,                 ONLY: charge_mixing_init,&
      92             :                                               mixing_allocate,&
      93             :                                               mixing_init
      94             :    USE qs_mo_occupation,                ONLY: set_mo_occupation
      95             :    USE qs_mo_types,                     ONLY: get_mo_set,&
      96             :                                               init_mo_set,&
      97             :                                               mo_set_type,&
      98             :                                               set_mo_set
      99             :    USE qs_outer_scf,                    ONLY: outer_loop_extrapolate,&
     100             :                                               outer_loop_switch,&
     101             :                                               outer_loop_variables_count
     102             :    USE qs_rho_atom_types,               ONLY: rho_atom_type
     103             :    USE qs_rho_methods,                  ONLY: duplicate_rho_type,&
     104             :                                               qs_rho_update_rho
     105             :    USE qs_rho_types,                    ONLY: qs_rho_create,&
     106             :                                               qs_rho_get,&
     107             :                                               qs_rho_type
     108             :    USE qs_scf_diagonalization,          ONLY: diag_subspace_allocate
     109             :    USE qs_scf_lanczos,                  ONLY: krylov_space_allocate
     110             :    USE qs_scf_output,                   ONLY: qs_scf_initial_info
     111             :    USE qs_scf_types,                    ONLY: &
     112             :         block_davidson_diag_method_nr, block_krylov_diag_method_nr, diag_subspace_env_create, &
     113             :         filter_matrix_diag_method_nr, general_diag_method_nr, krylov_space_create, &
     114             :         ot_diag_method_nr, ot_method_nr, qs_scf_env_type, scf_env_create, smeagol_method_nr, &
     115             :         special_diag_method_nr
     116             :    USE qs_wf_history_methods,           ONLY: reorthogonalize_vectors,&
     117             :                                               wfi_extrapolate,&
     118             :                                               wfi_get_method_label,&
     119             :                                               wfi_update
     120             :    USE scf_control_types,               ONLY: scf_control_type
     121             :    USE xas_env_types,                   ONLY: xas_environment_type
     122             :    USE xas_restart,                     ONLY: xas_initialize_rho
     123             : #include "./base/base_uses.f90"
     124             : 
     125             :    IMPLICIT NONE
     126             : 
     127             :    PRIVATE
     128             : 
     129             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_scf_initialization'
     130             : 
     131             :    PUBLIC:: qs_scf_env_initialize, qs_scf_env_init_basic
     132             : 
     133             : CONTAINS
     134             : 
     135             : ! **************************************************************************************************
     136             : !> \brief initializes input parameters if needed or restores values from
     137             : !>        previous runs to fill scf_env with the values required for scf
     138             : !> \param qs_env the qs_environment where to perform the scf procedure
     139             : !> \param scf_env ...
     140             : !> \param scf_control ...
     141             : !> \param scf_section ...
     142             : ! **************************************************************************************************
     143       19443 :    SUBROUTINE qs_scf_env_initialize(qs_env, scf_env, scf_control, scf_section)
     144             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     145             :       TYPE(qs_scf_env_type), POINTER                     :: scf_env
     146             :       TYPE(scf_control_type), OPTIONAL, POINTER          :: scf_control
     147             :       TYPE(section_vals_type), OPTIONAL, POINTER         :: scf_section
     148             : 
     149             :       TYPE(dft_control_type), POINTER                    :: dft_control
     150             :       TYPE(scf_control_type), POINTER                    :: my_scf_control
     151             :       TYPE(section_vals_type), POINTER                   :: dft_section, input, my_scf_section
     152             : 
     153       19443 :       CALL get_qs_env(qs_env, input=input, dft_control=dft_control)
     154             : 
     155       19443 :       IF (PRESENT(scf_control)) THEN
     156          82 :          my_scf_control => scf_control
     157             :       ELSE
     158       19361 :          CALL get_qs_env(qs_env, scf_control=my_scf_control)
     159             :       END IF
     160             : 
     161       19443 :       dft_section => section_vals_get_subs_vals(input, "DFT")
     162       19443 :       IF (PRESENT(scf_section)) THEN
     163          82 :          my_scf_section => scf_section
     164             :       ELSE
     165       19361 :          my_scf_section => section_vals_get_subs_vals(dft_section, "SCF")
     166             :       END IF
     167             : 
     168       19443 :       CALL qs_scf_ensure_scf_env(qs_env, scf_env)
     169             : 
     170       19443 :       CALL section_vals_val_get(my_scf_section, "CHOLESKY", i_val=scf_env%cholesky_method)
     171             : 
     172       19443 :       CALL qs_scf_ensure_mos(qs_env)
     173             : 
     174             :       ! set flags for diagonalization
     175             :       CALL qs_scf_ensure_diagonalization(scf_env, my_scf_section, qs_env, &
     176       19443 :                                          my_scf_control, qs_env%has_unit_metric)
     177             :       ! set parameters for mixing/DIIS during scf
     178       19443 :       CALL qs_scf_ensure_mixing(my_scf_control, my_scf_section, scf_env, dft_control)
     179             : 
     180       19443 :       CALL qs_scf_ensure_work_matrices(qs_env, scf_env)
     181             : 
     182       19443 :       CALL qs_scf_ensure_mixing_store(qs_env, scf_env)
     183             : 
     184             :       ! Initialize outer loop variables: handle CDFT and regular outer loop separately
     185       19443 :       IF (dft_control%qs_control%cdft) THEN
     186             :          CALL qs_scf_ensure_cdft_loop_vars(qs_env, scf_env, dft_control, &
     187         326 :                                            scf_control=my_scf_control)
     188             :       ELSE
     189       19117 :          CALL qs_scf_ensure_outer_loop_vars(scf_env, my_scf_control)
     190             :       END IF
     191             : 
     192       19443 :       CALL init_scf_run(scf_env, qs_env, my_scf_section, my_scf_control)
     193             : 
     194       19443 :    END SUBROUTINE qs_scf_env_initialize
     195             : 
     196             : ! **************************************************************************************************
     197             : !> \brief initializes input parameters if needed for non-scf calclulations using diagonalization
     198             : !> \param qs_env the qs_environment where to perform the scf procedure
     199             : !> \param scf_env ...
     200             : ! **************************************************************************************************
     201           2 :    SUBROUTINE qs_scf_env_init_basic(qs_env, scf_env)
     202             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     203             :       TYPE(qs_scf_env_type), POINTER                     :: scf_env
     204             : 
     205             :       TYPE(dft_control_type), POINTER                    :: dft_control
     206             :       TYPE(scf_control_type), POINTER                    :: scf_control
     207             :       TYPE(section_vals_type), POINTER                   :: dft_section, input, scf_section
     208             : 
     209           2 :       CALL get_qs_env(qs_env, input=input, dft_control=dft_control)
     210             : 
     211           2 :       CALL get_qs_env(qs_env, scf_control=scf_control)
     212           2 :       dft_section => section_vals_get_subs_vals(input, "DFT")
     213           2 :       scf_section => section_vals_get_subs_vals(dft_section, "SCF")
     214             : 
     215           2 :       CALL qs_scf_ensure_scf_env(qs_env, scf_env)
     216             : 
     217           2 :       CALL section_vals_val_get(scf_section, "CHOLESKY", i_val=scf_env%cholesky_method)
     218           2 :       scf_control%use_diag = .TRUE.
     219           2 :       scf_control%diagonalization%method = diag_standard
     220             : 
     221           2 :       CALL qs_scf_ensure_mos(qs_env)
     222             : 
     223             :       ! set flags for diagonalization
     224             :       CALL qs_scf_ensure_diagonalization(scf_env, scf_section, qs_env, &
     225           2 :                                          scf_control, qs_env%has_unit_metric)
     226           2 :       CALL qs_scf_ensure_work_matrices(qs_env, scf_env)
     227             : 
     228           2 :       CALL init_scf_run(scf_env, qs_env, scf_section, scf_control)
     229             : 
     230           2 :    END SUBROUTINE qs_scf_env_init_basic
     231             : 
     232             : ! **************************************************************************************************
     233             : !> \brief makes sure scf_env is allocated (might already be from before)
     234             : !>        in case it is present the g-space mixing storage is reset
     235             : !> \param qs_env ...
     236             : !> \param scf_env ...
     237             : ! **************************************************************************************************
     238       19445 :    SUBROUTINE qs_scf_ensure_scf_env(qs_env, scf_env)
     239             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     240             :       TYPE(qs_scf_env_type), POINTER                     :: scf_env
     241             : 
     242       19445 :       TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER        :: rho_g
     243             :       TYPE(qs_rho_type), POINTER                         :: rho
     244             : 
     245       19445 :       NULLIFY (rho_g)
     246             : 
     247       25702 :       IF (.NOT. ASSOCIATED(scf_env)) THEN ! i.e. for MD this is associated on the second step (it so seems)
     248        6257 :          ALLOCATE (scf_env)
     249        6257 :          CALL scf_env_create(scf_env)
     250             :       ELSE
     251             :          ! Reallocate mixing store, if the g space grid (cell) has changed
     252       13238 :          SELECT CASE (scf_env%mixing_method)
     253             :          CASE (kerker_mix, pulay_mix, broy_mix, multisec_mix)
     254       13188 :             IF (ASSOCIATED(scf_env%mixing_store)) THEN
     255             :                ! The current mixing_store data structure does not allow for an unique
     256             :                ! grid comparison, but the probability that the 1d lengths of the old and
     257             :                ! the new grid are accidentily equal is rather low
     258          50 :                CALL get_qs_env(qs_env, rho=rho)
     259          50 :                CALL qs_rho_get(rho, rho_g=rho_g)
     260          50 :                IF (ASSOCIATED(scf_env%mixing_store%rhoin)) THEN
     261          30 :                   IF (SIZE(rho_g(1)%pw_grid%gsq) /= SIZE(scf_env%mixing_store%rhoin(1)%cc)) THEN
     262           0 :                      CALL mixing_storage_release(scf_env%mixing_store)
     263           0 :                      DEALLOCATE (scf_env%mixing_store)
     264             :                   END IF
     265             :                END IF
     266             :             END IF
     267             :          END SELECT
     268             :       END IF
     269             : 
     270       19445 :    END SUBROUTINE qs_scf_ensure_scf_env
     271             : 
     272             : ! **************************************************************************************************
     273             : !> \brief performs allocation of outer SCF variables
     274             : !> \param scf_env the SCF environment which contains the outer SCF variables
     275             : !> \param scf_control control settings for the outer SCF loop
     276             : !> \param nvar (optional) set number of outer SCF variables externally if CDFT SCF is active
     277             : ! **************************************************************************************************
     278       19443 :    SUBROUTINE qs_scf_ensure_outer_loop_vars(scf_env, scf_control, nvar)
     279             :       TYPE(qs_scf_env_type), POINTER                     :: scf_env
     280             :       TYPE(scf_control_type), POINTER                    :: scf_control
     281             :       INTEGER, OPTIONAL                                  :: nvar
     282             : 
     283             :       INTEGER                                            :: nhistory, nvariables
     284             : 
     285       19443 :       IF (scf_control%outer_scf%have_scf) THEN
     286        3833 :          nhistory = scf_control%outer_scf%max_scf + 1
     287        3833 :          IF (PRESENT(nvar)) THEN
     288         326 :             IF (nvar > 0) THEN
     289             :                nvariables = nvar
     290             :             ELSE
     291           0 :                nvariables = outer_loop_variables_count(scf_control)
     292             :             END IF
     293             :          ELSE
     294        3507 :             nvariables = outer_loop_variables_count(scf_control)
     295             :          END IF
     296       15332 :          ALLOCATE (scf_env%outer_scf%variables(nvariables, nhistory))
     297       11499 :          ALLOCATE (scf_env%outer_scf%count(nhistory))
     298       72493 :          scf_env%outer_scf%count = 0
     299       11499 :          ALLOCATE (scf_env%outer_scf%gradient(nvariables, nhistory))
     300       11499 :          ALLOCATE (scf_env%outer_scf%energy(nhistory))
     301             :       END IF
     302             : 
     303       19443 :    END SUBROUTINE qs_scf_ensure_outer_loop_vars
     304             : 
     305             : ! **************************************************************************************************
     306             : !> \brief performs allocation of CDFT SCF variables
     307             : !> \param qs_env the qs_env where to perform the allocation
     308             : !> \param scf_env the currently active scf_env
     309             : !> \param dft_control the dft_control that holds the cdft_control type
     310             : !> \param scf_control the currently active scf_control
     311             : ! **************************************************************************************************
     312         326 :    SUBROUTINE qs_scf_ensure_cdft_loop_vars(qs_env, scf_env, dft_control, scf_control)
     313             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     314             :       TYPE(qs_scf_env_type), POINTER                     :: scf_env
     315             :       TYPE(dft_control_type), POINTER                    :: dft_control
     316             :       TYPE(scf_control_type), POINTER                    :: scf_control
     317             : 
     318             :       INTEGER                                            :: nhistory, nvariables
     319             :       LOGICAL                                            :: do_kpoints
     320         326 :       REAL(KIND=dp), DIMENSION(:, :), POINTER            :: gradient_history, outer_scf_history, &
     321         326 :                                                             variable_history
     322             : 
     323         326 :       NULLIFY (outer_scf_history, gradient_history, variable_history)
     324         326 :       CALL get_qs_env(qs_env=qs_env, do_kpoints=do_kpoints)
     325             :       ! Test kpoints
     326         326 :       IF (do_kpoints) &
     327           0 :          CPABORT("CDFT calculation not possible with kpoints")
     328             :       ! Check that OUTER_SCF section in DFT&SCF is active
     329             :       ! This section must always be active to facilitate
     330             :       ! switching of the CDFT and SCF control parameters in outer_loop_switch
     331         326 :       IF (.NOT. scf_control%outer_scf%have_scf) &
     332           0 :          CPABORT("Section SCF&OUTER_SCF must be active for CDFT calculations.")
     333             :       ! Initialize CDFT and outer_loop variables (constraint settings active in scf_control)
     334         326 :       IF (dft_control%qs_control%cdft_control%constraint_control%have_scf) THEN
     335         326 :          nhistory = dft_control%qs_control%cdft_control%constraint_control%max_scf + 1
     336         326 :          IF (scf_control%outer_scf%type /= outer_scf_none) THEN
     337             :             nvariables = outer_loop_variables_count(scf_control, &
     338          62 :                                                     dft_control%qs_control%cdft_control)
     339             :          ELSE
     340             :             ! First iteration: scf_control has not yet been updated
     341         264 :             nvariables = SIZE(dft_control%qs_control%cdft_control%target)
     342             :          END IF
     343        1304 :          ALLOCATE (dft_control%qs_control%cdft_control%constraint%variables(nvariables, nhistory))
     344         978 :          ALLOCATE (dft_control%qs_control%cdft_control%constraint%count(nhistory))
     345        2246 :          dft_control%qs_control%cdft_control%constraint%count = 0
     346         978 :          ALLOCATE (dft_control%qs_control%cdft_control%constraint%gradient(nvariables, nhistory))
     347         978 :          ALLOCATE (dft_control%qs_control%cdft_control%constraint%energy(nhistory))
     348         326 :          CALL qs_scf_ensure_outer_loop_vars(scf_env, scf_control, nvariables)
     349             :       END IF
     350             :       ! Executed only on first call (OT settings active in scf_control)
     351             :       ! Save OT settings and constraint initial values in CDFT control
     352             :       ! Then switch to constraint outer_scf settings for proper initialization of history
     353         326 :       IF (scf_control%outer_scf%have_scf) THEN
     354         326 :          IF (scf_control%outer_scf%type == outer_scf_none) THEN
     355         264 :             dft_control%qs_control%cdft_control%ot_control%have_scf = .TRUE.
     356         264 :             dft_control%qs_control%cdft_control%ot_control%max_scf = scf_control%outer_scf%max_scf
     357         264 :             dft_control%qs_control%cdft_control%ot_control%eps_scf = scf_control%outer_scf%eps_scf
     358         264 :             dft_control%qs_control%cdft_control%ot_control%step_size = scf_control%outer_scf%step_size
     359         264 :             dft_control%qs_control%cdft_control%ot_control%type = scf_control%outer_scf%type
     360         264 :             dft_control%qs_control%cdft_control%ot_control%optimizer = scf_control%outer_scf%optimizer
     361         264 :             dft_control%qs_control%cdft_control%ot_control%diis_buffer_length = scf_control%outer_scf%diis_buffer_length
     362         264 :             dft_control%qs_control%cdft_control%ot_control%bisect_trust_count = scf_control%outer_scf%bisect_trust_count
     363             :             CALL cdft_opt_type_copy(dft_control%qs_control%cdft_control%ot_control%cdft_opt_control, &
     364         264 :                                     scf_control%outer_scf%cdft_opt_control)
     365             :             ! In case constraint and OT extrapolation orders are different, make sure to use former
     366         264 :             nvariables = SIZE(dft_control%qs_control%cdft_control%target)
     367             :             IF (scf_control%outer_scf%extrapolation_order /= &
     368             :                 dft_control%qs_control%cdft_control%constraint_control%extrapolation_order &
     369         264 :                 .OR. nvariables /= 1) THEN
     370         256 :                DEALLOCATE (qs_env%outer_scf_history)
     371         256 :                DEALLOCATE (qs_env%gradient_history)
     372         256 :                DEALLOCATE (qs_env%variable_history)
     373         256 :                nhistory = dft_control%qs_control%cdft_control%constraint_control%extrapolation_order
     374        1024 :                ALLOCATE (outer_scf_history(nvariables, nhistory))
     375         768 :                ALLOCATE (gradient_history(nvariables, 2))
     376        1324 :                gradient_history = 0.0_dp
     377         512 :                ALLOCATE (variable_history(nvariables, 2))
     378        1324 :                variable_history = 0.0_dp
     379             :                CALL set_qs_env(qs_env, outer_scf_history=outer_scf_history, &
     380         256 :                                gradient_history=gradient_history, variable_history=variable_history)
     381             :             END IF
     382         264 :             CALL outer_loop_switch(scf_env, scf_control, dft_control%qs_control%cdft_control, ot2cdft)
     383             :          END IF
     384             :       END IF
     385             : 
     386         326 :    END SUBROUTINE qs_scf_ensure_cdft_loop_vars
     387             : 
     388             : ! **************************************************************************************************
     389             : !> \brief performs allocation of the mixing storage
     390             : !> \param qs_env ...
     391             : !> \param scf_env ...
     392             : ! **************************************************************************************************
     393       19443 :    SUBROUTINE qs_scf_ensure_mixing_store(qs_env, scf_env)
     394             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     395             :       TYPE(qs_scf_env_type), POINTER                     :: scf_env
     396             : 
     397             :       TYPE(dft_control_type), POINTER                    :: dft_control
     398             : 
     399       19443 :       NULLIFY (dft_control)
     400       19443 :       CALL get_qs_env(qs_env=qs_env, dft_control=dft_control)
     401             : 
     402       19443 :       IF (scf_env%mixing_method > 0) THEN
     403             :          CALL mixing_allocate(qs_env, scf_env%mixing_method, scf_env%p_mix_new, &
     404             :                               scf_env%p_delta, dft_control%nspins, &
     405       13962 :                               scf_env%mixing_store)
     406             :       ELSE
     407        5481 :          NULLIFY (scf_env%p_mix_new)
     408             :       END IF
     409             : 
     410       19443 :    END SUBROUTINE qs_scf_ensure_mixing_store
     411             : 
     412             : ! **************************************************************************************************
     413             : !> \brief Performs allocation of the SCF work matrices
     414             : !>        In case of kpoints we probably don't need most of these matrices,
     415             : !>        maybe we have to initialize some matrices in the fm_pool in kpoints
     416             : !> \param qs_env ...
     417             : !> \param scf_env ...
     418             : ! **************************************************************************************************
     419       58335 :    SUBROUTINE qs_scf_ensure_work_matrices(qs_env, scf_env)
     420             : 
     421             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     422             :       TYPE(qs_scf_env_type), POINTER                     :: scf_env
     423             : 
     424             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'qs_scf_ensure_work_matrices'
     425             : 
     426             :       INTEGER                                            :: handle, is, nao, nrow_block, nw
     427             :       LOGICAL                                            :: do_kpoints
     428       19445 :       TYPE(cp_fm_pool_p_type), DIMENSION(:), POINTER     :: ao_mo_fm_pools
     429             :       TYPE(cp_fm_struct_type), POINTER                   :: ao_ao_fmstruct, ao_mo_fmstruct
     430       19445 :       TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER       :: matrix_s
     431             :       TYPE(dbcsr_type), POINTER                          :: ref_matrix
     432             :       TYPE(dft_control_type), POINTER                    :: dft_control
     433       19445 :       TYPE(mo_set_type), DIMENSION(:), POINTER           :: mos
     434             :       TYPE(scf_control_type), POINTER                    :: scf_control
     435             : 
     436       19445 :       CALL timeset(routineN, handle)
     437             : 
     438       19445 :       NULLIFY (ao_mo_fm_pools, ao_mo_fmstruct, ao_ao_fmstruct, dft_control, matrix_s, mos)
     439             : 
     440             :       CALL get_qs_env(qs_env=qs_env, &
     441             :                       dft_control=dft_control, &
     442             :                       matrix_s_kp=matrix_s, &
     443             :                       mos=mos, &
     444             :                       scf_control=scf_control, &
     445       19445 :                       do_kpoints=do_kpoints)
     446       19445 :       CALL mpools_get(qs_env%mpools, ao_mo_fm_pools=ao_mo_fm_pools)
     447             : 
     448             :       ! create an ao_ao parallel matrix structure
     449       19445 :       ao_mo_fmstruct => fm_pool_get_el_struct(ao_mo_fm_pools(1)%pool)
     450       19445 :       CALL cp_fm_struct_get(ao_mo_fmstruct, nrow_block=nrow_block)
     451       19445 :       CALL get_mo_set(mos(1), nao=nao)
     452             :       CALL cp_fm_struct_create(fmstruct=ao_ao_fmstruct, &
     453             :                                nrow_block=nrow_block, &
     454             :                                ncol_block=nrow_block, &
     455             :                                nrow_global=nao, &
     456             :                                ncol_global=nao, &
     457       19445 :                                template_fmstruct=ao_mo_fmstruct)
     458             : 
     459       19445 :       IF ((scf_env%method /= ot_method_nr) .AND. &
     460             :           (scf_env%method /= block_davidson_diag_method_nr)) THEN
     461       13948 :          IF (.NOT. ASSOCIATED(scf_env%scf_work1)) THEN
     462       12500 :             nw = dft_control%nspins
     463       12500 :             IF (do_kpoints) nw = 4
     464       53364 :             ALLOCATE (scf_env%scf_work1(nw))
     465       28364 :             DO is = 1, SIZE(scf_env%scf_work1)
     466             :                CALL cp_fm_create(scf_env%scf_work1(is), &
     467             :                                  matrix_struct=ao_ao_fmstruct, &
     468       28364 :                                  name="SCF-WORK_MATRIX-1-"//TRIM(ADJUSTL(cp_to_string(is))))
     469             :             END DO
     470             :          END IF
     471             :          IF ((.NOT. ASSOCIATED(scf_env%ortho)) .AND. &
     472       13948 :              (scf_env%method /= ot_diag_method_nr) .AND. &
     473             :              (scf_env%method /= special_diag_method_nr)) THEN
     474             :             ! Initialize fm matrix to store the Cholesky decomposition
     475        9836 :             ALLOCATE (scf_env%ortho)
     476             :             CALL cp_fm_create(scf_env%ortho, &
     477             :                               matrix_struct=ao_ao_fmstruct, &
     478        9836 :                               name="SCF-ORTHO_MATRIX")
     479             :             ! Initialize dbcsr matrix to store the Cholesky decomposition
     480        9836 :             IF (scf_env%cholesky_method == cholesky_dbcsr) THEN
     481          58 :                ref_matrix => matrix_s(1, 1)%matrix
     482          58 :                CALL dbcsr_init_p(scf_env%ortho_dbcsr)
     483             :                CALL dbcsr_create(scf_env%ortho_dbcsr, template=ref_matrix, &
     484          58 :                                  matrix_type=dbcsr_type_no_symmetry)
     485          58 :                CALL dbcsr_init_p(scf_env%buf1_dbcsr)
     486             :                CALL dbcsr_create(scf_env%buf1_dbcsr, template=ref_matrix, &
     487          58 :                                  matrix_type=dbcsr_type_no_symmetry)
     488          58 :                CALL dbcsr_init_p(scf_env%buf2_dbcsr)
     489             :                CALL dbcsr_create(scf_env%buf2_dbcsr, template=ref_matrix, &
     490          58 :                                  matrix_type=dbcsr_type_no_symmetry)
     491        9778 :             ELSE IF (scf_env%cholesky_method == cholesky_inverse .OR. &
     492             :                      (scf_control%level_shift /= 0.0_dp .AND. &
     493             :                       scf_env%cholesky_method == cholesky_off)) THEN
     494          50 :                ALLOCATE (scf_env%ortho_m1)
     495             :                CALL cp_fm_create(scf_env%ortho_m1, &
     496             :                                  matrix_struct=ao_ao_fmstruct, &
     497          50 :                                  name="SCF-ORTHO_MATRIX-1")
     498             :             END IF
     499             :          END IF
     500       13948 :          IF (.NOT. ASSOCIATED(scf_env%scf_work2)) THEN
     501       12500 :             ALLOCATE (scf_env%scf_work2)
     502             :             CALL cp_fm_create(scf_env%scf_work2, &
     503             :                               matrix_struct=ao_ao_fmstruct, &
     504       12500 :                               name="SCF-WORK_MATRIX-2")
     505             :          END IF
     506             :       END IF
     507             : 
     508       19445 :       IF (dft_control%dft_plus_u) THEN
     509          80 :          IF (dft_control%plus_u_method_id == plus_u_lowdin) THEN
     510           8 :             IF (.NOT. ASSOCIATED(scf_env%scf_work2)) THEN
     511           4 :                ALLOCATE (scf_env%scf_work2)
     512             :                CALL cp_fm_create(scf_env%scf_work2, &
     513             :                                  matrix_struct=ao_ao_fmstruct, &
     514           4 :                                  name="SCF-WORK_MATRIX-2")
     515             :             END IF
     516           8 :             IF (.NOT. ASSOCIATED(scf_env%s_half)) THEN
     517           8 :                ALLOCATE (scf_env%s_half)
     518             :                CALL cp_fm_create(scf_env%s_half, &
     519             :                                  matrix_struct=ao_ao_fmstruct, &
     520           8 :                                  name="S**(1/2) MATRIX")
     521             :             END IF
     522             :          END IF
     523             :       END IF
     524             : 
     525       19445 :       IF (do_kpoints) THEN
     526         912 :          IF (.NOT. ASSOCIATED(scf_env%scf_work1)) THEN
     527           0 :             nw = 4
     528           0 :             ALLOCATE (scf_env%scf_work1(nw))
     529           0 :             DO is = 1, SIZE(scf_env%scf_work1)
     530             :                CALL cp_fm_create(scf_env%scf_work1(is), &
     531             :                                  matrix_struct=ao_ao_fmstruct, &
     532           0 :                                  name="SCF-WORK_MATRIX-1-"//TRIM(ADJUSTL(cp_to_string(is))))
     533             :             END DO
     534             :          END IF
     535             :       END IF
     536             : 
     537       19445 :       CALL cp_fm_struct_release(ao_ao_fmstruct)
     538             : 
     539       19445 :       CALL timestop(handle)
     540             : 
     541       19445 :    END SUBROUTINE qs_scf_ensure_work_matrices
     542             : 
     543             : ! **************************************************************************************************
     544             : !> \brief performs allocation of the MO matrices
     545             : !> \param qs_env ...
     546             : ! **************************************************************************************************
     547       19445 :    SUBROUTINE qs_scf_ensure_mos(qs_env)
     548             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     549             : 
     550             :       CHARACTER(len=*), PARAMETER                        :: routineN = 'qs_scf_ensure_mos'
     551             : 
     552             :       INTEGER                                            :: handle, ic, ik, ikk, ispin, nmo, nmo_mat
     553       19445 :       TYPE(cp_fm_pool_p_type), DIMENSION(:), POINTER     :: ao_mo_fm_pools
     554             :       TYPE(cp_fm_type), POINTER                          :: mo_coeff, mo_coeff_last
     555       19445 :       TYPE(dbcsr_p_type), DIMENSION(:), POINTER          :: mo_derivs
     556       19445 :       TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER       :: matrix_s
     557             :       TYPE(dbcsr_type), POINTER                          :: mo_coeff_b
     558             :       TYPE(dft_control_type), POINTER                    :: dft_control
     559             :       TYPE(kpoint_type), POINTER                         :: kpoints
     560       19445 :       TYPE(mo_set_type), DIMENSION(:), POINTER           :: mos, mos_last_converged
     561       19445 :       TYPE(mo_set_type), DIMENSION(:, :), POINTER        :: mos_k
     562             :       TYPE(xas_environment_type), POINTER                :: xas_env
     563             : 
     564       19445 :       CALL timeset(routineN, handle)
     565             : 
     566       19445 :       NULLIFY (ao_mo_fm_pools, dft_control, mos, xas_env, matrix_s, mos_last_converged, mo_coeff_last)
     567             : 
     568             :       CALL get_qs_env(qs_env=qs_env, &
     569             :                       dft_control=dft_control, &
     570             :                       mos=mos, &
     571             :                       matrix_s_kp=matrix_s, &
     572       19445 :                       xas_env=xas_env)
     573       19445 :       CALL mpools_get(qs_env%mpools, ao_mo_fm_pools=ao_mo_fm_pools)
     574       19445 :       IF (dft_control%switch_surf_dip) THEN
     575           2 :          CALL get_qs_env(qs_env, mos_last_converged=mos_last_converged)
     576             :       END IF
     577             : 
     578       19445 :       nmo_mat = dft_control%nspins
     579       19445 :       IF (dft_control%restricted) nmo_mat = 1 ! right now, there might be more mos than needed derivs
     580             : 
     581             : !   *** finish initialization of the MOs ***
     582       19445 :       CPASSERT(ASSOCIATED(mos))
     583       41418 :       DO ispin = 1, SIZE(mos)
     584       21973 :          CALL get_mo_set(mos(ispin), mo_coeff=mo_coeff, mo_coeff_b=mo_coeff_b)
     585       21973 :          IF (.NOT. ASSOCIATED(mo_coeff)) THEN
     586             :             CALL init_mo_set(mos(ispin), &
     587             :                              fm_pool=ao_mo_fm_pools(ispin)%pool, &
     588        7724 :                              name="qs_env%mo"//TRIM(ADJUSTL(cp_to_string(ispin))))
     589             :          END IF
     590       41418 :          IF (.NOT. ASSOCIATED(mo_coeff_b)) THEN
     591        7724 :             CALL cp_fm_get_info(mos(ispin)%mo_coeff, ncol_global=nmo)
     592        7724 :             CALL dbcsr_init_p(mos(ispin)%mo_coeff_b)
     593             :             CALL cp_dbcsr_m_by_n_from_row_template(mos(ispin)%mo_coeff_b, template=matrix_s(1, 1)%matrix, n=nmo, &
     594        7724 :                                                    sym=dbcsr_type_no_symmetry)
     595             :          END IF
     596             :       END DO
     597             : !   *** get the mo_derivs OK if needed ***
     598       19445 :       IF (qs_env%requires_mo_derivs) THEN
     599        5487 :          CALL get_qs_env(qs_env, mo_derivs=mo_derivs)
     600        5487 :          IF (.NOT. ASSOCIATED(mo_derivs)) THEN
     601        8401 :             ALLOCATE (mo_derivs(nmo_mat))
     602        4495 :             DO ispin = 1, nmo_mat
     603        2542 :                CALL get_mo_set(mos(ispin), mo_coeff_b=mo_coeff_b)
     604        2542 :                NULLIFY (mo_derivs(ispin)%matrix)
     605        2542 :                CALL dbcsr_init_p(mo_derivs(ispin)%matrix)
     606             :                CALL dbcsr_create(mo_derivs(ispin)%matrix, template=mo_coeff_b, &
     607             :                                  name="mo_derivs", matrix_type=dbcsr_type_no_symmetry, &
     608        4495 :                                  nze=0, data_type=dbcsr_type_real_default)
     609             :             END DO
     610        1953 :             CALL set_qs_env(qs_env, mo_derivs=mo_derivs)
     611             :          END IF
     612             : 
     613             :       ELSE
     614             :          ! nothing should be done
     615             :       END IF
     616             : 
     617             : !   *** finish initialization of the MOs for ADMM and derivs if needed ***
     618       19445 :       IF (dft_control%do_admm) THEN
     619         786 :          IF (dft_control%restricted) CPABORT("ROKS with ADMM is not implemented")
     620             :       END IF
     621             : 
     622             : ! *** finish initialization of mos_last_converged *** [SGh]
     623       19445 :       IF (dft_control%switch_surf_dip) THEN
     624           2 :          CPASSERT(ASSOCIATED(mos_last_converged))
     625           4 :          DO ispin = 1, SIZE(mos_last_converged)
     626           2 :             CALL get_mo_set(mos_last_converged(ispin), mo_coeff=mo_coeff_last)
     627           4 :             IF (.NOT. ASSOCIATED(mo_coeff_last)) THEN
     628             :                CALL init_mo_set(mos_last_converged(ispin), &
     629             :                                 fm_ref=mos(ispin)%mo_coeff, &
     630           2 :                                 name="qs_env%mos_last_converged"//TRIM(ADJUSTL(cp_to_string(ispin))))
     631             :             END IF
     632             :          END DO
     633             :       END IF
     634             :       ! kpoints: we have to initialize all the k-point MOs
     635       19445 :       CALL get_qs_env(qs_env=qs_env, kpoints=kpoints)
     636       19445 :       IF (kpoints%nkp /= 0) THEN
     637             :          ! check for some incompatible options
     638         912 :          IF (qs_env%requires_mo_derivs) THEN
     639           2 :             CPWARN("MO derivative methods flag has been switched off for kpoint calculation")
     640             :             ! we switch it off to make band structure calculations
     641             :             ! possible for OT gamma point calculations
     642           2 :             qs_env%requires_mo_derivs = .FALSE.
     643             :          END IF
     644         912 :          IF (dft_control%do_xas_calculation) &
     645           0 :             CPABORT("No XAS implemented with kpoints")
     646        3650 :          DO ik = 1, SIZE(kpoints%kp_env)
     647        2738 :             CALL mpools_get(kpoints%mpools, ao_mo_fm_pools=ao_mo_fm_pools)
     648        2738 :             mos_k => kpoints%kp_env(ik)%kpoint_env%mos
     649        2738 :             ikk = kpoints%kp_range(1) + ik - 1
     650        2738 :             CPASSERT(ASSOCIATED(mos_k))
     651        6840 :             DO ispin = 1, SIZE(mos_k, 2)
     652       12294 :                DO ic = 1, SIZE(mos_k, 1)
     653        6366 :                   CALL get_mo_set(mos_k(ic, ispin), mo_coeff=mo_coeff, mo_coeff_b=mo_coeff_b)
     654        6366 :                   IF (.NOT. ASSOCIATED(mo_coeff)) THEN
     655             :                      CALL init_mo_set(mos_k(ic, ispin), &
     656             :                                       fm_pool=ao_mo_fm_pools(ispin)%pool, &
     657             :                                       name="kpoints_"//TRIM(ADJUSTL(cp_to_string(ikk)))// &
     658        2610 :                                       "%mo"//TRIM(ADJUSTL(cp_to_string(ispin))))
     659             :                   END IF
     660             :                   ! no sparse matrix representation of kpoint MO vectors
     661        9556 :                   CPASSERT(.NOT. ASSOCIATED(mo_coeff_b))
     662             :                END DO
     663             :             END DO
     664             :          END DO
     665             :       END IF
     666             : 
     667       19445 :       CALL timestop(handle)
     668             : 
     669       19445 :    END SUBROUTINE qs_scf_ensure_mos
     670             : 
     671             : ! **************************************************************************************************
     672             : !> \brief sets flag for mixing/DIIS during scf
     673             : !> \param scf_control ...
     674             : !> \param scf_section ...
     675             : !> \param scf_env ...
     676             : !> \param dft_control ...
     677             : ! **************************************************************************************************
     678       19443 :    SUBROUTINE qs_scf_ensure_mixing(scf_control, scf_section, scf_env, dft_control)
     679             :       TYPE(scf_control_type), POINTER                    :: scf_control
     680             :       TYPE(section_vals_type), POINTER                   :: scf_section
     681             :       TYPE(qs_scf_env_type), POINTER                     :: scf_env
     682             :       TYPE(dft_control_type), POINTER                    :: dft_control
     683             : 
     684             :       TYPE(section_vals_type), POINTER                   :: mixing_section
     685             : 
     686       19443 :       SELECT CASE (scf_control%mixing_method)
     687             :       CASE (no_mix)
     688           0 :          scf_env%mixing_method = no_mixing_nr
     689           0 :          scf_env%p_mix_alpha = 1.0_dp
     690             :       CASE (direct_p_mix, kerker_mix, pulay_mix, broy_mix, multisec_mix)
     691       19443 :          scf_env%mixing_method = scf_control%mixing_method
     692       19443 :          mixing_section => section_vals_get_subs_vals(scf_section, "MIXING")
     693       19443 :          IF (.NOT. ASSOCIATED(scf_env%mixing_store)) THEN
     694       25020 :             ALLOCATE (scf_env%mixing_store)
     695             :             CALL mixing_storage_create(scf_env%mixing_store, mixing_section, scf_env%mixing_method, &
     696        6255 :                                        dft_control%qs_control%cutoff)
     697             :          END IF
     698             :       CASE DEFAULT
     699       19443 :          CPABORT("Unknown mixing method")
     700             :       END SELECT
     701             : 
     702             :       ! Disable DIIS for OT and g-space density mixing methods
     703       19443 :       IF (scf_env%method == ot_method_nr) THEN
     704             :          ! No mixing is used with OT
     705        5481 :          scf_env%mixing_method = no_mixing_nr
     706        5481 :          scf_env%p_mix_alpha = 1.0_dp
     707        5481 :          scf_env%skip_diis = .TRUE.
     708             :       END IF
     709             : 
     710       19443 :       IF (scf_control%use_diag .AND. scf_env%mixing_method == no_mixing_nr) THEN
     711           0 :          CPABORT("Diagonalization procedures without mixing are not recommendable")
     712             :       END IF
     713             : 
     714       19443 :       IF (scf_env%mixing_method > direct_mixing_nr) THEN
     715         246 :          scf_env%skip_diis = .TRUE.
     716         246 :          scf_env%p_mix_alpha = scf_env%mixing_store%alpha
     717         246 :          IF (scf_env%mixing_store%beta == 0.0_dp) THEN
     718           0 :             CPABORT("Mixing employing the Kerker damping factor needs BETA /= 0.0")
     719             :          END IF
     720             :       END IF
     721             : 
     722       19443 :       IF (scf_env%mixing_method == direct_mixing_nr) THEN
     723       13716 :          scf_env%p_mix_alpha = scf_env%mixing_store%alpha
     724       13716 :          IF (scf_control%eps_diis < scf_control%eps_scf) THEN
     725          42 :             scf_env%skip_diis = .TRUE.
     726          42 :             CPWARN("the DIIS scheme is disabled, since EPS_DIIS < EPS_SCF")
     727             :          END IF
     728             :       END IF
     729             : 
     730       19443 :    END SUBROUTINE qs_scf_ensure_mixing
     731             : 
     732             : ! **************************************************************************************************
     733             : !> \brief sets flags for diagonalization and ensure that everything is
     734             : !>        allocated
     735             : !> \param scf_env ...
     736             : !> \param scf_section ...
     737             : !> \param qs_env ...
     738             : !> \param scf_control ...
     739             : !> \param has_unit_metric ...
     740             : ! **************************************************************************************************
     741       19445 :    SUBROUTINE qs_scf_ensure_diagonalization(scf_env, scf_section, qs_env, &
     742             :                                             scf_control, has_unit_metric)
     743             :       TYPE(qs_scf_env_type), POINTER                     :: scf_env
     744             :       TYPE(section_vals_type), POINTER                   :: scf_section
     745             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     746             :       TYPE(scf_control_type), POINTER                    :: scf_control
     747             :       LOGICAL                                            :: has_unit_metric
     748             : 
     749             :       INTEGER                                            :: ispin, nao, nmo
     750             :       LOGICAL                                            :: do_kpoints, need_coeff_b, not_se_or_tb
     751             :       TYPE(cp_fm_type), POINTER                          :: mo_coeff
     752             :       TYPE(dft_control_type), POINTER                    :: dft_control
     753       19445 :       TYPE(mo_set_type), DIMENSION(:), POINTER           :: mos
     754             : 
     755       19445 :       CALL get_qs_env(qs_env=qs_env, do_kpoints=do_kpoints, dft_control=dft_control, mos=mos)
     756             :       not_se_or_tb = .NOT. (dft_control%qs_control%dftb .OR. dft_control%qs_control%xtb .OR. &
     757       19445 :                             dft_control%qs_control%semi_empirical)
     758       19445 :       need_coeff_b = .FALSE.
     759       19445 :       scf_env%needs_ortho = .FALSE.
     760             : 
     761       19445 :       IF (dft_control%smeagol_control%smeagol_enabled .AND. &
     762             :           dft_control%smeagol_control%run_type == smeagol_runtype_emtransport) THEN
     763           0 :          scf_env%method = smeagol_method_nr
     764           0 :          scf_env%skip_diis = .TRUE.
     765           0 :          scf_control%use_diag = .FALSE.
     766             : 
     767           0 :          IF (.NOT. do_kpoints) THEN
     768           0 :             CPABORT("SMEAGOL requires kpoint calculations")
     769             :          END IF
     770           0 :          CPWARN_IF(scf_control%use_ot, "OT is irrelevant to NEGF method")
     771             :       END IF
     772             : 
     773       19445 :       IF (scf_control%use_diag) THEN
     774             :          ! sanity check whether combinations are allowed
     775       13964 :          IF (dft_control%restricted) &
     776           0 :             CPABORT("OT only for restricted (ROKS)")
     777       13996 :          SELECT CASE (scf_control%diagonalization%method)
     778             :          CASE (diag_ot, diag_block_krylov, diag_block_davidson)
     779          32 :             IF (.NOT. not_se_or_tb) &
     780       13964 :                CPABORT("TB and SE not possible with OT diagonalization")
     781             :          END SELECT
     782       27886 :          SELECT CASE (scf_control%diagonalization%method)
     783             :             ! Diagonalization: additional check whether we are in an orthonormal basis
     784             :          CASE (diag_standard)
     785       13922 :             scf_env%method = general_diag_method_nr
     786       13922 :             scf_env%needs_ortho = (.NOT. has_unit_metric) .AND. (.NOT. do_kpoints)
     787       13922 :             IF (has_unit_metric) THEN
     788        2656 :                scf_env%method = special_diag_method_nr
     789             :             END IF
     790             :             ! OT Diagonalization: not possible with ROKS
     791             :          CASE (diag_ot)
     792           8 :             IF (dft_control%roks) &
     793           0 :                CPABORT("ROKS with OT diagonalization not possible")
     794           8 :             IF (do_kpoints) &
     795           0 :                CPABORT("OT diagonalization not possible with kpoint calculations")
     796           8 :             scf_env%method = ot_diag_method_nr
     797           8 :             need_coeff_b = .TRUE.
     798             :             ! Block Krylov diagonlization: not possible with ROKS,
     799             :             ! allocation of additional matrices is needed
     800             :          CASE (diag_block_krylov)
     801           8 :             IF (dft_control%roks) &
     802           0 :                CPABORT("ROKS with block PF diagonalization not possible")
     803           8 :             IF (do_kpoints) &
     804           0 :                CPABORT("Block Krylov diagonalization not possible with kpoint calculations")
     805           8 :             scf_env%method = block_krylov_diag_method_nr
     806           8 :             scf_env%needs_ortho = .TRUE.
     807           8 :             IF (.NOT. ASSOCIATED(scf_env%krylov_space)) &
     808           4 :                CALL krylov_space_create(scf_env%krylov_space, scf_section)
     809           8 :             CALL krylov_space_allocate(scf_env%krylov_space, scf_control, mos)
     810             :             ! Block davidson diagonlization: allocation of additional matrices is needed
     811             :          CASE (diag_block_davidson)
     812          16 :             IF (do_kpoints) &
     813           0 :                CPABORT("Block Davidson diagonalization not possible with kpoint calculations")
     814          16 :             scf_env%method = block_davidson_diag_method_nr
     815          16 :             IF (.NOT. ASSOCIATED(scf_env%block_davidson_env)) &
     816             :                CALL block_davidson_env_create(scf_env%block_davidson_env, dft_control%nspins, &
     817          12 :                                               scf_section)
     818          34 :             DO ispin = 1, dft_control%nspins
     819          18 :                CALL get_mo_set(mo_set=mos(ispin), mo_coeff=mo_coeff, nao=nao, nmo=nmo)
     820          34 :                CALL block_davidson_allocate(scf_env%block_davidson_env(ispin), mo_coeff, nao, nmo)
     821             :             END DO
     822          10 :             need_coeff_b = .TRUE.
     823             :             ! Filter matrix diagonalisation method
     824             :          CASE (diag_filter_matrix)
     825          10 :             scf_env%method = filter_matrix_diag_method_nr
     826          10 :             IF (.NOT. fb_env_has_data(scf_env%filter_matrix_env)) THEN
     827          10 :                CALL fb_env_create(scf_env%filter_matrix_env)
     828             :             END IF
     829          10 :             CALL fb_env_read_input(scf_env%filter_matrix_env, scf_section)
     830          10 :             CALL fb_env_build_rcut_auto(scf_env%filter_matrix_env, qs_env)
     831          10 :             CALL fb_env_write_info(scf_env%filter_matrix_env, qs_env, scf_section)
     832          10 :             CALL fb_distribution_build(scf_env%filter_matrix_env, qs_env, scf_section)
     833          10 :             CALL fb_env_build_atomic_halos(scf_env%filter_matrix_env, qs_env, scf_section)
     834             :          CASE DEFAULT
     835       13964 :             CPABORT("Unknown diagonalization method")
     836             :          END SELECT
     837             :          ! Check if subspace diagonlization is requested: allocation of additional matrices is needed
     838       13964 :          IF (scf_control%do_diag_sub) THEN
     839           2 :             scf_env%needs_ortho = .TRUE.
     840           2 :             IF (.NOT. ASSOCIATED(scf_env%subspace_env)) &
     841             :                CALL diag_subspace_env_create(scf_env%subspace_env, scf_section, &
     842           2 :                                              dft_control%qs_control%cutoff)
     843           2 :             CALL diag_subspace_allocate(scf_env%subspace_env, qs_env, mos)
     844           2 :             IF (do_kpoints) &
     845           0 :                CPABORT("No subspace diagonlization with kpoint calculation")
     846             :          END IF
     847             :          ! OT: check if OT is used instead of diagonlization. Not possible with added MOS at the moment
     848        5481 :       ELSEIF (scf_control%use_ot) THEN
     849        5481 :          scf_env%method = ot_method_nr
     850        5481 :          need_coeff_b = .TRUE.
     851       16443 :          IF (SUM(ABS(scf_control%added_mos)) > 0) &
     852           0 :             CPABORT("OT with ADDED_MOS/=0 not implemented")
     853        5481 :          IF (dft_control%restricted .AND. dft_control%nspins .NE. 2) &
     854           0 :             CPABORT("nspin must be 2 for restricted (ROKS)")
     855        5481 :          IF (do_kpoints) &
     856           0 :             CPABORT("OT not possible with kpoint calculations")
     857           0 :       ELSEIF (scf_env%method /= smeagol_method_nr) THEN
     858           0 :          CPABORT("OT or DIAGONALIZATION have to be set")
     859             :       END IF
     860       41418 :       DO ispin = 1, dft_control%nspins
     861       41418 :          mos(ispin)%use_mo_coeff_b = need_coeff_b
     862             :       END DO
     863             : 
     864       19445 :    END SUBROUTINE qs_scf_ensure_diagonalization
     865             : 
     866             : ! **************************************************************************************************
     867             : !> \brief performs those initialisations that need to be done only once
     868             : !>       (e.g. that only depend on the atomic positions)
     869             : !>       this will be called in scf
     870             : !> \param scf_env ...
     871             : !> \param qs_env ...
     872             : !> \param scf_section ...
     873             : !> \param scf_control ...
     874             : !> \par History
     875             : !>      03.2006 created [Joost VandeVondele]
     876             : ! **************************************************************************************************
     877       19445 :    SUBROUTINE init_scf_run(scf_env, qs_env, scf_section, scf_control)
     878             : 
     879             :       TYPE(qs_scf_env_type), POINTER                     :: scf_env
     880             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     881             :       TYPE(section_vals_type), POINTER                   :: scf_section
     882             :       TYPE(scf_control_type), POINTER                    :: scf_control
     883             : 
     884             :       CHARACTER(LEN=*), PARAMETER                        :: routineN = 'init_scf_run'
     885             : 
     886             :       INTEGER                                            :: after, handle, homo, ii, ikind, ispin, &
     887             :                                                             iw, nao, ndep, needed_evals, nmo, &
     888             :                                                             output_unit
     889             :       LOGICAL                                            :: dft_plus_u_atom, do_kpoints, &
     890             :                                                             init_u_ramping_each_scf, omit_headers, &
     891             :                                                             s_minus_half_available
     892             :       REAL(KIND=dp)                                      :: u_ramping
     893       19445 :       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: evals
     894       19445 :       REAL(KIND=dp), DIMENSION(:), POINTER               :: eigenvalues
     895             :       TYPE(cp_fm_struct_type), POINTER                   :: fm_struct
     896             :       TYPE(cp_fm_type)                                   :: evecs
     897             :       TYPE(cp_fm_type), POINTER                          :: mo_coeff
     898             :       TYPE(cp_logger_type), POINTER                      :: logger
     899       19445 :       TYPE(dbcsr_p_type), DIMENSION(:), POINTER          :: matrix_s
     900             :       TYPE(dft_control_type), POINTER                    :: dft_control
     901       19445 :       TYPE(mo_set_type), DIMENSION(:), POINTER           :: mos
     902             :       TYPE(mp_para_env_type), POINTER                    :: para_env
     903       19445 :       TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
     904             :       TYPE(qs_kind_type), POINTER                        :: qs_kind
     905             :       TYPE(qs_rho_type), POINTER                         :: rho
     906             :       TYPE(xas_environment_type), POINTER                :: xas_env
     907             : 
     908       19445 :       CALL timeset(routineN, handle)
     909             : 
     910       19445 :       NULLIFY (qs_kind_set, matrix_s, dft_control, mos, qs_kind, rho, xas_env, mo_coeff)
     911             : 
     912       19445 :       logger => cp_get_default_logger()
     913             : 
     914       19445 :       CPASSERT(ASSOCIATED(scf_env))
     915       19445 :       CPASSERT(ASSOCIATED(qs_env))
     916       19445 :       NULLIFY (para_env)
     917             : 
     918       19445 :       s_minus_half_available = .FALSE.
     919             :       CALL get_qs_env(qs_env, &
     920             :                       dft_control=dft_control, &
     921             :                       qs_kind_set=qs_kind_set, &
     922             :                       mos=mos, &
     923             :                       rho=rho, &
     924             :                       nelectron_total=scf_env%nelectron, &
     925             :                       do_kpoints=do_kpoints, &
     926             :                       para_env=para_env, &
     927       19445 :                       xas_env=xas_env)
     928             : 
     929             :       output_unit = cp_print_key_unit_nr(logger, scf_section, "PRINT%PROGRAM_RUN_INFO", &
     930       19445 :                                          extension=".scfLog")
     931       19445 :       CALL qs_scf_initial_info(output_unit, mos, dft_control)
     932             :       CALL cp_print_key_finished_output(output_unit, logger, scf_section, &
     933       19445 :                                         "PRINT%PROGRAM_RUN_INFO")
     934             : 
     935             :       ! calc ortho matrix
     936       19445 :       ndep = 0
     937       19445 :       IF (scf_env%needs_ortho) THEN
     938       10362 :          CALL get_qs_env(qs_env, matrix_s=matrix_s)
     939       10362 :          CALL copy_dbcsr_to_fm(matrix_s(1)%matrix, scf_env%ortho)
     940       10362 :          IF (scf_env%cholesky_method > cholesky_off) THEN
     941       10324 :             CALL cp_fm_cholesky_decompose(scf_env%ortho)
     942       10324 :             IF (scf_env%cholesky_method == cholesky_dbcsr) THEN
     943          58 :                CALL cp_fm_triangular_invert(scf_env%ortho)
     944          58 :                CALL cp_fm_set_all(scf_env%scf_work2, 0.0_dp)
     945          58 :                CALL cp_fm_to_fm_triangular(scf_env%ortho, scf_env%scf_work2, "U")
     946          58 :                CALL copy_fm_to_dbcsr(scf_env%scf_work2, scf_env%ortho_dbcsr)
     947       10266 :             ELSE IF (scf_env%cholesky_method == cholesky_inverse) THEN
     948          32 :                CALL cp_fm_to_fm(scf_env%ortho, scf_env%ortho_m1)
     949          32 :                CALL cp_fm_triangular_invert(scf_env%ortho_m1)
     950             :             END IF
     951             :          ELSE
     952          38 :             CALL cp_fm_get_info(scf_env%ortho, ncol_global=nao)
     953         114 :             ALLOCATE (evals(nao))
     954        1760 :             evals = 0
     955             : 
     956          38 :             CALL cp_fm_create(evecs, scf_env%ortho%matrix_struct)
     957             : 
     958             :             ! Perform an EVD
     959          38 :             CALL choose_eigv_solver(scf_env%ortho, evecs, evals)
     960             : 
     961             :             ! Determine the number of neglectable eigenvalues assuming that the eigenvalues are in ascending order
     962             :             ! (Required by Lapack)
     963             :             ndep = 0
     964          86 :             DO ii = 1, nao
     965          86 :                IF (evals(ii) > scf_control%eps_eigval) THEN
     966          38 :                   ndep = ii - 1
     967          38 :                   EXIT
     968             :                END IF
     969             :             END DO
     970          38 :             needed_evals = nao - ndep
     971             : 
     972             :             ! Set the eigenvalue of the eigenvectors belonging to the linear subspace to zero
     973          86 :             evals(1:ndep) = 0.0_dp
     974             :             ! Determine the eigenvalues of the inverse square root
     975        1712 :             evals(ndep + 1:nao) = 1.0_dp/SQRT(evals(ndep + 1:nao))
     976             : 
     977             :             ! Create reduced matrices
     978          38 :             NULLIFY (fm_struct)
     979             :             CALL cp_fm_struct_create(fm_struct, template_fmstruct=scf_env%ortho%matrix_struct, &
     980          38 :                                      nrow_global=nao, ncol_global=needed_evals)
     981             : 
     982          38 :             ALLOCATE (scf_env%ortho_red, scf_env%scf_work2_red)
     983          38 :             CALL cp_fm_create(scf_env%ortho_red, fm_struct)
     984          38 :             CALL cp_fm_create(scf_env%scf_work2_red, fm_struct)
     985          38 :             CALL cp_fm_struct_release(fm_struct)
     986             : 
     987          38 :             IF (scf_control%level_shift /= 0.0_dp) THEN
     988             :                CALL cp_fm_struct_create(fm_struct, template_fmstruct=scf_env%ortho%matrix_struct, &
     989          10 :                                         nrow_global=needed_evals, ncol_global=nao)
     990             : 
     991          10 :                ALLOCATE (scf_env%ortho_m1_red)
     992          10 :                CALL cp_fm_create(scf_env%ortho_m1_red, fm_struct)
     993          10 :                CALL cp_fm_struct_release(fm_struct)
     994             :             END IF
     995             : 
     996         164 :             ALLOCATE (scf_env%scf_work1_red(SIZE(scf_env%scf_work1)))
     997          88 :             DO ispin = 1, SIZE(scf_env%scf_work1)
     998             :                CALL cp_fm_struct_create(fm_struct, template_fmstruct=scf_env%ortho%matrix_struct, &
     999          50 :                                         nrow_global=needed_evals, ncol_global=needed_evals)
    1000          50 :                CALL cp_fm_create(scf_env%scf_work1_red(ispin), fm_struct)
    1001          88 :                CALL cp_fm_struct_release(fm_struct)
    1002             :             END DO
    1003             : 
    1004             :             ! Scale the eigenvalues and copy them to
    1005          38 :             CALL cp_fm_to_fm(evecs, scf_env%ortho_red, needed_evals, ndep + 1, 1)
    1006             : 
    1007          38 :             IF (scf_control%level_shift /= 0.0_dp) THEN
    1008          10 :                CALL cp_fm_transpose(scf_env%ortho_red, scf_env%ortho_m1_red)
    1009             :             END IF
    1010             : 
    1011          38 :             CALL cp_fm_column_scale(scf_env%ortho_red, evals(ndep + 1:))
    1012             : 
    1013             :             ! Copy the linear dependent columns to the mo sets and set their orbital energies
    1014             :             ! to a very large value to reduce the probability of occupying them
    1015          88 :             DO ispin = 1, SIZE(mos)
    1016          50 :                CALL get_mo_set(mos(ispin), nmo=nmo, mo_coeff=mo_coeff, homo=homo, eigenvalues=eigenvalues)
    1017          50 :                IF (needed_evals < nmo) THEN
    1018           4 :                   IF (needed_evals < homo) THEN
    1019             :                      CALL cp_abort(__LOCATION__, &
    1020             :                                    "The numerical rank of the overlap matrix is lower than the "// &
    1021             :                                    "number of orbitals to be occupied! Check the geometry or increase "// &
    1022           0 :                                    "EPS_DEFAULT or EPS_PGF_ORB!")
    1023             :                   END IF
    1024             :                   CALL cp_warn(__LOCATION__, &
    1025             :                                "The numerical rank of the overlap matrix is lower than the number of requested MOs! "// &
    1026             :                              "Reduce the number of MOs to the number of available MOs. If necessary, request a lower number of "// &
    1027           4 :                                "MOs or increase EPS_DEFAULT or EPS_PGF_ORB.")
    1028           4 :                   CALL set_mo_set(mos(ispin), nmo=needed_evals)
    1029             :                END IF
    1030             :                ! Copy the last columns to mo_coeff if the container is large enough
    1031          50 :                CALL cp_fm_to_fm(evecs, mo_coeff, MIN(ndep, MAX(0, nmo - needed_evals)), 1, needed_evals + 1)
    1032             :                ! Set the corresponding eigenvalues to a large value
    1033             :                ! This prevents their occupation but still keeps the information on them
    1034         158 :                eigenvalues(needed_evals + 1:MIN(nao, nmo)) = 1.0_dp/scf_control%eps_eigval
    1035             :             END DO
    1036             : 
    1037             :             ! Obtain ortho from (P)DGEMM, skip the linear dependent columns
    1038             :             CALL parallel_gemm("N", "T", nao, nao, needed_evals, 1.0_dp, scf_env%ortho_red, evecs, &
    1039          38 :                                0.0_dp, scf_env%ortho, b_first_col=ndep + 1)
    1040             : 
    1041          38 :             IF (scf_control%level_shift /= 0.0_dp) THEN
    1042             :                ! We need SQRT(evals) of the eigenvalues of H, so 1/SQRT(evals) of ortho_red
    1043         306 :                evals(ndep + 1:nao) = 1.0_dp/evals(ndep + 1:nao)
    1044          10 :                CALL cp_fm_row_scale(scf_env%ortho_m1_red, evals(ndep + 1:))
    1045             : 
    1046             :                CALL parallel_gemm("T", "T", nao, nao, needed_evals, 1.0_dp, scf_env%ortho_m1_red, evecs, &
    1047          10 :                                   0.0_dp, scf_env%ortho_m1, b_first_col=ndep + 1)
    1048             :             END IF
    1049             : 
    1050          38 :             CALL cp_fm_release(evecs)
    1051             : 
    1052         114 :             s_minus_half_available = .TRUE.
    1053             :          END IF
    1054             : 
    1055       10362 :          IF (BTEST(cp_print_key_should_output(logger%iter_info, &
    1056             :                                               qs_env%input, "DFT%PRINT%AO_MATRICES/ORTHO"), cp_p_file)) THEN
    1057             :             iw = cp_print_key_unit_nr(logger, qs_env%input, "DFT%PRINT%AO_MATRICES/ORTHO", &
    1058           4 :                                       extension=".Log")
    1059           4 :             CALL section_vals_val_get(qs_env%input, "DFT%PRINT%AO_MATRICES%NDIGITS", i_val=after)
    1060           4 :             CALL section_vals_val_get(qs_env%input, "DFT%PRINT%AO_MATRICES%OMIT_HEADERS", l_val=omit_headers)
    1061           4 :             after = MIN(MAX(after, 1), 16)
    1062             :             CALL write_fm_with_basis_info(scf_env%ortho, 4, after, qs_env, &
    1063           4 :                                           para_env, output_unit=iw, omit_headers=omit_headers)
    1064             :             CALL cp_print_key_finished_output(iw, logger, qs_env%input, &
    1065           4 :                                               "DFT%PRINT%AO_MATRICES/ORTHO")
    1066             :          END IF
    1067             :       END IF
    1068             : 
    1069       19445 :       CALL get_mo_set(mo_set=mos(1), nao=nao)
    1070             : 
    1071             :       ! DFT+U methods based on Lowdin charges need S^(1/2)
    1072       19445 :       IF (dft_control%dft_plus_u) THEN
    1073          80 :          CALL get_qs_env(qs_env, matrix_s=matrix_s)
    1074          80 :          IF (dft_control%plus_u_method_id == plus_u_lowdin) THEN
    1075           8 :             IF (s_minus_half_available) THEN
    1076             :                CALL cp_dbcsr_sm_fm_multiply(matrix_s(1)%matrix, scf_env%ortho, scf_env%s_half, &
    1077           0 :                                             nao)
    1078             :             ELSE
    1079           8 :                CALL copy_dbcsr_to_fm(matrix_s(1)%matrix, scf_env%s_half)
    1080             :                CALL cp_fm_power(scf_env%s_half, scf_env%scf_work2, 0.5_dp, &
    1081           8 :                                 scf_control%eps_eigval, ndep)
    1082             :             END IF
    1083             :          END IF
    1084         240 :          DO ikind = 1, SIZE(qs_kind_set)
    1085         160 :             qs_kind => qs_kind_set(ikind)
    1086             :             CALL get_qs_kind(qs_kind=qs_kind, &
    1087             :                              dft_plus_u_atom=dft_plus_u_atom, &
    1088             :                              u_ramping=u_ramping, &
    1089         160 :                              init_u_ramping_each_scf=init_u_ramping_each_scf)
    1090         240 :             IF (dft_plus_u_atom .AND. (u_ramping /= 0.0_dp)) THEN
    1091          24 :                IF (init_u_ramping_each_scf) THEN
    1092          12 :                   CALL set_qs_kind(qs_kind=qs_kind, u_minus_j=0.0_dp)
    1093             :                END IF
    1094             :             END IF
    1095             :          END DO
    1096             :       END IF
    1097             : 
    1098             :       output_unit = cp_print_key_unit_nr(logger, scf_section, "PRINT%PROGRAM_RUN_INFO", &
    1099       19445 :                                          extension=".scfLog")
    1100       19445 :       IF (output_unit > 0) THEN
    1101             :          WRITE (UNIT=output_unit, FMT="(T2,A,T71,I10)") &
    1102        9904 :             "Number of independent orbital functions:", nao - ndep
    1103             :       END IF
    1104             :       CALL cp_print_key_finished_output(output_unit, logger, scf_section, &
    1105       19445 :                                         "PRINT%PROGRAM_RUN_INFO")
    1106             : 
    1107             :       ! extrapolate outer loop variables
    1108       19445 :       IF (scf_control%outer_scf%have_scf) THEN
    1109        3835 :          CALL outer_loop_extrapolate(qs_env)
    1110             :       END IF
    1111             : 
    1112             :       ! initializes rho and the mos
    1113       19445 :       IF (ASSOCIATED(qs_env%xas_env)) THEN
    1114             :          ! if just optimized wfn, e.g. ground state
    1115             :          ! changes come from a perturbation, e.g., the occupation numbers
    1116             :          ! it could be generalized for other cases, at the moment used only for core level spectroscopy
    1117             :          ! initialize the density with the localized mos
    1118          82 :          CALL xas_initialize_rho(qs_env, scf_env, scf_control)
    1119             :       ELSE
    1120             :          CALL scf_env_initial_rho_setup(scf_env, qs_env=qs_env, &
    1121       19363 :                                         scf_section=scf_section, scf_control=scf_control)
    1122             :       END IF
    1123             : 
    1124             :       ! Frozen density approximation
    1125       19445 :       IF (ASSOCIATED(qs_env%wf_history)) THEN
    1126       19445 :          IF (qs_env%wf_history%interpolation_method_nr == wfi_frozen_method_nr) THEN
    1127          12 :             IF (.NOT. ASSOCIATED(qs_env%wf_history%past_states(1)%snapshot)) THEN
    1128           4 :                CALL wfi_update(qs_env%wf_history, qs_env=qs_env, dt=1.0_dp)
    1129           4 :                ALLOCATE (qs_env%wf_history%past_states(1)%snapshot%rho_frozen)
    1130           4 :                CALL qs_rho_create(qs_env%wf_history%past_states(1)%snapshot%rho_frozen)
    1131             :                CALL duplicate_rho_type(rho_input=rho, &
    1132             :                                        rho_output=qs_env%wf_history%past_states(1)%snapshot%rho_frozen, &
    1133           4 :                                        qs_env=qs_env)
    1134             :             END IF
    1135             :          END IF
    1136             :       END IF
    1137             : 
    1138             :       !image charge method, calculate image_matrix if required
    1139       19445 :       IF (qs_env%qmmm) THEN
    1140        3802 :          IF (qs_env%qmmm .AND. qs_env%qmmm_env_qm%image_charge) THEN
    1141             :             CALL conditional_calc_image_matrix(qs_env=qs_env, &
    1142          20 :                                                qmmm_env=qs_env%qmmm_env_qm)
    1143             :          END IF
    1144             :       END IF
    1145             : 
    1146       19445 :       CALL timestop(handle)
    1147             : 
    1148       38890 :    END SUBROUTINE init_scf_run
    1149             : 
    1150             : ! **************************************************************************************************
    1151             : !> \brief Initializes rho and the mos, so that an scf cycle can start
    1152             : !> \param scf_env the scf env in which to do the scf
    1153             : !> \param qs_env the qs env the scf_env lives in
    1154             : !> \param scf_section ...
    1155             : !> \param scf_control ...
    1156             : !> \par History
    1157             : !>      02.2003 created [fawzi]
    1158             : !> \author fawzi
    1159             : ! **************************************************************************************************
    1160       19363 :    SUBROUTINE scf_env_initial_rho_setup(scf_env, qs_env, scf_section, scf_control)
    1161             :       TYPE(qs_scf_env_type), POINTER                     :: scf_env
    1162             :       TYPE(qs_environment_type), POINTER                 :: qs_env
    1163             :       TYPE(section_vals_type), POINTER                   :: scf_section
    1164             :       TYPE(scf_control_type), POINTER                    :: scf_control
    1165             : 
    1166             :       CHARACTER(len=*), PARAMETER :: routineN = 'scf_env_initial_rho_setup'
    1167             : 
    1168             :       INTEGER                                            :: extrapolation_method_nr, handle, ispin, &
    1169             :                                                             nmo, output_unit
    1170             :       LOGICAL                                            :: do_harris, orthogonal_wf
    1171             :       TYPE(cp_fm_type), POINTER                          :: mo_coeff
    1172             :       TYPE(cp_logger_type), POINTER                      :: logger
    1173             :       TYPE(dft_control_type), POINTER                    :: dft_control
    1174             :       TYPE(harris_type), POINTER                         :: harris_env
    1175       19363 :       TYPE(mo_set_type), DIMENSION(:), POINTER           :: mos
    1176             :       TYPE(mp_para_env_type), POINTER                    :: para_env
    1177             :       TYPE(qs_rho_type), POINTER                         :: rho
    1178       19363 :       TYPE(rho_atom_type), DIMENSION(:), POINTER         :: rho_atom
    1179             : 
    1180       19363 :       CALL timeset(routineN, handle)
    1181       19363 :       NULLIFY (mo_coeff, rho, dft_control, para_env, mos)
    1182       19363 :       logger => cp_get_default_logger()
    1183       19363 :       CPASSERT(ASSOCIATED(scf_env))
    1184       19363 :       CPASSERT(ASSOCIATED(qs_env))
    1185             : 
    1186             :       CALL get_qs_env(qs_env, &
    1187             :                       rho=rho, &
    1188             :                       mos=mos, &
    1189             :                       dft_control=dft_control, &
    1190       19363 :                       para_env=para_env)
    1191             : 
    1192       19363 :       do_harris = qs_env%harris_method
    1193             : 
    1194       19363 :       extrapolation_method_nr = wfi_use_guess_method_nr
    1195       19363 :       IF (ASSOCIATED(qs_env%wf_history)) THEN
    1196             :          CALL wfi_extrapolate(qs_env%wf_history, &
    1197             :                               qs_env=qs_env, dt=1.0_dp, &
    1198             :                               extrapolation_method_nr=extrapolation_method_nr, &
    1199       19363 :                               orthogonal_wf=orthogonal_wf)
    1200             :          ! wfi_use_guess_method_nr the wavefunctions are not yet initialized
    1201             :          IF ((.NOT. orthogonal_wf) .AND. &
    1202       19363 :              (scf_env%method == ot_method_nr) .AND. &
    1203             :              (.NOT. (extrapolation_method_nr == wfi_use_guess_method_nr))) THEN
    1204           0 :             DO ispin = 1, SIZE(mos)
    1205           0 :                CALL get_mo_set(mos(ispin), mo_coeff=mo_coeff, nmo=nmo)
    1206           0 :                CALL reorthogonalize_vectors(qs_env, v_matrix=mo_coeff, n_col=nmo)
    1207             :                CALL set_mo_occupation(mo_set=mos(ispin), &
    1208           0 :                                       smear=scf_control%smear)
    1209             :             END DO
    1210             :          END IF
    1211             :       END IF
    1212             : 
    1213       19363 :       IF (.NOT. do_harris) THEN
    1214             :          output_unit = cp_print_key_unit_nr(logger, scf_section, "PRINT%PROGRAM_RUN_INFO", &
    1215       19347 :                                             extension=".scfLog")
    1216       19347 :          IF (output_unit > 0) THEN
    1217             :             WRITE (UNIT=output_unit, FMT="(/,T2,A,I0)") &
    1218             :                "Extrapolation method: "// &
    1219        9855 :                TRIM(wfi_get_method_label(extrapolation_method_nr))
    1220        9855 :             IF (extrapolation_method_nr == wfi_ps_method_nr) THEN
    1221             :                WRITE (UNIT=output_unit, FMT="(T2,A,I0,A)") &
    1222         124 :                   "Extrapolation order:  ", &
    1223         248 :                   MAX((MIN(qs_env%wf_history%memory_depth, qs_env%wf_history%snapshot_count) - 1), 0)
    1224             :             END IF
    1225             :          END IF
    1226             :          CALL cp_print_key_finished_output(output_unit, logger, scf_section, &
    1227       19347 :                                            "PRINT%PROGRAM_RUN_INFO")
    1228             :       END IF
    1229             : 
    1230             :       IF (do_harris) THEN
    1231          16 :          CALL get_qs_env(qs_env, harris_env=harris_env)
    1232          16 :          CALL harris_density_update(qs_env, harris_env)
    1233          16 :          CALL qs_rho_update_rho(rho, qs_env=qs_env)
    1234          16 :          CALL qs_ks_did_change(qs_env%ks_env, rho_changed=.TRUE.)
    1235       19347 :       ELSE IF (extrapolation_method_nr == wfi_use_guess_method_nr) THEN
    1236        6799 :          CALL calculate_first_density_matrix(scf_env=scf_env, qs_env=qs_env)
    1237        6799 :          CALL qs_rho_update_rho(rho, qs_env=qs_env)
    1238        6799 :          CALL qs_ks_did_change(qs_env%ks_env, rho_changed=.TRUE.)
    1239             :       END IF
    1240             : 
    1241             :       ! Some preparation for the mixing
    1242       19363 :       IF (scf_env%mixing_method > 1) THEN
    1243         240 :          IF (dft_control%qs_control%gapw) THEN
    1244          40 :             CALL get_qs_env(qs_env=qs_env, rho_atom_set=rho_atom)
    1245             :             CALL mixing_init(scf_env%mixing_method, rho, scf_env%mixing_store, &
    1246          40 :                              para_env, rho_atom=rho_atom)
    1247         200 :          ELSEIF (dft_control%qs_control%dftb .OR. dft_control%qs_control%xtb) THEN
    1248          36 :             CALL charge_mixing_init(scf_env%mixing_store)
    1249         164 :          ELSEIF (dft_control%qs_control%semi_empirical) THEN
    1250           0 :             CPABORT('SE Code not possible')
    1251             :          ELSE
    1252             :             CALL mixing_init(scf_env%mixing_method, rho, scf_env%mixing_store, &
    1253         164 :                              para_env)
    1254             :          END IF
    1255             :       END IF
    1256             : 
    1257       41172 :       DO ispin = 1, SIZE(mos) !fm->dbcsr
    1258       41172 :          IF (mos(ispin)%use_mo_coeff_b) THEN
    1259             :             CALL copy_fm_to_dbcsr(mos(ispin)%mo_coeff, &
    1260        6471 :                                   mos(ispin)%mo_coeff_b) !fm->dbcsr
    1261             :          END IF
    1262             :       END DO !fm->dbcsr
    1263             : 
    1264       19363 :       CALL timestop(handle)
    1265             : 
    1266       19363 :    END SUBROUTINE scf_env_initial_rho_setup
    1267             : 
    1268             : END MODULE qs_scf_initialization

Generated by: LCOV version 1.15