From 51cc574b6badb32c012f12eaf01d280b1031d576 Mon Sep 17 00:00:00 2001 From: abussy Date: Thu, 9 Sep 2021 18:34:19 +0200 Subject: [PATCH] RI-HFX forces --- src/hfx_admm_utils.F | 66 +- src/hfx_ri.F | 1919 ++++++++++++++++- src/hfx_types.F | 72 +- src/input_cp2k_hfx.F | 4 +- src/libint_2c_3c.F | 594 ++++- src/libint_wrapper.F | 136 +- src/mp2.F | 2 + src/mp2_cphf.F | 25 +- src/qs_linres_kernel.F | 24 +- src/qs_tddfpt2_fhxc_forces.F | 2 + src/qs_tddfpt2_forces.F | 2 + src/qs_tensors.F | 1395 +++++++++++- src/response_solver.F | 102 +- src/rpa_axk.F | 32 +- src/rpa_gw_sigma.F | 37 +- src/rpa_hfx.F | 23 +- src/rpa_rse.F | 38 +- src/xc_adiabatic_utils.F | 8 +- tests/QS/regtest-hfx-ri-2/CH-hfx-ri-mo.inp | 61 + tests/QS/regtest-hfx-ri-2/CH-hfx-ri-rho.inp | 58 + tests/QS/regtest-hfx-ri-2/CH3-b3lyp-ADMM.inp | 75 + .../H2O-hfx-stress-identity.inp | 59 + .../H2O-pbe0-stress-truncated.inp | 65 + .../regtest-hfx-ri-2/Ne-hfx-pbc-metric-mo.inp | 63 + .../Ne-hfx-pbc-metric-rho.inp | 63 + tests/QS/regtest-hfx-ri-2/TEST_FILES | 9 + tests/QS/regtest-hfx-ri/CH3-ADMM.inp | 2 +- tests/QS/regtest-hfx-ri/CH3-hfx-converged.inp | 2 +- .../H2O-hfx-periodic-ri-truncated.inp | 2 +- .../Ne-hybrid-periodic-shortrange.inp | 2 +- tests/QS/regtest-mp2-grad/H2O_grad_ri-hfx.inp | 103 + tests/QS/regtest-mp2-grad/O2_dyn_ri-hfx.inp | 94 + tests/QS/regtest-mp2-grad/TEST_FILES | 2 + .../Cubic_RPA_CH3_ri-hfx.inp | 85 + .../Cubic_RPA_H2O_ri-hfx.inp | 82 + tests/QS/regtest-rpa-cubic-scaling/TEST_FILES | 2 + tests/TEST_DIRS | 1 + 37 files changed, 5058 insertions(+), 253 deletions(-) create mode 100644 tests/QS/regtest-hfx-ri-2/CH-hfx-ri-mo.inp create mode 100644 tests/QS/regtest-hfx-ri-2/CH-hfx-ri-rho.inp create mode 100644 tests/QS/regtest-hfx-ri-2/CH3-b3lyp-ADMM.inp create mode 100644 tests/QS/regtest-hfx-ri-2/H2O-hfx-stress-identity.inp create mode 100644 tests/QS/regtest-hfx-ri-2/H2O-pbe0-stress-truncated.inp create mode 100644 tests/QS/regtest-hfx-ri-2/Ne-hfx-pbc-metric-mo.inp create mode 100644 tests/QS/regtest-hfx-ri-2/Ne-hfx-pbc-metric-rho.inp create mode 100644 tests/QS/regtest-hfx-ri-2/TEST_FILES create mode 100644 tests/QS/regtest-mp2-grad/H2O_grad_ri-hfx.inp create mode 100644 tests/QS/regtest-mp2-grad/O2_dyn_ri-hfx.inp create mode 100644 tests/QS/regtest-rpa-cubic-scaling/Cubic_RPA_CH3_ri-hfx.inp create mode 100644 tests/QS/regtest-rpa-cubic-scaling/Cubic_RPA_H2O_ri-hfx.inp diff --git a/src/hfx_admm_utils.F b/src/hfx_admm_utils.F index 8250431aae..760e3bdb40 100644 --- a/src/hfx_admm_utils.F +++ b/src/hfx_admm_utils.F @@ -38,13 +38,15 @@ MODULE hfx_admm_utils USE hfx_derivatives, ONLY: derivatives_four_center USE hfx_energy_potential, ONLY: integrate_four_center USE hfx_pw_methods, ONLY: pw_hfx - USE hfx_ri, ONLY: hfx_ri_update_ks + USE hfx_ri, ONLY: hfx_ri_update_forces,& + hfx_ri_update_ks USE hfx_types, ONLY: hfx_type USE input_constants, ONLY: & do_admm_aux_exch_func_bee, do_admm_aux_exch_func_default, do_admm_aux_exch_func_none, & do_admm_aux_exch_func_opt, do_admm_aux_exch_func_pbex, do_potential_coulomb, & do_potential_long, do_potential_mix_cl, do_potential_mix_cl_trunc, do_potential_short, & do_potential_truncated, xc_funct_no_shortcut, xc_none + USE input_cp2k_hfx, ONLY: ri_mo USE input_section_types, ONLY: section_vals_duplicate,& section_vals_get,& section_vals_get_subs_vals,& @@ -421,10 +423,6 @@ CONTAINS ! Finally the real hfx calulation ehfx = 0.0_dp - IF (x_data(irep, 1)%do_hfx_ri .AND. calculate_forces) THEN - CPABORT("RI forces not yet implemented in HFX") - ENDIF - IF (x_data(irep, 1)%do_hfx_ri) THEN CALL hfx_ri_update_ks(qs_env, x_data(irep, 1)%ri_data, matrix_ks_orb, ehfx, & mo_array, rho_ao_orb, & @@ -432,11 +430,12 @@ CONTAINS x_data(irep, 1)%general_parameter%fraction) IF (dft_control%do_admm) THEN !for ADMMS, we need the exchange matrix k(d) for both spins - DO ispin = 1, mspin + DO ispin = 1, nspins CALL dbcsr_copy(matrix_ks_aux_fit_hfx(ispin)%matrix, matrix_ks_orb(ispin, 1)%matrix, & name="HF exch. part of matrix_ks_aux_fit for ADMMS") ENDDO END IF + ELSE DO ispin = 1, mspin @@ -461,8 +460,22 @@ CONTAINS ELSE NULLIFY (rho_ao_resp) END IF - CALL derivatives_four_center(qs_env, rho_ao_orb, rho_ao_resp, hfx_sections, & - para_env, irep, use_virial) + + IF (x_data(irep, 1)%do_hfx_ri) THEN + + CALL hfx_ri_update_forces(qs_env, x_data(irep, 1)%ri_data, nspins, & + x_data(irep, 1)%general_parameter%fraction, & + rho_ao=rho_ao_orb, mos=mo_array, & + rho_ao_resp=rho_ao_resp, & + use_virial=use_virial) + + ELSE + + CALL derivatives_four_center(qs_env, rho_ao_orb, rho_ao_resp, hfx_sections, & + para_env, irep, use_virial) + + END IF + !Scale auxiliary density matrix for ADMMP back with 1/gsi(ispin) IF (dft_control%do_admm) THEN CALL scale_dm(qs_env, rho_ao_orb, scale_back=.TRUE.) @@ -506,7 +519,7 @@ CONTAINS x_data(irep, 1)%general_parameter%fraction) IF (dft_control%do_admm) THEN !for ADMMS, we need the exchange matrix k(d) for both spins - DO ispin = 1, mspin + DO ispin = 1, nspins CALL dbcsr_copy(matrix_ks_aux_fit_hfx(ispin)%matrix, matrix_ks_orb(ispin, 1)%matrix, & name="HF exch. part of matrix_ks_aux_fit for ADMMS") ENDDO @@ -523,8 +536,18 @@ CONTAINS IF (calculate_forces .AND. .NOT. do_adiabatic_rescaling) THEN NULLIFY (rho_ao_resp) - CALL derivatives_four_center(qs_env, rho_ao_orb, rho_ao_resp, hfx_sections, & - para_env, irep, use_virial) + + IF (x_data(irep, 1)%do_hfx_ri) THEN + + CALL hfx_ri_update_forces(qs_env, x_data(irep, 1)%ri_data, nspins, & + x_data(irep, 1)%general_parameter%fraction, & + rho_ao=rho_ao_orb, mos=mo_array, & + use_virial=use_virial) + + ELSE + CALL derivatives_four_center(qs_env, rho_ao_orb, rho_ao_resp, hfx_sections, & + para_env, irep, use_virial) + END IF END IF !! If required, the calculation of the forces will be done later with adiabatic rescaling @@ -1211,11 +1234,22 @@ CONTAINS DO irep = 1, n_rep_hf ! the real hfx calulation ehfx = 0.0_dp - DO ispin = 1, mspin - CALL integrate_four_center(qs_env, x_data, matrix_ks_kp, eh1, rho_ao_kp, hfx_sections, para_env, & - s_mstruct_changed, irep, distribute_fock_matrix, ispin=ispin) - ehfx = ehfx + eh1 - END DO + + IF (x_data(irep, 1)%do_hfx_ri) THEN + IF (x_data(irep, 1)%ri_data%flavor == ri_mo) THEN + CPABORT("NYI with RI_FLAVOR MO") + END IF + CALL hfx_ri_update_ks(qs_env, x_data(irep, 1)%ri_data, matrix_ks_kp, ehfx, & + rho_ao=rho_ao_kp, geometry_did_change=s_mstruct_changed, & + nspins=nspins, hf_fraction=x_data(irep, 1)%general_parameter%fraction) + + ELSE + DO ispin = 1, mspin + CALL integrate_four_center(qs_env, x_data, matrix_ks_kp, eh1, rho_ao_kp, hfx_sections, para_env, & + s_mstruct_changed, irep, distribute_fock_matrix, ispin=ispin) + ehfx = ehfx + eh1 + END DO + END IF END DO IF (my_update_energy) energy%ex = ehfx diff --git a/src/hfx_ri.F b/src/hfx_ri.F index a82f5ca8ed..901092ae5d 100644 --- a/src/hfx_ri.F +++ b/src/hfx_ri.F @@ -12,9 +12,12 @@ MODULE hfx_ri USE arnoldi_api, ONLY: arnoldi_extremal - USE atomic_kind_types, ONLY: atomic_kind_type + USE atomic_kind_types, ONLY: atomic_kind_type,& + get_atomic_kind_set USE basis_set_types, ONLY: gto_basis_set_p_type,& gto_basis_set_type + USE cell_types, ONLY: cell_type,& + real_to_scaled USE cp_array_utils, ONLY: cp_1d_r_p_type USE cp_blacs_env, ONLY: cp_blacs_env_type USE cp_control_types, ONLY: dft_control_type @@ -34,17 +37,23 @@ MODULE hfx_ri dbcsr_add, dbcsr_add_on_diag, dbcsr_copy, dbcsr_create, dbcsr_distribution_get, & dbcsr_distribution_release, dbcsr_distribution_type, dbcsr_dot, dbcsr_filter, & dbcsr_frobenius_norm, dbcsr_get_info, dbcsr_get_num_blocks, dbcsr_multiply, dbcsr_p_type, & - dbcsr_release, dbcsr_scalar, dbcsr_scale, dbcsr_type, dbcsr_type_no_symmetry, & - dbcsr_type_symmetric + dbcsr_release, dbcsr_scalar, dbcsr_scale, dbcsr_type, dbcsr_type_antisymmetric, & + dbcsr_type_no_symmetry, dbcsr_type_symmetric USE dbcsr_tensor_api, ONLY: & dbcsr_t_batched_contract_finalize, dbcsr_t_batched_contract_init, dbcsr_t_clear, & dbcsr_t_contract, dbcsr_t_copy, dbcsr_t_copy_matrix_to_tensor, & dbcsr_t_copy_tensor_to_matrix, dbcsr_t_create, dbcsr_t_destroy, dbcsr_t_filter, & - dbcsr_t_get_info, dbcsr_t_get_num_blocks, dbcsr_t_get_num_blocks_total, & - dbcsr_t_mp_environ_pgrid, dbcsr_t_nd_mp_comm, dbcsr_t_pgrid_create, dbcsr_t_pgrid_destroy, & - dbcsr_t_pgrid_type, dbcsr_t_reserved_block_indices, dbcsr_t_type + dbcsr_t_get_block, dbcsr_t_get_info, dbcsr_t_get_num_blocks, dbcsr_t_get_num_blocks_total, & + dbcsr_t_iterator_blocks_left, dbcsr_t_iterator_next_block, dbcsr_t_iterator_start, & + dbcsr_t_iterator_stop, dbcsr_t_iterator_type, dbcsr_t_mp_environ_pgrid, & + dbcsr_t_nd_mp_comm, dbcsr_t_pgrid_create, dbcsr_t_pgrid_destroy, dbcsr_t_pgrid_type, & + dbcsr_t_reserved_block_indices, dbcsr_t_type USE distribution_2d_types, ONLY: distribution_2d_type - USE hfx_types, ONLY: hfx_ri_type + USE hfx_types, ONLY: alloc_containers,& + block_ind_type,& + dealloc_containers,& + hfx_compression_type,& + hfx_ri_type USE input_constants, ONLY: hfx_ri_do_2c_cholesky,& hfx_ri_do_2c_diag,& hfx_ri_do_2c_iter @@ -64,6 +73,7 @@ MODULE hfx_ri USE particle_types, ONLY: particle_type USE qs_environment_types, ONLY: get_qs_env,& qs_environment_type + USE qs_force_types, ONLY: qs_force_type USE qs_integral_utils, ONLY: basis_set_list_setup USE qs_interactions, ONLY: init_interaction_radii_orb_basis USE qs_kind_types, ONLY: qs_kind_type @@ -79,14 +89,10 @@ MODULE hfx_ri mo_set_type USE qs_neighbor_list_types, ONLY: neighbor_list_set_p_type,& release_neighbor_list_sets - USE qs_tensors, ONLY: build_2c_integrals,& - build_2c_neighbor_lists,& - build_3c_integrals,& - build_3c_neighbor_lists,& - compress_tensor,& - decompress_tensor,& - get_tensor_occupancy,& - neighbor_list_3c_destroy + USE qs_tensors, ONLY: & + build_2c_derivatives, build_2c_integrals, build_2c_neighbor_lists, build_3c_derivatives, & + build_3c_integrals, build_3c_neighbor_lists, compress_tensor, decompress_tensor, & + get_tensor_occupancy, neighbor_list_3c_destroy USE qs_tensors_types, ONLY: create_2c_tensor,& create_3c_tensor,& create_tensor_batches,& @@ -95,12 +101,13 @@ MODULE hfx_ri neighbor_list_3c_type,& split_block_sizes USE util, ONLY: sort + USE virial_types, ONLY: virial_type #include "./base/base_uses.f90" IMPLICIT NONE PRIVATE - PUBLIC :: hfx_ri_update_ks + PUBLIC :: hfx_ri_update_ks, hfx_ri_update_forces CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'hfx_ri' CONTAINS @@ -127,11 +134,10 @@ CONTAINS REAL(KIND=dp) :: threshold TYPE(cp_blacs_env_type), POINTER :: blacs_env TYPE(cp_para_env_type), POINTER :: para_env - TYPE(dbcsr_t_type), DIMENSION(1) :: t_2c_int - TYPE(dbcsr_type), DIMENSION(1) :: t_2c_int_mat, t_2c_op_pot, & - t_2c_op_pot_sqrt, & - t_2c_op_pot_sqrt_inv, t_2c_op_RI, & - t_2c_op_RI_inv + TYPE(dbcsr_t_type), DIMENSION(1) :: t_2c_int, t_2c_work + TYPE(dbcsr_t_type), DIMENSION(1, 1) :: t_3c_int + TYPE(dbcsr_type), DIMENSION(1) :: dbcsr_work_1, dbcsr_work_2, t_2c_int_mat, t_2c_op_pot, & + t_2c_op_pot_sqrt, t_2c_op_pot_sqrt_inv, t_2c_op_RI, t_2c_op_RI_inv CALL timeset(routineN, handle) @@ -142,7 +148,7 @@ CONTAINS CALL timeset(routineN//"_int", handle2) - CALL hfx_ri_pre_scf_calc_tensors(qs_env, ri_data, t_2c_op_RI, t_2c_op_pot, ri_data%t_3c_int) + CALL hfx_ri_pre_scf_calc_tensors(qs_env, ri_data, t_2c_op_RI, t_2c_op_pot, t_3c_int) CALL timestop(handle2) @@ -183,6 +189,20 @@ CONTAINS CALL cp_dbcsr_power(t_2c_op_pot_sqrt(1), 0.5_dp, ri_data%eps_eigval, n_dependent, & para_env, blacs_env, verbose=ri_data%unit_nr_dbcsr > 0) END SELECT + + !We need S^-1 and (P|Q) for the forces. + CALL dbcsr_t_create(t_2c_op_RI_inv(1), t_2c_work(1)) + CALL dbcsr_t_copy_matrix_to_tensor(t_2c_op_RI_inv(1), t_2c_work(1)) + CALL dbcsr_t_copy(t_2c_work(1), ri_data%t_2c_inv(1, 1), move_data=.TRUE.) + CALL dbcsr_t_destroy(t_2c_work(1)) + CALL dbcsr_t_filter(ri_data%t_2c_inv(1, 1), ri_data%filter_eps) + + CALL dbcsr_t_create(t_2c_op_pot(1), t_2c_work(1)) + CALL dbcsr_t_copy_matrix_to_tensor(t_2c_op_pot(1), t_2c_work(1)) + CALL dbcsr_t_copy(t_2c_work(1), ri_data%t_2c_pot(1, 1), move_data=.TRUE.) + CALL dbcsr_t_destroy(t_2c_work(1)) + CALL dbcsr_t_filter(ri_data%t_2c_pot(1, 1), ri_data%filter_eps) + IF (ri_data%check_2c_inv) THEN CALL check_sqrt(t_2c_op_pot(1), matrix_sqrt=t_2c_op_pot_sqrt(1), unit_nr=unit_nr) ENDIF @@ -208,6 +228,18 @@ CONTAINS IF (ri_data%check_2c_inv) THEN CALL check_sqrt(t_2c_op_pot(1), matrix_sqrt_inv=t_2c_int_mat(1), unit_nr=unit_nr) ENDIF + + !We need (P|Q)^-1 for the forces + CALL dbcsr_copy(dbcsr_work_1(1), t_2c_int_mat(1)) + CALL dbcsr_create(dbcsr_work_2(1), template=t_2c_int_mat(1)) + CALL dbcsr_multiply("N", "N", 1.0_dp, dbcsr_work_1(1), t_2c_int_mat(1), 0.0_dp, dbcsr_work_2(1)) + CALL dbcsr_release(dbcsr_work_1(1)) + CALL dbcsr_t_create(dbcsr_work_2(1), t_2c_work(1)) + CALL dbcsr_t_copy_matrix_to_tensor(dbcsr_work_2(1), t_2c_work(1)) + CALL dbcsr_release(dbcsr_work_2(1)) + CALL dbcsr_t_copy(t_2c_work(1), ri_data%t_2c_inv(1, 1), move_data=.TRUE.) + CALL dbcsr_t_destroy(t_2c_work(1)) + CALL dbcsr_t_filter(ri_data%t_2c_inv(1, 1), ri_data%filter_eps) ENDIF CALL dbcsr_release(t_2c_op_pot(1)) @@ -216,18 +248,16 @@ CONTAINS CALL dbcsr_t_copy_matrix_to_tensor(t_2c_int_mat(1), t_2c_int(1)) CALL dbcsr_release(t_2c_int_mat(1)) DO ispin = 1, nspins - IF (ispin > 1) CALL dbcsr_t_create(ri_data%t_2c_int(1, 1), ri_data%t_2c_int(ispin, 1)) CALL dbcsr_t_copy(t_2c_int(1), ri_data%t_2c_int(ispin, 1)) ENDDO CALL dbcsr_t_destroy(t_2c_int(1)) CALL timestop(handle2) CALL timeset(routineN//"_3c", handle2) - CALL dbcsr_t_copy(ri_data%t_3c_int(1, 1), ri_data%t_3c_int_ctr_1(1, 1), order=[2, 1, 3], move_data=.TRUE.) - CALL dbcsr_t_destroy(ri_data%t_3c_int(1, 1)) + CALL dbcsr_t_copy(t_3c_int(1, 1), ri_data%t_3c_int_ctr_1(1, 1), order=[2, 1, 3], move_data=.TRUE.) CALL dbcsr_t_filter(ri_data%t_3c_int_ctr_1(1, 1), ri_data%filter_eps) CALL dbcsr_t_copy(ri_data%t_3c_int_ctr_1(1, 1), ri_data%t_3c_int_ctr_2(1, 1)) - DEALLOCATE (ri_data%t_3c_int) + CALL dbcsr_t_destroy(t_3c_int(1, 1)) CALL timestop(handle2) CALL timestop(handle) @@ -415,8 +445,7 @@ CONTAINS ! create 3c tensor for storage of ints CALL build_3c_neighbor_lists(nl_3c, basis_set_RI, basis_set_AO, basis_set_AO, dist_3d, ri_data%ri_metric, & - "HFX_3c_nl", & - qs_env, op_pos=1, sym_jk=.TRUE., own_dist=.TRUE.) + "HFX_3c_nl", qs_env, op_pos=1, sym_jk=.TRUE., own_dist=.TRUE.) DO i_mem = 1, n_mem CALL build_3c_integrals(t_3c_int_batched, ri_data%filter_eps/2, qs_env, nl_3c, & @@ -466,7 +495,6 @@ CONTAINS CALL build_2c_integrals(t_2c_int_pot, ri_data%filter_eps_2c, qs_env, nl_2c_pot, basis_set_RI, basis_set_RI, & ri_data%hfx_pot) - CALL release_neighbor_list_sets(nl_2c_pot) IF (.NOT. ri_data%same_op) THEN @@ -556,7 +584,7 @@ CONTAINS TYPE(cp_blacs_env_type), POINTER :: blacs_env TYPE(cp_para_env_type), POINTER :: para_env TYPE(dbcsr_t_type) :: t_3c_2 - TYPE(dbcsr_t_type), DIMENSION(1) :: t_2c_int + TYPE(dbcsr_t_type), DIMENSION(1) :: t_2c_int, t_2c_work TYPE(dbcsr_t_type), DIMENSION(1, 1) :: t_3c_int_1 TYPE(dbcsr_type), DIMENSION(1) :: t_2c_int_mat, t_2c_op_pot, t_2c_op_RI, & t_2c_tmp, t_2c_tmp_2 @@ -569,6 +597,7 @@ CONTAINS CALL get_qs_env(qs_env, para_env=para_env, blacs_env=blacs_env) CALL timeset(routineN//"_int", handle2) + CALL hfx_ri_pre_scf_calc_tensors(qs_env, ri_data, t_2c_op_RI, t_2c_op_pot, t_3c_int_1) CALL dbcsr_t_copy(t_3c_int_1(1, 1), ri_data%t_3c_int_ctr_3(1, 1), order=[1, 2, 3], move_data=.TRUE.) @@ -601,6 +630,21 @@ CONTAINS CALL check_inverse(t_2c_int_mat(1), t_2c_op_RI(1), unit_nr=unit_nr) ENDIF + !Need to save the (P|Q)^-1 tensor for forces (inverse metric if not same_op) + CALL dbcsr_t_create(t_2c_int_mat(1), t_2c_work(1)) + CALL dbcsr_t_copy_matrix_to_tensor(t_2c_int_mat(1), t_2c_work(1)) + CALL dbcsr_t_copy(t_2c_work(1), ri_data%t_2c_inv(1, 1), move_data=.TRUE.) + CALL dbcsr_t_destroy(t_2c_work(1)) + CALL dbcsr_t_filter(ri_data%t_2c_inv(1, 1), ri_data%filter_eps) + IF (.NOT. ri_data%same_op) THEN + !Also save the RI (P|Q) integral + CALL dbcsr_t_create(t_2c_op_pot(1), t_2c_work(1)) + CALL dbcsr_t_copy_matrix_to_tensor(t_2c_op_pot(1), t_2c_work(1)) + CALL dbcsr_t_copy(t_2c_work(1), ri_data%t_2c_pot(1, 1), move_data=.TRUE.) + CALL dbcsr_t_destroy(t_2c_work(1)) + CALL dbcsr_t_filter(ri_data%t_2c_pot(1, 1), ri_data%filter_eps) + END IF + IF (ri_data%same_op) THEN CALL dbcsr_release(t_2c_op_pot(1)) ELSE @@ -621,7 +665,7 @@ CONTAINS CALL dbcsr_t_create(t_2c_int_mat(1), t_2c_int(1), name="(RI|RI)") CALL dbcsr_t_copy_matrix_to_tensor(t_2c_int_mat(1), t_2c_int(1)) CALL dbcsr_release(t_2c_int_mat(1)) - CALL dbcsr_t_copy(t_2c_int(1), ri_data%t_2c_int(1, 1)) + CALL dbcsr_t_copy(t_2c_int(1), ri_data%t_2c_int(1, 1), move_data=.TRUE.) CALL dbcsr_t_destroy(t_2c_int(1)) CALL dbcsr_t_filter(ri_data%t_2c_int(1, 1), ri_data%filter_eps) @@ -1031,7 +1075,7 @@ CONTAINS mem_size(i_mem) = bsize ENDDO - CALL split_block_sizes(mem_size, mo_bsizes_1, ri_data%min_bsize_MO) + CALL split_block_sizes(mem_size, mo_bsizes_1, ri_data%max_bsize_MO) ALLOCATE (mem_start_block_1(n_mem)) ALLOCATE (mem_end_block_1(n_mem)) nblock = SIZE(mo_bsizes_1) @@ -1116,31 +1160,16 @@ CONTAINS CALL dbcsr_t_filter(mo_coeff_t_split, ri_data%filter_eps_mo) CALL dbcsr_t_destroy(mo_coeff_t) + CALL dbcsr_t_batched_contract_init(ks_t) + CALL dbcsr_t_batched_contract_init(ri_data%t_3c_ctr_KS(ispin, 1, 1), batch_range_2=batch_ranges_2) + CALL dbcsr_t_batched_contract_init(ri_data%t_3c_ctr_KS_copy(ispin, 1, 1), batch_range_2=batch_ranges_2) + + CALL dbcsr_t_batched_contract_init(ri_data%t_2c_int(ispin, 1)) + CALL dbcsr_t_batched_contract_init(ri_data%t_3c_int_mo(ispin, 1, 1), batch_range_2=batch_ranges_2) + CALL dbcsr_t_batched_contract_init(ri_data%t_3c_ctr_RI(ispin, 1, 1), batch_range_2=batch_ranges_2) + DO i_mem = 1, n_mem - IF (i_mem == 2) THEN - IF (.NOT. do_initialize) THEN - IF (geometry_did_change) THEN - CALL dbcsr_t_batched_contract_finalize(ri_data%t_3c_int_mo(ispin, 1, 1)) - CALL dbcsr_t_batched_contract_finalize(ri_data%t_3c_ctr_RI(ispin, 1, 1)) - CALL dbcsr_t_batched_contract_finalize(ri_data%t_2c_int(ispin, 1)) - ENDIF - ENDIF - CALL dbcsr_t_batched_contract_init(ks_t) - CALL dbcsr_t_batched_contract_init(ri_data%t_3c_ctr_KS(ispin, 1, 1), & - batch_range_2=batch_ranges_2) - CALL dbcsr_t_batched_contract_init(ri_data%t_3c_ctr_KS_copy(ispin, 1, 1), & - batch_range_2=batch_ranges_2) - - IF (do_initialize .OR. geometry_did_change) THEN - CALL dbcsr_t_batched_contract_init(ri_data%t_2c_int(ispin, 1)) - CALL dbcsr_t_batched_contract_init(ri_data%t_3c_int_mo(ispin, 1, 1), & - batch_range_2=batch_ranges_2) - CALL dbcsr_t_batched_contract_init(ri_data%t_3c_ctr_RI(ispin, 1, 1), & - batch_range_2=batch_ranges_2) - ENDIF - ENDIF - bounds(:, 1) = [mem_start(i_mem), mem_end(i_mem)] CALL dbcsr_t_batched_contract_init(mo_coeff_t_split) @@ -1237,11 +1266,14 @@ CONTAINS CALL timestop(handle2) ENDDO - !CALL dbcsr_t_batched_contract_finalize(ri_data%t_2c_int(1)) - CALL dbcsr_t_batched_contract_finalize(ks_t, unit_nr=unit_nr_dbcsr) + CALL dbcsr_t_batched_contract_finalize(ks_t) CALL dbcsr_t_batched_contract_finalize(ri_data%t_3c_ctr_KS(ispin, 1, 1)) CALL dbcsr_t_batched_contract_finalize(ri_data%t_3c_ctr_KS_copy(ispin, 1, 1)) + CALL dbcsr_t_batched_contract_finalize(ri_data%t_2c_int(ispin, 1)) + CALL dbcsr_t_batched_contract_finalize(ri_data%t_3c_int_mo(ispin, 1, 1)) + CALL dbcsr_t_batched_contract_finalize(ri_data%t_3c_ctr_RI(ispin, 1, 1)) + CALL dbcsr_t_destroy(t_3c_int_mo_1(1, 1)) CALL dbcsr_t_destroy(t_3c_int_mo_2(1, 1)) CALL dbcsr_t_clear(ri_data%t_3c_int_mo(ispin, 1, 1)) @@ -1523,6 +1555,1779 @@ CONTAINS END SUBROUTINE +! ************************************************************************************************** +!> \brief Implementation based on the MO flavor +!> \param qs_env ... +!> \param ri_data ... +!> \param nspins ... +!> \param hf_fraction ... +!> \param mo_coeff ... +!> \param mo_coeff_resp ... +!> \param use_virial ... +! ************************************************************************************************** + SUBROUTINE hfx_ri_forces_mo(qs_env, ri_data, nspins, hf_fraction, mo_coeff, mo_coeff_resp, use_virial) + + TYPE(qs_environment_type), POINTER :: qs_env + TYPE(hfx_ri_type), INTENT(INOUT) :: ri_data + INTEGER, INTENT(IN) :: nspins + REAL(dp), INTENT(IN) :: hf_fraction + TYPE(dbcsr_type), DIMENSION(:), INTENT(IN) :: mo_coeff + TYPE(dbcsr_type), DIMENSION(:), INTENT(IN), & + OPTIONAL :: mo_coeff_resp + LOGICAL, INTENT(IN), OPTIONAL :: use_virial + + CHARACTER(LEN=*), PARAMETER :: routineN = 'hfx_ri_forces_mo' + + INTEGER :: handle, i_mem, i_xyz, ispin, j_mem, & + n_mem, n_mos, natom, unit_nr_dbcsr + INTEGER(int_8) :: nflop + INTEGER, ALLOCATABLE, DIMENSION(:) :: atom_of_kind, batch_blk_end, batch_blk_start, & + batch_end, batch_ranges, batch_start, bsizes_MO, dist1, dist2, dist3, idx_to_at_AO, & + idx_to_at_RI, kind_of + INTEGER, DIMENSION(2, 1) :: bounds_ctr_1d + INTEGER, DIMENSION(2, 2) :: bounds_ctr_2d + LOGICAL :: use_virial_prv + REAL(dp) :: pref, spin_fac + REAL(dp), DIMENSION(3, 3) :: work_virial + TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set + TYPE(cell_type), POINTER :: cell + TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s + TYPE(dbcsr_t_type) :: t_2c_RI, t_2c_RI_inv, t_2c_RI_met, t_2c_RI_PQ, t_2c_tmp, t_3c_0, & + t_3c_1, t_3c_2, t_3c_3, t_3c_4, t_3c_ao_ri_ao, t_3c_ao_ri_mo, t_3c_desymm, t_3c_mo_ri_ao, & + t_3c_mo_ri_mo, t_3c_ri_ao_ao, t_3c_ri_mo_mo, t_3c_work, t_mo_coeff, t_mo_cpy + TYPE(dbcsr_t_type), DIMENSION(3) :: t_2c_der_metric, t_2c_der_RI, t_2c_MO_AO, & + t_2c_MO_AO_ctr, t_2c_RI_ctr, t_3c_der_AO, t_3c_der_AO_ctr_1, t_3c_der_RI, & + t_3c_der_RI_ctr_1, t_3c_der_RI_ctr_2, t_3c_tmp_AO, t_3c_tmp_RI + TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(qs_force_type), DIMENSION(:), POINTER :: force + TYPE(virial_type), POINTER :: virial + + ! 1) Precompute the derivatives that are needed (3c, 3c RI and metric) + ! 2) Go over batched of occupied MOs so as to save memory and optimize contractions + ! 3) Contract all 3c integrals and derivatives with MO coeffs + ! 4) Contract relevant quantities with the inverse 2c RI (metric or pot) + ! 5) First force contribution with the 2c RI derivative d/dx (Q|R) + ! 6) If metric, do the additional contraction with S_pq^-1 (Q|R) + ! 7) Do the force contribution due to 3c integrals (a'b|P) and (ab|P') + ! 8) If metric, do the last force contribution due to d/dx S^-1 (First contract (ab|P), then S^-1) + + MARK_USED(mo_coeff_resp) !TODO: allow for response MO coeffs + + use_virial_prv = .FALSE. + IF (PRESENT(use_virial)) use_virial_prv = use_virial + + unit_nr_dbcsr = ri_data%unit_nr_dbcsr + + CALL get_qs_env(qs_env, natom=natom, particle_set=particle_set, & + atomic_kind_set=atomic_kind_set, virial=virial, & + cell=cell, force=force, matrix_s=matrix_s) + + CALL create_3c_tensor(t_3c_ao_ri_ao, dist1, dist2, dist3, ri_data%pgrid, & + ri_data%bsizes_AO_split, ri_data%bsizes_RI_split, ri_data%bsizes_AO_split, & + [1, 2], [3], name="(AO RI | AO)") + DEALLOCATE (dist1, dist2, dist3) + CALL create_3c_tensor(t_3c_ri_ao_ao, dist1, dist2, dist3, ri_data%pgrid, & + ri_data%bsizes_RI_split, ri_data%bsizes_AO_split, ri_data%bsizes_AO_split, & + [1], [2, 3], name="(RI | AO AO)") + DEALLOCATE (dist1, dist2, dist3) + + ! 1) Precompute the derivatives + CALL precalc_derivatives(t_3c_tmp_RI, t_3c_tmp_AO, t_2c_der_RI, t_2c_der_metric, & + t_3c_ri_ao_ao, t_3c_ao_ri_ao, ri_data, qs_env) + DO i_xyz = 1, 3 + CALL dbcsr_t_create(t_3c_ao_ri_ao, t_3c_der_RI(i_xyz)) + CALL dbcsr_t_copy(t_3c_tmp_RI(i_xyz), t_3c_der_RI(i_xyz), order=[2, 1, 3], move_data=.TRUE.) + CALL dbcsr_t_destroy(t_3c_tmp_RI(i_xyz)) + + CALL dbcsr_t_create(t_3c_ao_ri_ao, t_3c_der_AO(i_xyz)) + !want deriv as first center + CALL dbcsr_t_copy(t_3c_tmp_AO(i_xyz), t_3c_der_AO(i_xyz), order=[3, 2, 1], move_data=.TRUE.) + CALL dbcsr_t_destroy(t_3c_tmp_AO(i_xyz)) + END DO + + ! Get the 3c integrals (desymmetrized) + CALL dbcsr_t_create(t_3c_ao_ri_ao, t_3c_desymm) + CALL dbcsr_t_copy(ri_data%t_3c_int_ctr_1(1, 1), t_3c_desymm) + CALL dbcsr_t_copy(ri_data%t_3c_int_ctr_1(1, 1), t_3c_desymm, order=[3, 2, 1], & + summation=.TRUE., move_data=.TRUE.) + + CALL dbcsr_t_destroy(t_3c_ao_ri_ao) + CALL dbcsr_t_destroy(t_3c_ri_ao_ao) + + ! Some utilities + spin_fac = 0.5_dp + IF (nspins == 2) spin_fac = 1.0_dp + + ALLOCATE (idx_to_at_RI(SIZE(ri_data%bsizes_RI_split))) + CALL get_idx_to_atom(idx_to_at_RI, ri_data%bsizes_RI_split, ri_data%bsizes_RI) + + ALLOCATE (idx_to_at_AO(SIZE(ri_data%bsizes_AO_split))) + CALL get_idx_to_atom(idx_to_at_AO, ri_data%bsizes_AO_split, ri_data%bsizes_AO) + + ALLOCATE (atom_of_kind(natom), kind_of(natom)) + CALL get_atomic_kind_set(atomic_kind_set, kind_of=kind_of, atom_of_kind=atom_of_kind) + + ! 2-center RI tensors + CALL create_2c_tensor(t_2c_RI, dist1, dist2, ri_data%pgrid_2d, & + ri_data%bsizes_RI_split, ri_data%bsizes_RI_split, name="(RI | RI)") + DEALLOCATE (dist1, dist2) + CALL dbcsr_t_create(t_2c_RI, t_2c_RI_PQ) + DO i_xyz = 1, 3 + CALL dbcsr_t_create(t_2c_RI, t_2c_RI_ctr(i_xyz)) + END DO + IF (.NOT. ri_data%same_op) THEN + !precompute the (P|Q)*S^-1 product + CALL dbcsr_t_create(t_2c_RI, t_2c_RI_inv) + CALL dbcsr_t_create(t_2c_RI, t_2c_RI_met) + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), ri_data%t_2c_inv(1, 1), ri_data%t_2c_pot(1, 1), & + dbcsr_scalar(0.0_dp), t_2c_RI_inv, & + contract_1=[2], notcontract_1=[1], & + contract_2=[1], notcontract_2=[2], & + map_1=[1], map_2=[2], filter_eps=ri_data%filter_eps, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + END IF + + DO ispin = 1, nspins + + ! 2 )Prepare the batches for this spin + CALL dbcsr_get_info(mo_coeff(ispin), nfullcols_total=n_mos) + CALL split_block_sizes([n_mos], bsizes_MO, max_size=ri_data%max_bsize_MO) + + n_mem = ri_data%n_mem + CALL create_tensor_batches(bsizes_MO, n_mem, batch_start, batch_end, & + batch_blk_start, batch_blk_end) + ALLOCATE (batch_ranges(n_mem + 1)) + batch_ranges(1:n_mem) = batch_blk_start(1:n_mem) + batch_ranges(n_mem + 1) = batch_blk_end(n_mem) + 1 + DEALLOCATE (batch_blk_start, batch_blk_end) + + ! Initialize the different tensors needed (Note: keep MO coeffs as (MO | AO) for less transpose) + CALL create_2c_tensor(t_mo_coeff, dist1, dist2, ri_data%pgrid_2d, bsizes_MO, & + ri_data%bsizes_AO_split, name="MO coeffs") + DEALLOCATE (dist1, dist2) + CALL dbcsr_t_create(mo_coeff(ispin), t_2c_tmp, name="MO coeffs") + CALL dbcsr_t_copy_matrix_to_tensor(mo_coeff(ispin), t_2c_tmp) + CALL dbcsr_t_copy(t_2c_tmp, t_mo_coeff, order=[2, 1], move_data=.TRUE.) + CALL dbcsr_t_destroy(t_2c_tmp) + + CALL dbcsr_t_create(t_mo_coeff, t_mo_cpy) + CALL dbcsr_t_copy(t_mo_coeff, t_mo_cpy) + DO i_xyz = 1, 3 + CALL dbcsr_t_create(t_mo_coeff, t_2c_MO_AO_ctr(i_xyz)) + CALL dbcsr_t_create(t_mo_coeff, t_2c_MO_AO(i_xyz)) + END DO + + CALL create_3c_tensor(t_3c_ao_ri_mo, dist1, dist2, dist3, ri_data%pgrid, ri_data%bsizes_AO_split, & + ri_data%bsizes_RI_split, bsizes_MO, [1, 2], [3], name="(AO RI| MO)") + DEALLOCATE (dist1, dist2, dist3) + + CALL dbcsr_t_create(t_3c_ao_ri_mo, t_3c_0) + CALL dbcsr_t_destroy(t_3c_ao_ri_mo) + + CALL create_3c_tensor(t_3c_mo_ri_ao, dist1, dist2, dist3, ri_data%pgrid, bsizes_MO, ri_data%bsizes_RI_split, & + ri_data%bsizes_AO_split, [1, 2], [3], name="(MO RI | AO)") + DEALLOCATE (dist1, dist2, dist3) + CALL dbcsr_t_create(t_3c_mo_ri_ao, t_3c_1) + + DO i_xyz = 1, 3 + CALL dbcsr_t_create(t_3c_mo_ri_ao, t_3c_der_RI_ctr_1(i_xyz)) + CALL dbcsr_t_create(t_3c_mo_ri_ao, t_3c_der_AO_ctr_1(i_xyz)) + END DO + + CALL create_3c_tensor(t_3c_mo_ri_mo, dist1, dist2, dist3, ri_data%pgrid, bsizes_MO, & + ri_data%bsizes_RI_split, bsizes_MO, [1, 2], [3], name="(MO RI | MO)") + DEALLOCATE (dist1, dist2, dist3) + CALL dbcsr_t_create(t_3c_mo_ri_mo, t_3c_work) + + CALL create_3c_tensor(t_3c_ri_mo_mo, dist1, dist2, dist3, ri_data%pgrid, ri_data%bsizes_RI_split, & + bsizes_MO, bsizes_MO, [1], [2, 3], name="(RI| MO MO)") + DEALLOCATE (dist1, dist2, dist3) + + CALL dbcsr_t_create(t_3c_ri_mo_mo, t_3c_2) + CALL dbcsr_t_create(t_3c_ri_mo_mo, t_3c_3) + CALL dbcsr_t_create(t_3c_ri_mo_mo, t_3c_4) + DO i_xyz = 1, 3 + CALL dbcsr_t_create(t_3c_ri_mo_mo, t_3c_der_RI_ctr_2(i_xyz)) + END DO + + CALL dbcsr_t_batched_contract_init(t_mo_coeff, batch_range_1=batch_ranges) + CALL dbcsr_t_batched_contract_init(t_3c_desymm) + CALL dbcsr_t_batched_contract_init(t_3c_0, batch_range_3=batch_ranges) + + DO i_xyz = 1, 3 + CALL dbcsr_t_batched_contract_init(t_3c_der_AO(i_xyz)) + CALL dbcsr_t_batched_contract_init(t_3c_der_RI(i_xyz)) + END DO + + ! 2) Loop over batches + DO i_mem = 1, n_mem + + bounds_ctr_1d(1, 1) = batch_start(i_mem) + bounds_ctr_1d(2, 1) = batch_end(i_mem) + + ! 3) Do the first AO to MO contraction here + CALL timeset(routineN//"_AO2MO_1", handle) + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), t_mo_coeff, t_3c_desymm, & + dbcsr_scalar(0.0_dp), t_3c_0, & + contract_1=[2], notcontract_1=[1], & + contract_2=[3], notcontract_2=[1, 2], & + map_1=[3], map_2=[1, 2], filter_eps=ri_data%filter_eps, & + bounds_2=bounds_ctr_1d, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + CALL dbcsr_t_copy(t_3c_0, t_3c_1, order=[3, 2, 1], move_data=.TRUE.) + + DO i_xyz = 1, 3 + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), t_mo_coeff, t_3c_der_AO(i_xyz), & + dbcsr_scalar(0.0_dp), t_3c_0, & + contract_1=[2], notcontract_1=[1], & + contract_2=[3], notcontract_2=[1, 2], & + map_1=[3], map_2=[1, 2], filter_eps=ri_data%filter_eps, & + bounds_2=bounds_ctr_1d, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + CALL dbcsr_t_copy(t_3c_0, t_3c_der_AO_ctr_1(i_xyz), order=[3, 2, 1], move_data=.TRUE.) + + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), t_mo_coeff, t_3c_der_RI(i_xyz), & + dbcsr_scalar(0.0_dp), t_3c_0, & + contract_1=[2], notcontract_1=[1], & + contract_2=[3], notcontract_2=[1, 2], & + map_1=[3], map_2=[1, 2], filter_eps=ri_data%filter_eps, & + bounds_2=bounds_ctr_1d, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + CALL dbcsr_t_copy(t_3c_0, t_3c_der_RI_ctr_1(i_xyz), order=[3, 2, 1], move_data=.TRUE.) + END DO + CALL timestop(handle) + + CALL dbcsr_t_batched_contract_init(t_3c_1, batch_range_1=batch_ranges) + CALL dbcsr_t_batched_contract_init(t_3c_work, batch_range_1=batch_ranges, batch_range_3=batch_ranges) + CALL dbcsr_t_batched_contract_init(t_3c_2, batch_range_2=batch_ranges, batch_range_3=batch_ranges) + CALL dbcsr_t_batched_contract_init(t_3c_3, batch_range_2=batch_ranges, batch_range_3=batch_ranges) + CALL dbcsr_t_batched_contract_init(ri_data%t_2c_inv(1, 1)) + + DO i_xyz = 1, 3 + CALL dbcsr_t_batched_contract_init(t_3c_der_RI_ctr_1(i_xyz), batch_range_1=batch_ranges) + CALL dbcsr_t_batched_contract_init(t_3c_der_RI_ctr_2(i_xyz), batch_range_2=batch_ranges, batch_range_3=batch_ranges) + CALL dbcsr_t_batched_contract_init(t_3c_der_AO_ctr_1(i_xyz), batch_range_1=batch_ranges) + + CALL dbcsr_t_batched_contract_init(t_2c_RI_ctr(i_xyz)) + CALL dbcsr_t_batched_contract_init(t_2c_MO_AO_ctr(i_xyz), batch_range_1=batch_ranges) + + END DO + + IF (.NOT. ri_data%same_op) THEN + CALL dbcsr_t_batched_contract_init(t_2c_RI_inv) + CALL dbcsr_t_batched_contract_init(t_2c_RI_met) + CALL dbcsr_t_batched_contract_init(t_3c_4, batch_range_2=batch_ranges, batch_range_3=batch_ranges) + END IF + + DO j_mem = 1, n_mem + + bounds_ctr_1d(1, 1) = batch_start(j_mem) + bounds_ctr_1d(2, 1) = batch_end(j_mem) + + ! 3) Do the second AO to MO contraction here, followed by the S^-1 contraction + CALL timeset(routineN//"_AO2MO_2", handle) + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), t_mo_coeff, t_3c_1, & + dbcsr_scalar(0.0_dp), t_3c_work, & + contract_1=[2], notcontract_1=[1], & + contract_2=[3], notcontract_2=[1, 2], & + map_1=[3], map_2=[1, 2], filter_eps=ri_data%filter_eps, & + bounds_2=bounds_ctr_1d, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + CALL dbcsr_t_copy(t_3c_mo_ri_ao, t_3c_1) + CALL timestop(handle) + + bounds_ctr_2d(1, 1) = batch_start(i_mem) + bounds_ctr_2d(2, 1) = batch_end(i_mem) + bounds_ctr_2d(1, 2) = batch_start(j_mem) + bounds_ctr_2d(2, 2) = batch_end(j_mem) + + ! 4) Contract 3c MO integrals with S^-1 as well + CALL timeset(routineN//"_2c_inv", handle) + CALL dbcsr_t_copy(t_3c_work, t_3c_3, order=[2, 1, 3], move_data=.TRUE.) + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), ri_data%t_2c_inv(1, 1), t_3c_3, & + dbcsr_scalar(0.0_dp), t_3c_2, & + contract_1=[2], notcontract_1=[1], & + contract_2=[1], notcontract_2=[2, 3], & + map_1=[1], map_2=[2, 3], filter_eps=ri_data%filter_eps, & + bounds_3=bounds_ctr_2d, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + CALL dbcsr_t_copy(t_3c_ri_mo_mo, t_3c_3) + CALL timestop(handle) + + !Only contract (ab|P') with MO coeffs since need AO rep for the force of (a'b|P) + CALL timeset(routineN//"_AO2MO_2", handle) + DO i_xyz = 1, 3 + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), t_mo_coeff, t_3c_der_RI_ctr_1(i_xyz), & + dbcsr_scalar(0.0_dp), t_3c_work, & + contract_1=[2], notcontract_1=[1], & + contract_2=[3], notcontract_2=[1, 2], & + map_1=[3], map_2=[1, 2], filter_eps=ri_data%filter_eps, & + bounds_2=bounds_ctr_1d, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + CALL dbcsr_t_copy(t_3c_work, t_3c_der_RI_ctr_2(i_xyz), order=[2, 1, 3], move_data=.TRUE.) + END DO + CALL timestop(handle) + + !Convert the MO tensors to dense block format (bsizes_RI_fit, or blk_size=1 since MO is not so ?) + !TODO: try the above for performance later (prob before S^-1 contraction) (for GPUs) + + ! 5) Force due to d/dx (P|Q) + CALL timeset(routineN//"_PQ_der", handle) + CALL dbcsr_t_copy(t_3c_2, t_3c_3) + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), t_3c_2, t_3c_3, & + dbcsr_scalar(1.0_dp), t_2c_RI_PQ, & + contract_1=[2, 3], notcontract_1=[1], & + contract_2=[2, 3], notcontract_2=[1], & + bounds_1=bounds_ctr_2d, & + map_1=[1], map_2=[2], filter_eps=ri_data%filter_eps, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + CALL timestop(handle) + + ! 6) If metric, do the additional contraction with S_pq^-1 (Q|R) (not on the derivatives) + IF (.NOT. ri_data%same_op) THEN + CALL timeset(routineN//"_metric", handle) + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), t_2c_RI_inv, t_3c_2, & + dbcsr_scalar(0.0_dp), t_3c_4, & + contract_1=[2], notcontract_1=[1], & + contract_2=[1], notcontract_2=[2, 3], & + bounds_3=bounds_ctr_2d, & + map_1=[1], map_2=[2, 3], filter_eps=ri_data%filter_eps, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + CALL dbcsr_t_copy(t_3c_4, t_3c_2, move_data=.TRUE.) + + ! 8) and get the force due to d/dx S^-1 + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), t_3c_2, t_3c_3, & + dbcsr_scalar(1.0_dp), t_2c_RI_met, & + contract_1=[2, 3], notcontract_1=[1], & + contract_2=[2, 3], notcontract_2=[1], & + bounds_1=bounds_ctr_2d, & + map_1=[1], map_2=[2], filter_eps=ri_data%filter_eps, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + + CALL timestop(handle) + END IF + CALL dbcsr_t_copy(t_3c_ri_mo_mo, t_3c_3) + + ! 7) Do the force contribution due to 3c integrals (a'b|P) and (ab|P') + + ! (ab|P') + CALL timeset(routineN//"_3c_RI", handle) + DO i_xyz = 1, 3 + + !Contract into t_2c_RI_ctr, calculate the force later + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), t_3c_der_RI_ctr_2(i_xyz), t_3c_2, & + dbcsr_scalar(1.0_dp), t_2c_RI_ctr(i_xyz), & + contract_1=[2, 3], notcontract_1=[1], & + contract_2=[2, 3], notcontract_2=[1], & + map_1=[1], map_2=[2], filter_eps=ri_data%filter_eps, & + bounds_1=bounds_ctr_2d, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + END DO + CALL timestop(handle) + + ! (a'b|P) Note that derivative remains in AO rep until the actual force evaluation + bounds_ctr_2d(1, 1) = batch_start(i_mem) + bounds_ctr_2d(2, 1) = batch_end(i_mem) + bounds_ctr_2d(1, 2) = 1 + bounds_ctr_2d(2, 2) = SUM(ri_data%bsizes_RI) + + bounds_ctr_1d(1, 1) = batch_start(j_mem) + bounds_ctr_1d(2, 1) = batch_end(j_mem) + + CALL timeset(routineN//"_3c_AO", handle) + CALL dbcsr_t_copy(t_3c_2, t_3c_work, order=[2, 1, 3], move_data=.TRUE.) + DO i_xyz = 1, 3 + + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), t_3c_work, t_3c_der_AO_ctr_1(i_xyz), & + dbcsr_scalar(1.0_dp), t_2c_MO_AO_ctr(i_xyz), & + contract_1=[1, 2], notcontract_1=[3], & + contract_2=[1, 2], notcontract_2=[3], & + map_1=[1], map_2=[2], filter_eps=ri_data%filter_eps, & + bounds_1=bounds_ctr_2d, & + bounds_2=bounds_ctr_1d, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + + END DO + CALL timestop(handle) + + END DO !j_mem + CALL dbcsr_t_batched_contract_finalize(t_3c_1) + CALL dbcsr_t_batched_contract_finalize(t_3c_work) + CALL dbcsr_t_batched_contract_finalize(t_3c_2) + CALL dbcsr_t_batched_contract_finalize(t_3c_3) + CALL dbcsr_t_batched_contract_finalize(ri_data%t_2c_inv(1, 1)) + + DO i_xyz = 1, 3 + CALL dbcsr_t_batched_contract_finalize(t_3c_der_RI_ctr_1(i_xyz)) + CALL dbcsr_t_batched_contract_finalize(t_3c_der_RI_ctr_2(i_xyz)) + CALL dbcsr_t_batched_contract_finalize(t_3c_der_AO_ctr_1(i_xyz)) + + CALL dbcsr_t_batched_contract_finalize(t_2c_RI_ctr(i_xyz)) + CALL dbcsr_t_batched_contract_finalize(t_2c_MO_AO_ctr(i_xyz)) + + END DO + + IF (.NOT. ri_data%same_op) THEN + CALL dbcsr_t_batched_contract_finalize(t_2c_RI_inv) + CALL dbcsr_t_batched_contract_finalize(t_2c_RI_met) + CALL dbcsr_t_batched_contract_finalize(t_3c_4) + END IF + + !Force contribution due to 3-center RI derivatives (ab|P') + pref = -0.5_dp*2.0_dp*hf_fraction*spin_fac + DO i_xyz = 1, 3 + IF (use_virial_prv) THEN + CALL get_force_from_trace(force, t_2c_RI_ctr(i_xyz), atom_of_kind, kind_of, idx_to_at_RI, pref, & + i_xyz, work_virial, cell, particle_set) + ELSE + CALL get_force_from_trace(force, t_2c_RI_ctr(i_xyz), atom_of_kind, kind_of, idx_to_at_RI, pref, i_xyz) + END IF + CALL dbcsr_t_clear(t_2c_RI_ctr(i_xyz)) + END DO + + !Force contribution due to 3-center AO derivatives (a'b|P) + pref = -0.5_dp*4.0_dp*hf_fraction*spin_fac + DO i_xyz = 1, 3 + CALL dbcsr_t_copy(t_2c_MO_AO_ctr(i_xyz), t_2c_MO_AO(i_xyz), move_data=.TRUE.) !ensures matching distributions + IF (use_virial_prv) THEN + CALL get_mo_ao_force(force, t_mo_cpy, t_2c_MO_AO(i_xyz), atom_of_kind, kind_of, idx_to_at_AO, pref, & + i_xyz, work_virial, cell, particle_set) + ELSE + CALL get_mo_ao_force(force, t_mo_cpy, t_2c_MO_AO(i_xyz), atom_of_kind, kind_of, idx_to_at_AO, pref, i_xyz) + END IF + CALL dbcsr_t_clear(t_2c_MO_AO(i_xyz)) + END DO + + !Force contribution of d/dx (P|Q) + pref = 0.5_dp*hf_fraction*spin_fac + IF (.NOT. ri_data%same_op) pref = -pref + + !Making sure dists of the t_2c_RI tensors match + CALL dbcsr_t_copy(t_2c_RI_PQ, t_2c_RI, move_data=.TRUE.) + IF (use_virial_prv) THEN + CALL get_2c_der_force(force, t_2c_RI, t_2c_der_RI, atom_of_kind, & + kind_of, idx_to_at_RI, pref, work_virial, cell, particle_set) + ELSE + CALL get_2c_der_force(force, t_2c_RI, t_2c_der_RI, atom_of_kind, & + kind_of, idx_to_at_RI, pref) + + END IF + CALL dbcsr_t_clear(t_2c_RI) + + !Force contribution due to the inverse metric + IF (.NOT. ri_data%same_op) THEN + pref = 0.5_dp*2.0_dp*hf_fraction*spin_fac + + CALL dbcsr_t_copy(t_2c_RI_met, t_2c_RI, move_data=.TRUE.) + IF (use_virial_prv) THEN + CALL get_2c_der_force(force, t_2c_RI, t_2c_der_metric, atom_of_kind, & + kind_of, idx_to_at_RI, pref, work_virial, cell, particle_set) + ELSE + CALL get_2c_der_force(force, t_2c_RI, t_2c_der_metric, atom_of_kind, & + kind_of, idx_to_at_RI, pref) + END IF + CALL dbcsr_t_clear(t_2c_RI) + END IF + + END DO !i_mem + CALL dbcsr_t_batched_contract_finalize(t_mo_coeff) + CALL dbcsr_t_batched_contract_finalize(t_3c_desymm) + CALL dbcsr_t_batched_contract_finalize(t_3c_0) + + DO i_xyz = 1, 3 + CALL dbcsr_t_batched_contract_finalize(t_3c_der_AO(i_xyz)) + CALL dbcsr_t_batched_contract_finalize(t_3c_der_RI(i_xyz)) + END DO + + CALL dbcsr_t_destroy(t_3c_0) + CALL dbcsr_t_destroy(t_3c_1) + CALL dbcsr_t_destroy(t_3c_2) + CALL dbcsr_t_destroy(t_3c_3) + CALL dbcsr_t_destroy(t_3c_4) + CALL dbcsr_t_destroy(t_3c_work) + CALL dbcsr_t_destroy(t_3c_mo_ri_ao) + CALL dbcsr_t_destroy(t_3c_mo_ri_mo) + CALL dbcsr_t_destroy(t_3c_ri_mo_mo) + CALL dbcsr_t_destroy(t_mo_coeff) + CALL dbcsr_t_destroy(t_mo_cpy) + DO i_xyz = 1, 3 + CALL dbcsr_t_destroy(t_2c_MO_AO(i_xyz)) + CALL dbcsr_t_destroy(t_2c_MO_AO_ctr(i_xyz)) + CALL dbcsr_t_destroy(t_3c_der_RI_ctr_1(i_xyz)) + CALL dbcsr_t_destroy(t_3c_der_AO_ctr_1(i_xyz)) + CALL dbcsr_t_destroy(t_3c_der_RI_ctr_2(i_xyz)) + END DO + DEALLOCATE (batch_ranges, batch_start, batch_end) + END DO !ispin + + ! Clean-up + CALL dbcsr_t_destroy(t_3c_desymm) + CALL dbcsr_t_destroy(t_2c_RI) + CALL dbcsr_t_destroy(t_2c_RI_PQ) + IF (.NOT. ri_data%same_op) THEN + CALL dbcsr_t_destroy(t_2c_RI_inv) + CALL dbcsr_t_destroy(t_2c_RI_met) + END IF + DO i_xyz = 1, 3 + CALL dbcsr_t_destroy(t_3c_der_AO(i_xyz)) + CALL dbcsr_t_destroy(t_3c_der_RI(i_xyz)) + CALL dbcsr_t_destroy(t_2c_der_RI(i_xyz)) + IF (.NOT. ri_data%same_op) CALL dbcsr_t_destroy(t_2c_der_metric(i_xyz)) + CALL dbcsr_t_destroy(t_2c_RI_ctr(i_xyz)) + END DO + CALL dbcsr_t_copy(ri_data%t_3c_int_ctr_2(1, 1), ri_data%t_3c_int_ctr_1(1, 1)) + + END SUBROUTINE hfx_ri_forces_mo + +! ************************************************************************************************** +!> \brief More optimized and general implementation +!> \param qs_env ... +!> \param ri_data ... +!> \param nspins ... +!> \param hf_fraction ... +!> \param rho_ao ... +!> \param rho_ao_resp ... +!> \param use_virial ... +!> \param resp_only ... +!> \param rescale_factor ... +! ************************************************************************************************** + SUBROUTINE hfx_ri_forces_Pmat(qs_env, ri_data, nspins, hf_fraction, rho_ao, rho_ao_resp, & + use_virial, resp_only, rescale_factor) + + TYPE(qs_environment_type), POINTER :: qs_env + TYPE(hfx_ri_type), INTENT(INOUT) :: ri_data + INTEGER, INTENT(IN) :: nspins + REAL(dp), INTENT(IN) :: hf_fraction + TYPE(dbcsr_p_type), DIMENSION(:, :) :: rho_ao + TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL :: rho_ao_resp + LOGICAL, INTENT(IN), OPTIONAL :: use_virial, resp_only + REAL(dp), INTENT(IN), OPTIONAL :: rescale_factor + + CHARACTER(LEN=*), PARAMETER :: routineN = 'hfx_ri_forces_Pmat' + + INTEGER :: dummy, handle, i_mem, i_spin, i_xyz, & + j_mem, j_xyz, k_mem, k_xyz, l_mem, & + n_mem, natom, unit_nr_dbcsr + INTEGER(int_8) :: nflop + INTEGER, ALLOCATABLE, DIMENSION(:) :: atom_of_kind, batch_blk_end, batch_blk_start, & + batch_end, batch_ranges, batch_start, dist1, dist2, dist3, idx_to_at_AO, idx_to_at_RI, & + kind_of + INTEGER, DIMENSION(2, 1) :: bounds_ctr_1d, bounds_l + INTEGER, DIMENSION(2, 2) :: bounds_ctr_2d, bounds_k + INTEGER, DIMENSION(2, 3) :: bounds_cpy + LOGICAL :: do_resp, resp_only_prv, use_virial_prv + REAL(dp) :: memory, pref, spin_fac, t1, t2 + REAL(dp), DIMENSION(3, 3) :: work_virial + TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set + TYPE(block_ind_type), ALLOCATABLE, DIMENSION(:, :) :: blk_indices + TYPE(cell_type), POINTER :: cell + TYPE(dbcsr_t_type) :: rho_ao_1, rho_ao_2, t_2c_RI, t_2c_RI_inv, t_2c_RI_met, t_2c_RI_PQ, & + t_2c_tmp, t_3c_0, t_3c_1, t_3c_2, t_3c_3, t_3c_4, t_3c_AO_ctr, t_3c_AO_ctr_resp, & + t_3c_ao_ri_ao, t_3c_desymm, t_3c_int_1, t_3c_int_2, t_3c_ri_ao_ao, t_3c_RI_ctr + TYPE(dbcsr_t_type), DIMENSION(3) :: t_2c_AO_ctr, t_2c_der_metric, & + t_2c_der_RI, t_2c_RI_ctr, t_3c_der_AO, & + t_3c_der_RI + TYPE(dbcsr_type) :: dbcsr_tmp + TYPE(hfx_compression_type), ALLOCATABLE, & + DIMENSION(:, :) :: store_3c + TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(qs_force_type), DIMENSION(:), POINTER :: force + TYPE(virial_type), POINTER :: virial + + ! 1) Precompute the derivatives that are needed (3c, 3c RI and metric) + ! 2) Pre-contract with the inverse RI 2c tensor (metric or potential) + ! 3) Go over batches of block of both density matrices, such that intermediate 3c tensors are small + ! 4) Precontract the 3c integrals with the density matrix: sum_cd P_ac P_bd (S|cd) + ! 5) First force contribution with the 2c RI derivative d/dx (Q|R) + ! 6) If metric, do the additional contraction with S_pq^-1 (Q|R) + ! 7) Do the force contribution due to 3c integrals (a'b|P) and (ab|P') + ! 8) If metric, do the last force contribution due to d/dx S^-1 (First contract (ab|P), then S^-1) + + NULLIFY (particle_set, virial, cell, force, atomic_kind_set) + + use_virial_prv = .FALSE. + IF (PRESENT(use_virial)) use_virial_prv = use_virial + + do_resp = .FALSE. + IF (PRESENT(rho_ao_resp)) THEN + IF (ASSOCIATED(rho_ao_resp(1)%matrix)) do_resp = .TRUE. + END IF + + resp_only_prv = .FALSE. + IF (PRESENT(resp_only)) resp_only_prv = resp_only + + unit_nr_dbcsr = ri_data%unit_nr_dbcsr + + CALL get_qs_env(qs_env, natom=natom, particle_set=particle_set, & + atomic_kind_set=atomic_kind_set, virial=virial, & + cell=cell, force=force) + + CALL create_3c_tensor(t_3c_ao_ri_ao, dist1, dist2, dist3, ri_data%pgrid, & + ri_data%bsizes_AO_split, ri_data%bsizes_RI_split, ri_data%bsizes_AO_split, & + [1, 2], [3], name="(AO RI | AO)") + DEALLOCATE (dist1, dist2, dist3) + CALL create_3c_tensor(t_3c_ri_ao_ao, dist1, dist2, dist3, ri_data%pgrid, & + ri_data%bsizes_RI_split, ri_data%bsizes_AO_split, ri_data%bsizes_AO_split, & + [1], [2, 3], name="(RI | AO AO)") + DEALLOCATE (dist1, dist2, dist3) + + ! 1) Precompute the derivatives + CALL precalc_derivatives(t_3c_der_RI, t_3c_der_AO, t_2c_der_RI, t_2c_der_metric, & + t_3c_ri_ao_ao, t_3c_ao_ri_ao, ri_data, qs_env) + + !Go over batches of Pmat rows to save memory, such that any contracted quantity with Pmat is small + n_mem = ri_data%n_mem + CALL create_tensor_batches(ri_data%bsizes_AO_split, n_mem, batch_start, batch_end, & + batch_blk_start, batch_blk_end) + ALLOCATE (batch_ranges(n_mem + 1)) + batch_ranges(1:n_mem) = batch_blk_start(1:n_mem) + batch_ranges(n_mem + 1) = batch_blk_end(n_mem) + 1 + DEALLOCATE (batch_blk_start, batch_blk_end) + + !Pre-allocate everything we need before the contraction loops + CALL dbcsr_t_create(t_3c_ao_ri_ao, t_3c_int_1) ! (AO RI | AO) + CALL dbcsr_t_create(t_3c_ao_ri_ao, t_3c_0) ! (AO RI | AO) + CALL dbcsr_t_create(t_3c_ao_ri_ao, t_3c_1) ! (AO RI | AO) + CALL dbcsr_t_create(t_3c_ao_ri_ao, t_3c_2) ! (AO RI | AO) + CALL dbcsr_t_create(t_3c_ri_ao_ao, t_3c_3) ! (RI| AO AO) + CALL dbcsr_t_create(t_3c_ri_ao_ao, t_3c_4) ! (RI| AO AO) + CALL dbcsr_t_create(t_3c_ri_ao_ao, t_3c_int_2) ! (RI| AO AO) + CALL dbcsr_t_create(t_3c_ri_ao_ao, t_3c_RI_ctr) ! (RI| AO AO) + CALL dbcsr_t_create(t_3c_ao_ri_ao, t_3c_AO_ctr) ! (AO RI | AO) + IF (do_resp) CALL dbcsr_t_create(t_3c_ao_ri_ao, t_3c_AO_ctr_resp) ! (AO RI | AO) + + !The 3-center integrals (ab|P) + CALL dbcsr_t_create(t_3c_ao_ri_ao, t_3c_desymm) + CALL dbcsr_t_copy(ri_data%t_3c_int_ctr_2(1, 1), t_3c_desymm, move_data=.TRUE.) + + CALL create_2c_tensor(t_2c_RI, dist1, dist2, ri_data%pgrid_2d, & + ri_data%bsizes_RI_split, ri_data%bsizes_RI_split, name="(RI | RI)") + DEALLOCATE (dist1, dist2) + + CALL dbcsr_t_create(t_2c_RI, t_2c_RI_PQ) + DO i_xyz = 1, 3 + CALL dbcsr_t_create(t_2c_RI, t_2c_RI_ctr(i_xyz)) + END DO + + CALL create_2c_tensor(rho_ao_1, dist1, dist2, ri_data%pgrid_2d, & + ri_data%bsizes_AO_split, ri_data%bsizes_AO_split, & + name="(AO | AO)") + DEALLOCATE (dist1, dist2) + + CALL dbcsr_t_create(rho_ao_1, rho_ao_2) + DO i_xyz = 1, 3 + CALL dbcsr_t_create(rho_ao_1, t_2c_AO_ctr(i_xyz)) + END DO + + !Some utilities + spin_fac = 0.5_dp + IF (nspins == 2) spin_fac = 1.0_dp + IF (PRESENT(rescale_factor)) spin_fac = spin_fac*rescale_factor + + ALLOCATE (idx_to_at_RI(SIZE(ri_data%bsizes_RI_split))) + CALL get_idx_to_atom(idx_to_at_RI, ri_data%bsizes_RI_split, ri_data%bsizes_RI) + + ALLOCATE (idx_to_at_AO(SIZE(ri_data%bsizes_AO_split))) + CALL get_idx_to_atom(idx_to_at_AO, ri_data%bsizes_AO_split, ri_data%bsizes_AO) + + ALLOCATE (atom_of_kind(natom), kind_of(natom)) + CALL get_atomic_kind_set(atomic_kind_set, kind_of=kind_of, atom_of_kind=atom_of_kind) + + t1 = m_walltime() + + IF (.NOT. ri_data%same_op) THEN + !precompute the (P|Q)*S^-1 product + CALL dbcsr_t_create(t_2c_RI, t_2c_RI_inv) + CALL dbcsr_t_create(t_2c_RI, t_2c_RI_met) + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), ri_data%t_2c_inv(1, 1), ri_data%t_2c_pot(1, 1), & + dbcsr_scalar(0.0_dp), t_2c_RI_inv, & + contract_1=[2], notcontract_1=[1], & + contract_2=[1], notcontract_2=[2], & + map_1=[1], map_2=[2], filter_eps=ri_data%filter_eps, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + END IF + + !2) pre-contract with the inverse RI 2-center tensor: S^-1 (Q|cd) + ! We compress that tensor since it is large and not sparse + ALLOCATE (store_3c(n_mem, n_mem)) + ALLOCATE (blk_indices(n_mem, n_mem)) + + CALL dbcsr_t_batched_contract_init(ri_data%t_2c_inv(1, 1)) + CALL dbcsr_t_batched_contract_init(t_3c_int_2, batch_range_2=batch_ranges, batch_range_3=batch_ranges) + CALL dbcsr_t_batched_contract_init(t_3c_3, batch_range_2=batch_ranges, batch_range_3=batch_ranges) + + CALL timeset(routineN//"_2c_inv", handle) + CALL dbcsr_t_copy(t_3c_desymm, t_3c_int_2, order=[2, 1, 3], move_data=.TRUE.) + memory = 0.0_dp + DO i_mem = 1, n_mem + DO j_mem = 1, n_mem + + CALL alloc_containers(store_3c(j_mem, i_mem), 1) + + bounds_ctr_2d(1, 1) = batch_start(i_mem) + bounds_ctr_2d(2, 1) = batch_end(i_mem) + bounds_ctr_2d(1, 2) = batch_start(j_mem) + bounds_ctr_2d(2, 2) = batch_end(j_mem) + + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), ri_data%t_2c_inv(1, 1), t_3c_int_2, & + dbcsr_scalar(0.0_dp), t_3c_3, & + contract_1=[2], notcontract_1=[1], & + contract_2=[1], notcontract_2=[2, 3], & + bounds_3=bounds_ctr_2d, & + map_1=[1], map_2=[2, 3], filter_eps=ri_data%filter_eps, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + + CALL dbcsr_t_copy(t_3c_3, t_3c_int_1, order=[2, 1, 3], move_data=.TRUE.) + ALLOCATE (blk_indices(j_mem, i_mem)%ind(dbcsr_t_get_num_blocks(t_3c_int_1), 3)) + CALL dbcsr_t_reserved_block_indices(t_3c_int_1, blk_indices(j_mem, i_mem)%ind) + CALL compress_tensor(t_3c_int_1, store_3c(j_mem, i_mem), ri_data%filter_eps_storage, memory) + + END DO + END DO + CALL timestop(handle) + + CALL dbcsr_t_batched_contract_finalize(ri_data%t_2c_inv(1, 1)) + CALL dbcsr_t_batched_contract_finalize(t_3c_int_2) + CALL dbcsr_t_batched_contract_finalize(t_3c_3) + + CALL dbcsr_t_copy(t_3c_int_2, ri_data%t_3c_int_ctr_2(1, 1), order=[2, 1, 3], move_data=.TRUE.) + CALL dbcsr_t_clear(t_3c_int_1) + CALL dbcsr_t_clear(t_3c_int_2) + CALL dbcsr_t_destroy(t_3c_desymm) + + DO i_spin = 1, nspins + + !Prepare Pmat in tensor format + CALL dbcsr_t_clear(rho_ao_1) + CALL dbcsr_t_clear(rho_ao_2) + CALL dbcsr_t_create(rho_ao(i_spin, 1)%matrix, t_2c_tmp) + CALL dbcsr_t_copy_matrix_to_tensor(rho_ao(i_spin, 1)%matrix, t_2c_tmp) + CALL dbcsr_t_copy(t_2c_tmp, rho_ao_1, move_data=.TRUE.) + CALL dbcsr_t_destroy(t_2c_tmp) + + IF (.NOT. do_resp) THEN + CALL dbcsr_t_copy(rho_ao_1, rho_ao_2) + ELSE IF (do_resp .AND. resp_only_prv) THEN + + CALL dbcsr_t_create(rho_ao_resp(i_spin)%matrix, t_2c_tmp) + CALL dbcsr_t_copy_matrix_to_tensor(rho_ao_resp(i_spin)%matrix, t_2c_tmp) + CALL dbcsr_t_copy(t_2c_tmp, rho_ao_2) + !symmetry allows to take 2*P_resp rasther than explicitely take all cross products + CALL dbcsr_t_copy(t_2c_tmp, rho_ao_2, summation=.TRUE., move_data=.TRUE.) + CALL dbcsr_t_destroy(t_2c_tmp) + ELSE + + !if not resp_only, need P-P_resp and P+P_resp + CALL dbcsr_t_copy(rho_ao_1, rho_ao_2) + CALL dbcsr_create(dbcsr_tmp, template=rho_ao_resp(i_spin)%matrix) + CALL dbcsr_add(dbcsr_tmp, rho_ao_resp(i_spin)%matrix, 0.0_dp, -1.0_dp) + CALL dbcsr_t_create(dbcsr_tmp, t_2c_tmp) + CALL dbcsr_t_copy_matrix_to_tensor(dbcsr_tmp, t_2c_tmp) + CALL dbcsr_t_copy(t_2c_tmp, rho_ao_1, summation=.TRUE., move_data=.TRUE.) + CALL dbcsr_release(dbcsr_tmp) + + CALL dbcsr_t_copy_matrix_to_tensor(rho_ao_resp(i_spin)%matrix, t_2c_tmp) + CALL dbcsr_t_copy(t_2c_tmp, rho_ao_2, summation=.TRUE., move_data=.TRUE.) + CALL dbcsr_t_destroy(t_2c_tmp) + + END IF + work_virial = 0.0_dp + + CALL dbcsr_t_batched_contract_init(rho_ao_1, batch_range_1=batch_ranges, batch_range_2=batch_ranges) + CALL dbcsr_t_batched_contract_init(t_3c_int_1, batch_range_1=batch_ranges, batch_range_3=batch_ranges) + CALL dbcsr_t_batched_contract_init(t_3c_1, batch_range_1=batch_ranges, batch_range_3=batch_ranges) + + DO i_mem = 1, n_mem + + ! 4) Precontract 3c integrals with density matrices + bounds_ctr_1d(1, 1) = batch_start(i_mem) + bounds_ctr_1d(2, 1) = batch_end(i_mem) + + CALL timeset(routineN//"_Pmat", handle) + DO k_mem = 1, n_mem + + bounds_k(1, 1) = batch_start(k_mem) + bounds_k(2, 1) = batch_end(k_mem) + bounds_k(1, 2) = 1 + bounds_k(2, 2) = SUM(ri_data%bsizes_RI) + DO l_mem = 1, n_mem + + bounds_l(1, 1) = batch_start(l_mem) + bounds_l(2, 1) = batch_end(l_mem) + + CALL decompress_tensor(t_3c_0, blk_indices(l_mem, k_mem)%ind, store_3c(l_mem, k_mem), & + ri_data%filter_eps_storage) + + CALL dbcsr_t_copy(t_3c_0, t_3c_int_1, move_data=.TRUE.) + + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), rho_ao_1, t_3c_int_1, & + dbcsr_scalar(1.0_dp), t_3c_1, & + contract_1=[2], notcontract_1=[1], & + contract_2=[3], notcontract_2=[1, 2], & + map_1=[3], map_2=[1, 2], filter_eps=ri_data%filter_eps, & + bounds_1=bounds_l, & + bounds_2=bounds_ctr_1d, & !corresponds to notcontract_1, aka rows of rho + bounds_3=bounds_k, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + END DO + END DO + + CALL dbcsr_t_copy(t_3c_ao_ri_ao, t_3c_int_1) + CALL dbcsr_t_copy(t_3c_1, t_3c_2, order=[3, 2, 1], move_data=.TRUE.) !put un-contracted AO in 3rd + CALL timestop(handle) + + CALL dbcsr_t_batched_contract_init(rho_ao_2, batch_range_1=batch_ranges) + CALL dbcsr_t_batched_contract_init(t_3c_2, batch_range_1=batch_ranges) + CALL dbcsr_t_batched_contract_init(t_3c_0, batch_range_1=batch_ranges, batch_range_3=batch_ranges) + + CALL dbcsr_t_batched_contract_init(t_2c_RI_PQ) + CALL dbcsr_t_batched_contract_init(t_3c_3, batch_range_2=batch_ranges, batch_range_3=batch_ranges) + CALL dbcsr_t_batched_contract_init(t_3c_int_2, batch_range_2=batch_ranges, batch_range_3=batch_ranges) + + DO i_xyz = 1, 3 + CALL dbcsr_t_batched_contract_init(t_3c_der_RI(i_xyz), batch_range_2=batch_ranges, & + batch_range_3=batch_ranges) + CALL dbcsr_t_batched_contract_init(t_2c_RI_ctr(i_xyz)) + + CALL dbcsr_t_batched_contract_init(t_3c_der_AO(i_xyz), batch_range_1=batch_ranges, & + batch_range_3=batch_ranges) + CALL dbcsr_t_batched_contract_init(t_2c_AO_ctr(i_xyz)) + END DO + CALL dbcsr_t_batched_contract_init(t_3c_AO_ctr, batch_range_1=batch_ranges, batch_range_3=batch_ranges) + CALL dbcsr_t_batched_contract_init(t_3c_RI_ctr, batch_range_2=batch_ranges, batch_range_3=batch_ranges) + IF (do_resp) CALL dbcsr_t_batched_contract_init(t_3c_AO_ctr_resp, batch_range_1=batch_ranges, & + batch_range_3=batch_ranges) + + IF (.NOT. ri_data%same_op) THEN + CALL dbcsr_t_batched_contract_init(t_2c_RI_inv) + CALL dbcsr_t_batched_contract_init(t_2c_RI_met) + CALL dbcsr_t_batched_contract_init(t_3c_4, batch_range_2=batch_ranges, batch_range_3=batch_ranges) + END IF + + DO j_mem = 1, n_mem + + ! second Pmat contraction + bounds_ctr_1d(1, 1) = batch_start(j_mem) + bounds_ctr_1d(2, 1) = batch_end(j_mem) + + CALL timeset(routineN//"_Pmat", handle) + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), rho_ao_2, t_3c_2, & + dbcsr_scalar(0.0_dp), t_3c_0, & + contract_1=[2], notcontract_1=[1], & + contract_2=[3], notcontract_2=[1, 2], & + map_1=[3], map_2=[1, 2], & + bounds_2=bounds_ctr_1d, filter_eps=ri_data%filter_eps, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + + CALL timestop(handle) + + !t_3c_1 currently holds sum_cd P_ac P_bd (Scd) S^-1 + + ! 5) Force contribution due to d/dx (P|Q) + bounds_ctr_2d(1, 1) = batch_start(i_mem) + bounds_ctr_2d(2, 1) = batch_end(i_mem) + bounds_ctr_2d(1, 2) = batch_start(j_mem) + bounds_ctr_2d(2, 2) = batch_end(j_mem) + + !!Also contract with the simple 3c integrals (with correct bounds) + bounds_cpy(1, 1) = batch_start(i_mem) !first AO + bounds_cpy(2, 1) = batch_end(i_mem) + bounds_cpy(1, 2) = 1 + bounds_cpy(2, 2) = SUM(ri_data%bsizes_RI) !RI bounds (all) + bounds_cpy(1, 3) = batch_start(j_mem) !second AO + bounds_cpy(2, 3) = batch_end(j_mem) + + CALL timeset(routineN//"_PQ_der", handle) + CALL dbcsr_t_copy(t_3c_0, t_3c_3, order=[2, 1, 3], move_data=.TRUE.) + CALL decompress_tensor(t_3c_int_1, blk_indices(j_mem, i_mem)%ind, store_3c(j_mem, i_mem), & + ri_data%filter_eps_storage) + CALL dbcsr_t_copy(t_3c_int_1, t_3c_int_2, order=[2, 1, 3], move_data=.TRUE.) + + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), t_3c_int_2, t_3c_3, & + dbcsr_scalar(1.0_dp), t_2c_RI_PQ, & + contract_1=[2, 3], notcontract_1=[1], & + contract_2=[2, 3], notcontract_2=[1], & + bounds_1=bounds_ctr_2d, & + map_1=[1], map_2=[2], filter_eps=ri_data%filter_eps, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + + CALL timestop(handle) + + ! 6) If metric, do the additional contraction with S_pq^-1 (Q|R) + IF (.NOT. ri_data%same_op) THEN + + CALL timeset(routineN//"_metric", handle) + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), t_2c_RI_inv, t_3c_3, & + dbcsr_scalar(0.0_dp), t_3c_4, & + contract_1=[2], notcontract_1=[1], & + contract_2=[1], notcontract_2=[2, 3], & + bounds_3=bounds_ctr_2d, & + map_1=[1], map_2=[2, 3], filter_eps=ri_data%filter_eps, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + CALL dbcsr_t_copy(t_3c_4, t_3c_3, move_data=.TRUE.) + + ! 8) And the force due to d/dx S^-1 + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), t_3c_int_2, t_3c_3, & + dbcsr_scalar(1.0_dp), t_2c_RI_met, & + contract_1=[2, 3], notcontract_1=[1], & + contract_2=[2, 3], notcontract_2=[1], & + bounds_1=bounds_ctr_2d, & + map_1=[1], map_2=[2], filter_eps=ri_data%filter_eps, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + CALL timestop(handle) + END IF + CALL dbcsr_t_copy(t_3c_ri_ao_ao, t_3c_int_2) + + ! 7) Do the force contribution due to 3c integrals (a'b|P) and (ab|P') + + ! (ab|P') + bounds_ctr_2d(1, 1) = batch_start(i_mem) + bounds_ctr_2d(2, 1) = batch_end(i_mem) + bounds_ctr_2d(1, 2) = batch_start(j_mem) + bounds_ctr_2d(2, 2) = batch_end(j_mem) + + CALL timeset(routineN//"_3c_RI", handle) + CALL dbcsr_t_copy(t_3c_3, t_3c_RI_ctr, move_data=.TRUE.) + DO i_xyz = 1, 3 + + !Contract into t_2c_RI_ctr, calculate the force later + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), t_3c_der_RI(i_xyz), t_3c_RI_ctr, & + dbcsr_scalar(1.0_dp), t_2c_RI_ctr(i_xyz), & + contract_1=[2, 3], notcontract_1=[1], & + contract_2=[2, 3], notcontract_2=[1], & + map_1=[1], map_2=[2], filter_eps=ri_data%filter_eps, & + bounds_1=bounds_ctr_2d, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + END DO + CALL timestop(handle) + + ! (a'b|P) + bounds_ctr_2d(1, 1) = batch_start(i_mem) + bounds_ctr_2d(2, 1) = batch_end(i_mem) + bounds_ctr_2d(1, 2) = 1 + bounds_ctr_2d(2, 2) = SUM(ri_data%bsizes_RI) + + bounds_ctr_1d(1, 1) = batch_start(j_mem) + bounds_ctr_1d(2, 1) = batch_end(j_mem) + + CALL timeset(routineN//"_3c_AO", handle) + CALL dbcsr_t_copy(t_3c_RI_ctr, t_3c_AO_ctr, order=[2, 1, 3], move_data=.TRUE.) + DO i_xyz = 1, 3 + + !Contract into t_2c_AO_ctr, calculate the force later + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), t_3c_der_AO(i_xyz), t_3c_AO_ctr, & + dbcsr_scalar(1.0_dp), t_2c_AO_ctr(i_xyz), & + contract_1=[1, 2], notcontract_1=[3], & + contract_2=[1, 2], notcontract_2=[3], & + map_1=[1], map_2=[2], filter_eps=ri_data%filter_eps, & + bounds_1=bounds_ctr_2d, & + bounds_2=bounds_ctr_1d, bounds_3=bounds_ctr_1d, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + END DO + CALL timestop(handle) + + !If response matrix, need to consider force contribution from both Pmat + IF (do_resp) THEN + CALL timeset(routineN//"_3c_AO_resp", handle) + bounds_ctr_2d(1, 1) = batch_start(j_mem) + bounds_ctr_2d(2, 1) = batch_end(j_mem) + bounds_ctr_2d(1, 2) = 1 + bounds_ctr_2d(2, 2) = SUM(ri_data%bsizes_RI) + + bounds_ctr_1d(1, 1) = batch_start(i_mem) + bounds_ctr_1d(2, 1) = batch_end(i_mem) + CALL dbcsr_t_copy(t_3c_AO_ctr, t_3c_AO_ctr_resp, order=[3, 2, 1], move_data=.TRUE.) + DO i_xyz = 1, 3 + + CALL dbcsr_t_contract(dbcsr_scalar(1.0_dp), t_3c_der_AO(i_xyz), t_3c_AO_ctr_resp, & + dbcsr_scalar(1.0_dp), t_2c_AO_ctr(i_xyz), & + contract_1=[1, 2], notcontract_1=[3], & + contract_2=[1, 2], notcontract_2=[3], & + map_1=[1], map_2=[2], filter_eps=ri_data%filter_eps, & + bounds_1=bounds_ctr_2d, & + bounds_2=bounds_ctr_1d, bounds_3=bounds_ctr_1d, & + unit_nr=unit_nr_dbcsr, flop=nflop) + ri_data%dbcsr_nflop = ri_data%dbcsr_nflop + nflop + + END DO + CALL timestop(handle) + END IF + + END DO !j_mem + + CALL dbcsr_t_batched_contract_finalize(rho_ao_2) + CALL dbcsr_t_batched_contract_finalize(t_3c_2) + CALL dbcsr_t_batched_contract_finalize(t_3c_0) + + CALL dbcsr_t_batched_contract_finalize(t_2c_RI_PQ) + CALL dbcsr_t_batched_contract_finalize(t_3c_3) + CALL dbcsr_t_batched_contract_finalize(t_3c_int_2) + + DO i_xyz = 1, 3 + CALL dbcsr_t_batched_contract_finalize(t_3c_der_RI(i_xyz)) + CALL dbcsr_t_batched_contract_finalize(t_2c_RI_ctr(i_xyz)) + + CALL dbcsr_t_batched_contract_finalize(t_3c_der_AO(i_xyz)) + CALL dbcsr_t_batched_contract_finalize(t_2c_AO_ctr(i_xyz)) + END DO + CALL dbcsr_t_batched_contract_finalize(t_3c_RI_ctr) + CALL dbcsr_t_batched_contract_finalize(t_3c_AO_ctr) + IF (do_resp) CALL dbcsr_t_batched_contract_finalize(t_3c_AO_ctr_resp) + + IF (.NOT. ri_data%same_op) THEN + CALL dbcsr_t_batched_contract_finalize(t_2c_RI_inv) + CALL dbcsr_t_batched_contract_finalize(t_2c_RI_met) + CALL dbcsr_t_batched_contract_finalize(t_3c_4) + END IF + + !Force contribution due to 3-center RI derivatives (ab|P') + pref = -0.5_dp*2.0_dp*hf_fraction*spin_fac + DO i_xyz = 1, 3 + IF (use_virial_prv) THEN + CALL get_force_from_trace(force, t_2c_RI_ctr(i_xyz), atom_of_kind, kind_of, idx_to_at_RI, pref, & + i_xyz, work_virial, cell, particle_set) + ELSE + CALL get_force_from_trace(force, t_2c_RI_ctr(i_xyz), atom_of_kind, kind_of, idx_to_at_RI, pref, i_xyz) + END IF + CALL dbcsr_t_clear(t_2c_RI_ctr(i_xyz)) + END DO + + !Force contribution due to 3-center AO derivatives (a'b|P) + pref = -0.5_dp*4.0_dp*hf_fraction*spin_fac + IF (do_resp) pref = 0.5_dp*pref + DO i_xyz = 1, 3 + IF (use_virial_prv) THEN + CALL get_force_from_trace(force, t_2c_AO_ctr(i_xyz), atom_of_kind, kind_of, idx_to_at_AO, pref, & + i_xyz, work_virial, cell, particle_set) + ELSE + CALL get_force_from_trace(force, t_2c_AO_ctr(i_xyz), atom_of_kind, kind_of, idx_to_at_AO, pref, i_xyz) + END IF + CALL dbcsr_t_clear(t_2c_AO_ctr(i_xyz)) + END DO + + !Force contribution of d/dx (P|Q) + pref = 0.5_dp*hf_fraction*spin_fac + IF (.NOT. ri_data%same_op) pref = -pref + + !Making sure dists of the t_2c_RI tensors match + CALL dbcsr_t_copy(t_2c_RI_PQ, t_2c_RI, move_data=.TRUE.) + IF (use_virial_prv) THEN + CALL get_2c_der_force(force, t_2c_RI, t_2c_der_RI, atom_of_kind, & + kind_of, idx_to_at_RI, pref, work_virial, cell, particle_set) + ELSE + CALL get_2c_der_force(force, t_2c_RI, t_2c_der_RI, atom_of_kind, & + kind_of, idx_to_at_RI, pref) + + END IF + CALL dbcsr_t_clear(t_2c_RI) + + !Force contribution due to the inverse metric + IF (.NOT. ri_data%same_op) THEN + pref = 0.5_dp*2.0_dp*hf_fraction*spin_fac + + CALL dbcsr_t_copy(t_2c_RI_met, t_2c_RI, move_data=.TRUE.) + IF (use_virial_prv) THEN + CALL get_2c_der_force(force, t_2c_RI, t_2c_der_metric, atom_of_kind, & + kind_of, idx_to_at_RI, pref, work_virial, cell, particle_set) + ELSE + CALL get_2c_der_force(force, t_2c_RI, t_2c_der_metric, atom_of_kind, & + kind_of, idx_to_at_RI, pref) + END IF + CALL dbcsr_t_clear(t_2c_RI) + END IF + + CALL dbcsr_t_clear(t_3c_2) + CALL dbcsr_t_clear(t_3c_3) + CALL dbcsr_t_clear(t_3c_4) + CALL dbcsr_t_clear(t_3c_int_2) + CALL dbcsr_t_clear(t_3c_AO_ctr) + CALL dbcsr_t_clear(t_3c_RI_ctr) + IF (do_resp) CALL dbcsr_t_clear(t_3c_AO_ctr_resp) + END DO !i_mem + + CALL dbcsr_t_batched_contract_finalize(rho_ao_1) + CALL dbcsr_t_batched_contract_finalize(t_3c_int_1) + CALL dbcsr_t_batched_contract_finalize(t_3c_1) + + IF (use_virial_prv) THEN + DO k_xyz = 1, 3 + DO j_xyz = 1, 3 + DO i_xyz = 1, 3 + virial%pv_fock_4c(i_xyz, j_xyz) = virial%pv_fock_4c(i_xyz, j_xyz) & + + work_virial(i_xyz, k_xyz)*cell%hmat(j_xyz, k_xyz) + END DO + END DO + END DO + END IF + + END DO !i_spin + + t2 = m_walltime() + ri_data%dbcsr_time = ri_data%dbcsr_time + t2 - t1 + + !clean-up + CALL dbcsr_t_destroy(rho_ao_1) + CALL dbcsr_t_destroy(rho_ao_2) + CALL dbcsr_t_destroy(t_3c_int_1) + CALL dbcsr_t_destroy(t_3c_int_2) + CALL dbcsr_t_destroy(t_3c_0) + CALL dbcsr_t_destroy(t_3c_1) + CALL dbcsr_t_destroy(t_3c_2) + CALL dbcsr_t_destroy(t_3c_3) + CALL dbcsr_t_destroy(t_3c_4) + CALL dbcsr_t_destroy(t_2c_RI) + CALL dbcsr_t_destroy(t_2c_RI_PQ) + CALL dbcsr_t_destroy(t_3c_RI_ctr) + CALL dbcsr_t_destroy(t_3c_ao_ri_ao) + CALL dbcsr_t_destroy(t_3c_ri_ao_ao) + CALL dbcsr_t_destroy(t_3c_AO_ctr) + IF (do_resp) CALL dbcsr_t_destroy(t_3c_AO_ctr_resp) + DO i_xyz = 1, 3 + CALL dbcsr_t_destroy(t_3c_der_AO(i_xyz)) + CALL dbcsr_t_destroy(t_3c_der_RI(i_xyz)) + CALL dbcsr_t_destroy(t_2c_der_RI(i_xyz)) + IF (.NOT. ri_data%same_op) CALL dbcsr_t_destroy(t_2c_der_metric(i_xyz)) + CALL dbcsr_t_destroy(t_2c_RI_ctr(i_xyz)) + CALL dbcsr_t_destroy(t_2c_AO_ctr(i_xyz)) + END DO + IF (.NOT. ri_data%same_op) THEN + CALL dbcsr_t_destroy(t_2c_RI_inv) + CALL dbcsr_t_destroy(t_2c_RI_met) + END IF + DO i_mem = 1, n_mem + DO j_mem = 1, n_mem + CALL dealloc_containers(store_3c(i_mem, j_mem), dummy) + END DO + END DO + DEALLOCATE (store_3c, blk_indices) + + END SUBROUTINE hfx_ri_forces_Pmat + +! ************************************************************************************************** +!> \brief the general routine that calls the relevant force code +!> \param qs_env ... +!> \param ri_data ... +!> \param nspins ... +!> \param hf_fraction ... +!> \param rho_ao ... +!> \param rho_ao_resp ... +!> \param mos ... +!> \param mos_resp ... +!> \param use_virial ... +!> \param resp_only ... +!> \param rescale_factor ... +! ************************************************************************************************** + SUBROUTINE hfx_ri_update_forces(qs_env, ri_data, nspins, hf_fraction, rho_ao, rho_ao_resp, & + mos, mos_resp, use_virial, resp_only, rescale_factor) + + TYPE(qs_environment_type), POINTER :: qs_env + TYPE(hfx_ri_type), INTENT(INOUT) :: ri_data + INTEGER, INTENT(IN) :: nspins + REAL(KIND=dp), INTENT(IN) :: hf_fraction + TYPE(dbcsr_p_type), DIMENSION(:, :), OPTIONAL :: rho_ao + TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL :: rho_ao_resp + TYPE(mo_set_p_type), DIMENSION(:), OPTIONAL, & + POINTER :: mos, mos_resp + LOGICAL, INTENT(IN), OPTIONAL :: use_virial, resp_only + REAL(dp), INTENT(IN), OPTIONAL :: rescale_factor + + CHARACTER(LEN=*), PARAMETER :: routineN = 'hfx_ri_update_forces' + + INTEGER :: handle, ispin + INTEGER, DIMENSION(2) :: homo + REAL(KIND=dp), DIMENSION(:), POINTER :: mo_eigenvalues + TYPE(cp_1d_r_p_type), DIMENSION(:), POINTER :: occupied_evals + TYPE(cp_fm_p_type), DIMENSION(:), POINTER :: homo_localized, moloc_coeff, & + occupied_orbs + TYPE(cp_fm_type), POINTER :: mo_coeff + TYPE(dbcsr_type), DIMENSION(2) :: mo_coeff_b, mo_coeff_resp + TYPE(dbcsr_type), POINTER :: mo_coeff_b_tmp + TYPE(mo_set_type), POINTER :: mo_set + + CALL timeset(routineN, handle) + + MARK_USED(mos_resp) + + SELECT CASE (ri_data%flavor) + CASE (ri_mo) + + IF (ri_data%do_loc) THEN + ALLOCATE (occupied_orbs(nspins)) + ALLOCATE (occupied_evals(nspins)) + ALLOCATE (homo_localized(nspins)) + ENDIF + DO ispin = 1, nspins + NULLIFY (mo_coeff_b_tmp) + mo_set => mos(ispin)%mo_set + CPASSERT(mo_set%uniform_occupation) + CALL get_mo_set(mo_set=mo_set, mo_coeff=mo_coeff, eigenvalues=mo_eigenvalues, mo_coeff_b=mo_coeff_b_tmp) + + IF (.NOT. ri_data%do_loc) THEN + IF (.NOT. mo_set%use_mo_coeff_b) CALL copy_fm_to_dbcsr(mo_coeff, mo_coeff_b_tmp) + CALL dbcsr_copy(mo_coeff_b(ispin), mo_coeff_b_tmp) + ELSE + IF (mo_set%use_mo_coeff_b) CALL copy_dbcsr_to_fm(mo_coeff_b_tmp, mo_coeff) + CALL dbcsr_create(mo_coeff_b(ispin), template=mo_coeff_b_tmp) + ENDIF + + IF (ri_data%do_loc) THEN + occupied_orbs(ispin)%matrix => mo_coeff + occupied_evals(ispin)%array => mo_eigenvalues + CALL cp_fm_create(homo_localized(ispin)%matrix, occupied_orbs(ispin)%matrix%matrix_struct) + CALL cp_fm_to_fm(occupied_orbs(ispin)%matrix, homo_localized(ispin)%matrix) + ENDIF + ENDDO + + IF (ri_data%do_loc) THEN + CALL qs_loc_env_create(ri_data%qs_loc_env) + CALL qs_loc_control_init(ri_data%qs_loc_env, ri_data%loc_subsection, do_homo=.TRUE.) + CALL qs_loc_init(qs_env, ri_data%qs_loc_env, ri_data%loc_subsection, homo_localized) + DO ispin = 1, nspins + CALL qs_loc_driver(qs_env, ri_data%qs_loc_env, ri_data%print_loc_subsection, ispin, & + ext_mo_coeff=homo_localized(ispin)%matrix) + ENDDO + CALL get_qs_loc_env(qs_loc_env=ri_data%qs_loc_env, moloc_coeff=moloc_coeff) + + DO ispin = 1, nspins + CALL cp_fm_release(homo_localized(ispin)%matrix) + ENDDO + + DEALLOCATE (occupied_orbs, occupied_evals, homo_localized) + + ENDIF + + DO ispin = 1, nspins + mo_set => mos(ispin)%mo_set + IF (ri_data%do_loc) THEN + CALL copy_fm_to_dbcsr(moloc_coeff(ispin)%matrix, mo_coeff_b(ispin)) + ENDIF + CALL dbcsr_scale(mo_coeff_b(ispin), SQRT(mo_set%maxocc)) + homo(ispin) = mo_set%homo + ENDDO + + IF (ri_data%do_loc) CALL qs_loc_env_release(ri_data%qs_loc_env) + + CALL hfx_ri_forces_mo(qs_env, ri_data, nspins, hf_fraction, mo_coeff_b, mo_coeff_resp, use_virial) + + CASE (ri_pmat) + + CALL hfx_ri_forces_Pmat(qs_env, ri_data, nspins, hf_fraction, rho_ao, rho_ao_resp, use_virial, & + resp_only, rescale_factor) + END SELECT + + DO ispin = 1, nspins + CALL dbcsr_release(mo_coeff_b(ispin)) + END DO + + CALL timestop(handle) + + END SUBROUTINE hfx_ri_update_forces + +! ************************************************************************************************** +!> \brief Calculate the derivatives tensors for the force, in a format fit for contractions +!> \param t_3c_der_RI ... +!> \param t_3c_der_AO ... +!> \param t_2c_der_RI ... +!> \param t_2c_der_metric ... +!> \param ri_ao_ao_template ... +!> \param ao_ri_ao_template ... +!> \param ri_data ... +!> \param qs_env ... +! ************************************************************************************************** + SUBROUTINE precalc_derivatives(t_3c_der_RI, t_3c_der_AO, t_2c_der_RI, t_2c_der_metric, & + ri_ao_ao_template, ao_ri_ao_template, ri_data, qs_env) + + TYPE(dbcsr_t_type), DIMENSION(3), INTENT(OUT) :: t_3c_der_RI, t_3c_der_AO, t_2c_der_RI, & + t_2c_der_metric + TYPE(dbcsr_t_type), INTENT(INOUT) :: ri_ao_ao_template, ao_ri_ao_template + TYPE(hfx_ri_type), INTENT(INOUT) :: ri_data + TYPE(qs_environment_type), POINTER :: qs_env + + CHARACTER(LEN=*), PARAMETER :: routineN = 'precalc_derivatives' + + INTEGER :: handle, i_mem, i_xyz, ibasis, & + mp_comm_t3c, n_mem, nkind + INTEGER, ALLOCATABLE, DIMENSION(:) :: dist_AO_1, dist_AO_2, dist_RI, & + dummy_end, dummy_start, end_blocks, & + start_blocks + INTEGER, DIMENSION(3) :: pcoord, pdims + INTEGER, DIMENSION(:), POINTER :: col_bsize, row_bsize + TYPE(dbcsr_distribution_type) :: dbcsr_dist + TYPE(dbcsr_t_type) :: t_2c_tmp, t_3c_template + TYPE(dbcsr_t_type), DIMENSION(1, 1, 3) :: t_3c_der_AO_prv, t_3c_der_RI_prv + TYPE(dbcsr_type), DIMENSION(1, 3) :: t_2c_der_metric_prv, t_2c_der_RI_prv + TYPE(distribution_2d_type), POINTER :: dist_2d + TYPE(distribution_3d_type) :: dist_3d + TYPE(gto_basis_set_p_type), ALLOCATABLE, & + DIMENSION(:), TARGET :: basis_set_AO, basis_set_RI + TYPE(gto_basis_set_type), POINTER :: orb_basis + TYPE(neighbor_list_3c_type) :: nl_3c + TYPE(neighbor_list_set_p_type), DIMENSION(:), & + POINTER :: nl_2c + TYPE(particle_type), DIMENSION(:), POINTER :: particle_set + TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set + + NULLIFY (qs_kind_set, orb_basis, dist_2d, nl_2c, particle_set) + + CALL timeset(routineN, handle) + + CALL get_qs_env(qs_env, nkind=nkind, qs_kind_set=qs_kind_set, distribution_2d=dist_2d, & + particle_set=particle_set) + + ALLOCATE (basis_set_RI(nkind), basis_set_AO(nkind)) + CALL basis_set_list_setup(basis_set_RI, ri_data%ri_basis_type, qs_kind_set) + CALL get_particle_set(particle_set, qs_kind_set, basis=basis_set_RI) + CALL basis_set_list_setup(basis_set_AO, ri_data%orb_basis_type, qs_kind_set) + CALL get_particle_set(particle_set, qs_kind_set, basis=basis_set_AO) + + DO ibasis = 1, SIZE(basis_set_AO) + orb_basis => basis_set_AO(ibasis)%gto_basis_set + CALL init_interaction_radii_orb_basis(orb_basis, ri_data%eps_pgf_orb) + ENDDO + + !Dealing with the 3c derivatives + CALL create_3c_tensor(t_3c_template, dist_RI, dist_AO_1, dist_AO_2, ri_data%pgrid, & + ri_data%bsizes_RI, ri_data%bsizes_AO, ri_data%bsizes_AO, & + map1=[1], map2=[2, 3], & + name="der (RI AO | AO)") + + DO i_xyz = 1, 3 + CALL dbcsr_t_create(t_3c_template, t_3c_der_RI_prv(1, 1, i_xyz)) + CALL dbcsr_t_create(t_3c_template, t_3c_der_AO_prv(1, 1, i_xyz)) + END DO + CALL dbcsr_t_destroy(t_3c_template) + + CALL dbcsr_t_mp_environ_pgrid(ri_data%pgrid, pdims, pcoord) + CALL mp_cart_create(ri_data%pgrid%mp_comm_2d, 3, pdims, pcoord, mp_comm_t3c) + CALL distribution_3d_create(dist_3d, dist_RI, dist_AO_1, dist_AO_2, & + nkind, particle_set, mp_comm_t3c, own_comm=.TRUE.) + DEALLOCATE (dist_RI, dist_AO_1, dist_AO_2) + + CALL build_3c_neighbor_lists(nl_3c, basis_set_RI, basis_set_AO, basis_set_AO, dist_3d, ri_data%ri_metric, & + "HFX_3c_nl", qs_env, op_pos=1, sym_jk=.TRUE., own_dist=.TRUE.) + + !Output tensor must be in a format fit for contraction, with splitted blocks + DO i_xyz = 1, 3 + CALL dbcsr_t_create(ri_ao_ao_template, t_3c_der_RI(i_xyz)) ! (RI | AO AO) format + CALL dbcsr_t_create(ao_ri_ao_template, t_3c_der_AO(i_xyz)) !(AO RI | AO) format + END DO + + n_mem = ri_data%n_mem + CALL create_tensor_batches(ri_data%bsizes_AO, n_mem, dummy_start, dummy_end, & + start_blocks, end_blocks) + DEALLOCATE (dummy_start, dummy_end) + + DO i_mem = 1, n_mem + CALL build_3c_derivatives(t_3c_der_RI_prv, t_3c_der_AO_prv, ri_data%filter_eps, qs_env, & + nl_3c, basis_set_RI, basis_set_AO, basis_set_AO, & + ri_data%ri_metric, der_eps=ri_data%eps_schwarz_forces, op_pos=1, & + bounds_j=[start_blocks(i_mem), end_blocks(i_mem)]) + + DO i_xyz = 1, 3 + CALL dbcsr_t_copy(t_3c_der_RI_prv(1, 1, i_xyz), t_3c_der_RI(i_xyz), & + move_data=.TRUE., summation=.TRUE.) + CALL dbcsr_t_filter(t_3c_der_RI(i_xyz), ri_data%filter_eps) + + CALL dbcsr_t_copy(t_3c_der_AO_prv(1, 1, i_xyz), t_3c_der_AO(i_xyz), order=[2, 1, 3], & + move_data=.TRUE., summation=.TRUE.) + CALL dbcsr_t_filter(t_3c_der_AO(i_xyz), ri_data%filter_eps) + END DO + END DO + + CALL neighbor_list_3c_destroy(nl_3c) + + DO i_xyz = 1, 3 + CALL dbcsr_t_destroy(t_3c_der_RI_prv(1, 1, i_xyz)) + CALL dbcsr_t_destroy(t_3c_der_AO_prv(1, 1, i_xyz)) + END DO + + !Deal with the 2-center derivatives + CALL cp_dbcsr_dist2d_to_dist(dist_2d, dbcsr_dist) + ALLOCATE (row_bsize(SIZE(ri_data%bsizes_RI))) + ALLOCATE (col_bsize(SIZE(ri_data%bsizes_RI))) + row_bsize(:) = ri_data%bsizes_RI + col_bsize(:) = ri_data%bsizes_RI + + CALL build_2c_neighbor_lists(nl_2c, basis_set_RI, basis_set_RI, ri_data%hfx_pot, & + "HFX_2c_nl_pot", qs_env, sym_ij=.TRUE., dist_2d=dist_2d) + + DO i_xyz = 1, 3 + CALL dbcsr_create(t_2c_der_RI_prv(1, i_xyz), "(R|P) HFX der", dbcsr_dist, & + dbcsr_type_antisymmetric, row_bsize, col_bsize) + END DO + + CALL build_2c_derivatives(t_2c_der_RI_prv, ri_data%filter_eps_2c, qs_env, nl_2c, basis_set_RI, & + basis_set_RI, ri_data%hfx_pot) + CALL release_neighbor_list_sets(nl_2c) + + !copy 2c derivative tensor into a format fit for contraction (tensor, splitted blocks) + DO i_xyz = 1, 3 + CALL dbcsr_t_create(t_2c_der_RI_prv(1, i_xyz), t_2c_tmp) + CALL dbcsr_t_copy_matrix_to_tensor(t_2c_der_RI_prv(1, i_xyz), t_2c_tmp) + + CALL dbcsr_t_create(ri_data%t_2c_inv(1, 1), t_2c_der_RI(i_xyz)) + CALL dbcsr_t_copy(t_2c_tmp, t_2c_der_RI(i_xyz), move_data=.TRUE.) + + CALL dbcsr_t_destroy(t_2c_tmp) + CALL dbcsr_release(t_2c_der_RI_prv(1, i_xyz)) + END DO + + !Repeat with the metric, if required + IF (.NOT. ri_data%same_op) THEN + + CALL build_2c_neighbor_lists(nl_2c, basis_set_RI, basis_set_RI, ri_data%ri_metric, & + "HFX_2c_nl_RI", qs_env, sym_ij=.TRUE., dist_2d=dist_2d) + + DO i_xyz = 1, 3 + CALL dbcsr_create(t_2c_der_metric_prv(1, i_xyz), "(R|P) HFX der", dbcsr_dist, & + dbcsr_type_antisymmetric, row_bsize, col_bsize) + END DO + + CALL build_2c_derivatives(t_2c_der_metric_prv, ri_data%filter_eps_2c, qs_env, nl_2c, & + basis_set_RI, basis_set_RI, ri_data%ri_metric) + CALL release_neighbor_list_sets(nl_2c) + + DO i_xyz = 1, 3 + CALL dbcsr_t_create(t_2c_der_metric_prv(1, i_xyz), t_2c_tmp) + CALL dbcsr_t_copy_matrix_to_tensor(t_2c_der_metric_prv(1, i_xyz), t_2c_tmp) + + CALL dbcsr_t_create(ri_data%t_2c_inv(1, 1), t_2c_der_metric(i_xyz)) + CALL dbcsr_t_copy(t_2c_tmp, t_2c_der_metric(i_xyz), move_data=.TRUE.) + + CALL dbcsr_t_destroy(t_2c_tmp) + CALL dbcsr_release(t_2c_der_metric_prv(1, i_xyz)) + END DO + + END IF + + CALL dbcsr_distribution_release(dbcsr_dist) + DEALLOCATE (row_bsize, col_bsize) + + CALL timestop(handle) + + END SUBROUTINE precalc_derivatives + +! ************************************************************************************************** +!> \brief This routines takes a 2D tensor, which trace (sum_ii a_ii) contributes to the forces +!> \param force ... +!> \param t_2c ... +!> \param atom_of_kind ... +!> \param kind_of ... +!> \param idx_to_at ... +!> \param pref ... +!> \param i_xyz ... +!> \param work_virial ... +!> \param cell ... +!> \param particle_set ... +! ************************************************************************************************** + SUBROUTINE get_force_from_trace(force, t_2c, atom_of_kind, kind_of, idx_to_at, pref, i_xyz, & + work_virial, cell, particle_set) + + TYPE(qs_force_type), DIMENSION(:), POINTER :: force + TYPE(dbcsr_t_type), INTENT(INOUT) :: t_2c + INTEGER, DIMENSION(:), INTENT(IN) :: atom_of_kind, kind_of, idx_to_at + REAL(dp), INTENT(IN) :: pref + INTEGER, INTENT(IN) :: i_xyz + REAL(dp), DIMENSION(3, 3), INTENT(INOUT), OPTIONAL :: work_virial + TYPE(cell_type), OPTIONAL, POINTER :: cell + TYPE(particle_type), DIMENSION(:), OPTIONAL, & + POINTER :: particle_set + + CHARACTER(LEN=*), PARAMETER :: routineN = 'get_force_from_trace' + + INTEGER :: blk, handle, i, iat, iat_of_kind, ikind, & + j_xyz + INTEGER, DIMENSION(2) :: ind + LOGICAL :: found, use_virial + REAL(dp) :: new_force + REAL(dp), ALLOCATABLE, DIMENSION(:, :), TARGET :: blk_data + REAL(dp), DIMENSION(3) :: scoord + TYPE(dbcsr_t_iterator_type) :: iter + + CALL timeset(routineN, handle) + + use_virial = .FALSE. + IF (PRESENT(work_virial) .AND. PRESENT(cell) .AND. PRESENT(particle_set)) use_virial = .TRUE. + + !Loop over the blocks, calculate the trace and update the corresponding force + CALL dbcsr_t_iterator_start(iter, t_2c) + DO WHILE (dbcsr_t_iterator_blocks_left(iter)) + CALL dbcsr_t_iterator_next_block(iter, ind, blk) + CALL dbcsr_t_get_block(t_2c, ind, blk_data, found) + CPASSERT(found) + + IF (.NOT. ind(1) == ind(2)) CYCLE + + new_force = 0.0_dp + DO i = 1, SIZE(blk_data, 1) + new_force = new_force + blk_data(i, i) + END DO + + iat = idx_to_at(ind(1)) + iat_of_kind = atom_of_kind(iat) + ikind = kind_of(iat) + + force(ikind)%fock_4c(i_xyz, iat_of_kind) = force(ikind)%fock_4c(i_xyz, iat_of_kind) & + + pref*new_force + + IF (use_virial) THEN + + CALL real_to_scaled(scoord, particle_set(iat)%r, cell) + + DO j_xyz = 1, 3 + work_virial(i_xyz, j_xyz) = work_virial(i_xyz, j_xyz) + pref*new_force*scoord(j_xyz) + END DO + END IF + + DEALLOCATE (blk_data) + END DO + CALL dbcsr_t_iterator_stop(iter) + + CALL timestop(handle) + + END SUBROUTINE get_force_from_trace + +! ************************************************************************************************** +!> \brief Get the force from a contraction of type SUM_a,beta (a|beta') C_a,beta, where beta is an AO +!> and a is a MO +!> \param force ... +!> \param t_mo_coeff ... +!> \param t_2c_MO_AO ... +!> \param atom_of_kind ... +!> \param kind_of ... +!> \param idx_to_at ... +!> \param pref ... +!> \param i_xyz ... +!> \param work_virial ... +!> \param cell ... +!> \param particle_set ... +! ************************************************************************************************** + SUBROUTINE get_MO_AO_force(force, t_mo_coeff, t_2c_MO_AO, atom_of_kind, kind_of, idx_to_at, & + pref, i_xyz, work_virial, cell, particle_set) + + TYPE(qs_force_type), DIMENSION(:), POINTER :: force + TYPE(dbcsr_t_type), INTENT(INOUT) :: t_mo_coeff, t_2c_MO_AO + INTEGER, DIMENSION(:), INTENT(IN) :: atom_of_kind, kind_of, idx_to_at + REAL(dp), INTENT(IN) :: pref + INTEGER, INTENT(IN) :: i_xyz + REAL(dp), DIMENSION(3, 3), INTENT(INOUT), OPTIONAL :: work_virial + TYPE(cell_type), OPTIONAL, POINTER :: cell + TYPE(particle_type), DIMENSION(:), OPTIONAL, & + POINTER :: particle_set + + CHARACTER(LEN=*), PARAMETER :: routineN = 'get_MO_AO_force' + + INTEGER :: blk, handle, iat, iat_of_kind, ikind, & + j_xyz + INTEGER, DIMENSION(2) :: ind + LOGICAL :: found, use_virial + REAL(dp) :: new_force + REAL(dp), ALLOCATABLE, DIMENSION(:, :), TARGET :: mo_ao_blk, mo_coeff_blk + REAL(dp), DIMENSION(3) :: scoord + TYPE(dbcsr_t_iterator_type) :: iter + + CALL timeset(routineN, handle) + + use_virial = .FALSE. + IF (PRESENT(work_virial) .AND. PRESENT(cell) .AND. PRESENT(particle_set)) use_virial = .TRUE. + + CALL dbcsr_t_iterator_start(iter, t_2c_MO_AO) + DO WHILE (dbcsr_t_iterator_blocks_left(iter)) + CALL dbcsr_t_iterator_next_block(iter, ind, blk) + + CALL dbcsr_t_get_block(t_2c_MO_AO, ind, mo_ao_blk, found) + CPASSERT(found) + CALL dbcsr_t_get_block(t_mo_coeff, ind, mo_coeff_blk, found) + + IF (found) THEN + + new_force = pref*SUM(mo_ao_blk(:, :)*mo_coeff_blk(:, :)) + + iat = idx_to_at(ind(2)) !AO index is column index + iat_of_kind = atom_of_kind(iat) + ikind = kind_of(iat) + + force(ikind)%fock_4c(i_xyz, iat_of_kind) = force(ikind)%fock_4c(i_xyz, iat_of_kind) & + + new_force + + IF (use_virial) THEN + + CALL real_to_scaled(scoord, particle_set(iat)%r, cell) + + DO j_xyz = 1, 3 + work_virial(i_xyz, j_xyz) = work_virial(i_xyz, j_xyz) + new_force*scoord(j_xyz) + END DO + END IF + + DEALLOCATE (mo_coeff_blk) + END IF + + DEALLOCATE (mo_ao_blk) + END DO !iter + CALL dbcsr_t_iterator_stop(iter) + + CALL timestop(handle) + + END SUBROUTINE get_MO_AO_force + +! ************************************************************************************************** +!> \brief Update the forces due to the derivative of the a 2-center product d/dR (Q|R) +!> \param force ... +!> \param t_2c_contr A precontracted tensor containing sum_abcdPS (ab|P)(P|Q)^-1 (R|S)^-1 (S|cd) P_ac P_bd +!> \param t_2c_der the d/dR (Q|R) tensor, in all 3 cartesian directions +!> \param atom_of_kind ... +!> \param kind_of ... +!> \param idx_to_at ... +!> \param pref ... +!> \param work_virial ... +!> \param cell ... +!> \param particle_set ... +!> \note IMPORTANT: t_tc_contr and t_2c_der need to have the same distribution +! ************************************************************************************************** + SUBROUTINE get_2c_der_force(force, t_2c_contr, t_2c_der, atom_of_kind, kind_of, idx_to_at, & + pref, work_virial, cell, particle_set) + + TYPE(qs_force_type), DIMENSION(:), POINTER :: force + TYPE(dbcsr_t_type), INTENT(INOUT) :: t_2c_contr + TYPE(dbcsr_t_type), DIMENSION(3), INTENT(INOUT) :: t_2c_der + INTEGER, DIMENSION(:), INTENT(IN) :: atom_of_kind, kind_of, idx_to_at + REAL(dp), INTENT(IN) :: pref + REAL(dp), DIMENSION(3, 3), INTENT(INOUT), OPTIONAL :: work_virial + TYPE(cell_type), OPTIONAL, POINTER :: cell + TYPE(particle_type), DIMENSION(:), OPTIONAL, & + POINTER :: particle_set + + CHARACTER(LEN=*), PARAMETER :: routineN = 'get_2c_der_force' + + INTEGER :: blk, handle, i_xyz, iat, iat_of_kind, & + ikind, j_xyz, jat, jat_of_kind, jkind + INTEGER, DIMENSION(2) :: ind + LOGICAL :: found, use_virial + REAL(dp) :: new_force + REAL(dp), ALLOCATABLE, DIMENSION(:, :), TARGET :: contr_blk, der_blk + REAL(dp), DIMENSION(3) :: scoord + TYPE(dbcsr_t_iterator_type) :: iter + + !Loop over the blocks of d/dR (Q|R), contract with the corresponding block of t_2c_contr and + !update the relevant force + + CALL timeset(routineN, handle) + + use_virial = .FALSE. + IF (PRESENT(work_virial) .AND. PRESENT(cell) .AND. PRESENT(particle_set)) use_virial = .TRUE. + + DO i_xyz = 1, 3 + CALL dbcsr_t_iterator_start(iter, t_2c_der(i_xyz)) + DO WHILE (dbcsr_t_iterator_blocks_left(iter)) + CALL dbcsr_t_iterator_next_block(iter, ind, blk) + + IF (ind(1) == ind(2)) CYCLE + + CALL dbcsr_t_get_block(t_2c_der(i_xyz), ind, der_blk, found) + CPASSERT(found) + CALL dbcsr_t_get_block(t_2c_contr, ind, contr_blk, found) + + IF (found) THEN + + !an element of d/dR (Q|R) corresponds to 2 things because of translational invariance + !(Q'| R) = - (Q| R'), once wrt the center on Q, and once on R + new_force = pref*SUM(der_blk(:, :)*contr_blk(:, :)) + + iat = idx_to_at(ind(1)) + iat_of_kind = atom_of_kind(iat) + ikind = kind_of(iat) + + force(ikind)%fock_4c(i_xyz, iat_of_kind) = force(ikind)%fock_4c(i_xyz, iat_of_kind) & + + new_force + + IF (use_virial) THEN + + CALL real_to_scaled(scoord, particle_set(iat)%r, cell) + + DO j_xyz = 1, 3 + work_virial(i_xyz, j_xyz) = work_virial(i_xyz, j_xyz) + new_force*scoord(j_xyz) + END DO + END IF + + jat = idx_to_at(ind(2)) + jat_of_kind = atom_of_kind(jat) + jkind = kind_of(jat) + + force(jkind)%fock_4c(i_xyz, jat_of_kind) = force(jkind)%fock_4c(i_xyz, jat_of_kind) & + - new_force + + IF (use_virial) THEN + + CALL real_to_scaled(scoord, particle_set(jat)%r, cell) + + DO j_xyz = 1, 3 + work_virial(i_xyz, j_xyz) = work_virial(i_xyz, j_xyz) + new_force*scoord(j_xyz) + END DO + END IF + + DEALLOCATE (contr_blk) + END IF + + DEALLOCATE (der_blk) + END DO !iter + CALL dbcsr_t_iterator_stop(iter) + + END DO !i_xyz + + CALL timestop(handle) + + END SUBROUTINE get_2c_der_force + +! ************************************************************************************************** +!> \brief a small utility function that returns the atom corresponding to a block of a split tensor +!> \param idx_to_at ... +!> \param bsizes_split ... +!> \param bsizes_orig ... +!> \return ... +! ************************************************************************************************** + SUBROUTINE get_idx_to_atom(idx_to_at, bsizes_split, bsizes_orig) + INTEGER, DIMENSION(:), INTENT(INOUT) :: idx_to_at + INTEGER, DIMENSION(:), INTENT(IN) :: bsizes_split, bsizes_orig + + INTEGER :: full_sum, iat, iblk, split_sum + + iat = 1 + full_sum = bsizes_orig(iat) + split_sum = 0 + DO iblk = 1, SIZE(bsizes_split) + split_sum = split_sum + bsizes_split(iblk) + + IF (split_sum .GT. full_sum) THEN + iat = iat + 1 + full_sum = full_sum + bsizes_orig(iat) + END IF + + idx_to_at(iblk) = iat + END DO + + END SUBROUTINE get_idx_to_atom + ! ************************************************************************************************** !> \brief Function for calculating sqrt of a matrix !> \param values ... diff --git a/src/hfx_types.F b/src/hfx_types.F index bab239e2ca..22e662a224 100644 --- a/src/hfx_types.F +++ b/src/hfx_types.F @@ -36,14 +36,14 @@ MODULE hfx_types USE cp_log_handling, ONLY: cp_get_default_logger,& cp_logger_type USE cp_output_handling, ONLY: cp_print_key_finished_output,& - cp_print_key_unit_nr + cp_print_key_unit_nr,& + debug_print_level USE cp_para_types, ONLY: cp_para_env_type USE cp_units, ONLY: cp_unit_from_cp2k USE dbcsr_tensor_api, ONLY: & - dbcsr_t_batched_contract_finalize, dbcsr_t_default_distvec, dbcsr_t_destroy, & - dbcsr_t_distribution_destroy, dbcsr_t_distribution_new, dbcsr_t_distribution_type, & - dbcsr_t_mp_dims_create, dbcsr_t_pgrid_create, dbcsr_t_pgrid_destroy, dbcsr_t_pgrid_type, & - dbcsr_t_type + dbcsr_t_create, dbcsr_t_default_distvec, dbcsr_t_destroy, dbcsr_t_distribution_destroy, & + dbcsr_t_distribution_new, dbcsr_t_distribution_type, dbcsr_t_mp_dims_create, & + dbcsr_t_pgrid_create, dbcsr_t_pgrid_destroy, dbcsr_t_pgrid_type, dbcsr_t_type USE hfx_helpers, ONLY: count_cells_perd,& next_image_cell_perd USE input_constants, ONLY: & @@ -55,7 +55,8 @@ MODULE hfx_types USE input_section_types, ONLY: section_vals_get,& section_vals_get_subs_vals,& section_vals_type,& - section_vals_val_get + section_vals_val_get,& + section_vals_val_set USE kinds, ONLY: default_path_length,& default_string_length,& dp,& @@ -375,7 +376,7 @@ MODULE hfx_types REAL(KIND=dp) :: filter_eps, filter_eps_2c, filter_eps_storage, filter_eps_mo, & eps_lanczos, eps_pgf_orb, eps_eigval INTEGER :: t2c_sqrt_order, max_iter_lanczos, flavor, unit_nr_dbcsr, unit_nr, & - min_bsize, min_bsize_MO, t2c_method, nelectron_total + min_bsize, max_bsize_MO, t2c_method, nelectron_total LOGICAL :: check_2c_inv, calc_condnum TYPE(libint_potential_type) :: ri_metric @@ -383,6 +384,7 @@ MODULE hfx_types ! input parameters from hfx TYPE(libint_potential_type) :: hfx_pot ! interaction potential REAL(KIND=dp) :: eps_schwarz ! integral screening threshold + REAL(KIND=dp) :: eps_schwarz_forces ! integral derivatives screening threshold LOGICAL :: same_op ! whether RI operator is same as HF potential @@ -411,12 +413,13 @@ MODULE hfx_types ! Note: changed static DIMENSION(1,1) of dbcsr_t_type to allocatables as workaround for gfortran 8.3.0, ! with static dimension gfortran gets stuck during compilation + ! 2c tensors in (RI | RI) format for forces + TYPE(dbcsr_t_type), DIMENSION(:, :), ALLOCATABLE :: t_2c_inv + TYPE(dbcsr_t_type), DIMENSION(:, :), ALLOCATABLE :: t_2c_pot + ! 2c tensor in (RI | RI) format for contraction TYPE(dbcsr_t_type), DIMENSION(:, :), ALLOCATABLE :: t_2c_int - ! 3c integral tensor in default format - TYPE(dbcsr_t_type), DIMENSION(:, :), ALLOCATABLE :: t_3c_int - ! 3c integral tensor in (AO RI | AO) format for contraction TYPE(dbcsr_t_type), DIMENSION(:, :), ALLOCATABLE :: t_3c_int_ctr_1 TYPE(block_ind_type), DIMENSION(:, :), ALLOCATABLE :: blk_indices @@ -974,7 +977,7 @@ CONTAINS CALL hfx_ri_init_read_input_from_hfx(actual_x_data%ri_data, actual_x_data, hfx_section, & hf_sub_section, qs_kind_set, & particle_set, atomic_kind_set, dft_control, para_env, irep, do_ot, & - nelectron_total) + nelectron_total, my_do_exx) ENDIF END DO @@ -1001,9 +1004,11 @@ CONTAINS !> \param irep ... !> \param do_ot ... !> \param nelectron_total ... +!> \param do_exx ... ! ************************************************************************************************** SUBROUTINE hfx_ri_init_read_input_from_hfx(ri_data, x_data, hfx_section, ri_section, qs_kind_set, & - particle_set, atomic_kind_set, dft_control, para_env, irep, do_ot, nelectron_total) + particle_set, atomic_kind_set, dft_control, para_env, irep, & + do_ot, nelectron_total, do_exx) TYPE(hfx_ri_type), INTENT(INOUT) :: ri_data TYPE(hfx_type), INTENT(INOUT) :: x_data TYPE(section_vals_type), POINTER :: hfx_section, ri_section @@ -1015,6 +1020,7 @@ CONTAINS INTEGER, INTENT(IN) :: irep LOGICAL, INTENT(IN) :: do_ot INTEGER, INTENT(IN) :: nelectron_total + LOGICAL, INTENT(IN) :: do_exx CHARACTER(LEN=*), PARAMETER :: routineN = 'hfx_ri_init_read_input_from_hfx' @@ -1037,6 +1043,7 @@ CONTAINS ri_data%ri_section => ri_section ri_data%hfx_section => hfx_section ri_data%eps_schwarz = x_data%screening_parameter%eps_schwarz + ri_data%eps_schwarz_forces = x_data%screening_parameter%eps_schwarz_forces logger => cp_get_default_logger() unit_nr_dbcsr = cp_print_key_unit_nr(logger, ri_data%ri_section, "RI_INFO", & @@ -1057,7 +1064,7 @@ CONTAINS t_c_filename = char_val END IF - IF (dft_control%do_admm) THEN + IF (dft_control%do_admm .AND. (.NOT. do_exx)) THEN orb_basis_type = "AUX_FIT" ELSE orb_basis_type = "ORB" @@ -1112,6 +1119,7 @@ CONTAINS INTEGER :: handle LOGICAL :: explicit REAL(dp) :: eps_storage_scaling + TYPE(section_vals_type), POINTER :: prog_run_info CALL timeset(routineN, handle) @@ -1148,7 +1156,7 @@ CONTAINS CALL section_vals_val_get(ri_section, "RI_FLAVOR", i_val=ri_data%flavor) CALL section_vals_val_get(ri_section, "EPS_PGF_ORB", r_val=ri_data%eps_pgf_orb) CALL section_vals_val_get(ri_section, "MIN_BLOCK_SIZE", i_val=ri_data%min_bsize) - CALL section_vals_val_get(ri_section, "MIN_BLOCK_SIZE_MO", i_val=ri_data%min_bsize_MO) + CALL section_vals_val_get(ri_section, "MAX_BLOCK_SIZE_MO", i_val=ri_data%max_bsize_MO) CALL section_vals_val_get(ri_section, "MEMORY_CUT", i_val=ri_data%n_mem) IF (ri_data%flavor == ri_pmat) THEN @@ -1169,6 +1177,9 @@ CONTAINS ri_data%loc_subsection => section_vals_get_subs_vals(ri_section, "LOCALIZE") ri_data%print_loc_subsection => section_vals_get_subs_vals(ri_data%loc_subsection, "PRINT") + prog_run_info => section_vals_get_subs_vals(ri_data%print_loc_subsection, "PROGRAM_RUN_INFO") + CALL section_vals_val_set(prog_run_info, keyword_name="_SECTION_PARAMETERS_", & + i_val=debug_print_level) !keep output clean CALL section_vals_val_get(ri_data%loc_subsection, "_SECTION_PARAMETERS_", l_val=ri_data%do_loc) @@ -1347,12 +1358,12 @@ CONTAINS DEALLOCATE (dist1, dist2) ELSEIF (ri_data%flavor == ri_mo) THEN - ALLOCATE (ri_data%t_3c_int(1, 1)) ALLOCATE (ri_data%t_2c_int(2, 1)) CALL create_2c_tensor(ri_data%t_2c_int(1, 1), dist1, dist2, ri_data%pgrid_2d, & ri_data%bsizes_RI_fit, ri_data%bsizes_RI_fit, & name="(RI | RI)") + CALL dbcsr_t_create(ri_data%t_2c_int(1, 1), ri_data%t_2c_int(2, 1)) DEALLOCATE (dist1, dist2) @@ -1370,7 +1381,7 @@ CONTAINS ! is larger than this (it is however not a problem for load balancing if actual MO dimension ! is slightly smaller) MO_dim = MAX((ri_data%nelectron_total/2 - 1)/ri_data%n_mem + 1, 1) - MO_dim = (MO_dim - 1)/ri_data%min_bsize_MO + 1 + MO_dim = (MO_dim - 1)/ri_data%max_bsize_MO + 1 pdims = 0 CALL dbcsr_t_mp_dims_create(nproc, pdims, [SIZE(ri_data%bsizes_AO_split), SIZE(ri_data%bsizes_RI_split), MO_dim]) @@ -1391,6 +1402,19 @@ CONTAINS ENDIF + !For forces + ALLOCATE (ri_data%t_2c_inv(1, 1)) + CALL create_2c_tensor(ri_data%t_2c_inv(1, 1), dist1, dist2, ri_data%pgrid_2d, & + ri_data%bsizes_RI_split, ri_data%bsizes_RI_split, & + name="(RI | RI)") + DEALLOCATE (dist1, dist2) + + ALLOCATE (ri_data%t_2c_pot(1, 1)) + CALL create_2c_tensor(ri_data%t_2c_pot(1, 1), dist1, dist2, ri_data%pgrid_2d, & + ri_data%bsizes_RI_split, ri_data%bsizes_RI_split, & + name="(RI | RI)") + DEALLOCATE (dist1, dist2) + ri_data%dbcsr_nflop = 0 ri_data%dbcsr_time = 0.0_dp ri_data%num_pe = para_env%num_pe @@ -1499,15 +1523,14 @@ CONTAINS DEALLOCATE (ri_data%t_3c_int_ctr_2) DO ispin = 1, SIZE(ri_data%t_3c_int_mo, 1) - CALL dbcsr_t_batched_contract_finalize(ri_data%t_2c_int(ispin, 1)) - CALL dbcsr_t_batched_contract_finalize(ri_data%t_3c_int_mo(ispin, 1, 1)) - CALL dbcsr_t_batched_contract_finalize(ri_data%t_3c_ctr_RI(ispin, 1, 1)) - CALL dbcsr_t_destroy(ri_data%t_2c_int(ispin, 1)) CALL dbcsr_t_destroy(ri_data%t_3c_int_mo(ispin, 1, 1)) CALL dbcsr_t_destroy(ri_data%t_3c_ctr_RI(ispin, 1, 1)) CALL dbcsr_t_destroy(ri_data%t_3c_ctr_KS(ispin, 1, 1)) CALL dbcsr_t_destroy(ri_data%t_3c_ctr_KS_copy(ispin, 1, 1)) ENDDO + DO ispin = 1, 2 + CALL dbcsr_t_destroy(ri_data%t_2c_int(ispin, 1)) + ENDDO DEALLOCATE (ri_data%t_2c_int) DEALLOCATE (ri_data%t_3c_int_mo) DEALLOCATE (ri_data%t_3c_ctr_RI) @@ -1515,6 +1538,11 @@ CONTAINS DEALLOCATE (ri_data%t_3c_ctr_KS_copy) ENDIF + CALL dbcsr_t_destroy(ri_data%t_2c_inv(1, 1)) + DEALLOCATE (ri_data%t_2c_inv) + CALL dbcsr_t_destroy(ri_data%t_2c_pot(1, 1)) + DEALLOCATE (ri_data%t_2c_pot) + CALL timestop(handle) END SUBROUTINE @@ -2633,10 +2661,12 @@ CONTAINS "HFX_RI_INFO| EPS_PGF_ORB", ri_data%eps_pgf_orb WRITE (UNIT=iw, FMT="((T3, A, T73, ES8.1))") & "HFX_RI_INFO| EPS_SCHWARZ: ", ri_data%eps_schwarz + WRITE (UNIT=iw, FMT="((T3, A, T73, ES8.1))") & + "HFX_RI_INFO| EPS_SCHWARZ_FORCES: ", ri_data%eps_schwarz_forces WRITE (UNIT=iw, FMT="(T3, A, T78, I3)") & "HFX_RI_INFO| Minimum block size", ri_data%min_bsize WRITE (UNIT=iw, FMT="(T3, A, T78, I3)") & - "HFX_RI_INFO| MO block size", ri_data%min_bsize_MO + "HFX_RI_INFO| MO block size", ri_data%max_bsize_MO SELECT CASE (ri_data%flavor) CASE (ri_mo) WRITE (UNIT=iw, FMT="(T3, A, T79, I2)") & diff --git a/src/input_cp2k_hfx.F b/src/input_cp2k_hfx.F index b16a1e3efc..3914a2855f 100644 --- a/src/input_cp2k_hfx.F +++ b/src/input_cp2k_hfx.F @@ -633,8 +633,8 @@ CONTAINS CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) - CALL keyword_create(keyword, __LOCATION__, name="MIN_BLOCK_SIZE_MO", & - description="Minimum tensor block size for MOs.", & + CALL keyword_create(keyword, __LOCATION__, name="MAX_BLOCK_SIZE_MO", & + description="Maximum tensor block size for MOs.", & default_i_val=64) CALL section_add_keyword(section, keyword) CALL keyword_release(keyword) diff --git a/src/libint_2c_3c.F b/src/libint_2c_3c.F index f0d52991ea..c416fa9756 100644 --- a/src/libint_2c_3c.F +++ b/src/libint_2c_3c.F @@ -20,9 +20,12 @@ MODULE libint_2c_3c do_potential_truncated USE kinds, ONLY: default_path_length,& dp - USE libint_wrapper, ONLY: cp_libint_get_2eris,& + USE libint_wrapper, ONLY: cp_libint_get_2eri_derivs,& + cp_libint_get_2eris,& + cp_libint_get_3eri_derivs,& cp_libint_get_3eris,& cp_libint_set_params_eri,& + cp_libint_set_params_eri_deriv,& cp_libint_t,& prim_data_f_size USE mathconstants, ONLY: pi @@ -37,7 +40,8 @@ MODULE libint_2c_3c CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'libint_2c_3c' - PUBLIC :: eri_3center, eri_2center, cutoff_screen_factor, libint_potential_type, compare_potential_types + PUBLIC :: eri_3center, eri_2center, cutoff_screen_factor, libint_potential_type, & + eri_3center_derivs, eri_2center_derivs, compare_potential_types ! For screening of integrals with a truncated potential, it is important to use a slightly larger ! cutoff radius due to the discontinuity of the truncated Coulomb potential at the cutoff radius. @@ -119,7 +123,7 @@ CONTAINS REAL(KIND=dp), INTENT(IN) :: dab, dac, dbc TYPE(cp_libint_t), INTENT(INOUT) :: lib TYPE(libint_potential_type), INTENT(IN) :: potential_parameter - REAL(dp), INTENT(OUT), OPTIONAL :: int_abc_ext + REAL(dp), INTENT(INOUT), OPTIONAL :: int_abc_ext INTEGER :: a_mysize(1), a_offset, a_start, b_offset, b_start, c_offset, c_start, i, ipgf, j, & jpgf, k, kpgf, li, lj, lk, ncoa, ncob, ncoc, op, p1, p2, p3 @@ -175,7 +179,7 @@ CONTAINS c_start = (kpgf - 1)*ncoset(lc_max) !start with all the (c|ba) integrals (standard order) and keep to lb >= la - CALL set_params_3c(lib, ra, rb, rc, la_max, lb_max, lc_max, zeti, zetj, zetk, & + CALL set_params_3c(lib, ra, rb, rc, zeti, zetj, zetk, la_max, lb_max, lc_max, & potential_parameter=potential_parameter, params_out=params) DO li = la_min, la_max @@ -279,12 +283,12 @@ CONTAINS !> \param ri ... !> \param rj ... !> \param rk ... -!> \param li_max ... -!> \param lj_max ... -!> \param lk_max ... !> \param zeti ... !> \param zetj ... !> \param zetk ... +!> \param li_max ... +!> \param lj_max ... +!> \param lk_max ... !> \param potential_parameter ... !> \param params_in external parameters to use for libint !> \param params_out returns the libint parameters computed based on the other arguments @@ -292,13 +296,13 @@ CONTAINS !> centers 3 and 4 because of angular momenta and pretty much all the parameters of libint !> remain the same upon such a change => might avoid recomputing things over and over again ! ************************************************************************************************** - SUBROUTINE set_params_3c(lib, ri, rj, rk, li_max, lj_max, lk_max, zeti, zetj, zetk, & + SUBROUTINE set_params_3c(lib, ri, rj, rk, zeti, zetj, zetk, li_max, lj_max, lk_max, & potential_parameter, params_in, params_out) TYPE(cp_libint_t), INTENT(INOUT) :: lib REAL(dp), DIMENSION(3), INTENT(IN) :: ri, rj, rk - INTEGER, INTENT(IN), OPTIONAL :: li_max, lj_max, lk_max REAL(dp), INTENT(IN), OPTIONAL :: zeti, zetj, zetk + INTEGER, INTENT(IN), OPTIONAL :: li_max, lj_max, lk_max TYPE(libint_potential_type), INTENT(IN), OPTIONAL :: potential_parameter TYPE(params_3c), OPTIONAL, POINTER :: params_in, params_out @@ -393,6 +397,373 @@ CONTAINS END SUBROUTINE set_params_3c +! ************************************************************************************************** +!> \brief Computes the derivatives of the 3-center electron repulsion integrals (ab|c) for a given +!> set of cartesian gaussian orbitals. Returns x,y,z derivatives for 1st and 2nd center +!> \param der_abc_1 the derivatives for the 1st center (allocated before hand) +!> \param der_abc_2 the derivatives for the 2nd center (allocated before hand) +!> \param la_min ... +!> \param la_max ... +!> \param npgfa ... +!> \param zeta ... +!> \param rpgfa ... +!> \param ra ... +!> \param lb_min ... +!> \param lb_max ... +!> \param npgfb ... +!> \param zetb ... +!> \param rpgfb ... +!> \param rb ... +!> \param lc_min ... +!> \param lc_max ... +!> \param npgfc ... +!> \param zetc ... +!> \param rpgfc ... +!> \param rc ... +!> \param dab ... +!> \param dac ... +!> \param dbc ... +!> \param lib the libint_t object for evaluation (assume that it is initialized outside) +!> \param potential_parameter the info about the potential +!> \param der_abc_1_ext the extremal value of der_abc_1, i.e., MAXVAL(ABS(der_abc_1)) +!> \param der_abc_2_ext ... +!> \note Prior to calling this routine, the cp_libint_t type passed as argument must be initialized, +!> the libint library must be static initialized, and in case of truncated Coulomb operator, +!> the latter must be initialized too. Note that the derivative wrt to the third center +!> can be obtained via translational invariance +! ************************************************************************************************** + SUBROUTINE eri_3center_derivs(der_abc_1, der_abc_2, & + la_min, la_max, npgfa, zeta, rpgfa, ra, & + lb_min, lb_max, npgfb, zetb, rpgfb, rb, & + lc_min, lc_max, npgfc, zetc, rpgfc, rc, & + dab, dac, dbc, lib, potential_parameter, & + der_abc_1_ext, der_abc_2_ext) + + REAL(dp), DIMENSION(:, :, :, :), INTENT(INOUT) :: der_abc_1, der_abc_2 + INTEGER, INTENT(IN) :: la_min, la_max, npgfa + REAL(dp), DIMENSION(:), INTENT(IN) :: zeta, rpgfa + REAL(dp), DIMENSION(3), INTENT(IN) :: ra + INTEGER, INTENT(IN) :: lb_min, lb_max, npgfb + REAL(dp), DIMENSION(:), INTENT(IN) :: zetb, rpgfb + REAL(dp), DIMENSION(3), INTENT(IN) :: rb + INTEGER, INTENT(IN) :: lc_min, lc_max, npgfc + REAL(dp), DIMENSION(:), INTENT(IN) :: zetc, rpgfc + REAL(dp), DIMENSION(3), INTENT(IN) :: rc + REAL(KIND=dp), INTENT(IN) :: dab, dac, dbc + TYPE(cp_libint_t), INTENT(INOUT) :: lib + TYPE(libint_potential_type), INTENT(IN) :: potential_parameter + REAL(dp), DIMENSION(3), INTENT(OUT), OPTIONAL :: der_abc_1_ext, der_abc_2_ext + + INTEGER :: a_mysize(1), a_offset, a_start, b_offset, b_start, c_offset, c_start, i, i_deriv, & + ipgf, j, jpgf, k, kpgf, li, lj, lk, ncoa, ncob, ncoc, op, p1, p2, p3 + INTEGER, DIMENSION(3) :: permute_1, permute_2 + LOGICAL :: do_ext + REAL(dp) :: dr_ab, dr_ac, dr_bc, zeti, zetj, zetk + REAL(dp), DIMENSION(3) :: der_abc_1_ext_prv, der_abc_2_ext_prv + REAL(dp), DIMENSION(:, :), POINTER :: p_deriv + TYPE(params_3c), POINTER :: params + + NULLIFY (params, p_deriv) + ALLOCATE (params) + + permute_1 = [4, 5, 6] + permute_2 = [7, 8, 9] + + dr_ab = 0.0_dp + dr_bc = 0.0_dp + dr_ac = 0.0_dp + + op = potential_parameter%potential_type + + IF (op == do_potential_truncated .OR. op == do_potential_short) THEN + dr_bc = potential_parameter%cutoff_radius*cutoff_screen_factor + dr_ac = potential_parameter%cutoff_radius*cutoff_screen_factor + ELSEIF (op == do_potential_coulomb) THEN + dr_bc = 1000000.0_dp + dr_ac = 1000000.0_dp + ENDIF + + do_ext = .FALSE. + IF (PRESENT(der_abc_1_ext) .OR. PRESENT(der_abc_2_ext)) do_ext = .TRUE. + der_abc_1_ext_prv = 0.0_dp + der_abc_2_ext_prv = 0.0_dp + + !Note: we want to compute all possible integrals based on the 3-centers (ab|c) before + ! having to switch to (ba|c) (or the other way around) due to angular momenta in libint + ! For a triplet of centers (k|ji), we can only compute integrals for which lj >= li + + !Looping over the pgfs + DO ipgf = 1, npgfa + zeti = zeta(ipgf) + a_start = (ipgf - 1)*ncoset(la_max) + + DO jpgf = 1, npgfb + + ! screening + IF (rpgfa(ipgf) + rpgfb(jpgf) + dr_ab < dab) CYCLE + + zetj = zetb(jpgf) + b_start = (jpgf - 1)*ncoset(lb_max) + + DO kpgf = 1, npgfc + + ! screening + IF (rpgfb(jpgf) + rpgfc(kpgf) + dr_bc < dbc) CYCLE + IF (rpgfa(ipgf) + rpgfc(kpgf) + dr_ac < dac) CYCLE + + zetk = zetc(kpgf) + c_start = (kpgf - 1)*ncoset(lc_max) + + !start with all the (c|ba) integrals (standard order) and keep to lb >= la + CALL set_params_3c_deriv(lib, ra, rb, rc, zeti, zetj, zetk, la_max, lb_max, lc_max, & + potential_parameter=potential_parameter, params_out=params) + + DO li = la_min, la_max + a_offset = a_start + ncoset(li - 1) + ncoa = nco(li) + DO lj = MAX(li, lb_min), lb_max + b_offset = b_start + ncoset(lj - 1) + ncob = nco(lj) + DO lk = lc_min, lc_max + c_offset = c_start + ncoset(lk - 1) + ncoc = nco(lk) + + a_mysize(1) = ncoa*ncob*ncoc + + CALL cp_libint_get_3eri_derivs(li, lj, lk, lib, p_deriv, a_mysize) + + IF (do_ext) THEN + DO k = 1, ncoc + p1 = (k - 1)*ncob + DO j = 1, ncob + p2 = (p1 + j - 1)*ncoa + DO i = 1, ncoa + p3 = p2 + i + + DO i_deriv = 1, 3 + der_abc_1(a_offset + i, b_offset + j, c_offset + k, i_deriv) = & + p_deriv(p3, permute_2(i_deriv)) + der_abc_1_ext_prv(i_deriv) = MAX(der_abc_1_ext_prv(i_deriv), & + ABS(p_deriv(p3, permute_2(i_deriv)))) + + der_abc_2(a_offset + i, b_offset + j, c_offset + k, i_deriv) = & + p_deriv(p3, permute_1(i_deriv)) + der_abc_2_ext_prv(i_deriv) = MAX(der_abc_2_ext_prv(i_deriv), & + ABS(p_deriv(p3, permute_1(i_deriv)))) + + END DO + END DO + END DO + END DO + ELSE + DO k = 1, ncoc + p1 = (k - 1)*ncob + DO j = 1, ncob + p2 = (p1 + j - 1)*ncoa + DO i = 1, ncoa + p3 = p2 + i + + DO i_deriv = 1, 3 + der_abc_1(a_offset + i, b_offset + j, c_offset + k, i_deriv) = & + p_deriv(p3, permute_2(i_deriv)) + + der_abc_2(a_offset + i, b_offset + j, c_offset + k, i_deriv) = & + p_deriv(p3, permute_1(i_deriv)) + END DO + END DO + END DO + END DO + ENDIF + + DEALLOCATE (p_deriv) + END DO !lk + END DO !lj + END DO !li + + !swap centers 3 and 4 to compute (c|ab) with lb < la + CALL set_params_3c_deriv(lib, rb, ra, rc, zetj, zeti, zetk, params_in=params) + + DO lj = lb_min, lb_max + b_offset = b_start + ncoset(lj - 1) + ncob = nco(lj) + DO li = MAX(lj + 1, la_min), la_max + a_offset = a_start + ncoset(li - 1) + ncoa = nco(li) + DO lk = lc_min, lc_max + c_offset = c_start + ncoset(lk - 1) + ncoc = nco(lk) + + a_mysize(1) = ncoa*ncob*ncoc + CALL cp_libint_get_3eri_derivs(lj, li, lk, lib, p_deriv, a_mysize) + + IF (do_ext) THEN + DO k = 1, ncoc + p1 = (k - 1)*ncoa + DO i = 1, ncoa + p2 = (p1 + i - 1)*ncob + DO j = 1, ncob + p3 = p2 + j + + DO i_deriv = 1, 3 + der_abc_1(a_offset + i, b_offset + j, c_offset + k, i_deriv) = & + p_deriv(p3, permute_1(i_deriv)) + + der_abc_1_ext_prv(i_deriv) = MAX(der_abc_1_ext_prv(i_deriv), & + ABS(p_deriv(p3, permute_1(i_deriv)))) + + der_abc_2(a_offset + i, b_offset + j, c_offset + k, i_deriv) = & + p_deriv(p3, permute_2(i_deriv)) + + der_abc_2_ext_prv(i_deriv) = MAX(der_abc_2_ext_prv(i_deriv), & + ABS(p_deriv(p3, permute_2(i_deriv)))) + END DO + END DO + END DO + END DO + ELSE + DO k = 1, ncoc + p1 = (k - 1)*ncoa + DO i = 1, ncoa + p2 = (p1 + i - 1)*ncob + DO j = 1, ncob + p3 = p2 + j + + DO i_deriv = 1, 3 + der_abc_1(a_offset + i, b_offset + j, c_offset + k, i_deriv) = & + p_deriv(p3, permute_1(i_deriv)) + + der_abc_2(a_offset + i, b_offset + j, c_offset + k, i_deriv) = & + p_deriv(p3, permute_2(i_deriv)) + END DO + END DO + END DO + END DO + ENDIF + + DEALLOCATE (p_deriv) + END DO !lk + END DO !li + END DO !lj + + END DO !kpgf + END DO !jpgf + END DO !ipgf + + IF (PRESENT(der_abc_1_ext)) der_abc_1_ext = der_abc_1_ext_prv + IF (PRESENT(der_abc_2_ext)) der_abc_2_ext = der_abc_2_ext_prv + + DEALLOCATE (params) + + END SUBROUTINE eri_3center_derivs + +! ************************************************************************************************** +!> \brief Sets the internals of the cp_libint_t object for derivatives of integrals of type (k|ji) +!> \param lib .. +!> \param ri ... +!> \param rj ... +!> \param rk ... +!> \param zeti ... +!> \param zetj ... +!> \param zetk ... +!> \param li_max ... +!> \param lj_max ... +!> \param lk_max ... +!> \param potential_parameter ... +!> \param params_in ... +!> \param params_out ... +!> \note The use of params_in and params_out comes from the fact that one might have to swap +!> centers 3 and 4 because of angular momenta and pretty much all the parameters of libint +!> remain the same upon such a change => might avoid recomputing things over and over again +! ************************************************************************************************** + SUBROUTINE set_params_3c_deriv(lib, ri, rj, rk, zeti, zetj, zetk, li_max, lj_max, lk_max, & + potential_parameter, params_in, params_out) + + TYPE(cp_libint_t), INTENT(INOUT) :: lib + REAL(dp), DIMENSION(3), INTENT(IN) :: ri, rj, rk + REAL(dp), INTENT(IN) :: zeti, zetj, zetk + INTEGER, INTENT(IN), OPTIONAL :: li_max, lj_max, lk_max + TYPE(libint_potential_type), INTENT(IN), OPTIONAL :: potential_parameter + TYPE(params_3c), OPTIONAL, POINTER :: params_in, params_out + + INTEGER :: l + LOGICAL :: use_gamma + REAL(dp) :: gammaq, omega2, omega_corr, omega_corr2, & + prefac, R, S1234, T, tmp + REAL(dp), ALLOCATABLE, DIMENSION(:) :: Fm + TYPE(params_3c), POINTER :: params + + IF (PRESENT(params_in)) THEN + params => params_in + + ELSE + params => params_out + + params%m_max = li_max + lj_max + lk_max + 1 + gammaq = zeti + zetj + params%ZetaInv = 1._dp/zetk; params%EtaInv = 1._dp/gammaq + params%ZetapEtaInv = 1._dp/(zetk + gammaq) + + params%Q = (zeti*ri + zetj*rj)*params%EtaInv + params%W = (zetk*rk + gammaq*params%Q)*params%ZetapEtaInv + params%Rho = zetk*gammaq/(zetk + gammaq) + + params%Fm = 0.0_dp + SELECT CASE (potential_parameter%potential_type) + CASE (do_potential_coulomb) + T = params%Rho*SUM((params%Q - rk)**2) + S1234 = EXP(-zeti*zetj*params%EtaInv*SUM((rj - ri)**2)) + prefac = 2._dp*pi/params%Rho*SQRT((pi*params%ZetapEtaInv)**3)*S1234 + + CALL fgamma(params%m_max, T, params%Fm) + params%Fm = prefac*params%Fm + CASE (do_potential_truncated) + R = potential_parameter%cutoff_radius*SQRT(params%Rho) + T = params%Rho*SUM((params%Q - rk)**2) + S1234 = EXP(-zeti*zetj*params%EtaInv*SUM((rj - ri)**2)) + prefac = 2._dp*pi/params%Rho*SQRT((pi*params%ZetapEtaInv)**3)*S1234 + + CPASSERT(get_lmax_init() .GE. params%m_max) !check if truncated coulomb init correctly + CALL t_c_g0_n(params%Fm, use_gamma, R, T, params%m_max) + IF (use_gamma) CALL fgamma(params%m_max, T, params%Fm) + params%Fm = prefac*params%Fm + CASE (do_potential_short) + T = params%Rho*SUM((params%Q - rk)**2) + S1234 = EXP(-zeti*zetj*params%EtaInv*SUM((rj - ri)**2)) + prefac = 2._dp*pi/params%Rho*SQRT((pi*params%ZetapEtaInv)**3)*S1234 + + CALL fgamma(params%m_max, T, params%Fm) + + omega2 = potential_parameter%omega**2 + omega_corr2 = omega2/(omega2 + params%Rho) + omega_corr = SQRT(omega_corr2) + T = T*omega_corr2 + ALLOCATE (Fm(prim_data_f_size)) + + CALL fgamma(params%m_max, T, Fm) + tmp = -omega_corr + DO l = 1, params%m_max + 1 + params%Fm(l) = params%Fm(l) + Fm(l)*tmp + tmp = tmp*omega_corr2 + END DO + params%Fm = prefac*params%Fm + CASE (do_potential_id) + S1234 = EXP(-zeti*zetj*params%EtaInv*SUM((rj - ri)**2) & + - gammaq*zetk*params%ZetapEtaInv*SUM((params%Q - rk)**2)) + prefac = SQRT((pi*params%ZetapEtaInv)**3)*S1234 + + params%Fm(:) = prefac + CASE DEFAULT + CPABORT("Requested operator NYI") + END SELECT + + END IF + + CALL cp_libint_set_params_eri_deriv(lib, rk, rk, rj, ri, rk, & + params%Q, params%W, zetk, 0.0_dp, zetj, zeti, params%ZetaInv, & + params%EtaInv, params%ZetapEtaInv, params%Rho, params%m_max, params%Fm) + + END SUBROUTINE set_params_3c_deriv + ! ************************************************************************************************** !> \brief Computes the 2-center electron repulsion integrals (a|b) for a given set of cartesian !> gaussian orbitals @@ -460,7 +831,7 @@ CONTAINS !screening IF (rpgfa(ipgf) + rpgfb(jpgf) + dr_ab < dab) CYCLE - CALL set_params_2c(lib, ra, rb, la_max, lb_max, zeti, zetj, potential_parameter) + CALL set_params_2c(lib, ra, rb, zeti, zetj, la_max, lb_max, potential_parameter) DO li = la_min, la_max a_offset = a_start + ncoset(li - 1) @@ -486,25 +857,25 @@ CONTAINS END DO END DO - END SUBROUTINE + END SUBROUTINE eri_2center ! ************************************************************************************************** !> \brief Sets the internals of the cp_libint_t object for integrals of type (k|j) !> \param lib .. !> \param rj ... !> \param rk ... -!> \param lj_max ... -!> \param lk_max ... !> \param zetj ... !> \param zetk ... +!> \param lj_max ... +!> \param lk_max ... !> \param potential_parameter ... ! ************************************************************************************************** - SUBROUTINE set_params_2c(lib, rj, rk, lj_max, lk_max, zetj, zetk, potential_parameter) + SUBROUTINE set_params_2c(lib, rj, rk, zetj, zetk, lj_max, lk_max, potential_parameter) TYPE(cp_libint_t), INTENT(INOUT) :: lib REAL(dp), DIMENSION(3), INTENT(IN) :: rj, rk - INTEGER, INTENT(IN) :: lj_max, lk_max REAL(dp), INTENT(IN) :: zetj, zetk + INTEGER, INTENT(IN) :: lj_max, lk_max TYPE(libint_potential_type), INTENT(IN) :: potential_parameter INTEGER :: l, op @@ -604,5 +975,198 @@ CONTAINS END FUNCTION compare_potential_types +!> \brief Computes the 2-center derivatives of the electron repulsion integrals (a|b) for a given +!> set of cartesian gaussian orbitals. Returns the derivatives wrt to the first center +!> \param der_ab the derivatives as array of cartesian orbitals (allocated before hand) +!> \param la_min ... +!> \param la_max ... +!> \param npgfa ... +!> \param zeta ... +!> \param rpgfa ... +!> \param ra ... +!> \param lb_min ... +!> \param lb_max ... +!> \param npgfb ... +!> \param zetb ... +!> \param rpgfb ... +!> \param rb ... +!> \param dab ... +!> \param lib the libint_t object for evaluation (assume that it is initialized outside) +!> \param potential_parameter the info about the potential +!> \note Prior to calling this routine, the cp_libint_t type passed as argument must be initialized, +!> the libint library must be static initialized, and in case of truncated Coulomb operator, +!> the latter must be initialized too +! ************************************************************************************************** + SUBROUTINE eri_2center_derivs(der_ab, la_min, la_max, npgfa, zeta, rpgfa, ra, & + lb_min, lb_max, npgfb, zetb, rpgfb, rb, & + dab, lib, potential_parameter) + + REAL(dp), DIMENSION(:, :, :), INTENT(INOUT) :: der_ab + INTEGER, INTENT(IN) :: la_min, la_max, npgfa + REAL(dp), DIMENSION(:), INTENT(IN) :: zeta, rpgfa + REAL(dp), DIMENSION(3), INTENT(IN) :: ra + INTEGER, INTENT(IN) :: lb_min, lb_max, npgfb + REAL(dp), DIMENSION(:), INTENT(IN) :: zetb, rpgfb + REAL(dp), DIMENSION(3), INTENT(IN) :: rb + REAL(dp), INTENT(IN) :: dab + TYPE(cp_libint_t), INTENT(INOUT) :: lib + TYPE(libint_potential_type), INTENT(IN) :: potential_parameter + + INTEGER :: a_mysize(1), a_offset, a_start, & + b_offset, b_start, i, i_deriv, ipgf, & + j, jpgf, li, lj, ncoa, ncob, p1, p2 + INTEGER, DIMENSION(3) :: permute + REAL(dp) :: dr_ab, zeti, zetj + REAL(dp), DIMENSION(:, :), POINTER :: p_deriv + + NULLIFY (p_deriv) + + permute = [4, 5, 6] + + dr_ab = 0.0_dp + + IF (potential_parameter%potential_type == do_potential_truncated .OR. & + potential_parameter%potential_type == do_potential_short) THEN + dr_ab = potential_parameter%cutoff_radius*cutoff_screen_factor + ELSEIF (potential_parameter%potential_type == do_potential_coulomb) THEN + dr_ab = 1000000.0_dp + ENDIF + + !Looping over the pgfs + DO ipgf = 1, npgfa + zeti = zeta(ipgf) + a_start = (ipgf - 1)*ncoset(la_max) + + DO jpgf = 1, npgfb + zetj = zetb(jpgf) + b_start = (jpgf - 1)*ncoset(lb_max) + + !screening + IF (rpgfa(ipgf) + rpgfb(jpgf) + dr_ab < dab) CYCLE + + CALL set_params_2c_deriv(lib, ra, rb, zeti, zetj, la_max, lb_max, potential_parameter) + + DO li = la_min, la_max + a_offset = a_start + ncoset(li - 1) + ncoa = nco(li) + DO lj = lb_min, lb_max + b_offset = b_start + ncoset(lj - 1) + ncob = nco(lj) + + a_mysize(1) = ncoa*ncob + CALL cp_libint_get_2eri_derivs(li, lj, lib, p_deriv, a_mysize) + + DO j = 1, ncob + p1 = (j - 1)*ncoa + DO i = 1, ncoa + p2 = p1 + i + DO i_deriv = 1, 3 + der_ab(a_offset + i, b_offset + j, i_deriv) = p_deriv(p2, permute(i_deriv)) + END DO + END DO + END DO + + DEALLOCATE (p_deriv) + END DO + END DO + + END DO + END DO + + END SUBROUTINE eri_2center_derivs + +! ************************************************************************************************** +!> \brief Sets the internals of the cp_libint_t object for derivatives of integrals of type (k|j) +!> \param lib .. +!> \param rj ... +!> \param rk ... +!> \param zetj ... +!> \param zetk ... +!> \param lj_max ... +!> \param lk_max ... +!> \param potential_parameter ... +! ************************************************************************************************** + SUBROUTINE set_params_2c_deriv(lib, rj, rk, zetj, zetk, lj_max, lk_max, potential_parameter) + + TYPE(cp_libint_t), INTENT(INOUT) :: lib + REAL(dp), DIMENSION(3), INTENT(IN) :: rj, rk + REAL(dp), INTENT(IN) :: zetj, zetk + INTEGER, INTENT(IN) :: lj_max, lk_max + TYPE(libint_potential_type), INTENT(IN) :: potential_parameter + + INTEGER :: l, op + LOGICAL :: use_gamma + REAL(dp) :: omega2, omega_corr, omega_corr2, prefac, & + R, T, tmp + REAL(dp), ALLOCATABLE, DIMENSION(:) :: Fm + TYPE(params_2c) :: params + + !The internal structure of libint2 is based on 4-center integrals + !For 2-center, two of those are dummy centers + !The integral is assumed to be (k|j) where the centers are ordered as: + !k -> 1, j -> 3 and (the centers #2 & #4 are dummy centers) + + !Note: some variable of 4-center integrals simplify due to dummy centers: + ! P -> rk, gammap -> zetk + ! Q -> rj, gammaq -> zetj + + op = potential_parameter%potential_type + params%m_max = lj_max + lk_max + 1 + params%ZetaInv = 1._dp/zetk; params%EtaInv = 1._dp/zetj + params%ZetapEtaInv = 1._dp/(zetk + zetj) + + params%W = (zetk*rk + zetj*rj)*params%ZetapEtaInv + params%Rho = zetk*zetj/(zetk + zetj) + + params%Fm = 0.0_dp + SELECT CASE (op) + CASE (do_potential_coulomb) + T = params%Rho*SUM((rj - rk)**2) + prefac = 2._dp*pi/params%Rho*SQRT((pi*params%ZetapEtaInv)**3) + CALL fgamma(params%m_max, T, params%Fm) + params%Fm = prefac*params%Fm + CASE (do_potential_truncated) + R = potential_parameter%cutoff_radius*SQRT(params%Rho) + T = params%Rho*SUM((rj - rk)**2) + prefac = 2._dp*pi/params%Rho*SQRT((pi*params%ZetapEtaInv)**3) + + CPASSERT(get_lmax_init() .GE. params%m_max) !check if truncated coulomb init correctly + CALL t_c_g0_n(params%Fm, use_gamma, R, T, params%m_max) + IF (use_gamma) CALL fgamma(params%m_max, T, params%Fm) + params%Fm = prefac*params%Fm + CASE (do_potential_short) + T = params%Rho*SUM((rj - rk)**2) + prefac = 2._dp*pi/params%Rho*SQRT((pi*params%ZetapEtaInv)**3) + + CALL fgamma(params%m_max, T, params%Fm) + + omega2 = potential_parameter%omega**2 + omega_corr2 = omega2/(omega2 + params%Rho) + omega_corr = SQRT(omega_corr2) + T = T*omega_corr2 + ALLOCATE (Fm(prim_data_f_size)) + + CALL fgamma(params%m_max, T, Fm) + tmp = -omega_corr + DO l = 1, params%m_max + 1 + params%Fm(l) = params%Fm(l) + Fm(l)*tmp + tmp = tmp*omega_corr2 + END DO + params%Fm = prefac*params%Fm + CASE (do_potential_id) + + prefac = SQRT((pi*params%ZetapEtaInv)**3)*EXP(-zetj*zetk*params%ZetapEtaInv*SUM((rk - rj)**2)) + params%Fm(:) = prefac + CASE DEFAULT + CPABORT("Requested operator NYI") + END SELECT + + CALL cp_libint_set_params_eri_deriv(lib, rk, rk, rj, rj, rk, rj, params%W, zetk, 0.0_dp, & + zetj, 0.0_dp, params%ZetaInv, params%EtaInv, & + params%ZetapEtaInv, params%Rho, & + params%m_max, params%Fm) + + END SUBROUTINE set_params_2c_deriv + END MODULE libint_2c_3c diff --git a/src/libint_wrapper.F b/src/libint_wrapper.F index b2ac68a9f9..60e3dfd258 100644 --- a/src/libint_wrapper.F +++ b/src/libint_wrapper.F @@ -33,7 +33,8 @@ MODULE libint_wrapper libint2_cleanup_eri1, libint2_init_eri, libint2_init_eri1, libint2_static_cleanup, & libint2_static_init, libint_t, libint2_max_am_eri, libint2_init_3eri, libint2_cleanup_3eri, & libint2_init_2eri, libint2_cleanup_2eri, & - libint2_build_2eri, libint2_build_3eri + libint2_build_2eri, libint2_build_3eri, libint2_build_3eri1, libint2_cleanup_3eri1, libint2_init_3eri1, & + libint2_build_2eri1, libint2_cleanup_2eri1, libint2_init_2eri1 #endif USE orbital_pointers, ONLY: nco #include "./base/base_uses.f90" @@ -47,7 +48,9 @@ MODULE libint_wrapper get_ssss_f_val, cp_libint_set_contrdepth, cp_libint_set_params_eri_screen, & cp_libint_set_params_eri, cp_libint_set_params_eri_deriv, & cp_libint_init_3eri, cp_libint_cleanup_3eri, cp_libint_get_3eris, & - cp_libint_init_2eri, cp_libint_cleanup_2eri, cp_libint_get_2eris + cp_libint_init_2eri, cp_libint_cleanup_2eri, cp_libint_get_2eris, & + cp_libint_get_3eri_derivs, cp_libint_init_3eri1, cp_libint_cleanup_3eri1, & + cp_libint_get_2eri_derivs, cp_libint_init_2eri1, cp_libint_cleanup_2eri1 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'libint_wrapper' @@ -377,6 +380,91 @@ CONTAINS END SUBROUTINE cp_libint_get_3eris +! ************************************************************************************************** +!> \brief ... +!> \param n_c ... +!> \param n_b ... +!> \param n_a ... +!> \param lib ... +!> \param p_work ... +!> \param a_mysize ... +! ************************************************************************************************** + SUBROUTINE cp_libint_get_3eri_derivs(n_c, n_b, n_a, lib, p_work, a_mysize) + INTEGER, INTENT(IN) :: n_c, n_b, n_a + TYPE(cp_libint_t) :: lib + INTEGER :: a_mysize(1) + REAL(dp), DIMENSION(:, :), POINTER :: p_work + REAL(dp), DIMENSION(:), POINTER :: p_work_tmp + +#if(__LIBINT) + PROCEDURE(libint2_build), POINTER :: pbuild + INTEGER :: i + + CALL C_F_PROCPOINTER(libint2_build_3eri1(n_c, n_b, n_a), pbuild) + CALL pbuild(lib%prv) + + ALLOCATE (p_work(a_mysize(1), 9)) + + !Derivatives 1-3 can be obtained using translational invariance + DO i = 4, 9 + NULLIFY (p_work_tmp) + CALL C_F_POINTER(lib%prv(1)%targets(i), p_work_tmp, SHAPE=a_mysize) + p_work(:, i) = p_work_tmp + ENDDO +#else + MARK_USED(n_c) + MARK_USED(n_b) + MARK_USED(n_a) + MARK_USED(lib) + MARK_USED(p_work) + MARK_USED(a_mysize) + CPABORT("This CP2K executable has not been linked against the required library libint.") +#endif + + END SUBROUTINE cp_libint_get_3eri_derivs + +! ************************************************************************************************** +!> \brief ... +!> \param n_c ... +!> \param n_b ... +!> \param n_a ... +!> \param lib ... +!> \param p_work ... +!> \param a_mysize ... +! ************************************************************************************************** + SUBROUTINE cp_libint_get_2eri_derivs(n_b, n_a, lib, p_work, a_mysize) + INTEGER, INTENT(IN) :: n_b, n_a + TYPE(cp_libint_t) :: lib + INTEGER :: a_mysize(1) + REAL(dp), DIMENSION(:, :), POINTER :: p_work + REAL(dp), DIMENSION(:), POINTER :: p_work_tmp + +#if(__LIBINT) + PROCEDURE(libint2_build), POINTER :: pbuild + INTEGER :: i + + CALL C_F_PROCPOINTER(libint2_build_2eri1(n_b, n_a), pbuild) + CALL pbuild(lib%prv) + + ALLOCATE (p_work(a_mysize(1), 6)) + + !Derivatives 1-3 can be obtained using translational invariance + DO i = 4, 6 + NULLIFY (p_work_tmp) + CALL C_F_POINTER(lib%prv(1)%targets(i), p_work_tmp, SHAPE=a_mysize) + p_work(:, i) = p_work_tmp + ENDDO +#else + MARK_USED(n_b) + MARK_USED(n_a) + MARK_USED(lib) + MARK_USED(p_work) + MARK_USED(a_mysize) + CPABORT("This CP2K executable has not been linked against the required library libint.") +#endif + + END SUBROUTINE cp_libint_get_2eri_derivs + ! ************************************************************************************************** !> \brief ... !> \param n_c ... @@ -528,6 +616,30 @@ CONTAINS #endif END SUBROUTINE + SUBROUTINE cp_libint_init_3eri1(lib, max_am) + TYPE(cp_libint_t) :: lib + INTEGER :: max_am +#if(__LIBINT) + CALL libint2_init_3eri1(lib%prv, max_am, C_NULL_PTR) +#else + MARK_USED(lib) + MARK_USED(max_am) + CPABORT("This CP2K executable has not been linked against the required library libint.") +#endif + END SUBROUTINE + + SUBROUTINE cp_libint_init_2eri1(lib, max_am) + TYPE(cp_libint_t) :: lib + INTEGER :: max_am +#if(__LIBINT) + CALL libint2_init_2eri1(lib%prv, max_am, C_NULL_PTR) +#else + MARK_USED(lib) + MARK_USED(max_am) + CPABORT("This CP2K executable has not been linked against the required library libint.") +#endif + END SUBROUTINE + SUBROUTINE cp_libint_init_2eri(lib, max_am) TYPE(cp_libint_t) :: lib INTEGER :: max_am @@ -570,6 +682,26 @@ CONTAINS #endif END SUBROUTINE + SUBROUTINE cp_libint_cleanup_3eri1(lib) + TYPE(cp_libint_t) :: lib +#if(__LIBINT) + CALL libint2_cleanup_3eri1(lib%prv) +#else + MARK_USED(lib) + CPABORT("This CP2K executable has not been linked against the required library libint.") +#endif + END SUBROUTINE + + SUBROUTINE cp_libint_cleanup_2eri1(lib) + TYPE(cp_libint_t) :: lib +#if(__LIBINT) + CALL libint2_cleanup_2eri1(lib%prv) +#else + MARK_USED(lib) + CPABORT("This CP2K executable has not been linked against the required library libint.") +#endif + END SUBROUTINE + SUBROUTINE cp_libint_cleanup_2eri(lib) TYPE(cp_libint_t) :: lib #if(__LIBINT) diff --git a/src/mp2.F b/src/mp2.F index 14ab2acda3..9b47704326 100644 --- a/src/mp2.F +++ b/src/mp2.F @@ -450,6 +450,7 @@ CONTAINS DO irep = 1, n_rep_hf DO i_thread = 0, n_threads - 1 actual_x_data => qs_env%x_data(irep, i_thread + 1) + IF (actual_x_data%do_hfx_ri) CYCLE do_dynamic_load_balancing = .TRUE. IF (n_threads == 1 .OR. actual_x_data%memory_parameter%do_disk_storage) do_dynamic_load_balancing = .FALSE. @@ -696,6 +697,7 @@ CONTAINS DO irep = 1, n_rep_hf DO i_thread = 0, n_threads - 1 actual_x_data => qs_env%x_data(irep, i_thread + 1) + IF (actual_x_data%do_hfx_ri) CYCLE do_dynamic_load_balancing = .TRUE. IF (n_threads == 1 .OR. actual_x_data%memory_parameter%do_disk_storage) do_dynamic_load_balancing = .FALSE. diff --git a/src/mp2_cphf.F b/src/mp2_cphf.F index bf37eab2f0..efea332693 100644 --- a/src/mp2_cphf.F +++ b/src/mp2_cphf.F @@ -48,12 +48,14 @@ MODULE mp2_cphf dbcsr_set USE hfx_admm_utils, ONLY: tddft_hfx_matrix USE hfx_derivatives, ONLY: derivatives_four_center + USE hfx_ri, ONLY: hfx_ri_update_forces USE hfx_types, ONLY: alloc_containers,& hfx_container_type,& hfx_init_container,& hfx_type USE input_constants, ONLY: do_admm_aux_exch_func_none,& ot_precond_full_all + USE input_cp2k_hfx, ONLY: ri_mo USE input_section_types, ONLY: section_vals_get,& section_vals_get_subs_vals,& section_vals_type @@ -282,6 +284,7 @@ CONTAINS DO irep = 1, n_rep_hf DO i_thread = 0, n_threads - 1 actual_x_data => qs_env%x_data(irep, i_thread + 1) + IF (actual_x_data%do_hfx_ri) CYCLE do_dynamic_load_balancing = .TRUE. IF (n_threads == 1 .OR. actual_x_data%memory_parameter%do_disk_storage) do_dynamic_load_balancing = .FALSE. @@ -970,6 +973,7 @@ CONTAINS rho_ao, rho_ao_aux, scrm TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rho_ao_kp, scrm_kp TYPE(dft_control_type), POINTER :: dft_control + TYPE(hfx_type), DIMENSION(:, :), POINTER :: x_data TYPE(linres_control_type), POINTER :: linres_control TYPE(mo_set_p_type), DIMENSION(:), POINTER :: mos TYPE(neighbor_list_set_p_type), DIMENSION(:), & @@ -1019,7 +1023,8 @@ CONTAINS virial=virial, & sab_orb=sab_orb, & energy=energy, & - rho_core=rho_core) + rho_core=rho_core, & + x_data=x_data) p_env => qs_env%mp2_env%ri_grad%p_env @@ -1364,8 +1369,22 @@ CONTAINS rho1 => p_env%p1 END IF - CALL derivatives_four_center(qs_env, rho_ao_kp, rho1, hfx_sections, para_env, & - 1, use_virial) + IF (x_data(1, 1)%do_hfx_ri) THEN + + IF (x_data(1, 1)%ri_data%flavor == ri_mo) THEN + CPABORT("NYI with RI_FLAVOR MO") + END IF + + CALL hfx_ri_update_forces(qs_env, x_data(1, 1)%ri_data, nspins, & + x_data(1, 1)%general_parameter%fraction, & + rho_ao=rho_ao_kp, rho_ao_resp=rho1, & + use_virial=use_virial) + + ELSE + CALL derivatives_four_center(qs_env, rho_ao_kp, rho1, hfx_sections, para_env, & + 1, use_virial) + END IF + IF (use_virial) THEN virial%pv_exx = virial%pv_exx - virial%pv_fock_4c virial%pv_virial = virial%pv_virial - virial%pv_fock_4c diff --git a/src/qs_linres_kernel.F b/src/qs_linres_kernel.F index a1d0798d95..4ac244e08c 100644 --- a/src/qs_linres_kernel.F +++ b/src/qs_linres_kernel.F @@ -35,12 +35,14 @@ MODULE qs_linres_kernel dbcsr_set USE hartree_local_methods, ONLY: Vh_1c_gg_integrals USE hfx_energy_potential, ONLY: integrate_four_center + USE hfx_ri, ONLY: hfx_ri_update_ks USE hfx_types, ONLY: hfx_type USE input_constants, ONLY: do_admm_aux_exch_func_none,& do_admm_basis_projection,& do_admm_exch_scaling_none,& do_admm_purify_none,& kg_tnadd_embed + USE input_cp2k_hfx, ONLY: ri_mo USE input_section_types, ONLY: section_get_ival,& section_get_lval,& section_get_rval,& @@ -851,10 +853,24 @@ CONTAINS rho_ao_kp(1:nspins, 1:1) => rho_ao(1:nspins) DO irep = 1, n_rep_hf - DO ispin = 1, mspin - CALL integrate_four_center(qs_env, x_data, matrix_ks_kp, eh1, rho_ao_kp, hfx_sections, para_env, & - s_mstruct_changed, irep, distribute_fock_matrix, ispin=ispin) - END DO + eh1 = 0.0_dp + + IF (x_data(irep, 1)%do_hfx_ri) THEN + IF (x_data(irep, 1)%ri_data%flavor == ri_mo) THEN + CPABORT("NYI with RI_FLAVOR MO") + END IF + CALL hfx_ri_update_ks(qs_env, x_data(irep, 1)%ri_data, matrix_ks_kp, eh1, & + rho_ao=rho_ao_kp, geometry_did_change=s_mstruct_changed, & + nspins=nspins, hf_fraction=x_data(irep, 1)%general_parameter%fraction) + + ELSE + + DO ispin = 1, mspin + CALL integrate_four_center(qs_env, x_data, matrix_ks_kp, eh1, rho_ao_kp, hfx_sections, para_env, & + s_mstruct_changed, irep, distribute_fock_matrix, ispin=ispin) + END DO + + END IF END DO CALL timestop(handle) diff --git a/src/qs_tddfpt2_fhxc_forces.F b/src/qs_tddfpt2_fhxc_forces.F index 7b9e42ffe4..6e4dcb5f89 100644 --- a/src/qs_tddfpt2_fhxc_forces.F +++ b/src/qs_tddfpt2_fhxc_forces.F @@ -591,6 +591,7 @@ CONTAINS mhe(ispin, 1)%matrix => matrix_hfx_admm(ispin)%matrix mpe(ispin, 1)%matrix => matrix_px1_admm(ispin)%matrix END DO + IF (x_data(1, 1)%do_hfx_ri) CPABORT("RI-HFX with TDDFPT NYI") DO ispin = 1, mspin eh1 = 0.0 CALL integrate_four_center(qs_env, x_data, mhe, eh1, mpe, hfx_section, & @@ -648,6 +649,7 @@ CONTAINS mhe(ispin, 1)%matrix => matrix_hfx(ispin)%matrix mpe(ispin, 1)%matrix => matrix_px1(ispin)%matrix END DO + IF (x_data(1, 1)%do_hfx_ri) CPABORT("RI-HFX with TDDFPT NYI") DO ispin = 1, mspin eh1 = 0.0 CALL integrate_four_center(qs_env, x_data, mhe, eh1, mpe, hfx_section, & diff --git a/src/qs_tddfpt2_forces.F b/src/qs_tddfpt2_forces.F index b0b4f8bca9..6419004398 100644 --- a/src/qs_tddfpt2_forces.F +++ b/src/qs_tddfpt2_forces.F @@ -751,6 +751,7 @@ CONTAINS CALL dbcsr_set(mhz(ispin, 1)%matrix, 0.0_dp) mpe(ispin, 1)%matrix => matrix_pe_admm(ispin)%matrix END DO + IF (x_data(1, 1)%do_hfx_ri) CPABORT("RI-HFX with TDDFPT NYI") DO ispin = 1, mspin eh1 = 0.0 CALL integrate_four_center(qs_env, x_data, mhz, eh1, mpe, hfx_section, & @@ -786,6 +787,7 @@ CONTAINS mhz(ispin, 1)%matrix => matrix_hz(ispin)%matrix mpe(ispin, 1)%matrix => matrix_pe(ispin)%matrix END DO + IF (x_data(1, 1)%do_hfx_ri) CPABORT("RI-HFX with TDDFPT NYI") DO ispin = 1, mspin eh1 = 0.0 CALL integrate_four_center(qs_env, x_data, mhz, eh1, mpe, hfx_section, & diff --git a/src/qs_tensors.F b/src/qs_tensors.F index d1833fefcf..090e61eb92 100644 --- a/src/qs_tensors.F +++ b/src/qs_tensors.F @@ -12,7 +12,6 @@ MODULE qs_tensors USE ai_contraction, ONLY: block_add USE ai_contraction_sphi, ONLY: ab_contract,& libxsmm_abc_contract - USE ai_overlap, ONLY: overlap_ab USE atomic_kind_types, ONLY: atomic_kind_type USE basis_set_types, ONLY: get_gto_basis_set,& gto_basis_set_p_type,& @@ -28,8 +27,11 @@ MODULE qs_tensors USE dbcsr_api, ONLY: dbcsr_filter,& dbcsr_finalize,& dbcsr_get_block_p,& + dbcsr_get_matrix_type,& dbcsr_has_symmetry,& - dbcsr_type + dbcsr_type,& + dbcsr_type_antisymmetric,& + dbcsr_type_no_symmetry USE dbcsr_tensor_api, ONLY: & dbcsr_t_blk_sizes, dbcsr_t_clear, dbcsr_t_copy, dbcsr_t_create, dbcsr_t_destroy, & dbcsr_t_filter, dbcsr_t_get_block, dbcsr_t_get_info, dbcsr_t_get_nze_total, & @@ -63,14 +65,14 @@ MODULE qs_tensors kpoint_type USE libint_2c_3c, ONLY: cutoff_screen_factor,& eri_2center,& + eri_2center_derivs,& eri_3center,& + eri_3center_derivs,& libint_potential_type - USE libint_wrapper, ONLY: cp_libint_cleanup_2eri,& - cp_libint_cleanup_3eri,& - cp_libint_init_2eri,& - cp_libint_init_3eri,& - cp_libint_set_contrdepth,& - cp_libint_t + USE libint_wrapper, ONLY: & + cp_libint_cleanup_2eri, cp_libint_cleanup_2eri1, cp_libint_cleanup_3eri, & + cp_libint_cleanup_3eri1, cp_libint_init_2eri, cp_libint_init_2eri1, cp_libint_init_3eri, & + cp_libint_init_3eri1, cp_libint_set_contrdepth, cp_libint_t USE molecule_types, ONLY: molecule_type USE orbital_pointers, ONLY: ncoset USE particle_types, ONLY: particle_type @@ -93,6 +95,9 @@ MODULE qs_tensors symmetrik_ik USE t_c_g0, ONLY: get_lmax_init,& init + USE util, ONLY: get_limit + +!$ USE OMP_LIB, ONLY: omp_get_max_threads, omp_get_thread_num #include "./base/base_uses.f90" IMPLICIT NONE @@ -105,7 +110,8 @@ MODULE qs_tensors neighbor_list_3c_destroy, neighbor_list_3c_iterate, neighbor_list_3c_iterator_create, & neighbor_list_3c_iterator_destroy, get_3c_iterator_info, build_3c_integrals, & build_2c_neighbor_lists, build_2c_integrals, cutoff_screen_factor, & - get_tensor_occupancy, compress_tensor, decompress_tensor + get_tensor_occupancy, compress_tensor, decompress_tensor, & + build_3c_derivatives, build_2c_derivatives TYPE one_dim_int_array INTEGER, DIMENSION(:), ALLOCATABLE :: array @@ -602,8 +608,12 @@ CONTAINS !> \param potential_parameter ... !> \param op_pos ... !> \param do_kpoints ... +!> \param bounds_i ... +!> \param bounds_j ... +!> \param bounds_k ... ! ************************************************************************************************** - SUBROUTINE alloc_block_3c(t3c, nl_3c, basis_i, basis_j, basis_k, qs_env, potential_parameter, op_pos, do_kpoints) + SUBROUTINE alloc_block_3c(t3c, nl_3c, basis_i, basis_j, basis_k, qs_env, potential_parameter, op_pos, & + do_kpoints, bounds_i, bounds_j, bounds_k) TYPE(dbcsr_t_type), DIMENSION(:, :), INTENT(INOUT) :: t3c TYPE(neighbor_list_3c_type), INTENT(INOUT) :: nl_3c TYPE(gto_basis_set_p_type), DIMENSION(:) :: basis_i, basis_j, basis_k @@ -611,9 +621,244 @@ CONTAINS TYPE(libint_potential_type), INTENT(IN) :: potential_parameter INTEGER, INTENT(IN), OPTIONAL :: op_pos LOGICAL, INTENT(IN), OPTIONAL :: do_kpoints + INTEGER, DIMENSION(2), INTENT(IN), OPTIONAL :: bounds_i, bounds_j, bounds_k CHARACTER(LEN=*), PARAMETER :: routineN = 'alloc_block_3c' + INTEGER :: handle, i, i_img, iatom, ikind, iproc, & + j_img, jatom, jcell, jkind, katom, & + kcell, kkind, natom, nimg, op_ij, & + op_jk, op_pos_prv + INTEGER(int_8), ALLOCATABLE, DIMENSION(:, :) :: nblk + INTEGER, DIMENSION(3) :: cell_j, cell_k, kp_index_lbounds, & + kp_index_ubounds + INTEGER, DIMENSION(:, :, :), POINTER :: cell_to_index + LOGICAL :: do_kpoints_prv + REAL(KIND=dp) :: dij, dik, djk, dr_ij, dr_ik, dr_jk, & + kind_radius_i, kind_radius_j, & + kind_radius_k + REAL(KIND=dp), DIMENSION(3) :: rij, rik, rjk + TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set + TYPE(cp_para_env_type), POINTER :: para_env + TYPE(dft_control_type), POINTER :: dft_control + TYPE(kpoint_type), POINTER :: kpoints + TYPE(neighbor_list_3c_iterator_type) :: nl_3c_iter + TYPE(one_dim_int_array), ALLOCATABLE, & + DIMENSION(:, :) :: alloc_i, alloc_j, alloc_k + TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set + + CALL timeset(routineN, handle) + NULLIFY (qs_kind_set, atomic_kind_set) + + IF (PRESENT(do_kpoints)) THEN + do_kpoints_prv = do_kpoints + ELSE + do_kpoints_prv = .FALSE. + ENDIF + + dr_ij = 0.0_dp; dr_jk = 0.0_dp; dr_ik = 0.0_dp + + op_ij = do_potential_id; op_jk = do_potential_id + + IF (PRESENT(op_pos)) THEN + op_pos_prv = op_pos + ELSE + op_pos_prv = 1 + ENDIF + + SELECT CASE (op_pos_prv) + CASE (1) + op_ij = potential_parameter%potential_type + CASE (2) + op_jk = potential_parameter%potential_type + END SELECT + + IF (op_ij == do_potential_truncated .OR. op_ij == do_potential_short) THEN + dr_ij = potential_parameter%cutoff_radius*cutoff_screen_factor + dr_ik = potential_parameter%cutoff_radius*cutoff_screen_factor + ELSEIF (op_ij == do_potential_coulomb) THEN + dr_ij = 1000000.0_dp + dr_ik = 1000000.0_dp + ENDIF + + IF (op_jk == do_potential_truncated .OR. op_jk == do_potential_short) THEN + dr_jk = potential_parameter%cutoff_radius*cutoff_screen_factor + dr_ik = potential_parameter%cutoff_radius*cutoff_screen_factor + ELSEIF (op_jk == do_potential_coulomb) THEN + dr_jk = 1000000.0_dp + dr_ik = 1000000.0_dp + ENDIF + + CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set, qs_kind_set=qs_kind_set, natom=natom, & + dft_control=dft_control, kpoints=kpoints, para_env=para_env) + + IF (do_kpoints_prv) THEN + nimg = dft_control%nimages + CALL get_kpoint_info(kpoints, cell_to_index=cell_to_index) + ELSE + nimg = 1 + END IF + + IF (do_kpoints_prv) THEN + kp_index_lbounds = LBOUND(cell_to_index) + kp_index_ubounds = UBOUND(cell_to_index) + ENDIF + + !Do a first loop over the nl and count the blocks present + ALLOCATE (nblk(nimg, nimg)) + nblk(:, :) = 0 + + CALL neighbor_list_3c_iterator_create(nl_3c_iter, nl_3c) + CALL nl_3c_iter_set_bounds(nl_3c_iter, bounds_i, bounds_j, bounds_k) + + DO WHILE (neighbor_list_3c_iterate(nl_3c_iter) == 0) + CALL get_3c_iterator_info(nl_3c_iter, ikind=ikind, jkind=jkind, kkind=kkind, & + rij=rij, rjk=rjk, rik=rik, cell_j=cell_j, cell_k=cell_k) + + IF (do_kpoints_prv) THEN + + IF (ANY([cell_j(1), cell_j(2), cell_j(3)] < kp_index_lbounds) .OR. & + ANY([cell_j(1), cell_j(2), cell_j(3)] > kp_index_ubounds)) CYCLE + + jcell = cell_to_index(cell_j(1), cell_j(2), cell_j(3)) + IF (jcell > nimg) CYCLE + + IF (ANY([cell_k(1), cell_k(2), cell_k(3)] < kp_index_lbounds) .OR. & + ANY([cell_k(1), cell_k(2), cell_k(3)] > kp_index_ubounds)) CYCLE + + kcell = cell_to_index(cell_k(1), cell_k(2), cell_k(3)) + IF (kcell > nimg) CYCLE + ELSE + jcell = 1; kcell = 1 + END IF + + djk = NORM2(rjk) + dij = NORM2(rij) + dik = NORM2(rik) + + CALL get_gto_basis_set(basis_i(ikind)%gto_basis_set, kind_radius=kind_radius_i) + CALL get_gto_basis_set(basis_j(jkind)%gto_basis_set, kind_radius=kind_radius_j) + CALL get_gto_basis_set(basis_k(kkind)%gto_basis_set, kind_radius=kind_radius_k) + + IF (kind_radius_j + kind_radius_i + dr_ij < dij) CYCLE + IF (kind_radius_j + kind_radius_k + dr_jk < djk) CYCLE + IF (kind_radius_k + kind_radius_i + dr_ik < dik) CYCLE + + nblk(jcell, kcell) = nblk(jcell, kcell) + 1 + ENDDO + CALL neighbor_list_3c_iterator_destroy(nl_3c_iter) + + !Do a second loop over the nl to give block indices + ALLOCATE (alloc_i(nimg, nimg)) + ALLOCATE (alloc_j(nimg, nimg)) + ALLOCATE (alloc_k(nimg, nimg)) + DO j_img = 1, nimg + DO i_img = 1, nimg + ALLOCATE (alloc_i(i_img, j_img)%array(nblk(i_img, j_img))) + ALLOCATE (alloc_j(i_img, j_img)%array(nblk(i_img, j_img))) + ALLOCATE (alloc_k(i_img, j_img)%array(nblk(i_img, j_img))) + END DO + END DO + nblk(:, :) = 0 + + CALL neighbor_list_3c_iterator_create(nl_3c_iter, nl_3c) + CALL nl_3c_iter_set_bounds(nl_3c_iter, bounds_i, bounds_j, bounds_k) + + DO WHILE (neighbor_list_3c_iterate(nl_3c_iter) == 0) + CALL get_3c_iterator_info(nl_3c_iter, ikind=ikind, jkind=jkind, kkind=kkind, & + iatom=iatom, jatom=jatom, katom=katom, & + rij=rij, rjk=rjk, rik=rik, cell_j=cell_j, cell_k=cell_k) + + IF (do_kpoints_prv) THEN + + IF (ANY([cell_j(1), cell_j(2), cell_j(3)] < kp_index_lbounds) .OR. & + ANY([cell_j(1), cell_j(2), cell_j(3)] > kp_index_ubounds)) CYCLE + + jcell = cell_to_index(cell_j(1), cell_j(2), cell_j(3)) + IF (jcell > nimg) CYCLE + + IF (ANY([cell_k(1), cell_k(2), cell_k(3)] < kp_index_lbounds) .OR. & + ANY([cell_k(1), cell_k(2), cell_k(3)] > kp_index_ubounds)) CYCLE + + kcell = cell_to_index(cell_k(1), cell_k(2), cell_k(3)) + IF (kcell > nimg) CYCLE + ELSE + jcell = 1; kcell = 1 + END IF + + djk = NORM2(rjk) + dij = NORM2(rij) + dik = NORM2(rik) + + CALL get_gto_basis_set(basis_i(ikind)%gto_basis_set, kind_radius=kind_radius_i) + CALL get_gto_basis_set(basis_j(jkind)%gto_basis_set, kind_radius=kind_radius_j) + CALL get_gto_basis_set(basis_k(kkind)%gto_basis_set, kind_radius=kind_radius_k) + + IF (kind_radius_j + kind_radius_i + dr_ij < dij) CYCLE + IF (kind_radius_j + kind_radius_k + dr_jk < djk) CYCLE + IF (kind_radius_k + kind_radius_i + dr_ik < dik) CYCLE + + nblk(jcell, kcell) = nblk(jcell, kcell) + 1 + + !Note: there may be repeated indices due to periodic images => dbcsr_t_reserve_blocks takes care of it + alloc_i(jcell, kcell)%array(nblk(jcell, kcell)) = iatom + alloc_j(jcell, kcell)%array(nblk(jcell, kcell)) = jatom + alloc_k(jcell, kcell)%array(nblk(jcell, kcell)) = katom + + ENDDO + CALL neighbor_list_3c_iterator_destroy(nl_3c_iter) + + DO j_img = 1, nimg + DO i_img = 1, nimg + IF (ALLOCATED(alloc_i(i_img, j_img)%array)) THEN + DO i = 1, SIZE(alloc_i(i_img, j_img)%array) + CALL dbcsr_t_get_stored_coordinates(t3c(i_img, j_img), & + [alloc_i(i_img, j_img)%array(i), alloc_j(i_img, j_img)%array(i), & + alloc_k(i_img, j_img)%array(i)], & + iproc) + CPASSERT(iproc .EQ. para_env%mepos) + ENDDO + + CALL dbcsr_t_reserve_blocks(t3c(i_img, j_img), & + alloc_i(i_img, j_img)%array, & + alloc_j(i_img, j_img)%array, & + alloc_k(i_img, j_img)%array) + ENDIF + ENDDO + ENDDO + + CALL timestop(handle) + + END SUBROUTINE + +! ************************************************************************************************** +!> \brief ... +!> \param t3c ... +!> \param nl_3c ... +!> \param basis_i ... +!> \param basis_j ... +!> \param basis_k ... +!> \param qs_env ... +!> \param potential_parameter ... +!> \param op_pos ... +!> \param do_kpoints ... +!> \param bounds_i ... +!> \param bounds_j ... +!> \param bounds_k ... +! ************************************************************************************************** + SUBROUTINE alloc_block_3c_old(t3c, nl_3c, basis_i, basis_j, basis_k, qs_env, potential_parameter, op_pos, & + do_kpoints, bounds_i, bounds_j, bounds_k) + TYPE(dbcsr_t_type), DIMENSION(:, :), INTENT(INOUT) :: t3c + TYPE(neighbor_list_3c_type), INTENT(INOUT) :: nl_3c + TYPE(gto_basis_set_p_type), DIMENSION(:) :: basis_i, basis_j, basis_k + TYPE(qs_environment_type), POINTER :: qs_env + TYPE(libint_potential_type), INTENT(IN) :: potential_parameter + INTEGER, INTENT(IN), OPTIONAL :: op_pos + LOGICAL, INTENT(IN), OPTIONAL :: do_kpoints + INTEGER, DIMENSION(2), INTENT(IN), OPTIONAL :: bounds_i, bounds_j, bounds_k + + CHARACTER(LEN=*), PARAMETER :: routineN = 'alloc_block_3c_old' + INTEGER :: blk_cnt, handle, i, i_img, iatom, iblk, ikind, iproc, j_img, jatom, jcell, jkind, & katom, kcell, kkind, natom, nimg, op_ij, op_jk, op_pos_prv INTEGER, ALLOCATABLE, DIMENSION(:) :: tmp @@ -696,6 +941,7 @@ CONTAINS ENDIF CALL neighbor_list_3c_iterator_create(nl_3c_iter, nl_3c) + CALL nl_3c_iter_set_bounds(nl_3c_iter, bounds_i, bounds_j, bounds_k) DO WHILE (neighbor_list_3c_iterate(nl_3c_iter) == 0) CALL get_3c_iterator_info(nl_3c_iter, ikind=ikind, jkind=jkind, kkind=kkind, & iatom=iatom, jatom=jatom, katom=katom, & @@ -819,6 +1065,730 @@ CONTAINS END SUBROUTINE ! ************************************************************************************************** +!> \brief Build 3-center derivative tensors +!> \param t3c_der_i empty DBCSR tensor which will contain the 1st center derivatives +!> \param t3c_der_k empty DBCSR tensor which will contain the 3rd center derivatives +!> \param filter_eps Filter threshold for tensor blocks +!> \param qs_env ... +!> \param nl_3c 3-center neighborlist +!> \param basis_i ... +!> \param basis_j ... +!> \param basis_k ... +!> \param potential_parameter ... +!> \param der_eps neglect integrals smaller than der_eps +!> \param op_pos operator position. +!> 1: calculate (i|jk) integrals, +!> 2: calculate (ij|k) integrals +!> \param do_kpoints ... +!> this routine requires that libint has been static initialised somewhere else +!> \param bounds_i ... +!> \param bounds_j ... +!> \param bounds_k ... +! ************************************************************************************************** + SUBROUTINE build_3c_derivatives(t3c_der_i, t3c_der_k, filter_eps, qs_env, & + nl_3c, basis_i, basis_j, basis_k, & + potential_parameter, & + der_eps, & + op_pos, do_kpoints, & + bounds_i, bounds_j, bounds_k) + + TYPE(dbcsr_t_type), DIMENSION(:, :, :), & + INTENT(INOUT) :: t3c_der_i, t3c_der_k + REAL(KIND=dp), INTENT(IN) :: filter_eps + TYPE(qs_environment_type), POINTER :: qs_env + TYPE(neighbor_list_3c_type), INTENT(INOUT) :: nl_3c + TYPE(gto_basis_set_p_type), DIMENSION(:) :: basis_i, basis_j, basis_k + TYPE(libint_potential_type), INTENT(IN) :: potential_parameter + REAL(KIND=dp), INTENT(IN), OPTIONAL :: der_eps + INTEGER, INTENT(IN), OPTIONAL :: op_pos + LOGICAL, INTENT(IN), OPTIONAL :: do_kpoints + INTEGER, DIMENSION(2), INTENT(IN), OPTIONAL :: bounds_i, bounds_j, bounds_k + + CHARACTER(LEN=*), PARAMETER :: routineN = 'build_3c_derivatives' + + INTEGER :: block_end_i, block_end_j, block_end_k, block_start_i, block_start_j, & + block_start_k, egfi, handle, handle2, i, i_img, i_xyz, iatom, ibasis, ikind, ilist, imax, & + iset, j_img, jatom, jcell, jkind, jset, katom, kcell, kkind, kset, m_max, max_ncoi, & + max_ncoj, max_ncok, max_nset, max_nsgfi, max_nsgfj, max_nsgfk, maxli, maxlj, maxlk, & + mepos, natom, nbasis, ncoi, ncoj, ncok, nimg, nseti, nsetj, nsetk, nthread, op_ij, op_jk, & + op_pos_prv, sgfi, sgfj, sgfk, unit_id + INTEGER, DIMENSION(2) :: bo + INTEGER, DIMENSION(3) :: blk_size, cell_j, cell_k, & + kp_index_lbounds, kp_index_ubounds, sp + INTEGER, DIMENSION(:), POINTER :: lmax_i, lmax_j, lmax_k, lmin_i, lmin_j, & + lmin_k, npgfi, npgfj, npgfk, nsgfi, & + nsgfj, nsgfk + INTEGER, DIMENSION(:, :), POINTER :: first_sgf_i, first_sgf_j, first_sgf_k + INTEGER, DIMENSION(:, :, :), POINTER :: cell_to_index + LOGICAL :: debug, do_kpoints_prv, found, skip + LOGICAL, DIMENSION(3) :: block_i_not_zero, block_j_not_zero, & + block_k_not_zero, der_i_zero, & + der_j_zero, der_k_zero + REAL(dp), DIMENSION(3) :: der_ext_i, der_ext_j, der_ext_k + REAL(KIND=dp) :: dij, dik, djk, dr_ij, dr_ik, dr_jk, & + kind_radius_i, kind_radius_j, & + kind_radius_k, prefac + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: ccp_buffer, cpp_buffer, & + max_contraction_i, max_contraction_j, & + max_contraction_k + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: dijk_contr, dummy_block_t + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :, :) :: block_t_i, block_t_j, block_t_k, dijk_i, & + dijk_j, dijk_k + REAL(KIND=dp), DIMENSION(3) :: ri, rij, rik, rj, rjk, rk + REAL(KIND=dp), DIMENSION(:), POINTER :: set_radius_i, set_radius_j, set_radius_k + REAL(KIND=dp), DIMENSION(:, :), POINTER :: rpgf_i, rpgf_j, rpgf_k, sphi_i, sphi_j, & + sphi_k, zeti, zetj, zetk + TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set + TYPE(cp_2d_r_p_type), DIMENSION(:, :), POINTER :: spi, spk, tspj + TYPE(cp_libint_t) :: lib + TYPE(cp_para_env_type), POINTER :: para_env + TYPE(dbcsr_t_type) :: t3c_tmp + TYPE(dbcsr_t_type), ALLOCATABLE, DIMENSION(:, :) :: t3c_template + TYPE(dbcsr_t_type), ALLOCATABLE, & + DIMENSION(:, :, :) :: t3c_der_j + TYPE(dft_control_type), POINTER :: dft_control + TYPE(gto_basis_set_type), POINTER :: basis_set + TYPE(kpoint_type), POINTER :: kpoints + TYPE(neighbor_list_3c_iterator_type) :: nl_3c_iter + TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set + + CALL timeset(routineN, handle) + + debug = .FALSE. + + IF (PRESENT(do_kpoints)) THEN + do_kpoints_prv = do_kpoints + ELSE + do_kpoints_prv = .FALSE. + ENDIF + + op_ij = do_potential_id; op_jk = do_potential_id + + IF (PRESENT(op_pos)) THEN + op_pos_prv = op_pos + ELSE + op_pos_prv = 1 + ENDIF + + SELECT CASE (op_pos_prv) + CASE (1) + op_ij = potential_parameter%potential_type + CASE (2) + op_jk = potential_parameter%potential_type + END SELECT + + dr_ij = 0.0_dp; dr_jk = 0.0_dp; dr_ik = 0.0_dp + + IF (op_ij == do_potential_truncated .OR. op_ij == do_potential_short) THEN + dr_ij = potential_parameter%cutoff_radius*cutoff_screen_factor + dr_ik = potential_parameter%cutoff_radius*cutoff_screen_factor + ELSEIF (op_ij == do_potential_coulomb) THEN + dr_ij = 1000000.0_dp + dr_ik = 1000000.0_dp + ENDIF + + IF (op_jk == do_potential_truncated .OR. op_jk == do_potential_short) THEN + dr_jk = potential_parameter%cutoff_radius*cutoff_screen_factor + dr_ik = potential_parameter%cutoff_radius*cutoff_screen_factor + ELSEIF (op_jk == do_potential_coulomb) THEN + dr_jk = 1000000.0_dp + dr_ik = 1000000.0_dp + ENDIF + + NULLIFY (qs_kind_set, atomic_kind_set) + + ! get stuff + CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set, qs_kind_set=qs_kind_set, & + natom=natom, kpoints=kpoints, dft_control=dft_control, para_env=para_env) + + IF (do_kpoints_prv) THEN + nimg = dft_control%nimages + CALL get_kpoint_info(kpoints, cell_to_index=cell_to_index) + ELSE + nimg = 1 + END IF + + CPASSERT(ALL(SHAPE(t3c_der_i) == [nimg, nimg, 3])) + CPASSERT(ALL(SHAPE(t3c_der_k) == [nimg, nimg, 3])) + + ALLOCATE (t3c_template(nimg, nimg)) + DO j_img = 1, nimg + DO i_img = 1, nimg + CALL dbcsr_t_create(t3c_der_i(i_img, j_img, 1), t3c_template(i_img, j_img)) + END DO + END DO + + CALL alloc_block_3c(t3c_template, nl_3c, basis_i, basis_j, basis_k, qs_env, & + potential_parameter, op_pos=op_pos_prv, do_kpoints=do_kpoints, & + bounds_i=bounds_i, bounds_j=bounds_j, bounds_k=bounds_k) + DO i_xyz = 1, 3 + DO j_img = 1, nimg + DO i_img = 1, nimg + CALL dbcsr_t_copy(t3c_template(i_img, j_img), t3c_der_i(i_img, j_img, i_xyz)) + CALL dbcsr_t_copy(t3c_template(i_img, j_img), t3c_der_k(i_img, j_img, i_xyz)) + END DO + END DO + END DO + + DO j_img = 1, nimg + DO i_img = 1, nimg + CALL dbcsr_t_destroy(t3c_template(i_img, j_img)) + END DO + END DO + DEALLOCATE (t3c_template) + + IF (nl_3c%sym == symmetric_jk) THEN + ALLOCATE (t3c_der_j(nimg, nimg, 3)) + DO i_xyz = 1, 3 + DO j_img = 1, nimg + DO i_img = 1, nimg + CALL dbcsr_t_create(t3c_der_k(i_img, j_img, i_xyz), t3c_der_j(i_img, j_img, i_xyz)) + CALL dbcsr_t_copy(t3c_der_k(i_img, j_img, i_xyz), t3c_der_j(i_img, j_img, i_xyz)) + END DO + END DO + END DO + END IF + + !Need the max l for each basis for libint and max nset, nco and nsgf for LIBXSMM contraction + nbasis = SIZE(basis_i) + max_nsgfi = 0 + max_ncoi = 0 + max_nset = 0 + maxli = 0 + DO ibasis = 1, nbasis + CALL get_gto_basis_set(gto_basis_set=basis_i(ibasis)%gto_basis_set, maxl=imax, & + nset=iset, nsgf_set=nsgfi, npgf=npgfi) + maxli = MAX(maxli, imax) + max_nset = MAX(max_nset, iset) + max_nsgfi = MAX(max_nsgfi, MAXVAL(nsgfi)) + max_ncoi = MAX(max_ncoi, MAXVAL(npgfi)*ncoset(maxli)) + END DO + max_nsgfj = 0 + max_ncoj = 0 + maxlj = 0 + DO ibasis = 1, nbasis + CALL get_gto_basis_set(gto_basis_set=basis_j(ibasis)%gto_basis_set, maxl=imax, & + nset=jset, nsgf_set=nsgfj, npgf=npgfj) + maxlj = MAX(maxlj, imax) + max_nset = MAX(max_nset, jset) + max_nsgfj = MAX(max_nsgfj, MAXVAL(nsgfj)) + max_ncoj = MAX(max_ncoj, MAXVAL(npgfj)*ncoset(maxlj)) + END DO + max_nsgfk = 0 + max_ncok = 0 + maxlk = 0 + DO ibasis = 1, nbasis + CALL get_gto_basis_set(gto_basis_set=basis_k(ibasis)%gto_basis_set, maxl=imax, & + nset=kset, nsgf_set=nsgfk, npgf=npgfk) + maxlk = MAX(maxlk, imax) + max_nset = MAX(max_nset, kset) + max_nsgfk = MAX(max_nsgfk, MAXVAL(nsgfk)) + max_ncok = MAX(max_ncok, MAXVAL(npgfk)*ncoset(maxlk)) + END DO + m_max = maxli + maxlj + maxlk + 1 + + !To minimize expensive memory opsand generally optimize contraction, pre-allocate + !contiguous sphi arrays (and transposed in the cas of sphi_i) + + NULLIFY (tspj, spi, spk) + ALLOCATE (spi(max_nset, nbasis), tspj(max_nset, nbasis), spk(max_nset, nbasis)) + + DO ibasis = 1, nbasis + DO iset = 1, max_nset + NULLIFY (spi(iset, ibasis)%array) + NULLIFY (tspj(iset, ibasis)%array) + + NULLIFY (spk(iset, ibasis)%array) + END DO + END DO + + DO ilist = 1, 3 + DO ibasis = 1, nbasis + IF (ilist == 1) basis_set => basis_i(ibasis)%gto_basis_set + IF (ilist == 2) basis_set => basis_j(ibasis)%gto_basis_set + IF (ilist == 3) basis_set => basis_k(ibasis)%gto_basis_set + + DO iset = 1, basis_set%nset + + ncoi = basis_set%npgf(iset)*ncoset(basis_set%lmax(iset)) + sgfi = basis_set%first_sgf(1, iset) + egfi = sgfi + basis_set%nsgf_set(iset) - 1 + + IF (ilist == 1) THEN + ALLOCATE (spi(iset, ibasis)%array(ncoi, basis_set%nsgf_set(iset))) + spi(iset, ibasis)%array(:, :) = basis_set%sphi(1:ncoi, sgfi:egfi) + + ELSE IF (ilist == 2) THEN + ALLOCATE (tspj(iset, ibasis)%array(basis_set%nsgf_set(iset), ncoi)) + tspj(iset, ibasis)%array(:, :) = TRANSPOSE(basis_set%sphi(1:ncoi, sgfi:egfi)) + + ELSE + ALLOCATE (spk(iset, ibasis)%array(ncoi, basis_set%nsgf_set(iset))) + spk(iset, ibasis)%array(:, :) = basis_set%sphi(1:ncoi, sgfi:egfi) + END IF + + END DO !iset + END DO !ibasis + END DO !ilist + + !Init the truncated Coulomb operator + IF (op_ij == do_potential_truncated .OR. op_jk == do_potential_truncated) THEN + + IF (m_max > get_lmax_init()) THEN + IF (para_env%mepos == 0) THEN + CALL open_file(unit_number=unit_id, file_name=potential_parameter%filename) + END IF + CALL init(m_max, unit_id, para_env%mepos, para_env%group) + IF (para_env%mepos == 0) THEN + CALL close_file(unit_id) + END IF + END IF + END IF + + CALL init_md_ftable(nmax=m_max) + + IF (do_kpoints_prv) THEN + kp_index_lbounds = LBOUND(cell_to_index) + kp_index_ubounds = UBOUND(cell_to_index) + ENDIF + + nthread = 1 +!$ nthread = omp_get_max_threads() + +!$OMP PARALLEL DEFAULT(NONE) & +!$OMP SHARED (nthread,do_kpoints_prv,kp_index_lbounds,kp_index_ubounds,maxli,maxlk,maxlj,bounds_i,& +!$OMP bounds_j,bounds_k,nimg,basis_i,basis_j,basis_k,dr_ij,dr_jk,dr_ik,ncoset,& +!$OMP potential_parameter,der_eps,tspj,spi,spk,debug,cell_to_index,max_ncoi,max_nsgfk,& +!$OMP max_nsgfj,max_ncok,natom,nl_3c,t3c_der_i,t3c_der_k,t3c_der_j) & +!$OMP PRIVATE (lib,nl_3c_iter,ikind,jkind,kkind,iatom,jatom,katom,rij,rjk,rik,cell_j,cell_k,& +!$OMP prefac,jcell,kcell,first_sgf_i,lmax_i,lmin_i,npgfi,nseti,nsgfi,rpgf_i,set_radius_i,& +!$OMP sphi_i,zeti,kind_radius_i,first_sgf_j,lmax_j,lmin_j,npgfj,nsetj,nsgfj,rpgf_j,& +!$OMP set_radius_j,sphi_j,zetj,kind_radius_j,first_sgf_k,lmax_k,lmin_k,npgfk,nsetk,nsgfk,& +!$OMP rpgf_k,set_radius_k,sphi_k,zetk,kind_radius_k,djk,dij,dik,ncoi,ncoj,ncok,sgfi,sgfj,& +!$OMP sgfk,dijk_i,dijk_j,dijk_k,ri,rj,rk,max_contraction_i,max_contraction_j,& +!$OMP max_contraction_k,iset,jset,kset,block_t_i,blk_size,dijk_contr,cpp_buffer,ccp_buffer,& +!$OMP block_start_j,block_end_j,block_start_k,block_end_k,block_start_i,block_end_i,found,& +!$OMP dummy_block_t,sp,handle2,mepos,bo,block_t_k,der_ext_i,der_ext_j,der_ext_k,block_i_not_zero,& +!$OMP block_k_not_zero,der_i_zero,der_k_zero,skip,der_j_zero,block_t_j,block_j_not_zero) + + mepos = 0 +!$ mepos = omp_get_thread_num() + + CALL cp_libint_init_3eri1(lib, MAX(maxli, maxlj, maxlk)) + CALL cp_libint_set_contrdepth(lib, 1) + + !pre-allocate contraction buffers + ALLOCATE (cpp_buffer(max_nsgfj*max_ncok), ccp_buffer(max_nsgfj*max_nsgfk*max_ncoi)) + + CALL neighbor_list_3c_iterator_create(nl_3c_iter, nl_3c) + + !We split the provided bounds among the threads such that each threads works on a different set of atoms + IF (PRESENT(bounds_i)) THEN + bo = get_limit(bounds_i(2) - bounds_i(1) + 1, nthread, mepos) + bo(:) = bo(:) + bounds_i(1) - 1 + CALL nl_3c_iter_set_bounds(nl_3c_iter, bo, bounds_j, bounds_k) + ELSE IF (PRESENT(bounds_j)) THEN + bo = get_limit(bounds_j(2) - bounds_j(1) + 1, nthread, mepos) + bo(:) = bo(:) + bounds_j(1) - 1 + CALL nl_3c_iter_set_bounds(nl_3c_iter, bounds_i, bo, bounds_k) + ELSE IF (PRESENT(bounds_k)) THEN + bo = get_limit(bounds_k(2) - bounds_k(1) + 1, nthread, mepos) + bo(:) = bo(:) + bounds_k(1) - 1 + CALL nl_3c_iter_set_bounds(nl_3c_iter, bounds_i, bounds_j, bo) + ELSE + bo = get_limit(natom, nthread, mepos) + CALL nl_3c_iter_set_bounds(nl_3c_iter, bo, bounds_j, bounds_k) + END IF + + skip = .FALSE. + IF (bo(1) > bo(2)) skip = .TRUE. + + DO WHILE (neighbor_list_3c_iterate(nl_3c_iter) == 0) + CALL get_3c_iterator_info(nl_3c_iter, ikind=ikind, jkind=jkind, kkind=kkind, & + iatom=iatom, jatom=jatom, katom=katom, & + rij=rij, rjk=rjk, rik=rik, cell_j=cell_j, cell_k=cell_k) + IF (skip) EXIT + + IF (do_kpoints_prv) THEN + prefac = 0.5_dp + ELSEIF (nl_3c%sym == symmetric_jk) THEN + IF (jatom == katom) THEN + prefac = 0.5_dp + ELSE + prefac = 1.0_dp + END IF + ELSE + prefac = 1.0_dp + ENDIF + + IF (do_kpoints_prv) THEN + + IF (ANY([cell_j(1), cell_j(2), cell_j(3)] < kp_index_lbounds) .OR. & + ANY([cell_j(1), cell_j(2), cell_j(3)] > kp_index_ubounds)) CYCLE + + jcell = cell_to_index(cell_j(1), cell_j(2), cell_j(3)) + IF (jcell > nimg) CYCLE + + IF (ANY([cell_k(1), cell_k(2), cell_k(3)] < kp_index_lbounds) .OR. & + ANY([cell_k(1), cell_k(2), cell_k(3)] > kp_index_ubounds)) CYCLE + + kcell = cell_to_index(cell_k(1), cell_k(2), cell_k(3)) + IF (kcell > nimg) CYCLE + + ELSE + jcell = 1; kcell = 1 + END IF + + CALL get_gto_basis_set(basis_i(ikind)%gto_basis_set, first_sgf=first_sgf_i, lmax=lmax_i, lmin=lmin_i, & + npgf=npgfi, nset=nseti, nsgf_set=nsgfi, pgf_radius=rpgf_i, set_radius=set_radius_i, & + sphi=sphi_i, zet=zeti, kind_radius=kind_radius_i) + + CALL get_gto_basis_set(basis_j(jkind)%gto_basis_set, first_sgf=first_sgf_j, lmax=lmax_j, lmin=lmin_j, & + npgf=npgfj, nset=nsetj, nsgf_set=nsgfj, pgf_radius=rpgf_j, set_radius=set_radius_j, & + sphi=sphi_j, zet=zetj, kind_radius=kind_radius_j) + + CALL get_gto_basis_set(basis_k(kkind)%gto_basis_set, first_sgf=first_sgf_k, lmax=lmax_k, lmin=lmin_k, & + npgf=npgfk, nset=nsetk, nsgf_set=nsgfk, pgf_radius=rpgf_k, set_radius=set_radius_k, & + sphi=sphi_k, zet=zetk, kind_radius=kind_radius_k) + + djk = NORM2(rjk) + dij = NORM2(rij) + dik = NORM2(rik) + + IF (kind_radius_j + kind_radius_i + dr_ij < dij) CYCLE + IF (kind_radius_j + kind_radius_k + dr_jk < djk) CYCLE + IF (kind_radius_k + kind_radius_i + dr_ik < dik) CYCLE + + ALLOCATE (max_contraction_i(nseti)) + max_contraction_i = 0.0_dp + DO iset = 1, nseti + sgfi = first_sgf_i(1, iset) + max_contraction_i(iset) = MAXVAL((/(SUM(ABS(sphi_i(:, i))), i=sgfi, sgfi + nsgfi(iset) - 1)/)) + ENDDO + + ALLOCATE (max_contraction_j(nsetj)) + max_contraction_j = 0.0_dp + DO jset = 1, nsetj + sgfj = first_sgf_j(1, jset) + max_contraction_j(jset) = MAXVAL((/(SUM(ABS(sphi_j(:, i))), i=sgfj, sgfj + nsgfj(jset) - 1)/)) + ENDDO + + ALLOCATE (max_contraction_k(nsetk)) + max_contraction_k = 0.0_dp + DO kset = 1, nsetk + sgfk = first_sgf_k(1, kset) + max_contraction_k(kset) = MAXVAL((/(SUM(ABS(sphi_k(:, i))), i=sgfk, sgfk + nsgfk(kset) - 1)/)) + ENDDO + + CALL dbcsr_t_blk_sizes(t3c_der_i(jcell, kcell, 1), [iatom, jatom, katom], blk_size) + + ALLOCATE (block_t_i(blk_size(2), blk_size(3), blk_size(1), 3)) + ALLOCATE (block_t_j(blk_size(2), blk_size(3), blk_size(1), 3)) + ALLOCATE (block_t_k(blk_size(2), blk_size(3), blk_size(1), 3)) + + block_t_i = 0.0_dp + block_t_j = 0.0_dp + block_t_k = 0.0_dp + block_i_not_zero = .FALSE. + block_j_not_zero = .FALSE. + block_k_not_zero = .FALSE. + + DO iset = 1, nseti + + DO jset = 1, nsetj + + IF (set_radius_j(jset) + set_radius_i(iset) + dr_ij < dij) CYCLE + + DO kset = 1, nsetk + + IF (set_radius_j(jset) + set_radius_k(kset) + dr_jk < djk) CYCLE + IF (set_radius_k(kset) + set_radius_i(iset) + dr_ik < dik) CYCLE + + ncoi = npgfi(iset)*ncoset(lmax_i(iset)) + ncoj = npgfj(jset)*ncoset(lmax_j(jset)) + ncok = npgfk(kset)*ncoset(lmax_k(kset)) + + sgfi = first_sgf_i(1, iset) + sgfj = first_sgf_j(1, jset) + sgfk = first_sgf_k(1, kset) + + IF (ncoj*ncok*ncoi > 0) THEN + ALLOCATE (dijk_i(ncoj, ncok, ncoi, 3)) + ALLOCATE (dijk_j(ncoj, ncok, ncoi, 3)) + ALLOCATE (dijk_k(ncoj, ncok, ncoi, 3)) + dijk_j(:, :, :, :) = 0.0_dp + dijk_k(:, :, :, :) = 0.0_dp + + der_i_zero = .FALSE. + der_j_zero = .FALSE. + der_k_zero = .FALSE. + + !need positions for libint. Only relative positions are needed => set ri to 0.0 + ri = 0.0_dp + rj = rij ! ri + rij + rk = rik ! ri + rik + + CALL eri_3center_derivs(dijk_j, dijk_k, & + lmin_j(jset), lmax_j(jset), npgfj(jset), zetj(:, jset), rpgf_j(:, jset), rj, & + lmin_k(kset), lmax_k(kset), npgfk(kset), zetk(:, kset), rpgf_k(:, kset), rk, & + lmin_i(iset), lmax_i(iset), npgfi(iset), zeti(:, iset), rpgf_i(:, iset), ri, & + djk, dij, dik, lib, potential_parameter, & + der_abc_1_ext=der_ext_j, der_abc_2_ext=der_ext_k) + + !translational invariance for the 3rd center (center i) + dijk_i(:, :, :, :) = -(dijk_j(:, :, :, :) + dijk_k(:, :, :, :)) + der_ext_i = der_ext_j + der_ext_k + + IF (PRESENT(der_eps)) THEN + DO i_xyz = 1, 3 + IF (der_eps > der_ext_i(i_xyz)*(max_contraction_i(iset)* & + max_contraction_j(jset)* & + max_contraction_k(kset))) THEN + der_i_zero(i_xyz) = .TRUE. + END IF + END DO + + DO i_xyz = 1, 3 + IF (der_eps > der_ext_j(i_xyz)*(max_contraction_i(iset)* & + max_contraction_j(jset)* & + max_contraction_k(kset))) THEN + der_j_zero(i_xyz) = .TRUE. + END IF + END DO + + DO i_xyz = 1, 3 + IF (der_eps > der_ext_k(i_xyz)*(max_contraction_i(iset)* & + max_contraction_j(jset)* & + max_contraction_k(kset))) THEN + der_k_zero(i_xyz) = .TRUE. + END IF + END DO + IF (ALL(der_i_zero) .AND. ALL(der_j_zero) .AND. ALL(der_k_zero)) THEN + DEALLOCATE (dijk_i, dijk_j, dijk_k) + CYCLE + END IF + ENDIF + + ALLOCATE (dijk_contr(nsgfj(jset), nsgfk(kset), nsgfi(iset))) + + block_start_j = sgfj + block_end_j = sgfj + nsgfj(jset) - 1 + block_start_k = sgfk + block_end_k = sgfk + nsgfk(kset) - 1 + block_start_i = sgfi + block_end_i = sgfi + nsgfi(iset) - 1 + + DO i_xyz = 1, 3 + IF (der_i_zero(i_xyz)) CYCLE + + block_i_not_zero(i_xyz) = .TRUE. + CALL libxsmm_abc_contract(dijk_contr, dijk_i(:, :, :, i_xyz), tspj(jset, jkind)%array, & + spk(kset, kkind)%array, spi(iset, ikind)%array, & + ncoj, ncok, ncoi, nsgfj(jset), nsgfk(kset), & + nsgfi(iset), cpp_buffer, ccp_buffer) + + block_t_i(block_start_j:block_end_j, & + block_start_k:block_end_k, & + block_start_i:block_end_i, i_xyz) = & + block_t_i(block_start_j:block_end_j, & + block_start_k:block_end_k, & + block_start_i:block_end_i, i_xyz) + & + prefac*dijk_contr(:, :, :) + + END DO + + IF (nl_3c%sym == symmetric_jk) THEN + DO i_xyz = 1, 3 + IF (der_j_zero(i_xyz)) CYCLE + + block_j_not_zero(i_xyz) = .TRUE. + CALL libxsmm_abc_contract(dijk_contr, dijk_j(:, :, :, i_xyz), tspj(jset, jkind)%array, & + spk(kset, kkind)%array, spi(iset, ikind)%array, & + ncoj, ncok, ncoi, nsgfj(jset), nsgfk(kset), & + nsgfi(iset), cpp_buffer, ccp_buffer) + + block_t_j(block_start_j:block_end_j, & + block_start_k:block_end_k, & + block_start_i:block_end_i, i_xyz) = & + block_t_j(block_start_j:block_end_j, & + block_start_k:block_end_k, & + block_start_i:block_end_i, i_xyz) + & + prefac*dijk_contr(:, :, :) + + END DO + END IF + + DO i_xyz = 1, 3 + IF (der_k_zero(i_xyz)) CYCLE + + block_k_not_zero(i_xyz) = .TRUE. + CALL libxsmm_abc_contract(dijk_contr, dijk_k(:, :, :, i_xyz), tspj(jset, jkind)%array, & + spk(kset, kkind)%array, spi(iset, ikind)%array, & + ncoj, ncok, ncoi, nsgfj(jset), nsgfk(kset), & + nsgfi(iset), cpp_buffer, ccp_buffer) + + block_t_k(block_start_j:block_end_j, & + block_start_k:block_end_k, & + block_start_i:block_end_i, i_xyz) = & + block_t_k(block_start_j:block_end_j, & + block_start_k:block_end_k, & + block_start_i:block_end_i, i_xyz) + & + prefac*dijk_contr(:, :, :) + + END DO + + DEALLOCATE (dijk_i, dijk_j, dijk_k, dijk_contr) + END IF ! number of triples > 0 + END DO + END DO + END DO + + CALL timeset(routineN//"_put_dbcsr", handle2) +!$OMP CRITICAL + IF (debug) THEN + DO i_xyz = 1, 3 + IF (.NOT. block_i_not_zero(i_xyz)) CYCLE + CALL dbcsr_t_get_block(t3c_der_i(jcell, kcell, i_xyz), & + [iatom, jatom, katom], dummy_block_t, found=found) + CPASSERT(found) + END DO + ENDIF + + sp = SHAPE(block_t_i(:, :, :, 1)) + sp([2, 3, 1]) = sp + + DO i_xyz = 1, 3 + IF (.NOT. block_i_not_zero(i_xyz)) CYCLE + CALL dbcsr_t_put_block(t3c_der_i(jcell, kcell, i_xyz), [iatom, jatom, katom], sp, & + RESHAPE(block_t_i(:, :, :, i_xyz), SHAPE=sp, ORDER=[2, 3, 1]), & + summation=.TRUE.) + END DO +!$OMP END CRITICAL +!$OMP CRITICAL + IF (nl_3c%sym == symmetric_jk) THEN + IF (debug) THEN + DO i_xyz = 1, 3 + IF (.NOT. block_j_not_zero(i_xyz)) CYCLE + CALL dbcsr_t_get_block(t3c_der_j(jcell, kcell, i_xyz), & + [iatom, jatom, katom], dummy_block_t, found=found) + CPASSERT(found) + END DO + ENDIF + + sp = SHAPE(block_t_j(:, :, :, 1)) + sp([2, 3, 1]) = sp + + DO i_xyz = 1, 3 + IF (.NOT. block_j_not_zero(i_xyz)) CYCLE + CALL dbcsr_t_put_block(t3c_der_j(jcell, kcell, i_xyz), [iatom, jatom, katom], sp, & + RESHAPE(block_t_j(:, :, :, i_xyz), SHAPE=sp, ORDER=[2, 3, 1]), & + summation=.TRUE.) + END DO + END IF +!$OMP END CRITICAL +!$OMP CRITICAL + IF (debug) THEN + DO i_xyz = 1, 3 + IF (.NOT. block_k_not_zero(i_xyz)) CYCLE + CALL dbcsr_t_get_block(t3c_der_k(jcell, kcell, i_xyz), & + [iatom, jatom, katom], dummy_block_t, found=found) + CPASSERT(found) + END DO + ENDIF + + sp = SHAPE(block_t_k(:, :, :, 1)) + sp([2, 3, 1]) = sp + + DO i_xyz = 1, 3 + IF (.NOT. block_k_not_zero(i_xyz)) CYCLE + CALL dbcsr_t_put_block(t3c_der_k(jcell, kcell, i_xyz), [iatom, jatom, katom], sp, & + RESHAPE(block_t_k(:, :, :, i_xyz), SHAPE=sp, ORDER=[2, 3, 1]), & + summation=.TRUE.) + END DO +!$OMP END CRITICAL + + CALL timestop(handle2) + + DEALLOCATE (block_t_i) + DEALLOCATE (block_t_j) + DEALLOCATE (block_t_k) + + DEALLOCATE (max_contraction_i, max_contraction_j, max_contraction_k) + END DO + + CALL cp_libint_cleanup_3eri1(lib) + + CALL neighbor_list_3c_iterator_destroy(nl_3c_iter) +!$OMP END PARALLEL + + IF (do_kpoints_prv) THEN + DO i_xyz = 1, 3 + DO kcell = 1, nimg + DO jcell = 1, nimg + ! need half of filter eps because afterwards we add transposed tensor + CALL dbcsr_t_filter(t3c_der_i(jcell, kcell, i_xyz), filter_eps/2) + CALL dbcsr_t_filter(t3c_der_k(jcell, kcell, i_xyz), filter_eps/2) + END DO + ENDDO + ENDDO + + ELSEIF (nl_3c%sym == symmetric_jk) THEN + !Add the transpose of t3c_der_j to t3c_der_k to get the fully populated tensor + CALL dbcsr_t_create(t3c_der_k(1, 1, 1), t3c_tmp) + DO i_xyz = 1, 3 + DO kcell = 1, nimg + DO jcell = 1, nimg + CALL dbcsr_t_copy(t3c_der_j(jcell, kcell, i_xyz), t3c_der_k(jcell, kcell, i_xyz), & + order=[1, 3, 2], move_data=.TRUE., summation=.TRUE.) + CALL dbcsr_t_filter(t3c_der_k(jcell, kcell, i_xyz), filter_eps) + + CALL dbcsr_t_copy(t3c_der_i(jcell, kcell, i_xyz), t3c_tmp) + CALL dbcsr_t_copy(t3c_tmp, t3c_der_i(jcell, kcell, i_xyz), & + order=[1, 3, 2], move_data=.TRUE., summation=.TRUE.) + CALL dbcsr_t_filter(t3c_der_i(jcell, kcell, i_xyz), filter_eps) + END DO + END DO + END DO + CALL dbcsr_t_destroy(t3c_tmp) + + ELSEIF (nl_3c%sym == symmetric_none) THEN + DO i_xyz = 1, 3 + DO kcell = 1, nimg + DO jcell = 1, nimg + CALL dbcsr_t_filter(t3c_der_i(jcell, kcell, i_xyz), filter_eps) + CALL dbcsr_t_filter(t3c_der_k(jcell, kcell, i_xyz), filter_eps) + END DO + ENDDO + ENDDO + ELSE + CPABORT("requested symmetric case not implemented") + ENDIF + + IF (nl_3c%sym == symmetric_jk) THEN + DO i_xyz = 1, 3 + DO j_img = 1, nimg + DO i_img = 1, nimg + CALL dbcsr_t_destroy(t3c_der_j(i_img, j_img, i_xyz)) + END DO + END DO + END DO + END IF + + DO iset = 1, max_nset + DO ibasis = 1, nbasis + IF (ASSOCIATED(spi(iset, ibasis)%array)) DEALLOCATE (spi(iset, ibasis)%array) + IF (ASSOCIATED(tspj(iset, ibasis)%array)) DEALLOCATE (tspj(iset, ibasis)%array) + + IF (ASSOCIATED(spk(iset, ibasis)%array)) DEALLOCATE (spk(iset, ibasis)%array) + END DO + END DO + + DEALLOCATE (spi, tspj, spk) + + CALL timestop(handle) + END SUBROUTINE build_3c_derivatives + + ! ************************************************************************************************** !> \brief Build 3-center integral tensor !> \param t3c empty DBCSR tensor !> Should be of shape (1,1) if no kpoints are used and of shape (nimages, nimages) @@ -843,10 +1813,10 @@ CONTAINS ! ************************************************************************************************** SUBROUTINE build_3c_integrals(t3c, filter_eps, qs_env, & nl_3c, basis_i, basis_j, basis_k, & - potential_parameter, & - int_eps, & + potential_parameter, int_eps, & op_pos, do_kpoints, desymmetrize, & bounds_i, bounds_j, bounds_k) + TYPE(dbcsr_t_type), DIMENSION(:, :), INTENT(INOUT) :: t3c REAL(KIND=dp), INTENT(IN) :: filter_eps TYPE(qs_environment_type), POINTER :: qs_env @@ -863,8 +1833,10 @@ CONTAINS INTEGER :: block_end_i, block_end_j, block_end_k, block_start_i, block_start_j, & block_start_k, egfi, handle, handle2, i, iatom, ibasis, ikind, ilist, imax, iset, jatom, & jcell, jkind, jset, katom, kcell, kkind, kset, m_max, max_ncoi, max_ncoj, max_ncok, & - max_nset, max_nsgfi, max_nsgfj, max_nsgfk, maxli, maxlj, maxlk, natom, nbasis, ncoi, & - ncoj, ncok, nimg, nseti, nsetj, nsetk, op_ij, op_jk, op_pos_prv, sgfi, sgfj, sgfk, unit_id + max_nset, max_nsgfi, max_nsgfj, max_nsgfk, maxli, maxlj, maxlk, mepos, natom, nbasis, & + ncoi, ncoj, ncok, nimg, nseti, nsetj, nsetk, nthread, op_ij, op_jk, op_pos_prv, sgfi, & + sgfj, sgfk, unit_id + INTEGER, DIMENSION(2) :: bo INTEGER, DIMENSION(3) :: blk_size, cell_j, cell_k, & kp_index_lbounds, kp_index_ubounds, sp INTEGER, DIMENSION(:), POINTER :: lmax_i, lmax_j, lmax_k, lmin_i, lmin_j, & @@ -873,7 +1845,7 @@ CONTAINS INTEGER, DIMENSION(:, :), POINTER :: first_sgf_i, first_sgf_j, first_sgf_k INTEGER, DIMENSION(:, :, :), POINTER :: cell_to_index LOGICAL :: block_not_zero, debug, desymmetrize_prv, & - do_kpoints_prv, found + do_kpoints_prv, found, skip REAL(KIND=dp) :: dij, dik, djk, dr_ij, dr_ik, dr_jk, & kind_radius_i, kind_radius_j, & kind_radius_k, prefac, sijk_ext @@ -948,7 +1920,8 @@ CONTAINS NULLIFY (qs_kind_set, atomic_kind_set) CALL alloc_block_3c(t3c, nl_3c, basis_i, basis_j, basis_k, qs_env, & - potential_parameter, op_pos=op_pos_prv, do_kpoints=do_kpoints) + potential_parameter, op_pos=op_pos_prv, do_kpoints=do_kpoints, & + bounds_i=bounds_i, bounds_j=bounds_j, bounds_k=bounds_k) ! get stuff CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set, qs_kind_set=qs_kind_set, & @@ -1001,9 +1974,8 @@ CONTAINS END DO m_max = maxli + maxlj + maxlk - !To minimize expensive memory opsand generally optimize contraction, pre-allocate buffers and + !To minimize expensive memory opsand generally optimize contraction, pre-allocate !contiguous sphi arrays (and transposed in the cas of sphi_i) - ALLOCATE (cpp_buffer(max_nsgfj*max_ncok), ccp_buffer(max_nsgfj*max_nsgfk*max_ncoi)) NULLIFY (tspj, spi, spk) ALLOCATE (spi(max_nset, nbasis), tspj(max_nset, nbasis), spk(max_nset, nbasis)) @@ -1062,21 +2034,66 @@ CONTAINS CALL init_md_ftable(nmax=m_max) - CALL cp_libint_init_3eri(lib, MAX(maxli, maxlj, maxlk)) - CALL cp_libint_set_contrdepth(lib, 1) - - CALL neighbor_list_3c_iterator_create(nl_3c_iter, nl_3c) - CALL nl_3c_iter_set_bounds(nl_3c_iter, bounds_i, bounds_j, bounds_k) - IF (do_kpoints_prv) THEN kp_index_lbounds = LBOUND(cell_to_index) kp_index_ubounds = UBOUND(cell_to_index) ENDIF + nthread = 1 +!$ nthread = omp_get_max_threads() + +!$OMP PARALLEL DEFAULT(NONE) & +!$OMP SHARED (nthread,do_kpoints_prv,kp_index_lbounds,kp_index_ubounds,maxli,maxlk,maxlj,bounds_i,& +!$OMP bounds_j,bounds_k,nimg,basis_i,basis_j,basis_k,dr_ij,dr_jk,dr_ik,ncoset,& +!$OMP potential_parameter,int_eps,t3c,tspj,spi,spk,debug,cell_to_index,max_ncoi,max_nsgfk,& +!$OMP max_nsgfj,max_ncok,natom,nl_3c) & +!$OMP PRIVATE (lib,nl_3c_iter,ikind,jkind,kkind,iatom,jatom,katom,rij,rjk,rik,cell_j,cell_k,& +!$OMP prefac,jcell,kcell,first_sgf_i,lmax_i,lmin_i,npgfi,nseti,nsgfi,rpgf_i,set_radius_i,& +!$OMP sphi_i,zeti,kind_radius_i,first_sgf_j,lmax_j,lmin_j,npgfj,nsetj,nsgfj,rpgf_j,& +!$OMP set_radius_j,sphi_j,zetj,kind_radius_j,first_sgf_k,lmax_k,lmin_k,npgfk,nsetk,nsgfk,& +!$OMP rpgf_k,set_radius_k,sphi_k,zetk,kind_radius_k,djk,dij,dik,ncoi,ncoj,ncok,sgfi,sgfj,& +!$OMP sgfk,sijk,ri,rj,rk,sijk_ext,block_not_zero,max_contraction_i,max_contraction_j,& +!$OMP max_contraction_k,iset,jset,kset,block_t,blk_size,sijk_contr,cpp_buffer,ccp_buffer,& +!$OMP block_start_j,block_end_j,block_start_k,block_end_k,block_start_i,block_end_i,found,& +!$OMP dummy_block_t,sp,handle2,mepos,bo,skip) + + mepos = 0 +!$ mepos = omp_get_thread_num() + + CALL cp_libint_init_3eri(lib, MAX(maxli, maxlj, maxlk)) + CALL cp_libint_set_contrdepth(lib, 1) + + !pre-allocate contraction buffers + ALLOCATE (cpp_buffer(max_nsgfj*max_ncok), ccp_buffer(max_nsgfj*max_nsgfk*max_ncoi)) + + CALL neighbor_list_3c_iterator_create(nl_3c_iter, nl_3c) + + !We split the provided bounds among the threads such that each threads works on a different set of atoms + IF (PRESENT(bounds_i)) THEN + bo = get_limit(bounds_i(2) - bounds_i(1) + 1, nthread, mepos) + bo(:) = bo(:) + bounds_i(1) - 1 + CALL nl_3c_iter_set_bounds(nl_3c_iter, bo, bounds_j, bounds_k) + ELSE IF (PRESENT(bounds_j)) THEN + bo = get_limit(bounds_j(2) - bounds_j(1) + 1, nthread, mepos) + bo(:) = bo(:) + bounds_j(1) - 1 + CALL nl_3c_iter_set_bounds(nl_3c_iter, bounds_i, bo, bounds_k) + ELSE IF (PRESENT(bounds_k)) THEN + bo = get_limit(bounds_k(2) - bounds_k(1) + 1, nthread, mepos) + bo(:) = bo(:) + bounds_k(1) - 1 + CALL nl_3c_iter_set_bounds(nl_3c_iter, bounds_i, bounds_j, bo) + ELSE + bo = get_limit(natom, nthread, mepos) + CALL nl_3c_iter_set_bounds(nl_3c_iter, bo, bounds_j, bounds_k) + END IF + + skip = .FALSE. + IF (bo(1) > bo(2)) skip = .TRUE. + DO WHILE (neighbor_list_3c_iterate(nl_3c_iter) == 0) CALL get_3c_iterator_info(nl_3c_iter, ikind=ikind, jkind=jkind, kkind=kkind, & iatom=iatom, jatom=jatom, katom=katom, & rij=rij, rjk=rjk, rik=rik, cell_j=cell_j, cell_k=cell_k) + IF (skip) EXIT IF (do_kpoints_prv) THEN prefac = 0.5_dp @@ -1180,10 +2197,12 @@ CONTAINS IF (ncoj*ncok*ncoi > 0) THEN ALLOCATE (sijk(ncoj, ncok, ncoi)) sijk(:, :, :) = 0.0_dp + !need positions for libint. Only relative positions are needed => set ri to 0.0 ri = 0.0_dp rj = rij ! ri + rij rk = rik ! ri + rik + CALL eri_3center(sijk, & lmin_j(jset), lmax_j(jset), npgfj(jset), zetj(:, jset), rpgf_j(:, jset), rj, & lmin_k(kset), lmax_k(kset), npgfk(kset), zetk(:, kset), rpgf_k(:, kset), rk, & @@ -1222,8 +2241,8 @@ CONTAINS block_start_k:block_end_k, & block_start_i:block_end_i) + & prefac*sijk_contr(:, :, :) - DEALLOCATE (sijk_contr) + DEALLOCATE (sijk_contr) END IF ! number of triples > 0 END DO @@ -1233,6 +2252,7 @@ CONTAINS END DO IF (block_not_zero) THEN +!$OMP CRITICAL CALL timeset(routineN//"_put_dbcsr", handle2) IF (debug) THEN CALL dbcsr_t_get_block(t3c(jcell, kcell), & @@ -1247,20 +2267,21 @@ CONTAINS [iatom, jatom, katom], sp, RESHAPE(block_t, SHAPE=sp, ORDER=[2, 3, 1]), summation=.TRUE.) CALL timestop(handle2) +!$OMP END CRITICAL ENDIF DEALLOCATE (block_t) - DEALLOCATE (max_contraction_i, max_contraction_j, max_contraction_k) END DO CALL cp_libint_cleanup_3eri(lib) CALL neighbor_list_3c_iterator_destroy(nl_3c_iter) +!$OMP END PARALLEL IF (nl_3c%sym == symmetric_jk .OR. do_kpoints_prv) THEN - DO jcell = 1, nimg - DO kcell = 1, nimg + DO kcell = 1, nimg + DO jcell = 1, nimg ! need half of filter eps because afterwards we add transposed tensor CALL dbcsr_t_filter(t3c(jcell, kcell), filter_eps/2) ENDDO @@ -1269,15 +2290,15 @@ CONTAINS IF (desymmetrize_prv) THEN ! add transposed of overlap integrals CALL dbcsr_t_create(t3c(1, 1), t_3c_tmp) - DO jcell = 1, nimg - DO kcell = 1, jcell + DO kcell = 1, jcell + DO jcell = 1, nimg CALL dbcsr_t_copy(t3c(jcell, kcell), t_3c_tmp) CALL dbcsr_t_copy(t_3c_tmp, t3c(kcell, jcell), order=[1, 3, 2], summation=.TRUE., move_data=.TRUE.) CALL dbcsr_t_filter(t3c(kcell, jcell), filter_eps) ENDDO ENDDO - DO jcell = 1, nimg - DO kcell = jcell + 1, nimg + DO kcell = jcell + 1, nimg + DO jcell = 1, nimg CALL dbcsr_t_copy(t3c(jcell, kcell), t_3c_tmp) CALL dbcsr_t_copy(t_3c_tmp, t3c(kcell, jcell), order=[1, 3, 2], summation=.FALSE., move_data=.TRUE.) CALL dbcsr_t_filter(t3c(kcell, jcell), filter_eps) @@ -1286,8 +2307,8 @@ CONTAINS CALL dbcsr_t_destroy(t_3c_tmp) ENDIF ELSEIF (nl_3c%sym == symmetric_none) THEN - DO jcell = 1, nimg - DO kcell = 1, nimg + DO kcell = 1, nimg + DO jcell = 1, nimg CALL dbcsr_t_filter(t3c(jcell, kcell), filter_eps) ENDDO ENDDO @@ -1307,7 +2328,249 @@ CONTAINS DEALLOCATE (spi, tspj, spk) CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE build_3c_integrals + +! ************************************************************************************************** +!> \brief Calculates the derivatives of 2-center integrals, wrt to the first center +!> \param t2c_der ... +!> this routine requires that libint has been static initialised somewhere else +!> \param filter_eps Filter threshold for matrix blocks +!> \param qs_env ... +!> \param nl_2c 2-center neighborlist +!> \param basis_i ... +!> \param basis_j ... +!> \param potential_parameter ... +!> \param do_kpoints ... +! ************************************************************************************************** + SUBROUTINE build_2c_derivatives(t2c_der, filter_eps, qs_env, & + nl_2c, basis_i, basis_j, & + potential_parameter, do_kpoints) + + TYPE(dbcsr_type), DIMENSION(:, :), INTENT(INOUT) :: t2c_der + REAL(KIND=dp), INTENT(IN) :: filter_eps + TYPE(qs_environment_type), POINTER :: qs_env + TYPE(neighbor_list_set_p_type), DIMENSION(:), & + POINTER :: nl_2c + TYPE(gto_basis_set_p_type), DIMENSION(:) :: basis_i, basis_j + TYPE(libint_potential_type), INTENT(IN) :: potential_parameter + LOGICAL, INTENT(IN), OPTIONAL :: do_kpoints + + CHARACTER(len=*), PARAMETER :: routineN = 'build_2c_derivatives' + + INTEGER :: handle, i_xyz, iatom, ibasis, icol, ikind, imax, img, irow, iset, jatom, jkind, & + jset, m_max, maxli, maxlj, natom, ncoi, ncoj, nimg, nseti, nsetj, op_prv, sgfi, sgfj, & + unit_id + INTEGER, DIMENSION(3) :: cell + INTEGER, DIMENSION(:), POINTER :: lmax_i, lmax_j, lmin_i, lmin_j, npgfi, & + npgfj, nsgfi, nsgfj + INTEGER, DIMENSION(:, :), POINTER :: first_sgf_i, first_sgf_j + INTEGER, DIMENSION(:, :, :), POINTER :: cell_to_index + LOGICAL :: do_kpoints_prv, do_symmetric, found, & + trans + REAL(KIND=dp) :: dab + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: dij_contr, dij_rs + REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: dij + REAL(KIND=dp), DIMENSION(3) :: ri, rij, rj + REAL(KIND=dp), DIMENSION(:), POINTER :: set_radius_i, set_radius_j + REAL(KIND=dp), DIMENSION(:, :), POINTER :: rpgf_i, rpgf_j, sphi_i, sphi_j, zeti, & + zetj + TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set + TYPE(block_p_type), DIMENSION(3) :: block_t + TYPE(cp_libint_t) :: lib + TYPE(cp_para_env_type), POINTER :: para_env + TYPE(dft_control_type), POINTER :: dft_control + TYPE(kpoint_type), POINTER :: kpoints + TYPE(neighbor_list_iterator_p_type), & + DIMENSION(:), POINTER :: nl_iterator + TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set + + CALL timeset(routineN, handle) + + IF (PRESENT(do_kpoints)) THEN + do_kpoints_prv = do_kpoints + ELSE + do_kpoints_prv = .FALSE. + ENDIF + + op_prv = potential_parameter%potential_type + + NULLIFY (qs_kind_set, atomic_kind_set, block_t(1)%block, block_t(2)%block, block_t(3)%block, cell_to_index) + + ! get stuff + CALL get_qs_env(qs_env, atomic_kind_set=atomic_kind_set, qs_kind_set=qs_kind_set, & + natom=natom, kpoints=kpoints, dft_control=dft_control, para_env=para_env) + + IF (do_kpoints_prv) THEN + nimg = dft_control%nimages + CALL get_kpoint_info(kpoints, cell_to_index=cell_to_index) + ELSE + nimg = 1 + END IF + + CPASSERT(ALL(SHAPE(t2c_der) == [nimg, 3])) + + ! check for symmetry + CPASSERT(SIZE(nl_2c) > 0) + CALL get_neighbor_list_set_p(neighbor_list_sets=nl_2c, symmetric=do_symmetric) + + IF (do_symmetric) THEN + DO img = 1, nimg + !Derivtive matrix is assymetric + DO i_xyz = 1, 3 + CPASSERT(dbcsr_get_matrix_type(t2c_der(img, i_xyz)) == dbcsr_type_antisymmetric) + END DO + ENDDO + ELSE + DO img = 1, nimg + DO i_xyz = 1, 3 + CPASSERT(dbcsr_get_matrix_type(t2c_der(img, i_xyz)) == dbcsr_type_no_symmetry) + END DO + ENDDO + ENDIF + + DO img = 1, nimg + DO i_xyz = 1, 3 + CALL cp_dbcsr_alloc_block_from_nbl(t2c_der(img, i_xyz), nl_2c) + END DO + ENDDO + + maxli = 0 + DO ibasis = 1, SIZE(basis_i) + CALL get_gto_basis_set(gto_basis_set=basis_i(ibasis)%gto_basis_set, maxl=imax) + maxli = MAX(maxli, imax) + END DO + maxlj = 0 + DO ibasis = 1, SIZE(basis_j) + CALL get_gto_basis_set(gto_basis_set=basis_j(ibasis)%gto_basis_set, maxl=imax) + maxlj = MAX(maxlj, imax) + END DO + + m_max = maxli + maxlj + 1 + + !Init the truncated Coulomb operator + IF (op_prv == do_potential_truncated) THEN + + IF (m_max > get_lmax_init()) THEN + IF (para_env%mepos == 0) THEN + CALL open_file(unit_number=unit_id, file_name=potential_parameter%filename) + END IF + CALL init(m_max, unit_id, para_env%mepos, para_env%group) + IF (para_env%mepos == 0) THEN + CALL close_file(unit_id) + END IF + END IF + END IF + + CALL init_md_ftable(nmax=m_max) + + CALL cp_libint_init_2eri1(lib, MAX(maxli, maxlj)) + CALL cp_libint_set_contrdepth(lib, 1) + + CALL neighbor_list_iterator_create(nl_iterator, nl_2c) + DO WHILE (neighbor_list_iterate(nl_iterator) == 0) + + CALL get_iterator_info(nl_iterator, ikind=ikind, jkind=jkind, & + iatom=iatom, jatom=jatom, r=rij, cell=cell) + IF (do_kpoints_prv) THEN + img = cell_to_index(cell(1), cell(2), cell(3)) + IF (img > nimg) CYCLE + ELSE + img = 1 + END IF + + CALL get_gto_basis_set(basis_i(ikind)%gto_basis_set, first_sgf=first_sgf_i, lmax=lmax_i, lmin=lmin_i, & + npgf=npgfi, nset=nseti, nsgf_set=nsgfi, pgf_radius=rpgf_i, set_radius=set_radius_i, & + sphi=sphi_i, zet=zeti) + + CALL get_gto_basis_set(basis_j(jkind)%gto_basis_set, first_sgf=first_sgf_j, lmax=lmax_j, lmin=lmin_j, & + npgf=npgfj, nset=nsetj, nsgf_set=nsgfj, pgf_radius=rpgf_j, set_radius=set_radius_j, & + sphi=sphi_j, zet=zetj) + + IF (do_symmetric) THEN + IF (iatom <= jatom) THEN + irow = iatom + icol = jatom + ELSE + irow = jatom + icol = iatom + END IF + ELSE + irow = iatom + icol = jatom + END IF + + dab = NORM2(rij) + trans = do_symmetric .AND. (iatom > jatom) + + DO i_xyz = 1, 3 + CALL dbcsr_get_block_p(matrix=t2c_der(img, i_xyz), & + row=irow, col=icol, BLOCK=block_t(i_xyz)%block, found=found) + CPASSERT(found) + END DO + + DO iset = 1, nseti + + ncoi = npgfi(iset)*ncoset(lmax_i(iset)) + sgfi = first_sgf_i(1, iset) + + DO jset = 1, nsetj + + ncoj = npgfj(jset)*ncoset(lmax_j(jset)) + sgfj = first_sgf_j(1, jset) + + IF (ncoi*ncoj > 0) THEN + ALLOCATE (dij_contr(nsgfi(iset), nsgfj(jset))) + ALLOCATE (dij(ncoi, ncoj, 3)) + dij(:, :, :) = 0.0_dp + + ri = 0.0_dp + rj = rij + + CALL eri_2center_derivs(dij, lmin_i(iset), lmax_i(iset), npgfi(iset), zeti(:, iset), & + rpgf_i(:, iset), ri, lmin_j(jset), lmax_j(jset), npgfj(jset), zetj(:, jset), & + rpgf_j(:, jset), rj, dab, lib, potential_parameter) + + DO i_xyz = 1, 3 + + dij_contr(:, :) = 0.0_dp + CALL ab_contract(dij_contr, dij(:, :, i_xyz), & + sphi_i(:, sgfi:), sphi_j(:, sgfj:), & + ncoi, ncoj, nsgfi(iset), nsgfj(jset)) + + IF (trans) THEN + !if transpose, then -1 factor for antisymmetry + ALLOCATE (dij_rs(nsgfj(jset), nsgfi(iset))) + dij_rs(:, :) = -1.0_dp*TRANSPOSE(dij_contr) + ELSE + ALLOCATE (dij_rs(nsgfi(iset), nsgfj(jset))) + dij_rs(:, :) = dij_contr + ENDIF + + CALL block_add("IN", dij_rs, & + nsgfi(iset), nsgfj(jset), block_t(i_xyz)%block, & + sgfi, sgfj, trans=trans) + DEALLOCATE (dij_rs) + END DO + + DEALLOCATE (dij, dij_contr) + ENDIF + END DO + END DO + ENDDO + + CALL cp_libint_cleanup_2eri1(lib) + + CALL neighbor_list_iterator_release(nl_iterator) + DO img = 1, nimg + DO i_xyz = 1, 3 + CALL dbcsr_finalize(t2c_der(img, i_xyz)) + CALL dbcsr_filter(t2c_der(img, i_xyz), filter_eps) + END DO + ENDDO + + CALL timestop(handle) + + END SUBROUTINE build_2c_derivatives ! ************************************************************************************************** !> \brief ... @@ -1336,8 +2599,7 @@ CONTAINS CHARACTER(len=*), PARAMETER :: routineN = 'build_2c_integrals' INTEGER :: handle, iatom, ibasis, icol, ikind, imax, img, irow, iset, jatom, jkind, jset, & - m_max, maxli, maxlj, n1, n2, natom, ncoi, ncoj, nimg, nseti, nsetj, offi, offj, op_prv, & - sgfi, sgfj, unit_id + m_max, maxli, maxlj, natom, ncoi, ncoj, nimg, nseti, nsetj, op_prv, sgfi, sgfj, unit_id INTEGER, DIMENSION(3) :: cell INTEGER, DIMENSION(:), POINTER :: lmax_i, lmax_j, lmin_i, lmin_j, npgfi, & npgfj, nsgfi, nsgfj @@ -1349,8 +2611,8 @@ CONTAINS REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: sij, sij_contr, sij_rs REAL(KIND=dp), DIMENSION(3) :: ri, rij, rj REAL(KIND=dp), DIMENSION(:), POINTER :: set_radius_i, set_radius_j - REAL(KIND=dp), DIMENSION(:, :), POINTER :: rpgf_i, rpgf_j, scon_i, scon_j, sphi_i, & - sphi_j, zeti, zetj + REAL(KIND=dp), DIMENSION(:, :), POINTER :: rpgf_i, rpgf_j, sphi_i, sphi_j, zeti, & + zetj TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set TYPE(block_p_type) :: block_t TYPE(cp_libint_t) :: lib @@ -1433,10 +2695,8 @@ CONTAINS CALL init_md_ftable(nmax=m_max) - IF (op_prv /= do_potential_id) THEN - CALL cp_libint_init_2eri(lib, MAX(maxli, maxlj)) - CALL cp_libint_set_contrdepth(lib, 1) - ENDIF + CALL cp_libint_init_2eri(lib, MAX(maxli, maxlj)) + CALL cp_libint_set_contrdepth(lib, 1) CALL neighbor_list_iterator_create(nl_iterator, nl_2c) DO WHILE (neighbor_list_iterate(nl_iterator) == 0) @@ -1452,11 +2712,11 @@ CONTAINS CALL get_gto_basis_set(basis_i(ikind)%gto_basis_set, first_sgf=first_sgf_i, lmax=lmax_i, lmin=lmin_i, & npgf=npgfi, nset=nseti, nsgf_set=nsgfi, pgf_radius=rpgf_i, set_radius=set_radius_i, & - sphi=sphi_i, zet=zeti, scon=scon_i) + sphi=sphi_i, zet=zeti) CALL get_gto_basis_set(basis_j(jkind)%gto_basis_set, first_sgf=first_sgf_j, lmax=lmax_j, lmin=lmin_j, & npgf=npgfj, nset=nsetj, nsgf_set=nsgfj, pgf_radius=rpgf_j, set_radius=set_radius_j, & - sphi=sphi_j, zet=zetj, scon=scon_j) + sphi=sphi_j, zet=zetj) IF (do_symmetric) THEN IF (iatom <= jatom) THEN @@ -1481,48 +2741,30 @@ CONTAINS DO iset = 1, nseti ncoi = npgfi(iset)*ncoset(lmax_i(iset)) - n1 = npgfi(iset)*(ncoset(lmax_i(iset)) - ncoset(lmin_i(iset) - 1)) sgfi = first_sgf_i(1, iset) - offi = ncoset(lmin_i(iset) - 1) + 1 DO jset = 1, nsetj ncoj = npgfj(jset)*ncoset(lmax_j(jset)) - n2 = npgfj(jset)*(ncoset(lmax_j(jset)) - ncoset(lmin_j(jset) - 1)) sgfj = first_sgf_j(1, jset) - offj = ncoset(lmin_j(jset) - 1) + 1 IF (ncoi*ncoj > 0) THEN ALLOCATE (sij_contr(nsgfi(iset), nsgfj(jset))) sij_contr(:, :) = 0.0_dp - IF (op_prv == do_potential_id) THEN - ALLOCATE (sij(n1, n2)) - sij(:, :) = 0.0_dp + ALLOCATE (sij(ncoi, ncoj)) + sij(:, :) = 0.0_dp - CALL overlap_ab(lmax_i(iset), lmin_i(iset), npgfi(iset), rpgf_i(:, iset), zeti(:, iset), & - lmax_j(jset), lmin_j(jset), npgfj(jset), rpgf_j(:, jset), zetj(:, jset), & - rij, sab=sij(:, :)) + ri = 0.0_dp + rj = rij - CALL ab_contract(sij_contr, sij, & - scon_i(:, sgfi:), scon_j(:, sgfj:), & - n1, n2, nsgfi(iset), nsgfj(jset)) + CALL eri_2center(sij, lmin_i(iset), lmax_i(iset), npgfi(iset), zeti(:, iset), & + rpgf_i(:, iset), ri, lmin_j(jset), lmax_j(jset), npgfj(jset), zetj(:, jset), & + rpgf_j(:, jset), rj, dab, lib, potential_parameter) - ELSE - ALLOCATE (sij(ncoi, ncoj)) - sij(:, :) = 0.0_dp - - ri = 0.0_dp - rj = rij - - CALL eri_2center(sij, lmin_i(iset), lmax_i(iset), npgfi(iset), zeti(:, iset), & - rpgf_i(:, iset), ri, lmin_j(jset), lmax_j(jset), npgfj(jset), zetj(:, jset), & - rpgf_j(:, jset), rj, dab, lib, potential_parameter) - - CALL ab_contract(sij_contr, sij, & - sphi_i(:, sgfi:), sphi_j(:, sgfj:), & - ncoi, ncoj, nsgfi(iset), nsgfj(jset)) - ENDIF + CALL ab_contract(sij_contr, sij, & + sphi_i(:, sgfi:), sphi_j(:, sgfj:), & + ncoi, ncoj, nsgfi(iset), nsgfj(jset)) DEALLOCATE (sij) IF (trans) THEN @@ -1539,14 +2781,13 @@ CONTAINS nsgfi(iset), nsgfj(jset), block_t%block, & sgfi, sgfj, trans=trans) DEALLOCATE (sij_rs) + ENDIF END DO END DO ENDDO - IF (op_prv /= do_potential_id) THEN - CALL cp_libint_cleanup_2eri(lib) - ENDIF + CALL cp_libint_cleanup_2eri(lib) CALL neighbor_list_iterator_release(nl_iterator) DO img = 1, nimg @@ -1556,7 +2797,7 @@ CONTAINS CALL timestop(handle) - END SUBROUTINE + END SUBROUTINE build_2c_integrals ! ************************************************************************************************** !> \brief ... diff --git a/src/response_solver.F b/src/response_solver.F index f63d11fbfc..59d3cca19e 100644 --- a/src/response_solver.F +++ b/src/response_solver.F @@ -53,12 +53,15 @@ MODULE response_solver USE exstates_types, ONLY: excited_energy_type USE hfx_derivatives, ONLY: derivatives_four_center USE hfx_energy_potential, ONLY: integrate_four_center + USE hfx_ri, ONLY: hfx_ri_update_forces,& + hfx_ri_update_ks USE hfx_types, ONLY: hfx_type USE input_constants, ONLY: & do_admm_aux_exch_func_none, ec_ls_solver, ec_mo_solver, kg_tnadd_atomic, kg_tnadd_embed, & kg_tnadd_embed_ri, ls_s_sqrt_ns, ls_s_sqrt_proot, ot_precond_full_all, & ot_precond_full_kinetic, ot_precond_full_single, ot_precond_full_single_inverse, & ot_precond_none, ot_precond_s_inverse, precond_mlp + USE input_cp2k_hfx, ONLY: ri_mo USE input_section_types, ONLY: section_get_lval,& section_vals_get,& section_vals_get_subs_vals,& @@ -1609,18 +1612,36 @@ CONTAINS mpd(ispin, 1)%matrix => matrix_p(ispin, 1)%matrix END DO ! - DO ispin = 1, mspin - eh1 = 0.0 - CALL integrate_four_center(qs_env, x_data, mhz, eh1, mpz, hfx_section, & - para_env, s_mstruct_changed, 1, distribute_fock_matrix, & - ispin=ispin) - END DO - DO ispin = 1, mspin - eh1 = 0.0 - CALL integrate_four_center(qs_env, x_data, mhd, eh1, mpd, hfx_section, & - para_env, s_mstruct_changed, 1, distribute_fock_matrix, & - ispin=ispin) - END DO + IF (x_data(1, 1)%do_hfx_ri) THEN + + IF (x_data(1, 1)%ri_data%flavor == ri_mo) THEN + CPABORT("NYI with RI_FLAVOR MO") + END IF + + eh1 = 0.0_dp + CALL hfx_ri_update_ks(qs_env, x_data(1, 1)%ri_data, mhz, eh1, rho_ao=mpz, & + geometry_did_change=s_mstruct_changed, nspins=nspins, & + hf_fraction=x_data(1, 1)%general_parameter%fraction) + + eh1 = 0.0_dp + CALL hfx_ri_update_ks(qs_env, x_data(1, 1)%ri_data, mhd, eh1, rho_ao=mpd, & + geometry_did_change=s_mstruct_changed, nspins=nspins, & + hf_fraction=x_data(1, 1)%general_parameter%fraction) + + ELSE + DO ispin = 1, mspin + eh1 = 0.0 + CALL integrate_four_center(qs_env, x_data, mhz, eh1, mpz, hfx_section, & + para_env, s_mstruct_changed, 1, distribute_fock_matrix, & + ispin=ispin) + END DO + DO ispin = 1, mspin + eh1 = 0.0 + CALL integrate_four_center(qs_env, x_data, mhd, eh1, mpd, hfx_section, & + para_env, s_mstruct_changed, 1, distribute_fock_matrix, & + ispin=ispin) + END DO + END IF ! CALL get_qs_env(qs_env, admm_env=admm_env) CPASSERT(ASSOCIATED(admm_env%work_aux_orb)) @@ -1671,12 +1692,25 @@ CONTAINS mhz(ispin, 1)%matrix => matrix_hz(ispin)%matrix mpz(ispin, 1)%matrix => mpa(ispin)%matrix END DO - DO ispin = 1, mspin - eh1 = 0.0 - CALL integrate_four_center(qs_env, x_data, mhz, eh1, mpz, hfx_section, & - para_env, s_mstruct_changed, 1, distribute_fock_matrix, & - ispin=ispin) - END DO + + IF (x_data(1, 1)%do_hfx_ri) THEN + + IF (x_data(1, 1)%ri_data%flavor == ri_mo) THEN + CPABORT("NYI with RI_FLAVOR MO") + END IF + + eh1 = 0.0_dp + CALL hfx_ri_update_ks(qs_env, x_data(1, 1)%ri_data, mhz, eh1, rho_ao=mpz, & + geometry_did_change=s_mstruct_changed, nspins=nspins, & + hf_fraction=x_data(1, 1)%general_parameter%fraction) + ELSE + DO ispin = 1, mspin + eh1 = 0.0 + CALL integrate_four_center(qs_env, x_data, mhz, eh1, mpz, hfx_section, & + para_env, s_mstruct_changed, 1, distribute_fock_matrix, & + ispin=ispin) + END DO + END IF DEALLOCATE (mhz, mpz) END IF @@ -1698,13 +1732,37 @@ CONTAINS CALL dbcsr_copy(matrix_pza(ispin)%matrix, matrix_pz_admm(ispin)%matrix) END IF END DO - CALL derivatives_four_center(qs_env, matrix_p, matrix_pza, hfx_section, para_env, & - 1, use_virial, resp_only=resp_only) + IF (x_data(1, 1)%do_hfx_ri) THEN + + IF (x_data(1, 1)%ri_data%flavor == ri_mo) THEN + CPABORT("NYI with RI_FLAVOR MO") + END IF + + CALL hfx_ri_update_forces(qs_env, x_data(1, 1)%ri_data, nspins, & + x_data(1, 1)%general_parameter%fraction, & + rho_ao=matrix_p, rho_ao_resp=matrix_pza, & + use_virial=use_virial, resp_only=resp_only) + ELSE + CALL derivatives_four_center(qs_env, matrix_p, matrix_pza, hfx_section, para_env, & + 1, use_virial, resp_only=resp_only) + END IF CALL dbcsr_deallocate_matrix_set(matrix_pza) ELSE CALL qs_rho_get(rho, rho_ao_kp=matrix_p) - CALL derivatives_four_center(qs_env, matrix_p, mpa, hfx_section, para_env, & - 1, use_virial, resp_only=resp_only) + IF (x_data(1, 1)%do_hfx_ri) THEN + + IF (x_data(1, 1)%ri_data%flavor == ri_mo) THEN + CPABORT("NYI with RI_FLAVOR MO") + END IF + + CALL hfx_ri_update_forces(qs_env, x_data(1, 1)%ri_data, nspins, & + x_data(1, 1)%general_parameter%fraction, & + rho_ao=matrix_p, rho_ao_resp=mpa, & + use_virial=use_virial, resp_only=resp_only) + ELSE + CALL derivatives_four_center(qs_env, matrix_p, mpa, hfx_section, para_env, & + 1, use_virial, resp_only=resp_only) + END IF END IF IF (debug_forces) THEN fodeb(1:3) = force(1)%fock_4c(1:3, 1) - fodeb(1:3) diff --git a/src/rpa_axk.F b/src/rpa_axk.F index f8d8f61ff9..66b70ca4ce 100644 --- a/src/rpa_axk.F +++ b/src/rpa_axk.F @@ -36,9 +36,11 @@ MODULE rpa_axk dbcsr_copy, dbcsr_create, dbcsr_init_p, dbcsr_multiply, dbcsr_p_type, dbcsr_release, & dbcsr_set, dbcsr_trace, dbcsr_type, dbcsr_type_no_symmetry USE hfx_energy_potential, ONLY: integrate_four_center + USE hfx_ri, ONLY: hfx_ri_update_ks USE hfx_types, ONLY: hfx_create,& hfx_release,& hfx_type + USE input_cp2k_hfx, ONLY: ri_mo USE input_section_types, ONLY: section_vals_get,& section_vals_get_subs_vals,& section_vals_type @@ -52,6 +54,7 @@ MODULE rpa_axk USE qs_subsys_types, ONLY: qs_subsys_get,& qs_subsys_type USE rpa_communication, ONLY: gamma_fm_to_dbcsr + USE scf_control_types, ONLY: scf_control_type USE util, ONLY: get_limit #include "./base/base_uses.f90" @@ -434,9 +437,20 @@ CONTAINS rho_ao_2d(1:ns, 1:1) => rho_work_ao(1:ns) CALL dbcsr_set(mat_2d(1, 1)%matrix, 0.0_dp) - CALL integrate_four_center(qs_env, x_data, mat_2d, ehfx, rho_ao_2d, hfx_sections, & - para_env_sub, my_recalc_hfx_integrals, irep, .TRUE., & - ispin=1) + + IF (x_data(irep, 1)%do_hfx_ri) THEN + IF (x_data(irep, 1)%ri_data%flavor == ri_mo) THEN + CPABORT("NYI with RI_FLAVOR MO") + END IF + CALL hfx_ri_update_ks(qs_env, x_data(irep, 1)%ri_data, mat_2d, ehfx, & + rho_ao=rho_ao_2d, geometry_did_change=my_recalc_hfx_integrals, & + nspins=ns, hf_fraction=x_data(irep, 1)%general_parameter%fraction) + + ELSE + CALL integrate_four_center(qs_env, x_data, mat_2d, ehfx, rho_ao_2d, hfx_sections, & + para_env_sub, my_recalc_hfx_integrals, irep, .TRUE., & + ispin=1) + END IF END DO my_recalc_hfx_integrals = .FALSE. @@ -479,7 +493,7 @@ CONTAINS CHARACTER(LEN=*), PARAMETER :: routineN = 'hfx_create_subgroup' - INTEGER :: handle + INTEGER :: handle, nelectron_total LOGICAL :: do_hfx TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set TYPE(cell_type), POINTER :: my_cell @@ -487,15 +501,18 @@ CONTAINS TYPE(particle_type), DIMENSION(:), POINTER :: particle_set TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set TYPE(qs_subsys_type), POINTER :: subsys + TYPE(scf_control_type), POINTER :: scf_control TYPE(section_vals_type), POINTER :: input CALL timeset(routineN, handle) - NULLIFY (my_cell, atomic_kind_set, particle_set, dft_control, x_data, qs_kind_set) + NULLIFY (my_cell, atomic_kind_set, particle_set, dft_control, x_data, qs_kind_set, scf_control) CALL get_qs_env(qs_env, & subsys=subsys, & - input=input) + input=input, & + scf_control=scf_control, & + nelectron_total=nelectron_total) CALL qs_subsys_get(subsys, & cell=my_cell, & @@ -512,7 +529,8 @@ CONTAINS IF (do_hfx) THEN ! Retrieve particle_set and atomic_kind_set CALL hfx_create(x_data, para_env_sub, hfx_section, atomic_kind_set, & - qs_kind_set, particle_set, dft_control, my_cell, do_exx=.TRUE.) + qs_kind_set, particle_set, dft_control, my_cell, do_exx=.TRUE., & + do_ot=scf_control%use_ot, nelectron_total=nelectron_total) END IF CALL timestop(handle) diff --git a/src/rpa_gw_sigma.F b/src/rpa_gw_sigma.F index 1569e27f47..992685cd97 100644 --- a/src/rpa_gw_sigma.F +++ b/src/rpa_gw_sigma.F @@ -40,11 +40,13 @@ MODULE rpa_gw_sigma dbcsr_p_type, dbcsr_release, dbcsr_release_p, dbcsr_set, dbcsr_type, & dbcsr_type_antisymmetric, dbcsr_type_symmetric USE hfx_energy_potential, ONLY: integrate_four_center + USE hfx_ri, ONLY: hfx_ri_update_ks USE input_constants, ONLY: do_admm_basis_projection,& do_admm_purify_none,& gw_print_exx,& gw_read_exx,& xc_none + USE input_cp2k_hfx, ONLY: ri_mo USE input_section_types, ONLY: section_vals_get,& section_vals_get_subs_vals,& section_vals_type,& @@ -125,7 +127,8 @@ CONTAINS TYPE(admm_type), POINTER :: admm_env TYPE(cp_fm_type), POINTER :: mo_coeff TYPE(cp_para_env_type), POINTER :: para_env - TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks, matrix_ks_aux_fit, rho_ao + TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_ks, matrix_ks_aux_fit, & + matrix_ks_aux_fit_hfx, rho_ao TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: matrix_ks_2d, matrix_ks_kp_im, & matrix_ks_kp_re, matrix_ks_transl, matrix_sigma_x_minus_vxc, matrix_sigma_x_minus_vxc_im, & rho_ao_2d @@ -141,7 +144,7 @@ CONTAINS NULLIFY (admm_env, matrix_ks, matrix_ks_aux_fit, rho_ao, matrix_sigma_x_minus_vxc, input, & xc_section, xc_section_admm_aux, xc_section_admm_prim, hfx_sections, rho, & - dft_control, para_env, ks_env, mo_coeff, matrix_sigma_x_minus_vxc_im) + dft_control, para_env, ks_env, mo_coeff, matrix_sigma_x_minus_vxc_im, matrix_ks_aux_fit_hfx) CALL timeset(routineN, handle) @@ -167,7 +170,8 @@ CONTAINS dft_control=dft_control, & para_env=para_env, & ks_env=ks_env, & - energy=energy) + energy=energy, & + matrix_ks_aux_fit_hfx=matrix_ks_aux_fit_hfx) ! RPA/GW with ADMM for EXX or the exchange self-energy only implemented for ! ADMM_PURIFICATION_METHOD NONE @@ -430,11 +434,28 @@ CONTAINS matrix_ks_2d(1:ns, 1:1) => matrix_ks(1:ns) END IF - CALL integrate_four_center(qs_env, qs_env%mp2_env%ri_rpa%x_data, matrix_ks_2d, eh1, & - rho_ao_2d, hfx_sections, & - para_env, .TRUE., irep, .TRUE., & - ispin=1) - ehfx = ehfx + eh1 + IF (qs_env%mp2_env%ri_rpa%x_data(irep, 1)%do_hfx_ri) THEN + IF (qs_env%mp2_env%ri_rpa%x_data(irep, 1)%ri_data%flavor == ri_mo) THEN + CPABORT("NYI with RI_FLAVOR MO") + END IF + CALL hfx_ri_update_ks(qs_env, qs_env%mp2_env%ri_rpa%x_data(irep, 1)%ri_data, matrix_ks_2d, ehfx, & + rho_ao=rho_ao_2d, geometry_did_change=.TRUE., nspins=nspins, & + hf_fraction=qs_env%mp2_env%ri_rpa%x_data(irep, 1)%general_parameter%fraction) + + IF (do_admm_rpa) THEN + !for ADMMS, we need the exchange matrix k(d) for both spins + DO ispin = 1, nspins + CALL dbcsr_copy(matrix_ks_aux_fit_hfx(ispin)%matrix, matrix_ks_2d(ispin, 1)%matrix, & + name="HF exch. part of matrix_ks_aux_fit for ADMMS") + END DO + END IF + ELSE + CALL integrate_four_center(qs_env, qs_env%mp2_env%ri_rpa%x_data, matrix_ks_2d, eh1, & + rho_ao_2d, hfx_sections, & + para_env, .TRUE., irep, .TRUE., & + ispin=1) + ehfx = ehfx + eh1 + END IF END DO END IF energy_ex = ehfx diff --git a/src/rpa_hfx.F b/src/rpa_hfx.F index 24c0e479e6..32e62ae1f8 100644 --- a/src/rpa_hfx.F +++ b/src/rpa_hfx.F @@ -16,6 +16,8 @@ MODULE rpa_hfx USE dbcsr_api, ONLY: dbcsr_p_type,& dbcsr_set USE hfx_energy_potential, ONLY: integrate_four_center + USE hfx_ri, ONLY: hfx_ri_update_ks + USE input_cp2k_hfx, ONLY: ri_mo USE input_section_types, ONLY: section_vals_get,& section_vals_get_subs_vals,& section_vals_type @@ -133,11 +135,22 @@ CONTAINS ELSE matrix_ks_2d(1:ns, 1:1) => matrix_ks(1:ns) END IF - CALL integrate_four_center(qs_env, qs_env%mp2_env%ri_rpa%x_data, matrix_ks_2d, eh1, & - rho_ao_2d, hfx_sections, & - para_env, .TRUE., irep, .TRUE., & - ispin=1) - ehfx = ehfx + eh1 + + IF (qs_env%mp2_env%ri_rpa%x_data(irep, 1)%do_hfx_ri) THEN + IF (qs_env%mp2_env%ri_rpa%x_data(irep, 1)%ri_data%flavor == ri_mo) THEN + CPABORT("NYI with RI_FLAVOR MO") + END IF + CALL hfx_ri_update_ks(qs_env, qs_env%mp2_env%ri_rpa%x_data(irep, 1)%ri_data, matrix_ks_2d, ehfx, & + rho_ao=rho_ao_2d, geometry_did_change=.TRUE., nspins=ns, & + hf_fraction=qs_env%mp2_env%ri_rpa%x_data(irep, 1)%general_parameter%fraction) + ELSE + + CALL integrate_four_center(qs_env, qs_env%mp2_env%ri_rpa%x_data, matrix_ks_2d, eh1, & + rho_ao_2d, hfx_sections, & + para_env, .TRUE., irep, .TRUE., & + ispin=1) + ehfx = ehfx + eh1 + END IF END DO ! include the EXX contribution to the total energy diff --git a/src/rpa_rse.F b/src/rpa_rse.F index 003f44dab5..c06322aa5f 100644 --- a/src/rpa_rse.F +++ b/src/rpa_rse.F @@ -39,9 +39,12 @@ MODULE rpa_rse dbcsr_init_p,& dbcsr_p_type,& dbcsr_release,& + dbcsr_scale,& dbcsr_set,& dbcsr_type_symmetric USE hfx_energy_potential, ONLY: integrate_four_center + USE hfx_ri, ONLY: hfx_ri_update_ks + USE input_cp2k_hfx, ONLY: ri_mo USE input_section_types, ONLY: section_vals_get,& section_vals_get_subs_vals,& section_vals_type,& @@ -353,15 +356,34 @@ CONTAINS CALL dbcsr_set(mat_mu_nu(1)%matrix, 0.0_dp) - DO irep = 1, n_rep_hf - rho_ao_2d(1:ns, 1:1) => P_mu_nu(1:ns) - mat_2d(1:ns, 1:1) => mat_mu_nu(1:ns) - CALL integrate_four_center(qs_env, qs_env%mp2_env%ri_rpa%x_data, mat_2d, ehfx, rho_ao_2d, hfx_sections, & - para_env, my_recalc_hfx_integrals, irep, .TRUE., & - ispin=1) + IF (qs_env%mp2_env%ri_rpa%x_data(1, 1)%do_hfx_ri) THEN + IF (qs_env%mp2_env%ri_rpa%x_data(1, 1)%ri_data%flavor == ri_mo) THEN + CPABORT("NYI with RI_FLAVOR MO") + END IF - my_recalc_hfx_integrals = .FALSE. - END DO + DO irep = 1, n_rep_hf + rho_ao_2d(1:ns, 1:1) => P_mu_nu(1:ns) + mat_2d(1:ns, 1:1) => mat_mu_nu(1:ns) + CALL hfx_ri_update_ks(qs_env, qs_env%mp2_env%ri_rpa%x_data(irep, 1)%ri_data, mat_2d, ehfx, & + rho_ao=rho_ao_2d, geometry_did_change=my_recalc_hfx_integrals, nspins=1, & + hf_fraction=qs_env%mp2_env%ri_rpa%x_data(irep, 1)%general_parameter%fraction) + + IF (ns == 2) CALL dbcsr_scale(mat_mu_nu(1)%matrix, 2.0_dp) + my_recalc_hfx_integrals = .FALSE. + END DO + + ELSE + + DO irep = 1, n_rep_hf + rho_ao_2d(1:ns, 1:1) => P_mu_nu(1:ns) + mat_2d(1:ns, 1:1) => mat_mu_nu(1:ns) + CALL integrate_four_center(qs_env, qs_env%mp2_env%ri_rpa%x_data, mat_2d, ehfx, rho_ao_2d, hfx_sections, & + para_env, my_recalc_hfx_integrals, irep, .TRUE., & + ispin=1) + + my_recalc_hfx_integrals = .FALSE. + END DO + END IF ! copy back to fm CALL cp_fm_set_all(fm_X_ao, 0.0_dp) diff --git a/src/xc_adiabatic_utils.F b/src/xc_adiabatic_utils.F index 0a3be38694..0ed8b83666 100644 --- a/src/xc_adiabatic_utils.F +++ b/src/xc_adiabatic_utils.F @@ -20,6 +20,7 @@ MODULE xc_adiabatic_utils USE dbcsr_api, ONLY: dbcsr_p_type USE hfx_communication, ONLY: scale_and_add_fock_to_ks_matrix USE hfx_derivatives, ONLY: derivatives_four_center + USE hfx_types, ONLY: hfx_type USE input_constants, ONLY: do_adiabatic_hybrid_mcy3,& do_adiabatic_model_pade USE input_section_types, ONLY: section_vals_get,& @@ -88,6 +89,7 @@ CONTAINS TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: rho_ao_resp TYPE(dbcsr_p_type), DIMENSION(:, :), POINTER :: rho_ao TYPE(dft_control_type), POINTER :: dft_control + TYPE(hfx_type), DIMENSION(:, :), POINTER :: x_data TYPE(qs_ks_env_type), POINTER :: ks_env TYPE(qs_rho_type), POINTER :: rho_xc TYPE(section_vals_type), POINTER :: adiabatic_rescaling_section, & @@ -95,15 +97,17 @@ CONTAINS CALL timeset(routineN, handle) NULLIFY (para_env, dft_control, adiabatic_rescaling_section, hfx_sections, & - input, xc_section, rho_xc, ks_env, rho_ao, rho_ao_resp) + input, xc_section, rho_xc, ks_env, rho_ao, rho_ao_resp, x_data) CALL get_qs_env(qs_env, & dft_control=dft_control, & para_env=para_env, & input=input, & rho_xc=rho_xc, & - ks_env=ks_env) + ks_env=ks_env, & + x_data=x_data) + IF (x_data(1, 1)%do_hfx_ri) CPABORT("RI-HFX not compatible with this kinf of functionals") nimages = dft_control%nimages CPASSERT(nimages == 1) diff --git a/tests/QS/regtest-hfx-ri-2/CH-hfx-ri-mo.inp b/tests/QS/regtest-hfx-ri-2/CH-hfx-ri-mo.inp new file mode 100644 index 0000000000..75ab350f90 --- /dev/null +++ b/tests/QS/regtest-hfx-ri-2/CH-hfx-ri-mo.inp @@ -0,0 +1,61 @@ +&FORCE_EVAL + METHOD Quickstep + &DFT + BASIS_SET_FILE_NAME EMSL_BASIS_SETS + POTENTIAL_FILE_NAME POTENTIAL + AUTO_BASIS RI_HFX SMALL + LSD + &MGRID + CUTOFF 300 + REL_CUTOFF 50 + &END MGRID + &QS + METHOD GAPW + &END QS + &SCF + SCF_GUESS ATOMIC + MAX_SCF 20 + EPS_SCF 1.0E-07 + &OT + PRECONDITIONER FULL_ALL + &END + &END SCF + &XC + &XC_FUNCTIONAL NONE + &END XC_FUNCTIONAL + &HF + &RI + RI_FLAVOR MO + &END + &END + &END XC + &END DFT + &SUBSYS + &CELL + ABC 5.0 5.0 5.0 + PERIODIC NONE + &END CELL + &COORD + C 0.000000 0.000000 0.2581 + H 0.000000 0.000000 -0.9487 + &END COORD + &KIND C + BASIS_SET 6-31Gx + POTENTIAL ALL + &END KIND + &KIND H + BASIS_SET 6-31Gx + POTENTIAL ALL + &END KIND + &END SUBSYS +&END FORCE_EVAL +&GLOBAL + PROJECT CH-hfx-ri-mo + RUN_TYPE GEO_OPT + PRINT_LEVEL MEDIUM +&END GLOBAL +&MOTION + &GEO_OPT + MAX_ITER 1 + &END +&END MOTION diff --git a/tests/QS/regtest-hfx-ri-2/CH-hfx-ri-rho.inp b/tests/QS/regtest-hfx-ri-2/CH-hfx-ri-rho.inp new file mode 100644 index 0000000000..e0327694a3 --- /dev/null +++ b/tests/QS/regtest-hfx-ri-2/CH-hfx-ri-rho.inp @@ -0,0 +1,58 @@ +&FORCE_EVAL + METHOD Quickstep + &DFT + BASIS_SET_FILE_NAME EMSL_BASIS_SETS + POTENTIAL_FILE_NAME POTENTIAL + AUTO_BASIS RI_HFX SMALL + LSD + &MGRID + CUTOFF 300 + REL_CUTOFF 50 + &END MGRID + &QS + METHOD GAPW + &END QS + &SCF + SCF_GUESS ATOMIC + MAX_SCF 20 + EPS_SCF 1.0E-08 + &END SCF + &XC + &XC_FUNCTIONAL NONE + &END XC_FUNCTIONAL + &HF + &RI + RI_FLAVOR RHO + &END + &END + &END XC + &END DFT + &SUBSYS + &CELL + ABC 5.0 5.0 5.0 + PERIODIC NONE + &END CELL + &COORD + C 0.000000 0.000000 0.2581 + H 0.000000 0.000000 -0.9487 + &END COORD + &KIND C + BASIS_SET 6-31Gx + POTENTIAL ALL + &END KIND + &KIND H + BASIS_SET 6-31Gx + POTENTIAL ALL + &END KIND + &END SUBSYS +&END FORCE_EVAL +&GLOBAL + PROJECT CH-hfx-ri-rho + RUN_TYPE GEO_OPT + PRINT_LEVEL MEDIUM +&END GLOBAL +&MOTION + &GEO_OPT + MAX_ITER 1 + &END +&END MOTION diff --git a/tests/QS/regtest-hfx-ri-2/CH3-b3lyp-ADMM.inp b/tests/QS/regtest-hfx-ri-2/CH3-b3lyp-ADMM.inp new file mode 100644 index 0000000000..95087e921b --- /dev/null +++ b/tests/QS/regtest-hfx-ri-2/CH3-b3lyp-ADMM.inp @@ -0,0 +1,75 @@ +&FORCE_EVAL + METHOD Quickstep + &DFT + BASIS_SET_FILE_NAME BASIS_MOLOPT + BASIS_SET_FILE_NAME BASIS_ADMM + POTENTIAL_FILE_NAME POTENTIAL_UZH + AUTO_BASIS RI_HFX SMALL + LSD + &MGRID + CUTOFF 200 + REL_CUTOFF 30 + &END MGRID + &QS + METHOD GPW + &END QS + &AUXILIARY_DENSITY_MATRIX_METHOD + &END + &POISSON + PERIODIC NONE + PSOLVER MT + &END + &SCF + EPS_SCF 1.0E-6 + SCF_GUESS ATOMIC + MAX_SCF 5 + &OT + PRECONDITIONER FULL_ALL + &END + &END SCF + &XC + &XC_FUNCTIONAL + &LIBXC + FUNCTIONAL HYB_GGA_XC_B3LYP + &END + &END XC_FUNCTIONAL + &HF + FRACTION 0.2 + &RI + &END + &END + &END XC + &END DFT + &SUBSYS + &CELL + ABC 8.0 8.0 8.0 + PERIODIC NONE + &END CELL + &COORD + C 0.0000 0.0000 0.5000 + H 0.0000 1.0728 0.0000 + H 0.9291 -0.5364 0.0000 + H -0.9291 -0.5364 0.0000 + &END COORD + &KIND H + BASIS_SET DZVP-MOLOPT-GTH + BASIS_SET AUX_FIT FIT3 + POTENTIAL GTH-HYB-q1 + &END KIND + &KIND C + BASIS_SET DZVP-MOLOPT-GTH + BASIS_SET AUX_FIT FIT3 + POTENTIAL GTH-HYB-q4 + &END KIND + &END SUBSYS +&END FORCE_EVAL +&GLOBAL + PROJECT CH3-b3lyp-ADMM + PRINT_LEVEL MEDIUM + RUN_TYPE GEO_OPT +&END GLOBAL +&MOTION + &GEO_OPT + MAX_ITER 1 + &END GEO_OPT +&END MOTION diff --git a/tests/QS/regtest-hfx-ri-2/H2O-hfx-stress-identity.inp b/tests/QS/regtest-hfx-ri-2/H2O-hfx-stress-identity.inp new file mode 100644 index 0000000000..c9f89fe886 --- /dev/null +++ b/tests/QS/regtest-hfx-ri-2/H2O-hfx-stress-identity.inp @@ -0,0 +1,59 @@ +&FORCE_EVAL + METHOD Quickstep + STRESS_TENSOR ANALYTICAL + &PRINT + &STRESS_TENSOR + &END + &END + &DFT + BASIS_SET_FILE_NAME EMSL_BASIS_SETS + POTENTIAL_FILE_NAME POTENTIAL + AUTO_BASIS RI_HFX SMALL + &MGRID + CUTOFF 300 + REL_CUTOFF 50 + &END MGRID + &QS + METHOD GAPW + &END QS + &SCF + SCF_GUESS ATOMIC + MAX_SCF 20 + EPS_SCF 1.0E-07 + &END SCF + &XC + &XC_FUNCTIONAL NONE + &END XC_FUNCTIONAL + &HF + &RI + &END + &INTERACTION_POTENTIAL + POTENTIAL_TYPE IDENTITY + &END + &END + &END XC + &END DFT + &SUBSYS + &CELL + ABC 6.0 6.0 6.0 + &END CELL + &COORD + O 0.000000 0.000000 -0.065587 + H 0.000000 -0.757136 0.520545 + H 0.000000 0.757136 0.520545 + &END COORD + &KIND O + BASIS_SET Ahlrichs-def2-SVP + POTENTIAL ALL + &END KIND + &KIND H + BASIS_SET Ahlrichs-def2-SVP + POTENTIAL ALL + &END KIND + &END SUBSYS +&END FORCE_EVAL +&GLOBAL + PROJECT H2O-hfx-stress-identity + RUN_TYPE ENERGY_FORCE + PRINT_LEVEL MEDIUM +&END GLOBAL diff --git a/tests/QS/regtest-hfx-ri-2/H2O-pbe0-stress-truncated.inp b/tests/QS/regtest-hfx-ri-2/H2O-pbe0-stress-truncated.inp new file mode 100644 index 0000000000..dc25d63ff7 --- /dev/null +++ b/tests/QS/regtest-hfx-ri-2/H2O-pbe0-stress-truncated.inp @@ -0,0 +1,65 @@ +&FORCE_EVAL + METHOD Quickstep + STRESS_TENSOR ANALYTICAL + &PRINT + &STRESS_TENSOR + &END + &END + &DFT + BASIS_SET_FILE_NAME BASIS_MOLOPT + POTENTIAL_FILE_NAME POTENTIAL_UZH + AUTO_BASIS RI_HFX SMALL + &MGRID + CUTOFF 200 + REL_CUTOFF 30 + &END MGRID + &QS + METHOD GPW + &END QS + &SCF + SCF_GUESS ATOMIC + MAX_SCF 20 + EPS_SCF 1.0E-07 + &END SCF + &XC + &XC_FUNCTIONAL PBE + &PBE + SCALE_C 1.0 + SCALE_X 0.75 + &END + &END XC_FUNCTIONAL + &HF + FRACTION 0.25 + &RI + &END + &INTERACTION_POTENTIAL + POTENTIAL_TYPE TRUNCATED + CUTOFF_RADIUS 2.0 + &END + &END + &END XC + &END DFT + &SUBSYS + &CELL + ABC 6.0 6.0 6.0 + &END CELL + &COORD + O 0.000000 0.000000 -0.065587 + H 0.000000 -0.757136 0.520545 + H 0.000000 0.757136 0.520545 + &END COORD + &KIND O + BASIS_SET SZV-MOLOPT-GTH + POTENTIAL GTH-PBE0-q6 + &END KIND + &KIND H + BASIS_SET SZV-MOLOPT-GTH + POTENTIAL GTH-PBE0-q1 + &END KIND + &END SUBSYS +&END FORCE_EVAL +&GLOBAL + PROJECT H2O-pbe0-stress-truncated + RUN_TYPE ENERGY_FORCE + PRINT_LEVEL MEDIUM +&END GLOBAL diff --git a/tests/QS/regtest-hfx-ri-2/Ne-hfx-pbc-metric-mo.inp b/tests/QS/regtest-hfx-ri-2/Ne-hfx-pbc-metric-mo.inp new file mode 100644 index 0000000000..bf026e37fe --- /dev/null +++ b/tests/QS/regtest-hfx-ri-2/Ne-hfx-pbc-metric-mo.inp @@ -0,0 +1,63 @@ +&FORCE_EVAL + METHOD Quickstep + &DFT + BASIS_SET_FILE_NAME EMSL_BASIS_SETS + POTENTIAL_FILE_NAME POTENTIAL + AUTO_BASIS RI_HFX SMALL + &MGRID + CUTOFF 300 + REL_CUTOFF 50 + &END MGRID + &QS + METHOD GAPW + &END QS + &SCF + EPS_SCF 1.0E-7 + SCF_GUESS ATOMIC + MAX_SCF 5 + &OT ON + PRECONDITIONER FULL_ALL + &END + &END SCF + &XC + &XC_FUNCTIONAL NONE + &END XC_FUNCTIONAL + &HF + &RI + RI_FLAVOR MO + RI_METRIC IDENTITY + &END + &INTERACTION_POTENTIAL + POTENTIAL_TYPE SHORTRANGE + OMEGA 0.11 + &END + &END + &END XC + &END DFT + &SUBSYS + &CELL + ABC 5.0 5.0 10.0 + &END CELL + &COORD + Ne 0.000000 0.000000 0.000000 + Ne 0.000000 0.000000 2.800000 + Ne 0.000000 0.000000 4.000000 + Ne 0.000000 0.000000 6.100000 + Ne 0.000000 0.000000 8.900000 + &END COORD + &KIND Ne + BASIS_SET 3-21Gx + POTENTIAL ALL + &END KIND + &END SUBSYS +&END FORCE_EVAL +&GLOBAL + PROJECT Ne-hfx-pbc-metric-mo + PRINT_LEVEL MEDIUM + RUN_TYPE MD +&END GLOBAL +&MOTION + &MD + MAX_STEPS 1 + &END +&END MOTION diff --git a/tests/QS/regtest-hfx-ri-2/Ne-hfx-pbc-metric-rho.inp b/tests/QS/regtest-hfx-ri-2/Ne-hfx-pbc-metric-rho.inp new file mode 100644 index 0000000000..14cfc8b9c8 --- /dev/null +++ b/tests/QS/regtest-hfx-ri-2/Ne-hfx-pbc-metric-rho.inp @@ -0,0 +1,63 @@ +&FORCE_EVAL + METHOD Quickstep + &DFT + BASIS_SET_FILE_NAME EMSL_BASIS_SETS + POTENTIAL_FILE_NAME POTENTIAL + AUTO_BASIS RI_HFX SMALL + &MGRID + CUTOFF 300 + REL_CUTOFF 50 + &END MGRID + &QS + METHOD GAPW + &END QS + &SCF + EPS_SCF 1.0E-7 + SCF_GUESS ATOMIC + MAX_SCF 5 + &OT ON + PRECONDITIONER FULL_ALL + &END + &END SCF + &XC + &XC_FUNCTIONAL NONE + &END XC_FUNCTIONAL + &HF + &RI + RI_FLAVOR RHO + RI_METRIC IDENTITY + &END + &INTERACTION_POTENTIAL + POTENTIAL_TYPE TRUNCATED + CUTOFF_RADIUS 2.0 + &END + &END + &END XC + &END DFT + &SUBSYS + &CELL + ABC 5.0 5.0 10.0 + &END CELL + &COORD + Ne 0.000000 0.000000 0.000000 + Ne 0.000000 0.000000 2.800000 + Ne 0.000000 0.000000 4.000000 + Ne 0.000000 0.000000 6.100000 + Ne 0.000000 0.000000 8.900000 + &END COORD + &KIND Ne + BASIS_SET 3-21Gx + POTENTIAL ALL + &END KIND + &END SUBSYS +&END FORCE_EVAL +&GLOBAL + PROJECT Ne-hfx-pbc-metric-rho + PRINT_LEVEL MEDIUM + RUN_TYPE MD +&END GLOBAL +&MOTION + &MD + MAX_STEPS 1 + &END +&END MOTION diff --git a/tests/QS/regtest-hfx-ri-2/TEST_FILES b/tests/QS/regtest-hfx-ri-2/TEST_FILES new file mode 100644 index 0000000000..1982a121c8 --- /dev/null +++ b/tests/QS/regtest-hfx-ri-2/TEST_FILES @@ -0,0 +1,9 @@ +#Testing the forces: +CH-hfx-ri-rho.inp 11 1.0E-8 -38.259646458859827 +CH-hfx-ri-mo.inp 11 1.0E-9 -38.262303893579102 +Ne-hfx-pbc-metric-rho.inp 11 1.0E-9 -633.525916555354343 +Ne-hfx-pbc-metric-mo.inp 11 1.0E-9 -632.285120513072002 +CH3-b3lyp-ADMM.inp 11 1.0E-9 -7.413742783916254 +H2O-pbe0-stress-truncated.inp 31 1.0E-9 2.01366131588E-01 +H2O-hfx-stress-identity.inp 31 1.0E-9 6.44733085054E-02 +#EOF diff --git a/tests/QS/regtest-hfx-ri/CH3-ADMM.inp b/tests/QS/regtest-hfx-ri/CH3-ADMM.inp index ca6b893190..49042e4de4 100644 --- a/tests/QS/regtest-hfx-ri/CH3-ADMM.inp +++ b/tests/QS/regtest-hfx-ri/CH3-ADMM.inp @@ -78,7 +78,7 @@ &END SUBSYS &END FORCE_EVAL &GLOBAL - PROJECT CH3-BP-MO_DIAG + PROJECT CH3-ADMM PRINT_LEVEL MEDIUM RUN_TYPE ENERGY &TIMINGS diff --git a/tests/QS/regtest-hfx-ri/CH3-hfx-converged.inp b/tests/QS/regtest-hfx-ri/CH3-hfx-converged.inp index 361d284a58..94be10cdda 100644 --- a/tests/QS/regtest-hfx-ri/CH3-hfx-converged.inp +++ b/tests/QS/regtest-hfx-ri/CH3-hfx-converged.inp @@ -61,7 +61,7 @@ &END SUBSYS &END FORCE_EVAL &GLOBAL - PROJECT CH3-TZV2P-converged + PROJECT CH3-hfx-converged PRINT_LEVEL MEDIUM RUN_TYPE ENERGY &END GLOBAL diff --git a/tests/QS/regtest-hfx-ri/H2O-hfx-periodic-ri-truncated.inp b/tests/QS/regtest-hfx-ri/H2O-hfx-periodic-ri-truncated.inp index 61808ac9cc..f5e79ac9f6 100644 --- a/tests/QS/regtest-hfx-ri/H2O-hfx-periodic-ri-truncated.inp +++ b/tests/QS/regtest-hfx-ri/H2O-hfx-periodic-ri-truncated.inp @@ -65,7 +65,7 @@ &END SUBSYS &END FORCE_EVAL &GLOBAL - PROJECT H2O-ri-trunc + PROJECT H2O-hfx-periodic-ri-truncated PRINT_LEVEL MEDIUM RUN_TYPE ENERGY &END GLOBAL diff --git a/tests/QS/regtest-hfx-ri/Ne-hybrid-periodic-shortrange.inp b/tests/QS/regtest-hfx-ri/Ne-hybrid-periodic-shortrange.inp index 0c07ce1dc4..658105cc28 100644 --- a/tests/QS/regtest-hfx-ri/Ne-hybrid-periodic-shortrange.inp +++ b/tests/QS/regtest-hfx-ri/Ne-hybrid-periodic-shortrange.inp @@ -69,7 +69,7 @@ &END SUBSYS &END FORCE_EVAL &GLOBAL - PROJECT NE-hybrid-HSE06-lda + PROJECT Ne-hybrid-periodic-shortrange PRINT_LEVEL MEDIUM RUN_TYPE ENERGY &END GLOBAL diff --git a/tests/QS/regtest-mp2-grad/H2O_grad_ri-hfx.inp b/tests/QS/regtest-mp2-grad/H2O_grad_ri-hfx.inp new file mode 100644 index 0000000000..0f89e998e5 --- /dev/null +++ b/tests/QS/regtest-mp2-grad/H2O_grad_ri-hfx.inp @@ -0,0 +1,103 @@ +&GLOBAL + PROJECT GRAD_H2O_gpw + PRINT_LEVEL LOW + RUN_TYPE GEO_OPT + &TIMINGS + THRESHOLD 0.001 + &END +&END GLOBAL +&MOTION + &GEO_OPT + MAX_ITER 1 + &END +&END MOTION +&FORCE_EVAL + METHOD Quickstep + &DFT + BASIS_SET_FILE_NAME GTH_BASIS_SETS + BASIS_SET_FILE_NAME HFX_BASIS + POTENTIAL_FILE_NAME POTENTIAL + &MGRID + CUTOFF 150 + REL_CUTOFF 30 + &END MGRID + &QS + METHOD GPW + EPS_DEFAULT 1.0E-12 + &END QS + &SCF + SCF_GUESS ATOMIC + EPS_SCF 1.0E-6 + MAX_SCF 100 + &END SCF + &XC + &XC_FUNCTIONAL NONE + &END XC_FUNCTIONAL + &HF + FRACTION 1.0000000 + &SCREENING + SCREEN_ON_INITIAL_P .FALSE. + EPS_SCHWARZ 1.0E-9 + EPS_SCHWARZ_FORCES 1.0E-9 + &END SCREENING + &INTERACTION_POTENTIAL + POTENTIAL_TYPE TRUNCATED + CUTOFF_RADIUS 2.0 + T_C_G_DATA t_c_g.dat + &END + &RI + &END RI + &END HF + &WF_CORRELATION + &RI_MP2 + BLOCK_SIZE 1 + EPS_CANONICAL 0.0001 + FREE_HFX_BUFFER .TRUE. + &CPHF + EPS_CONV 1.0E-4 + MAX_ITER 10 + &END + &END + &INTEGRALS + &WFC_GPW + CUTOFF 100 + REL_CUTOFF 30 + EPS_FILTER 1.0E-6 + EPS_GRID 1.0E-6 + &END WFC_GPW + ERI_METHOD MME + &END INTEGRALS + MEMORY 1.00 + NUMBER_PROC 1 + &END + &END XC + &END DFT + &PRINT + &FORCES + &END + &END + &SUBSYS + &CELL + ABC [angstrom] 5.0 5.0 5.0 + &END CELL + &KIND H + BASIS_SET SZV-GTH + BASIS_SET RI_AUX RI_DZVP-GTH + POTENTIAL GTH-HF-q1 + &END KIND + &KIND O + BASIS_SET SZV-GTH + BASIS_SET RI_AUX RI_DZVP-GTH + POTENTIAL GTH-HF-q6 + &END KIND + &COORD + O 0.000000 0.000000 -0.211000 + H 0.000000 -0.844000 0.495000 + H 0.000000 0.744000 0.495000 + &END + &TOPOLOGY + &CENTER_COORDINATES + &END + &END TOPOLOGY + &END SUBSYS +&END FORCE_EVAL diff --git a/tests/QS/regtest-mp2-grad/O2_dyn_ri-hfx.inp b/tests/QS/regtest-mp2-grad/O2_dyn_ri-hfx.inp new file mode 100644 index 0000000000..b59e2b4c88 --- /dev/null +++ b/tests/QS/regtest-mp2-grad/O2_dyn_ri-hfx.inp @@ -0,0 +1,94 @@ +&GLOBAL + PROJECT O2_dyn_ri-hfx + PRINT_LEVEL LOW + &TIMINGS + THRESHOLD 0.01 + &END +&END GLOBAL +&MOTION + &MD + ENSEMBLE NVE + STEPS 1 + &END +&END MOTION +&FORCE_EVAL + METHOD Quickstep + &DFT + BASIS_SET_FILE_NAME HFX_BASIS + POTENTIAL_FILE_NAME POTENTIAL + &MGRID + CUTOFF 100 + REL_CUTOFF 20 + &END MGRID + &QS + METHOD GPW + EPS_DEFAULT 1.0E-10 + EPS_PGF_ORB 1.0E-20 + &END QS + &SCF + SCF_GUESS ATOMIC + EPS_SCF 1.0E-5 + MAX_SCF 100 + &END SCF + &XC + &XC_FUNCTIONAL NONE + &END XC_FUNCTIONAL + &HF + FRACTION 1.0000000 + &SCREENING + EPS_SCHWARZ 1.0E-6 + SCREEN_ON_INITIAL_P FALSE + &END SCREENING + &INTERACTION_POTENTIAL + POTENTIAL_TYPE TRUNCATED + CUTOFF_RADIUS 1.5 + T_C_G_DATA t_c_g.dat + &END + &RI + &END + &END HF + &WF_CORRELATION + &RI_MP2 + BLOCK_SIZE 1 + EPS_CANONICAL 0.0001 + FREE_HFX_BUFFER .TRUE. + &END RI_MP2 + &INTEGRALS + &WFC_GPW + CUTOFF 50 + REL_CUTOFF 25 + EPS_FILTER 1.0E-5 + EPS_GRID 1.0E-4 + &END WFC_GPW + &END INTEGRALS + MEMORY 500.0 + NUMBER_PROC 1 + &END + &END XC + UKS + MULTIPLICITY 3 + &END DFT + &SUBSYS + &VELOCITY + 0.0 0.0 0.0 + 0.0 0.0 0.0 + &END VELOCITY + &CELL + ABC [angstrom] 6.000 6.000 6.000 + !PERIODIC NONE + &END CELL + &KIND O + BASIS_SET DZVP-GTH + BASIS_SET RI_AUX RI_DZVP-GTH + POTENTIAL GTH-HF-q6 + &END KIND + &COORD + O 4.0000000084 4.0000000084 4.6623718822 + O 3.9999999905 3.9999999905 3.3376281178 + &END + &TOPOLOGY + &CENTER_COORDINATES + &END + &END TOPOLOGY + &END SUBSYS +&END FORCE_EVAL diff --git a/tests/QS/regtest-mp2-grad/TEST_FILES b/tests/QS/regtest-mp2-grad/TEST_FILES index 70df708d63..d6d49210ff 100644 --- a/tests/QS/regtest-mp2-grad/TEST_FILES +++ b/tests/QS/regtest-mp2-grad/TEST_FILES @@ -7,4 +7,6 @@ CH_dyn_screen.inp 11 2e-04 MOM_MP2_geoopt.inp 11 2e-06 -13.969926262647746 H2O_MD_mme.inp 11 1e-10 -17.056807598425291 H2_MP2_debug.inp 11 1e-10 -1.146241031776471 +H2O_grad_ri-hfx.inp 11 1e-10 -16.763446635143474 +O2_dyn_ri-hfx.inp 11 1e-10 -31.518462685641584 #EOF diff --git a/tests/QS/regtest-rpa-cubic-scaling/Cubic_RPA_CH3_ri-hfx.inp b/tests/QS/regtest-rpa-cubic-scaling/Cubic_RPA_CH3_ri-hfx.inp new file mode 100644 index 0000000000..f7951f627f --- /dev/null +++ b/tests/QS/regtest-rpa-cubic-scaling/Cubic_RPA_CH3_ri-hfx.inp @@ -0,0 +1,85 @@ +&GLOBAL + PROJECT RI_RPA_H2O_minimax + PRINT_LEVEL MEDIUM + RUN_TYPE ENERGY + &TIMINGS + THRESHOLD 0.01 + &END +&END GLOBAL +&FORCE_EVAL + METHOD Quickstep + &DFT + BASIS_SET_FILE_NAME HFX_BASIS + SORT_BASIS EXP + POTENTIAL_FILE_NAME GTH_POTENTIALS + UKS + MULTIPLICITY 2 + &MGRID + CUTOFF 100 + REL_CUTOFF 20 + &END MGRID + &POISSON + PERIODIC NONE + POISSON_SOLVER MT + &END POISSON + &QS + METHOD GPW + EPS_DEFAULT 1.0E-15 + EPS_PGF_ORB 1.0E-30 + &END QS + &SCF + SCF_GUESS ATOMIC + EPS_SCF 1.0E-7 + MAX_SCF 100 + &PRINT + &RESTART OFF + &END + &END + &END SCF + &XC + &XC_FUNCTIONAL PBE + &END XC_FUNCTIONAL + &WF_CORRELATION + &LOW_SCALING + MEMORY_CUT 1 + &END + &RI_RPA + RPA_NUM_QUAD_POINTS 6 + &HF + FRACTION 1.0000000 + &SCREENING + EPS_SCHWARZ 1.0E-8 + SCREEN_ON_INITIAL_P FALSE + &END SCREENING + &RI + &END + &END HF + &END RI_RPA + MEMORY 200. + NUMBER_PROC 1 + &END + &END XC + &END DFT + &SUBSYS + &CELL + ABC [angstrom] 9.000 9.000 9.000 + PERIODIC NONE + &END CELL + &KIND H + BASIS_SET DZVP-GTH + BASIS_SET RI_AUX RI_DZVP-GTH + POTENTIAL GTH-PBE-q1 + &END KIND + &KIND C + BASIS_SET DZVP-GTH + BASIS_SET RI_AUX RI_DZVP-GTH + POTENTIAL GTH-PBE-q4 + &END KIND + &TOPOLOGY + COORD_FILE_NAME CH3.xyz + COORD_FILE_FORMAT xyz + &CENTER_COORDINATES + &END + &END TOPOLOGY + &END SUBSYS +&END FORCE_EVAL diff --git a/tests/QS/regtest-rpa-cubic-scaling/Cubic_RPA_H2O_ri-hfx.inp b/tests/QS/regtest-rpa-cubic-scaling/Cubic_RPA_H2O_ri-hfx.inp new file mode 100644 index 0000000000..4048049de0 --- /dev/null +++ b/tests/QS/regtest-rpa-cubic-scaling/Cubic_RPA_H2O_ri-hfx.inp @@ -0,0 +1,82 @@ +&GLOBAL + PROJECT RI_RPA_H2O_minimax + PRINT_LEVEL MEDIUM + RUN_TYPE ENERGY + &TIMINGS + THRESHOLD 0.01 + &END +&END GLOBAL +&FORCE_EVAL + METHOD Quickstep + &DFT + BASIS_SET_FILE_NAME HFX_BASIS + SORT_BASIS EXP + POTENTIAL_FILE_NAME GTH_POTENTIALS + &MGRID + CUTOFF 100 + REL_CUTOFF 20 + &END MGRID + &POISSON + PERIODIC NONE + POISSON_SOLVER WAVELET + &END POISSON + &QS + METHOD GPW + EPS_DEFAULT 1.0E-15 + EPS_PGF_ORB 1.0E-30 + &END QS + &SCF + SCF_GUESS ATOMIC + EPS_SCF 1.0E-7 + MAX_SCF 100 + &PRINT + &RESTART OFF + &END + &END + &END SCF + &XC + &XC_FUNCTIONAL PBE + &END XC_FUNCTIONAL + &WF_CORRELATION + &LOW_SCALING + &END + &RI_RPA + RPA_NUM_QUAD_POINTS 6 + &HF + FRACTION 1.0000000 + &SCREENING + EPS_SCHWARZ 1.0E-8 + SCREEN_ON_INITIAL_P FALSE + &END SCREENING + &RI + &END RI + &END HF + &END RI_RPA + MEMORY 200. + NUMBER_PROC 1 + &END + &END XC + &END DFT + &SUBSYS + &CELL + ABC [angstrom] 8.000 8.000 8.000 + PERIODIC NONE + &END CELL + &KIND H + BASIS_SET DZVP-GTH + BASIS_SET RI_AUX RI_DZVP-GTH + POTENTIAL GTH-PBE-q1 + &END KIND + &KIND O + BASIS_SET DZVP-GTH + BASIS_SET RI_AUX RI_DZVP-GTH + POTENTIAL GTH-PBE-q6 + &END KIND + &TOPOLOGY + COORD_FILE_NAME H2O_gas.xyz + COORD_FILE_FORMAT xyz + &CENTER_COORDINATES + &END + &END TOPOLOGY + &END SUBSYS +&END FORCE_EVAL diff --git a/tests/QS/regtest-rpa-cubic-scaling/TEST_FILES b/tests/QS/regtest-rpa-cubic-scaling/TEST_FILES index 0e0b1447a2..2186e0946c 100644 --- a/tests/QS/regtest-rpa-cubic-scaling/TEST_FILES +++ b/tests/QS/regtest-rpa-cubic-scaling/TEST_FILES @@ -6,4 +6,6 @@ Cubic_RPA_H2O_standard_svd.inp 11 1e-08 - RPA_kpoints_H2O.inp 11 1e-08 -17.384612021187685 RPA_kpoints_H2O_batched.inp 11 1e-08 -17.384612021187685 RPA_kpoints_from_Gamma_H2O.inp 11 1e-08 -17.384615079520682 +Cubic_RPA_CH3_ri-hfx.inp 11 1e-08 -7.414799528509679 +Cubic_RPA_H2O_ri-hfx.inp 11 1e-08 -17.159865017693086 #EOF diff --git a/tests/TEST_DIRS b/tests/TEST_DIRS index 9821ff0bfe..8ffc9a9308 100644 --- a/tests/TEST_DIRS +++ b/tests/TEST_DIRS @@ -15,6 +15,7 @@ QS/regtest-mp2-block libint parallel mpir QS/regtest-mp2-admm-grad libint QS/regtest-double-hybrid-stress libint QS/regtest-double-hybrid-grad libint +QS/regtest-hfx-ri-2 libint libxc QS/regtest-rma libint mpi3 mpiranks==4 LIBTEST/libvori libvori LIBTEST/libbqb libbqb