From b51345574746db14c0cc8b03db02496d4f9c40e8 Mon Sep 17 00:00:00 2001 From: Juerg Hutter Date: Thu, 22 Aug 2024 10:36:56 +0200 Subject: [PATCH] Calculate_wavefunction refactoring, fix dropped commit (#3643) --- src/mp2_eri_gpw.F | 27 +++---- src/mp2_gpw.F | 10 +-- src/mp2_gpw_method.F | 18 ++--- src/mp2_integrals.F | 6 +- src/mp2_ri_grad.F | 4 +- src/optimize_embedding_potential.F | 27 ++++--- src/qs_collocate_density.F | 123 ++++++++++++++++++----------- src/rpa_im_time_force_methods.F | 14 ++-- src/scf_control_types.F | 2 +- 9 files changed, 129 insertions(+), 102 deletions(-) diff --git a/src/mp2_eri_gpw.F b/src/mp2_eri_gpw.F index 23ab1b712d..6af92ffcd5 100644 --- a/src/mp2_eri_gpw.F +++ b/src/mp2_eri_gpw.F @@ -19,7 +19,6 @@ MODULE mp2_eri_gpw USE cp_control_types, ONLY: dft_control_type USE cp_dbcsr_api, ONLY: dbcsr_p_type,& dbcsr_set - USE cp_fm_types, ONLY: cp_fm_type USE gaussian_gridlevels, ONLY: gaussian_gridlevel USE input_constants, ONLY: do_potential_coulomb,& do_potential_id,& @@ -48,7 +47,7 @@ MODULE mp2_eri_gpw USE pw_types, ONLY: pw_c1d_gs_type,& pw_r3d_rs_type USE qs_collocate_density, ONLY: calculate_rho_elec,& - calculate_wavefunction,& + collocate_function,& collocate_single_gaussian USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type @@ -86,7 +85,6 @@ MODULE mp2_eri_gpw ! ************************************************************************************************** !> \brief ... -!> \param mo_coeff ... !> \param psi_L ... !> \param rho_g ... !> \param atomic_kind_set ... @@ -104,11 +102,11 @@ MODULE mp2_eri_gpw !> \param qs_env ... !> \param task_list_sub ... ! ************************************************************************************************** - SUBROUTINE mp2_eri_3c_integrate_gpw(mo_coeff, psi_L, rho_g, atomic_kind_set, qs_kind_set, cell, dft_control, particle_set, & + SUBROUTINE mp2_eri_3c_integrate_gpw(psi_L, rho_g, atomic_kind_set, qs_kind_set, & + cell, dft_control, particle_set, & pw_env_sub, external_vector, poisson_env, rho_r, pot_g, & potential_parameter, mat_munu, qs_env, task_list_sub) - TYPE(cp_fm_type), INTENT(IN) :: mo_coeff TYPE(pw_r3d_rs_type), INTENT(INOUT) :: psi_L TYPE(pw_c1d_gs_type), INTENT(INOUT) :: rho_g TYPE(atomic_kind_type), DIMENSION(:), INTENT(IN), & @@ -136,10 +134,9 @@ SUBROUTINE mp2_eri_3c_integrate_gpw(mo_coeff, psi_L, rho_g, atomic_kind_set, qs_ CALL timeset(routineN, handle) ! pseudo psi_L - CALL calculate_wavefunction(mo_coeff, 1, psi_L, rho_g, atomic_kind_set, & - qs_kind_set, cell, dft_control, particle_set, pw_env_sub, & - basis_type="RI_AUX", & - external_vector=external_vector) + CALL collocate_function(external_vector, psi_L, rho_g, atomic_kind_set, & + qs_kind_set, cell, particle_set, pw_env_sub, & + dft_control%qs_control%eps_rho_rspace, basis_type="RI_AUX") CALL calc_potential_gpw(rho_r, rho_g, poisson_env, pot_g, potential_parameter) @@ -352,7 +349,6 @@ SUBROUTINE mp2_eri_2c_integrate_gpw(qs_env, para_env_sub, my_group_L_start, my_g !> \brief Integrates the potential of a RI function obtaining the forces and stress tensor !> \param rho_r ... !> \param LLL ... -!> \param matrix ... !> \param rho_g ... !> \param atomic_kind_set ... !> \param qs_kind_set ... @@ -375,7 +371,7 @@ SUBROUTINE mp2_eri_2c_integrate_gpw(qs_env, para_env_sub, my_group_L_start, my_g !> \param psi_L ... !> \param factor ... ! ************************************************************************************************** - SUBROUTINE integrate_potential_forces_2c(rho_r, LLL, matrix, rho_g, atomic_kind_set, & + SUBROUTINE integrate_potential_forces_2c(rho_r, LLL, rho_g, atomic_kind_set, & qs_kind_set, particle_set, cell, pw_env_sub, poisson_env, pot_g, & potential_parameter, use_virial, rho_g_copy, dvg, & kind_of, atom_of_kind, G_PQ_local, force, h_stress, para_env_sub, & @@ -383,7 +379,6 @@ SUBROUTINE integrate_potential_forces_2c(rho_r, LLL, matrix, rho_g, atomic_kind_ TYPE(pw_r3d_rs_type), INTENT(INOUT) :: rho_r INTEGER, INTENT(IN) :: LLL - TYPE(cp_fm_type), INTENT(IN) :: matrix TYPE(pw_c1d_gs_type), INTENT(INOUT) :: rho_g TYPE(atomic_kind_type), DIMENSION(:), INTENT(IN), & POINTER :: atomic_kind_set @@ -439,10 +434,10 @@ SUBROUTINE integrate_potential_forces_2c(rho_r, LLL, matrix, rho_g, atomic_kind_ ! hartree potential derivatives CALL pw_zero(psi_L) CALL pw_zero(rho_g) - CALL calculate_wavefunction(matrix, 1, psi_L, rho_g, atomic_kind_set, & - qs_kind_set, cell, dft_control, particle_set, pw_env_sub, & - basis_type="RI_AUX", & - external_vector=0.5_dp*factor*G_PQ_local) + CALL collocate_function(0.5_dp*factor*G_PQ_local, psi_L, rho_g, atomic_kind_set, & + qs_kind_set, cell, particle_set, pw_env_sub, & + dft_control%qs_control%eps_rho_rspace, & + basis_type="RI_AUX") ! transfer to reciprocal space and calculate potential CALL calc_potential_gpw(psi_L, rho_g, poisson_env, pot_g, potential_parameter, no_transfer=.TRUE.) ! update virial with volume term (first calculate hartree like energy (diagonal part of the virial)) diff --git a/src/mp2_gpw.F b/src/mp2_gpw.F index 4939690410..b034ba3a69 100644 --- a/src/mp2_gpw.F +++ b/src/mp2_gpw.F @@ -393,7 +393,7 @@ SUBROUTINE mp2_gpw_main(qs_env, mp2_env, Emp2, Emp2_Cou, Emp2_EX, Emp2_S, Emp2_T CALL mp2_ri_gpw_compute_in( & BIb_C, BIb_C_gw, BIb_C_bse_ij, BIb_C_bse_ab, gd_array, gd_B_virtual, dimen_RI, dimen_RI_red, qs_env, & para_env, para_env_sub, color_sub, cell, particle_set, & - atomic_kind_set, qs_kind_set, mo_coeff, fm_matrix_PQ, fm_matrix_L_kpoints, fm_matrix_Minv_L_kpoints, & + atomic_kind_set, qs_kind_set, fm_matrix_PQ, fm_matrix_L_kpoints, fm_matrix_Minv_L_kpoints, & fm_matrix_Minv, fm_matrix_Minv_Vtrunc_Minv, nmo, homo, mat_munu, sab_orb_sub, & mo_coeff_o, mo_coeff_v, mo_coeff_all, mo_coeff_gw, mo_coeff_o_bse, mo_coeff_v_bse, & mp2_env%mp2_gpw%eps_filter, unit_nr, & @@ -410,7 +410,7 @@ SUBROUTINE mp2_gpw_main(qs_env, mp2_env, Emp2, Emp2_Cou, Emp2_EX, Emp2_S, Emp2_T CALL mp2_ri_gpw_compute_in(BIb_C, BIb_C_gw, BIb_C_bse_ij, BIb_C_bse_ab, gd_array, gd_B_virtual, & dimen_RI, dimen_RI_red, qs_env, para_env, para_env_sub, & color_sub, cell, particle_set, & - atomic_kind_set, qs_kind_set, mo_coeff, fm_matrix_PQ, & + atomic_kind_set, qs_kind_set, fm_matrix_PQ, & fm_matrix_L_kpoints, fm_matrix_Minv_L_kpoints, & fm_matrix_Minv, fm_matrix_Minv_Vtrunc_Minv, nmo, homo, & mat_munu, sab_orb_sub, & @@ -436,7 +436,7 @@ SUBROUTINE mp2_gpw_main(qs_env, mp2_env, Emp2, Emp2_Cou, Emp2_EX, Emp2_S, Emp2_T CALL mp2_gpw_compute( & Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_sub, color_sub, & cell, particle_set, & - atomic_kind_set, qs_kind_set, mo_coeff(1), Eigenval, nmo, homo, mat_munu, & + atomic_kind_set, qs_kind_set, Eigenval, nmo, homo, mat_munu, & sab_orb_sub, mo_coeff_o, mo_coeff_v, mp2_env%mp2_gpw%eps_filter, unit_nr, & mp2_env%mp2_memory, calc_ex, blacs_env_sub, Emp2_AB) @@ -445,7 +445,7 @@ SUBROUTINE mp2_gpw_main(qs_env, mp2_env, Emp2, Emp2_Cou, Emp2_EX, Emp2_S, Emp2_T IF (unit_nr > 0) WRITE (unit_nr, '(T3,A)') 'Beta (ia|' CALL mp2_gpw_compute( & Emp2_BB, Emp2_Cou_BB, Emp2_EX_BB, qs_env, para_env, para_env_sub, color_sub, cell, particle_set, & - atomic_kind_set, qs_kind_set, mo_coeff(2), Eigenval(:, 2:2), nmo, homo(2:2), mat_munu, & + atomic_kind_set, qs_kind_set, Eigenval(:, 2:2), nmo, homo(2:2), mat_munu, & sab_orb_sub, mo_coeff_o(2:2), mo_coeff_v(2:2), mp2_env%mp2_gpw%eps_filter, unit_nr, & mp2_env%mp2_memory, calc_ex, blacs_env_sub) @@ -467,7 +467,7 @@ SUBROUTINE mp2_gpw_main(qs_env, mp2_env, Emp2, Emp2_Cou, Emp2_EX, Emp2_S, Emp2_T ! closed shell case CALL mp2_gpw_compute( & Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_sub, color_sub, cell, particle_set, & - atomic_kind_set, qs_kind_set, mo_coeff(1), Eigenval(:, 1:1), nmo, homo(1:1), mat_munu, & + atomic_kind_set, qs_kind_set, Eigenval(:, 1:1), nmo, homo(1:1), mat_munu, & sab_orb_sub, mo_coeff_o(1:1), mo_coeff_v(1:1), mp2_env%mp2_gpw%eps_filter, unit_nr, & mp2_env%mp2_memory, calc_ex, blacs_env_sub) END IF diff --git a/src/mp2_gpw_method.F b/src/mp2_gpw_method.F index b8d661759e..35221f0ec7 100644 --- a/src/mp2_gpw_method.F +++ b/src/mp2_gpw_method.F @@ -49,7 +49,7 @@ MODULE mp2_gpw_method USE pw_pool_types, ONLY: pw_pool_type USE pw_types, ONLY: pw_c1d_gs_type,& pw_r3d_rs_type - USE qs_collocate_density, ONLY: calculate_wavefunction + USE qs_collocate_density, ONLY: collocate_function USE qs_environment_types, ONLY: qs_environment_type USE qs_integrate_potential, ONLY: integrate_v_rspace USE qs_kind_types, ONLY: qs_kind_type @@ -80,7 +80,6 @@ MODULE mp2_gpw_method !> \param particle_set ... !> \param atomic_kind_set ... !> \param qs_kind_set ... -!> \param mo_coeff ... !> \param Eigenval ... !> \param nmo ... !> \param homo ... @@ -96,7 +95,7 @@ MODULE mp2_gpw_method !> \param Emp2_AB ... ! ************************************************************************************************** SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_sub, color_sub, & - cell, particle_set, atomic_kind_set, qs_kind_set, mo_coeff, Eigenval, nmo, homo, & + cell, particle_set, atomic_kind_set, qs_kind_set, Eigenval, nmo, homo, & mat_munu, sab_orb_sub, mo_coeff_o, mo_coeff_v, eps_filter, unit_nr, & mp2_memory, calc_ex, blacs_env_sub, Emp2_AB) @@ -108,7 +107,6 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s TYPE(particle_type), DIMENSION(:), POINTER :: particle_set TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set - TYPE(cp_fm_type), INTENT(IN) :: mo_coeff REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: Eigenval INTEGER, INTENT(IN) :: nmo INTEGER, DIMENSION(:), INTENT(IN) :: homo @@ -361,9 +359,9 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s ALLOCATE (psi_i(my_I_occupied_start:my_I_occupied_end)) DO i = my_I_occupied_start, my_I_occupied_end CALL auxbas_pw_pool%create_pw(psi_i(i)) - CALL calculate_wavefunction(mo_coeff, i, psi_i(i), rho_g, atomic_kind_set, & - qs_kind_set, cell, dft_control, particle_set, & - pw_env_sub, external_vector=my_Cocc(:, i - my_I_occupied_start + 1)) + CALL collocate_function(my_Cocc(:, i - my_I_occupied_start + 1), & + psi_i(i), rho_g, atomic_kind_set, qs_kind_set, cell, particle_set, & + pw_env_sub, dft_control%qs_control%eps_rho_rspace) END DO Emp2 = 0.0_dp @@ -380,9 +378,9 @@ SUBROUTINE mp2_gpw_compute(Emp2, Emp2_Cou, Emp2_EX, qs_env, para_env, para_env_s IF (calc_ex) BIb_C = 0.0_dp ! psi_a - CALL calculate_wavefunction(mo_coeff, a, psi_a, rho_g, atomic_kind_set, & - qs_kind_set, cell, dft_control, particle_set, & - pw_env_sub, external_vector=my_Cvirt(:, a - (homo(1) + my_A_virtual_start) + 1)) + CALL collocate_function(my_Cvirt(:, a - (homo(1) + my_A_virtual_start) + 1), & + psi_a, rho_g, atomic_kind_set, qs_kind_set, cell, particle_set, & + pw_env_sub, dft_control%qs_control%eps_rho_rspace) i_counter = 0 DO i = my_I_occupied_start, my_I_occupied_end i_counter = i_counter + 1 diff --git a/src/mp2_integrals.F b/src/mp2_integrals.F index c3a1e8ec2c..8852a5655b 100644 --- a/src/mp2_integrals.F +++ b/src/mp2_integrals.F @@ -139,7 +139,6 @@ MODULE mp2_integrals !> \param particle_set ... !> \param atomic_kind_set ... !> \param qs_kind_set ... -!> \param mo_coeff ... !> \param fm_matrix_PQ ... !> \param fm_matrix_L_kpoints ... !> \param fm_matrix_Minv_L_kpoints ... @@ -185,7 +184,7 @@ MODULE mp2_integrals ! ************************************************************************************************** SUBROUTINE mp2_ri_gpw_compute_in(BIb_C, BIb_C_gw, BIb_C_bse_ij, BIb_C_bse_ab, gd_array, gd_B_virtual, & dimen_RI, dimen_RI_red, qs_env, para_env, para_env_sub, color_sub, & - cell, particle_set, atomic_kind_set, qs_kind_set, mo_coeff, & + cell, particle_set, atomic_kind_set, qs_kind_set, & fm_matrix_PQ, fm_matrix_L_kpoints, fm_matrix_Minv_L_kpoints, & fm_matrix_Minv, fm_matrix_Minv_Vtrunc_Minv, & nmo, homo, mat_munu, & @@ -215,7 +214,6 @@ SUBROUTINE mp2_ri_gpw_compute_in(BIb_C, BIb_C_gw, BIb_C_bse_ij, BIb_C_bse_ab, gd TYPE(particle_type), DIMENSION(:), POINTER :: particle_set TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set - TYPE(cp_fm_type), DIMENSION(:), INTENT(IN) :: mo_coeff TYPE(cp_fm_type), INTENT(OUT) :: fm_matrix_PQ TYPE(cp_fm_type), ALLOCATABLE, DIMENSION(:, :) :: fm_matrix_L_kpoints, & fm_matrix_Minv_L_kpoints, & @@ -612,7 +610,7 @@ SUBROUTINE mp2_ri_gpw_compute_in(BIb_C, BIb_C_gw, BIb_C_bse_ij, BIb_C_bse_ab, gd DO i_counter = 1, my_group_L_size - CALL mp2_eri_3c_integrate_gpw(mo_coeff(1), psi_L, rho_g, atomic_kind_set, qs_kind_set, cell, dft_control, & + CALL mp2_eri_3c_integrate_gpw(psi_L, rho_g, atomic_kind_set, qs_kind_set, cell, dft_control, & particle_set, pw_env_sub, my_Lrows(:, i_counter), poisson_env, rho_r, pot_g, & ri_metric, mat_munu, qs_env, task_list_sub) diff --git a/src/mp2_ri_grad.F b/src/mp2_ri_grad.F index 2c8809251c..5f846012b4 100644 --- a/src/mp2_ri_grad.F +++ b/src/mp2_ri_grad.F @@ -361,7 +361,7 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par G_P_ia(:, L_counter), matrix_P_inu, & mo_coeff_v, mo_coeff_o, eps_filter) - CALL integrate_potential_forces_2c(rho_r, LLL, mo_coeff(1), rho_g, atomic_kind_set, & + CALL integrate_potential_forces_2c(rho_r, LLL, rho_g, atomic_kind_set, & qs_kind_set, particle_set, cell, pw_env_sub, poisson_env, & pot_g, mp2_env%potential_parameter, use_virial, & rho_g_copy, dvg, kind_of, atom_of_kind, G_PQ_local(:, L_counter), & @@ -369,7 +369,7 @@ SUBROUTINE calc_ri_mp2_nonsep(qs_env, mp2_env, para_env, para_env_sub, cell, par IF (.NOT. compare_potential_types(mp2_env%ri_metric, mp2_env%potential_parameter)) THEN - CALL integrate_potential_forces_2c(rho_r, LLL, mo_coeff(1), rho_g, atomic_kind_set, & + CALL integrate_potential_forces_2c(rho_r, LLL, rho_g, atomic_kind_set, & qs_kind_set, particle_set, cell, pw_env_sub, poisson_env, & pot_g, mp2_env%ri_metric, use_virial, & rho_g_copy, dvg, kind_of, atom_of_kind, G_PQ_local_2(:, L_counter), & diff --git a/src/optimize_embedding_potential.F b/src/optimize_embedding_potential.F index dc6bc228ae..8a8099b0f1 100644 --- a/src/optimize_embedding_potential.F +++ b/src/optimize_embedding_potential.F @@ -71,7 +71,8 @@ MODULE optimize_embedding_potential USE pw_types, ONLY: pw_c1d_gs_type,& pw_r3d_rs_type USE qs_collocate_density, ONLY: calculate_rho_resp_all,& - calculate_wavefunction + calculate_wavefunction,& + collocate_function USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type,& set_qs_env @@ -1791,10 +1792,10 @@ SUBROUTINE update_embed_pot(embed_pot_coef, dimen_aux, embed_pot, spin_embed_pot CALL para_env%sum(wf_vector) ! Calculate the variable part of the embedding potential - CALL calculate_wavefunction(mo_coeff, 1, psi_L, rho_g, atomic_kind_set, & - qs_kind_set, cell, dft_control, particle_set, pw_env, & - basis_type="RI_AUX", & - external_vector=wf_vector) + CALL collocate_function(wf_vector, psi_L, rho_g, atomic_kind_set, & + qs_kind_set, cell, particle_set, pw_env, & + dft_control%qs_control%eps_rho_rspace, & + basis_type="RI_AUX") ! Update the full embedding potential IF (add_const_pot) THEN CALL pw_copy(const_pot, embed_pot) @@ -1818,10 +1819,10 @@ SUBROUTINE update_embed_pot(embed_pot_coef, dimen_aux, embed_pot, spin_embed_pot CALL para_env%sum(wf_vector) ! Calculate the variable part of the embedding potential - CALL calculate_wavefunction(mo_coeff, 1, psi_L, rho_g, atomic_kind_set, & - qs_kind_set, cell, dft_control, particle_set, pw_env, & - basis_type="RI_AUX", & - external_vector=wf_vector) + CALL collocate_function(wf_vector, psi_L, rho_g, atomic_kind_set, & + qs_kind_set, cell, particle_set, pw_env, & + dft_control%qs_control%eps_rho_rspace, & + basis_type="RI_AUX") ! No constant potential for spin-dependent potential CALL pw_zero(spin_embed_pot) CALL pw_axpy(psi_L, spin_embed_pot) @@ -1843,10 +1844,10 @@ SUBROUTINE update_embed_pot(embed_pot_coef, dimen_aux, embed_pot, spin_embed_pot CALL calculate_wavefunction(mo_coeff, 1, psi_L, rho_g, atomic_kind_set, & qs_kind_set, cell, dft_control, particle_set, pw_env) - CALL calculate_wavefunction(mo_coeff, 1, psi_L, rho_g, atomic_kind_set, & - qs_kind_set, cell, dft_control, particle_set, pw_env, & - basis_type="RI_AUX", & - external_vector=wf_vector) + CALL collocate_function(wf_vector, psi_L, rho_g, atomic_kind_set, & + qs_kind_set, cell, particle_set, pw_env, & + dft_control%qs_control%eps_rho_rspace, & + basis_type="RI_AUX") ! Update the full embedding potential IF (add_const_pot) THEN diff --git a/src/qs_collocate_density.F b/src/qs_collocate_density.F index c027a6f9e0..a011323980 100644 --- a/src/qs_collocate_density.F +++ b/src/qs_collocate_density.F @@ -84,9 +84,9 @@ MODULE qs_collocate_density pw_pool_type, & pw_pools_create_pws, & pw_pools_give_back_pws - USE pw_types, ONLY: & - pw_r3d_rs_type, & - pw_c1d_gs_type, pw_r3d_rs_type + USE pw_types, ONLY: pw_r3d_rs_type, & + pw_c1d_gs_type, & + pw_r3d_rs_type USE qs_environment_types, ONLY: get_qs_env, & qs_environment_type USE qs_kind_types, ONLY: get_qs_kind, & @@ -129,6 +129,7 @@ MODULE qs_collocate_density calculate_rho_elec, & calculate_drho_elec, & calculate_wavefunction, & + collocate_function, & calculate_rho_nlcc, & calculate_drho_elec_dR, & calculate_drho_core, & @@ -2607,26 +2608,18 @@ END SUBROUTINE collocate_single_gaussian !> \param particle_set ... !> \param pw_env ... !> \param basis_type ... -!> \param external_vector ... !> \par History !> 08.2002 created [Joost VandeVondele] !> 03.2006 made independent of qs_env [Joost VandeVondele] -!> \note -!> modified calculate_rho_elec, should write the wavefunction represented by -!> it's presumably dominated by the FFT and the rs->pw and back routines -!> -!> BUGS ??? -!> does it take correctly the periodic images of the basis functions into account -!> i.e. is only correct if the basis functions are localised enough to be just in 1 cell ? +!> 08.2024 call collocate_function [JGH] ! ************************************************************************************************** SUBROUTINE calculate_wavefunction(mo_vectors, ivector, rho, rho_gspace, & atomic_kind_set, qs_kind_set, cell, dft_control, particle_set, & - pw_env, basis_type, external_vector) - + pw_env, basis_type) TYPE(cp_fm_type), INTENT(IN) :: mo_vectors INTEGER, INTENT(IN) :: ivector - TYPE(pw_r3d_rs_type), INTENT(INOUT) :: rho - TYPE(pw_c1d_gs_type), INTENT(INOUT) :: rho_gspace + TYPE(pw_r3d_rs_type), INTENT(INOUT) :: rho + TYPE(pw_c1d_gs_type), INTENT(INOUT) :: rho_gspace TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(cell_type), POINTER :: cell @@ -2634,52 +2627,98 @@ SUBROUTINE calculate_wavefunction(mo_vectors, ivector, rho, rho_gspace, & TYPE(particle_type), DIMENSION(:), POINTER :: particle_set TYPE(pw_env_type), POINTER :: pw_env CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: basis_type - REAL(KIND=dp), DIMENSION(:), OPTIONAL :: external_vector CHARACTER(LEN=*), PARAMETER :: routineN = 'calculate_wavefunction' + INTEGER :: handle, i, nao + LOGICAL :: local + REAL(KIND=dp) :: eps_rho_rspace + REAL(KIND=dp), DIMENSION(:), POINTER :: eigenvector + + CALL timeset(routineN, handle) + + CALL cp_fm_get_info(matrix=mo_vectors, nrow_global=nao) + ALLOCATE (eigenvector(nao)) + DO i = 1, nao + CALL cp_fm_get_element(mo_vectors, i, ivector, eigenvector(i), local) + END DO + + eps_rho_rspace = dft_control%qs_control%eps_rho_rspace + + CALL collocate_function(eigenvector, rho, rho_gspace, & + atomic_kind_set, qs_kind_set, cell, particle_set, pw_env, & + eps_rho_rspace, basis_type) + + DEALLOCATE (eigenvector) + + CALL timestop(handle) + + END SUBROUTINE calculate_wavefunction + +! ************************************************************************************************** +!> \brief maps a given function on the grid +!> \param vector ... +!> \param rho ... +!> \param rho_gspace ... +!> \param atomic_kind_set ... +!> \param qs_kind_set ... +!> \param cell ... +!> \param particle_set ... +!> \param pw_env ... +!> \param eps_rho_rspace ... +!> \param basis_type ... +!> \par History +!> 08.2002 created [Joost VandeVondele] +!> 03.2006 made independent of qs_env [Joost VandeVondele] +!> 08.2024 specialized version from calculate_wavefunction [JGH] +!> \notes +!> modified calculate_rho_elec, should write the wavefunction represented by vector +!> it's presumably dominated by the FFT and the rs->pw and back routines +! ************************************************************************************************** + SUBROUTINE collocate_function(vector, rho, rho_gspace, & + atomic_kind_set, qs_kind_set, cell, particle_set, pw_env, & + eps_rho_rspace, basis_type) + REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: vector + TYPE(pw_r3d_rs_type), INTENT(INOUT) :: rho + TYPE(pw_c1d_gs_type), INTENT(INOUT) :: rho_gspace + TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set + TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set + TYPE(cell_type), POINTER :: cell + TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(pw_env_type), POINTER :: pw_env + REAL(KIND=dp), INTENT(IN) :: eps_rho_rspace + CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: basis_type + + CHARACTER(LEN=*), PARAMETER :: routineN = 'collocate_function' + CHARACTER(LEN=default_string_length) :: my_basis_type INTEGER :: group_size, handle, i, iatom, igrid_level, ikind, ipgf, iset, maxco, maxsgf_set, & - my_pos, na1, na2, nao, natom, ncoa, nseta, offset, sgfa + my_pos, na1, na2, natom, ncoa, nseta, offset, sgfa INTEGER, ALLOCATABLE, DIMENSION(:) :: where_is_the_point INTEGER, DIMENSION(:), POINTER :: la_max, la_min, npgfa, nsgfa INTEGER, DIMENSION(:, :), POINTER :: first_sgfa - LOGICAL :: local - REAL(KIND=dp) :: dab, eps_rho_rspace, radius, scale + REAL(KIND=dp) :: dab, radius, scale REAL(KIND=dp), DIMENSION(3) :: ra - REAL(KIND=dp), DIMENSION(:), POINTER :: eigenvector REAL(KIND=dp), DIMENSION(:, :), POINTER :: pab, sphi_a, work, zeta TYPE(gridlevel_info_type), POINTER :: gridlevel_info TYPE(gto_basis_set_type), POINTER :: orb_basis_set TYPE(mp_comm_type) :: group TYPE(pw_pool_p_type), DIMENSION(:), POINTER :: pw_pools - TYPE(pw_c1d_gs_type), ALLOCATABLE, DIMENSION(:) :: mgrid_gspace - TYPE(pw_r3d_rs_type), ALLOCATABLE, DIMENSION(:) :: mgrid_rspace + TYPE(pw_c1d_gs_type), ALLOCATABLE, DIMENSION(:) :: mgrid_gspace + TYPE(pw_r3d_rs_type), ALLOCATABLE, DIMENSION(:) :: mgrid_rspace TYPE(realspace_grid_type), DIMENSION(:), POINTER :: rs_rho + CALL timeset(routineN, handle) + IF (PRESENT(basis_type)) THEN my_basis_type = basis_type ELSE my_basis_type = "ORB" END IF - CALL timeset(routineN, handle) - - NULLIFY (eigenvector, orb_basis_set, pab, work, la_max, la_min, & + NULLIFY (orb_basis_set, pab, work, la_max, la_min, & npgfa, nsgfa, sphi_a, zeta, first_sgfa, rs_rho, pw_pools) - IF (PRESENT(external_vector)) THEN - nao = SIZE(external_vector) - ALLOCATE (eigenvector(nao)) - eigenvector = external_vector - ELSE - CALL cp_fm_get_info(matrix=mo_vectors, nrow_global=nao) - ALLOCATE (eigenvector(nao)) - DO i = 1, nao - CALL cp_fm_get_element(mo_vectors, i, ivector, eigenvector(i), local) - END DO - END IF - ! *** set up the pw multi-grids CPASSERT(ASSOCIATED(pw_env)) CALL pw_env_get(pw_env, rs_grids=rs_rho, pw_pools=pw_pools, & @@ -2693,8 +2732,7 @@ SUBROUTINE calculate_wavefunction(mo_vectors, ivector, rho, rho_gspace, & CALL rs_grid_zero(rs_rho(igrid_level)) END DO - eps_rho_rspace = dft_control%qs_control%eps_rho_rspace -! *** Allocate work storage *** + ! *** Allocate work storage *** CALL get_atomic_kind_set(atomic_kind_set, natom=natom) CALL get_qs_kind_set(qs_kind_set, & maxco=maxco, & @@ -2731,7 +2769,7 @@ SUBROUTINE calculate_wavefunction(mo_vectors, ivector, rho, rho_gspace, & sgfa = first_sgfa(1, iset) DO i = 1, nsgfa(iset) - work(i, 1) = eigenvector(offset + i) + work(i, 1) = vector(offset + i) END DO CALL dgemm("N", "N", ncoa, 1, nsgfa(iset), & @@ -2783,10 +2821,7 @@ SUBROUTINE calculate_wavefunction(mo_vectors, ivector, rho, rho_gspace, & CALL pw_transfer(rho_gspace, rho) ! Release work storage - DEALLOCATE (eigenvector) - DEALLOCATE (pab) - DEALLOCATE (work) ! give back the pw multi-grids @@ -2795,6 +2830,6 @@ SUBROUTINE calculate_wavefunction(mo_vectors, ivector, rho, rho_gspace, & CALL timestop(handle) - END SUBROUTINE calculate_wavefunction + END SUBROUTINE collocate_function END MODULE qs_collocate_density diff --git a/src/rpa_im_time_force_methods.F b/src/rpa_im_time_force_methods.F index 6d5df5d34f..0006294a0a 100644 --- a/src/rpa_im_time_force_methods.F +++ b/src/rpa_im_time_force_methods.F @@ -115,7 +115,7 @@ MODULE rpa_im_time_force_methods USE pw_types, ONLY: pw_c1d_gs_type,& pw_r3d_rs_type USE qs_collocate_density, ONLY: calculate_rho_elec,& - calculate_wavefunction + collocate_function USE qs_density_matrices, ONLY: calculate_whz_matrix USE qs_energy_matrix_w, ONLY: qs_energies_compute_w USE qs_environment_types, ONLY: get_qs_env,& @@ -2832,9 +2832,9 @@ SUBROUTINE get_2c_gpw_forces(G_PQ, force, h_stress, use_virial, mp2_env, qs_env) wf_vector = 0.0_dp wf_vector(j_RI) = 1.0_dp - CALL calculate_wavefunction(mos(1)%mo_coeff, 1, psi_L, rho_g, atomic_kind_set, & - qs_kind_set, cell, dft_control, particle_set, pw_env_ext, & - basis_type="RI_AUX", external_vector=wf_vector) + CALL collocate_function(wf_vector, psi_L, rho_g, atomic_kind_set, qs_kind_set, cell, & + particle_set, pw_env_ext, dft_control%qs_control%eps_rho_rspace, & + basis_type="RI_AUX") IF (use_virial) THEN CALL calc_potential_gpw(rho_r, rho_g, poisson_env, pot_g, mp2_env%potential_parameter, dvg) @@ -2854,9 +2854,9 @@ SUBROUTINE get_2c_gpw_forces(G_PQ, force, h_stress, use_virial, mp2_env, qs_env) END DO CALL pw_copy(rho_g, rho_g_copy) - CALL calculate_wavefunction(mos(1)%mo_coeff, 1, psi_L, rho_g, atomic_kind_set, & - qs_kind_set, cell, dft_control, particle_set, pw_env_ext, & - basis_type="RI_AUX", external_vector=wf_vector) + CALL collocate_function(wf_vector, psi_L, rho_g, atomic_kind_set, qs_kind_set, cell, & + particle_set, pw_env_ext, dft_control%qs_control%eps_rho_rspace, & + basis_type="RI_AUX") CALL calc_potential_gpw(psi_L, rho_g, poisson_env, pot_g, mp2_env%potential_parameter, & no_transfer=.TRUE.) diff --git a/src/scf_control_types.F b/src/scf_control_types.F index c926ef3bb5..2627158c31 100644 --- a/src/scf_control_types.F +++ b/src/scf_control_types.F @@ -155,7 +155,7 @@ MODULE scf_control_types ! ************************************************************************************************** SUBROUTINE scf_c_create(scf_control) - TYPE(scf_control_type), INTENT(OUT) :: scf_control + TYPE(scf_control_type), INTENT(INOUT) :: scf_control CHARACTER(LEN=*), PARAMETER :: routineN = 'scf_c_create'