diff --git a/plugins/local/extra_basis_int/NEED b/plugins/local/extra_basis_int/NEED index 6214e5cd..0419f87f 100644 --- a/plugins/local/extra_basis_int/NEED +++ b/plugins/local/extra_basis_int/NEED @@ -1,3 +1,4 @@ ao_extra_basis ao_one_e_ints ao_two_e_ints +determinants diff --git a/plugins/local/extra_basis_int/coul_1s.irp.f b/plugins/local/extra_basis_int/coul_1s.irp.f index b6148293..964ed36a 100644 --- a/plugins/local/extra_basis_int/coul_1s.irp.f +++ b/plugins/local/extra_basis_int/coul_1s.irp.f @@ -1,9 +1,10 @@ -double precision function coul_full_pq_r_1s(p,q,R,R_p,R_q) +double precision function coul_full_ao_pq_r_1s(p,q,R,R_p,R_q) implicit none + include 'constants.include.F' BEGIN_DOC ! coul_full_pq_r_1s(p,q,r) = \int d^3r phi_p(r) phi_q(r) 1/(r-R) ! - ! where phi_q and phi_p are centered in R_q and R_p. + ! where phi_q and phi_p are centered in R_q and R_p. ! ! WARNING :: works only for purely 1s extra basis !! END_DOC @@ -18,6 +19,37 @@ double precision function coul_full_pq_r_1s(p,q,R,R_p,R_q) dist+= (P_pq(2)-R(2)) * (P_pq(2)-R(2)) dist+= (P_pq(3)-R(3)) * (P_pq(3)-R(3)) dist = dsqrt(dist) - coul_full_pq_r_1s = coefaos * coef * derf(sqrt_gamma_pq_ao_extra(q,p) * dist)/dist + if(dist.gt.1.d-10)then + coul_full_ao_pq_r_1s = coefaos * coef * derf(sqrt_gamma_pq_ao_extra(q,p) * dist)/dist + else + coul_full_ao_pq_r_1s = coefaos * coef * 2.d0 * sqrt_gamma_pq_ao_extra(q,p) * inv_sq_pi + endif + +end + +double precision function coul_pq_r_1s(p,q,R,R_p,R_q) + implicit none + include 'constants.include.F' + BEGIN_DOC + ! coul_full_pq_r_1s(p,q,r) = \int d^3r exp(-alpha_p (r-R_p)^2) exp(-alpha_q (r-R_q)^2) 1/|r-R| + ! + ! where alpha_p and alpha_q are the 1s extra basis + ! + ! WARNING :: works only for purely 1s extra basis !! + END_DOC + double precision, intent(in) :: R(3),R_p(3),R_q(3) + integer, intent(in) :: p,q + double precision :: dist,P_pq(3) + P_pq = ao_extra_expo(p,1) * R_p + ao_extra_expo(q,1) * R_q + P_pq = P_pq * inv_gamma_pq_ao_extra(q,p) + dist = (P_pq(1)-R(1)) * (P_pq(1)-R(1)) + dist+= (P_pq(2)-R(2)) * (P_pq(2)-R(2)) + dist+= (P_pq(3)-R(3)) * (P_pq(3)-R(3)) + dist = dsqrt(dist) + if(dist.gt.1.d-10)then + coul_pq_r_1s = derf(sqrt_gamma_pq_ao_extra(q,p) * dist)/dist + else + coul_pq_r_1s = 2.d0 * sqrt_gamma_pq_ao_extra(q,p) * inv_sq_pi + endif end diff --git a/plugins/local/extra_basis_int/extra_basis_int.irp.f b/plugins/local/extra_basis_int/extra_basis_int.irp.f index 4495c8ff..1d35b1c2 100644 --- a/plugins/local/extra_basis_int/extra_basis_int.irp.f +++ b/plugins/local/extra_basis_int/extra_basis_int.irp.f @@ -10,7 +10,9 @@ program extra_basis_int ! call routine_test_pot_ne_mixed ! call routine_pot_ne ! call routine_test_pot_ne_extra_mixed - call routine_test_coul_1s +! call routine_test_coul_1s + call print_v_ne_extra_basis + call print_v_ne_basis end @@ -128,7 +130,7 @@ subroutine routine_test_coul_1s implicit none integer :: i,j double precision :: r(3) ,mu_in,NAI_pol_mult_erf_ao_extra - double precision :: ref,new, accu,coul_full_pq_r_1s,v_nucl_extra_ao + double precision :: ref,new, accu,coul_full_ao_pq_r_1s,v_nucl_extra_ao r(1) = 0.d0 r(2) = 0.5d0 r(3) = -1.5d0 @@ -140,10 +142,50 @@ subroutine routine_test_coul_1s ! do i = 1, 1 ! do j = 1, 1 ref = NAI_pol_mult_erf_ao_extra(i, j, mu_in, r) - new = coul_full_pq_r_1s(i,j,r,ao_extra_center_1s(1,i),ao_extra_center_1s(1,j)) + new = coul_full_ao_pq_r_1s(i,j,r,ao_extra_center_1s(1,i),ao_extra_center_1s(1,j)) ! new = v_nucl_extra_ao(i,j) accu += dabs(new-ref) enddo enddo print*,'accu = ',accu end + +subroutine print_v_ne_extra_basis + implicit none + integer :: i_ao,j_ao,i + double precision :: integral, accu, charge, coord(3), coul_pq_r_1s + + accu = 0.d0 + do i_ao = 1, ao_extra_num + do j_ao = 1, ao_extra_num + do i = 1, nucl_num + charge = nucl_charge(i) + coord(1:3) = nucl_coord_transp(1:3,i) + integral = coul_pq_r_1s(i_ao,j_ao,coord,ao_extra_center_1s(1,i_ao),ao_extra_center_1s(1,j_ao)) + accu += -charge * integral * effective_ao_extra_dm(j_ao,i_ao) + enddo + enddo + enddo + print*,'accu = ',accu + +end + +subroutine print_v_ne_basis + implicit none + integer :: i_ao,j_ao,i + double precision :: integral, accu, charge, coord(3), coul_full_pq_r_1s,NAI_pol_mult_erf_ao + + accu = 0.d0 + do i_ao = 1, ao_num + do j_ao = 1, ao_num + do i = 1, nucl_num + charge = nucl_charge(i) + coord(1:3) = nucl_coord_transp(1:3,i) + integral = NAI_pol_mult_erf_ao(i_ao, j_ao, 1d+10, coord) + accu += -charge * integral * one_e_dm_ao(j_ao,i_ao) + enddo + enddo + enddo + print*,'accu = ',accu + +end diff --git a/src/ao_extra_basis/EZFIO.cfg b/src/ao_extra_basis/EZFIO.cfg index 8841c194..79b37bf0 100644 --- a/src/ao_extra_basis/EZFIO.cfg +++ b/src/ao_extra_basis/EZFIO.cfg @@ -94,7 +94,7 @@ interface: ezfio, provider [ao_extra_one_e_dm] type: double precision doc: reduced density matrix on the ao extra basis -size: (ao_extra_basis.ao_extra_num,ao_extra_basis.ao_extra_num) +size: (ao_extra_basis.ao_extra_num,ao_extra_basis.ao_extra_num,1) interface: ezfio, provider [ao_extra_center] diff --git a/src/ao_extra_basis/density_extra.irp.f b/src/ao_extra_basis/density_extra.irp.f index 5d6492e3..fa215466 100644 --- a/src/ao_extra_basis/density_extra.irp.f +++ b/src/ao_extra_basis/density_extra.irp.f @@ -14,7 +14,7 @@ BEGIN_PROVIDER [ double precision, effective_ao_extra_dm, (ao_extra_num, ao_extr integer :: i,j do i = 1, ao_extra_num do j = 1, ao_extra_num - effective_ao_extra_dm(j,i) = ao_extra_one_e_dm(j,i) * ao_extra_coef_normalized(j,1) * ao_extra_coef_normalized(i,1) & + effective_ao_extra_dm(j,i) = ao_extra_one_e_dm(j,i,1) * ao_extra_coef_normalized(j,1) * ao_extra_coef_normalized(i,1) & * inv_pi_gamma_pq_3_2_ao_extra(j,i) * E_pq_ao_extra(j,i) enddo enddo