LCOV - code coverage report
Current view: top level - src - qs_environment.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:cb5d5fc) Lines: 93.9 % 918 862
Test Date: 2026-04-24 07:01:27 Functions: 100.0 % 3 3

            Line data    Source code
       1              : !--------------------------------------------------------------------------------------------------!
       2              : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3              : !   Copyright 2000-2026 CP2K developers group <https://cp2k.org>                                   !
       4              : !                                                                                                  !
       5              : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6              : !--------------------------------------------------------------------------------------------------!
       7              : 
       8              : ! **************************************************************************************************
       9              : !> \par History
      10              : !>      - Merged with the Quickstep MODULE method_specification (17.01.2002,MK)
      11              : !>      - USE statements cleaned, added
      12              : !>        (25.09.2002,MK)
      13              : !>      - Added more LSD structure (01.2003,Joost VandeVondele)
      14              : !>      - New molecule data types introduced (Sep. 2003,MK)
      15              : !>      - Cleaning; getting rid of pnode (02.10.2003,MK)
      16              : !>      - Sub-system setup added (08.10.2003,MK)
      17              : !> \author MK (18.05.2000)
      18              : ! **************************************************************************************************
      19              : MODULE qs_environment
      20              :    USE almo_scf_env_methods,            ONLY: almo_scf_env_create
      21              :    USE atom_kind_orbitals,              ONLY: calculate_atomic_relkin
      22              :    USE atomic_kind_types,               ONLY: atomic_kind_type
      23              :    USE auto_basis,                      ONLY: create_lri_aux_basis_set,&
      24              :                                               create_ri_aux_basis_set
      25              :    USE basis_set_container_types,       ONLY: add_basis_set_to_container
      26              :    USE basis_set_types,                 ONLY: basis_sort_zet,&
      27              :                                               create_primitive_basis_set,&
      28              :                                               deallocate_gto_basis_set,&
      29              :                                               gto_basis_set_type
      30              :    USE bibliography,                    ONLY: Iannuzzi2006,&
      31              :                                               Iannuzzi2007,&
      32              :                                               cite_reference,&
      33              :                                               cp2kqs2020
      34              :    USE cell_types,                      ONLY: cell_type
      35              :    USE cp_blacs_env,                    ONLY: cp_blacs_env_create,&
      36              :                                               cp_blacs_env_release,&
      37              :                                               cp_blacs_env_type
      38              :    USE cp_control_types,                ONLY: dft_control_type,&
      39              :                                               dftb_control_type,&
      40              :                                               gapw_control_type,&
      41              :                                               qs_control_type,&
      42              :                                               semi_empirical_control_type,&
      43              :                                               xtb_control_type
      44              :    USE cp_control_utils,                ONLY: &
      45              :         read_ddapc_section, read_dft_control, read_mgrid_section, read_qs_section, &
      46              :         read_rixs_control, read_tddfpt2_control, write_admm_control, write_dft_control, &
      47              :         write_qs_control
      48              :    USE cp_ddapc_types,                  ONLY: cp_ddapc_ewald_create
      49              :    USE cp_log_handling,                 ONLY: cp_get_default_logger,&
      50              :                                               cp_logger_get_default_io_unit,&
      51              :                                               cp_logger_type,&
      52              :                                               cp_to_string
      53              :    USE cp_output_handling,              ONLY: cp_p_file,&
      54              :                                               cp_print_key_finished_output,&
      55              :                                               cp_print_key_should_output,&
      56              :                                               cp_print_key_unit_nr
      57              :    USE cp_subsys_types,                 ONLY: cp_subsys_type
      58              :    USE cp_symmetry,                     ONLY: write_symmetry
      59              :    USE distribution_1d_types,           ONLY: distribution_1d_release,&
      60              :                                               distribution_1d_type
      61              :    USE distribution_methods,            ONLY: distribute_molecules_1d
      62              :    USE ec_env_types,                    ONLY: energy_correction_type
      63              :    USE ec_environment,                  ONLY: ec_env_create,&
      64              :                                               ec_write_input
      65              :    USE et_coupling_types,               ONLY: et_coupling_create
      66              :    USE ewald_environment_types,         ONLY: ewald_env_create,&
      67              :                                               ewald_env_get,&
      68              :                                               ewald_env_set,&
      69              :                                               ewald_environment_type,&
      70              :                                               read_ewald_section,&
      71              :                                               read_ewald_section_tb
      72              :    USE ewald_pw_methods,                ONLY: ewald_pw_grid_update
      73              :    USE ewald_pw_types,                  ONLY: ewald_pw_create,&
      74              :                                               ewald_pw_type
      75              :    USE exstates_types,                  ONLY: excited_energy_type,&
      76              :                                               exstate_create
      77              :    USE external_potential_types,        ONLY: get_potential,&
      78              :                                               init_potential,&
      79              :                                               set_potential
      80              :    USE fist_nonbond_env_types,          ONLY: fist_nonbond_env_create,&
      81              :                                               fist_nonbond_env_type
      82              :    USE gamma,                           ONLY: init_md_ftable
      83              :    USE global_types,                    ONLY: global_environment_type
      84              :    USE hartree_local_methods,           ONLY: init_coulomb_local
      85              :    USE header,                          ONLY: dftb_header,&
      86              :                                               qs_header,&
      87              :                                               se_header,&
      88              :                                               tblite_header,&
      89              :                                               xtb_header
      90              :    USE hfx_types,                       ONLY: compare_hfx_sections,&
      91              :                                               hfx_create
      92              :    USE input_constants,                 ONLY: &
      93              :         dispersion_d2, dispersion_d3, dispersion_d3bj, do_et_ddapc, do_method_am1, do_method_dftb, &
      94              :         do_method_gapw, do_method_gapw_xc, do_method_gpw, do_method_lrigpw, do_method_mndo, &
      95              :         do_method_mndod, do_method_ofgpw, do_method_pdg, do_method_pm3, do_method_pm6, &
      96              :         do_method_pm6fm, do_method_pnnl, do_method_rigpw, do_method_rm1, do_method_xtb, &
      97              :         do_qmmm_gauss, do_qmmm_swave, general_roks, hden_atomic, kg_tnadd_embed_ri, rel_none, &
      98              :         rel_trans_atom, smear_fermi_dirac, vdw_pairpot_dftd2, vdw_pairpot_dftd3, &
      99              :         vdw_pairpot_dftd3bj, vdw_pairpot_dftd4, wfi_gext_proj_nr, wfi_gext_proj_qtr_nr, &
     100              :         wfi_linear_ps_method_nr, wfi_linear_wf_method_nr, wfi_use_prev_wf_method_nr, &
     101              :         xc_vdw_fun_none, xc_vdw_fun_nonloc, xc_vdw_fun_pairpot, xtb_vdw_type_d3, xtb_vdw_type_d4, &
     102              :         xtb_vdw_type_none
     103              :    USE input_section_types,             ONLY: section_get_ivals,&
     104              :                                               section_vals_get,&
     105              :                                               section_vals_get_subs_vals,&
     106              :                                               section_vals_type,&
     107              :                                               section_vals_val_get
     108              :    USE kg_environment,                  ONLY: kg_env_create
     109              :    USE kinds,                           ONLY: default_string_length,&
     110              :                                               dp
     111              :    USE kpoint_methods,                  ONLY: kpoint_env_initialize,&
     112              :                                               kpoint_initialize,&
     113              :                                               kpoint_initialize_mos
     114              :    USE kpoint_types,                    ONLY: get_kpoint_info,&
     115              :                                               kpoint_create,&
     116              :                                               kpoint_type,&
     117              :                                               read_kpoint_section,&
     118              :                                               write_kpoint_info
     119              :    USE lri_environment_init,            ONLY: lri_env_basis,&
     120              :                                               lri_env_init
     121              :    USE lri_environment_types,           ONLY: lri_environment_type
     122              :    USE machine,                         ONLY: m_flush
     123              :    USE mathconstants,                   ONLY: pi
     124              :    USE message_passing,                 ONLY: mp_para_env_type
     125              :    USE molecule_kind_types,             ONLY: molecule_kind_type,&
     126              :                                               write_molecule_kind_set
     127              :    USE molecule_types,                  ONLY: molecule_type
     128              :    USE mp2_setup,                       ONLY: read_mp2_section
     129              :    USE mp2_types,                       ONLY: mp2_env_create,&
     130              :                                               mp2_type
     131              :    USE multipole_types,                 ONLY: do_multipole_none
     132              :    USE orbital_pointers,                ONLY: init_orbital_pointers
     133              :    USE orbital_transformation_matrices, ONLY: init_spherical_harmonics
     134              :    USE particle_methods,                ONLY: write_particle_distances,&
     135              :                                               write_qs_particle_coordinates,&
     136              :                                               write_structure_data
     137              :    USE particle_types,                  ONLY: particle_type
     138              :    USE physcon,                         ONLY: kelvin
     139              :    USE pw_env_types,                    ONLY: pw_env_type
     140              :    USE qmmm_types_low,                  ONLY: qmmm_env_qm_type
     141              :    USE qs_basis_rotation_methods,       ONLY: qs_basis_rotation
     142              :    USE qs_dftb_parameters,              ONLY: qs_dftb_param_init
     143              :    USE qs_dftb_types,                   ONLY: qs_dftb_pairpot_type
     144              :    USE qs_dispersion_nonloc,            ONLY: qs_dispersion_nonloc_init
     145              :    USE qs_dispersion_pairpot,           ONLY: qs_dispersion_pairpot_init
     146              :    USE qs_dispersion_types,             ONLY: qs_dispersion_type
     147              :    USE qs_dispersion_utils,             ONLY: qs_dispersion_env_set,&
     148              :                                               qs_write_dispersion
     149              :    USE qs_energy_types,                 ONLY: allocate_qs_energy,&
     150              :                                               qs_energy_type
     151              :    USE qs_environment_methods,          ONLY: qs_env_setup
     152              :    USE qs_environment_types,            ONLY: get_qs_env,&
     153              :                                               qs_environment_type,&
     154              :                                               set_qs_env
     155              :    USE qs_force_types,                  ONLY: qs_force_type
     156              :    USE qs_gcp_types,                    ONLY: qs_gcp_type
     157              :    USE qs_gcp_utils,                    ONLY: qs_gcp_env_set,&
     158              :                                               qs_gcp_init
     159              :    USE qs_harris_types,                 ONLY: harris_rhoin_init,&
     160              :                                               harris_type
     161              :    USE qs_harris_utils,                 ONLY: harris_env_create,&
     162              :                                               harris_write_input
     163              :    USE qs_interactions,                 ONLY: init_interaction_radii,&
     164              :                                               init_se_nlradius,&
     165              :                                               write_core_charge_radii,&
     166              :                                               write_paw_radii,&
     167              :                                               write_pgf_orb_radii,&
     168              :                                               write_ppl_radii,&
     169              :                                               write_ppnl_radii
     170              :    USE qs_kind_types,                   ONLY: &
     171              :         check_qs_kind_set, get_qs_kind, get_qs_kind_set, init_cneo_basis_set, init_gapw_basis_set, &
     172              :         init_gapw_nlcc, init_qs_kind_set, qs_kind_type, set_qs_kind, write_gto_basis_sets, &
     173              :         write_qs_kind_set
     174              :    USE qs_ks_types,                     ONLY: qs_ks_env_create,&
     175              :                                               qs_ks_env_type,&
     176              :                                               set_ks_env
     177              :    USE qs_local_rho_types,              ONLY: local_rho_type
     178              :    USE qs_mo_types,                     ONLY: allocate_mo_set,&
     179              :                                               mo_set_type
     180              :    USE qs_rho0_ggrid,                   ONLY: rho0_s_grid_create
     181              :    USE qs_rho0_methods,                 ONLY: init_rho0
     182              :    USE qs_rho0_types,                   ONLY: rho0_mpole_type
     183              :    USE qs_rho_atom_methods,             ONLY: init_rho_atom
     184              :    USE qs_rho_atom_types,               ONLY: rho_atom_type
     185              :    USE qs_subsys_methods,               ONLY: qs_subsys_create
     186              :    USE qs_subsys_types,                 ONLY: qs_subsys_get,&
     187              :                                               qs_subsys_set,&
     188              :                                               qs_subsys_type
     189              :    USE qs_wf_history_methods,           ONLY: wfi_create,&
     190              :                                               wfi_create_for_kp
     191              :    USE qs_wf_history_types,             ONLY: qs_wf_history_type,&
     192              :                                               wfi_release
     193              :    USE rel_control_types,               ONLY: rel_c_create,&
     194              :                                               rel_c_read_parameters,&
     195              :                                               rel_control_type
     196              :    USE scf_control_types,               ONLY: scf_c_create,&
     197              :                                               scf_c_read_parameters,&
     198              :                                               scf_c_write_parameters,&
     199              :                                               scf_control_type
     200              :    USE semi_empirical_expns3_methods,   ONLY: semi_empirical_expns3_setup
     201              :    USE semi_empirical_int_arrays,       ONLY: init_se_intd_array
     202              :    USE semi_empirical_mpole_methods,    ONLY: nddo_mpole_setup
     203              :    USE semi_empirical_mpole_types,      ONLY: nddo_mpole_type
     204              :    USE semi_empirical_store_int_types,  ONLY: semi_empirical_si_create,&
     205              :                                               semi_empirical_si_type
     206              :    USE semi_empirical_types,            ONLY: se_taper_create,&
     207              :                                               se_taper_type
     208              :    USE semi_empirical_utils,            ONLY: se_cutoff_compatible
     209              :    USE tblite_interface,                ONLY: tb_get_basis,&
     210              :                                               tb_init_geometry,&
     211              :                                               tb_init_wf,&
     212              :                                               tb_set_calculator
     213              :    USE transport,                       ONLY: transport_env_create
     214              :    USE xtb_parameters,                  ONLY: init_xtb_basis,&
     215              :                                               xtb_parameters_init,&
     216              :                                               xtb_parameters_set
     217              :    USE xtb_potentials,                  ONLY: xtb_pp_radius
     218              :    USE xtb_types,                       ONLY: allocate_xtb_atom_param,&
     219              :                                               set_xtb_atom_param
     220              : #include "./base/base_uses.f90"
     221              : 
     222              :    IMPLICIT NONE
     223              : 
     224              :    PRIVATE
     225              : 
     226              :    ! *** Global parameters ***
     227              :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_environment'
     228              : 
     229              :    ! *** Public subroutines ***
     230              :    PUBLIC :: qs_init
     231              : 
     232              : CONTAINS
     233              : 
     234              : ! **************************************************************************************************
     235              : !> \brief Read the input and the database files for the setup of the
     236              : !>      QUICKSTEP environment.
     237              : !> \param qs_env ...
     238              : !> \param para_env ...
     239              : !> \param root_section ...
     240              : !> \param globenv ...
     241              : !> \param cp_subsys ...
     242              : !> \param kpoint_env ...
     243              : !> \param qmmm ...
     244              : !> \param qmmm_env_qm ...
     245              : !> \param force_env_section ...
     246              : !> \param subsys_section ...
     247              : !> \param use_motion_section ...
     248              : !> \param silent ...
     249              : !> \author Creation (22.05.2000,MK)
     250              : ! **************************************************************************************************
     251        54194 :    SUBROUTINE qs_init(qs_env, para_env, root_section, globenv, cp_subsys, kpoint_env, &
     252              :                       qmmm, qmmm_env_qm, force_env_section, subsys_section, &
     253              :                       use_motion_section, silent)
     254              : 
     255              :       TYPE(qs_environment_type), POINTER                 :: qs_env
     256              :       TYPE(mp_para_env_type), POINTER                    :: para_env
     257              :       TYPE(section_vals_type), OPTIONAL, POINTER         :: root_section
     258              :       TYPE(global_environment_type), OPTIONAL, POINTER   :: globenv
     259              :       TYPE(cp_subsys_type), OPTIONAL, POINTER            :: cp_subsys
     260              :       TYPE(kpoint_type), OPTIONAL, POINTER               :: kpoint_env
     261              :       LOGICAL, INTENT(IN), OPTIONAL                      :: qmmm
     262              :       TYPE(qmmm_env_qm_type), OPTIONAL, POINTER          :: qmmm_env_qm
     263              :       TYPE(section_vals_type), POINTER                   :: force_env_section, subsys_section
     264              :       LOGICAL, INTENT(IN)                                :: use_motion_section
     265              :       LOGICAL, INTENT(IN), OPTIONAL                      :: silent
     266              : 
     267              :       CHARACTER(LEN=default_string_length)               :: basis_type
     268              :       INTEGER                                            :: ikind, method_id, nelectron_total, &
     269              :                                                             nkind, nkp_grid(3)
     270              :       LOGICAL :: do_admm_rpa, do_ec_hfx, do_et, do_exx, do_hfx, do_kpoints, is_identical, is_semi, &
     271              :          mp2_present, my_qmmm, qmmm_decoupl, same_except_frac, use_ref_cell
     272         7742 :       REAL(KIND=dp), DIMENSION(:, :), POINTER            :: rtmat
     273         7742 :       TYPE(atomic_kind_type), DIMENSION(:), POINTER      :: atomic_kind_set
     274              :       TYPE(cell_type), POINTER                           :: my_cell, my_cell_ref
     275              :       TYPE(cp_blacs_env_type), POINTER                   :: blacs_env
     276              :       TYPE(dft_control_type), POINTER                    :: dft_control
     277              :       TYPE(distribution_1d_type), POINTER                :: local_particles
     278              :       TYPE(energy_correction_type), POINTER              :: ec_env
     279              :       TYPE(excited_energy_type), POINTER                 :: exstate_env
     280              :       TYPE(harris_type), POINTER                         :: harris_env
     281              :       TYPE(kpoint_type), POINTER                         :: kpoints
     282              :       TYPE(lri_environment_type), POINTER                :: lri_env
     283         7742 :       TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
     284         7742 :       TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
     285              :       TYPE(qs_ks_env_type), POINTER                      :: ks_env
     286              :       TYPE(qs_subsys_type), POINTER                      :: subsys
     287              :       TYPE(qs_wf_history_type), POINTER                  :: wf_history
     288              :       TYPE(rel_control_type), POINTER                    :: rel_control
     289              :       TYPE(scf_control_type), POINTER                    :: scf_control
     290              :       TYPE(section_vals_type), POINTER :: dft_section, ec_hfx_section, ec_section, &
     291              :          et_coupling_section, hfx_section, kpoint_section, mp2_section, rpa_hfx_section, &
     292              :          transport_section
     293              : 
     294         7742 :       NULLIFY (my_cell, my_cell_ref, atomic_kind_set, particle_set, &
     295         7742 :                qs_kind_set, kpoint_section, dft_section, ec_section, &
     296         7742 :                subsys, ks_env, dft_control, blacs_env)
     297              : 
     298         7742 :       CALL set_qs_env(qs_env, input=force_env_section)
     299         7742 :       IF (.NOT. ASSOCIATED(subsys_section)) THEN
     300          108 :          subsys_section => section_vals_get_subs_vals(force_env_section, "SUBSYS")
     301              :       END IF
     302              : 
     303              :       ! QMMM
     304         7742 :       my_qmmm = .FALSE.
     305         7742 :       IF (PRESENT(qmmm)) my_qmmm = qmmm
     306         7742 :       qmmm_decoupl = .FALSE.
     307         7742 :       IF (PRESENT(qmmm_env_qm)) THEN
     308          394 :          IF (qmmm_env_qm%qmmm_coupl_type == do_qmmm_gauss .OR. &
     309              :              qmmm_env_qm%qmmm_coupl_type == do_qmmm_swave) THEN
     310              :             ! For GAUSS/SWAVE methods there could be a DDAPC decoupling requested
     311          458 :             qmmm_decoupl = my_qmmm .AND. qmmm_env_qm%periodic .AND. qmmm_env_qm%multipole
     312              :          END IF
     313          394 :          qs_env%qmmm_env_qm => qmmm_env_qm
     314              :       END IF
     315         7742 :       CALL set_qs_env(qs_env=qs_env, qmmm=my_qmmm)
     316              : 
     317              :       ! Possibly initialize arrays for SE
     318         7742 :       CALL section_vals_val_get(force_env_section, "DFT%QS%METHOD", i_val=method_id)
     319         1000 :       SELECT CASE (method_id)
     320              :       CASE (do_method_rm1, do_method_am1, do_method_mndo, do_method_pdg, &
     321              :             do_method_pm3, do_method_pm6, do_method_pm6fm, do_method_mndod, do_method_pnnl)
     322         1000 :          CALL init_se_intd_array()
     323         1000 :          is_semi = .TRUE.
     324              :       CASE (do_method_xtb, do_method_dftb)
     325         1222 :          is_semi = .TRUE.
     326              :       CASE DEFAULT
     327         7742 :          is_semi = .FALSE.
     328              :       END SELECT
     329              : 
     330        30968 :       ALLOCATE (subsys)
     331              :       CALL qs_subsys_create(subsys, para_env, &
     332              :                             force_env_section=force_env_section, &
     333              :                             subsys_section=subsys_section, &
     334              :                             use_motion_section=use_motion_section, &
     335              :                             root_section=root_section, &
     336              :                             cp_subsys=cp_subsys, &
     337         7742 :                             elkind=is_semi, silent=silent)
     338              : 
     339         7742 :       ALLOCATE (ks_env)
     340         7742 :       CALL qs_ks_env_create(ks_env)
     341         7742 :       CALL set_ks_env(ks_env, subsys=subsys)
     342         7742 :       CALL set_qs_env(qs_env, ks_env=ks_env)
     343              : 
     344              :       CALL qs_subsys_get(subsys, &
     345              :                          cell=my_cell, &
     346              :                          cell_ref=my_cell_ref, &
     347              :                          use_ref_cell=use_ref_cell, &
     348              :                          atomic_kind_set=atomic_kind_set, &
     349              :                          qs_kind_set=qs_kind_set, &
     350         7742 :                          particle_set=particle_set)
     351              : 
     352         7742 :       CALL set_ks_env(ks_env, para_env=para_env)
     353         7742 :       IF (PRESENT(globenv)) THEN
     354              :          CALL cp_blacs_env_create(blacs_env, para_env, globenv%blacs_grid_layout, &
     355         7736 :                                   globenv%blacs_repeatable)
     356              :       ELSE
     357            6 :          CALL cp_blacs_env_create(blacs_env, para_env)
     358              :       END IF
     359         7742 :       CALL set_ks_env(ks_env, blacs_env=blacs_env)
     360         7742 :       CALL cp_blacs_env_release(blacs_env)
     361              : 
     362              :       !   *** Setup the grids for the G-space Interpolation if any
     363              :       CALL cp_ddapc_ewald_create(qs_env%cp_ddapc_ewald, qmmm_decoupl, my_cell, &
     364         7742 :                                  force_env_section, subsys_section, para_env)
     365              : 
     366              :       ! kpoints
     367         7742 :       IF (PRESENT(kpoint_env)) THEN
     368            2 :          kpoints => kpoint_env
     369            2 :          CALL set_qs_env(qs_env=qs_env, kpoints=kpoints)
     370            2 :          CALL kpoint_initialize(kpoints, particle_set, my_cell)
     371              :       ELSE
     372         7740 :          NULLIFY (kpoints)
     373         7740 :          CALL kpoint_create(kpoints)
     374         7740 :          CALL set_qs_env(qs_env=qs_env, kpoints=kpoints)
     375         7740 :          kpoint_section => section_vals_get_subs_vals(qs_env%input, "DFT%KPOINTS")
     376         7740 :          CALL read_kpoint_section(kpoints, kpoint_section, my_cell%hmat)
     377         7740 :          CALL kpoint_initialize(kpoints, particle_set, my_cell)
     378         7740 :          dft_section => section_vals_get_subs_vals(qs_env%input, "DFT")
     379         7740 :          CALL write_kpoint_info(kpoints, dft_section=dft_section)
     380              :       END IF
     381              : 
     382              :       CALL qs_init_subsys(qs_env, para_env, subsys, my_cell, my_cell_ref, use_ref_cell, &
     383         7742 :                           subsys_section, silent=silent)
     384              : 
     385         7742 :       CALL get_qs_env(qs_env, dft_control=dft_control)
     386         7742 :       IF (method_id == do_method_lrigpw .OR. dft_control%qs_control%lri_optbas) THEN
     387           46 :          CALL get_qs_env(qs_env=qs_env, lri_env=lri_env)
     388           46 :          CALL lri_env_basis("LRI", qs_env, lri_env, qs_kind_set)
     389         7696 :       ELSE IF (method_id == do_method_rigpw) THEN
     390              :          CALL cp_warn(__LOCATION__, "Experimental code: "// &
     391            2 :                       "RIGPW should only be used for testing.")
     392            2 :          CALL get_qs_env(qs_env=qs_env, lri_env=lri_env)
     393            2 :          CALL lri_env_basis("RI", qs_env, lri_env, qs_kind_set)
     394              :       END IF
     395              : 
     396         7742 :       IF (my_qmmm .AND. PRESENT(qmmm_env_qm) .AND. .NOT. dft_control%qs_control%commensurate_mgrids) THEN
     397          132 :          IF (qmmm_env_qm%qmmm_coupl_type == do_qmmm_gauss .OR. qmmm_env_qm%qmmm_coupl_type == do_qmmm_swave) THEN
     398              :             CALL cp_abort(__LOCATION__, "QM/MM with coupling GAUSS or S-WAVE requires "// &
     399            0 :                           "keyword FORCE_EVAL/DFT/MGRID/COMMENSURATE to be enabled.")
     400              :          END IF
     401              :       END IF
     402              : 
     403              :       ! more kpoint stuff
     404         7742 :       CALL get_qs_env(qs_env=qs_env, do_kpoints=do_kpoints, blacs_env=blacs_env)
     405         7742 :       IF (do_kpoints) THEN
     406          198 :          CALL kpoint_env_initialize(kpoints, para_env, blacs_env, with_aux_fit=dft_control%do_admm)
     407          198 :          CALL kpoint_initialize_mos(kpoints, qs_env%mos)
     408          198 :          CALL get_qs_env(qs_env=qs_env, wf_history=wf_history)
     409          198 :          CALL wfi_create_for_kp(wf_history)
     410              :       END IF
     411              :       ! basis set symmetry rotations
     412         7742 :       IF (do_kpoints) THEN
     413          198 :          CALL qs_basis_rotation(qs_env, kpoints)
     414              :       END IF
     415              : 
     416              :       do_hfx = .FALSE.
     417         7742 :       hfx_section => section_vals_get_subs_vals(qs_env%input, "DFT%XC%HF")
     418         7742 :       CALL section_vals_get(hfx_section, explicit=do_hfx)
     419         7742 :       CALL get_qs_env(qs_env, dft_control=dft_control, scf_control=scf_control, nelectron_total=nelectron_total)
     420         7742 :       IF (do_hfx) THEN
     421              :          ! Retrieve particle_set and atomic_kind_set (needed for both kinds of initialization)
     422         5072 :          nkp_grid = 1
     423         1268 :          IF (do_kpoints) CALL get_kpoint_info(kpoints, nkp_grid=nkp_grid)
     424         1268 :          IF (dft_control%do_admm) THEN
     425          494 :             basis_type = 'AUX_FIT'
     426              :          ELSE
     427          774 :             basis_type = 'ORB'
     428              :          END IF
     429              :          CALL hfx_create(qs_env%x_data, para_env, hfx_section, atomic_kind_set, &
     430              :                          qs_kind_set, particle_set, dft_control, my_cell, orb_basis=basis_type, &
     431         1268 :                          nelectron_total=nelectron_total, nkp_grid=nkp_grid)
     432              :       END IF
     433              : 
     434         7742 :       mp2_section => section_vals_get_subs_vals(qs_env%input, "DFT%XC%WF_CORRELATION")
     435         7742 :       CALL section_vals_get(mp2_section, explicit=mp2_present)
     436         7742 :       IF (mp2_present) THEN
     437          474 :          CPASSERT(ASSOCIATED(qs_env%mp2_env))
     438          474 :          CALL read_mp2_section(qs_env%input, qs_env%mp2_env)
     439              :          ! create the EXX section if necessary
     440              :          do_exx = .FALSE.
     441          474 :          rpa_hfx_section => section_vals_get_subs_vals(qs_env%input, "DFT%XC%WF_CORRELATION%RI_RPA%HF")
     442          474 :          CALL section_vals_get(rpa_hfx_section, explicit=do_exx)
     443          474 :          IF (do_exx) THEN
     444              : 
     445              :             ! do_exx in call of hfx_create decides whether to go without ADMM (do_exx=.TRUE.) or with
     446              :             ! ADMM (do_exx=.FALSE.)
     447          142 :             CALL section_vals_val_get(mp2_section, "RI_RPA%ADMM", l_val=do_admm_rpa)
     448              : 
     449              :             ! Reuse the HFX integrals from the qs_env if applicable
     450          142 :             qs_env%mp2_env%ri_rpa%reuse_hfx = .TRUE.
     451          142 :             IF (.NOT. do_hfx) qs_env%mp2_env%ri_rpa%reuse_hfx = .FALSE.
     452          142 :             CALL compare_hfx_sections(hfx_section, rpa_hfx_section, is_identical, same_except_frac)
     453          142 :             IF (.NOT. (is_identical .OR. same_except_frac)) qs_env%mp2_env%ri_rpa%reuse_hfx = .FALSE.
     454          142 :             IF (dft_control%do_admm .AND. .NOT. do_admm_rpa) qs_env%mp2_env%ri_rpa%reuse_hfx = .FALSE.
     455              : 
     456          142 :             IF (.NOT. qs_env%mp2_env%ri_rpa%reuse_hfx) THEN
     457          124 :                IF (do_admm_rpa) THEN
     458           10 :                   basis_type = 'AUX_FIT'
     459              :                ELSE
     460          114 :                   basis_type = 'ORB'
     461              :                END IF
     462              :                CALL hfx_create(qs_env%mp2_env%ri_rpa%x_data, para_env, rpa_hfx_section, atomic_kind_set, &
     463              :                                qs_kind_set, particle_set, dft_control, my_cell, orb_basis=basis_type, &
     464          124 :                                nelectron_total=nelectron_total)
     465              :             ELSE
     466           18 :                qs_env%mp2_env%ri_rpa%x_data => qs_env%x_data
     467              :             END IF
     468              :          END IF
     469              :       END IF
     470              : 
     471         7742 :       IF (dft_control%qs_control%do_kg) THEN
     472           66 :          CALL cite_reference(Iannuzzi2006)
     473           66 :          CALL kg_env_create(qs_env, qs_env%kg_env, qs_kind_set, qs_env%input)
     474              :       END IF
     475              : 
     476         7742 :       dft_section => section_vals_get_subs_vals(qs_env%input, "DFT")
     477              :       CALL section_vals_val_get(dft_section, "EXCITED_STATES%_SECTION_PARAMETERS_", &
     478         7742 :                                 l_val=qs_env%excited_state)
     479         7742 :       NULLIFY (exstate_env)
     480         7742 :       CALL exstate_create(exstate_env, qs_env%excited_state, dft_section)
     481         7742 :       CALL set_qs_env(qs_env, exstate_env=exstate_env)
     482              : 
     483              :       et_coupling_section => section_vals_get_subs_vals(qs_env%input, &
     484         7742 :                                                         "PROPERTIES%ET_COUPLING")
     485         7742 :       CALL section_vals_get(et_coupling_section, explicit=do_et)
     486         7742 :       IF (do_et) CALL et_coupling_create(qs_env%et_coupling)
     487              : 
     488         7742 :       transport_section => section_vals_get_subs_vals(qs_env%input, "DFT%TRANSPORT")
     489         7742 :       CALL section_vals_get(transport_section, explicit=qs_env%do_transport)
     490         7742 :       IF (qs_env%do_transport) THEN
     491            0 :          CALL transport_env_create(qs_env)
     492              :       END IF
     493              : 
     494         7742 :       CALL get_qs_env(qs_env, harris_env=harris_env)
     495         7742 :       IF (qs_env%harris_method) THEN
     496              :          ! initialize the Harris input density and potential integrals
     497            8 :          CALL get_qs_env(qs_env, local_particles=local_particles)
     498              :          CALL harris_rhoin_init(harris_env%rhoin, "RHOIN", qs_kind_set, atomic_kind_set, &
     499            8 :                                 local_particles, dft_control%nspins)
     500              :          ! Print information of the HARRIS section
     501            8 :          CALL harris_write_input(harris_env)
     502              :       END IF
     503              : 
     504         7742 :       NULLIFY (ec_env)
     505         7742 :       dft_section => section_vals_get_subs_vals(qs_env%input, "DFT")
     506              :       CALL section_vals_val_get(dft_section, "ENERGY_CORRECTION%_SECTION_PARAMETERS_", &
     507         7742 :                                 l_val=qs_env%energy_correction)
     508         7742 :       ec_section => section_vals_get_subs_vals(qs_env%input, "DFT%ENERGY_CORRECTION")
     509         7742 :       CALL ec_env_create(qs_env, ec_env, dft_section, ec_section)
     510         7742 :       CALL set_qs_env(qs_env, ec_env=ec_env)
     511              : 
     512         7742 :       IF (qs_env%energy_correction) THEN
     513              :          ! Energy correction with Hartree-Fock exchange
     514          292 :          ec_hfx_section => section_vals_get_subs_vals(ec_section, "XC%HF")
     515          292 :          CALL section_vals_get(ec_hfx_section, explicit=do_ec_hfx)
     516              : 
     517          292 :          IF (ec_env%do_ec_hfx) THEN
     518              : 
     519              :             ! kpoints and HFX not yet compatible
     520           28 :             IF (ec_env%do_kpoints) THEN
     521              :                CALL cp_abort(__LOCATION__, &
     522              :                              "Energy correction methods with hybrid functionals "// &
     523            0 :                              "and kpoints is not yet available.")
     524              :             END IF
     525              : 
     526              :             ! Hybrid functionals require same basis
     527           28 :             IF (ec_env%basis_inconsistent) THEN
     528              :                CALL cp_abort(__LOCATION__, &
     529              :                              "Energy correction methods with hybrid functionals: "// &
     530              :                              "correction and ground state need to use the same basis. "// &
     531            0 :                              "Checked by comparing basis set names only.")
     532              :             END IF
     533              : 
     534              :             ! Similar to RPA_HFX we can check if HFX integrals from the qs_env can be reused
     535           28 :             IF (ec_env%do_ec_admm .AND. .NOT. dft_control%do_admm) THEN
     536            0 :                CALL cp_abort(__LOCATION__, "Need an ADMM input section for ADMM EC to work")
     537              :             END IF
     538              : 
     539           28 :             ec_env%reuse_hfx = .TRUE.
     540           28 :             IF (.NOT. do_hfx) ec_env%reuse_hfx = .FALSE.
     541           28 :             CALL compare_hfx_sections(hfx_section, ec_hfx_section, is_identical, same_except_frac)
     542           28 :             IF (.NOT. (is_identical .OR. same_except_frac)) ec_env%reuse_hfx = .FALSE.
     543           28 :             IF (dft_control%do_admm .AND. .NOT. ec_env%do_ec_admm) ec_env%reuse_hfx = .FALSE.
     544              : 
     545           28 :             IF (.NOT. ec_env%reuse_hfx) THEN
     546           12 :                IF (ec_env%do_ec_admm) THEN
     547            2 :                   basis_type = 'AUX_FIT'
     548              :                ELSE
     549           10 :                   basis_type = 'ORB'
     550              :                END IF
     551              :                CALL hfx_create(ec_env%x_data, para_env, ec_hfx_section, atomic_kind_set, &
     552              :                                qs_kind_set, particle_set, dft_control, my_cell, orb_basis=basis_type, &
     553           12 :                                nelectron_total=nelectron_total)
     554              :             ELSE
     555           16 :                ec_env%x_data => qs_env%x_data
     556              :             END IF
     557              :          END IF
     558              : 
     559              :          ! Print information of the EC section
     560          292 :          CALL ec_write_input(ec_env)
     561              : 
     562              :       END IF
     563              : 
     564         7742 :       IF (dft_control%qs_control%do_almo_scf) THEN
     565           66 :          CALL almo_scf_env_create(qs_env)
     566              :       END IF
     567              : 
     568              :       ! see if we have atomic relativistic corrections
     569         7742 :       CALL get_qs_env(qs_env, rel_control=rel_control)
     570         7742 :       IF (rel_control%rel_method /= rel_none) THEN
     571           16 :          IF (rel_control%rel_transformation == rel_trans_atom) THEN
     572           16 :             nkind = SIZE(atomic_kind_set)
     573           42 :             DO ikind = 1, nkind
     574           26 :                NULLIFY (rtmat)
     575           26 :                CALL calculate_atomic_relkin(atomic_kind_set(ikind), qs_kind_set(ikind), rel_control, rtmat)
     576           42 :                IF (ASSOCIATED(rtmat)) CALL set_qs_kind(qs_kind_set(ikind), reltmat=rtmat)
     577              :             END DO
     578              :          END IF
     579              :       END IF
     580              : 
     581         7742 :    END SUBROUTINE qs_init
     582              : 
     583              : ! **************************************************************************************************
     584              : !> \brief Initialize the qs environment (subsys)
     585              : !> \param qs_env ...
     586              : !> \param para_env ...
     587              : !> \param subsys ...
     588              : !> \param cell ...
     589              : !> \param cell_ref ...
     590              : !> \param use_ref_cell ...
     591              : !> \param subsys_section ...
     592              : !> \param silent ...
     593              : !> \author Creation (22.05.2000,MK)
     594              : ! **************************************************************************************************
     595         7742 :    SUBROUTINE qs_init_subsys(qs_env, para_env, subsys, cell, cell_ref, use_ref_cell, subsys_section, &
     596              :                              silent)
     597              : 
     598              :       TYPE(qs_environment_type), POINTER                 :: qs_env
     599              :       TYPE(mp_para_env_type), POINTER                    :: para_env
     600              :       TYPE(qs_subsys_type), POINTER                      :: subsys
     601              :       TYPE(cell_type), POINTER                           :: cell, cell_ref
     602              :       LOGICAL, INTENT(in)                                :: use_ref_cell
     603              :       TYPE(section_vals_type), POINTER                   :: subsys_section
     604              :       LOGICAL, INTENT(in), OPTIONAL                      :: silent
     605              : 
     606              :       CHARACTER(len=*), PARAMETER                        :: routineN = 'qs_init_subsys'
     607              : 
     608              :       CHARACTER(len=2)                                   :: element_symbol
     609              :       INTEGER :: gfn_type, handle, ikind, ispin, iw, lmax_sphere, maxl, maxlgto, maxlgto_lri, &
     610              :          maxlgto_nuc, maxlppl, maxlppnl, method_id, multiplicity, my_ival, n_ao, n_mo_add, natom, &
     611              :          nelectron, ngauss, nkind, output_unit, sort_basis, tnadd_method
     612              :       INTEGER, DIMENSION(2)                              :: n_mo, nelectron_spin
     613              :       INTEGER, DIMENSION(5)                              :: occ
     614         7742 :       INTEGER, DIMENSION(:), POINTER                     :: mo_index_range
     615              :       LOGICAL :: all_potential_present, be_silent, cneo_potential_present, do_kpoints, do_ri_hfx, &
     616              :          do_ri_mp2, do_ri_rpa, do_ri_sos_mp2, do_rpa_ri_exx, do_wfc_im_time, e1terms, &
     617              :          has_unit_metric, lribas, mp2_present, orb_gradient, paw_atom
     618              :       REAL(KIND=dp)                                      :: alpha, ccore, ewald_rcut, fxx, maxocc, &
     619              :                                                             rc, rcut, total_zeff_corr, &
     620              :                                                             verlet_skin, zeff_correction
     621         7742 :       TYPE(atomic_kind_type), DIMENSION(:), POINTER      :: atomic_kind_set
     622              :       TYPE(cp_logger_type), POINTER                      :: logger
     623              :       TYPE(dft_control_type), POINTER                    :: dft_control
     624              :       TYPE(dftb_control_type), POINTER                   :: dftb_control
     625              :       TYPE(distribution_1d_type), POINTER                :: local_molecules, local_particles
     626              :       TYPE(ewald_environment_type), POINTER              :: ewald_env
     627              :       TYPE(ewald_pw_type), POINTER                       :: ewald_pw
     628              :       TYPE(fist_nonbond_env_type), POINTER               :: se_nonbond_env
     629              :       TYPE(gapw_control_type), POINTER                   :: gapw_control
     630              :       TYPE(gto_basis_set_type), POINTER                  :: aux_fit_basis, lri_aux_basis, &
     631              :                                                             rhoin_basis, ri_aux_basis_set, &
     632              :                                                             ri_hfx_basis, ri_xas_basis, &
     633              :                                                             tmp_basis_set
     634              :       TYPE(harris_type), POINTER                         :: harris_env
     635              :       TYPE(local_rho_type), POINTER                      :: local_rho_set
     636              :       TYPE(lri_environment_type), POINTER                :: lri_env
     637         7742 :       TYPE(mo_set_type), DIMENSION(:), POINTER           :: mos, mos_last_converged
     638         7742 :       TYPE(molecule_kind_type), DIMENSION(:), POINTER    :: molecule_kind_set
     639         7742 :       TYPE(molecule_type), DIMENSION(:), POINTER         :: molecule_set
     640              :       TYPE(mp2_type), POINTER                            :: mp2_env
     641              :       TYPE(nddo_mpole_type), POINTER                     :: se_nddo_mpole
     642         7742 :       TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
     643              :       TYPE(pw_env_type), POINTER                         :: pw_env
     644              :       TYPE(qs_control_type), POINTER                     :: qs_control
     645              :       TYPE(qs_dftb_pairpot_type), DIMENSION(:, :), &
     646         7742 :          POINTER                                         :: dftb_potential
     647              :       TYPE(qs_dispersion_type), POINTER                  :: dispersion_env
     648              :       TYPE(qs_energy_type), POINTER                      :: energy
     649         7742 :       TYPE(qs_force_type), DIMENSION(:), POINTER         :: force
     650              :       TYPE(qs_gcp_type), POINTER                         :: gcp_env
     651         7742 :       TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
     652              :       TYPE(qs_kind_type), POINTER                        :: qs_kind
     653              :       TYPE(qs_ks_env_type), POINTER                      :: ks_env
     654              :       TYPE(qs_wf_history_type), POINTER                  :: wf_history
     655              :       TYPE(rho0_mpole_type), POINTER                     :: rho0_mpole
     656         7742 :       TYPE(rho_atom_type), DIMENSION(:), POINTER         :: rho_atom_set
     657              :       TYPE(scf_control_type), POINTER                    :: scf_control
     658              :       TYPE(se_taper_type), POINTER                       :: se_taper
     659              :       TYPE(section_vals_type), POINTER :: dft_section, et_coupling_section, et_ddapc_section, &
     660              :          ewald_section, harris_section, lri_section, mp2_section, nl_section, poisson_section, &
     661              :          pp_section, print_section, qs_section, rixs_section, se_section, tddfpt_section, &
     662              :          xc_section
     663              :       TYPE(semi_empirical_control_type), POINTER         :: se_control
     664              :       TYPE(semi_empirical_si_type), POINTER              :: se_store_int_env
     665              :       TYPE(xtb_control_type), POINTER                    :: xtb_control
     666              : 
     667         7742 :       CALL timeset(routineN, handle)
     668         7742 :       NULLIFY (logger)
     669         7742 :       logger => cp_get_default_logger()
     670         7742 :       output_unit = cp_logger_get_default_io_unit(logger)
     671              : 
     672         7742 :       be_silent = .FALSE.
     673         7742 :       IF (PRESENT(silent)) be_silent = silent
     674              : 
     675         7742 :       CALL cite_reference(cp2kqs2020)
     676              : 
     677              :       ! Initialise the Quickstep environment
     678         7742 :       NULLIFY (mos, se_taper)
     679         7742 :       NULLIFY (dft_control)
     680         7742 :       NULLIFY (energy)
     681         7742 :       NULLIFY (force)
     682         7742 :       NULLIFY (local_molecules)
     683         7742 :       NULLIFY (local_particles)
     684         7742 :       NULLIFY (scf_control)
     685         7742 :       NULLIFY (dft_section)
     686         7742 :       NULLIFY (et_coupling_section)
     687         7742 :       NULLIFY (ks_env)
     688         7742 :       NULLIFY (mos_last_converged)
     689         7742 :       dft_section => section_vals_get_subs_vals(qs_env%input, "DFT")
     690         7742 :       qs_section => section_vals_get_subs_vals(dft_section, "QS")
     691         7742 :       et_coupling_section => section_vals_get_subs_vals(qs_env%input, "PROPERTIES%ET_COUPLING")
     692              :       ! reimplemented TDDFPT
     693         7742 :       tddfpt_section => section_vals_get_subs_vals(qs_env%input, "PROPERTIES%TDDFPT")
     694         7742 :       rixs_section => section_vals_get_subs_vals(qs_env%input, "PROPERTIES%RIXS")
     695              : 
     696              :       CALL qs_subsys_get(subsys, particle_set=particle_set, &
     697              :                          qs_kind_set=qs_kind_set, &
     698              :                          atomic_kind_set=atomic_kind_set, &
     699              :                          molecule_set=molecule_set, &
     700         7742 :                          molecule_kind_set=molecule_kind_set)
     701              : 
     702              :       ! Read the input section with the DFT control parameters
     703         7742 :       CALL read_dft_control(dft_control, dft_section)
     704              : 
     705              :       ! Set periodicity flag
     706        30968 :       dft_control%qs_control%periodicity = SUM(cell%perd)
     707              : 
     708              :       ! Read the input section with the Quickstep control parameters
     709         7742 :       CALL read_qs_section(dft_control%qs_control, qs_section)
     710              : 
     711              :       ! Print the Quickstep program banner (copyright and version number)
     712         7742 :       IF (.NOT. be_silent) THEN
     713         7736 :          iw = cp_print_key_unit_nr(logger, dft_section, "PRINT%PROGRAM_BANNER", extension=".Log")
     714         7736 :          CALL section_vals_val_get(qs_section, "METHOD", i_val=method_id)
     715         5518 :          SELECT CASE (method_id)
     716              :          CASE DEFAULT
     717         5518 :             CALL qs_header(iw)
     718              :          CASE (do_method_rm1, do_method_am1, do_method_mndo, do_method_pdg, &
     719              :                do_method_pm3, do_method_pm6, do_method_pm6fm, do_method_mndod, do_method_pnnl)
     720         1000 :             CALL se_header(iw)
     721              :          CASE (do_method_dftb)
     722          222 :             CALL dftb_header(iw)
     723              :          CASE (do_method_xtb)
     724         7736 :             IF (dft_control%qs_control%xtb_control%do_tblite) THEN
     725           50 :                CALL tblite_header(iw, dft_control%qs_control%xtb_control%tblite_method)
     726              :             ELSE
     727          946 :                gfn_type = dft_control%qs_control%xtb_control%gfn_type
     728          946 :                CALL xtb_header(iw, gfn_type)
     729              :             END IF
     730              :          END SELECT
     731              :          CALL cp_print_key_finished_output(iw, logger, dft_section, &
     732         7736 :                                            "PRINT%PROGRAM_BANNER")
     733              :       END IF
     734              : 
     735         7742 :       IF (dft_control%do_sccs .AND. dft_control%qs_control%gapw) THEN
     736            0 :          CPABORT("SCCS is not yet implemented with GAPW")
     737              :       END IF
     738         7742 :       CALL get_qs_env(qs_env=qs_env, do_kpoints=do_kpoints)
     739         7742 :       IF (do_kpoints) THEN
     740              :          ! reset some of the settings for wfn extrapolation for kpoints
     741          198 :          SELECT CASE (dft_control%qs_control%wf_interpolation_method_nr)
     742              :          CASE (wfi_linear_wf_method_nr, wfi_linear_ps_method_nr, &
     743              :                wfi_gext_proj_nr, wfi_gext_proj_qtr_nr)
     744              :             CALL cp_warn(__LOCATION__, "Linear WFN-based extrapolation methods are not "// &
     745            0 :                          "implemented for k-points. Switching to USE_PREV_WF.")
     746          198 :             dft_control%qs_control%wf_interpolation_method_nr = wfi_use_prev_wf_method_nr
     747              :          END SELECT
     748              :       END IF
     749              : 
     750              :       ! Check if any kind of electron transfer calculation has to be performed
     751         7742 :       CALL section_vals_val_get(et_coupling_section, "TYPE_OF_CONSTRAINT", i_val=my_ival)
     752         7742 :       dft_control%qs_control%et_coupling_calc = .FALSE.
     753         7742 :       IF (my_ival == do_et_ddapc) THEN
     754            0 :          et_ddapc_section => section_vals_get_subs_vals(et_coupling_section, "DDAPC_RESTRAINT_A")
     755            0 :          dft_control%qs_control%et_coupling_calc = .TRUE.
     756            0 :          dft_control%qs_control%ddapc_restraint = .TRUE.
     757            0 :          CALL read_ddapc_section(dft_control%qs_control, ddapc_restraint_section=et_ddapc_section)
     758              :       END IF
     759              : 
     760         7742 :       CALL read_mgrid_section(dft_control%qs_control, dft_section)
     761              : 
     762              :       ! Reimplemented TDDFPT
     763         7742 :       CALL read_tddfpt2_control(dft_control%tddfpt2_control, tddfpt_section, dft_control%qs_control)
     764              : 
     765              :       ! RIXS
     766         7742 :       CALL section_vals_get(rixs_section, explicit=qs_env%do_rixs)
     767         7742 :       IF (qs_env%do_rixs) THEN
     768           16 :          CALL read_rixs_control(dft_control%rixs_control, rixs_section, dft_control%qs_control)
     769              :       END IF
     770              : 
     771              :       ! Create relativistic control section
     772              :       BLOCK
     773              :          TYPE(rel_control_type), POINTER :: rel_control
     774         7742 :          ALLOCATE (rel_control)
     775         7742 :          CALL rel_c_create(rel_control)
     776         7742 :          CALL rel_c_read_parameters(rel_control, dft_section)
     777         7742 :          CALL set_qs_env(qs_env, rel_control=rel_control)
     778              :       END BLOCK
     779              : 
     780              :       ! Read DFTB parameter files
     781         7742 :       IF (dft_control%qs_control%method_id == do_method_dftb) THEN
     782          222 :          NULLIFY (ewald_env, ewald_pw, dftb_potential)
     783          222 :          dftb_control => dft_control%qs_control%dftb_control
     784              :          CALL qs_dftb_param_init(atomic_kind_set, qs_kind_set, dftb_control, dftb_potential, &
     785          222 :                                  subsys_section=subsys_section, para_env=para_env)
     786          222 :          CALL set_qs_env(qs_env, dftb_potential=dftb_potential)
     787              :          ! check for Ewald
     788          222 :          IF (dftb_control%do_ewald) THEN
     789         1888 :             ALLOCATE (ewald_env)
     790          118 :             CALL ewald_env_create(ewald_env, para_env)
     791          118 :             poisson_section => section_vals_get_subs_vals(dft_section, "POISSON")
     792          118 :             CALL ewald_env_set(ewald_env, poisson_section=poisson_section)
     793          118 :             ewald_section => section_vals_get_subs_vals(poisson_section, "EWALD")
     794          118 :             print_section => section_vals_get_subs_vals(qs_env%input, "PRINT%GRID_INFORMATION")
     795          118 :             CALL get_qs_kind_set(qs_kind_set, basis_rcut=ewald_rcut)
     796          118 :             CALL read_ewald_section_tb(ewald_env, ewald_section, cell_ref%hmat)
     797          118 :             ALLOCATE (ewald_pw)
     798          118 :             CALL ewald_pw_create(ewald_pw, ewald_env, cell, cell_ref, print_section=print_section)
     799          118 :             CALL set_qs_env(qs_env, ewald_env=ewald_env, ewald_pw=ewald_pw)
     800              :          END IF
     801         7520 :       ELSEIF (dft_control%qs_control%method_id == do_method_xtb) THEN
     802              :          ! Read xTB parameter file
     803         1000 :          xtb_control => dft_control%qs_control%xtb_control
     804         1000 :          CALL get_qs_env(qs_env, nkind=nkind)
     805         1000 :          IF (xtb_control%do_tblite) THEN
     806              :             ! put geometry to tblite
     807           50 :             CALL tb_init_geometry(qs_env, qs_env%tb_tblite)
     808              :             ! select tblite method
     809           50 :             CALL tb_set_calculator(qs_env%tb_tblite, xtb_control%tblite_method)
     810              :             !set up wave function
     811           50 :             CALL tb_init_wf(qs_env%tb_tblite)
     812              :             !get basis set
     813          184 :             DO ikind = 1, nkind
     814          134 :                qs_kind => qs_kind_set(ikind)
     815              :                ! Setup proper xTB parameters
     816          134 :                CPASSERT(.NOT. ASSOCIATED(qs_kind%xtb_parameter))
     817          134 :                CALL allocate_xtb_atom_param(qs_kind%xtb_parameter)
     818              :                ! Set default parameters
     819          134 :                CALL get_qs_kind(qs_kind, element_symbol=element_symbol)
     820              : 
     821          134 :                NULLIFY (tmp_basis_set)
     822          134 :                CALL tb_get_basis(qs_env%tb_tblite, tmp_basis_set, element_symbol, qs_kind%xtb_parameter, occ)
     823          134 :                CALL add_basis_set_to_container(qs_kind%basis_sets, tmp_basis_set, "ORB")
     824          134 :                CALL set_xtb_atom_param(qs_kind%xtb_parameter, occupation=occ)
     825              : 
     826              :                !setting the potential for the computation
     827          134 :                zeff_correction = 0.0_dp
     828              :                CALL init_potential(qs_kind%all_potential, itype="BARE", &
     829          854 :                                    zeff=REAL(SUM(occ), dp), zeff_correction=zeff_correction)
     830              :             END DO
     831              :          ELSE
     832          950 :             NULLIFY (ewald_env, ewald_pw)
     833         3058 :             DO ikind = 1, nkind
     834         2108 :                qs_kind => qs_kind_set(ikind)
     835              :                ! Setup proper xTB parameters
     836         2108 :                CPASSERT(.NOT. ASSOCIATED(qs_kind%xtb_parameter))
     837         2108 :                CALL allocate_xtb_atom_param(qs_kind%xtb_parameter)
     838              :                ! Set default parameters
     839         2108 :                gfn_type = dft_control%qs_control%xtb_control%gfn_type
     840         2108 :                CALL get_qs_kind(qs_kind, element_symbol=element_symbol)
     841              :                CALL xtb_parameters_init(qs_kind%xtb_parameter, gfn_type, element_symbol, &
     842              :                                         xtb_control%parameter_file_path, xtb_control%parameter_file_name, &
     843         2108 :                                         para_env)
     844              :                ! set dependent parameters
     845         2108 :                CALL xtb_parameters_set(qs_kind%xtb_parameter)
     846              :                ! Generate basis set
     847         2108 :                NULLIFY (tmp_basis_set)
     848         2108 :                IF (qs_kind%xtb_parameter%z == 1) THEN
     849              :                   ! special case hydrogen
     850          456 :                   ngauss = xtb_control%h_sto_ng
     851              :                ELSE
     852         1652 :                   ngauss = xtb_control%sto_ng
     853              :                END IF
     854         2108 :                IF (qs_kind%xtb_parameter%defined) THEN
     855         2106 :                   CALL init_xtb_basis(qs_kind%xtb_parameter, tmp_basis_set, ngauss)
     856         2106 :                   CALL add_basis_set_to_container(qs_kind%basis_sets, tmp_basis_set, "ORB")
     857              :                ELSE
     858            2 :                   CALL set_qs_kind(qs_kind, ghost=.TRUE.)
     859            2 :                   IF (ASSOCIATED(qs_kind%all_potential)) THEN
     860            2 :                      DEALLOCATE (qs_kind%all_potential%elec_conf)
     861            2 :                      DEALLOCATE (qs_kind%all_potential)
     862              :                   END IF
     863              :                END IF
     864              :                ! potential
     865         3058 :                IF (qs_kind%xtb_parameter%defined) THEN
     866         2106 :                   zeff_correction = 0.0_dp
     867              :                   CALL init_potential(qs_kind%all_potential, itype="BARE", &
     868         2106 :                                       zeff=qs_kind%xtb_parameter%zeff, zeff_correction=zeff_correction)
     869         2106 :                   CALL get_potential(qs_kind%all_potential, alpha_core_charge=alpha)
     870         2106 :                   ccore = qs_kind%xtb_parameter%zeff*SQRT((alpha/pi)**3)
     871         2106 :                   CALL set_potential(qs_kind%all_potential, ccore_charge=ccore)
     872         2106 :                   qs_kind%xtb_parameter%zeff = qs_kind%xtb_parameter%zeff - zeff_correction
     873              :                END IF
     874              :             END DO
     875              :             !
     876              :             ! set repulsive potential range
     877              :             !
     878         3800 :             ALLOCATE (xtb_control%rcpair(nkind, nkind))
     879          950 :             CALL xtb_pp_radius(qs_kind_set, xtb_control%rcpair, xtb_control%eps_pair, xtb_control%kf)
     880              :             ! check for Ewald
     881          950 :             IF (xtb_control%do_ewald) THEN
     882         2944 :                ALLOCATE (ewald_env)
     883          184 :                CALL ewald_env_create(ewald_env, para_env)
     884          184 :                poisson_section => section_vals_get_subs_vals(dft_section, "POISSON")
     885          184 :                CALL ewald_env_set(ewald_env, poisson_section=poisson_section)
     886          184 :                ewald_section => section_vals_get_subs_vals(poisson_section, "EWALD")
     887          184 :                print_section => section_vals_get_subs_vals(qs_env%input, "PRINT%GRID_INFORMATION")
     888          184 :                IF (gfn_type == 0) THEN
     889              :                   CALL read_ewald_section_tb(ewald_env, ewald_section, cell_ref%hmat, &
     890           34 :                                              silent=silent, pset="EEQ")
     891              :                ELSE
     892              :                   CALL read_ewald_section_tb(ewald_env, ewald_section, cell_ref%hmat, &
     893          150 :                                              silent=silent)
     894              :                END IF
     895          184 :                ALLOCATE (ewald_pw)
     896          184 :                CALL ewald_pw_create(ewald_pw, ewald_env, cell, cell_ref, print_section=print_section)
     897          184 :                CALL set_qs_env(qs_env, ewald_env=ewald_env, ewald_pw=ewald_pw)
     898              :             END IF
     899              :          END IF
     900              :       END IF
     901              :       ! lri or ri env initialization
     902         7742 :       lri_section => section_vals_get_subs_vals(qs_section, "LRIGPW")
     903              :       IF (dft_control%qs_control%method_id == do_method_lrigpw .OR. &
     904         7742 :           dft_control%qs_control%lri_optbas .OR. &
     905              :           dft_control%qs_control%method_id == do_method_rigpw) THEN
     906           48 :          CALL lri_env_init(lri_env, lri_section)
     907           48 :          CALL set_qs_env(qs_env, lri_env=lri_env)
     908              :       END IF
     909              : 
     910              :       ! Check basis and fill in missing parts
     911         7742 :       CALL check_qs_kind_set(qs_kind_set, dft_control, subsys_section=subsys_section)
     912              : 
     913              :       ! Check that no all-electron potential is present if GPW or GAPW_XC
     914         7742 :       CALL get_qs_kind_set(qs_kind_set, all_potential_present=all_potential_present)
     915              :       IF ((dft_control%qs_control%method_id == do_method_gpw) .OR. &
     916         7742 :           (dft_control%qs_control%method_id == do_method_gapw_xc) .OR. &
     917              :           (dft_control%qs_control%method_id == do_method_ofgpw)) THEN
     918         4466 :          IF (all_potential_present) THEN
     919            0 :             CPABORT("All-electron calculations with GPW, GAPW_XC, and OFGPW are not implemented")
     920              :          END IF
     921              :       END IF
     922              : 
     923              :       ! Check that no cneo potential is present if not GAPW
     924         7742 :       CALL get_qs_kind_set(qs_kind_set, cneo_potential_present=cneo_potential_present)
     925         7742 :       IF (cneo_potential_present .AND. &
     926              :           dft_control%qs_control%method_id /= do_method_gapw) THEN
     927            0 :          CPABORT("CNEO calculations require GAPW method")
     928              :       END IF
     929              : 
     930              :       ! DFT+U
     931         7742 :       CALL get_qs_kind_set(qs_kind_set, dft_plus_u_atom_present=dft_control%dft_plus_u)
     932              : 
     933         7742 :       IF (dft_control%do_admm) THEN
     934              :          ! Check if ADMM basis is available
     935          502 :          CALL get_qs_env(qs_env, nkind=nkind)
     936         1430 :          DO ikind = 1, nkind
     937          928 :             NULLIFY (aux_fit_basis)
     938          928 :             qs_kind => qs_kind_set(ikind)
     939          928 :             CALL get_qs_kind(qs_kind, basis_set=aux_fit_basis, basis_type="AUX_FIT")
     940         1430 :             IF (.NOT. (ASSOCIATED(aux_fit_basis))) THEN
     941              :                ! AUX_FIT basis set is not available
     942            0 :                CPABORT("AUX_FIT basis set is not defined. ")
     943              :             END IF
     944              :          END DO
     945              :       END IF
     946              : 
     947         7742 :       lribas = .FALSE.
     948         7742 :       e1terms = .FALSE.
     949         7742 :       IF (dft_control%qs_control%method_id == do_method_lrigpw) THEN
     950           40 :          lribas = .TRUE.
     951           40 :          CALL get_qs_env(qs_env, lri_env=lri_env)
     952           40 :          e1terms = lri_env%exact_1c_terms
     953              :       END IF
     954         7742 :       IF (dft_control%qs_control%do_kg) THEN
     955           66 :          CALL section_vals_val_get(dft_section, "KG_METHOD%TNADD_METHOD", i_val=tnadd_method)
     956           66 :          IF (tnadd_method == kg_tnadd_embed_ri) lribas = .TRUE.
     957              :       END IF
     958         7740 :       IF (lribas) THEN
     959              :          ! Check if LRI_AUX basis is available, auto-generate if needed
     960           42 :          CALL get_qs_env(qs_env, nkind=nkind)
     961          122 :          DO ikind = 1, nkind
     962           80 :             NULLIFY (lri_aux_basis)
     963           80 :             qs_kind => qs_kind_set(ikind)
     964           80 :             CALL get_qs_kind(qs_kind, basis_set=lri_aux_basis, basis_type="LRI_AUX")
     965          122 :             IF (.NOT. (ASSOCIATED(lri_aux_basis))) THEN
     966              :                ! LRI_AUX basis set is not yet loaded
     967              :                CALL cp_warn(__LOCATION__, "Automatic Generation of LRI_AUX basis. "// &
     968           18 :                             "This is experimental code.")
     969              :                ! Generate a default basis
     970           18 :                CALL create_lri_aux_basis_set(lri_aux_basis, qs_kind, dft_control%auto_basis_lri_aux, e1terms)
     971           18 :                CALL add_basis_set_to_container(qs_kind%basis_sets, lri_aux_basis, "LRI_AUX")
     972              :             END IF
     973              :          END DO
     974              :       END IF
     975              : 
     976         7742 :       CALL section_vals_val_get(qs_env%input, "DFT%XC%HF%RI%_SECTION_PARAMETERS_", l_val=do_ri_hfx)
     977              :       CALL section_vals_val_get(qs_env%input, "DFT%XC%WF_CORRELATION%RI_RPA%HF%RI%_SECTION_PARAMETERS_", &
     978         7742 :                                 l_val=do_rpa_ri_exx)
     979         7742 :       IF (do_ri_hfx .OR. do_rpa_ri_exx) THEN
     980          108 :          CALL get_qs_env(qs_env, nkind=nkind)
     981          108 :          CALL section_vals_val_get(qs_env%input, "DFT%SORT_BASIS", i_val=sort_basis)
     982          290 :          DO ikind = 1, nkind
     983          182 :             NULLIFY (ri_hfx_basis)
     984          182 :             qs_kind => qs_kind_set(ikind)
     985              :             CALL get_qs_kind(qs_kind=qs_kind, basis_set=ri_hfx_basis, &
     986          182 :                              basis_type="RI_HFX")
     987         7924 :             IF (.NOT. (ASSOCIATED(ri_hfx_basis))) THEN
     988          178 :                CALL get_qs_kind_set(qs_kind_set, maxlgto=maxlgto)
     989          178 :                IF (dft_control%do_admm) THEN
     990              :                   CALL create_ri_aux_basis_set(ri_hfx_basis, qs_kind, dft_control%auto_basis_ri_hfx, &
     991           58 :                                                basis_type="AUX_FIT", basis_sort=sort_basis)
     992              :                ELSE
     993              :                   CALL create_ri_aux_basis_set(ri_hfx_basis, qs_kind, dft_control%auto_basis_ri_hfx, &
     994          120 :                                                basis_sort=sort_basis)
     995              :                END IF
     996          178 :                CALL add_basis_set_to_container(qs_kind%basis_sets, ri_hfx_basis, "RI_HFX")
     997              :             END IF
     998              :          END DO
     999              :       END IF
    1000              : 
    1001         7742 :       IF (dft_control%qs_control%method_id == do_method_rigpw) THEN
    1002              :          ! Check if RI_HXC basis is available, auto-generate if needed
    1003            2 :          CALL get_qs_env(qs_env, nkind=nkind)
    1004            4 :          DO ikind = 1, nkind
    1005            2 :             NULLIFY (ri_hfx_basis)
    1006            2 :             qs_kind => qs_kind_set(ikind)
    1007            2 :             CALL get_qs_kind(qs_kind, basis_set=ri_hfx_basis, basis_type="RI_HXC")
    1008            4 :             IF (.NOT. (ASSOCIATED(ri_hfx_basis))) THEN
    1009              :                ! Generate a default basis
    1010            2 :                CALL create_ri_aux_basis_set(ri_hfx_basis, qs_kind, dft_control%auto_basis_ri_hxc)
    1011            2 :                CALL add_basis_set_to_container(qs_kind%basis_sets, ri_hfx_basis, "RI_HXC")
    1012              :             END IF
    1013              :          END DO
    1014              :       END IF
    1015              : 
    1016              :       ! Harris method
    1017         7742 :       NULLIFY (harris_env)
    1018              :       CALL section_vals_val_get(dft_section, "HARRIS_METHOD%_SECTION_PARAMETERS_", &
    1019         7742 :                                 l_val=qs_env%harris_method)
    1020         7742 :       harris_section => section_vals_get_subs_vals(dft_section, "HARRIS_METHOD")
    1021         7742 :       CALL harris_env_create(qs_env, harris_env, harris_section)
    1022         7742 :       CALL set_qs_env(qs_env, harris_env=harris_env)
    1023              :       !
    1024         7742 :       IF (qs_env%harris_method) THEN
    1025            8 :          CALL get_qs_env(qs_env, nkind=nkind)
    1026              :          ! Check if RI_HXC basis is available, auto-generate if needed
    1027           30 :          DO ikind = 1, nkind
    1028           22 :             NULLIFY (tmp_basis_set)
    1029           22 :             qs_kind => qs_kind_set(ikind)
    1030           22 :             CALL get_qs_kind(qs_kind, basis_set=rhoin_basis, basis_type="RHOIN")
    1031           30 :             IF (.NOT. (ASSOCIATED(rhoin_basis))) THEN
    1032              :                ! Generate a default basis
    1033           22 :                CALL create_ri_aux_basis_set(tmp_basis_set, qs_kind, dft_control%auto_basis_ri_hxc)
    1034           22 :                IF (qs_env%harris_env%density_source == hden_atomic) THEN
    1035           22 :                   CALL create_primitive_basis_set(tmp_basis_set, rhoin_basis, lmax=0)
    1036           22 :                   CALL deallocate_gto_basis_set(tmp_basis_set)
    1037              :                ELSE
    1038            0 :                   rhoin_basis => tmp_basis_set
    1039              :                END IF
    1040           22 :                CALL add_basis_set_to_container(qs_kind%basis_sets, rhoin_basis, "RHOIN")
    1041              :             END IF
    1042              :          END DO
    1043              :       END IF
    1044              : 
    1045         7742 :       mp2_section => section_vals_get_subs_vals(qs_env%input, "DFT%XC%WF_CORRELATION")
    1046         7742 :       CALL section_vals_get(mp2_section, explicit=mp2_present)
    1047         7742 :       IF (mp2_present) THEN
    1048              : 
    1049              :          ! basis should be sorted for imaginary time RPA/GW
    1050          474 :          CALL section_vals_val_get(qs_env%input, "DFT%SORT_BASIS", i_val=sort_basis)
    1051              :          CALL section_vals_val_get(qs_env%input, "DFT%XC%WF_CORRELATION%LOW_SCALING%_SECTION_PARAMETERS_", &
    1052          474 :                                    l_val=do_wfc_im_time)
    1053              : 
    1054          474 :          IF (do_wfc_im_time .AND. sort_basis /= basis_sort_zet) THEN
    1055              :             CALL cp_warn(__LOCATION__, &
    1056           10 :                          "Low-scaling RPA requires SORT_BASIS EXP keyword (in DFT input section) for good performance")
    1057              :          END IF
    1058              : 
    1059              :          ! Check if RI_AUX basis (for MP2/RPA) is given, auto-generate if not
    1060          474 :          CALL mp2_env_create(qs_env%mp2_env)
    1061          474 :          CALL get_qs_env(qs_env, mp2_env=mp2_env, nkind=nkind)
    1062          474 :          CALL section_vals_val_get(qs_env%input, "DFT%XC%WF_CORRELATION%RI_MP2%_SECTION_PARAMETERS_", l_val=do_ri_mp2)
    1063          474 :          CALL section_vals_val_get(qs_env%input, "DFT%XC%WF_CORRELATION%RI_SOS_MP2%_SECTION_PARAMETERS_", l_val=do_ri_sos_mp2)
    1064          474 :          CALL section_vals_val_get(qs_env%input, "DFT%XC%WF_CORRELATION%RI_RPA%_SECTION_PARAMETERS_", l_val=do_ri_rpa)
    1065          474 :          IF (do_ri_mp2 .OR. do_ri_sos_mp2 .OR. do_ri_rpa) THEN
    1066         1276 :             DO ikind = 1, nkind
    1067          840 :                NULLIFY (ri_aux_basis_set)
    1068          840 :                qs_kind => qs_kind_set(ikind)
    1069              :                CALL get_qs_kind(qs_kind=qs_kind, basis_set=ri_aux_basis_set, &
    1070          840 :                                 basis_type="RI_AUX")
    1071         1314 :                IF (.NOT. (ASSOCIATED(ri_aux_basis_set))) THEN
    1072              :                   ! RI_AUX basis set is not yet loaded
    1073              :                   ! Generate a default basis
    1074            8 :                   CALL create_ri_aux_basis_set(ri_aux_basis_set, qs_kind, dft_control%auto_basis_ri_aux, basis_sort=sort_basis)
    1075            8 :                   CALL add_basis_set_to_container(qs_kind%basis_sets, ri_aux_basis_set, "RI_AUX")
    1076              :                   ! Add a flag, which allows to check if the basis was generated
    1077              :                   !  when applying ERI_METHOD OS to mp2, ri-rpa, gw etc
    1078            8 :                   qs_env%mp2_env%ri_aux_auto_generated = .TRUE.
    1079              :                END IF
    1080              :             END DO
    1081              :          END IF
    1082              : 
    1083              :       END IF
    1084              : 
    1085         7742 :       IF (dft_control%do_xas_tdp_calculation .OR. qs_env%do_rixs) THEN
    1086              :          ! Check if RI_XAS basis is given, auto-generate if not
    1087           66 :          CALL get_qs_env(qs_env, nkind=nkind)
    1088          172 :          DO ikind = 1, nkind
    1089          106 :             NULLIFY (ri_xas_basis)
    1090          106 :             qs_kind => qs_kind_set(ikind)
    1091          106 :             CALL get_qs_kind(qs_kind, basis_Set=ri_xas_basis, basis_type="RI_XAS")
    1092         7848 :             IF (.NOT. ASSOCIATED(ri_xas_basis)) THEN
    1093              :                ! Generate a default basis
    1094          102 :                CALL create_ri_aux_basis_set(ri_xas_basis, qs_kind, dft_control%auto_basis_ri_xas)
    1095          102 :                CALL add_basis_set_to_container(qs_kind%basis_sets, ri_xas_basis, "RI_XAS")
    1096              :             END IF
    1097              :          END DO
    1098              :       END IF
    1099              : 
    1100              :       ! Initialize the spherical harmonics and the orbital transformation matrices
    1101         7742 :       CALL get_qs_kind_set(qs_kind_set, maxlgto=maxlgto, maxlppl=maxlppl, maxlppnl=maxlppnl)
    1102              : 
    1103              :       ! CNEO nuclear basis contributes to GAPW rho0
    1104         7742 :       IF (cneo_potential_present) THEN
    1105            8 :          CALL get_qs_kind_set(qs_kind_set, maxlgto=maxlgto_nuc, basis_type="NUC")
    1106            8 :          maxlgto = MAX(maxlgto, maxlgto_nuc)
    1107              :       END IF
    1108         7742 :       lmax_sphere = dft_control%qs_control%gapw_control%lmax_sphere
    1109         7742 :       IF (lmax_sphere < 0) THEN
    1110         7618 :          lmax_sphere = 2*maxlgto
    1111         7618 :          dft_control%qs_control%gapw_control%lmax_sphere = lmax_sphere
    1112              :       END IF
    1113         7742 :       IF (dft_control%qs_control%method_id == do_method_lrigpw .OR. dft_control%qs_control%lri_optbas) THEN
    1114           46 :          CALL get_qs_kind_set(qs_kind_set, maxlgto=maxlgto_lri, basis_type="LRI_AUX")
    1115              :          !take maxlgto from lri basis if larger (usually)
    1116           46 :          maxlgto = MAX(maxlgto, maxlgto_lri)
    1117         7696 :       ELSE IF (dft_control%qs_control%method_id == do_method_rigpw) THEN
    1118            2 :          CALL get_qs_kind_set(qs_kind_set, maxlgto=maxlgto_lri, basis_type="RI_HXC")
    1119            2 :          maxlgto = MAX(maxlgto, maxlgto_lri)
    1120              :       END IF
    1121         7742 :       IF (dft_control%do_xas_tdp_calculation .OR. qs_env%do_rixs) THEN
    1122              :          !done as a precaution
    1123           66 :          CALL get_qs_kind_set(qs_kind_set, maxlgto=maxlgto_lri, basis_type="RI_XAS")
    1124           66 :          maxlgto = MAX(maxlgto, maxlgto_lri)
    1125              :       END IF
    1126         7742 :       maxl = MAX(2*maxlgto, maxlppl, maxlppnl, lmax_sphere) + 1
    1127              : 
    1128         7742 :       CALL init_orbital_pointers(maxl)
    1129              : 
    1130         7742 :       CALL init_spherical_harmonics(maxl, 0)
    1131              : 
    1132              :       !  Initialise the qs_kind_set
    1133         7742 :       CALL init_qs_kind_set(qs_kind_set)
    1134              : 
    1135              :       ! Initialise GAPW soft basis and projectors
    1136         7742 :       IF (dft_control%qs_control%method_id == do_method_gapw .OR. &
    1137              :           dft_control%qs_control%method_id == do_method_gapw_xc) THEN
    1138         1162 :          qs_control => dft_control%qs_control
    1139         1162 :          CALL init_gapw_basis_set(qs_kind_set, qs_control, qs_env%input)
    1140              :       END IF
    1141              : 
    1142              :       ! Initialise CNEO nuclear soft basis
    1143         7742 :       IF (cneo_potential_present) THEN
    1144            8 :          CALL init_cneo_basis_set(qs_kind_set, qs_control)
    1145              :       END IF
    1146              : 
    1147              :       ! Initialize the pretabulation for the calculation of the
    1148              :       ! incomplete Gamma function F_n(t) after McMurchie-Davidson
    1149         7742 :       CALL get_qs_kind_set(qs_kind_set, maxlgto=maxlgto)
    1150         7742 :       maxl = MAX(3*maxlgto + 1, 0)
    1151         7742 :       CALL init_md_ftable(maxl)
    1152              : 
    1153              :       ! Initialize the atomic interaction radii
    1154         7742 :       CALL init_interaction_radii(dft_control%qs_control, qs_kind_set)
    1155              :       !
    1156         7742 :       IF (dft_control%qs_control%method_id == do_method_xtb) THEN
    1157         1000 :          IF (.NOT. dft_control%qs_control%xtb_control%do_tblite) THEN
    1158              :             ! cutoff radius
    1159          950 :             CALL get_qs_env(qs_env, nkind=nkind)
    1160         3058 :             DO ikind = 1, nkind
    1161         2108 :                qs_kind => qs_kind_set(ikind)
    1162         3058 :                IF (qs_kind%xtb_parameter%defined) THEN
    1163         2106 :                   CALL get_qs_kind(qs_kind, basis_set=tmp_basis_set)
    1164         2106 :                   rcut = xtb_control%coulomb_sr_cut
    1165         2106 :                   fxx = 2.0_dp*xtb_control%coulomb_sr_eps*qs_kind%xtb_parameter%eta**2
    1166         2106 :                   fxx = 0.80_dp*(1.0_dp/fxx)**0.3333_dp
    1167         2106 :                   rcut = MIN(rcut, xtb_control%coulomb_sr_cut)
    1168         2106 :                   qs_kind%xtb_parameter%rcut = MIN(rcut, fxx)
    1169              :                ELSE
    1170            2 :                   qs_kind%xtb_parameter%rcut = 0.0_dp
    1171              :                END IF
    1172              :             END DO
    1173              :          END IF
    1174              :       END IF
    1175              : 
    1176         7742 :       IF (.NOT. be_silent) THEN
    1177         7736 :          CALL write_pgf_orb_radii("orb", atomic_kind_set, qs_kind_set, subsys_section)
    1178         7736 :          CALL write_pgf_orb_radii("aux", atomic_kind_set, qs_kind_set, subsys_section)
    1179         7736 :          CALL write_pgf_orb_radii("lri", atomic_kind_set, qs_kind_set, subsys_section)
    1180         7736 :          CALL write_pgf_orb_radii("nuc", atomic_kind_set, qs_kind_set, subsys_section)
    1181         7736 :          CALL write_core_charge_radii(atomic_kind_set, qs_kind_set, subsys_section)
    1182         7736 :          CALL write_ppl_radii(atomic_kind_set, qs_kind_set, subsys_section)
    1183         7736 :          CALL write_ppnl_radii(atomic_kind_set, qs_kind_set, subsys_section)
    1184         7736 :          CALL write_paw_radii(atomic_kind_set, qs_kind_set, subsys_section)
    1185              :       END IF
    1186              : 
    1187              :       ! Distribute molecules and atoms using the new data structures
    1188              :       CALL distribute_molecules_1d(atomic_kind_set=atomic_kind_set, &
    1189              :                                    particle_set=particle_set, &
    1190              :                                    local_particles=local_particles, &
    1191              :                                    molecule_kind_set=molecule_kind_set, &
    1192              :                                    molecule_set=molecule_set, &
    1193              :                                    local_molecules=local_molecules, &
    1194         7742 :                                    force_env_section=qs_env%input)
    1195              : 
    1196              :       ! SCF parameters
    1197       224518 :       ALLOCATE (scf_control)
    1198              :       ! set (non)-self consistency
    1199         7742 :       IF (dft_control%qs_control%dftb) THEN
    1200          222 :          scf_control%non_selfconsistent = .NOT. dft_control%qs_control%dftb_control%self_consistent
    1201              :       END IF
    1202         7742 :       IF (dft_control%qs_control%xtb) THEN
    1203         1000 :          IF (dft_control%qs_control%xtb_control%do_tblite) THEN
    1204           50 :             scf_control%non_selfconsistent = .FALSE.
    1205              :          ELSE
    1206          950 :             scf_control%non_selfconsistent = (dft_control%qs_control%xtb_control%gfn_type == 0)
    1207              :          END IF
    1208              :       END IF
    1209         7742 :       IF (qs_env%harris_method) THEN
    1210            8 :          scf_control%non_selfconsistent = .TRUE.
    1211              :       END IF
    1212         7742 :       CALL scf_c_create(scf_control)
    1213         7742 :       CALL scf_c_read_parameters(scf_control, dft_section)
    1214              : 
    1215              :       ! Allocate the data structure for Quickstep energies
    1216         7742 :       CALL allocate_qs_energy(energy)
    1217              : 
    1218              :       ! Check for orthogonal basis
    1219         7742 :       has_unit_metric = .FALSE.
    1220         7742 :       IF (dft_control%qs_control%semi_empirical) THEN
    1221         1000 :          IF (dft_control%qs_control%se_control%orthogonal_basis) has_unit_metric = .TRUE.
    1222              :       END IF
    1223         7742 :       IF (dft_control%qs_control%dftb) THEN
    1224          222 :          IF (dft_control%qs_control%dftb_control%orthogonal_basis) has_unit_metric = .TRUE.
    1225              :       END IF
    1226         7742 :       CALL set_qs_env(qs_env, has_unit_metric=has_unit_metric)
    1227              : 
    1228              :       !  Activate the interpolation
    1229              :       CALL wfi_create(wf_history, &
    1230              :                       interpolation_method_nr= &
    1231              :                       dft_control%qs_control%wf_interpolation_method_nr, &
    1232              :                       extrapolation_order=dft_control%qs_control%wf_extrapolation_order, &
    1233         7742 :                       has_unit_metric=has_unit_metric)
    1234              : 
    1235              :       ! Set the current Quickstep environment
    1236              :       CALL set_qs_env(qs_env=qs_env, &
    1237              :                       scf_control=scf_control, &
    1238         7742 :                       wf_history=wf_history)
    1239              : 
    1240              :       CALL qs_subsys_set(subsys, &
    1241              :                          cell_ref=cell_ref, &
    1242              :                          use_ref_cell=use_ref_cell, &
    1243              :                          energy=energy, &
    1244         7742 :                          force=force)
    1245              : 
    1246         7742 :       CALL get_qs_env(qs_env, ks_env=ks_env)
    1247         7742 :       CALL set_ks_env(ks_env, dft_control=dft_control)
    1248              : 
    1249              :       CALL qs_subsys_set(subsys, local_molecules=local_molecules, &
    1250         7742 :                          local_particles=local_particles, cell=cell)
    1251              : 
    1252         7742 :       CALL distribution_1d_release(local_particles)
    1253         7742 :       CALL distribution_1d_release(local_molecules)
    1254         7742 :       CALL wfi_release(wf_history)
    1255              : 
    1256              :       CALL get_qs_env(qs_env=qs_env, &
    1257              :                       atomic_kind_set=atomic_kind_set, &
    1258              :                       dft_control=dft_control, &
    1259         7742 :                       scf_control=scf_control)
    1260              : 
    1261              :       ! Decide what conditions need mo_derivs
    1262              :       ! right now, this only appears to be OT
    1263         7742 :       IF (dft_control%qs_control%do_ls_scf .OR. &
    1264              :           dft_control%qs_control%do_almo_scf) THEN
    1265          408 :          CALL set_qs_env(qs_env=qs_env, requires_mo_derivs=.FALSE.)
    1266              :       ELSE
    1267         7334 :          IF (scf_control%use_ot) THEN
    1268         2168 :             CALL set_qs_env(qs_env=qs_env, requires_mo_derivs=.TRUE.)
    1269              :          ELSE
    1270         5166 :             CALL set_qs_env(qs_env=qs_env, requires_mo_derivs=.FALSE.)
    1271              :          END IF
    1272              :       END IF
    1273              : 
    1274              :       ! XXXXXXX this is backwards XXXXXXXX
    1275         7742 :       IF (dft_control%qs_control%xtb_control%do_tblite) THEN
    1276           50 :          IF (.NOT. scf_control%smear%do_smear) THEN
    1277              :             ! set tblite default smearing
    1278           28 :             scf_control%smear%do_smear = .TRUE.
    1279           28 :             scf_control%smear%method = smear_fermi_dirac
    1280           28 :             scf_control%smear%electronic_temperature = 300._dp/kelvin
    1281           28 :             scf_control%smear%eps_fermi_dirac = 1.E-6_dp
    1282              :          END IF
    1283              :       END IF
    1284         7742 :       dft_control%smear = scf_control%smear%do_smear
    1285              : 
    1286              :       ! Periodic efield needs equal occupation and orbital gradients
    1287         7742 :       IF (.NOT. (dft_control%qs_control%dftb .OR. dft_control%qs_control%xtb)) THEN
    1288         6520 :          IF (dft_control%apply_period_efield) THEN
    1289           30 :             CALL get_qs_env(qs_env=qs_env, requires_mo_derivs=orb_gradient)
    1290           30 :             IF (.NOT. orb_gradient) THEN
    1291              :                CALL cp_abort(__LOCATION__, "Periodic Efield needs orbital gradient and direct optimization."// &
    1292            0 :                              " Use the OT optimization method.")
    1293              :             END IF
    1294           30 :             IF (dft_control%smear) THEN
    1295              :                CALL cp_abort(__LOCATION__, "Periodic Efield needs equal occupation numbers."// &
    1296            0 :                              " Smearing option is not possible.")
    1297              :             END IF
    1298              :          END IF
    1299              :       END IF
    1300              : 
    1301              :       ! Initialize the GAPW local densities and potentials
    1302         7742 :       IF (dft_control%qs_control%method_id == do_method_gapw .OR. &
    1303              :           dft_control%qs_control%method_id == do_method_gapw_xc) THEN
    1304              :          ! Allocate and initialize the set of atomic densities
    1305         1162 :          NULLIFY (rho_atom_set)
    1306         1162 :          gapw_control => dft_control%qs_control%gapw_control
    1307         1162 :          CALL init_rho_atom(rho_atom_set, atomic_kind_set, qs_kind_set, dft_control, para_env)
    1308         1162 :          CALL set_qs_env(qs_env=qs_env, rho_atom_set=rho_atom_set)
    1309         1162 :          IF (dft_control%qs_control%method_id /= do_method_gapw_xc) THEN
    1310         1012 :             CALL get_qs_env(qs_env=qs_env, local_rho_set=local_rho_set, natom=natom)
    1311              :             ! Allocate and initialize the compensation density rho0
    1312         1012 :             CALL init_rho0(local_rho_set, qs_env, gapw_control)
    1313              :             ! Allocate and Initialize the local coulomb term
    1314         1012 :             CALL init_coulomb_local(qs_env%hartree_local, natom)
    1315              :          END IF
    1316              :          ! NLCC
    1317         1162 :          CALL init_gapw_nlcc(qs_kind_set)
    1318              :          ! Accurate XC integration
    1319         1162 :          IF (gapw_control%accurate_xcint) THEN
    1320          152 :             CPASSERT(.NOT. ASSOCIATED(gapw_control%aw))
    1321          152 :             CALL get_qs_env(qs_env, nkind=nkind)
    1322          456 :             ALLOCATE (gapw_control%aw(nkind))
    1323          152 :             alpha = gapw_control%aweights
    1324          464 :             DO ikind = 1, nkind
    1325          312 :                qs_kind => qs_kind_set(ikind)
    1326          312 :                CALL get_qs_kind(qs_kind, hard_radius=rc, paw_atom=paw_atom)
    1327          464 :                IF (paw_atom) THEN
    1328          308 :                   gapw_control%aw(ikind) = alpha*(1.2_dp/rc)**2
    1329              :                ELSE
    1330            4 :                   gapw_control%aw(ikind) = 0.0_dp
    1331              :                END IF
    1332              :             END DO
    1333              :          END IF
    1334         6580 :       ELSE IF (dft_control%qs_control%method_id == do_method_lrigpw) THEN
    1335              :          ! allocate local ri environment
    1336              :          ! nothing to do here?
    1337         6540 :       ELSE IF (dft_control%qs_control%method_id == do_method_rigpw) THEN
    1338              :          ! allocate ri environment
    1339              :          ! nothing to do here?
    1340         6538 :       ELSE IF (dft_control%qs_control%semi_empirical) THEN
    1341         1000 :          NULLIFY (se_store_int_env, se_nddo_mpole, se_nonbond_env)
    1342         1000 :          natom = SIZE(particle_set)
    1343         1000 :          se_section => section_vals_get_subs_vals(qs_section, "SE")
    1344         1000 :          se_control => dft_control%qs_control%se_control
    1345              : 
    1346              :          ! Make the cutoff radii choice a bit smarter
    1347         1000 :          CALL se_cutoff_compatible(se_control, se_section, cell, output_unit)
    1348              : 
    1349         1998 :          SELECT CASE (dft_control%qs_control%method_id)
    1350              :          CASE DEFAULT
    1351              :          CASE (do_method_rm1, do_method_am1, do_method_mndo, do_method_pm3, &
    1352              :                do_method_pm6, do_method_pm6fm, do_method_mndod, do_method_pnnl)
    1353              :             ! Neighbor lists have to be MAX(interaction range, orbital range)
    1354              :             ! set new kind radius
    1355         1000 :             CALL init_se_nlradius(se_control, atomic_kind_set, qs_kind_set, subsys_section)
    1356              :          END SELECT
    1357              :          ! Initialize to zero the max multipole to treat in the EWALD scheme..
    1358         1000 :          se_control%max_multipole = do_multipole_none
    1359              :          ! check for Ewald
    1360         1000 :          IF (se_control%do_ewald .OR. se_control%do_ewald_gks) THEN
    1361          512 :             ALLOCATE (ewald_env)
    1362           32 :             CALL ewald_env_create(ewald_env, para_env)
    1363           32 :             poisson_section => section_vals_get_subs_vals(dft_section, "POISSON")
    1364           32 :             CALL ewald_env_set(ewald_env, poisson_section=poisson_section)
    1365           32 :             ewald_section => section_vals_get_subs_vals(poisson_section, "EWALD")
    1366              :             print_section => section_vals_get_subs_vals(qs_env%input, &
    1367           32 :                                                         "PRINT%GRID_INFORMATION")
    1368           32 :             CALL read_ewald_section(ewald_env, ewald_section)
    1369              :             ! Create ewald grids
    1370           32 :             ALLOCATE (ewald_pw)
    1371              :             CALL ewald_pw_create(ewald_pw, ewald_env, cell, cell_ref, &
    1372           32 :                                  print_section=print_section)
    1373              :             ! Initialize ewald grids
    1374           32 :             CALL ewald_pw_grid_update(ewald_pw, ewald_env, cell%hmat)
    1375              :             ! Setup the nonbond environment (real space part of Ewald)
    1376           32 :             CALL ewald_env_get(ewald_env, rcut=ewald_rcut)
    1377              :             ! Setup the maximum level of multipoles to be treated in the periodic SE scheme
    1378           32 :             IF (se_control%do_ewald) THEN
    1379           30 :                CALL ewald_env_get(ewald_env, max_multipole=se_control%max_multipole)
    1380              :             END IF
    1381              :             CALL section_vals_val_get(se_section, "NEIGHBOR_LISTS%VERLET_SKIN", &
    1382           32 :                                       r_val=verlet_skin)
    1383           32 :             ALLOCATE (se_nonbond_env)
    1384              :             CALL fist_nonbond_env_create(se_nonbond_env, atomic_kind_set, do_nonbonded=.TRUE., &
    1385              :                                          do_electrostatics=.TRUE., verlet_skin=verlet_skin, ewald_rcut=ewald_rcut, &
    1386           32 :                                          ei_scale14=0.0_dp, vdw_scale14=0.0_dp, shift_cutoff=.FALSE.)
    1387              :             ! Create and Setup NDDO multipole environment
    1388           32 :             CALL nddo_mpole_setup(se_nddo_mpole, natom)
    1389              :             CALL set_qs_env(qs_env, ewald_env=ewald_env, ewald_pw=ewald_pw, &
    1390           32 :                             se_nonbond_env=se_nonbond_env, se_nddo_mpole=se_nddo_mpole)
    1391              :             ! Handle the residual integral part 1/R^3
    1392              :             CALL semi_empirical_expns3_setup(qs_kind_set, se_control, &
    1393           32 :                                              dft_control%qs_control%method_id)
    1394              :          END IF
    1395              :          ! Taper function
    1396              :          CALL se_taper_create(se_taper, se_control%integral_screening, se_control%do_ewald, &
    1397              :                               se_control%taper_cou, se_control%range_cou, &
    1398              :                               se_control%taper_exc, se_control%range_exc, &
    1399              :                               se_control%taper_scr, se_control%range_scr, &
    1400         1000 :                               se_control%taper_lrc, se_control%range_lrc)
    1401         1000 :          CALL set_qs_env(qs_env, se_taper=se_taper)
    1402              :          ! Store integral environment
    1403         1000 :          CALL semi_empirical_si_create(se_store_int_env, se_section)
    1404         1000 :          CALL set_qs_env(qs_env, se_store_int_env=se_store_int_env)
    1405              :       END IF
    1406              : 
    1407              :       ! Initialize possible dispersion parameters
    1408              :       IF (dft_control%qs_control%method_id == do_method_gpw .OR. &
    1409              :           dft_control%qs_control%method_id == do_method_gapw .OR. &
    1410              :           dft_control%qs_control%method_id == do_method_gapw_xc .OR. &
    1411              :           dft_control%qs_control%method_id == do_method_lrigpw .OR. &
    1412         7742 :           dft_control%qs_control%method_id == do_method_rigpw .OR. &
    1413              :           dft_control%qs_control%method_id == do_method_ofgpw) THEN
    1414        27600 :          ALLOCATE (dispersion_env)
    1415         5520 :          NULLIFY (xc_section)
    1416         5520 :          xc_section => section_vals_get_subs_vals(dft_section, "XC")
    1417         5520 :          CALL qs_dispersion_env_set(dispersion_env, xc_section)
    1418         5520 :          IF (dispersion_env%type == xc_vdw_fun_pairpot) THEN
    1419          114 :             NULLIFY (pp_section)
    1420          114 :             pp_section => section_vals_get_subs_vals(xc_section, "VDW_POTENTIAL%PAIR_POTENTIAL")
    1421          114 :             CALL qs_dispersion_pairpot_init(atomic_kind_set, qs_kind_set, dispersion_env, pp_section, para_env)
    1422         5406 :          ELSE IF (dispersion_env%type == xc_vdw_fun_nonloc) THEN
    1423           46 :             NULLIFY (nl_section)
    1424           46 :             nl_section => section_vals_get_subs_vals(xc_section, "VDW_POTENTIAL%NON_LOCAL")
    1425           46 :             CALL qs_dispersion_nonloc_init(dispersion_env, para_env)
    1426              :          END IF
    1427         5520 :          CALL set_qs_env(qs_env, dispersion_env=dispersion_env)
    1428         2222 :       ELSE IF (dft_control%qs_control%method_id == do_method_dftb) THEN
    1429         1110 :          ALLOCATE (dispersion_env)
    1430              :          ! set general defaults
    1431              :          dispersion_env%doabc = .FALSE.
    1432              :          dispersion_env%c9cnst = .FALSE.
    1433              :          dispersion_env%lrc = .FALSE.
    1434              :          dispersion_env%srb = .FALSE.
    1435              :          dispersion_env%verbose = .FALSE.
    1436              :          NULLIFY (dispersion_env%c6ab, dispersion_env%maxci, dispersion_env%r0ab, dispersion_env%rcov, &
    1437              :                   dispersion_env%r2r4, dispersion_env%cn, dispersion_env%cnkind, dispersion_env%cnlist, &
    1438              :                   dispersion_env%d3_exclude_pair)
    1439              :          NULLIFY (dispersion_env%q_mesh, dispersion_env%kernel, dispersion_env%d2phi_dk2, &
    1440              :                   dispersion_env%d2y_dx2, dispersion_env%dftd_section)
    1441              :          NULLIFY (dispersion_env%sab_vdw, dispersion_env%sab_cn)
    1442          222 :          IF (dftb_control%dispersion .AND. dftb_control%dispersion_type == dispersion_d3) THEN
    1443           14 :             dispersion_env%type = xc_vdw_fun_pairpot
    1444           14 :             dispersion_env%pp_type = vdw_pairpot_dftd3
    1445           14 :             dispersion_env%eps_cn = dftb_control%epscn
    1446           14 :             dispersion_env%s6 = dftb_control%sd3(1)
    1447           14 :             dispersion_env%sr6 = dftb_control%sd3(2)
    1448           14 :             dispersion_env%s8 = dftb_control%sd3(3)
    1449              :             dispersion_env%domol = .FALSE.
    1450           14 :             dispersion_env%kgc8 = 0._dp
    1451           14 :             dispersion_env%rc_disp = dftb_control%rcdisp
    1452           14 :             dispersion_env%exp_pre = 0._dp
    1453           14 :             dispersion_env%scaling = 0._dp
    1454           14 :             dispersion_env%nd3_exclude_pair = 0
    1455           14 :             dispersion_env%parameter_file_name = dftb_control%dispersion_parameter_file
    1456           14 :             CALL qs_dispersion_pairpot_init(atomic_kind_set, qs_kind_set, dispersion_env, para_env=para_env)
    1457          208 :          ELSEIF (dftb_control%dispersion .AND. dftb_control%dispersion_type == dispersion_d3bj) THEN
    1458            2 :             dispersion_env%type = xc_vdw_fun_pairpot
    1459            2 :             dispersion_env%pp_type = vdw_pairpot_dftd3bj
    1460            2 :             dispersion_env%eps_cn = dftb_control%epscn
    1461            2 :             dispersion_env%s6 = dftb_control%sd3bj(1)
    1462            2 :             dispersion_env%a1 = dftb_control%sd3bj(2)
    1463            2 :             dispersion_env%s8 = dftb_control%sd3bj(3)
    1464            2 :             dispersion_env%a2 = dftb_control%sd3bj(4)
    1465              :             dispersion_env%domol = .FALSE.
    1466            2 :             dispersion_env%kgc8 = 0._dp
    1467            2 :             dispersion_env%rc_disp = dftb_control%rcdisp
    1468            2 :             dispersion_env%exp_pre = 0._dp
    1469            2 :             dispersion_env%scaling = 0._dp
    1470            2 :             dispersion_env%nd3_exclude_pair = 0
    1471            2 :             dispersion_env%parameter_file_name = dftb_control%dispersion_parameter_file
    1472            2 :             CALL qs_dispersion_pairpot_init(atomic_kind_set, qs_kind_set, dispersion_env, para_env=para_env)
    1473          206 :          ELSEIF (dftb_control%dispersion .AND. dftb_control%dispersion_type == dispersion_d2) THEN
    1474            2 :             dispersion_env%type = xc_vdw_fun_pairpot
    1475            2 :             dispersion_env%pp_type = vdw_pairpot_dftd2
    1476            2 :             dispersion_env%exp_pre = dftb_control%exp_pre
    1477            2 :             dispersion_env%scaling = dftb_control%scaling
    1478            2 :             dispersion_env%parameter_file_name = dftb_control%dispersion_parameter_file
    1479            2 :             dispersion_env%rc_disp = dftb_control%rcdisp
    1480            2 :             CALL qs_dispersion_pairpot_init(atomic_kind_set, qs_kind_set, dispersion_env, para_env=para_env)
    1481              :          ELSE
    1482          204 :             dispersion_env%type = xc_vdw_fun_none
    1483              :          END IF
    1484          222 :          CALL set_qs_env(qs_env, dispersion_env=dispersion_env)
    1485         2000 :       ELSE IF (dft_control%qs_control%method_id == do_method_xtb) THEN
    1486         1000 :          IF (.NOT. (dft_control%qs_control%xtb_control%do_tblite)) THEN
    1487         4750 :             ALLOCATE (dispersion_env)
    1488              :             ! set general defaults
    1489              :             dispersion_env%doabc = .FALSE.
    1490              :             dispersion_env%c9cnst = .FALSE.
    1491              :             dispersion_env%lrc = .FALSE.
    1492              :             dispersion_env%srb = .FALSE.
    1493              :             dispersion_env%verbose = .FALSE.
    1494              :             NULLIFY (dispersion_env%c6ab, dispersion_env%maxci, &
    1495              :                      dispersion_env%r0ab, dispersion_env%rcov, &
    1496              :                      dispersion_env%r2r4, dispersion_env%cn, &
    1497              :                      dispersion_env%cnkind, dispersion_env%cnlist, &
    1498              :                      dispersion_env%d3_exclude_pair)
    1499              :             NULLIFY (dispersion_env%q_mesh, dispersion_env%kernel, dispersion_env%d2phi_dk2, &
    1500              :                      dispersion_env%d2y_dx2, dispersion_env%dftd_section)
    1501              :             NULLIFY (dispersion_env%sab_vdw, dispersion_env%sab_cn)
    1502          950 :             dispersion_env%type = xc_vdw_fun_pairpot
    1503          950 :             dispersion_env%eps_cn = xtb_control%epscn
    1504          950 :             dispersion_env%s6 = xtb_control%s6
    1505          950 :             dispersion_env%s8 = xtb_control%s8
    1506          950 :             dispersion_env%a1 = xtb_control%a1
    1507          950 :             dispersion_env%a2 = xtb_control%a2
    1508              :             dispersion_env%domol = .FALSE.
    1509          950 :             dispersion_env%kgc8 = 0._dp
    1510          950 :             dispersion_env%rc_disp = xtb_control%rcdisp
    1511          950 :             dispersion_env%rc_d4 = xtb_control%rcdisp
    1512          950 :             dispersion_env%exp_pre = 0._dp
    1513          950 :             dispersion_env%scaling = 0._dp
    1514          950 :             dispersion_env%nd3_exclude_pair = 0
    1515          950 :             dispersion_env%parameter_file_name = xtb_control%dispersion_parameter_file
    1516              :             !
    1517         1260 :             SELECT CASE (xtb_control%vdw_type)
    1518              :             CASE (xtb_vdw_type_none, xtb_vdw_type_d3)
    1519          310 :                dispersion_env%pp_type = vdw_pairpot_dftd3bj
    1520          310 :                CALL qs_dispersion_pairpot_init(atomic_kind_set, qs_kind_set, dispersion_env, para_env=para_env)
    1521          310 :                IF (xtb_control%vdw_type == xtb_vdw_type_none) dispersion_env%type = xc_vdw_fun_none
    1522              :             CASE (xtb_vdw_type_d4)
    1523          640 :                dispersion_env%pp_type = vdw_pairpot_dftd4
    1524          640 :                dispersion_env%ref_functional = "none"
    1525              :                CALL qs_dispersion_pairpot_init(atomic_kind_set, qs_kind_set, &
    1526          640 :                                                dispersion_env, para_env=para_env)
    1527          640 :                dispersion_env%cnfun = 2
    1528              :             CASE DEFAULT
    1529          950 :                CPABORT("vdw type")
    1530              :             END SELECT
    1531          950 :             CALL set_qs_env(qs_env, dispersion_env=dispersion_env)
    1532              :          END IF
    1533         1000 :       ELSE IF (dft_control%qs_control%semi_empirical) THEN
    1534         5000 :          ALLOCATE (dispersion_env)
    1535              :          ! set general defaults
    1536              :          dispersion_env%doabc = .FALSE.
    1537              :          dispersion_env%c9cnst = .FALSE.
    1538              :          dispersion_env%lrc = .FALSE.
    1539              :          dispersion_env%srb = .FALSE.
    1540              :          dispersion_env%verbose = .FALSE.
    1541              :          NULLIFY (dispersion_env%c6ab, dispersion_env%maxci, dispersion_env%r0ab, dispersion_env%rcov, &
    1542              :                   dispersion_env%r2r4, dispersion_env%cn, dispersion_env%cnkind, dispersion_env%cnlist, &
    1543              :                   dispersion_env%d3_exclude_pair)
    1544              :          NULLIFY (dispersion_env%q_mesh, dispersion_env%kernel, dispersion_env%d2phi_dk2, &
    1545              :                   dispersion_env%d2y_dx2, dispersion_env%dftd_section)
    1546              :          NULLIFY (dispersion_env%sab_vdw, dispersion_env%sab_cn)
    1547         1000 :          IF (se_control%dispersion) THEN
    1548            6 :             dispersion_env%type = xc_vdw_fun_pairpot
    1549            6 :             dispersion_env%pp_type = vdw_pairpot_dftd3
    1550            6 :             dispersion_env%eps_cn = se_control%epscn
    1551            6 :             dispersion_env%s6 = se_control%sd3(1)
    1552            6 :             dispersion_env%sr6 = se_control%sd3(2)
    1553            6 :             dispersion_env%s8 = se_control%sd3(3)
    1554              :             dispersion_env%domol = .FALSE.
    1555            6 :             dispersion_env%kgc8 = 0._dp
    1556            6 :             dispersion_env%rc_disp = se_control%rcdisp
    1557            6 :             dispersion_env%exp_pre = 0._dp
    1558            6 :             dispersion_env%scaling = 0._dp
    1559            6 :             dispersion_env%nd3_exclude_pair = 0
    1560            6 :             dispersion_env%parameter_file_name = se_control%dispersion_parameter_file
    1561            6 :             CALL qs_dispersion_pairpot_init(atomic_kind_set, qs_kind_set, dispersion_env, para_env=para_env)
    1562              :          ELSE
    1563          994 :             dispersion_env%type = xc_vdw_fun_none
    1564              :          END IF
    1565         1000 :          CALL set_qs_env(qs_env, dispersion_env=dispersion_env)
    1566              :       END IF
    1567              : 
    1568              :       ! Initialize possible geomertical counterpoise correction potential
    1569              :       IF (dft_control%qs_control%method_id == do_method_gpw .OR. &
    1570              :           dft_control%qs_control%method_id == do_method_gapw .OR. &
    1571              :           dft_control%qs_control%method_id == do_method_gapw_xc .OR. &
    1572              :           dft_control%qs_control%method_id == do_method_lrigpw .OR. &
    1573         7742 :           dft_control%qs_control%method_id == do_method_rigpw .OR. &
    1574              :           dft_control%qs_control%method_id == do_method_ofgpw) THEN
    1575         5520 :          ALLOCATE (gcp_env)
    1576         5520 :          NULLIFY (xc_section)
    1577         5520 :          xc_section => section_vals_get_subs_vals(dft_section, "XC")
    1578         5520 :          CALL qs_gcp_env_set(gcp_env, xc_section)
    1579         5520 :          CALL qs_gcp_init(qs_env, gcp_env)
    1580         5520 :          CALL set_qs_env(qs_env, gcp_env=gcp_env)
    1581              :       END IF
    1582              : 
    1583              :       ! Allocate the MO data types
    1584         7742 :       CALL get_qs_kind_set(qs_kind_set, nsgf=n_ao, nelectron=nelectron)
    1585              : 
    1586              :       ! The total number of electrons
    1587         7742 :       nelectron = nelectron - dft_control%charge
    1588              : 
    1589         7742 :       IF (dft_control%multiplicity == 0) THEN
    1590         6492 :          IF (MODULO(nelectron, 2) == 0) THEN
    1591         6013 :             dft_control%multiplicity = 1
    1592              :          ELSE
    1593          479 :             dft_control%multiplicity = 2
    1594              :          END IF
    1595              :       END IF
    1596              : 
    1597         7742 :       multiplicity = dft_control%multiplicity
    1598              : 
    1599         7742 :       IF ((dft_control%nspins < 1) .OR. (dft_control%nspins > 2)) THEN
    1600            0 :          CPABORT("nspins should be 1 or 2 for the time being ...")
    1601              :       END IF
    1602              : 
    1603         7742 :       IF ((MODULO(nelectron, 2) /= 0) .AND. (dft_control%nspins == 1)) THEN
    1604           12 :          IF (.NOT. dft_control%qs_control%ofgpw .AND. .NOT. dft_control%smear) THEN
    1605            0 :             CPABORT("Use the LSD option for an odd number of electrons")
    1606              :          END IF
    1607              :       END IF
    1608              : 
    1609              :       ! The transition potential method to calculate XAS needs LSD
    1610         7742 :       IF (dft_control%do_xas_calculation) THEN
    1611           42 :          IF (dft_control%nspins == 1) THEN
    1612            0 :             CPABORT("Use the LSD option for XAS with transition potential")
    1613              :          END IF
    1614              :       END IF
    1615              : 
    1616              :       ! assigning the number of states per spin initial version, not yet very
    1617              :       ! general. Should work for an even number of electrons and a single
    1618              :       ! additional electron this set of options that requires full matrices,
    1619              :       ! however, makes things a bit ugly right now.... we try to make a
    1620              :       ! distinction between the number of electrons per spin and the number of
    1621              :       ! MOs per spin this should allow the use of fractional occupations later on
    1622         7742 :       IF (dft_control%qs_control%ofgpw) THEN
    1623              : 
    1624            0 :          IF (dft_control%nspins == 1) THEN
    1625            0 :             maxocc = nelectron
    1626            0 :             nelectron_spin(1) = nelectron
    1627            0 :             nelectron_spin(2) = 0
    1628            0 :             n_mo(1) = 1
    1629            0 :             n_mo(2) = 0
    1630              :          ELSE
    1631            0 :             IF (MODULO(nelectron + multiplicity - 1, 2) /= 0) THEN
    1632            0 :                CPABORT("LSD: try to use a different multiplicity")
    1633              :             END IF
    1634            0 :             nelectron_spin(1) = (nelectron + multiplicity - 1)/2
    1635            0 :             nelectron_spin(2) = (nelectron - multiplicity + 1)/2
    1636            0 :             IF (nelectron_spin(1) < 0) THEN
    1637            0 :                CPABORT("LSD: too few electrons for this multiplicity")
    1638              :             END IF
    1639            0 :             maxocc = MAXVAL(nelectron_spin)
    1640            0 :             n_mo(1) = MIN(nelectron_spin(1), 1)
    1641            0 :             n_mo(2) = MIN(nelectron_spin(2), 1)
    1642              :          END IF
    1643              : 
    1644              :       ELSE
    1645              : 
    1646         7742 :          IF (dft_control%nspins == 1) THEN
    1647         6097 :             maxocc = 2.0_dp
    1648         6097 :             nelectron_spin(1) = nelectron
    1649         6097 :             nelectron_spin(2) = 0
    1650         6097 :             IF (MODULO(nelectron, 2) == 0) THEN
    1651         6085 :                n_mo(1) = nelectron/2
    1652              :             ELSE
    1653           12 :                n_mo(1) = INT(nelectron/2._dp) + 1
    1654              :             END IF
    1655         6097 :             n_mo(2) = 0
    1656              :          ELSE
    1657         1645 :             maxocc = 1.0_dp
    1658              : 
    1659              :             ! The simplist spin distribution is written here. Special cases will
    1660              :             ! need additional user input
    1661         1645 :             IF (MODULO(nelectron + multiplicity - 1, 2) /= 0) THEN
    1662            0 :                CPABORT("LSD: try to use a different multiplicity")
    1663              :             END IF
    1664              : 
    1665         1645 :             nelectron_spin(1) = (nelectron + multiplicity - 1)/2
    1666         1645 :             nelectron_spin(2) = (nelectron - multiplicity + 1)/2
    1667              : 
    1668         1645 :             IF (nelectron_spin(2) < 0) THEN
    1669            0 :                CPABORT("LSD: too few electrons for this multiplicity")
    1670              :             END IF
    1671              : 
    1672         1645 :             n_mo(1) = nelectron_spin(1)
    1673         1645 :             n_mo(2) = nelectron_spin(2)
    1674              : 
    1675              :          END IF
    1676              : 
    1677              :       END IF
    1678              : 
    1679              :       ! Read the total_zeff_corr here [SGh]
    1680         7742 :       CALL get_qs_kind_set(qs_kind_set, total_zeff_corr=total_zeff_corr)
    1681              :       ! store it in qs_env
    1682         7742 :       qs_env%total_zeff_corr = total_zeff_corr
    1683              : 
    1684              :       ! Store the number of electrons once and for all
    1685              :       CALL qs_subsys_set(subsys, &
    1686              :                          nelectron_total=nelectron, &
    1687         7742 :                          nelectron_spin=nelectron_spin)
    1688              : 
    1689              :       ! Ensure that all orbitals requested for printout are added even
    1690              :       ! if the keyword ADDED_MOS was not specified or set properly
    1691         7742 :       mo_index_range => section_get_ivals(dft_section, "PRINT%MO%MO_INDEX_RANGE")
    1692         7742 :       CPASSERT(ASSOCIATED(mo_index_range))
    1693         7778 :       IF (ALL(mo_index_range > 0)) THEN
    1694           18 :          IF (mo_index_range(1) > mo_index_range(2)) THEN
    1695              :             CALL cp_abort(__LOCATION__, &
    1696              :                           "The upper orbital index ("// &
    1697              :                           TRIM(ADJUSTL(cp_to_string(mo_index_range(2))))// &
    1698              :                           ") of the MO_INDEX_RANGE should be equal or larger "// &
    1699              :                           "than the lower orbital index ("// &
    1700              :                           TRIM(ADJUSTL(cp_to_string(mo_index_range(1))))// &
    1701            0 :                           ") for printout.")
    1702              :          END IF
    1703              :          ! Adapt ADDED_MOS automatically if needed for printout
    1704           18 :          IF (.NOT. scf_control%use_ot) THEN
    1705              :             scf_control%added_mos(1) = MIN(MAX(scf_control%added_mos(1), &
    1706              :                                                mo_index_range(2) - n_mo(1)), &
    1707           12 :                                            n_ao - n_mo(1))
    1708           12 :             IF (dft_control%nspins == 2) THEN
    1709              :                scf_control%added_mos(2) = MIN(MAX(scf_control%added_mos(2), &
    1710              :                                                   mo_index_range(2) - n_mo(2)), &
    1711            8 :                                               n_ao - n_mo(2))
    1712              :             END IF
    1713              :          END IF
    1714         7724 :       ELSE IF (mo_index_range(2) < 0) THEN
    1715            0 :          IF (.NOT. scf_control%use_ot) THEN
    1716              :             ! Add all available orbitals
    1717            0 :             scf_control%added_mos(1) = n_ao - n_mo(1)
    1718            0 :             IF (dft_control%nspins == 2) THEN
    1719              :                ! Ensure the same number for the spin-down (beta) orbitals
    1720            0 :                scf_control%added_mos(2) = n_ao - n_mo(2)
    1721              :             END IF
    1722              :          END IF
    1723              :       END IF
    1724              : 
    1725         7742 :       IF (dft_control%nspins == 2) THEN
    1726              :          ! Check and set number of added (unoccupied) orbitals for beta spin
    1727         1645 :          IF (scf_control%added_mos(2) < 0) THEN
    1728          128 :             n_mo_add = n_ao - n_mo(2)  ! use all available MOs
    1729         1517 :          ELSE IF (scf_control%added_mos(2) > 0) THEN
    1730              :             n_mo_add = scf_control%added_mos(2)
    1731              :          ELSE
    1732         1365 :             n_mo_add = scf_control%added_mos(1)
    1733              :          END IF
    1734         1645 :          IF (n_mo_add > n_ao - n_mo(2)) THEN
    1735           18 :             CPWARN("More ADDED_MOs requested for beta spin than available.")
    1736              :          END IF
    1737         1645 :          scf_control%added_mos(2) = MIN(n_mo_add, n_ao - n_mo(2))
    1738         1645 :          n_mo(2) = n_mo(2) + scf_control%added_mos(2)
    1739              :       END IF
    1740              : 
    1741              :       ! proceed alpha orbitals after the beta orbitals; this is essential to avoid
    1742              :       ! reduction in the number of available unoccupied molecular orbitals.
    1743              :       ! E.g. n_ao = 10, nelectrons = 10, multiplicity = 3 implies n_mo(1) = 6, n_mo(2) = 4;
    1744              :       ! added_mos(1:2) = (6,undef) should increase the number of molecular orbitals as
    1745              :       ! n_mo(1) = min(n_ao, n_mo(1) + added_mos(1)) = 10, n_mo(2) = 10.
    1746              :       ! However, if we try to proceed alpha orbitals first, this leads us n_mo(1:2) = (10,8)
    1747              :       ! due to the following assignment instruction above:
    1748              :       !   IF (scf_control%added_mos(2) > 0) THEN ... ELSE; n_mo_add = scf_control%added_mos(1); END IF
    1749         7742 :       IF (dft_control%qs_control%xtb_control%do_tblite) THEN
    1750           50 :          scf_control%added_mos(1) = n_ao - n_mo(1)  ! tblite needs all MO's
    1751         7692 :       ELSE IF (scf_control%added_mos(1) < 0) THEN
    1752          678 :          scf_control%added_mos(1) = n_ao - n_mo(1)  ! use all available MOs
    1753         7014 :       ELSE IF (scf_control%added_mos(1) > n_ao - n_mo(1)) THEN
    1754              :          CALL cp_warn(__LOCATION__, &
    1755              :                       "More added MOs requested than available. "// &
    1756              :                       "The full set of unoccupied MOs will be used. "// &
    1757              :                       "Use 'ADDED_MOS -1' to always use all available MOs "// &
    1758           92 :                       "and to get rid of this warning.")
    1759              :       END IF
    1760         7742 :       scf_control%added_mos(1) = MIN(scf_control%added_mos(1), n_ao - n_mo(1))
    1761         7742 :       n_mo(1) = n_mo(1) + scf_control%added_mos(1)
    1762              : 
    1763         7742 :       IF (dft_control%nspins == 2) THEN
    1764         1645 :          IF (n_mo(2) > n_mo(1)) &
    1765              :             CALL cp_warn(__LOCATION__, &
    1766              :                          "More beta than alpha MOs requested. "// &
    1767            0 :                          "The number of beta MOs will be reduced to the number alpha MOs.")
    1768         1645 :          n_mo(2) = MIN(n_mo(1), n_mo(2))
    1769         1645 :          CPASSERT(n_mo(1) >= nelectron_spin(1))
    1770         1645 :          CPASSERT(n_mo(2) >= nelectron_spin(2))
    1771              :       END IF
    1772              : 
    1773              :       ! kpoints
    1774         7742 :       CALL get_qs_env(qs_env=qs_env, do_kpoints=do_kpoints)
    1775         7742 :       IF (do_kpoints .AND. dft_control%nspins == 2) THEN
    1776              :          ! we need equal number of calculated states
    1777           26 :          IF (n_mo(2) /= n_mo(1)) &
    1778              :             CALL cp_warn(__LOCATION__, &
    1779              :                          "Kpoints: Different number of MOs requested. "// &
    1780            6 :                          "The number of beta MOs will be set to the number alpha MOs.")
    1781           26 :          n_mo(2) = n_mo(1)
    1782           26 :          CPASSERT(n_mo(1) >= nelectron_spin(1))
    1783           26 :          CPASSERT(n_mo(2) >= nelectron_spin(2))
    1784              :       END IF
    1785              : 
    1786              :       ! Compatibility checks for smearing
    1787         7742 :       IF (scf_control%smear%do_smear) THEN
    1788          950 :          IF (scf_control%added_mos(1) == 0) THEN
    1789            0 :             CPABORT("Extra MOs (ADDED_MOS) are required for smearing")
    1790              :          END IF
    1791              :       END IF
    1792              : 
    1793              :       ! Some options require that all MOs are computed ...
    1794              :       IF (BTEST(cp_print_key_should_output(logger%iter_info, dft_section, &
    1795              :                                            "PRINT%MO/CARTESIAN"), &
    1796              :                 cp_p_file) .OR. &
    1797              :           (scf_control%level_shift /= 0.0_dp) .OR. &
    1798         7742 :           (scf_control%diagonalization%eps_jacobi /= 0.0_dp) .OR. &
    1799              :           (dft_control%roks .AND. (.NOT. scf_control%use_ot))) THEN
    1800         7898 :          n_mo(:) = n_ao
    1801              :       END IF
    1802              : 
    1803              :       ! Compatibility checks for ROKS
    1804         7742 :       IF (dft_control%roks .AND. (.NOT. scf_control%use_ot)) THEN
    1805           42 :          IF (scf_control%roks_scheme == general_roks) THEN
    1806            0 :             CPWARN("General ROKS scheme is not yet tested!")
    1807              :          END IF
    1808           42 :          IF (scf_control%smear%do_smear) THEN
    1809              :             CALL cp_abort(__LOCATION__, &
    1810              :                           "The options ROKS and SMEAR are not compatible. "// &
    1811            0 :                           "Try UKS instead of ROKS")
    1812              :          END IF
    1813              :       END IF
    1814         7742 :       IF (dft_control%low_spin_roks) THEN
    1815            8 :          SELECT CASE (dft_control%qs_control%method_id)
    1816              :          CASE DEFAULT
    1817              :          CASE (do_method_xtb, do_method_dftb)
    1818              :             CALL cp_abort(__LOCATION__, &
    1819            0 :                           "xTB/DFTB methods are not compatible with low spin ROKS.")
    1820              :          CASE (do_method_rm1, do_method_am1, do_method_mndo, do_method_pm3, &
    1821              :                do_method_pm6, do_method_pm6fm, do_method_mndod, do_method_pnnl)
    1822              :             CALL cp_abort(__LOCATION__, &
    1823            8 :                           "SE methods are not compatible with low spin ROKS.")
    1824              :          END SELECT
    1825              :       END IF
    1826              : 
    1827              :       ! in principle the restricted calculation could be performed
    1828              :       ! using just one set of MOs and special casing most of the code
    1829              :       ! right now we'll just take care of what is effectively an additional constraint
    1830              :       ! at as few places as possible, just duplicating the beta orbitals
    1831         7742 :       IF (dft_control%restricted .AND. (output_unit > 0)) THEN
    1832              :          ! it is really not yet tested till the end ! Joost
    1833           23 :          WRITE (output_unit, *) ""
    1834           23 :          WRITE (output_unit, *) " **************************************"
    1835           23 :          WRITE (output_unit, *) " restricted calculation cutting corners"
    1836           23 :          WRITE (output_unit, *) " experimental feature, check code      "
    1837           23 :          WRITE (output_unit, *) " **************************************"
    1838              :       END IF
    1839              : 
    1840              :       ! no point in allocating these things here ?
    1841         7742 :       IF (dft_control%qs_control%do_ls_scf) THEN
    1842          342 :          NULLIFY (mos)
    1843              :       ELSE
    1844        31231 :          ALLOCATE (mos(dft_control%nspins))
    1845        16431 :          DO ispin = 1, dft_control%nspins
    1846              :             CALL allocate_mo_set(mo_set=mos(ispin), &
    1847              :                                  nao=n_ao, &
    1848              :                                  nmo=n_mo(ispin), &
    1849              :                                  nelectron=nelectron_spin(ispin), &
    1850              :                                  n_el_f=REAL(nelectron_spin(ispin), dp), &
    1851              :                                  maxocc=maxocc, &
    1852        16431 :                                  flexible_electron_count=dft_control%relax_multiplicity)
    1853              :          END DO
    1854              :       END IF
    1855              : 
    1856         7742 :       CALL set_qs_env(qs_env, mos=mos)
    1857              : 
    1858              :       ! allocate mos when switch_surf_dip is triggered [SGh]
    1859         7742 :       IF (dft_control%switch_surf_dip) THEN
    1860            8 :          ALLOCATE (mos_last_converged(dft_control%nspins))
    1861            4 :          DO ispin = 1, dft_control%nspins
    1862              :             CALL allocate_mo_set(mo_set=mos_last_converged(ispin), &
    1863              :                                  nao=n_ao, &
    1864              :                                  nmo=n_mo(ispin), &
    1865              :                                  nelectron=nelectron_spin(ispin), &
    1866              :                                  n_el_f=REAL(nelectron_spin(ispin), dp), &
    1867              :                                  maxocc=maxocc, &
    1868            4 :                                  flexible_electron_count=dft_control%relax_multiplicity)
    1869              :          END DO
    1870            2 :          CALL set_qs_env(qs_env, mos_last_converged=mos_last_converged)
    1871              :       END IF
    1872              : 
    1873         7742 :       IF (.NOT. be_silent) THEN
    1874              :          ! Print the DFT control parameters
    1875         7736 :          CALL write_dft_control(dft_control, dft_section)
    1876              : 
    1877              :          ! Print the vdW control parameters
    1878              :          IF (dft_control%qs_control%method_id == do_method_gpw .OR. &
    1879              :              dft_control%qs_control%method_id == do_method_gapw .OR. &
    1880              :              dft_control%qs_control%method_id == do_method_gapw_xc .OR. &
    1881              :              dft_control%qs_control%method_id == do_method_lrigpw .OR. &
    1882              :              dft_control%qs_control%method_id == do_method_rigpw .OR. &
    1883              :              dft_control%qs_control%method_id == do_method_dftb .OR. &
    1884              :              (dft_control%qs_control%method_id == do_method_xtb .AND. &
    1885         7736 :               (.NOT. dft_control%qs_control%xtb_control%do_tblite)) .OR. &
    1886              :              dft_control%qs_control%method_id == do_method_ofgpw) THEN
    1887         6686 :             CALL get_qs_env(qs_env, dispersion_env=dispersion_env)
    1888         6686 :             CALL qs_write_dispersion(qs_env, dispersion_env)
    1889              :          END IF
    1890              : 
    1891              :          ! Print the Quickstep control parameters
    1892         7736 :          CALL write_qs_control(dft_control%qs_control, dft_section)
    1893              : 
    1894              :          ! Print the ADMM control parameters
    1895         7736 :          IF (dft_control%do_admm) THEN
    1896          502 :             CALL write_admm_control(dft_control%admm_control, dft_section)
    1897              :          END IF
    1898              : 
    1899              :          ! Print XES/XAS control parameters
    1900         7736 :          IF (dft_control%do_xas_calculation) THEN
    1901           42 :             CALL cite_reference(Iannuzzi2007)
    1902              :             !CALL write_xas_control(dft_control%xas_control,dft_section)
    1903              :          END IF
    1904              : 
    1905              :          ! Print the unnormalized basis set information (input data)
    1906         7736 :          CALL write_gto_basis_sets(qs_kind_set, subsys_section)
    1907              : 
    1908              :          ! Print the atomic kind set
    1909         7736 :          CALL write_qs_kind_set(qs_kind_set, subsys_section)
    1910              : 
    1911              :          ! Print the molecule kind set
    1912         7736 :          CALL write_molecule_kind_set(molecule_kind_set, subsys_section)
    1913              : 
    1914              :          ! Print the total number of kinds, atoms, basis functions etc.
    1915         7736 :          CALL write_total_numbers(qs_kind_set, particle_set, qs_env%input)
    1916              : 
    1917              :          ! Print the atomic coordinates
    1918         7736 :          CALL write_qs_particle_coordinates(particle_set, qs_kind_set, subsys_section, label="QUICKSTEP")
    1919              : 
    1920              :          ! Print the interatomic distances
    1921         7736 :          CALL write_particle_distances(particle_set, cell, subsys_section)
    1922              : 
    1923              :          ! Print the requested structure data
    1924         7736 :          CALL write_structure_data(particle_set, cell, subsys_section)
    1925              : 
    1926              :          ! Print symmetry information
    1927         7736 :          CALL write_symmetry(particle_set, cell, subsys_section)
    1928              : 
    1929              :          ! Print the SCF parameters
    1930         7736 :          IF ((.NOT. dft_control%qs_control%do_ls_scf) .AND. &
    1931              :              (.NOT. dft_control%qs_control%do_almo_scf)) THEN
    1932         7328 :             CALL scf_c_write_parameters(scf_control, dft_section)
    1933              :          END IF
    1934              :       END IF
    1935              : 
    1936              :       ! Sets up pw_env, qs_charges, mpools ...
    1937         7742 :       CALL qs_env_setup(qs_env)
    1938              : 
    1939              :       ! Allocate and initialise rho0 soft on the global grid
    1940         7742 :       IF (dft_control%qs_control%method_id == do_method_gapw) THEN
    1941         1012 :          CALL get_qs_env(qs_env=qs_env, pw_env=pw_env, rho0_mpole=rho0_mpole)
    1942         1012 :          CALL rho0_s_grid_create(pw_env, rho0_mpole)
    1943              :       END IF
    1944              : 
    1945         7742 :       IF (output_unit > 0) CALL m_flush(output_unit)
    1946         7742 :       CALL timestop(handle)
    1947              : 
    1948        85162 :    END SUBROUTINE qs_init_subsys
    1949              : 
    1950              : ! **************************************************************************************************
    1951              : !> \brief Write the total number of kinds, atoms, etc. to the logical unit
    1952              : !>      number lunit.
    1953              : !> \param qs_kind_set ...
    1954              : !> \param particle_set ...
    1955              : !> \param force_env_section ...
    1956              : !> \author Creation (06.10.2000)
    1957              : ! **************************************************************************************************
    1958         7736 :    SUBROUTINE write_total_numbers(qs_kind_set, particle_set, force_env_section)
    1959              : 
    1960              :       TYPE(qs_kind_type), DIMENSION(:), POINTER          :: qs_kind_set
    1961              :       TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
    1962              :       TYPE(section_vals_type), POINTER                   :: force_env_section
    1963              : 
    1964              :       INTEGER                                            :: maxlgto, maxlppl, maxlppnl, natom, &
    1965              :                                                             natom_q, ncgf, nkind, nkind_q, npgf, &
    1966              :                                                             nset, nsgf, nshell, output_unit
    1967              :       TYPE(cp_logger_type), POINTER                      :: logger
    1968              : 
    1969         7736 :       NULLIFY (logger)
    1970         7736 :       logger => cp_get_default_logger()
    1971              :       output_unit = cp_print_key_unit_nr(logger, force_env_section, "PRINT%TOTAL_NUMBERS", &
    1972         7736 :                                          extension=".Log")
    1973              : 
    1974         7736 :       IF (output_unit > 0) THEN
    1975         3892 :          natom = SIZE(particle_set)
    1976         3892 :          nkind = SIZE(qs_kind_set)
    1977              : 
    1978              :          CALL get_qs_kind_set(qs_kind_set, &
    1979              :                               maxlgto=maxlgto, &
    1980              :                               ncgf=ncgf, &
    1981              :                               npgf=npgf, &
    1982              :                               nset=nset, &
    1983              :                               nsgf=nsgf, &
    1984              :                               nshell=nshell, &
    1985              :                               maxlppl=maxlppl, &
    1986         3892 :                               maxlppnl=maxlppnl)
    1987              : 
    1988              :          WRITE (UNIT=output_unit, FMT="(/,/,T2,A)") &
    1989         3892 :             "TOTAL NUMBERS AND MAXIMUM NUMBERS"
    1990              : 
    1991         3892 :          IF (nset + npgf + ncgf > 0) THEN
    1992              :             WRITE (UNIT=output_unit, FMT="(/,T3,A,(T30,A,T71,I10))") &
    1993         3892 :                "Total number of", &
    1994         3892 :                "- Atomic kinds:                  ", nkind, &
    1995         3892 :                "- Atoms:                         ", natom, &
    1996         3892 :                "- Shell sets:                    ", nset, &
    1997         3892 :                "- Shells:                        ", nshell, &
    1998         3892 :                "- Primitive Cartesian functions: ", npgf, &
    1999         3892 :                "- Cartesian basis functions:     ", ncgf, &
    2000         7784 :                "- Spherical basis functions:     ", nsgf
    2001            0 :          ELSE IF (nshell + nsgf > 0) THEN
    2002              :             WRITE (UNIT=output_unit, FMT="(/,T3,A,(T30,A,T71,I10))") &
    2003            0 :                "Total number of", &
    2004            0 :                "- Atomic kinds:                  ", nkind, &
    2005            0 :                "- Atoms:                         ", natom, &
    2006            0 :                "- Shells:                        ", nshell, &
    2007            0 :                "- Spherical basis functions:     ", nsgf
    2008              :          ELSE
    2009              :             WRITE (UNIT=output_unit, FMT="(/,T3,A,(T30,A,T71,I10))") &
    2010            0 :                "Total number of", &
    2011            0 :                "- Atomic kinds:                  ", nkind, &
    2012            0 :                "- Atoms:                         ", natom
    2013              :          END IF
    2014              : 
    2015         3892 :          IF ((maxlppl > -1) .AND. (maxlppnl > -1)) THEN
    2016              :             WRITE (UNIT=output_unit, FMT="(/,T3,A,(T30,A,T75,I6))") &
    2017         2004 :                "Maximum angular momentum of the", &
    2018         2004 :                "- Orbital basis functions:                   ", maxlgto, &
    2019         2004 :                "- Local part of the GTH pseudopotential:     ", maxlppl, &
    2020         4008 :                "- Non-local part of the GTH pseudopotential: ", maxlppnl
    2021         1888 :          ELSEIF (maxlppl > -1) THEN
    2022              :             WRITE (UNIT=output_unit, FMT="(/,T3,A,(T30,A,T75,I6))") &
    2023          457 :                "Maximum angular momentum of the", &
    2024          457 :                "- Orbital basis functions:                   ", maxlgto, &
    2025          914 :                "- Local part of the GTH pseudopotential:     ", maxlppl
    2026              :          ELSE
    2027              :             WRITE (UNIT=output_unit, FMT="(/,T3,A,T75,I6)") &
    2028         1431 :                "Maximum angular momentum of the orbital basis functions: ", maxlgto
    2029              :          END IF
    2030              : 
    2031              :          ! LRI_AUX BASIS
    2032              :          CALL get_qs_kind_set(qs_kind_set, &
    2033              :                               maxlgto=maxlgto, &
    2034              :                               ncgf=ncgf, &
    2035              :                               npgf=npgf, &
    2036              :                               nset=nset, &
    2037              :                               nsgf=nsgf, &
    2038              :                               nshell=nshell, &
    2039         3892 :                               basis_type="LRI_AUX")
    2040         3892 :          IF (nset + npgf + ncgf > 0) THEN
    2041              :             WRITE (UNIT=output_unit, FMT="(/,T3,A,/,T3,A,(T30,A,T71,I10))") &
    2042          135 :                "LRI_AUX Basis: ", &
    2043          135 :                "Total number of", &
    2044          135 :                "- Shell sets:                    ", nset, &
    2045          135 :                "- Shells:                        ", nshell, &
    2046          135 :                "- Primitive Cartesian functions: ", npgf, &
    2047          135 :                "- Cartesian basis functions:     ", ncgf, &
    2048          270 :                "- Spherical basis functions:     ", nsgf
    2049              :             WRITE (UNIT=output_unit, FMT="(T30,A,T75,I6)") &
    2050          135 :                "  Maximum angular momentum ", maxlgto
    2051              :          END IF
    2052              : 
    2053              :          ! RI_HXC BASIS
    2054              :          CALL get_qs_kind_set(qs_kind_set, &
    2055              :                               maxlgto=maxlgto, &
    2056              :                               ncgf=ncgf, &
    2057              :                               npgf=npgf, &
    2058              :                               nset=nset, &
    2059              :                               nsgf=nsgf, &
    2060              :                               nshell=nshell, &
    2061         3892 :                               basis_type="RI_HXC")
    2062         3892 :          IF (nset + npgf + ncgf > 0) THEN
    2063              :             WRITE (UNIT=output_unit, FMT="(/,T3,A,/,T3,A,(T30,A,T71,I10))") &
    2064          112 :                "RI_HXC Basis: ", &
    2065          112 :                "Total number of", &
    2066          112 :                "- Shell sets:                    ", nset, &
    2067          112 :                "- Shells:                        ", nshell, &
    2068          112 :                "- Primitive Cartesian functions: ", npgf, &
    2069          112 :                "- Cartesian basis functions:     ", ncgf, &
    2070          224 :                "- Spherical basis functions:     ", nsgf
    2071              :             WRITE (UNIT=output_unit, FMT="(T30,A,T75,I6)") &
    2072          112 :                "  Maximum angular momentum ", maxlgto
    2073              :          END IF
    2074              : 
    2075              :          ! AUX_FIT BASIS
    2076              :          CALL get_qs_kind_set(qs_kind_set, &
    2077              :                               maxlgto=maxlgto, &
    2078              :                               ncgf=ncgf, &
    2079              :                               npgf=npgf, &
    2080              :                               nset=nset, &
    2081              :                               nsgf=nsgf, &
    2082              :                               nshell=nshell, &
    2083         3892 :                               basis_type="AUX_FIT")
    2084         3892 :          IF (nset + npgf + ncgf > 0) THEN
    2085              :             WRITE (UNIT=output_unit, FMT="(/,T3,A,/,T3,A,(T30,A,T71,I10))") &
    2086          363 :                "AUX_FIT ADMM-Basis: ", &
    2087          363 :                "Total number of", &
    2088          363 :                "- Shell sets:                    ", nset, &
    2089          363 :                "- Shells:                        ", nshell, &
    2090          363 :                "- Primitive Cartesian functions: ", npgf, &
    2091          363 :                "- Cartesian basis functions:     ", ncgf, &
    2092          726 :                "- Spherical basis functions:     ", nsgf
    2093              :             WRITE (UNIT=output_unit, FMT="(T30,A,T75,I6)") &
    2094          363 :                "  Maximum angular momentum ", maxlgto
    2095              :          END IF
    2096              : 
    2097              :          ! NUCLEAR BASIS
    2098              :          CALL get_qs_kind_set(qs_kind_set, &
    2099              :                               nkind_q=nkind_q, &
    2100              :                               natom_q=natom_q, &
    2101              :                               maxlgto=maxlgto, &
    2102              :                               ncgf=ncgf, &
    2103              :                               npgf=npgf, &
    2104              :                               nset=nset, &
    2105              :                               nsgf=nsgf, &
    2106              :                               nshell=nshell, &
    2107         3892 :                               basis_type="NUC")
    2108         3892 :          IF (nset + npgf + ncgf > 0) THEN
    2109              :             WRITE (UNIT=output_unit, FMT="(/,T3,A,/,T3,A,(T30,A,T71,I10))") &
    2110          115 :                "Nuclear Basis: ", &
    2111          115 :                "Total number of", &
    2112          115 :                "- Quantum atomic kinds:          ", nkind_q, &
    2113          115 :                "- Quantum atoms:                 ", natom_q, &
    2114          115 :                "- Shell sets:                    ", nset, &
    2115          115 :                "- Shells:                        ", nshell, &
    2116          115 :                "- Primitive Cartesian functions: ", npgf, &
    2117          115 :                "- Cartesian basis functions:     ", ncgf, &
    2118          230 :                "- Spherical basis functions:     ", nsgf
    2119              :             WRITE (UNIT=output_unit, FMT="(T30,A,T75,I6)") &
    2120          115 :                "  Maximum angular momentum ", maxlgto
    2121              :          END IF
    2122              : 
    2123              :       END IF
    2124              :       CALL cp_print_key_finished_output(output_unit, logger, force_env_section, &
    2125         7736 :                                         "PRINT%TOTAL_NUMBERS")
    2126              : 
    2127         7736 :    END SUBROUTINE write_total_numbers
    2128              : 
    2129              : END MODULE qs_environment
        

Generated by: LCOV version 2.0-1