100                          do_hfx, do_admm, qs_env, kernel_env, kernel_env_admm_aux, &
 
  101                          sub_env, work_matrices, admm_symm, admm_xc_correction, do_lrigpw, &
 
  103      TYPE(
cp_fm_type), 
DIMENSION(:, :), 
INTENT(INOUT)   :: aop_evects
 
  104      TYPE(
cp_fm_type), 
DIMENSION(:, :), 
INTENT(IN)      :: evects
 
  105      LOGICAL, 
INTENT(in)                                :: is_rks_triplets, do_hfx, do_admm
 
  110      LOGICAL, 
INTENT(in)                                :: admm_symm, admm_xc_correction, &
 
  111                                                            do_lrigpw, tddfpt_mgrid
 
  113      CHARACTER(LEN=*), 
PARAMETER                        :: routinen = 
'fhxc_kernel' 
  115      CHARACTER(LEN=default_string_length)               :: basis_type
 
  116      INTEGER                                            :: handle, ikind, ispin, ivect, nao, &
 
  117                                                            nao_aux, nkind, nspins, nvects, &
 
  119      INTEGER, 
DIMENSION(:), 
POINTER                     :: blk_sizes
 
  120      INTEGER, 
DIMENSION(maxspins)                       :: nactive
 
  121      LOGICAL                                            :: do_noncol, gapw, gapw_xc
 
  123      TYPE(
cp_fm_type)                                   :: work_aux_orb, work_orb_orb
 
  124      TYPE(
dbcsr_p_type), 
DIMENSION(:), 
POINTER          :: a_xc_munu_sub, rho_ia_ao, &
 
  130      TYPE(
pw_c1d_gs_type), 
DIMENSION(:), 
POINTER        :: rho_ia_g, rho_ia_g_aux_fit
 
  133      TYPE(
pw_r3d_rs_type), 
DIMENSION(:), 
POINTER        :: rho_ia_r, rho_ia_r_aux_fit
 
  134      TYPE(
rho_atom_type), 
DIMENSION(:), 
POINTER         :: rho1_atom_set, rho_atom_set
 
  137      CALL timeset(routinen, handle)
 
  139      nspins = 
SIZE(evects, 1)
 
  140      nvects = 
SIZE(evects, 2)
 
  143         cpassert(
ASSOCIATED(sub_env%admm_A))
 
  145      CALL get_qs_env(qs_env, dft_control=dft_control)
 
  147      gapw = dft_control%qs_control%gapw
 
  148      gapw_xc = dft_control%qs_control%gapw_xc
 
  149      spinflip = dft_control%tddfpt2_control%spinflip
 
  158      CALL qs_rho_get(work_matrices%rho_orb_struct_sub, rho_ao=rho_ia_ao, &
 
  159                      rho_g=rho_ia_g, rho_r=rho_ia_r)
 
  160      IF (do_hfx .AND. do_admm) 
THEN 
  162         CALL qs_rho_get(work_matrices%rho_aux_fit_struct_sub, &
 
  163                         rho_ao=rho_ia_ao_aux_fit, rho_g=rho_ia_g_aux_fit, &
 
  164                         rho_r=rho_ia_r_aux_fit)
 
  170         IF (
ALLOCATED(work_matrices%evects_sub)) 
THEN 
  171            IF (
ASSOCIATED(work_matrices%evects_sub(1, ivect)%matrix_struct)) 
THEN 
  173                  CALL dbcsr_set(rho_ia_ao(ispin)%matrix, 0.0_dp)
 
  175                                             matrix_v=sub_env%mos_occ(ispin), &
 
  176                                             matrix_g=work_matrices%evects_sub(ispin, ivect), &
 
  177                                             ncol=nactive(ispin), symmetry_mode=1)
 
  185               CALL dbcsr_set(rho_ia_ao(ispin)%matrix, 0.0_dp)
 
  187                                          matrix_v=sub_env%mos_occ(ispin), &
 
  188                                          matrix_g=evects(ispin, ivect), &
 
  189                                          ncol=nactive(ispin), symmetry_mode=1)
 
  195                                      pw_env_external=sub_env%pw_env, &
 
  196                                      task_list_external=sub_env%task_list_orb, &
 
  197                                      para_env_external=sub_env%para_env, &
 
  198                                      tddfpt_lri_env=kernel_env%lri_env, &
 
  199                                      tddfpt_lri_density=kernel_env%lri_density)
 
  200         ELSEIF (dft_control%qs_control%lrigpw .OR. &
 
  201                 dft_control%qs_control%rigpw) 
