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

Generated by: LCOV version 2.0-1