LCOV - code coverage report
Current view: top level - src - qs_ks_methods.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:2fce0f8) Lines: 462 487 94.9 %
Date: 2024-12-21 06:28:57 Functions: 7 7 100.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \brief routines that build the Kohn-Sham matrix (i.e calculate the coulomb
      10             : !>        and xc parts
      11             : !> \author Fawzi Mohamed
      12             : !> \par History
      13             : !>      - 05.2002 moved from qs_scf (see there the history) [fawzi]
      14             : !>      - JGH [30.08.02] multi-grid arrays independent from density and potential
      15             : !>      - 10.2002 introduced pools, uses updated rho as input,
      16             : !>                removed most temporary variables, renamed may vars,
      17             : !>                began conversion to LSD [fawzi]
      18             : !>      - 10.2004 moved calculate_w_matrix here [Joost VandeVondele]
      19             : !>                introduced energy derivative wrt MOs [Joost VandeVondele]
      20             : !>      - SCCS implementation (16.10.2013,MK)
      21             : ! **************************************************************************************************
      22             : MODULE qs_ks_methods
      23             :    USE admm_dm_methods,                 ONLY: admm_dm_calc_rho_aux,&
      24             :                                               admm_dm_merge_ks_matrix
      25             :    USE admm_methods,                    ONLY: admm_mo_calc_rho_aux,&
      26             :                                               admm_mo_calc_rho_aux_kp,&
      27             :                                               admm_mo_merge_ks_matrix,&
      28             :                                               admm_update_ks_atom,&
      29             :                                               calc_admm_mo_derivatives,&
      30             :                                               calc_admm_ovlp_forces,&
      31             :                                               calc_admm_ovlp_forces_kp
      32             :    USE admm_types,                      ONLY: admm_type,&
      33             :                                               get_admm_env
      34             :    USE cell_types,                      ONLY: cell_type
      35             :    USE cp_control_types,                ONLY: dft_control_type
      36             :    USE cp_dbcsr_api,                    ONLY: &
      37             :         dbcsr_add, dbcsr_copy, dbcsr_create, dbcsr_filter, dbcsr_get_info, dbcsr_multiply, &
      38             :         dbcsr_p_type, dbcsr_release, dbcsr_set, dbcsr_type, dbcsr_type_antisymmetric, &
      39             :         dbcsr_type_symmetric
      40             :    USE cp_dbcsr_cp2k_link,              ONLY: cp_dbcsr_alloc_block_from_nbl
      41             :    USE cp_dbcsr_operations,             ONLY: dbcsr_allocate_matrix_set,&
      42             :                                               dbcsr_copy_columns_hack
      43             :    USE cp_ddapc,                        ONLY: qs_ks_ddapc
      44             :    USE cp_fm_types,                     ONLY: cp_fm_type
      45             :    USE cp_log_handling,                 ONLY: cp_get_default_logger,&
      46             :                                               cp_logger_get_default_io_unit,&
      47             :                                               cp_logger_type
      48             :    USE cp_output_handling,              ONLY: cp_p_file,&
      49             :                                               cp_print_key_should_output
      50             :    USE dft_plus_u,                      ONLY: plus_u
      51             :    USE hartree_local_methods,           ONLY: Vh_1c_gg_integrals
      52             :    USE hartree_local_types,             ONLY: ecoul_1center_type
      53             :    USE hfx_admm_utils,                  ONLY: hfx_admm_init,&
      54             :                                               hfx_ks_matrix,&
      55             :                                               hfx_ks_matrix_kp
      56             :    USE input_constants,                 ONLY: do_ppl_grid,&
      57             :                                               outer_scf_becke_constraint,&
      58             :                                               outer_scf_hirshfeld_constraint,&
      59             :                                               smeagol_runtype_emtransport
      60             :    USE input_section_types,             ONLY: section_vals_get,&
      61             :                                               section_vals_get_subs_vals,&
      62             :                                               section_vals_type,&
      63             :                                               section_vals_val_get
      64             :    USE kg_correction,                   ONLY: kg_ekin_subset
      65             :    USE kinds,                           ONLY: default_string_length,&
      66             :                                               dp
      67             :    USE kpoint_types,                    ONLY: get_kpoint_info,&
      68             :                                               kpoint_type
      69             :    USE lri_environment_methods,         ONLY: v_int_ppl_energy
      70             :    USE lri_environment_types,           ONLY: lri_density_type,&
      71             :                                               lri_environment_type,&
      72             :                                               lri_kind_type
      73             :    USE mathlib,                         ONLY: abnormal_value
      74             :    USE message_passing,                 ONLY: mp_para_env_type
      75             :    USE pw_env_types,                    ONLY: pw_env_get,&
      76             :                                               pw_env_type
      77             :    USE pw_methods,                      ONLY: pw_axpy,&
      78             :                                               pw_copy,&
      79             :                                               pw_integral_ab,&
      80             :                                               pw_integrate_function,&
      81             :                                               pw_scale,&
      82             :                                               pw_transfer,&
      83             :                                               pw_zero
      84             :    USE pw_poisson_methods,              ONLY: pw_poisson_solve
      85             :    USE pw_poisson_types,                ONLY: pw_poisson_implicit,&
      86             :                                               pw_poisson_type
      87             :    USE pw_pool_types,                   ONLY: pw_pool_type
      88             :    USE pw_types,                        ONLY: pw_c1d_gs_type,&
      89             :                                               pw_r3d_rs_type
      90             :    USE qmmm_image_charge,               ONLY: add_image_pot_to_hartree_pot,&
      91             :                                               calculate_image_pot,&
      92             :                                               integrate_potential_devga_rspace
      93             :    USE qs_cdft_types,                   ONLY: cdft_control_type
      94             :    USE qs_charges_types,                ONLY: qs_charges_type
      95             :    USE qs_core_energies,                ONLY: calculate_ptrace
      96             :    USE qs_dftb_matrices,                ONLY: build_dftb_ks_matrix
      97             :    USE qs_efield_berry,                 ONLY: qs_efield_berry_phase
      98             :    USE qs_efield_local,                 ONLY: qs_efield_local_operator
      99             :    USE qs_energy_types,                 ONLY: qs_energy_type
     100             :    USE qs_environment_types,            ONLY: get_qs_env,&
     101             :                                               qs_environment_type
     102             :    USE qs_gapw_densities,               ONLY: prepare_gapw_den
     103             :    USE qs_harris_types,                 ONLY: harris_type
     104             :    USE qs_harris_utils,                 ONLY: harris_set_potentials
     105             :    USE qs_integrate_potential,          ONLY: integrate_ppl_rspace,&
     106             :                                               integrate_rho_nlcc,&
     107             :                                               integrate_v_core_rspace
     108             :    USE qs_ks_apply_restraints,          ONLY: qs_ks_cdft_constraint,&
     109             :                                               qs_ks_mulliken_restraint,&
     110             :                                               qs_ks_s2_restraint
     111             :    USE qs_ks_atom,                      ONLY: update_ks_atom
     112             :    USE qs_ks_qmmm_methods,              ONLY: qmmm_calculate_energy,&
     113             :                                               qmmm_modify_hartree_pot
     114             :    USE qs_ks_types,                     ONLY: qs_ks_env_type,&
     115             :                                               set_ks_env
     116             :    USE qs_ks_utils,                     ONLY: &
     117             :         calc_v_sic_rspace, calculate_zmp_potential, compute_matrix_vxc, &
     118             :         get_embed_potential_energy, low_spin_roks, print_densities, print_detailed_energy, &
     119             :         sic_explicit_orbitals, sum_up_and_integrate
     120             :    USE qs_local_rho_types,              ONLY: local_rho_type
     121             :    USE qs_mo_types,                     ONLY: get_mo_set,&
     122             :                                               mo_set_type
     123             :    USE qs_neighbor_list_types,          ONLY: neighbor_list_set_p_type
     124             :    USE qs_rho0_ggrid,                   ONLY: integrate_vhg0_rspace
     125             :    USE qs_rho_types,                    ONLY: qs_rho_get,&
     126             :                                               qs_rho_type
     127             :    USE qs_sccs,                         ONLY: sccs
     128             :    USE qs_vxc,                          ONLY: qs_vxc_create
     129             :    USE qs_vxc_atom,                     ONLY: calculate_vxc_atom
     130             :    USE rtp_admm_methods,                ONLY: rtp_admm_calc_rho_aux,&
     131             :                                               rtp_admm_merge_ks_matrix
     132             :    USE se_fock_matrix,                  ONLY: build_se_fock_matrix
     133             :    USE smeagol_interface,               ONLY: smeagol_shift_v_hartree
     134             :    USE surface_dipole,                  ONLY: calc_dipsurf_potential
     135             :    USE virial_types,                    ONLY: virial_type
     136             :    USE xtb_ks_matrix,                   ONLY: build_xtb_ks_matrix
     137             : #include "./base/base_uses.f90"
     138             : 
     139             :    IMPLICIT NONE
     140             : 
     141             :    PRIVATE
     142             : 
     143             :    LOGICAL, PARAMETER :: debug_this_module = .TRUE.
     144             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_ks_methods'
     145             : 
     146             :    PUBLIC :: calc_rho_tot_gspace, qs_ks_update_qs_env, qs_ks_build_kohn_sham_matrix, &
     147             :              qs_ks_allocate_basics
     148             : 
     149             : CONTAINS
     150             : 
     151             : ! **************************************************************************************************
     152             : !> \brief routine where the real calculations are made: the
     153             : !>      KS matrix is calculated
     154             : !> \param qs_env the qs_env to update
     155             : !> \param calculate_forces if true calculate the quantities needed
     156             : !>        to calculate the forces. Defaults to false.
     157             : !> \param just_energy if true updates the energies but not the
     158             : !>        ks matrix. Defaults to false
     159             : !> \param print_active ...
     160             : !> \param ext_ks_matrix ...
     161             : !> \par History
     162             : !>      06.2002 moved from qs_scf to qs_ks_methods, use of ks_env
     163             : !>              new did_change scheme [fawzi]
     164             : !>      10.2002 introduced pools, uses updated rho as input, LSD [fawzi]
     165             : !>      10.2004 build_kohn_sham matrix now also computes the derivatives
     166             : !>              of the total energy wrt to the MO coefs, if instructed to
     167             : !>              do so. This appears useful for orbital dependent functionals
     168             : !>              where the KS matrix alone (however this might be defined)
     169             : !>               does not contain the info to construct this derivative.
     170             : !> \author Matthias Krack
     171             : !> \note
     172             : !>      make rho, energy and qs_charges optional, defaulting
     173             : !>      to qs_env components?
     174             : ! **************************************************************************************************
     175      294267 :    SUBROUTINE qs_ks_build_kohn_sham_matrix(qs_env, calculate_forces, just_energy, &
     176             :                                            print_active, ext_ks_matrix)
     177             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     178             :       LOGICAL, INTENT(in)                                :: calculate_forces, just_energy
     179             :       LOGICAL, INTENT(IN), OPTIONAL                      :: print_active
     180             :       TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, &
     181             :          POINTER                                         :: ext_ks_matrix
     182             : 
     183             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'qs_ks_build_kohn_sham_matrix'
     184             : 
     185             :       CHARACTER(len=default_string_length)               :: name
     186             :       INTEGER                                            :: handle, iatom, img, ispin, nimages, &
     187             :                                                             nspins
     188             :       LOGICAL :: do_adiabatic_rescaling, do_ddapc, do_hfx, do_ppl, dokp, gapw, gapw_xc, &
     189             :          hfx_treat_lsd_in_core, just_energy_xc, lrigpw, my_print, rigpw, use_virial
     190             :       REAL(KIND=dp)                                      :: ecore_ppl, edisp, ee_ener, ekin_mol, &
     191             :                                                             mulliken_order_p, vscale
     192             :       REAL(KIND=dp), DIMENSION(3, 3)                     :: h_stress, pv_loc
     193             :       TYPE(admm_type), POINTER                           :: admm_env
     194             :       TYPE(cdft_control_type), POINTER                   :: cdft_control
     195             :       TYPE(cell_type), POINTER                           :: cell
     196             :       TYPE(cp_logger_type), POINTER                      :: logger
     197       98089 :       TYPE(dbcsr_p_type), DIMENSION(:), POINTER          :: ksmat, matrix_vxc, mo_derivs
     198       98089 :       TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER       :: ks_matrix, ks_matrix_im, matrix_h, &
     199       98089 :                                                             matrix_h_im, matrix_s, my_rho, rho_ao
     200             :       TYPE(dft_control_type), POINTER                    :: dft_control
     201       98089 :       TYPE(ecoul_1center_type), DIMENSION(:), POINTER    :: ecoul_1c
     202             :       TYPE(harris_type), POINTER                         :: harris_env
     203             :       TYPE(local_rho_type), POINTER                      :: local_rho_set
     204             :       TYPE(lri_density_type), POINTER                    :: lri_density
     205             :       TYPE(lri_environment_type), POINTER                :: lri_env
     206       98089 :       TYPE(lri_kind_type), DIMENSION(:), POINTER         :: lri_v_int
     207             :       TYPE(mp_para_env_type), POINTER                    :: para_env
     208             :       TYPE(pw_c1d_gs_type)                               :: rho_tot_gspace, v_hartree_gspace
     209             :       TYPE(pw_c1d_gs_type), POINTER                      :: rho_core
     210             :       TYPE(pw_env_type), POINTER                         :: pw_env
     211             :       TYPE(pw_poisson_type), POINTER                     :: poisson_env
     212             :       TYPE(pw_pool_type), POINTER                        :: auxbas_pw_pool
     213       98089 :       TYPE(pw_r3d_rs_type), DIMENSION(:), POINTER        :: rho_r, v_rspace_embed, v_rspace_new, &
     214       98089 :                                                             v_rspace_new_aux_fit, v_tau_rspace, &
     215       98089 :                                                             v_tau_rspace_aux_fit
     216             :       TYPE(pw_r3d_rs_type), POINTER                      :: rho0_s_rs, rho_nlcc, v_hartree_rspace, &
     217             :                                                             v_sccs_rspace, v_sic_rspace, &
     218             :                                                             v_spin_ddapc_rest_r, vee, vppl_rspace
     219             :       TYPE(qs_energy_type), POINTER                      :: energy
     220             :       TYPE(qs_ks_env_type), POINTER                      :: ks_env
     221             :       TYPE(qs_rho_type), POINTER                         :: rho, rho_struct, rho_xc
     222             :       TYPE(section_vals_type), POINTER                   :: adiabatic_rescaling_section, &
     223             :                                                             hfx_sections, input, scf_section, &
     224             :                                                             xc_section
     225             :       TYPE(virial_type), POINTER                         :: virial
     226             : 
     227       98089 :       CALL timeset(routineN, handle)
     228       98089 :       NULLIFY (admm_env, cell, dft_control, logger, mo_derivs, my_rho, &
     229       98089 :                rho_struct, para_env, pw_env, virial, vppl_rspace, &
     230       98089 :                adiabatic_rescaling_section, hfx_sections, &
     231       98089 :                input, scf_section, xc_section, matrix_h, matrix_h_im, matrix_s, &
     232       98089 :                auxbas_pw_pool, poisson_env, v_rspace_new, v_rspace_new_aux_fit, &
     233       98089 :                v_tau_rspace, v_tau_rspace_aux_fit, matrix_vxc, vee, rho_nlcc, &
     234       98089 :                ks_env, ks_matrix, ks_matrix_im, rho, energy, rho_xc, rho_r, rho_ao, rho_core)
     235             : 
     236       98089 :       CPASSERT(ASSOCIATED(qs_env))
     237             : 
     238       98089 :       logger => cp_get_default_logger()
     239       98089 :       my_print = .TRUE.
     240       98089 :       IF (PRESENT(print_active)) my_print = print_active
     241             : 
     242             :       CALL get_qs_env(qs_env, &
     243             :                       ks_env=ks_env, &
     244             :                       dft_control=dft_control, &
     245             :                       matrix_h_kp=matrix_h, &
     246             :                       matrix_h_im_kp=matrix_h_im, &
     247             :                       matrix_s_kp=matrix_s, &
     248             :                       matrix_ks_kp=ks_matrix, &
     249             :                       matrix_ks_im_kp=ks_matrix_im, &
     250             :                       matrix_vxc=matrix_vxc, &
     251             :                       pw_env=pw_env, &
     252             :                       cell=cell, &
     253             :                       para_env=para_env, &
     254             :                       input=input, &
     255             :                       virial=virial, &
     256             :                       v_hartree_rspace=v_hartree_rspace, &
     257             :                       vee=vee, &
     258             :                       rho_nlcc=rho_nlcc, &
     259             :                       rho=rho, &
     260             :                       rho_core=rho_core, &
     261             :                       rho_xc=rho_xc, &
     262       98089 :                       energy=energy)
     263             : 
     264       98089 :       CALL qs_rho_get(rho, rho_r=rho_r, rho_ao_kp=rho_ao)
     265             : 
     266       98089 :       nimages = dft_control%nimages
     267       98089 :       nspins = dft_control%nspins
     268             : 
     269             :       ! remap pointer to allow for non-kpoint external ks matrix
     270       98089 :       IF (PRESENT(ext_ks_matrix)) ks_matrix(1:nspins, 1:1) => ext_ks_matrix(1:nspins)
     271             : 
     272       98089 :       use_virial = virial%pv_availability .AND. (.NOT. virial%pv_numer)
     273             : 
     274       98089 :       hfx_sections => section_vals_get_subs_vals(input, "DFT%XC%HF")
     275       98089 :       CALL section_vals_get(hfx_sections, explicit=do_hfx)
     276       98089 :       IF (do_hfx) THEN
     277             :          CALL section_vals_val_get(hfx_sections, "TREAT_LSD_IN_CORE", l_val=hfx_treat_lsd_in_core, &
     278       23516 :                                    i_rep_section=1)
     279             :       END IF
     280       98089 :       adiabatic_rescaling_section => section_vals_get_subs_vals(input, "DFT%XC%ADIABATIC_RESCALING")
     281       98089 :       CALL section_vals_get(adiabatic_rescaling_section, explicit=do_adiabatic_rescaling)
     282       98089 :       just_energy_xc = just_energy
     283       98089 :       IF (do_adiabatic_rescaling) THEN
     284             :          !! If we perform adiabatic rescaling, the xc potential has to be scaled by the xc- and
     285             :          !! HFX-energy. Thus, let us first calculate the energy
     286          48 :          just_energy_xc = .TRUE.
     287             :       END IF
     288             : 
     289       98089 :       CPASSERT(ASSOCIATED(matrix_h))
     290       98089 :       CPASSERT(ASSOCIATED(matrix_s))
     291       98089 :       CPASSERT(ASSOCIATED(rho))
     292       98089 :       CPASSERT(ASSOCIATED(pw_env))
     293       98089 :       CPASSERT(SIZE(ks_matrix, 1) > 0)
     294       98089 :       dokp = (nimages > 1)
     295             : 
     296             :       ! Setup the possible usage of DDAPC charges
     297             :       do_ddapc = dft_control%qs_control%ddapc_restraint .OR. &
     298             :                  qs_env%cp_ddapc_ewald%do_decoupling .OR. &
     299             :                  qs_env%cp_ddapc_ewald%do_qmmm_periodic_decpl .OR. &
     300       98089 :                  qs_env%cp_ddapc_ewald%do_solvation
     301             : 
     302             :       ! Check if LRIGPW is used
     303       98089 :       lrigpw = dft_control%qs_control%lrigpw
     304       98089 :       rigpw = dft_control%qs_control%rigpw
     305       98089 :       IF (rigpw) THEN
     306           0 :          CPASSERT(nimages == 1)
     307             :       END IF
     308           0 :       IF (lrigpw .AND. rigpw) THEN
     309           0 :          CPABORT(" LRI and RI are not compatible")
     310             :       END IF
     311             : 
     312             :       ! Check for GAPW method : additional terms for local densities
     313       98089 :       gapw = dft_control%qs_control%gapw
     314       98089 :       gapw_xc = dft_control%qs_control%gapw_xc
     315       98089 :       IF (gapw_xc .AND. gapw) THEN
     316           0 :          CPABORT(" GAPW and GAPW_XC are not compatible")
     317             :       END IF
     318       98089 :       IF ((gapw .AND. lrigpw) .OR. (gapw_xc .AND. lrigpw)) THEN
     319           0 :          CPABORT(" GAPW/GAPW_XC and LRIGPW are not compatible")
     320             :       END IF
     321       98089 :       IF ((gapw .AND. rigpw) .OR. (gapw_xc .AND. rigpw)) THEN
     322           0 :          CPABORT(" GAPW/GAPW_XC and RIGPW are not compatible")
     323             :       END IF
     324             : 
     325       98089 :       do_ppl = dft_control%qs_control%do_ppl_method == do_ppl_grid
     326       98089 :       IF (do_ppl) THEN
     327          60 :          CPASSERT(.NOT. gapw)
     328          60 :          CALL get_qs_env(qs_env=qs_env, vppl=vppl_rspace)
     329             :       END IF
     330             : 
     331       98089 :       IF (gapw_xc) THEN
     332        2534 :          CPASSERT(ASSOCIATED(rho_xc))
     333             :       END IF
     334             : 
     335             :       ! gets the tmp grids
     336       98089 :       CALL pw_env_get(pw_env, auxbas_pw_pool=auxbas_pw_pool, poisson_env=poisson_env)
     337             : 
     338       98089 :       IF (gapw .AND. (poisson_env%parameters%solver .EQ. pw_poisson_implicit)) THEN
     339           0 :          CPABORT("The implicit Poisson solver cannot be used in conjunction with GAPW.")
     340             :       END IF
     341             : 
     342             :       ! ***  Prepare densities for gapw ***
     343       98089 :       IF (gapw .OR. gapw_xc) THEN
     344       15628 :          CALL prepare_gapw_den(qs_env, do_rho0=(.NOT. gapw_xc))
     345             :       END IF
     346             : 
     347             :       ! Calculate the Hartree potential
     348       98089 :       CALL auxbas_pw_pool%create_pw(v_hartree_gspace)
     349       98089 :       CALL auxbas_pw_pool%create_pw(rho_tot_gspace)
     350             : 
     351       98089 :       scf_section => section_vals_get_subs_vals(input, "DFT%SCF")
     352             :       IF (BTEST(cp_print_key_should_output(logger%iter_info, scf_section, &
     353             :                                            "PRINT%DETAILED_ENERGY"), &
     354             :                 cp_p_file) .AND. &
     355       98089 :           (.NOT. gapw) .AND. (.NOT. gapw_xc) .AND. &
     356             :           (.NOT. (poisson_env%parameters%solver .EQ. pw_poisson_implicit))) THEN
     357         906 :          CALL pw_zero(rho_tot_gspace)
     358         906 :          CALL calc_rho_tot_gspace(rho_tot_gspace, qs_env, rho, skip_nuclear_density=.TRUE.)
     359             :          CALL pw_poisson_solve(poisson_env, rho_tot_gspace, energy%e_hartree, &
     360         906 :                                v_hartree_gspace)
     361         906 :          CALL pw_zero(rho_tot_gspace)
     362         906 :          CALL pw_zero(v_hartree_gspace)
     363             :       END IF
     364             : 
     365             :       ! Get the total density in g-space [ions + electrons]
     366       98089 :       CALL calc_rho_tot_gspace(rho_tot_gspace, qs_env, rho)
     367             : 
     368       98089 :       IF (my_print) THEN
     369       98067 :          CALL print_densities(qs_env, rho)
     370             :       END IF
     371             : 
     372       98089 :       IF (dft_control%do_sccs) THEN
     373             :          ! Self-consistent continuum solvation (SCCS) model
     374             :          NULLIFY (v_sccs_rspace)
     375         132 :          ALLOCATE (v_sccs_rspace)
     376         132 :          CALL auxbas_pw_pool%create_pw(v_sccs_rspace)
     377             : 
     378         132 :          IF (poisson_env%parameters%solver .EQ. pw_poisson_implicit) THEN
     379           0 :             CPABORT("The implicit Poisson solver cannot be used together with SCCS.")
     380             :          END IF
     381             : 
     382         132 :          IF (use_virial .AND. calculate_forces) THEN
     383             :             CALL sccs(qs_env, rho_tot_gspace, v_hartree_gspace, v_sccs_rspace, &
     384           0 :                       h_stress=h_stress)
     385           0 :             virial%pv_ehartree = virial%pv_ehartree + h_stress/REAL(para_env%num_pe, dp)
     386           0 :             virial%pv_virial = virial%pv_virial + h_stress/REAL(para_env%num_pe, dp)
     387             :          ELSE
     388         132 :             CALL sccs(qs_env, rho_tot_gspace, v_hartree_gspace, v_sccs_rspace)
     389             :          END IF
     390             :       ELSE
     391             :          ! Getting the Hartree energy and Hartree potential.  Also getting the stress tensor
     392             :          ! from the Hartree term if needed.  No nuclear force information here
     393       97957 :          IF (use_virial .AND. calculate_forces) THEN
     394         378 :             h_stress(:, :) = 0.0_dp
     395             :             CALL pw_poisson_solve(poisson_env, rho_tot_gspace, energy%hartree, &
     396             :                                   v_hartree_gspace, h_stress=h_stress, &
     397         378 :                                   rho_core=rho_core)
     398        4914 :             virial%pv_ehartree = virial%pv_ehartree + h_stress/REAL(para_env%num_pe, dp)
     399        4914 :             virial%pv_virial = virial%pv_virial + h_stress/REAL(para_env%num_pe, dp)
     400             :          ELSE
     401             :             CALL pw_poisson_solve(poisson_env, rho_tot_gspace, energy%hartree, &
     402       97579 :                                   v_hartree_gspace, rho_core=rho_core)
     403             :          END IF
     404             :       END IF
     405             : 
     406             :       ! In case decouple periodic images and/or apply restraints to charges
     407       98089 :       IF (do_ddapc) THEN
     408             :          CALL qs_ks_ddapc(qs_env, auxbas_pw_pool, rho_tot_gspace, v_hartree_gspace, &
     409             :                           v_spin_ddapc_rest_r, energy, calculate_forces, ks_matrix, &
     410        1016 :                           just_energy)
     411             :       ELSE
     412       97073 :          dft_control%qs_control%ddapc_explicit_potential = .FALSE.
     413       97073 :          dft_control%qs_control%ddapc_restraint_is_spin = .FALSE.
     414       97073 :          IF (.NOT. just_energy) THEN
     415       90288 :             CALL pw_transfer(v_hartree_gspace, v_hartree_rspace)
     416       90288 :             CALL pw_scale(v_hartree_rspace, v_hartree_rspace%pw_grid%dvol)
     417             :          END IF
     418             :       END IF
     419       98089 :       CALL auxbas_pw_pool%give_back_pw(v_hartree_gspace)
     420             : 
     421       98089 :       IF (dft_control%correct_surf_dip) THEN
     422          98 :          IF (dft_control%surf_dip_correct_switch) THEN
     423          98 :             CALL calc_dipsurf_potential(qs_env, energy)
     424          98 :             energy%hartree = energy%hartree + energy%surf_dipole
     425             :          END IF
     426             :       END IF
     427             : 
     428             :       ! SIC
     429             :       CALL calc_v_sic_rspace(v_sic_rspace, energy, qs_env, dft_control, rho, poisson_env, &
     430       98089 :                              just_energy, calculate_forces, auxbas_pw_pool)
     431             : 
     432       98089 :       IF (gapw) THEN
     433       13094 :          CALL get_qs_env(qs_env, ecoul_1c=ecoul_1c, local_rho_set=local_rho_set)
     434             :          CALL Vh_1c_gg_integrals(qs_env, energy%hartree_1c, ecoul_1c, local_rho_set, para_env, tddft=.FALSE., &
     435       13094 :                                  core_2nd=.FALSE.)
     436             :       END IF
     437             : 
     438             :       ! Check if CDFT constraint is needed
     439       98089 :       CALL qs_ks_cdft_constraint(qs_env, auxbas_pw_pool, calculate_forces, cdft_control)
     440             : 
     441             :       ! Adds the External Potential if requested
     442       98089 :       IF (dft_control%apply_external_potential) THEN
     443             :          ! Compute the energy due to the external potential
     444             :          ee_ener = 0.0_dp
     445         728 :          DO ispin = 1, nspins
     446         728 :             ee_ener = ee_ener + pw_integral_ab(rho_r(ispin), vee)
     447             :          END DO
     448         364 :          IF (.NOT. just_energy) THEN
     449         364 :             IF (gapw) THEN
     450             :                CALL get_qs_env(qs_env=qs_env, &
     451          42 :                                rho0_s_rs=rho0_s_rs)
     452          42 :                CPASSERT(ASSOCIATED(rho0_s_rs))
     453          42 :                ee_ener = ee_ener + pw_integral_ab(rho0_s_rs, vee)
     454             :             END IF
     455             :          END IF
     456             :          ! the sign accounts for the charge of the electrons
     457         364 :          energy%ee = -ee_ener
     458             :       END IF
     459             : 
     460             :       ! Adds the QM/MM potential
     461       98089 :       IF (qs_env%qmmm) THEN
     462             :          CALL qmmm_calculate_energy(qs_env=qs_env, &
     463             :                                     rho=rho_r, &
     464             :                                     v_qmmm=qs_env%ks_qmmm_env%v_qmmm_rspace, &
     465        6298 :                                     qmmm_energy=energy%qmmm_el)
     466        6298 :          IF (qs_env%qmmm_env_qm%image_charge) THEN
     467             :             CALL calculate_image_pot(v_hartree_rspace=v_hartree_rspace, &
     468             :                                      rho_hartree_gspace=rho_tot_gspace, &
     469             :                                      energy=energy, &
     470             :                                      qmmm_env=qs_env%qmmm_env_qm, &
     471          60 :                                      qs_env=qs_env)
     472          60 :             IF (.NOT. just_energy) THEN
     473             :                CALL add_image_pot_to_hartree_pot(v_hartree=v_hartree_rspace, &
     474             :                                                  v_metal=qs_env%ks_qmmm_env%v_metal_rspace, &
     475          60 :                                                  qs_env=qs_env)
     476          60 :                IF (calculate_forces) THEN
     477             :                   CALL integrate_potential_devga_rspace( &
     478             :                      potential=v_hartree_rspace, coeff=qs_env%image_coeff, &
     479             :                      forces=qs_env%qmmm_env_qm%image_charge_pot%image_forcesMM, &
     480          20 :                      qmmm_env=qs_env%qmmm_env_qm, qs_env=qs_env)
     481             :                END IF
     482             :             END IF
     483          60 :             CALL qs_env%ks_qmmm_env%v_metal_rspace%release()
     484          60 :             DEALLOCATE (qs_env%ks_qmmm_env%v_metal_rspace)
     485             :          END IF
     486        6298 :          IF (.NOT. just_energy) THEN
     487             :             CALL qmmm_modify_hartree_pot(v_hartree=v_hartree_rspace, &
     488        6218 :                                          v_qmmm=qs_env%ks_qmmm_env%v_qmmm_rspace, scale=1.0_dp)
     489             :          END IF
     490             :       END IF
     491       98089 :       CALL auxbas_pw_pool%give_back_pw(rho_tot_gspace)
     492             : 
     493             :       ! SMEAGOL interface
     494       98089 :       IF (dft_control%smeagol_control%smeagol_enabled .AND. &
     495             :           dft_control%smeagol_control%run_type == smeagol_runtype_emtransport) THEN
     496           0 :          CPASSERT(ASSOCIATED(dft_control%smeagol_control%aux))
     497             :          CALL smeagol_shift_v_hartree(v_hartree_rspace, cell, &
     498             :                                       dft_control%smeagol_control%aux%HartreeLeadsLeft, &
     499             :                                       dft_control%smeagol_control%aux%HartreeLeadsRight, &
     500             :                                       dft_control%smeagol_control%aux%HartreeLeadsBottom, &
     501             :                                       dft_control%smeagol_control%aux%VBias, &
     502             :                                       dft_control%smeagol_control%aux%minL, &
     503             :                                       dft_control%smeagol_control%aux%maxR, &
     504             :                                       dft_control%smeagol_control%aux%isexplicit_maxR, &
     505           0 :                                       dft_control%smeagol_control%aux%isexplicit_HartreeLeadsBottom)
     506             :       END IF
     507             : 
     508             :       ! calculate the density matrix for the fitted mo_coeffs
     509       98089 :       IF (dft_control%do_admm) THEN
     510       10156 :          CALL hfx_admm_init(qs_env, calculate_forces)
     511             : 
     512       10156 :          IF (dft_control%do_admm_mo) THEN
     513       10016 :             IF (qs_env%run_rtp) THEN
     514          76 :                CALL rtp_admm_calc_rho_aux(qs_env)
     515             :             ELSE
     516        9940 :                IF (dokp) THEN
     517          90 :                   CALL admm_mo_calc_rho_aux_kp(qs_env)
     518             :                ELSE
     519        9850 :                   CALL admm_mo_calc_rho_aux(qs_env)
     520             :                END IF
     521             :             END IF
     522         140 :          ELSEIF (dft_control%do_admm_dm) THEN
     523         140 :             CALL admm_dm_calc_rho_aux(qs_env)
     524             :          END IF
     525             :       END IF
     526             : 
     527             :       ! only activate stress calculation if
     528       98089 :       IF (use_virial .AND. calculate_forces) virial%pv_calculate = .TRUE.
     529             : 
     530             :       ! *** calculate the xc potential on the pw density ***
     531             :       ! *** associates v_rspace_new if the xc potential needs to be computed.
     532             :       ! If we do wavefunction fitting, we need the vxc_potential in the auxiliary basis set
     533       98089 :       IF (dft_control%do_admm) THEN
     534       10156 :          CALL get_qs_env(qs_env, admm_env=admm_env)
     535       10156 :          xc_section => admm_env%xc_section_aux
     536       10156 :          CALL get_admm_env(admm_env, rho_aux_fit=rho_struct)
     537             : 
     538             :          ! here we ignore a possible vdW section in admm_env%xc_section_aux
     539             :          CALL qs_vxc_create(ks_env=ks_env, rho_struct=rho_struct, xc_section=xc_section, &
     540             :                             vxc_rho=v_rspace_new_aux_fit, vxc_tau=v_tau_rspace_aux_fit, exc=energy%exc_aux_fit, &
     541       10156 :                             just_energy=just_energy_xc)
     542             : 
     543       10156 :          IF (admm_env%do_gapw) THEN
     544             :             !compute the potential due to atomic densities
     545             :             CALL calculate_vxc_atom(qs_env, energy_only=just_energy_xc, exc1=energy%exc1_aux_fit, &
     546             :                                     kind_set_external=admm_env%admm_gapw_env%admm_kind_set, &
     547             :                                     xc_section_external=xc_section, &
     548        2342 :                                     rho_atom_set_external=admm_env%admm_gapw_env%local_rho_set%rho_atom_set)
     549             : 
     550             :          END IF
     551             : 
     552       10156 :          NULLIFY (rho_struct)
     553             : 
     554       10156 :          IF (use_virial .AND. calculate_forces) THEN
     555          12 :             vscale = 1.0_dp
     556             :             !Note: ADMMS and ADMMP stress tensor only for closed-shell calculations
     557          12 :             IF (admm_env%do_admms) vscale = admm_env%gsi(1)**(2.0_dp/3.0_dp)
     558          12 :             IF (admm_env%do_admmp) vscale = admm_env%gsi(1)**2
     559         156 :             virial%pv_exc = virial%pv_exc - vscale*virial%pv_xc
     560         156 :             virial%pv_virial = virial%pv_virial - vscale*virial%pv_xc
     561             :             ! virial%pv_xc will be zeroed in the xc routines
     562             :          END IF
     563       10156 :          xc_section => admm_env%xc_section_primary
     564             :       ELSE
     565       87933 :          xc_section => section_vals_get_subs_vals(input, "DFT%XC")
     566             :       END IF
     567             : 
     568       98089 :       IF (gapw_xc) THEN
     569        2534 :          CALL get_qs_env(qs_env=qs_env, rho_xc=rho_struct)
     570             :       ELSE
     571       95555 :          CALL get_qs_env(qs_env=qs_env, rho=rho_struct)
     572             :       END IF
     573             : 
     574             :       ! zmp
     575       98089 :       IF (dft_control%apply_external_density .OR. dft_control%apply_external_vxc) THEN
     576           0 :          energy%exc = 0.0_dp
     577           0 :          CALL calculate_zmp_potential(qs_env, v_rspace_new, rho, exc=energy%exc)
     578             :       ELSE
     579             :          ! Embedding potential
     580       98089 :          IF (dft_control%apply_embed_pot) THEN
     581         868 :             NULLIFY (v_rspace_embed)
     582         868 :             energy%embed_corr = 0.0_dp
     583             :             CALL get_embed_potential_energy(qs_env, rho, v_rspace_embed, dft_control, &
     584         868 :                                             energy%embed_corr, just_energy)
     585             :          END IF
     586             :          ! Everything else
     587             :          CALL qs_vxc_create(ks_env=ks_env, rho_struct=rho_struct, xc_section=xc_section, &
     588             :                             vxc_rho=v_rspace_new, vxc_tau=v_tau_rspace, exc=energy%exc, &
     589             :                             edisp=edisp, dispersion_env=qs_env%dispersion_env, &
     590       98089 :                             just_energy=just_energy_xc)
     591       98089 :          IF (edisp /= 0.0_dp) energy%dispersion = edisp
     592       98089 :          IF (qs_env%requires_matrix_vxc .AND. ASSOCIATED(v_rspace_new)) THEN
     593           0 :             CALL compute_matrix_vxc(qs_env=qs_env, v_rspace=v_rspace_new, matrix_vxc=matrix_vxc)
     594           0 :             CALL set_ks_env(ks_env, matrix_vxc=matrix_vxc)
     595             :          END IF
     596             : 
     597       98089 :          IF (gapw .OR. gapw_xc) THEN
     598       15628 :             CALL calculate_vxc_atom(qs_env, just_energy_xc, energy%exc1, xc_section_external=xc_section)
     599             :             ! test for not implemented (bug) option
     600       15628 :             IF (use_virial .AND. calculate_forces) THEN
     601          26 :                IF (ASSOCIATED(v_tau_rspace)) THEN
     602           0 :                   CPABORT("MGGA STRESS with GAPW/GAPW_XC not implemneted")
     603             :                END IF
     604             :             END IF
     605             :          END IF
     606             : 
     607             :       END IF
     608             : 
     609             :       ! set hartree and xc potentials for use in Harris method
     610       98089 :       IF (qs_env%harris_method) THEN
     611          54 :          CALL get_qs_env(qs_env, harris_env=harris_env)
     612          54 :          CALL harris_set_potentials(harris_env, v_hartree_rspace, v_rspace_new)
     613             :       END IF
     614             : 
     615       98089 :       NULLIFY (rho_struct)
     616       98089 :       IF (use_virial .AND. calculate_forces) THEN
     617        4914 :          virial%pv_exc = virial%pv_exc - virial%pv_xc
     618        4914 :          virial%pv_virial = virial%pv_virial - virial%pv_xc
     619             :       END IF
     620             : 
     621             :       ! *** Add Hartree-Fock contribution if required ***
     622       98089 :       IF (do_hfx) THEN
     623       23516 :          IF (dokp) THEN
     624         190 :             CALL hfx_ks_matrix_kp(qs_env, ks_matrix, energy, calculate_forces)
     625             :          ELSE
     626             :             CALL hfx_ks_matrix(qs_env, ks_matrix, rho, energy, calculate_forces, &
     627       23326 :                                just_energy, v_rspace_new, v_tau_rspace)
     628             :          END IF
     629             : !!    Adiabatic rescaling  only if do_hfx; right?????
     630             :       END IF !do_hfx
     631             : 
     632       98089 :       IF (do_ppl .AND. calculate_forces) THEN
     633          12 :          CPASSERT(.NOT. gapw)
     634          26 :          DO ispin = 1, nspins
     635          26 :             CALL integrate_ppl_rspace(rho_r(ispin), qs_env)
     636             :          END DO
     637             :       END IF
     638             : 
     639       98089 :       IF (ASSOCIATED(rho_nlcc) .AND. calculate_forces) THEN
     640          60 :          DO ispin = 1, nspins
     641          30 :             CALL integrate_rho_nlcc(v_rspace_new(ispin), qs_env)
     642          60 :             IF (dft_control%do_admm) CALL integrate_rho_nlcc(v_rspace_new_aux_fit(ispin), qs_env)
     643             :          END DO
     644             :       END IF
     645             : 
     646             :       ! calculate KG correction
     647       98089 :       IF (dft_control%qs_control%do_kg .AND. just_energy) THEN
     648             : 
     649          12 :          CPASSERT(.NOT. (gapw .OR. gapw_xc))
     650          12 :          CPASSERT(nimages == 1)
     651          12 :          ksmat => ks_matrix(:, 1)
     652          12 :          CALL kg_ekin_subset(qs_env, ksmat, ekin_mol, calculate_forces, do_kernel=.FALSE.)
     653             : 
     654             :          ! subtract kg corr from the total energy
     655          12 :          energy%exc = energy%exc - ekin_mol
     656             : 
     657             :       END IF
     658             : 
     659             :       ! ***  Single atom contributions ***
     660       98089 :       IF (.NOT. just_energy) THEN
     661       91038 :          IF (calculate_forces) THEN
     662             :             ! Getting nuclear force contribution from the core charge density
     663        5353 :             IF ((poisson_env%parameters%solver .EQ. pw_poisson_implicit) .AND. &
     664             :                 (poisson_env%parameters%dielectric_params%dielec_core_correction)) THEN
     665          28 :                BLOCK
     666             :                   TYPE(pw_r3d_rs_type) :: v_minus_veps
     667          28 :                   CALL auxbas_pw_pool%create_pw(v_minus_veps)
     668          28 :                   CALL pw_copy(v_hartree_rspace, v_minus_veps)
     669          28 :                   CALL pw_axpy(poisson_env%implicit_env%v_eps, v_minus_veps, -v_hartree_rspace%pw_grid%dvol)
     670          28 :                   CALL integrate_v_core_rspace(v_minus_veps, qs_env)
     671          28 :                   CALL auxbas_pw_pool%give_back_pw(v_minus_veps)
     672             :                END BLOCK
     673             :             ELSE
     674        5325 :                CALL integrate_v_core_rspace(v_hartree_rspace, qs_env)
     675             :             END IF
     676             :          END IF
     677             : 
     678       91038 :          IF (.NOT. do_hfx) THEN
     679             :             ! Initialize the Kohn-Sham matrix with the core Hamiltonian matrix
     680             :             ! (sets ks sparsity equal to matrix_h sparsity)
     681      151579 :             DO ispin = 1, nspins
     682      332150 :                DO img = 1, nimages
     683      180571 :                   CALL dbcsr_get_info(ks_matrix(ispin, img)%matrix, name=name) ! keep the name
     684      262872 :                   CALL dbcsr_copy(ks_matrix(ispin, img)%matrix, matrix_h(1, img)%matrix, name=name)
     685             :                END DO
     686             :             END DO
     687             :             ! imaginary part if required
     688       69278 :             IF (qs_env%run_rtp) THEN
     689        2002 :                IF (dft_control%rtp_control%velocity_gauge) THEN
     690         150 :                   CPASSERT(ASSOCIATED(matrix_h_im))
     691         150 :                   CPASSERT(ASSOCIATED(ks_matrix_im))
     692         300 :                   DO ispin = 1, nspins
     693         450 :                      DO img = 1, nimages
     694         150 :                         CALL dbcsr_get_info(ks_matrix_im(ispin, img)%matrix, name=name) ! keep the name
     695         300 :                         CALL dbcsr_copy(ks_matrix_im(ispin, img)%matrix, matrix_h_im(1, img)%matrix, name=name)
     696             :                      END DO
     697             :                   END DO
     698             :                END IF
     699             :             END IF
     700             :          END IF
     701             : 
     702       91038 :          IF (use_virial .AND. calculate_forces) THEN
     703        4914 :             pv_loc = virial%pv_virial
     704             :          END IF
     705             :          ! sum up potentials and integrate
     706             :          ! Pointing my_rho to the density matrix rho_ao
     707       91038 :          my_rho => rho_ao
     708             : 
     709             :          CALL sum_up_and_integrate(qs_env, ks_matrix, rho, my_rho, vppl_rspace, &
     710             :                                    v_rspace_new, v_rspace_new_aux_fit, v_tau_rspace, v_tau_rspace_aux_fit, &
     711             :                                    v_sic_rspace, v_spin_ddapc_rest_r, v_sccs_rspace, v_rspace_embed, &
     712       91038 :                                    cdft_control, calculate_forces)
     713             : 
     714       91038 :          IF (use_virial .AND. calculate_forces) THEN
     715        4914 :             virial%pv_ehartree = virial%pv_ehartree + (virial%pv_virial - pv_loc)
     716             :          END IF
     717       91038 :          IF (dft_control%qs_control%do_kg) THEN
     718         776 :             CPASSERT(.NOT. (gapw .OR. gapw_xc))
     719         776 :             CPASSERT(nimages == 1)
     720         776 :             ksmat => ks_matrix(:, 1)
     721             : 
     722         776 :             IF (use_virial .AND. calculate_forces) THEN
     723           0 :                pv_loc = virial%pv_virial
     724             :             END IF
     725             : 
     726         776 :             CALL kg_ekin_subset(qs_env, ksmat, ekin_mol, calculate_forces, do_kernel=.FALSE.)
     727             :             ! subtract kg corr from the total energy
     728         776 :             energy%exc = energy%exc - ekin_mol
     729             : 
     730             :             ! virial corrections
     731         776 :             IF (use_virial .AND. calculate_forces) THEN
     732             : 
     733             :                ! Integral contribution
     734           0 :                virial%pv_ehartree = virial%pv_ehartree + (virial%pv_virial - pv_loc)
     735             : 
     736             :                ! GGA contribution
     737           0 :                virial%pv_exc = virial%pv_exc + virial%pv_xc
     738           0 :                virial%pv_virial = virial%pv_virial + virial%pv_xc
     739           0 :                virial%pv_xc = 0.0_dp
     740             :             END IF
     741             :          END IF
     742             : 
     743             :       ELSE
     744             :          IF (do_hfx) THEN
     745             :             IF (.FALSE.) THEN
     746             :                CPWARN("KS matrix not longer correct. Check possible problems with property calculations!")
     747             :             END IF
     748             :          END IF
     749             :       END IF ! .NOT. just energy
     750             : 
     751       98089 :       IF (dft_control%qs_control%ddapc_explicit_potential) THEN
     752          92 :          CALL auxbas_pw_pool%give_back_pw(v_spin_ddapc_rest_r)
     753          92 :          DEALLOCATE (v_spin_ddapc_rest_r)
     754             :       END IF
     755             : 
     756       98089 :       IF (calculate_forces .AND. dft_control%qs_control%cdft) THEN
     757         118 :          IF (.NOT. cdft_control%transfer_pot) THEN
     758         212 :             DO iatom = 1, SIZE(cdft_control%group)
     759         114 :                CALL auxbas_pw_pool%give_back_pw(cdft_control%group(iatom)%weight)
     760         212 :                DEALLOCATE (cdft_control%group(iatom)%weight)
     761             :             END DO
     762          98 :             IF (cdft_control%atomic_charges) THEN
     763          78 :                DO iatom = 1, cdft_control%natoms
     764          78 :                   CALL auxbas_pw_pool%give_back_pw(cdft_control%charge(iatom))
     765             :                END DO
     766          26 :                DEALLOCATE (cdft_control%charge)
     767             :             END IF
     768          98 :             IF (cdft_control%type == outer_scf_becke_constraint .AND. &
     769             :                 cdft_control%becke_control%cavity_confine) THEN
     770          88 :                IF (.NOT. ASSOCIATED(cdft_control%becke_control%cavity_mat)) THEN
     771          64 :                   CALL auxbas_pw_pool%give_back_pw(cdft_control%becke_control%cavity)
     772             :                ELSE
     773          24 :                   DEALLOCATE (cdft_control%becke_control%cavity_mat)
     774             :                END IF
     775          10 :             ELSE IF (cdft_control%type == outer_scf_hirshfeld_constraint) THEN
     776           2 :                IF (ASSOCIATED(cdft_control%hirshfeld_control%hirshfeld_env%fnorm)) THEN
     777           0 :                   CALL auxbas_pw_pool%give_back_pw(cdft_control%hirshfeld_control%hirshfeld_env%fnorm)
     778             :                END IF
     779             :             END IF
     780          98 :             IF (ASSOCIATED(cdft_control%charges_fragment)) DEALLOCATE (cdft_control%charges_fragment)
     781          98 :             cdft_control%save_pot = .FALSE.
     782          98 :             cdft_control%need_pot = .TRUE.
     783          98 :             cdft_control%external_control = .FALSE.
     784             :          END IF
     785             :       END IF
     786             : 
     787       98089 :       IF (dft_control%do_sccs) THEN
     788         132 :          CALL auxbas_pw_pool%give_back_pw(v_sccs_rspace)
     789         132 :          DEALLOCATE (v_sccs_rspace)
     790             :       END IF
     791             : 
     792       98089 :       IF (gapw) THEN
     793       13094 :          IF (dft_control%apply_external_potential) THEN
     794             :             ! Integrals of the Hartree potential with g0_soft
     795             :             CALL qmmm_modify_hartree_pot(v_hartree=v_hartree_rspace, &
     796          42 :                                          v_qmmm=vee, scale=-1.0_dp)
     797             :          END IF
     798       13094 :          CALL integrate_vhg0_rspace(qs_env, v_hartree_rspace, para_env, calculate_forces)
     799             :       END IF
     800             : 
     801       98089 :       IF (gapw .OR. gapw_xc) THEN
     802             :          ! Single atom contributions in the KS matrix ***
     803       15628 :          CALL update_ks_atom(qs_env, ks_matrix, rho_ao, calculate_forces)
     804       15628 :          IF (dft_control%do_admm) THEN
     805             :             !Single atom contribution to the AUX matrices
     806             :             !Note: also update ks_aux_fit matrix in case of rtp
     807        2342 :             CALL admm_update_ks_atom(qs_env, calculate_forces)
     808             :          END IF
     809             :       END IF
     810             : 
     811             :       !Calculation of Mulliken restraint, if requested
     812             :       CALL qs_ks_mulliken_restraint(energy, dft_control, just_energy, para_env, &
     813       98089 :                                     ks_matrix, matrix_s, rho, mulliken_order_p)
     814             : 
     815             :       ! Add DFT+U contribution, if requested
     816       98089 :       IF (dft_control%dft_plus_u) THEN
     817        1552 :          CPASSERT(nimages == 1)
     818        1552 :          IF (just_energy) THEN
     819         588 :             CALL plus_u(qs_env=qs_env)
     820             :          ELSE
     821         964 :             ksmat => ks_matrix(:, 1)
     822         964 :             CALL plus_u(qs_env=qs_env, matrix_h=ksmat)
     823             :          END IF
     824             :       ELSE
     825       96537 :          energy%dft_plus_u = 0.0_dp
     826             :       END IF
     827             : 
     828             :       ! At this point the ks matrix should be up to date, filter it if requested
     829      216276 :       DO ispin = 1, nspins
     830      442335 :          DO img = 1, nimages
     831             :             CALL dbcsr_filter(ks_matrix(ispin, img)%matrix, &
     832      344246 :                               dft_control%qs_control%eps_filter_matrix)
     833             :          END DO
     834             :       END DO
     835             : 
     836             :       !** merge the auxiliary KS matrix and the primary one
     837       98089 :       IF (dft_control%do_admm_mo) THEN
     838       10016 :          IF (qs_env%run_rtp) THEN
     839          76 :             CALL rtp_admm_merge_ks_matrix(qs_env)
     840             :          ELSE
     841        9940 :             CALL admm_mo_merge_ks_matrix(qs_env)
     842             :          END IF
     843       88073 :       ELSEIF (dft_control%do_admm_dm) THEN
     844         140 :          CALL admm_dm_merge_ks_matrix(qs_env)
     845             :       END IF
     846             : 
     847             :       ! External field (nonperiodic case)
     848       98089 :       CALL qs_efield_local_operator(qs_env, just_energy, calculate_forces)
     849             : 
     850             :       ! Right now we can compute the orbital derivative here, as it depends currently only on the available
     851             :       ! Kohn-Sham matrix. This might change in the future, in which case more pieces might need to be assembled
     852             :       ! from this routine, notice that this part of the calculation in not linear scaling
     853             :       ! right now this operation is only non-trivial because of occupation numbers and the restricted keyword
     854       98089 :       IF (qs_env%requires_mo_derivs .AND. .NOT. just_energy .AND. .NOT. qs_env%run_rtp) THEN
     855       34546 :          CALL get_qs_env(qs_env, mo_derivs=mo_derivs)
     856       34546 :          CPASSERT(nimages == 1)
     857       34546 :          ksmat => ks_matrix(:, 1)
     858       34546 :          CALL calc_mo_derivatives(qs_env, ksmat, mo_derivs)
     859             :       END IF
     860             : 
     861             :       ! ADMM overlap forces
     862       98089 :       IF (calculate_forces .AND. dft_control%do_admm) THEN
     863         262 :          IF (dokp) THEN
     864          24 :             CALL calc_admm_ovlp_forces_kp(qs_env)
     865             :          ELSE
     866         238 :             CALL calc_admm_ovlp_forces(qs_env)
     867             :          END IF
     868             :       END IF
     869             : 
     870             :       ! deal with low spin roks
     871             :       CALL low_spin_roks(energy, qs_env, dft_control, do_hfx, just_energy, &
     872       98089 :                          calculate_forces, auxbas_pw_pool)
     873             : 
     874             :       ! deal with sic on explicit orbitals
     875             :       CALL sic_explicit_orbitals(energy, qs_env, dft_control, poisson_env, just_energy, &
     876       98089 :                                  calculate_forces, auxbas_pw_pool)
     877             : 
     878             :       ! Periodic external field
     879       98089 :       CALL qs_efield_berry_phase(qs_env, just_energy, calculate_forces)
     880             : 
     881             :       ! adds s2_restraint energy and orbital derivatives
     882             :       CALL qs_ks_s2_restraint(dft_control, qs_env, matrix_s, &
     883       98089 :                               energy, calculate_forces, just_energy)
     884             : 
     885       98089 :       IF (do_ppl) THEN
     886             :          ! update core energy for grid based local pseudopotential
     887          60 :          ecore_ppl = 0._dp
     888         126 :          DO ispin = 1, nspins
     889         126 :             ecore_ppl = ecore_ppl + pw_integral_ab(vppl_rspace, rho_r(ispin))
     890             :          END DO
     891          60 :          energy%core = energy%core + ecore_ppl
     892             :       END IF
     893             : 
     894       98089 :       IF (lrigpw) THEN
     895             :          ! update core energy for ppl_ri method
     896         424 :          CALL get_qs_env(qs_env, lri_env=lri_env, lri_density=lri_density)
     897         424 :          IF (lri_env%ppl_ri) THEN
     898           8 :             ecore_ppl = 0._dp
     899          16 :             DO ispin = 1, nspins
     900           8 :                lri_v_int => lri_density%lri_coefs(ispin)%lri_kinds
     901          16 :                CALL v_int_ppl_energy(qs_env, lri_v_int, ecore_ppl)
     902             :             END DO
     903           8 :             energy%core = energy%core + ecore_ppl
     904             :          END IF
     905             :       END IF
     906             : 
     907             :       ! Sum all energy terms to obtain the total energy
     908             :       energy%total = energy%core_overlap + energy%core_self + energy%core + energy%hartree + &
     909             :                      energy%hartree_1c + energy%exc + energy%exc1 + energy%ex + &
     910             :                      energy%dispersion + energy%gcp + energy%qmmm_el + energy%mulliken + &
     911             :                      SUM(energy%ddapc_restraint) + energy%s2_restraint + &
     912             :                      energy%dft_plus_u + energy%kTS + &
     913             :                      energy%efield + energy%efield_core + energy%ee + &
     914             :                      energy%ee_core + energy%exc_aux_fit + energy%image_charge + &
     915      196234 :                      energy%sccs_pol + energy%cdft + energy%exc1_aux_fit
     916             : 
     917       98089 :       IF (dft_control%apply_embed_pot) energy%total = energy%total + energy%embed_corr
     918             : 
     919       98089 :       IF (abnormal_value(energy%total)) &
     920           0 :          CPABORT("KS energy is an abnormal value (NaN/Inf).")
     921             : 
     922             :       ! Print detailed energy
     923       98089 :       IF (my_print) THEN
     924       98067 :          CALL print_detailed_energy(qs_env, dft_control, input, energy, mulliken_order_p)
     925             :       END IF
     926             : 
     927       98089 :       CALL timestop(handle)
     928             : 
     929       98089 :    END SUBROUTINE qs_ks_build_kohn_sham_matrix
     930             : 
     931             : ! **************************************************************************************************
     932             : !> \brief ...
     933             : !> \param rho_tot_gspace ...
     934             : !> \param qs_env ...
     935             : !> \param rho ...
     936             : !> \param skip_nuclear_density ...
     937             : ! **************************************************************************************************
     938      101411 :    SUBROUTINE calc_rho_tot_gspace(rho_tot_gspace, qs_env, rho, skip_nuclear_density)
     939             :       TYPE(pw_c1d_gs_type), INTENT(INOUT)                :: rho_tot_gspace
     940             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     941             :       TYPE(qs_rho_type), POINTER                         :: rho
     942             :       LOGICAL, INTENT(IN), OPTIONAL                      :: skip_nuclear_density
     943             : 
     944             :       INTEGER                                            :: ispin
     945             :       LOGICAL                                            :: my_skip
     946             :       TYPE(dft_control_type), POINTER                    :: dft_control
     947      101411 :       TYPE(pw_c1d_gs_type), DIMENSION(:), POINTER        :: rho_g
     948             :       TYPE(pw_c1d_gs_type), POINTER                      :: rho0_s_gs, rho_core
     949             :       TYPE(qs_charges_type), POINTER                     :: qs_charges
     950             : 
     951      101411 :       my_skip = .FALSE.
     952         920 :       IF (PRESENT(skip_nuclear_density)) my_skip = skip_nuclear_density
     953             : 
     954      101411 :       CALL qs_rho_get(rho, rho_g=rho_g)
     955      101411 :       CALL get_qs_env(qs_env=qs_env, dft_control=dft_control)
     956             : 
     957      101411 :       IF (.NOT. my_skip) THEN
     958      100501 :          NULLIFY (rho_core)
     959      100501 :          CALL get_qs_env(qs_env=qs_env, rho_core=rho_core)
     960      100501 :          IF (dft_control%qs_control%gapw) THEN
     961       13166 :             NULLIFY (rho0_s_gs)
     962       13166 :             CALL get_qs_env(qs_env=qs_env, rho0_s_gs=rho0_s_gs)
     963       13166 :             CPASSERT(ASSOCIATED(rho0_s_gs))
     964       13166 :             CALL pw_copy(rho0_s_gs, rho_tot_gspace)
     965       13166 :             IF (dft_control%qs_control%gapw_control%nopaw_as_gpw) THEN
     966        1238 :                CALL pw_axpy(rho_core, rho_tot_gspace)
     967             :             END IF
     968             :          ELSE
     969       87335 :             CALL pw_copy(rho_core, rho_tot_gspace)
     970             :          END IF
     971      221388 :          DO ispin = 1, dft_control%nspins
     972      221388 :             CALL pw_axpy(rho_g(ispin), rho_tot_gspace)
     973             :          END DO
     974      100501 :          CALL get_qs_env(qs_env=qs_env, qs_charges=qs_charges)
     975      100501 :          qs_charges%total_rho_gspace = pw_integrate_function(rho_tot_gspace, isign=-1)
     976             :       ELSE
     977        1824 :          DO ispin = 1, dft_control%nspins
     978        1824 :             CALL pw_axpy(rho_g(ispin), rho_tot_gspace)
     979             :          END DO
     980             :       END IF
     981             : 
     982      101411 :    END SUBROUTINE calc_rho_tot_gspace
     983             : 
     984             : ! **************************************************************************************************
     985             : !> \brief compute MO derivatives
     986             : !> \param qs_env the qs_env to update
     987             : !> \param ks_matrix ...
     988             : !> \param mo_derivs ...
     989             : !> \par History
     990             : !>      01.2014 created, transferred from qs_ks_build_kohn_sham_matrix in
     991             : !>      separate subroutine
     992             : !> \author Dorothea Golze
     993             : ! **************************************************************************************************
     994       34546 :    SUBROUTINE calc_mo_derivatives(qs_env, ks_matrix, mo_derivs)
     995             :       TYPE(qs_environment_type), POINTER                 :: qs_env
     996             :       TYPE(dbcsr_p_type), DIMENSION(:), POINTER          :: ks_matrix, mo_derivs
     997             : 
     998             :       INTEGER                                            :: ispin
     999             :       LOGICAL                                            :: uniform_occupation
    1000       34546 :       REAL(KIND=dp), DIMENSION(:), POINTER               :: occupation_numbers
    1001             :       TYPE(cp_fm_type), POINTER                          :: mo_coeff
    1002             :       TYPE(dbcsr_type)                                   :: mo_derivs2_tmp1, mo_derivs2_tmp2
    1003             :       TYPE(dbcsr_type), POINTER                          :: mo_coeff_b
    1004             :       TYPE(dft_control_type), POINTER                    :: dft_control
    1005       34546 :       TYPE(mo_set_type), DIMENSION(:), POINTER           :: mo_array
    1006             : 
    1007       34546 :       NULLIFY (dft_control, mo_array, mo_coeff, mo_coeff_b, occupation_numbers)
    1008             : 
    1009             :       CALL get_qs_env(qs_env, &
    1010             :                       dft_control=dft_control, &
    1011       34546 :                       mos=mo_array)
    1012             : 
    1013       75637 :       DO ispin = 1, SIZE(mo_derivs)
    1014             : 
    1015             :          CALL get_mo_set(mo_set=mo_array(ispin), mo_coeff=mo_coeff, &
    1016       41091 :                          mo_coeff_b=mo_coeff_b, occupation_numbers=occupation_numbers)
    1017             :          CALL dbcsr_multiply('n', 'n', 1.0_dp, ks_matrix(ispin)%matrix, mo_coeff_b, &
    1018       41091 :                              0.0_dp, mo_derivs(ispin)%matrix)
    1019             : 
    1020       75637 :          IF (dft_control%restricted) THEN
    1021             :             ! only the first mo_set are actual variables, but we still need both
    1022         552 :             CPASSERT(ispin == 1)
    1023         552 :             CPASSERT(SIZE(mo_array) == 2)
    1024             :             ! use a temporary array with the same size as the first spin for the second spin
    1025             : 
    1026             :             ! uniform_occupation is needed for this case, otherwise we can no
    1027             :             ! reconstruct things in ot, since we irreversibly sum
    1028         552 :             CALL get_mo_set(mo_set=mo_array(1), uniform_occupation=uniform_occupation)
    1029         552 :             CPASSERT(uniform_occupation)
    1030         552 :             CALL get_mo_set(mo_set=mo_array(2), uniform_occupation=uniform_occupation)
    1031         552 :             CPASSERT(uniform_occupation)
    1032             : 
    1033             :             ! The beta-spin might have fewer orbitals than alpa-spin...
    1034             :             ! create tempoary matrices with beta_nmo columns
    1035         552 :             CALL get_mo_set(mo_set=mo_array(2), mo_coeff_b=mo_coeff_b)
    1036         552 :             CALL dbcsr_create(mo_derivs2_tmp1, template=mo_coeff_b)
    1037             : 
    1038             :             ! calculate beta derivatives
    1039         552 :             CALL dbcsr_multiply('n', 'n', 1.0_dp, ks_matrix(2)%matrix, mo_coeff_b, 0.0_dp, mo_derivs2_tmp1)
    1040             : 
    1041             :             ! create larger matrix with alpha_nmo columns
    1042         552 :             CALL dbcsr_create(mo_derivs2_tmp2, template=mo_derivs(1)%matrix)
    1043         552 :             CALL dbcsr_set(mo_derivs2_tmp2, 0.0_dp)
    1044             : 
    1045             :             ! copy into larger matrix, fills the first beta_nmo columns
    1046             :             CALL dbcsr_copy_columns_hack(mo_derivs2_tmp2, mo_derivs2_tmp1, &
    1047             :                                          mo_array(2)%nmo, 1, 1, &
    1048             :                                          para_env=mo_array(1)%mo_coeff%matrix_struct%para_env, &
    1049         552 :                                          blacs_env=mo_array(1)%mo_coeff%matrix_struct%context)
    1050             : 
    1051             :             ! add beta contribution to alpa mo_derivs
    1052         552 :             CALL dbcsr_add(mo_derivs(1)%matrix, mo_derivs2_tmp2, 1.0_dp, 1.0_dp)
    1053         552 :             CALL dbcsr_release(mo_derivs2_tmp1)
    1054         552 :             CALL dbcsr_release(mo_derivs2_tmp2)
    1055             :          END IF
    1056             :       END DO
    1057             : 
    1058       34546 :       IF (dft_control%do_admm_mo) THEN
    1059        5006 :          CALL calc_admm_mo_derivatives(qs_env, mo_derivs)
    1060             :       END IF
    1061             : 
    1062       34546 :    END SUBROUTINE calc_mo_derivatives
    1063             : 
    1064             : ! **************************************************************************************************
    1065             : !> \brief updates the Kohn Sham matrix of the given qs_env (facility method)
    1066             : !> \param qs_env the qs_env to update
    1067             : !> \param calculate_forces if true calculate the quantities needed
    1068             : !>        to calculate the forces. Defaults to false.
    1069             : !> \param just_energy if true updates the energies but not the
    1070             : !>        ks matrix. Defaults to false
    1071             : !> \param print_active ...
    1072             : !> \par History
    1073             : !>      4.2002 created [fawzi]
    1074             : !>      8.2014 kpoints [JGH]
    1075             : !>     10.2014 refractored [Ole Schuett]
    1076             : !> \author Fawzi Mohamed
    1077             : ! **************************************************************************************************
    1078      182673 :    SUBROUTINE qs_ks_update_qs_env(qs_env, calculate_forces, just_energy, &
    1079             :                                   print_active)
    1080             :       TYPE(qs_environment_type), POINTER                 :: qs_env
    1081             :       LOGICAL, INTENT(IN), OPTIONAL                      :: calculate_forces, just_energy, &
    1082             :                                                             print_active
    1083             : 
    1084             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'qs_ks_update_qs_env'
    1085             : 
    1086             :       INTEGER                                            :: handle, unit_nr
    1087             :       LOGICAL                                            :: c_forces, do_rebuild, energy_only, &
    1088             :                                                             forces_up_to_date, potential_changed, &
    1089             :                                                             rho_changed, s_mstruct_changed
    1090             :       TYPE(qs_ks_env_type), POINTER                      :: ks_env
    1091             : 
    1092      182673 :       NULLIFY (ks_env)
    1093      182673 :       unit_nr = cp_logger_get_default_io_unit()
    1094             : 
    1095      182673 :       c_forces = .FALSE.
    1096      182673 :       energy_only = .FALSE.
    1097      182673 :       IF (PRESENT(just_energy)) energy_only = just_energy
    1098      182673 :       IF (PRESENT(calculate_forces)) c_forces = calculate_forces
    1099             : 
    1100      182673 :       IF (c_forces) THEN
    1101        9531 :          CALL timeset(routineN//'_forces', handle)
    1102             :       ELSE
    1103      173142 :          CALL timeset(routineN, handle)
    1104             :       END IF
    1105             : 
    1106      182673 :       CPASSERT(ASSOCIATED(qs_env))
    1107             : 
    1108             :       CALL get_qs_env(qs_env, &
    1109             :                       ks_env=ks_env, &
    1110             :                       rho_changed=rho_changed, &
    1111             :                       s_mstruct_changed=s_mstruct_changed, &
    1112             :                       potential_changed=potential_changed, &
    1113      182673 :                       forces_up_to_date=forces_up_to_date)
    1114             : 
    1115      182673 :       do_rebuild = .FALSE.
    1116      182673 :       do_rebuild = do_rebuild .OR. rho_changed
    1117        7696 :       do_rebuild = do_rebuild .OR. s_mstruct_changed
    1118        7688 :       do_rebuild = do_rebuild .OR. potential_changed
    1119        7688 :       do_rebuild = do_rebuild .OR. (c_forces .AND. .NOT. forces_up_to_date)
    1120             : 
    1121             :       IF (do_rebuild) THEN
    1122      175347 :          CALL evaluate_core_matrix_traces(qs_env)
    1123             : 
    1124             :          ! the ks matrix will be rebuilt so this is fine now
    1125      175347 :          CALL set_ks_env(ks_env, potential_changed=.FALSE.)
    1126             : 
    1127             :          CALL rebuild_ks_matrix(qs_env, &
    1128             :                                 calculate_forces=c_forces, &
    1129             :                                 just_energy=energy_only, &
    1130      175347 :                                 print_active=print_active)
    1131             : 
    1132      175347 :          IF (.NOT. energy_only) THEN
    1133             :             CALL set_ks_env(ks_env, &
    1134             :                             rho_changed=.FALSE., &
    1135             :                             s_mstruct_changed=.FALSE., &
    1136      319713 :                             forces_up_to_date=forces_up_to_date .OR. c_forces)
    1137             :          END IF
    1138             :       END IF
    1139             : 
    1140      182673 :       CALL timestop(handle)
    1141             : 
    1142      182673 :    END SUBROUTINE qs_ks_update_qs_env
    1143             : 
    1144             : ! **************************************************************************************************
    1145             : !> \brief Calculates the traces of the core matrices and the density matrix.
    1146             : !> \param qs_env ...
    1147             : !> \author Ole Schuett
    1148             : ! **************************************************************************************************
    1149      175347 :    SUBROUTINE evaluate_core_matrix_traces(qs_env)
    1150             :       TYPE(qs_environment_type), POINTER                 :: qs_env
    1151             : 
    1152             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'evaluate_core_matrix_traces'
    1153             : 
    1154             :       INTEGER                                            :: handle
    1155             :       REAL(KIND=dp)                                      :: energy_core_im
    1156      175347 :       TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER       :: matrixkp_h, matrixkp_t, rho_ao_kp
    1157             :       TYPE(dft_control_type), POINTER                    :: dft_control
    1158             :       TYPE(qs_energy_type), POINTER                      :: energy
    1159             :       TYPE(qs_rho_type), POINTER                         :: rho
    1160             : 
    1161      175347 :       CALL timeset(routineN, handle)
    1162      175347 :       NULLIFY (energy, rho, dft_control, rho_ao_kp, matrixkp_t, matrixkp_h)
    1163             : 
    1164             :       CALL get_qs_env(qs_env, &
    1165             :                       rho=rho, &
    1166             :                       energy=energy, &
    1167             :                       dft_control=dft_control, &
    1168             :                       kinetic_kp=matrixkp_t, &
    1169      175347 :                       matrix_h_kp=matrixkp_h)
    1170             : 
    1171      175347 :       CALL qs_rho_get(rho, rho_ao_kp=rho_ao_kp)
    1172             : 
    1173      175347 :       CALL calculate_ptrace(matrixkp_h, rho_ao_kp, energy%core, dft_control%nspins)
    1174             : 
    1175             :       ! Add the imaginary part in the RTP case
    1176      175347 :       IF (qs_env%run_rtp) THEN
    1177        3178 :          IF (dft_control%rtp_control%velocity_gauge) THEN
    1178         150 :             CALL get_qs_env(qs_env, matrix_h_im_kp=matrixkp_h)
    1179         150 :             CALL qs_rho_get(rho, rho_ao_im_kp=rho_ao_kp)
    1180         150 :             CALL calculate_ptrace(matrixkp_h, rho_ao_kp, energy_core_im, dft_control%nspins)
    1181         150 :             energy%core = energy%core - energy_core_im
    1182             :          END IF
    1183             :       END IF
    1184             : 
    1185             :       ! kinetic energy
    1186      175347 :       IF (ASSOCIATED(matrixkp_t)) &
    1187       97889 :          CALL calculate_ptrace(matrixkp_t, rho_ao_kp, energy%kinetic, dft_control%nspins)
    1188             : 
    1189      175347 :       CALL timestop(handle)
    1190      175347 :    END SUBROUTINE evaluate_core_matrix_traces
    1191             : 
    1192             : ! **************************************************************************************************
    1193             : !> \brief Constructs a new Khon-Sham matrix
    1194             : !> \param qs_env ...
    1195             : !> \param calculate_forces ...
    1196             : !> \param just_energy ...
    1197             : !> \param print_active ...
    1198             : !> \author Ole Schuett
    1199             : ! **************************************************************************************************
    1200      175347 :    SUBROUTINE rebuild_ks_matrix(qs_env, calculate_forces, just_energy, print_active)
    1201             :       TYPE(qs_environment_type), POINTER                 :: qs_env
    1202             :       LOGICAL, INTENT(IN)                                :: calculate_forces, just_energy
    1203             :       LOGICAL, INTENT(IN), OPTIONAL                      :: print_active
    1204             : 
    1205             :       CHARACTER(LEN=*), PARAMETER                        :: routineN = 'rebuild_ks_matrix'
    1206             : 
    1207             :       INTEGER                                            :: handle
    1208             :       TYPE(dft_control_type), POINTER                    :: dft_control
    1209             : 
    1210      175347 :       CALL timeset(routineN, handle)
    1211      175347 :       NULLIFY (dft_control)
    1212             : 
    1213      175347 :       CALL get_qs_env(qs_env, dft_control=dft_control)
    1214             : 
    1215      175347 :       IF (dft_control%qs_control%semi_empirical) THEN
    1216             :          CALL build_se_fock_matrix(qs_env, &
    1217             :                                    calculate_forces=calculate_forces, &
    1218       39188 :                                    just_energy=just_energy)
    1219             : 
    1220      136159 :       ELSEIF (dft_control%qs_control%dftb) THEN
    1221             :          CALL build_dftb_ks_matrix(qs_env, &
    1222             :                                    calculate_forces=calculate_forces, &
    1223       13050 :                                    just_energy=just_energy)
    1224             : 
    1225      123109 :       ELSEIF (dft_control%qs_control%xtb) THEN
    1226             :          CALL build_xtb_ks_matrix(qs_env, &
    1227             :                                   calculate_forces=calculate_forces, &
    1228       25220 :                                   just_energy=just_energy)
    1229             : 
    1230             :       ELSE
    1231             :          CALL qs_ks_build_kohn_sham_matrix(qs_env, &
    1232             :                                            calculate_forces=calculate_forces, &
    1233             :                                            just_energy=just_energy, &
    1234       97889 :                                            print_active=print_active)
    1235             :       END IF
    1236             : 
    1237      175347 :       CALL timestop(handle)
    1238             : 
    1239      175347 :    END SUBROUTINE rebuild_ks_matrix
    1240             : 
    1241             : ! **************************************************************************************************
    1242             : !> \brief Allocate ks_matrix if necessary, take current overlap matrix as template
    1243             : !> \param qs_env ...
    1244             : !> \param is_complex ...
    1245             : !> \par History
    1246             : !>    refactoring 04.03.2011 [MI]
    1247             : !> \author
    1248             : ! **************************************************************************************************
    1249             : 
    1250       21052 :    SUBROUTINE qs_ks_allocate_basics(qs_env, is_complex)
    1251             :       TYPE(qs_environment_type), POINTER                 :: qs_env
    1252             :       LOGICAL, INTENT(in)                                :: is_complex
    1253             : 
    1254             :       CHARACTER(LEN=default_string_length)               :: headline
    1255             :       INTEGER                                            :: ic, ispin, nimages, nspins
    1256             :       LOGICAL                                            :: do_kpoints
    1257       21052 :       TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER       :: matrix_s_kp, matrixkp_im_ks, matrixkp_ks
    1258             :       TYPE(dbcsr_type), POINTER                          :: refmatrix
    1259             :       TYPE(dft_control_type), POINTER                    :: dft_control
    1260             :       TYPE(kpoint_type), POINTER                         :: kpoints
    1261             :       TYPE(neighbor_list_set_p_type), DIMENSION(:), &
    1262       21052 :          POINTER                                         :: sab_orb
    1263             :       TYPE(qs_ks_env_type), POINTER                      :: ks_env
    1264             : 
    1265       21052 :       NULLIFY (dft_control, ks_env, matrix_s_kp, sab_orb, matrixkp_ks, refmatrix, matrixkp_im_ks, kpoints)
    1266             : 
    1267             :       CALL get_qs_env(qs_env, &
    1268             :                       dft_control=dft_control, &
    1269             :                       matrix_s_kp=matrix_s_kp, &
    1270             :                       ks_env=ks_env, &
    1271             :                       kpoints=kpoints, &
    1272             :                       do_kpoints=do_kpoints, &
    1273             :                       matrix_ks_kp=matrixkp_ks, &
    1274       21052 :                       matrix_ks_im_kp=matrixkp_im_ks)
    1275             : 
    1276       21052 :       IF (do_kpoints) THEN
    1277         912 :          CALL get_kpoint_info(kpoints, sab_nl=sab_orb)
    1278             :       ELSE
    1279       20140 :          CALL get_qs_env(qs_env, sab_orb=sab_orb)
    1280             :       END IF
    1281             : 
    1282       21052 :       nspins = dft_control%nspins
    1283       21052 :       nimages = dft_control%nimages
    1284             : 
    1285       21052 :       IF (.NOT. ASSOCIATED(matrixkp_ks)) THEN
    1286       21012 :          CALL dbcsr_allocate_matrix_set(matrixkp_ks, nspins, nimages)
    1287       21012 :          refmatrix => matrix_s_kp(1, 1)%matrix
    1288       44746 :          DO ispin = 1, nspins
    1289      164924 :             DO ic = 1, nimages
    1290      120178 :                IF (nspins > 1) THEN
    1291       25156 :                   IF (ispin == 1) THEN
    1292       12578 :                      headline = "KOHN-SHAM MATRIX FOR ALPHA SPIN"
    1293             :                   ELSE
    1294       12578 :                      headline = "KOHN-SHAM MATRIX FOR BETA SPIN"
    1295             :                   END IF
    1296             :                ELSE
    1297       95022 :                   headline = "KOHN-SHAM MATRIX"
    1298             :                END IF
    1299      120178 :                ALLOCATE (matrixkp_ks(ispin, ic)%matrix)
    1300             :                CALL dbcsr_create(matrix=matrixkp_ks(ispin, ic)%matrix, template=refmatrix, &
    1301      120178 :                                  name=TRIM(headline), matrix_type=dbcsr_type_symmetric, nze=0)
    1302      120178 :                CALL cp_dbcsr_alloc_block_from_nbl(matrixkp_ks(ispin, ic)%matrix, sab_orb)
    1303      143912 :                CALL dbcsr_set(matrixkp_ks(ispin, ic)%matrix, 0.0_dp)
    1304             :             END DO
    1305             :          END DO
    1306       21012 :          CALL set_ks_env(ks_env, matrix_ks_kp=matrixkp_ks)
    1307             :       END IF
    1308             : 
    1309       21052 :       IF (is_complex) THEN
    1310         138 :          IF (.NOT. ASSOCIATED(matrixkp_im_ks)) THEN
    1311         138 :             CPASSERT(nspins .EQ. SIZE(matrixkp_ks, 1))
    1312         138 :             CPASSERT(nimages .EQ. SIZE(matrixkp_ks, 2))
    1313         138 :             CALL dbcsr_allocate_matrix_set(matrixkp_im_ks, nspins, nimages)
    1314         288 :             DO ispin = 1, nspins
    1315         438 :                DO ic = 1, nimages
    1316         150 :                   IF (nspins > 1) THEN
    1317          24 :                      IF (ispin == 1) THEN
    1318          12 :                         headline = "IMAGINARY KOHN-SHAM MATRIX FOR ALPHA SPIN"
    1319             :                      ELSE
    1320          12 :                         headline = "IMAGINARY KOHN-SHAM MATRIX FOR BETA SPIN"
    1321             :                      END IF
    1322             :                   ELSE
    1323         126 :                      headline = "IMAGINARY KOHN-SHAM MATRIX"
    1324             :                   END IF
    1325         150 :                   ALLOCATE (matrixkp_im_ks(ispin, ic)%matrix)
    1326         150 :                   refmatrix => matrixkp_ks(ispin, ic)%matrix  ! base on real part, but anti-symmetric
    1327             :                   CALL dbcsr_create(matrix=matrixkp_im_ks(ispin, ic)%matrix, template=refmatrix, &
    1328         150 :                                     name=TRIM(headline), matrix_type=dbcsr_type_antisymmetric, nze=0)
    1329         150 :                   CALL cp_dbcsr_alloc_block_from_nbl(matrixkp_im_ks(ispin, ic)%matrix, sab_orb)
    1330         300 :                   CALL dbcsr_set(matrixkp_im_ks(ispin, ic)%matrix, 0.0_dp)
    1331             :                END DO
    1332             :             END DO
    1333         138 :             CALL set_ks_env(ks_env, matrix_ks_im_kp=matrixkp_im_ks)
    1334             :          END IF
    1335             :       END IF
    1336             : 
    1337       21052 :    END SUBROUTINE qs_ks_allocate_basics
    1338             : 
    1339             : END MODULE qs_ks_methods

Generated by: LCOV version 1.15