THEN 
  203                                      pw_env_external=sub_env%pw_env, &
 
  204                                      task_list_external=sub_env%task_list_orb, &
 
  205                                      para_env_external=sub_env%para_env)
 
  209                                      local_rho_set=work_matrices%local_rho_set, &
 
  210                                      pw_env_external=sub_env%pw_env, &
 
  211                                      task_list_external=sub_env%task_list_orb_soft, &
 
  212                                      para_env_external=sub_env%para_env)
 
  214                                     do_rho0=(.NOT. is_rks_triplets), pw_env_sub=sub_env%pw_env)
 
  215            ELSEIF (gapw_xc) 
THEN 
  217                                      rho_xc_external=work_matrices%rho_xc_struct_sub, &
 
  218                                      local_rho_set=work_matrices%local_rho_set, &
 
  219                                      pw_env_external=sub_env%pw_env, &
 
  220                                      task_list_external=sub_env%task_list_orb, &
 
  221                                      task_list_external_soft=sub_env%task_list_orb_soft, &
 
  222                                      para_env_external=sub_env%para_env)
 
  223               CALL prepare_gapw_den(qs_env, work_matrices%local_rho_set, do_rho0=.false., &
 
  224                                     pw_env_sub=sub_env%pw_env)
 
  227                                      pw_env_external=sub_env%pw_env, &
 
  228                                      task_list_external=sub_env%task_list_orb, &
 
  229                                      para_env_external=sub_env%para_env)
 
  234            CALL dbcsr_set(work_matrices%A_ia_munu_sub(ispin)%matrix, 0.0_dp)
 
  239            CALL pw_zero(work_matrices%A_ia_rspace_sub(ispin))
 
  245            IF (.NOT. dft_control%tddfpt2_control%do_bse) 
THEN 
  249                  IF (kernel_env%do_exck) 
