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

Generated by: LCOV version 1.15