ao_extra_one_e_dm works

plugins/local/extra_basis_int/NEED

@@ -1,3 +1,4 @@
 ao_extra_basis
 ao_one_e_ints
 ao_two_e_ints
+determinants

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

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

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]

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