THEN 
  252                     CALL tddfpt_apply_xc(a_ia_rspace=work_matrices%A_ia_rspace_sub, kernel_env=kernel_env, &
 
  253                                          rho_ia_struct=work_matrices%rho_xc_struct_sub, &
 
  254                                          is_rks_triplets=is_rks_triplets, pw_env=sub_env%pw_env, &
 
  255                                          work_v_xc=work_matrices%wpw_rspace_sub, &
 
  256                                          work_v_xc_tau=work_matrices%wpw_tau_rspace_sub, &
 
  260                     CALL pw_scale(work_matrices%A_ia_rspace_sub(ispin), &
 
  261                                   work_matrices%A_ia_rspace_sub(ispin)%pw_grid%dvol)
 
  262                     CALL integrate_v_rspace(v_rspace=work_matrices%A_ia_rspace_sub(ispin), &
 
  263                                             hmat=work_matrices%A_ia_munu_sub(ispin), &
 
  264                                             qs_env=qs_env, calculate_forces=.false., gapw=gapw_xc, &
 
  265                                             pw_env_external=sub_env%pw_env, &
 
  266                                             task_list_external=sub_env%task_list_orb_soft)
 
  267                     CALL pw_zero(work_matrices%A_ia_rspace_sub(ispin))
 
  270                  IF (kernel_env%do_exck) 
THEN 
  272                                                    work_matrices%rho_orb_struct_sub, is_rks_triplets)
 
  274                     CALL tddfpt_apply_xc(a_ia_rspace=work_matrices%A_ia_rspace_sub, kernel_env=kernel_env, &
 
  275                                          rho_ia_struct=work_matrices%rho_orb_struct_sub, &
 
  276                                          is_rks_triplets=is_rks_triplets, pw_env=sub_env%pw_env, &
 
  277                                          work_v_xc=work_matrices%wpw_rspace_sub, &
 
  278                                          work_v_xc_tau=work_matrices%wpw_tau_rspace_sub, &
 
  282               IF (gapw .OR. gapw_xc) 
THEN 
  283                  rho_atom_set => sub_env%local_rho_set%rho_atom_set
 
  284                  rho1_atom_set => work_matrices%local_rho_set%rho_atom_set
 
  286                                                   sub_env%para_env, do_tddfpt2=.true., do_triplet=is_rks_triplets, &
 
  294         IF (do_admm .AND. admm_xc_correction) 
THEN 
  297                                                     rho_aux_fit_struct=work_matrices%rho_aux_fit_struct_sub, &
 
  298                                                     local_rho_set=work_matrices%local_rho_set_admm, &
 
  299                                                     qs_env=qs_env, sub_env=sub_env, &
 
  300                                                     wfm_rho_orb=work_matrices%rho_ao_orb_fm_sub, &
 
  301                                                     wfm_rho_aux_fit=work_matrices%rho_ao_aux_fit_fm_sub, &
 
  302                                                     wfm_aux_orb=work_matrices%wfm_aux_orb_sub)
 
  305                  CALL dbcsr_get_info(rho_ia_ao_aux_fit(1)%matrix, row_blk_size=blk_sizes)
 
  306                  ALLOCATE (a_xc_munu_sub(nspins))
 
  308                     ALLOCATE (a_xc_munu_sub(ispin)%matrix)
 
  309                     CALL dbcsr_create(matrix=a_xc_munu_sub(ispin)%matrix, name=
"ADMM_XC", &
 
  310                                       dist=sub_env%dbcsr_dist, matrix_type=dbcsr_type_symmetric, &
 
  311                                       row_blk_size=blk_sizes, col_blk_size=blk_sizes)
 
  313                     CALL dbcsr_set(a_xc_munu_sub(ispin)%matrix, 0.0_dp)
 
  316                  CALL pw_env_get(sub_env%pw_env, auxbas_pw_pool=auxbas_pw_pool)
 
  317                  ALLOCATE (v_rspace_sub(nspins))
 
  319                     CALL auxbas_pw_pool%create_pw(v_rspace_sub(ispin))
 
  320                     CALL pw_zero(v_rspace_sub(ispin))
 
  323                  IF (admm_env%do_gapw) 
THEN 
  324                     basis_type = 
"AUX_FIT_SOFT" 
  325                     task_list => sub_env%task_list_aux_fit_soft
 
  327                     basis_type = 
"AUX_FIT" 
  328                     task_list => sub_env%task_list_aux_fit
 
  332                                       kernel_env=kernel_env_admm_aux, &
 
  333                                       rho_ia_struct=work_matrices%rho_aux_fit_struct_sub, &
 
  334                                       is_rks_triplets=is_rks_triplets, pw_env=sub_env%pw_env, &
 
  335                                       work_v_xc=work_matrices%wpw_rspace_sub, &
 
  336                                       work_v_xc_tau=work_matrices%wpw_tau_rspace_sub, &
 
  339                     CALL pw_scale(v_rspace_sub(ispin), v_rspace_sub(ispin)%pw_grid%dvol)
 
  340                     CALL integrate_v_rspace(v_rspace=v_rspace_sub(ispin), &
 
  341                                             hmat=a_xc_munu_sub(ispin), &
 
  342                                             qs_env=qs_env, calculate_forces=.false., &
 
  343                                             pw_env_external=sub_env%pw_env, &
 
  344                                             basis_type=basis_type, &
 
  345                                             task_list_external=task_list)
 
  347                  IF (admm_env%do_gapw) 
THEN 
  348                     rho_atom_set => sub_env%local_rho_set_admm%rho_atom_set
 
  349                     rho1_atom_set => work_matrices%local_rho_set_admm%rho_atom_set
 
  351                                                      kernel_env_admm_aux%xc_section, &
 
  352                                                      sub_env%para_env, do_tddfpt2=.true., &
 
  353                                                      do_triplet=is_rks_triplets, do_sf=do_noncol, &
 
  354                                                      kind_set_external=admm_env%admm_gapw_env%admm_kind_set)
 
  355                     CALL update_ks_atom(qs_env, a_xc_munu_sub, rho_ia_ao_aux_fit, forces=.false., tddft=.true., &
 
  356                                         rho_atom_external=rho1_atom_set, &
 
  357                                         kind_set_external=admm_env%admm_gapw_env%admm_kind_set, &
 
  358                                         oce_external=admm_env%admm_gapw_env%oce, &
 
  359                                         sab_external=sub_env%sab_aux_fit)
 
  362                  CALL dbcsr_create(dbwork, template=work_matrices%A_ia_munu_sub(1)%matrix)
 
  364                                    matrix_struct=work_matrices%wfm_aux_orb_sub%matrix_struct)
 
  366                                    matrix_struct=work_matrices%rho_ao_orb_fm_sub%matrix_struct)
 
  367                  CALL cp_fm_get_info(work_aux_orb, nrow_global=nao_aux, ncol_global=nao)
 
  371                     CALL parallel_gemm(
'T', 
'N', nao, nao, nao_aux, 1.0_dp, sub_env%admm_A, &
 
  372                                        work_aux_orb, 0.0_dp, work_orb_orb)
 
  373                     CALL dbcsr_copy(dbwork, work_matrices%A_ia_munu_sub(1)%matrix)
 
  376                     CALL dbcsr_add(work_matrices%A_ia_munu_sub(ispin)%matrix, dbwork, 1.0_dp, 1.0_dp)
 
  381                     CALL auxbas_pw_pool%give_back_pw(v_rspace_sub(ispin))
 
  383                  DEALLOCATE (v_rspace_sub)
 
  389                  DEALLOCATE (a_xc_munu_sub)
 
  392                                       kernel_env=kernel_env_admm_aux, &
 
  393                                       rho_ia_struct=work_matrices%rho_aux_fit_struct_sub, &
 
  394                                       is_rks_triplets=is_rks_triplets, pw_env=sub_env%pw_env, &
 
  395                                       work_v_xc=work_matrices%wpw_rspace_sub, &
 
  396                                       work_v_xc_tau=work_matrices%wpw_tau_rspace_sub, &
 
  398                  IF (admm_env%do_gapw) 
THEN 
  399                     cpwarn(
"GAPW/ADMM needs symmetric ADMM kernel")
 
  400                     cpabort(
"GAPW/ADMM@TDDFT")
 
  407         IF ((.NOT. is_rks_triplets) .AND. (spinflip .EQ. 
no_sf_tddfpt)) 
THEN 
  412               CALL pw_axpy(rho_ia_g(ispin), rho_ia_g(1))
 
  415                                      rho_ia_g=rho_ia_g(1), &
 
  416                                      local_rho_set=work_matrices%local_rho_set, &
 
  417                                      hartree_local=work_matrices%hartree_local, &
 
  418                                      qs_env=qs_env, sub_env=sub_env, gapw=gapw, &
 
  419                                      work_v_gspace=work_matrices%wpw_gspace_sub(1), &
 
  420                                      work_v_rspace=work_matrices%wpw_rspace_sub(1), &
 
  421                                      tddfpt_mgrid=tddfpt_mgrid)
 
  426            IF (.NOT. do_lrigpw) 
THEN 
  427               CALL pw_scale(work_matrices%A_ia_rspace_sub(ispin), &
 
  428                             work_matrices%A_ia_rspace_sub(ispin)%pw_grid%dvol)
 
  431                  CALL integrate_v_rspace(v_rspace=work_matrices%A_ia_rspace_sub(ispin), &
 
  432                                          hmat=work_matrices%A_ia_munu_sub(ispin), &
 
  433                                          qs_env=qs_env, calculate_forces=.false., gapw=gapw, &
 
  434                                          pw_env_external=sub_env%pw_env, &
 
  435                                          task_list_external=sub_env%task_list_orb_soft)
 
  436               ELSEIF (gapw_xc) 
THEN 
  437                  IF (.NOT. is_rks_triplets) 
THEN 
  438                     CALL integrate_v_rspace(v_rspace=work_matrices%A_ia_rspace_sub(ispin), &
 
  439                                             hmat=work_matrices%A_ia_munu_sub(ispin), &
 
  440                                             qs_env=qs_env, calculate_forces=.false., gapw=.false., &
 
  441                                             pw_env_external=sub_env%pw_env, task_list_external=sub_env%task_list_orb)
 
  444                  CALL integrate_v_rspace(v_rspace=work_matrices%A_ia_rspace_sub(ispin), &
 
  445                                          hmat=work_matrices%A_ia_munu_sub(ispin), &
 
  446                                          qs_env=qs_env, calculate_forces=.false., gapw=.false., &
 
  447                                          pw_env_external=sub_env%pw_env, task_list_external=sub_env%task_list_orb)
 
  450               CALL pw_scale(work_matrices%A_ia_rspace_sub(ispin), &
 
  451                             work_matrices%A_ia_rspace_sub(ispin)%pw_grid%dvol)
 
  452               lri_v_int => kernel_env%lri_density%lri_coefs(ispin)%lri_kinds
 
  453               CALL get_qs_env(qs_env, nkind=nkind, para_env=para_env)
 
  455                  lri_v_int(ikind)%v_int = 0.0_dp
 
  457               CALL integrate_v_rspace_one_center(work_matrices%A_ia_rspace_sub(ispin), &
 
  458                                                  qs_env, lri_v_int, .false., 
"P_LRI_AUX")
 
  460                  CALL para_env%sum(lri_v_int(ikind)%v_int)
 
  466         IF (.NOT. do_lrigpw) 
THEN 
  467            IF (gapw .OR. gapw_xc) 
THEN 
  469               CALL update_ks_atom(qs_env, work_matrices%A_ia_munu_sub, rho_ia_ao, forces=.false., &
 
  470                                   rho_atom_external=work_matrices%local_rho_set%rho_atom_set, &
 
  477         IF (do_lrigpw .AND. (.NOT. is_rks_triplets)) 
THEN  
  478            CALL tddfpt2_lri_amat(qs_env, sub_env, kernel_env%lri_env, lri_v_int, work_matrices%A_ia_munu_sub)
 
  481         IF (
ALLOCATED(work_matrices%evects_sub)) 
THEN 
  484                                            sub_env%mos_occ(ispin), &
 
  485                                            work_matrices%Aop_evects_sub(ispin, ivect), &
 
  486                                            ncol=nactive(ispin), alpha=1.0_dp, beta=0.0_dp)
 
  491                                            sub_env%mos_occ(ispin), &
 
  492                                            aop_evects(ispin, ivect), &
 
  493                                            ncol=nactive(ispin), alpha=1.0_dp, beta=0.0_dp)
 
  498      CALL timestop(handle)
 
 
subroutine, public get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, cell_ref, use_ref_cell, kpoints, dft_control, mos, sab_orb, sab_all, qmmm, qmmm_periodic, sac_ae, sac_ppl, sac_lri, sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, sab_cneo, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, rhoz_cneo_set, ecoul_1c, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, lri_env, lri_density, exstate_env, ec_env, harris_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, mp2_env, bs_env, kg_env, wanniercentres, atprop, ls_scf_env, do_transport, transport_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, mscfg_env, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Get the QUICKSTEP environment.