added many files and did a lot of documentation for bi-ortho scf

src/ao_many_one_e_ints/NEED

@@ -0,0 +1,5 @@
+ao_one_e_ints
+ao_two_e_ints
+becke_numerical_grid
+mo_one_e_ints
+dft_utils_in_r

src/ao_many_one_e_ints/README.rst

@@ -0,0 +1,25 @@
+==================
+ao_many_one_e_ints
+==================
+
+This module contains A LOT of one-electron integrals of the type 
+A_ij( r ) = \int dr' phi_i(r') w(r,r') phi_j(r') 
+where r is a point in real space. 
+
++) ao_gaus_gauss.irp.f: w(r,r') is a exp(-(r-r')^2)  , and can be multiplied by x/y/z
++) ao_erf_gauss.irp.f : w(r,r') is a exp(-(r-r')^2) erf(mu * |r-r'|)/|r-r'| , and can be multiplied by x/y/z
++) ao_erf_gauss_grad.irp.f: w(r,r') is a exp(-(r-r')^2) erf(mu * |r-r'|)/|r-r'| , and can be multiplied by x/y/z, but evaluated with also one gradient of an AO function. 
+
+Fit of a Slater function and corresponding integrals
+----------------------------------------------------
+The file fit_slat_gauss.irp.f contains many useful providers/routines to fit a Slater function with 20 gaussian. 
++) coef_fit_slat_gauss : coefficients of the gaussians to fit e^(-x)
++) expo_fit_slat_gauss : exponents of the gaussians to fit e^(-x)
+
+Integrals involving Slater functions : stg_gauss_int.irp.f
+
+Taylor expansion of full correlation factor
+-------------------------------------------
+In taylor_exp.irp.f you might find interesting integrals of the type 
+\int dr' exp( e^{-alpha |r-r|' - beta |r-r'|^2}) phi_i(r') phi_j(r') 
+evaluated as a Taylor expansion of the exponential. 

src/ao_many_one_e_ints/ao_erf_gauss.irp.f

@@ -0,0 +1,269 @@
+
+subroutine phi_j_erf_mu_r_xyz_phi(i,j,mu_in, C_center, xyz_ints)
+ implicit none
+ BEGIN_DOC
+! xyz_ints(1/2/3) = int dr phi_j(r) [erf(mu  |r - C|)/|r-C|]  x/y/z phi_i(r)
+!
+! where phi_i and phi_j are AOs
+ END_DOC
+ integer, intent(in) :: i,j
+ double precision, intent(in) :: mu_in, C_center(3)
+ double precision, intent(out):: xyz_ints(3)
+ integer :: num_A,power_A(3), num_b, power_B(3),power_B_tmp(3)
+ double precision :: alpha, beta, A_center(3), B_center(3),contrib,NAI_pol_mult_erf
+ integer :: n_pt_in,l,m,mm
+ xyz_ints = 0.d0
+ if(ao_overlap_abs(j,i).lt.1.d-12)then
+  return
+ endif
+ n_pt_in = n_pt_max_integrals
+ ! j 
+ num_A = ao_nucl(j)
+ power_A(1:3)= ao_power(j,1:3)
+ A_center(1:3) = nucl_coord(num_A,1:3)
+ ! i 
+ num_B = ao_nucl(i)
+ power_B(1:3)= ao_power(i,1:3)
+ B_center(1:3) = nucl_coord(num_B,1:3)
+
+ do l=1,ao_prim_num(j)
+  alpha = ao_expo_ordered_transp(l,j)
+  do m=1,ao_prim_num(i)
+    beta = ao_expo_ordered_transp(m,i)
+    do mm = 1, 3
+     ! (x phi_i ) * phi_j 
+     ! x * (x - B_x)^b_x = b_x (x - B_x)^b_x + 1 * (x - B_x)^{b_x+1}
+     !
+     ! first contribution :: B_x (x - B_x)^b_x :: usual integral multiplied by B_x
+     power_B_tmp = power_B
+     contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B_tmp,alpha,beta,C_center,n_pt_in,mu_in)  
+     xyz_ints(mm) += contrib * B_center(mm) * ao_coef_normalized_ordered_transp(l,j)             &
+                                            * ao_coef_normalized_ordered_transp(m,i) 
+     ! second contribution :: 1 * (x - B_x)^(b_x+1) :: integral with b_x=>b_x+1 
+     power_B_tmp(mm) += 1
+     contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B_tmp,alpha,beta,C_center,n_pt_in,mu_in)  
+     xyz_ints(mm) += contrib * 1.d0        * ao_coef_normalized_ordered_transp(l,j)             &
+                                           * ao_coef_normalized_ordered_transp(m,i) 
+    enddo
+  enddo
+ enddo
+end
+
+
+double precision function phi_j_erf_mu_r_phi(i,j,mu_in, C_center)
+ implicit none
+ BEGIN_DOC
+! phi_j_erf_mu_r_phi  = int dr phi_j(r) [erf(mu  |r - C|)/|r-C|]  phi_i(r)
+ END_DOC
+ integer, intent(in) :: i,j
+ double precision, intent(in) :: mu_in, C_center(3)
+ integer :: num_A,power_A(3), num_b, power_B(3)
+ double precision :: alpha, beta, A_center(3), B_center(3),contrib,NAI_pol_mult_erf
+ integer :: n_pt_in,l,m
+ phi_j_erf_mu_r_phi = 0.d0
+ if(ao_overlap_abs(j,i).lt.1.d-12)then
+  return
+ endif
+ n_pt_in = n_pt_max_integrals
+ ! j 
+ num_A = ao_nucl(j)
+ power_A(1:3)= ao_power(j,1:3)
+ A_center(1:3) = nucl_coord(num_A,1:3)
+ ! i 
+ num_B = ao_nucl(i)
+ power_B(1:3)= ao_power(i,1:3)
+ B_center(1:3) = nucl_coord(num_B,1:3)
+
+ do l=1,ao_prim_num(j)
+  alpha = ao_expo_ordered_transp(l,j)
+  do m=1,ao_prim_num(i)
+    beta = ao_expo_ordered_transp(m,i)
+    contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B,alpha,beta,C_center,n_pt_in,mu_in)  
+    phi_j_erf_mu_r_phi += contrib *  ao_coef_normalized_ordered_transp(l,j)             &
+                                  *  ao_coef_normalized_ordered_transp(m,i) 
+  enddo
+ enddo
+end
+
+
+
+subroutine erfc_mu_gauss_xyz_ij_ao(i,j,mu, C_center, delta,gauss_ints)
+ implicit none
+ BEGIN_DOC
+  ! gauss_ints(m) =   \int dr exp(-delta (r - C)^2 ) x/y/z * ( 1 - erf(mu |r-r'|))/ |r-r'| * AO_i(r') * AO_j(r')
+  !
+  ! with m = 1 ==> x, m = 2, m = 3 ==> z
+  !
+  !      m = 4 ==> no x/y/z
+ END_DOC
+ integer, intent(in) :: i,j
+ double precision, intent(in) :: mu, C_center(3),delta
+ double precision, intent(out):: gauss_ints(4)
+
+ integer :: num_A,power_A(3), num_b, power_B(3)
+ double precision :: alpha, beta, A_center(3), B_center(3),contrib,NAI_pol_mult_erf
+ double precision :: xyz_ints(4)
+ integer :: n_pt_in,l,m,mm
+ gauss_ints = 0.d0
+ if(ao_overlap_abs(j,i).lt.1.d-12)then
+  return
+ endif
+ n_pt_in = n_pt_max_integrals
+ ! j 
+ num_A = ao_nucl(j)
+ power_A(1:3)= ao_power(j,1:3)
+ A_center(1:3) = nucl_coord(num_A,1:3)
+ ! i 
+ num_B = ao_nucl(i)
+ power_B(1:3)= ao_power(i,1:3)
+ B_center(1:3) = nucl_coord(num_B,1:3)
+
+ gauss_ints = 0.d0
+ do l=1,ao_prim_num(j)
+  alpha = ao_expo_ordered_transp(l,j)
+  do m=1,ao_prim_num(i)
+    beta = ao_expo_ordered_transp(m,i)
+    call erfc_mu_gauss_xyz(C_center,delta,mu,A_center,B_center,power_A,power_B,alpha,beta,n_pt_in,xyz_ints)
+    do mm = 1, 4
+     gauss_ints(mm) += xyz_ints(mm)  * ao_coef_normalized_ordered_transp(l,j)             &
+                                     * ao_coef_normalized_ordered_transp(m,i) 
+    enddo
+  enddo
+ enddo
+end
+
+subroutine erf_mu_gauss_ij_ao(i,j,mu, C_center, delta,gauss_ints)
+ implicit none
+ BEGIN_DOC
+  ! gauss_ints(m) =   \int dr exp(-delta (r - C)^2 )  * erf(mu |r-r'|)/ |r-r'| * AO_i(r') * AO_j(r')
+  !
+ END_DOC
+ integer, intent(in) :: i,j
+ double precision, intent(in) :: mu, C_center(3),delta
+ double precision, intent(out):: gauss_ints
+
+ integer :: num_A,power_A(3), num_b, power_B(3)
+ double precision :: alpha, beta, A_center(3), B_center(3),contrib,NAI_pol_mult_erf
+ double precision :: integral , erf_mu_gauss
+ integer :: n_pt_in,l,m,mm
+ gauss_ints = 0.d0
+ if(ao_overlap_abs(j,i).lt.1.d-12)then
+  return
+ endif
+ n_pt_in = n_pt_max_integrals
+ ! j 
+ num_A = ao_nucl(j)
+ power_A(1:3)= ao_power(j,1:3)
+ A_center(1:3) = nucl_coord(num_A,1:3)
+ ! i 
+ num_B = ao_nucl(i)
+ power_B(1:3)= ao_power(i,1:3)
+ B_center(1:3) = nucl_coord(num_B,1:3)
+
+ do l=1,ao_prim_num(j)
+  alpha = ao_expo_ordered_transp(l,j)
+  do m=1,ao_prim_num(i)
+    beta = ao_expo_ordered_transp(m,i)
+    if(dabs(ao_coef_normalized_ordered_transp(l,j) * ao_coef_normalized_ordered_transp(m,i)).lt.1.d-12)cycle
+    integral = erf_mu_gauss(C_center,delta,mu,A_center,B_center,power_A,power_B,alpha,beta,n_pt_in)
+    gauss_ints += integral * ao_coef_normalized_ordered_transp(l,j)             &
+                           * ao_coef_normalized_ordered_transp(m,i) 
+  enddo
+ enddo
+end
+
+
+subroutine NAI_pol_x_mult_erf_ao(i_ao,j_ao,mu_in,C_center,ints)
+ implicit none
+  BEGIN_DOC
+  ! Computes the following integral :
+  ! $\int_{-\infty}^{infty} dr x * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
+  !
+  ! $\int_{-\infty}^{infty} dr y * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
+  !
+  ! $\int_{-\infty}^{infty} dr z * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
+  END_DOC
+ include 'utils/constants.include.F'                                                                                                                                  
+ integer, intent(in) :: i_ao,j_ao
+ double precision, intent(in) :: mu_in, C_center(3)
+ double precision, intent(out):: ints(3)
+ double precision               :: A_center(3), B_center(3),integral, alpha,beta
+ double precision               :: NAI_pol_mult_erf
+ integer                        :: i,j,num_A,num_B, power_A(3), power_B(3), n_pt_in, power_xA(3),m
+ ints = 0.d0
+ if(ao_overlap_abs(j_ao,i_ao).lt.1.d-12)then
+  return
+ endif
+ num_A = ao_nucl(i_ao)
+ power_A(1:3)= ao_power(i_ao,1:3)
+ A_center(1:3) = nucl_coord(num_A,1:3)
+ num_B = ao_nucl(j_ao)
+ power_B(1:3)= ao_power(j_ao,1:3)
+ B_center(1:3) = nucl_coord(num_B,1:3)
+ n_pt_in = n_pt_max_integrals
+
+
+ do i = 1, ao_prim_num(i_ao)
+  alpha = ao_expo_ordered_transp(i,i_ao)
+   do m = 1, 3
+    power_xA = power_A
+    ! x * phi_i(r) = x * (x-Ax)**ax = (x-Ax)**(ax+1) + Ax * (x-Ax)**ax
+    power_xA(m) += 1
+    do j = 1, ao_prim_num(j_ao)
+      beta = ao_expo_ordered_transp(j,j_ao)
+      ! First term = (x-Ax)**(ax+1)
+      integral =  NAI_pol_mult_erf(A_center,B_center,power_xA,power_B,alpha,beta,C_center,n_pt_in,mu_in)
+      ints(m) += integral * ao_coef_normalized_ordered_transp(j,j_ao)*ao_coef_normalized_ordered_transp(i,i_ao)
+      ! Second term = Ax * (x-Ax)**(ax)
+      integral =  NAI_pol_mult_erf(A_center,B_center,power_A,power_B,alpha,beta,C_center,n_pt_in,mu_in)
+      ints(m) += A_center(m) * integral * ao_coef_normalized_ordered_transp(j,j_ao)*ao_coef_normalized_ordered_transp(i,i_ao)
+    enddo
+  enddo
+ enddo
+end
+
+subroutine NAI_pol_x_specify_mult_erf_ao(i_ao,j_ao,mu_in,C_center,m,ints)
+ implicit none
+  BEGIN_DOC
+  ! Computes the following integral :
+  ! $\int_{-\infty}^{infty} dr X(m) * \chi_i(r) \chi_j(r) \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
+  !
+  ! if m == 1 X(m) = x, m == 1 X(m) = y, m == 1 X(m) = z
+  END_DOC
+ include 'utils/constants.include.F'                                                                                                                                  
+ integer, intent(in) :: i_ao,j_ao,m
+ double precision, intent(in) :: mu_in, C_center(3)
+ double precision, intent(out):: ints
+ double precision               :: A_center(3), B_center(3),integral, alpha,beta
+ double precision               :: NAI_pol_mult_erf
+ integer                        :: i,j,num_A,num_B, power_A(3), power_B(3), n_pt_in, power_xA(3)
+ ints = 0.d0
+ if(ao_overlap_abs(j_ao,i_ao).lt.1.d-12)then
+  return
+ endif
+ num_A = ao_nucl(i_ao)
+ power_A(1:3)= ao_power(i_ao,1:3)
+ A_center(1:3) = nucl_coord(num_A,1:3)
+ num_B = ao_nucl(j_ao)
+ power_B(1:3)= ao_power(j_ao,1:3)
+ B_center(1:3) = nucl_coord(num_B,1:3)
+ n_pt_in = n_pt_max_integrals
+
+
+ do i = 1, ao_prim_num(i_ao)
+  alpha = ao_expo_ordered_transp(i,i_ao)
+    power_xA = power_A
+    ! x * phi_i(r) = x * (x-Ax)**ax = (x-Ax)**(ax+1) + Ax * (x-Ax)**ax
+    power_xA(m) += 1
+    do j = 1, ao_prim_num(j_ao)
+      beta = ao_expo_ordered_transp(j,j_ao)
+      ! First term = (x-Ax)**(ax+1)
+      integral =  NAI_pol_mult_erf(A_center,B_center,power_xA,power_B,alpha,beta,C_center,n_pt_in,mu_in)
+      ints += integral * ao_coef_normalized_ordered_transp(j,j_ao)*ao_coef_normalized_ordered_transp(i,i_ao)
+      ! Second term = Ax * (x-Ax)**(ax)
+      integral =  NAI_pol_mult_erf(A_center,B_center,power_A,power_B,alpha,beta,C_center,n_pt_in,mu_in)
+      ints += A_center(m) * integral * ao_coef_normalized_ordered_transp(j,j_ao)*ao_coef_normalized_ordered_transp(i,i_ao)
+    enddo
+ enddo
+end
+

src/ao_many_one_e_ints/ao_erf_gauss_grad.irp.f

@@ -0,0 +1,150 @@
+subroutine phi_j_erf_mu_r_dxyz_phi(i,j,mu_in, C_center, dxyz_ints)
+ implicit none
+ BEGIN_DOC
+! dxyz_ints(1/2/3) = int dr phi_i(r) [erf(mu  |r - C|)/|r-C|]  d/d(x/y/z) phi_i(r)
+ END_DOC
+ integer, intent(in) :: i,j
+ double precision, intent(in) :: mu_in, C_center(3)
+ double precision, intent(out):: dxyz_ints(3)
+ integer :: num_A,power_A(3), num_b, power_B(3),power_B_tmp(3)
+ double precision :: alpha, beta, A_center(3), B_center(3),contrib,NAI_pol_mult_erf,coef,thr
+ integer :: n_pt_in,l,m,mm
+ thr = 1.d-12
+ dxyz_ints = 0.d0
+ if(ao_overlap_abs(j,i).lt.thr)then
+  return
+ endif
+
+ n_pt_in = n_pt_max_integrals
+ ! j 
+ num_A = ao_nucl(j)
+ power_A(1:3)= ao_power(j,1:3)
+ A_center(1:3) = nucl_coord(num_A,1:3)
+ ! i 
+ num_B = ao_nucl(i)
+ power_B(1:3)= ao_power(i,1:3)
+ B_center(1:3) = nucl_coord(num_B,1:3)
+
+ do l=1,ao_prim_num(j)
+  alpha = ao_expo_ordered_transp(l,j)
+  do m=1,ao_prim_num(i)
+    beta = ao_expo_ordered_transp(m,i)
+    coef = ao_coef_normalized_ordered_transp(l,j) * ao_coef_normalized_ordered_transp(m,i) 
+    if(dabs(coef).lt.thr)cycle
+    do mm = 1, 3
+     ! (d/dx phi_i ) * phi_j 
+     ! d/dx * (x - B_x)^b_x exp(-beta * (x -B_x)^2)= [b_x * (x - B_x)^(b_x - 1) - 2 beta * (x - B_x)^(b_x + 1)] exp(-beta * (x -B_x)^2)
+     !
+     ! first contribution :: b_x (x - B_x)^(b_x-1) :: integral with b_x=>b_x-1 multiplied by b_x
+     power_B_tmp = power_B
+     power_B_tmp(mm) += -1
+     contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B_tmp,alpha,beta,C_center,n_pt_in,mu_in)  
+     dxyz_ints(mm) += contrib * dble(power_B(mm)) * coef 
+                                                  
+     ! second contribution ::  - 2 beta * (x - B_x)^(b_x + 1) :: integral with b_x=> b_x+1 multiplied by -2 * beta
+     power_B_tmp = power_B
+     power_B_tmp(mm) += 1
+     contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B_tmp,alpha,beta,C_center,n_pt_in,mu_in)  
+     dxyz_ints(mm) += contrib * (-2.d0 * beta )  * coef 
+                                                 
+    enddo
+  enddo
+ enddo
+end
+
+
+
+
+subroutine phi_j_erf_mu_r_dxyz_phi_bis(i,j,mu_in, C_center, dxyz_ints)
+ implicit none
+ BEGIN_DOC
+! dxyz_ints(1/2/3) = int dr phi_j(r) [erf(mu  |r - C|)/|r-C|]  d/d(x/y/z) phi_i(r)
+ END_DOC
+ integer, intent(in) :: i,j
+ double precision, intent(in) :: mu_in, C_center(3)
+ double precision, intent(out):: dxyz_ints(3)
+ integer :: num_A,power_A(3), num_b, power_B(3),power_B_tmp(3)
+ double precision :: alpha, beta, A_center(3), B_center(3),contrib,NAI_pol_mult_erf
+ double precision :: thr, coef
+ integer :: n_pt_in,l,m,mm,kk
+ thr = 1.d-12
+ dxyz_ints = 0.d0
+ if(ao_overlap_abs(j,i).lt.thr)then
+  return
+ endif
+
+ n_pt_in = n_pt_max_integrals
+ ! j == A 
+ num_A = ao_nucl(j)
+ power_A(1:3)= ao_power(j,1:3)
+ A_center(1:3) = nucl_coord(num_A,1:3)
+ ! i == B
+ num_B = ao_nucl(i)
+ power_B(1:3)= ao_power(i,1:3)
+ B_center(1:3) = nucl_coord(num_B,1:3)
+
+ dxyz_ints = 0.d0
+ do l=1,ao_prim_num(j)
+  alpha = ao_expo_ordered_transp(l,j)
+  do m=1,ao_prim_num(i)
+    beta = ao_expo_ordered_transp(m,i)
+    do kk = 1, 2 ! loop over the extra terms induced by the d/dx/y/z * AO(i)
+     do mm = 1, 3
+      power_B_tmp = power_B
+      power_B_tmp(mm) = power_ord_grad_transp(kk,mm,i)
+      coef = ao_coef_normalized_ordered_transp(l,j) * ao_coef_ord_grad_transp(kk,mm,m,i) 
+      if(dabs(coef).lt.thr)cycle
+      contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B_tmp,alpha,beta,C_center,n_pt_in,mu_in)  
+      dxyz_ints(mm) += contrib * coef 
+     enddo
+    enddo
+  enddo
+ enddo
+end
+
+subroutine phi_j_erf_mu_r_xyz_dxyz_phi(i,j,mu_in, C_center, dxyz_ints)
+ implicit none
+ BEGIN_DOC
+! dxyz_ints(1/2/3) = int dr phi_j(r) x/y/z [erf(mu  |r - C|)/|r-C|]  d/d(x/y/z) phi_i(r)
+ END_DOC
+ integer, intent(in) :: i,j
+ double precision, intent(in) :: mu_in, C_center(3)
+ double precision, intent(out):: dxyz_ints(3)
+ integer :: num_A,power_A(3), num_b, power_B(3),power_B_tmp(3)
+ double precision :: alpha, beta, A_center(3), B_center(3),contrib,NAI_pol_mult_erf
+ double precision :: thr, coef
+ integer :: n_pt_in,l,m,mm,kk
+ thr = 1.d-12
+ dxyz_ints = 0.d0
+ if(ao_overlap_abs(j,i).lt.thr)then
+  return
+ endif
+
+ n_pt_in = n_pt_max_integrals
+ ! j == A 
+ num_A = ao_nucl(j)
+ power_A(1:3)= ao_power(j,1:3)
+ A_center(1:3) = nucl_coord(num_A,1:3)
+ ! i == B
+ num_B = ao_nucl(i)
+ power_B(1:3)= ao_power(i,1:3)
+ B_center(1:3) = nucl_coord(num_B,1:3)
+
+ dxyz_ints = 0.d0
+ do l=1,ao_prim_num(j)
+  alpha = ao_expo_ordered_transp(l,j)
+  do m=1,ao_prim_num(i)
+    beta = ao_expo_ordered_transp(m,i)
+    do kk = 1, 4 ! loop over the extra terms induced by the x/y/z * d dx/y/z AO(i)
+     do mm = 1, 3
+      power_B_tmp = power_B
+      power_B_tmp(mm) = power_ord_xyz_grad_transp(kk,mm,i)
+      coef = ao_coef_normalized_ordered_transp(l,j) * ao_coef_ord_xyz_grad_transp(kk,mm,m,i) 
+      if(dabs(coef).lt.thr)cycle
+      contrib = NAI_pol_mult_erf(A_center,B_center,power_A,power_B_tmp,alpha,beta,C_center,n_pt_in,mu_in)  
+      dxyz_ints(mm) += contrib * coef 
+     enddo
+    enddo
+  enddo
+ enddo
+end

src/ao_many_one_e_ints/ao_gaus_gauss.irp.f

@@ -0,0 +1,136 @@
+subroutine overlap_gauss_xyz_r12_ao(D_center,delta,i,j,gauss_ints)
+ implicit none
+ BEGIN_DOC
+! gauss_ints(m) = \int dr AO_i(r) AO_j(r) x/y/z e^{-delta |r-D_center|^2}
+!
+! with m == 1 ==> x, m == 2 ==> y, m == 3 ==> z
+ END_DOC
+ integer, intent(in) :: i,j
+ double precision, intent(in)  :: D_center(3), delta
+ double precision, intent(out) :: gauss_ints(3)
+
+ integer :: num_a,num_b,power_A(3), power_B(3),l,k,m
+ double precision :: A_center(3), B_center(3),overlap_gauss_r12,alpha,beta,gauss_ints_tmp(3)
+ gauss_ints = 0.d0
+ if(ao_overlap_abs(j,i).lt.1.d-12)then
+  return
+ endif
+ num_A = ao_nucl(i)
+ power_A(1:3)= ao_power(i,1:3)
+ A_center(1:3) = nucl_coord(num_A,1:3)
+ num_B = ao_nucl(j)
+ power_B(1:3)= ao_power(j,1:3)
+ B_center(1:3) = nucl_coord(num_B,1:3)
+ do l=1,ao_prim_num(i)
+  alpha = ao_expo_ordered_transp(l,i)     
+  do k=1,ao_prim_num(j)
+   beta = ao_expo_ordered_transp(k,j)     
+   call overlap_gauss_xyz_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta,gauss_ints_tmp)
+   do m = 1, 3
+    gauss_ints(m) += gauss_ints_tmp(m) *  ao_coef_normalized_ordered_transp(l,i)             &
+                                       *  ao_coef_normalized_ordered_transp(k,j) 
+   enddo
+  enddo 
+ enddo
+end
+
+
+
+double precision function overlap_gauss_xyz_r12_ao_specific(D_center,delta,i,j,mx)
+ implicit none
+ BEGIN_DOC
+! \int dr AO_i(r) AO_j(r) x/y/z e^{-delta |r-D_center|^2}
+!
+! with mx == 1 ==> x, mx == 2 ==> y, mx == 3 ==> z
+ END_DOC
+ integer, intent(in) :: i,j,mx
+ double precision, intent(in)  :: D_center(3), delta
+
+ integer :: num_a,num_b,power_A(3), power_B(3),l,k
+ double precision :: gauss_int
+ double precision :: A_center(3), B_center(3),overlap_gauss_r12,alpha,beta
+ double precision :: overlap_gauss_xyz_r12_specific
+ overlap_gauss_xyz_r12_ao_specific = 0.d0
+ if(ao_overlap_abs(j,i).lt.1.d-12)then
+  return
+ endif
+ num_A = ao_nucl(i)
+ power_A(1:3)= ao_power(i,1:3)
+ A_center(1:3) = nucl_coord(num_A,1:3)
+ num_B = ao_nucl(j)
+ power_B(1:3)= ao_power(j,1:3)
+ B_center(1:3) = nucl_coord(num_B,1:3)
+ do l=1,ao_prim_num(i)
+  alpha = ao_expo_ordered_transp(l,i)     
+  do k=1,ao_prim_num(j)
+   beta = ao_expo_ordered_transp(k,j)     
+   gauss_int = overlap_gauss_xyz_r12_specific(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta,mx)
+   overlap_gauss_xyz_r12_ao_specific = gauss_int *  ao_coef_normalized_ordered_transp(l,i)             &
+                                                 *  ao_coef_normalized_ordered_transp(k,j) 
+  enddo 
+ enddo
+end
+
+
+subroutine overlap_gauss_r12_all_ao(D_center,delta,aos_ints)
+ implicit none
+ double precision, intent(in) :: D_center(3), delta
+ double precision, intent(out):: aos_ints(ao_num,ao_num)
+
+ integer :: num_a,num_b,power_A(3), power_B(3),l,k,i,j
+ double precision :: A_center(3), B_center(3),overlap_gauss_r12,alpha,beta,analytical_j
+ aos_ints = 0.d0
+ do i = 1, ao_num
+  do j = 1, ao_num
+   if(ao_overlap_abs(j,i).lt.1.d-12)cycle
+   num_A = ao_nucl(i)
+   power_A(1:3)= ao_power(i,1:3)
+   A_center(1:3) = nucl_coord(num_A,1:3)
+   num_B = ao_nucl(j)
+   power_B(1:3)= ao_power(j,1:3)
+   B_center(1:3) = nucl_coord(num_B,1:3)
+   do l=1,ao_prim_num(i)
+    alpha = ao_expo_ordered_transp(l,i)     
+    do k=1,ao_prim_num(j)
+     beta = ao_expo_ordered_transp(k,j)     
+     analytical_j = overlap_gauss_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta)
+     aos_ints(j,i) += analytical_j *  ao_coef_normalized_ordered_transp(l,i)             &
+                                   *  ao_coef_normalized_ordered_transp(k,j) 
+    enddo 
+   enddo
+  enddo
+ enddo
+end
+
+double precision function overlap_gauss_r12_ao(D_center,delta,i,j)
+ implicit none
+ BEGIN_DOC
+! \int dr AO_i(r) AO_j(r) e^{-delta |r-D_center|^2}
+ END_DOC
+ integer, intent(in) :: i,j
+ double precision, intent(in) :: D_center(3), delta
+
+ integer :: num_a,num_b,power_A(3), power_B(3),l,k
+ double precision :: A_center(3), B_center(3),overlap_gauss_r12,alpha,beta,analytical_j
+ overlap_gauss_r12_ao = 0.d0
+ if(ao_overlap_abs(j,i).lt.1.d-12)then
+  return
+ endif
+ num_A = ao_nucl(i)
+ power_A(1:3)= ao_power(i,1:3)
+ A_center(1:3) = nucl_coord(num_A,1:3)
+ num_B = ao_nucl(j)
+ power_B(1:3)= ao_power(j,1:3)
+ B_center(1:3) = nucl_coord(num_B,1:3)
+ do l=1,ao_prim_num(i)
+  alpha = ao_expo_ordered_transp(l,i)     
+  do k=1,ao_prim_num(j)
+   beta = ao_expo_ordered_transp(k,j)     
+   analytical_j = overlap_gauss_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta)
+   overlap_gauss_r12_ao += analytical_j *  ao_coef_normalized_ordered_transp(l,i)             &
+                                        *  ao_coef_normalized_ordered_transp(k,j) 
+  enddo 
+ enddo
+end
+
+

src/ao_many_one_e_ints/fit_slat_gauss.irp.f

@@ -0,0 +1,94 @@
+ BEGIN_PROVIDER [integer, n_max_fit_slat]
+ implicit none
+ BEGIN_DOC
+! number of gaussian to fit exp(-x)
+!
+! I took 20 gaussians from the program bassto.f
+ END_DOC
+ n_max_fit_slat = 20
+ END_PROVIDER
+
+ BEGIN_PROVIDER [double precision, coef_fit_slat_gauss, (n_max_fit_slat)]
+&BEGIN_PROVIDER [double precision, expo_fit_slat_gauss, (n_max_fit_slat)]
+ implicit none
+  include 'constants.include.F'
+ BEGIN_DOC
+ ! fit the exp(-x) as 
+ !
+ ! \sum_{i = 1, n_max_fit_slat} coef_fit_slat_gauss(i) * exp(-expo_fit_slat_gauss(i) * x**2)
+ !
+ ! The coefficient are taken from the program bassto.f
+ END_DOC
+
+
+      expo_fit_slat_gauss(01)=30573.77073000000
+      coef_fit_slat_gauss(01)=0.00338925525
+      expo_fit_slat_gauss(02)=5608.45238100000
+      coef_fit_slat_gauss(02)=0.00536433869
+      expo_fit_slat_gauss(03)=1570.95673400000
+      coef_fit_slat_gauss(03)=0.00818702846
+      expo_fit_slat_gauss(04)=541.39785110000
+      coef_fit_slat_gauss(04)=0.01202047655
+      expo_fit_slat_gauss(05)=212.43469630000
+      coef_fit_slat_gauss(05)=0.01711289568
+      expo_fit_slat_gauss(06)=91.31444574000
+      coef_fit_slat_gauss(06)=0.02376001022
+      expo_fit_slat_gauss(07)=42.04087246000
+      coef_fit_slat_gauss(07)=0.03229121736
+      expo_fit_slat_gauss(08)=20.43200443000
+      coef_fit_slat_gauss(08)=0.04303646818
+      expo_fit_slat_gauss(09)=10.37775161000
+      coef_fit_slat_gauss(09)=0.05624657578
+      expo_fit_slat_gauss(10)=5.46880754500
+      coef_fit_slat_gauss(10)=0.07192311571
+      expo_fit_slat_gauss(11)=2.97373529200
+      coef_fit_slat_gauss(11)=0.08949389001
+      expo_fit_slat_gauss(12)=1.66144190200
+      coef_fit_slat_gauss(12)=0.10727599240
+      expo_fit_slat_gauss(13)=0.95052560820
+      coef_fit_slat_gauss(13)=0.12178961750
+      expo_fit_slat_gauss(14)=0.55528683970
+      coef_fit_slat_gauss(14)=0.12740141870
+      expo_fit_slat_gauss(15)=0.33043360020
+      coef_fit_slat_gauss(15)=0.11759168160
+      expo_fit_slat_gauss(16)=0.19982303230
+      coef_fit_slat_gauss(16)=0.08953504394
+      expo_fit_slat_gauss(17)=0.12246840760
+      coef_fit_slat_gauss(17)=0.05066721317
+      expo_fit_slat_gauss(18)=0.07575825322
+      coef_fit_slat_gauss(18)=0.01806363869
+      expo_fit_slat_gauss(19)=0.04690146243
+      coef_fit_slat_gauss(19)=0.00305632563
+      expo_fit_slat_gauss(20)=0.02834749861
+      coef_fit_slat_gauss(20)=0.00013317513
+
+
+
+END_PROVIDER 
+
+double precision function slater_fit_gam(x,gam)
+ implicit none
+ double precision, intent(in) :: x,gam
+ BEGIN_DOC
+! fit of the function exp(-gam * x) with gaussian functions 
+ END_DOC
+ integer :: i
+ slater_fit_gam = 0.d0
+ do i = 1, n_max_fit_slat
+  slater_fit_gam += coef_fit_slat_gauss(i) * dexp(-expo_fit_slat_gauss(i) * gam * gam * x * x)
+ enddo
+end
+
+subroutine expo_fit_slater_gam(gam,expos)
+ implicit none
+ BEGIN_DOC
+! returns the array of the exponents of the gaussians to fit exp(-gam*x)
+ END_DOC
+ double precision, intent(in)  :: gam
+ double precision, intent(out) :: expos(n_max_fit_slat)
+ integer :: i
+ do i = 1, n_max_fit_slat
+  expos(i) = expo_fit_slat_gauss(i) * gam * gam
+ enddo
+end
+

src/ao_many_one_e_ints/grad_related_ints.irp.f

@@ -0,0 +1,342 @@
+BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu, ( ao_num, ao_num,n_points_final_grid)]
+ implicit none
+ BEGIN_DOC
+! int dr phi_i(r) phi_j(r) (erf(mu(R) |r - R| - 1)/|r - R|
+ END_DOC
+ integer :: i,j,ipoint
+ double precision :: mu,r(3),NAI_pol_mult_erf_ao
+ double precision :: int_mu, int_coulomb
+ provide mu_erf final_grid_points 
+ double precision :: wall0, wall1
+ call wall_time(wall0)
+ !$OMP PARALLEL                  &
+ !$OMP DEFAULT (NONE)            &
+ !$OMP PRIVATE (i,j,ipoint,mu,r,int_mu,int_coulomb) & 
+ !$OMP SHARED (ao_num,n_points_final_grid,v_ij_erf_rk_cst_mu,final_grid_points,mu_erf)
+ !$OMP DO SCHEDULE (dynamic)
+ do ipoint = 1, n_points_final_grid
+   do i = 1, ao_num
+    do j = i, ao_num
+     mu = mu_erf
+     r(1) = final_grid_points(1,ipoint)
+     r(2) = final_grid_points(2,ipoint)
+     r(3) = final_grid_points(3,ipoint)
+     int_mu = NAI_pol_mult_erf_ao(i,j,mu,r)
+     int_coulomb = NAI_pol_mult_erf_ao(i,j,1.d+9,r)
+     v_ij_erf_rk_cst_mu(j,i,ipoint)= (int_mu - int_coulomb )
+   enddo
+  enddo
+ enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ do ipoint = 1, n_points_final_grid
+  do i = 1, ao_num
+   do j = 1, i-1
+     v_ij_erf_rk_cst_mu(j,i,ipoint)= v_ij_erf_rk_cst_mu(i,j,ipoint)
+    enddo
+   enddo
+  enddo
+
+ call wall_time(wall1)
+ print*,'wall time for v_ij_erf_rk_cst_mu  ',wall1 - wall0
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, v_ij_erf_rk_cst_mu_transp, (n_points_final_grid, ao_num, ao_num)]
+ implicit none
+ BEGIN_DOC
+! int dr phi_i(r) phi_j(r) (erf(mu(R) |r - R| - 1)/|r - R|
+ END_DOC
+ integer :: i,j,ipoint
+ double precision :: mu,r(3),NAI_pol_mult_erf_ao
+ double precision :: int_mu, int_coulomb
+ provide mu_erf final_grid_points 
+ double precision :: wall0, wall1
+ call wall_time(wall0)
+ !$OMP PARALLEL                  &
+ !$OMP DEFAULT (NONE)            &
+ !$OMP PRIVATE (i,j,ipoint,mu,r,int_mu,int_coulomb) & 
+ !$OMP SHARED (ao_num,n_points_final_grid,v_ij_erf_rk_cst_mu_transp,final_grid_points,mu_erf)
+ !$OMP DO SCHEDULE (dynamic)
+ do i = 1, ao_num
+  do j = i, ao_num
+   do ipoint = 1, n_points_final_grid
+     mu = mu_erf 
+     r(1) = final_grid_points(1,ipoint)
+     r(2) = final_grid_points(2,ipoint)
+     r(3) = final_grid_points(3,ipoint)
+     int_mu = NAI_pol_mult_erf_ao(i,j,mu,r)
+     int_coulomb = NAI_pol_mult_erf_ao(i,j,1.d+9,r)
+     v_ij_erf_rk_cst_mu_transp(ipoint,j,i)= (int_mu - int_coulomb )
+   enddo
+  enddo
+ enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ do i = 1, ao_num
+  do j = 1, i-1
+   do ipoint = 1, n_points_final_grid
+     v_ij_erf_rk_cst_mu_transp(ipoint,j,i)= v_ij_erf_rk_cst_mu_transp(ipoint,i,j)
+    enddo
+   enddo
+  enddo
+
+ call wall_time(wall1)
+ print*,'wall time for v_ij_erf_rk_cst_mu_transp  ',wall1 - wall0
+END_PROVIDER 
+
+
+BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_tmp, (3,ao_num, ao_num,n_points_final_grid)]
+ implicit none
+ BEGIN_DOC
+! int dr x * phi_i(r) phi_j(r) (erf(mu(R) |r - R|) - 1)/|r - R|
+ END_DOC
+ integer :: i,j,ipoint,m
+ double precision :: mu,r(3),ints(3),ints_coulomb(3)
+ double precision :: wall0, wall1
+ call wall_time(wall0)
+ !$OMP PARALLEL                  &
+ !$OMP DEFAULT (NONE)            &
+ !$OMP PRIVATE (i,j,ipoint,mu,r,ints,m,ints_coulomb) & 
+ !$OMP SHARED (ao_num,n_points_final_grid,x_v_ij_erf_rk_cst_mu_tmp,final_grid_points,mu_erf)
+ !$OMP DO SCHEDULE (dynamic)
+ do ipoint = 1, n_points_final_grid
+  do i = 1, ao_num
+   do j = i, ao_num
+    mu = mu_erf
+    r(1) = final_grid_points(1,ipoint)
+    r(2) = final_grid_points(2,ipoint)
+    r(3) = final_grid_points(3,ipoint)
+    call NAI_pol_x_mult_erf_ao(i,j,mu,r,ints)
+    call NAI_pol_x_mult_erf_ao(i,j,1.d+9,r,ints_coulomb)
+    do m = 1, 3
+     x_v_ij_erf_rk_cst_mu_tmp(m,j,i,ipoint) = ( ints(m) - ints_coulomb(m))
+    enddo
+   enddo
+  enddo
+ enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ do ipoint = 1, n_points_final_grid
+  do i = 1, ao_num
+   do j = 1, i-1
+    do m = 1, 3
+     x_v_ij_erf_rk_cst_mu_tmp(m,j,i,ipoint)= x_v_ij_erf_rk_cst_mu_tmp(m,i,j,ipoint)
+    enddo
+   enddo
+  enddo
+ enddo
+ call wall_time(wall1)
+ print*,'wall time for x_v_ij_erf_rk_cst_mu_tmp',wall1 - wall0
+
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu, (ao_num, ao_num,n_points_final_grid,3)]
+ implicit none
+ BEGIN_DOC
+! int dr x * phi_i(r) phi_j(r) (erf(mu(R) |r - R|) - 1)/|r - R|
+ END_DOC
+ integer :: i,j,ipoint,m
+ double precision :: mu,r(3),ints,ints_coulomb
+ double precision :: wall0, wall1
+ call wall_time(wall0)
+ do ipoint = 1, n_points_final_grid
+  do i = 1, ao_num
+   do j = 1, ao_num
+    do m = 1, 3
+     x_v_ij_erf_rk_cst_mu(j,i,ipoint,m)= x_v_ij_erf_rk_cst_mu_tmp(m,j,i,ipoint)
+    enddo
+   enddo
+  enddo
+ enddo
+
+ call wall_time(wall1)
+ print*,'wall time for x_v_ij_erf_rk_cst_mu',wall1 - wall0
+
+END_PROVIDER 
+
+
+BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_transp, (ao_num, ao_num,3,n_points_final_grid)]
+ implicit none
+ BEGIN_DOC
+! int dr x * phi_i(r) phi_j(r) (erf(mu(R) |r - R|) - 1)/|r - R|
+ END_DOC
+ integer :: i,j,ipoint,m
+ double precision :: mu,r(3),ints,ints_coulomb
+ double precision :: wall0, wall1
+ call wall_time(wall0)
+ do ipoint = 1, n_points_final_grid
+  do m = 1, 3
+   do i = 1, ao_num
+    do j = 1, ao_num
+     x_v_ij_erf_rk_cst_mu_transp(j,i,m,ipoint)= x_v_ij_erf_rk_cst_mu_tmp(m,j,i,ipoint)
+    enddo
+   enddo
+  enddo
+ enddo
+ call wall_time(wall1)
+ print*,'wall time for x_v_ij_erf_rk_cst_mu_transp',wall1 - wall0
+
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, x_v_ij_erf_rk_cst_mu_transp_bis, (n_points_final_grid,ao_num, ao_num,3)]
+ implicit none
+ BEGIN_DOC
+! int dr x * phi_i(r) phi_j(r) (erf(mu(R) |r - R|) - 1)/|r - R|
+ END_DOC
+ integer :: i,j,ipoint,m
+ double precision :: mu,r(3),ints,ints_coulomb
+ double precision :: wall0, wall1
+ call wall_time(wall0)
+ do m = 1, 3
+  do i = 1, ao_num
+   do j = 1, ao_num
+    do ipoint = 1, n_points_final_grid
+     x_v_ij_erf_rk_cst_mu_transp_bis(ipoint,j,i,m)= x_v_ij_erf_rk_cst_mu_tmp(m,j,i,ipoint)
+    enddo
+   enddo
+  enddo
+ enddo
+ call wall_time(wall1)
+ print*,'wall time for x_v_ij_erf_rk_cst_mu_transp',wall1 - wall0
+
+
+END_PROVIDER 
+
+
+BEGIN_PROVIDER [ double precision, d_dx_v_ij_erf_rk_cst_mu_tmp, (3,n_points_final_grid,ao_num, ao_num)]
+ implicit none
+ BEGIN_DOC
+! d_dx_v_ij_erf_rk_cst_mu_tmp(m,R,j,i) = int dr phi_j(r)) (erf(mu(R) |r - R|) - 1)/|r - R| d/dx (phi_i(r) 
+!
+! with m == 1 -> d/dx , m == 2 -> d/dy , m == 3 -> d/dz
+ END_DOC
+ integer :: i,j,ipoint,m
+ double precision :: mu,r(3),ints(3),ints_coulomb(3)
+ double precision :: wall0, wall1
+ call wall_time(wall0)
+ !$OMP PARALLEL                  &
+ !$OMP DEFAULT (NONE)            &
+ !$OMP PRIVATE (i,j,ipoint,mu,r,ints,m,ints_coulomb) & 
+ !$OMP SHARED (ao_num,n_points_final_grid,d_dx_v_ij_erf_rk_cst_mu_tmp,final_grid_points,mu_erf)
+ !$OMP DO SCHEDULE (dynamic)
+ do i = 1, ao_num
+  do j = 1, ao_num
+   do ipoint = 1, n_points_final_grid
+    mu = mu_erf 
+    r(1) = final_grid_points(1,ipoint)
+    r(2) = final_grid_points(2,ipoint)
+    r(3) = final_grid_points(3,ipoint)
+    call phi_j_erf_mu_r_dxyz_phi(j,i,mu, r, ints)
+    call phi_j_erf_mu_r_dxyz_phi(j,i,1.d+9, r, ints_coulomb)
+    do m = 1, 3
+     d_dx_v_ij_erf_rk_cst_mu_tmp(m,ipoint,j,i) = ( ints(m) - ints_coulomb(m))
+    enddo
+   enddo
+  enddo
+ enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ call wall_time(wall1)
+ print*,'wall time for d_dx_v_ij_erf_rk_cst_mu_tmp',wall1 - wall0
+
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, d_dx_v_ij_erf_rk_cst_mu, (n_points_final_grid,ao_num, ao_num,3)]
+ implicit none
+ BEGIN_DOC
+! d_dx_v_ij_erf_rk_cst_mu_tmp(j,i,R,m) = int dr phi_j(r)) (erf(mu(R) |r - R|) - 1)/|r - R| d/dx (phi_i(r) 
+!
+! with m == 1 -> d/dx , m == 2 -> d/dy , m == 3 -> d/dz
+ END_DOC
+ integer :: i,j,ipoint,m
+ double precision :: mu,r(3),ints,ints_coulomb
+ double precision :: wall0, wall1
+ call wall_time(wall0)
+ do i = 1, ao_num
+  do j = 1, ao_num
+   do m = 1, 3
+    do ipoint = 1, n_points_final_grid
+     d_dx_v_ij_erf_rk_cst_mu(ipoint,j,i,m)= d_dx_v_ij_erf_rk_cst_mu_tmp(m,ipoint,j,i)
+    enddo
+   enddo
+  enddo
+ enddo
+
+ call wall_time(wall1)
+ print*,'wall time for d_dx_v_ij_erf_rk_cst_mu',wall1 - wall0
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, x_d_dx_v_ij_erf_rk_cst_mu_tmp, (3,n_points_final_grid,ao_num, ao_num)]
+ implicit none
+ BEGIN_DOC
+! x_d_dx_v_ij_erf_rk_cst_mu_tmp(m,j,i,R) = int dr x phi_j(r)) (erf(mu(R) |r - R|) - 1)/|r - R| d/dx (phi_i(r) 
+!
+! with m == 1 -> d/dx , m == 2 -> d/dy , m == 3 -> d/dz
+ END_DOC
+ integer :: i,j,ipoint,m
+ double precision :: mu,r(3),ints(3),ints_coulomb(3)
+ double precision :: wall0, wall1
+ call wall_time(wall0)
+ !$OMP PARALLEL                  &
+ !$OMP DEFAULT (NONE)            &
+ !$OMP PRIVATE (i,j,ipoint,mu,r,ints,m,ints_coulomb) & 
+ !$OMP SHARED (ao_num,n_points_final_grid,x_d_dx_v_ij_erf_rk_cst_mu_tmp,final_grid_points,mu_erf)
+ !$OMP DO SCHEDULE (dynamic)
+ do i = 1, ao_num
+  do j = 1, ao_num
+   do ipoint = 1, n_points_final_grid
+    mu = mu_erf
+    r(1) = final_grid_points(1,ipoint)
+    r(2) = final_grid_points(2,ipoint)
+    r(3) = final_grid_points(3,ipoint)
+    call phi_j_erf_mu_r_xyz_dxyz_phi(j,i,mu, r, ints)
+    call phi_j_erf_mu_r_xyz_dxyz_phi(j,i,1.d+9, r, ints_coulomb)
+    do m = 1, 3
+     x_d_dx_v_ij_erf_rk_cst_mu_tmp(m,ipoint,j,i) = ( ints(m) - ints_coulomb(m))
+    enddo
+   enddo
+  enddo
+ enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ call wall_time(wall1)
+ print*,'wall time for x_d_dx_v_ij_erf_rk_cst_mu_tmp',wall1 - wall0
+
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, x_d_dx_v_ij_erf_rk_cst_mu, (n_points_final_grid,ao_num, ao_num,3)]
+ implicit none
+ BEGIN_DOC
+! x_d_dx_v_ij_erf_rk_cst_mu_tmp(j,i,R,m) = int dr x phi_j(r)) (erf(mu(R) |r - R|) - 1)/|r - R| d/dx (phi_i(r) 
+!
+! with m == 1 -> d/dx , m == 2 -> d/dy , m == 3 -> d/dz
+ END_DOC
+ integer :: i,j,ipoint,m
+ double precision :: mu,r(3),ints,ints_coulomb
+ double precision :: wall0, wall1
+ call wall_time(wall0)
+ do i = 1, ao_num
+  do j = 1, ao_num
+   do ipoint = 1, n_points_final_grid
+    do m = 1, 3
+     x_d_dx_v_ij_erf_rk_cst_mu(ipoint,j,i,m)= x_d_dx_v_ij_erf_rk_cst_mu_tmp(m,ipoint,j,i)
+    enddo
+   enddo
+  enddo
+ enddo
+
+ call wall_time(wall1)
+ print*,'wall time for x_d_dx_v_ij_erf_rk_cst_mu',wall1 - wall0
+
+END_PROVIDER 
+

src/ao_many_one_e_ints/prim_int_erf_gauss.irp.f

@@ -0,0 +1,195 @@
+double precision function NAI_pol_mult_erf_gauss_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu)
+  BEGIN_DOC
+  ! Computes the following integral R^3 :
+  !
+  ! .. math::
+  ! 
+  !   \int dr  (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !   \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$ exp(-delta (r - D)^2 ).
+  !
+  END_DOC
+
+ implicit none
+  include 'constants.include.F'
+ double precision, intent(in)    :: D_center(3), delta  ! pure gaussian "D" 
+ double precision, intent(in)    :: C_center(3),mu      ! coulomb center "C" and "mu" in the erf(mu*x)/x function
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3)
+
+ double precision  :: NAI_pol_mult_erf
+ ! First you multiply the usual gaussian "A" with the gaussian exp(-delta (r - D)^2 )
+ double precision  :: A_new(0:max_dim,3)! new polynom 
+ double precision  :: A_center_new(3)   ! new center
+ integer           :: iorder_a_new(3)   ! i_order(i) = order of the new polynom ==> should be equal to power_A
+ double precision  :: alpha_new         ! new exponent
+ double precision  :: fact_a_new        ! constant factor
+ double precision  :: accu,coefx,coefy,coefz,coefxy,coefxyz,thr
+ integer           :: d(3),i,lx,ly,lz,iorder_tmp(3)
+ thr = 1.d-10
+ d = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 )  == 0
+
+ ! New gaussian/polynom defined by :: new pol new center new expo   cst fact new order                                
+ call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new , & 
+                                      delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
+ ! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
+ accu = 0.d0
+ do lx = 0, iorder_a_new(1)
+  coefx = A_new(lx,1)
+  if(dabs(coefx).lt.thr)cycle
+  iorder_tmp(1) = lx
+  do ly = 0, iorder_a_new(2)
+   coefy = A_new(ly,2)
+   coefxy = coefx * coefy 
+   if(dabs(coefxy).lt.thr)cycle
+   iorder_tmp(2) = ly
+   do lz = 0, iorder_a_new(3)
+    coefz = A_new(lz,3)
+    coefxyz = coefxy * coefz 
+    if(dabs(coefxyz).lt.thr)cycle
+    iorder_tmp(3) = lz
+    accu += coefxyz * NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B,alpha_new,beta,C_center,n_pt_max_integrals,mu)
+   enddo
+  enddo
+ enddo
+ NAI_pol_mult_erf_gauss_r12 = fact_a_new * accu 
+end
+
+subroutine erfc_mu_gauss_xyz(D_center,delta,mu,A_center,B_center,power_A,power_B,alpha,beta,n_pt_in,xyz_ints)
+  BEGIN_DOC
+  ! Computes the following integral :
+  !
+  ! .. math::
+  ! 
+  !   \int dr exp(-delta (r - D)^2 ) x/y/z * (1 - erf(mu |r-r'|))/ |r-r'| * (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !
+  !   xyz_ints(1) = x , xyz_ints(2) = y, xyz_ints(3) = z, xyz_ints(4) = x^0 
+  END_DOC
+
+ implicit none
+  include 'constants.include.F'
+ double precision, intent(in)    :: D_center(3), delta,mu  ! pure gaussian "D" and mu parameter
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3),n_pt_in
+ double precision, intent(out)   :: xyz_ints(4)
+
+ double precision  :: NAI_pol_mult_erf
+ ! First you multiply the usual gaussian "A" with the gaussian exp(-delta (r - D)^2 )
+ double precision  :: A_new(0:max_dim,3)! new polynom 
+ double precision  :: A_center_new(3)   ! new center
+ integer           :: iorder_a_new(3)   ! i_order(i) = order of the new polynom ==> should be equal to power_A
+ double precision  :: alpha_new         ! new exponent
+ double precision  :: fact_a_new        ! constant factor
+ double precision  :: accu,coefx,coefy,coefz,coefxy,coefxyz,thr,contrib,contrib_inf,mu_inf
+ integer           :: d(3),i,lx,ly,lz,iorder_tmp(3),dim1,mm
+ integer           :: power_B_tmp(3)
+ dim1=100
+ mu_inf = 1.d+10
+ thr = 1.d-10
+ d = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 )  == 0
+
+ ! New gaussian/polynom defined by :: new pol new center new expo   cst fact new order                                
+ call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new , & 
+                                      delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
+ ! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
+ xyz_ints = 0.d0
+ do lx = 0, iorder_a_new(1)
+  coefx = A_new(lx,1)
+  if(dabs(coefx).lt.thr)cycle
+  iorder_tmp(1) = lx
+  do ly = 0, iorder_a_new(2)
+   coefy = A_new(ly,2)
+   coefxy = coefx * coefy 
+   if(dabs(coefxy).lt.thr)cycle
+   iorder_tmp(2) = ly
+   do lz = 0, iorder_a_new(3)
+    coefz = A_new(lz,3)
+    coefxyz = coefxy * coefz 
+    if(dabs(coefxyz).lt.thr)cycle
+    iorder_tmp(3) = lz
+     power_B_tmp = power_B
+     contrib = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B_tmp,alpha_new,beta,D_center,n_pt_in,mu)  
+     contrib_inf = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B_tmp,alpha_new,beta,D_center,n_pt_in,mu_inf)  
+     xyz_ints(4) += (contrib_inf - contrib) * coefxyz ! usual term with no x/y/z 
+                                      
+     do mm = 1, 3 
+      ! (x phi_i ) * phi_j 
+      ! x * (x - B_x)^b_x = B_x (x - B_x)^b_x + 1 * (x - B_x)^{b_x+1}
+      
+      !
+      ! first contribution :: B_x (x - B_x)^b_x :: usual integral multiplied by B_x
+      power_B_tmp = power_B
+      contrib_inf = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B_tmp,alpha_new,beta,D_center,n_pt_in,mu_inf)  
+      contrib = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B_tmp,alpha_new,beta,D_center,n_pt_in,mu)  
+      xyz_ints(mm) += (contrib_inf - contrib) * B_center(mm) * coefxyz 
+                                                       
+      !
+      ! second contribution :: (x - B_x)^(b_x+1) :: integral with b_x=>b_x+1 
+      power_B_tmp(mm) += 1
+      contrib = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B_tmp,alpha_new,beta,D_center,n_pt_in,mu)  
+      contrib_inf = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B_tmp,alpha_new,beta,D_center,n_pt_in,mu_inf)  
+      xyz_ints(mm) += (contrib_inf -  contrib) * coefxyz     
+     enddo
+   enddo
+  enddo
+ enddo
+ xyz_ints *= fact_a_new 
+end
+
+
+double precision function erf_mu_gauss(D_center,delta,mu,A_center,B_center,power_A,power_B,alpha,beta,n_pt_in)
+  BEGIN_DOC
+  ! Computes the following integral :
+  !
+  ! .. math::
+  ! 
+  !   \int dr exp(-delta (r - D)^2 ) erf(mu*|r-r'|)/ |r-r'| * (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !
+  END_DOC
+
+ implicit none
+  include 'constants.include.F'
+ double precision, intent(in)    :: D_center(3), delta,mu  ! pure gaussian "D" and mu parameter
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3),n_pt_in
+
+ double precision  :: NAI_pol_mult_erf
+ ! First you multiply the usual gaussian "A" with the gaussian exp(-delta (r - D)^2 )
+ double precision  :: A_new(0:max_dim,3)! new polynom 
+ double precision  :: A_center_new(3)   ! new center
+ integer           :: iorder_a_new(3)   ! i_order(i) = order of the new polynom ==> should be equal to power_A
+ double precision  :: alpha_new         ! new exponent
+ double precision  :: fact_a_new        ! constant factor
+ double precision  :: accu,coefx,coefy,coefz,coefxy,coefxyz,thr,contrib,contrib_inf,mu_inf
+ integer           :: d(3),i,lx,ly,lz,iorder_tmp(3),dim1,mm
+ dim1=100
+ mu_inf = 1.d+10
+ thr = 1.d-10
+ d = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 )  == 0
+
+ ! New gaussian/polynom defined by :: new pol new center new expo   cst fact new order                                
+ call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new , & 
+                                      delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
+ ! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
+ erf_mu_gauss = 0.d0
+ do lx = 0, iorder_a_new(1)
+  coefx = A_new(lx,1)
+  if(dabs(coefx).lt.thr)cycle
+  iorder_tmp(1) = lx
+  do ly = 0, iorder_a_new(2)
+   coefy = A_new(ly,2)
+   coefxy = coefx * coefy 
+   if(dabs(coefxy).lt.thr)cycle
+   iorder_tmp(2) = ly
+   do lz = 0, iorder_a_new(3)
+    coefz = A_new(lz,3)
+    coefxyz = coefxy * coefz 
+    if(dabs(coefxyz).lt.thr)cycle
+    iorder_tmp(3) = lz
+    contrib = NAI_pol_mult_erf(A_center_new,B_center,iorder_tmp,power_B,alpha_new,beta,D_center,n_pt_in,mu)
+    erf_mu_gauss += contrib * coefxyz     
+   enddo
+  enddo
+ enddo
+ erf_mu_gauss *= fact_a_new 
+end
+

src/ao_many_one_e_ints/prim_int_gauss_gauss.irp.f

@@ -0,0 +1,191 @@
+
+double precision function overlap_gauss_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta)
+  BEGIN_DOC
+  ! Computes the following integral :
+  !
+  ! .. math::
+  ! 
+  !   \int dr exp(-delta (r - D)^2 ) (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !
+  END_DOC
+
+ implicit none
+  include 'constants.include.F'
+ double precision, intent(in)    :: D_center(3), delta  ! pure gaussian "D" 
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3)
+
+ double precision  :: overlap_x,overlap_y,overlap_z,overlap
+ ! First you multiply the usual gaussian "A" with the gaussian exp(-delta (r - D)^2 )
+ double precision  :: A_new(0:max_dim,3)! new polynom 
+ double precision  :: A_center_new(3)   ! new center
+ integer           :: iorder_a_new(3)   ! i_order(i) = order of the new polynom ==> should be equal to power_A
+ double precision  :: alpha_new         ! new exponent
+ double precision  :: fact_a_new        ! constant factor
+ double precision  :: accu,coefx,coefy,coefz,coefxy,coefxyz,thr
+ integer           :: d(3),i,lx,ly,lz,iorder_tmp(3),dim1
+ dim1=100
+ thr = 1.d-10
+ d = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 )  == 0
+
+ ! New gaussian/polynom defined by :: new pol new center new expo   cst fact new order                                
+ call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new , & 
+                                      delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
+ ! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
+ accu = 0.d0
+ do lx = 0, iorder_a_new(1)
+  coefx = A_new(lx,1)
+  if(dabs(coefx).lt.thr)cycle
+  iorder_tmp(1) = lx
+  do ly = 0, iorder_a_new(2)
+   coefy = A_new(ly,2)
+   coefxy = coefx * coefy 
+   if(dabs(coefxy).lt.thr)cycle
+   iorder_tmp(2) = ly
+   do lz = 0, iorder_a_new(3)
+    coefz = A_new(lz,3)
+    coefxyz = coefxy * coefz 
+    if(dabs(coefxyz).lt.thr)cycle
+    iorder_tmp(3) = lz
+    call overlap_gaussian_xyz(A_center_new,B_center,alpha_new,beta,iorder_tmp,power_B,overlap_x,overlap_y,overlap_z,overlap,dim1)
+    accu += coefxyz * overlap
+   enddo
+  enddo
+ enddo
+ overlap_gauss_r12 = fact_a_new * accu 
+end
+
+
+subroutine overlap_gauss_xyz_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta,gauss_ints)
+  BEGIN_DOC
+  ! Computes the following integral :
+  !
+  ! .. math::
+  ! 
+  !   gauss_ints(m) = \int dr exp(-delta (r - D)^2 ) * x/y/z (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !
+  ! with m == 1 ==> x, m == 2 ==> y, m == 3 ==> z
+  END_DOC
+
+ implicit none
+  include 'constants.include.F'
+ double precision, intent(in)    :: D_center(3), delta  ! pure gaussian "D" 
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3)
+ double precision, intent(out)   :: gauss_ints(3)
+
+ double precision  :: overlap_x,overlap_y,overlap_z,overlap
+ ! First you multiply the usual gaussian "A" with the gaussian exp(-delta (r - D)^2 )
+ double precision  :: A_new(0:max_dim,3)! new polynom 
+ double precision  :: A_center_new(3)   ! new center
+ integer           :: iorder_a_new(3)   ! i_order(i) = order of the new polynom ==> should be equal to power_A
+ integer           :: power_B_new(3)
+ double precision  :: alpha_new         ! new exponent
+ double precision  :: fact_a_new        ! constant factor
+ double precision  :: coefx,coefy,coefz,coefxy,coefxyz,thr
+ integer           :: d(3),i,lx,ly,lz,iorder_tmp(3),dim1,m
+ dim1=100
+ thr = 1.d-10
+ d = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 )  == 0
+
+ ! New gaussian/polynom defined by :: new pol new center new expo   cst fact new order                                
+ call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new , & 
+                                      delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
+ ! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
+ gauss_ints = 0.d0
+ do lx = 0, iorder_a_new(1)
+  coefx = A_new(lx,1)
+  if(dabs(coefx).lt.thr)cycle
+  iorder_tmp(1) = lx
+  do ly = 0, iorder_a_new(2)
+   coefy = A_new(ly,2)
+   coefxy = coefx * coefy 
+   if(dabs(coefxy).lt.thr)cycle
+   iorder_tmp(2) = ly
+   do lz = 0, iorder_a_new(3)
+    coefz = A_new(lz,3)
+    coefxyz = coefxy * coefz 
+    if(dabs(coefxyz).lt.thr)cycle
+    iorder_tmp(3) = lz
+    do m = 1, 3
+     ! change (x-Bx)^bx --> (x-Bx)^(bx+1) + Bx(x-Bx)^bx
+     power_B_new = power_B
+     power_B_new(m) += 1 ! (x-Bx)^(bx+1)
+     call overlap_gaussian_xyz(A_center_new,B_center,alpha_new,beta,iorder_tmp,power_B_new,overlap_x,overlap_y,overlap_z,overlap,dim1)
+     gauss_ints(m) += coefxyz * overlap
+
+     power_B_new = power_B
+     call overlap_gaussian_xyz(A_center_new,B_center,alpha_new,beta,iorder_tmp,power_B_new,overlap_x,overlap_y,overlap_z,overlap,dim1)
+     gauss_ints(m) += coefxyz * overlap * B_center(m) ! Bx (x-Bx)^(bx)
+    enddo
+   enddo
+  enddo
+ enddo
+ gauss_ints *= fact_a_new
+end
+
+double precision function overlap_gauss_xyz_r12_specific(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta,mx)
+  BEGIN_DOC
+  ! Computes the following integral :
+  !
+  ! .. math::
+  ! 
+  !    \int dr exp(-delta (r - D)^2 ) * x/y/z (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !
+  ! with mx == 1 ==> x, mx == 2 ==> y, mx == 3 ==> z
+  END_DOC
+
+ implicit none
+  include 'constants.include.F'
+ double precision, intent(in)    :: D_center(3), delta  ! pure gaussian "D" 
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3),mx
+
+ double precision  :: overlap_x,overlap_y,overlap_z,overlap
+ ! First you multiply the usual gaussian "A" with the gaussian exp(-delta (r - D)^2 )
+ double precision  :: A_new(0:max_dim,3)! new polynom 
+ double precision  :: A_center_new(3)   ! new center
+ integer           :: iorder_a_new(3)   ! i_order(i) = order of the new polynom ==> should be equal to power_A
+ integer           :: power_B_new(3)
+ double precision  :: alpha_new         ! new exponent
+ double precision  :: fact_a_new        ! constant factor
+ double precision  :: coefx,coefy,coefz,coefxy,coefxyz,thr
+ integer           :: d(3),i,lx,ly,lz,iorder_tmp(3),dim1,m
+ dim1=100
+ thr = 1.d-10
+ d = 0 ! order of the polynom for the gaussian exp(-delta (r - D)^2 )  == 0
+
+ ! New gaussian/polynom defined by :: new pol new center new expo   cst fact new order                                
+ call give_explicit_poly_and_gaussian(A_new , A_center_new , alpha_new, fact_a_new , iorder_a_new , & 
+                                      delta,alpha,d,power_A,D_center,A_center,n_pt_max_integrals)
+ ! The new gaussian exp(-delta (r - D)^2 ) (x-A_x)^a \exp(-\alpha (x-A_x)^2
+ overlap_gauss_xyz_r12_specific = 0.d0
+ do lx = 0, iorder_a_new(1)
+  coefx = A_new(lx,1)
+  if(dabs(coefx).lt.thr)cycle
+  iorder_tmp(1) = lx
+  do ly = 0, iorder_a_new(2)
+   coefy = A_new(ly,2)
+   coefxy = coefx * coefy 
+   if(dabs(coefxy).lt.thr)cycle
+   iorder_tmp(2) = ly
+   do lz = 0, iorder_a_new(3)
+    coefz = A_new(lz,3)
+    coefxyz = coefxy * coefz 
+    if(dabs(coefxyz).lt.thr)cycle
+    iorder_tmp(3) = lz
+    m = mx
+    ! change (x-Bx)^bx --> (x-Bx)^(bx+1) + Bx(x-Bx)^bx
+    power_B_new = power_B
+    power_B_new(m) += 1 ! (x-Bx)^(bx+1)
+    call overlap_gaussian_xyz(A_center_new,B_center,alpha_new,beta,iorder_tmp,power_B_new,overlap_x,overlap_y,overlap_z,overlap,dim1)
+    overlap_gauss_xyz_r12_specific += coefxyz * overlap
+
+    power_B_new = power_B
+    call overlap_gaussian_xyz(A_center_new,B_center,alpha_new,beta,iorder_tmp,power_B_new,overlap_x,overlap_y,overlap_z,overlap,dim1)
+    overlap_gauss_xyz_r12_specific += coefxyz * overlap * B_center(m) ! Bx (x-Bx)^(bx)
+   enddo
+  enddo
+ enddo
+ overlap_gauss_xyz_r12_specific *= fact_a_new
+end

src/ao_many_one_e_ints/stg_gauss_int.irp.f

@@ -0,0 +1,121 @@
+double precision function ovlp_stg_gauss_int_phi_ij(D_center,gam,delta,A_center,B_center,power_A,power_B,alpha,beta)
+  BEGIN_DOC
+  ! Computes the following integral : 
+  !
+  ! .. math::
+  ! 
+  !   \int dr exp(-gam (r - D)) exp(-delta * (r -D)^2) (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !
+  END_DOC
+
+ implicit none
+ double precision, intent(in)    :: D_center(3), gam ! pure Slater "D" in r-r_D
+ double precision, intent(in)    :: delta            ! gaussian        in r-r_D
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3)
+
+ integer :: i
+ double precision :: integral,gama_gauss
+ double precision, allocatable :: expos_slat(:)
+ allocate(expos_slat(n_max_fit_slat))
+ double precision :: overlap_gauss_r12
+ ovlp_stg_gauss_int_phi_ij = 0.d0
+ call expo_fit_slater_gam(gam,expos_slat)
+ do i = 1, n_max_fit_slat
+  gama_gauss = expos_slat(i)+delta 
+  integral = overlap_gauss_r12(D_center,gama_gauss,A_center,B_center,power_A,power_B,alpha,beta)
+  ovlp_stg_gauss_int_phi_ij += coef_fit_slat_gauss(i) * integral
+ enddo
+end
+
+
+double precision function erf_mu_stg_gauss_int_phi_ij(D_center,gam,delta,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu)
+  BEGIN_DOC
+  ! Computes the following integral : 
+  !
+  ! .. math::
+  ! 
+  !   \int dr exp(-gam(r - D)-delta(r - D)^2) (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !   \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
+  !
+  END_DOC
+
+ implicit none
+  include 'constants.include.F'
+ double precision, intent(in)    :: D_center(3), gam ! pure Slater "D" in r-r_D
+ double precision, intent(in)    :: delta            ! gaussian        in r-r_D
+ double precision, intent(in)    :: C_center(3),mu      ! coulomb center "C" and "mu" in the erf(mu*x)/x function
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3)
+
+ integer :: i
+ double precision :: NAI_pol_mult_erf_gauss_r12
+ double precision :: integral,gama_gauss
+ double precision, allocatable :: expos_slat(:)
+ allocate(expos_slat(n_max_fit_slat))
+ erf_mu_stg_gauss_int_phi_ij = 0.d0
+ call expo_fit_slater_gam(gam,expos_slat)
+ do i = 1, n_max_fit_slat
+  gama_gauss = expos_slat(i) + delta
+  integral = NAI_pol_mult_erf_gauss_r12(D_center,gama_gauss,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu)
+  erf_mu_stg_gauss_int_phi_ij += coef_fit_slat_gauss(i) * integral
+ enddo
+end
+
+double precision function overlap_stg_gauss(D_center,gam,A_center,B_center,power_A,power_B,alpha,beta)
+  BEGIN_DOC
+  ! Computes the following integral : 
+  !
+  ! .. math::
+  ! 
+  !   \int dr exp(-gam (r - D)) (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !
+  END_DOC
+
+ implicit none
+ double precision, intent(in)    :: D_center(3), gam ! pure Slater "D" 
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3)
+ 
+ integer :: i
+ double precision :: expos_slat(n_max_fit_slat),integral,delta
+ double precision :: overlap_gauss_r12
+ overlap_stg_gauss = 0.d0
+ call expo_fit_slater_gam(gam,expos_slat)
+ do i = 1, n_max_fit_slat
+  delta = expos_slat(i) 
+  integral = overlap_gauss_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta)
+  overlap_stg_gauss += coef_fit_slat_gauss(i) * integral
+ enddo
+end
+
+double precision function erf_mu_stg_gauss(D_center,gam,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu)
+  BEGIN_DOC
+  ! Computes the following integral : 
+  !
+  ! .. math::
+  ! 
+  !   \int dr exp(-gam(r - D)) (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !   \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
+  !
+  END_DOC
+
+ implicit none
+  include 'constants.include.F'
+ double precision, intent(in)    :: D_center(3), gam    ! pure Slater "D" 
+ double precision, intent(in)    :: C_center(3),mu      ! coulomb center "C" and "mu" in the erf(mu*x)/x function
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3)
+
+ 
+ integer :: i
+ double precision :: expos_slat(n_max_fit_slat),integral,delta
+ double precision :: NAI_pol_mult_erf_gauss_r12
+ erf_mu_stg_gauss = 0.d0
+ call expo_fit_slater_gam(gam,expos_slat)
+ do i = 1, n_max_fit_slat
+  delta = expos_slat(i) 
+  integral = NAI_pol_mult_erf_gauss_r12(D_center,delta,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu)
+  erf_mu_stg_gauss += coef_fit_slat_gauss(i) * integral
+ enddo
+end

src/ao_many_one_e_ints/taylor_exp.irp.f

@@ -0,0 +1,101 @@
+double precision function exp_dl(x,n)
+ implicit none
+ double precision, intent(in) :: x
+ integer         , intent(in) :: n
+ integer :: i
+ exp_dl = 1.d0
+ do i = 1, n
+  exp_dl += fact_inv(i) * x**dble(i)
+ enddo
+end
+
+subroutine exp_dl_rout(x,n, array)
+ implicit none
+ double precision, intent(in) :: x
+ integer         , intent(in) :: n
+ double precision, intent(out)::  array(0:n)
+ integer :: i
+ double precision :: accu
+ accu = 1.d0
+ array(0) = 1.d0
+ do i = 1, n
+  accu += fact_inv(i) * x**dble(i)
+  array(i) = accu
+ enddo
+end
+
+subroutine exp_dl_ovlp_stg_phi_ij(zeta,D_center,gam,delta,A_center,B_center,power_A,power_B,alpha,beta,n_taylor,array_ints,integral_taylor,exponent_exp)
+  BEGIN_DOC
+  ! Computes the following integrals : 
+  !
+  ! .. math::
+  ! 
+  !   array(i) = \int dr EXP{exponent_exp * [exp(-gam*i (r - D)) exp(-delta*i * (r -D)^2)] (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !
+  !
+  ! and gives back the Taylor expansion of the exponential in integral_taylor
+  END_DOC
+
+ implicit none
+ double precision, intent(in)    :: zeta             ! prefactor of the argument of the exp(-zeta*x)
+ integer, intent(in)             :: n_taylor         ! order of the Taylor expansion of the exponential
+ double precision, intent(in)    :: D_center(3), gam ! pure Slater "D" in r-r_D
+ double precision, intent(in)    :: delta            ! gaussian        in r-r_D
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ double precision, intent(in)    :: exponent_exp
+ integer, intent(in)             :: power_A(3),power_B(3)
+ double precision, intent(out)   :: array_ints(0:n_taylor),integral_taylor
+
+ integer :: i,dim1
+ double precision :: delta_exp,gam_exp,ovlp_stg_gauss_int_phi_ij
+ double precision :: overlap_x,overlap_y,overlap_z,overlap
+ dim1=100
+ call overlap_gaussian_xyz(A_center,B_center,alpha,beta,power_A,power_B,overlap_x,overlap_y,overlap_z,overlap,dim1)
+ array_ints(0) = overlap
+ integral_taylor = array_ints(0)
+ do i = 1, n_taylor
+  delta_exp = dble(i) * delta
+  gam_exp   = dble(i) * gam
+  array_ints(i) = ovlp_stg_gauss_int_phi_ij(D_center,gam_exp,delta_exp,A_center,B_center,power_A,power_B,alpha,beta)
+  integral_taylor += (-zeta*exponent_exp)**dble(i) * fact_inv(i) * array_ints(i)
+ enddo
+
+end
+
+subroutine exp_dl_erf_stg_phi_ij(zeta,D_center,gam,delta,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu,n_taylor,array_ints,integral_taylor)
+  BEGIN_DOC
+  ! Computes the following integrals : 
+  !
+  ! .. math::
+  ! 
+  !   array(i) = \int dr exp(-gam*i (r - D)) exp(-delta*i * (r -D)^2) (x-A_x)^a (x-B_x)^b \exp(-\alpha (x-A_x)^2 - \beta (x-B_x)^2 )
+  !   \frac{\erf(\mu | r - R_C | )}{ | r - R_C | }$.
+  !
+  !
+  ! and gives back the Taylor expansion of the exponential in integral_taylor
+  END_DOC
+
+ implicit none
+ integer, intent(in)             :: n_taylor         ! order of the Taylor expansion of the exponential
+ double precision, intent(in)    :: zeta             ! prefactor of the argument of the exp(-zeta*x)
+ double precision, intent(in)    :: D_center(3), gam ! pure Slater "D" in r-r_D
+ double precision, intent(in)    :: delta            ! gaussian        in r-r_D
+ double precision, intent(in)    :: C_center(3),mu      ! coulomb center "C" and "mu" in the erf(mu*x)/x function
+ double precision, intent(in)    :: A_center(3),B_center(3),alpha,beta ! gaussian/polynoms "A" and "B"
+ integer, intent(in)             :: power_A(3),power_B(3)
+ double precision, intent(out)   :: array_ints(0:n_taylor),integral_taylor
+
+ integer :: i,dim1
+ double precision :: delta_exp,gam_exp,NAI_pol_mult_erf,erf_mu_stg_gauss_int_phi_ij
+ dim1=100
+ 
+ array_ints(0) = NAI_pol_mult_erf(A_center,B_center,power_A,power_B,alpha,beta,C_center,n_pt_max_integrals,mu)
+ integral_taylor = array_ints(0)
+ do i = 1, n_taylor
+  delta_exp = dble(i) * delta
+  gam_exp   = dble(i) * gam
+  array_ints(i) = erf_mu_stg_gauss_int_phi_ij(D_center,gam_exp,delta_exp,A_center,B_center,power_A,power_B,alpha,beta,C_center,mu)
+  integral_taylor += (-zeta)**dble(i) * fact_inv(i) * array_ints(i)
+ enddo
+
+end

src/ao_many_one_e_ints/xyz_grad_xyz_ao_pol.irp.f

@@ -0,0 +1,343 @@
+ BEGIN_PROVIDER [double precision, coef_xyz_ao, (2,3,ao_num)]
+&BEGIN_PROVIDER [integer, power_xyz_ao, (2,3,ao_num)]
+ implicit none
+ BEGIN_DOC
+! coefficient for the basis function :: (x * phi_i(r), y * phi_i(r), * z_phi(r))
+!
+! x * (x - A_x)^a_x = A_x (x - A_x)^a_x + 1 * (x - A_x)^{a_x+1}
+ END_DOC
+ integer :: i,j,k,num_ao,power_ao(1:3)
+ double precision :: center_ao(1:3)
+ do i = 1, ao_num
+  power_ao(1:3)= ao_power(i,1:3) 
+  num_ao = ao_nucl(i)
+  center_ao(1:3) = nucl_coord(num_ao,1:3)
+  do j = 1, 3
+   coef_xyz_ao(1,j,i) = center_ao(j) ! A_x (x - A_x)^a_x
+   power_xyz_ao(1,j,i)= power_ao(j)
+   coef_xyz_ao(2,j,i) = 1.d0         ! 1 * (x - A_x)^a_{x+1}
+   power_xyz_ao(2,j,i)= power_ao(j) + 1
+  enddo
+ enddo
+END_PROVIDER 
+
+ BEGIN_PROVIDER [ double precision, ao_coef_ord_grad_transp, (2,3,ao_prim_num_max,ao_num) ]
+&BEGIN_PROVIDER [ integer, power_ord_grad_transp, (2,3,ao_num) ]
+  implicit none
+  BEGIN_DOC
+  ! grad AO in terms of polynoms and coefficients 
+  ! 
+  ! WARNING !!!! SOME polynoms might be negative !!!!! 
+  !
+  ! WHEN IT IS THE CASE, coefficients are ZERO 
+  END_DOC
+  integer                        :: i,j,power_ao(3), m,kk
+  do j=1, ao_num
+    power_ao(1:3)= ao_power(j,1:3) 
+    do m = 1, 3
+     power_ord_grad_transp(1,m,j) = power_ao(m) - 1
+     power_ord_grad_transp(2,m,j) = power_ao(m) + 1
+    enddo
+    do i=1, ao_prim_num_max
+     do m = 1, 3
+       ao_coef_ord_grad_transp(1,m,i,j) = ao_coef_normalized_ordered(j,i) * dble(power_ao(m)) ! a_x * c_i 
+       ao_coef_ord_grad_transp(2,m,i,j) = -2.d0 * ao_coef_normalized_ordered(j,i) * ao_expo_ordered_transp(i,j) ! -2 * c_i * alpha_i 
+       do kk = 1, 2
+        if(power_ord_grad_transp(kk,m,j).lt.0)then
+         ao_coef_ord_grad_transp(kk,m,i,j) = 0.d0
+        endif
+       enddo
+     enddo
+    enddo
+  enddo
+
+END_PROVIDER
+
+ BEGIN_PROVIDER [ double precision, ao_coef_ord_xyz_grad_transp, (4,3,ao_prim_num_max,ao_num) ]
+&BEGIN_PROVIDER [ integer, power_ord_xyz_grad_transp, (4,3,ao_num) ]
+  implicit none
+  BEGIN_DOC
+  ! x * d/dx of an AO in terms of polynoms and coefficients 
+  !
+  ! WARNING !!!! SOME polynoms might be negative !!!!! 
+  !
+  ! WHEN IT IS THE CASE, coefficients are ZERO 
+  END_DOC
+  integer                        :: i,j,power_ao(3), m,num_ao,kk
+  double precision :: center_ao(1:3)
+  do j=1, ao_num
+   power_ao(1:3)= ao_power(j,1:3) 
+   num_ao = ao_nucl(j)
+   center_ao(1:3) = nucl_coord(num_ao,1:3)
+   do m = 1, 3
+     power_ord_xyz_grad_transp(1,m,j)   = power_ao(m) - 1
+     power_ord_xyz_grad_transp(2,m,j)   = power_ao(m)
+     power_ord_xyz_grad_transp(3,m,j)   = power_ao(m) + 1
+     power_ord_xyz_grad_transp(4,m,j)   = power_ao(m) + 2
+     do kk = 1, 4
+      if(power_ord_xyz_grad_transp(kk,m,j).lt.0)then
+       power_ord_xyz_grad_transp(kk,m,j) = -1
+      endif
+     enddo
+   enddo
+   do i=1, ao_prim_num_max
+    do m = 1, 3
+     ao_coef_ord_xyz_grad_transp(1,m,i,j) = dble(power_ao(m)) * ao_coef_normalized_ordered(j,i) * center_ao(m)
+     ao_coef_ord_xyz_grad_transp(2,m,i,j) = dble(power_ao(m)) * ao_coef_normalized_ordered(j,i) 
+     ao_coef_ord_xyz_grad_transp(3,m,i,j) = -2.d0 * ao_coef_normalized_ordered(j,i) * ao_expo_ordered_transp(i,j) * center_ao(m)
+     ao_coef_ord_xyz_grad_transp(4,m,i,j) = -2.d0 * ao_coef_normalized_ordered(j,i) * ao_expo_ordered_transp(i,j) 
+     do kk = 1, 4
+      if(power_ord_xyz_grad_transp(kk,m,j).lt.0)then
+       ao_coef_ord_xyz_grad_transp(kk,m,i,j) = 0.d0
+      endif
+     enddo
+    enddo
+   enddo
+  enddo
+
+END_PROVIDER
+
+subroutine xyz_grad_phi_ao(r,i_ao,xyz_grad_phi)
+ implicit none
+ integer, intent(in) :: i_ao
+ double precision, intent(in) :: r(3)
+ double precision, intent(out):: xyz_grad_phi(3) ! x * d/dx phi i, y * d/dy phi_i, z * d/dz phi_
+ double precision :: center_ao(3),beta
+ double precision :: accu(3,4),dr(3),r2,pol_usual(3)
+ integer :: m,power_ao(3),num_ao,j_prim
+ power_ao(1:3)= ao_power(i_ao,1:3) 
+ num_ao = ao_nucl(i_ao)
+ center_ao(1:3) = nucl_coord(num_ao,1:3)
+ dr(1) = (r(1) - center_ao(1))
+ dr(2) = (r(2) - center_ao(2))
+ dr(3) = (r(3) - center_ao(3))
+ r2 = 0.d0
+ do m = 1, 3
+  r2 += dr(m)*dr(m)
+ enddo
+ ! computes the gaussian part 
+ accu = 0.d0
+ do j_prim =1,ao_prim_num(i_ao)
+   beta = ao_expo_ordered_transp(j_prim,i_ao)
+   if(dabs(beta*r2).gt.50.d0)cycle
+   do m = 1, 3
+    accu(m,1) += ao_coef_ord_xyz_grad_transp(1,m,j_prim,i_ao) * dexp(-beta*r2) 
+    accu(m,2) += ao_coef_ord_xyz_grad_transp(2,m,j_prim,i_ao) * dexp(-beta*r2) 
+    accu(m,3) += ao_coef_ord_xyz_grad_transp(3,m,j_prim,i_ao) * dexp(-beta*r2) 
+    accu(m,4) += ao_coef_ord_xyz_grad_transp(4,m,j_prim,i_ao) * dexp(-beta*r2) 
+   enddo
+ enddo
+ ! computes the polynom part
+ pol_usual = 0.d0
+ pol_usual(1) = dr(2)**dble(power_ao(2)) * dr(3)**dble(power_ao(3)) 
+ pol_usual(2) = dr(1)**dble(power_ao(1)) * dr(3)**dble(power_ao(3)) 
+ pol_usual(3) = dr(1)**dble(power_ao(1)) * dr(2)**dble(power_ao(2)) 
+
+ xyz_grad_phi = 0.d0
+ do m = 1, 3
+  xyz_grad_phi(m) += accu(m,2) * pol_usual(m) * dr(m)**dble(power_ord_xyz_grad_transp(2,m,i_ao))
+  xyz_grad_phi(m) += accu(m,3) * pol_usual(m) * dr(m)**dble(power_ord_xyz_grad_transp(3,m,i_ao))
+  xyz_grad_phi(m) += accu(m,4) * pol_usual(m) * dr(m)**dble(power_ord_xyz_grad_transp(4,m,i_ao))
+  if(power_ord_xyz_grad_transp(1,m,i_ao).lt.0)cycle
+  xyz_grad_phi(m) += accu(m,1) * pol_usual(m) * dr(m)**dble(power_ord_xyz_grad_transp(1,m,i_ao))
+ enddo
+end
+
+subroutine grad_phi_ao(r,i_ao,grad_xyz_phi)
+ implicit none
+ integer, intent(in) :: i_ao
+ double precision, intent(in) :: r(3)
+ double precision, intent(out):: grad_xyz_phi(3) ! x * phi i, y * phi_i, z * phi_
+ double precision :: center_ao(3),beta
+ double precision :: accu(3,2),dr(3),r2,pol_usual(3)
+ integer :: m,power_ao(3),num_ao,j_prim
+ power_ao(1:3)= ao_power(i_ao,1:3) 
+ num_ao = ao_nucl(i_ao)
+ center_ao(1:3) = nucl_coord(num_ao,1:3)
+ dr(1) = (r(1) - center_ao(1))
+ dr(2) = (r(2) - center_ao(2))
+ dr(3) = (r(3) - center_ao(3))
+ r2 = 0.d0
+ do m = 1, 3
+  r2 += dr(m)*dr(m)
+ enddo
+ ! computes the gaussian part 
+ accu = 0.d0
+ do j_prim =1,ao_prim_num(i_ao)
+   beta = ao_expo_ordered_transp(j_prim,i_ao)
+   if(dabs(beta*r2).gt.50.d0)cycle
+   do m = 1, 3
+    accu(m,1) += ao_coef_ord_grad_transp(1,m,j_prim,i_ao) * dexp(-beta*r2) 
+    accu(m,2) += ao_coef_ord_grad_transp(2,m,j_prim,i_ao) * dexp(-beta*r2) 
+   enddo
+ enddo
+ ! computes the polynom part
+ pol_usual = 0.d0
+ pol_usual(1) = dr(2)**dble(power_ao(2)) * dr(3)**dble(power_ao(3)) 
+ pol_usual(2) = dr(1)**dble(power_ao(1)) * dr(3)**dble(power_ao(3)) 
+ pol_usual(3) = dr(1)**dble(power_ao(1)) * dr(2)**dble(power_ao(2)) 
+ do m = 1, 3
+  grad_xyz_phi(m)  = accu(m,2) * pol_usual(m) * dr(m)**dble(power_ord_grad_transp(2,m,i_ao))
+  if(power_ao(m)==0)cycle
+  grad_xyz_phi(m) += accu(m,1) * pol_usual(m) * dr(m)**dble(power_ord_grad_transp(1,m,i_ao))
+ enddo
+end
+
+subroutine xyz_phi_ao(r,i_ao,xyz_phi)
+ implicit none
+ integer, intent(in) :: i_ao
+ double precision, intent(in) :: r(3)
+ double precision, intent(out):: xyz_phi(3) ! x * phi i, y * phi_i, z * phi_i
+ double precision :: center_ao(3),beta
+ double precision :: accu,dr(3),r2,pol_usual(3)
+ integer :: m,power_ao(3),num_ao
+ power_ao(1:3)= ao_power(i_ao,1:3) 
+ num_ao = ao_nucl(i_ao)
+ center_ao(1:3) = nucl_coord(num_ao,1:3)
+ dr(1) = (r(1) - center_ao(1))
+ dr(2) = (r(2) - center_ao(2))
+ dr(3) = (r(3) - center_ao(3))
+ r2 = 0.d0
+ do m = 1, 3
+  r2 += dr(m)*dr(m)
+ enddo
+ ! computes the gaussian part 
+ accu = 0.d0
+ do m=1,ao_prim_num(i_ao)
+   beta = ao_expo_ordered_transp(m,i_ao)
+   if(dabs(beta*r2).gt.50.d0)cycle
+   accu += ao_coef_normalized_ordered_transp(m,i_ao) * dexp(-beta*r2)
+ enddo
+ ! computes the polynom part
+ pol_usual = 0.d0
+ pol_usual(1) = dr(2)**dble(power_ao(2)) * dr(3)**dble(power_ao(3)) 
+ pol_usual(2) = dr(1)**dble(power_ao(1)) * dr(3)**dble(power_ao(3)) 
+ pol_usual(3) = dr(1)**dble(power_ao(1)) * dr(2)**dble(power_ao(2)) 
+ do m = 1, 3
+  xyz_phi(m) = accu * pol_usual(m) * dr(m)**(dble(power_ao(m))) * ( coef_xyz_ao(1,m,i_ao) + coef_xyz_ao(2,m,i_ao) * dr(m) )
+ enddo
+end
+
+
+subroutine test_pol_xyz
+ implicit none
+ integer :: ipoint,i,j,m,jpoint
+ double precision :: r1(3),derf_mu_x
+ double precision :: weight1,r12,xyz_phi(3),grad_phi(3),xyz_grad_phi(3)
+ double precision, allocatable :: aos_array(:),aos_grad_array(:,:)
+ double precision :: num_xyz_phi(3),num_grad_phi(3),num_xyz_grad_phi(3)
+ double precision :: accu_xyz_phi(3),accu_grad_phi(3),accu_xyz_grad_phi(3)
+ double precision :: meta_accu_xyz_phi(3),meta_accu_grad_phi(3),meta_accu_xyz_grad_phi(3)
+ allocate(aos_array(ao_num),aos_grad_array(3,ao_num))
+ meta_accu_xyz_phi     = 0.d0
+ meta_accu_grad_phi    = 0.d0
+ meta_accu_xyz_grad_phi= 0.d0
+ do i = 1, ao_num
+  accu_xyz_phi     = 0.d0
+  accu_grad_phi    = 0.d0
+  accu_xyz_grad_phi= 0.d0
+
+  do ipoint = 1, n_points_final_grid
+   r1(:) = final_grid_points(:,ipoint)
+   weight1 = final_weight_at_r_vector(ipoint)
+   call give_all_aos_and_grad_at_r(r1,aos_array,aos_grad_array)
+   do m = 1, 3
+    num_xyz_phi(m)      = r1(m) *  aos_array(i)  
+    num_grad_phi(m)     = aos_grad_array(m,i)  
+    num_xyz_grad_phi(m) = r1(m) *  aos_grad_array(m,i) 
+   enddo
+   call xyz_phi_ao(r1,i,xyz_phi)
+   call grad_phi_ao(r1,i,grad_phi)
+   call xyz_grad_phi_ao(r1,i,xyz_grad_phi)
+   do m = 1, 3
+    accu_xyz_phi(m)      += weight1 * dabs(num_xyz_phi(m)      -  xyz_phi(m)     )
+    accu_grad_phi(m)     += weight1 * dabs(num_grad_phi(m)     -  grad_phi(m)    )
+    accu_xyz_grad_phi(m) += weight1 * dabs(num_xyz_grad_phi(m) -  xyz_grad_phi(m))
+   enddo
+  enddo
+  print*,''
+  print*,''
+  print*,'i,',i
+  print*,''
+  do m = 1, 3
+!    print*, 'm, accu_xyz_phi(m)  ' ,m, accu_xyz_phi(m)  
+!    print*, 'm, accu_grad_phi(m) ' ,m, accu_grad_phi(m)         
+    print*, 'm, accu_xyz_grad_phi' ,m, accu_xyz_grad_phi(m)
+  enddo
+  do m = 1, 3
+   meta_accu_xyz_phi(m) += dabs(accu_xyz_phi(m))
+   meta_accu_grad_phi(m) += dabs(accu_grad_phi(m))
+   meta_accu_xyz_grad_phi(m) += dabs(accu_xyz_grad_phi(m))
+  enddo
+ enddo
+  do m = 1, 3
+!    print*, 'm, meta_accu_xyz_phi(m)  ' ,m, meta_accu_xyz_phi(m)  
+!    print*, 'm, meta_accu_grad_phi(m) ' ,m, meta_accu_grad_phi(m)         
+    print*, 'm, meta_accu_xyz_grad_phi' ,m, meta_accu_xyz_grad_phi(m)
+  enddo
+
+
+
+end
+
+subroutine test_ints_semi_bis
+ implicit none
+ integer :: ipoint,i,j,m
+ double precision :: r1(3), aos_grad_array_r1(3, ao_num), aos_array_r1(ao_num)
+ double precision :: C_center(3), weight1,mu_in,r12,derf_mu_x,dxyz_ints(3),NAI_pol_mult_erf_ao
+ double precision :: ao_mat(ao_num,ao_num),ao_xmat(3,ao_num,ao_num),accu1, accu2(3)
+ mu_in = 0.5d0
+ C_center = 0.d0
+ C_center(1) = 0.25d0
+ C_center(3) = 1.12d0
+ C_center(2) = -1.d0
+ ao_mat = 0.d0
+ ao_xmat = 0.d0
+ do ipoint = 1, n_points_final_grid
+  r1(1) = final_grid_points(1,ipoint)
+  r1(2) = final_grid_points(2,ipoint)
+  r1(3) = final_grid_points(3,ipoint)
+  call give_all_aos_and_grad_at_r(r1,aos_array_r1,aos_grad_array_r1)
+  weight1 = final_weight_at_r_vector(ipoint)
+  r12 = (r1(1) - C_center(1))**2.d0 + (r1(2) - C_center(2))**2.d0 + (r1(3) - C_center(3))**2.d0 
+  r12 = dsqrt(r12)
+  do i = 1, ao_num
+   do j = 1, ao_num
+    ao_mat(j,i)  += aos_array_r1(i) * aos_array_r1(j) * weight1 * derf_mu_x(mu_in,r12)
+    do m = 1, 3
+     ao_xmat(m,j,i) += r1(m) * aos_array_r1(j) * aos_grad_array_r1(m,i) * weight1 * derf_mu_x(mu_in,r12)
+    enddo
+   enddo
+  enddo
+ enddo
+
+ accu1 = 0.d0
+ accu2 = 0.d0
+ accu1relat = 0.d0
+ accu2relat = 0.d0
+ double precision :: accu1relat, accu2relat(3)
+ double precision :: contrib(3)
+ do i = 1, ao_num
+  do j = 1, ao_num
+   call phi_j_erf_mu_r_xyz_dxyz_phi(i,j,mu_in, C_center, dxyz_ints)
+   print*,''
+   print*,'i,j',i,j
+   print*,dxyz_ints(:)
+   print*,ao_xmat(:,j,i)
+   do m = 1, 3
+    contrib(m) = dabs(ao_xmat(m,j,i) - dxyz_ints(m))
+    accu2(m) += contrib(m)
+    if(dabs(ao_xmat(m,j,i)).gt.1.d-10)then
+     accu2relat(m) += dabs(ao_xmat(m,j,i) - dxyz_ints(m))/dabs(ao_xmat(m,j,i))
+    endif
+   enddo
+    print*,contrib
+  enddo
+   print*,''
+ enddo
+ print*,'accu2relat = '
+ print*, accu2relat /dble(ao_num * ao_num)
+
+end
+
+

src/ao_tc_eff_map/EZFIO.cfg

@@ -0,0 +1,12 @@
+
+[j1b_gauss_pen]
+type: double precision
+doc: exponents of the 1-body Jastrow
+interface: ezfio
+size: (nuclei.nucl_num)
+
+[j1b_gauss]
+type: integer
+doc: Use 1-body Gaussian Jastrow
+interface: ezfio, provider, ocaml
+default: 0

src/ao_tc_eff_map/NEED

@@ -0,0 +1,4 @@
+ao_two_e_erf_ints
+mo_one_e_ints
+ao_many_one_e_ints
+dft_utils_in_r

src/ao_tc_eff_map/README.rst

@@ -0,0 +1,12 @@
+ao_tc_eff_map
+=============
+
+This is a module to obtain the integrals on the AO basis of the SCALAR HERMITIAN 
+effective potential defined in Eq. 32 of JCP 154, 084119 (2021)
+It also contains the modification by a one-body Jastrow factor.  
+
+The main routine/providers are
+
++) ao_tc_sym_two_e_pot_map : map of the SCALAR PART of total effective two-electron on the AO basis in PHYSICIST notations. It might contain the two-electron term coming from the one-e correlation factor. 
++) get_ao_tc_sym_two_e_pot(i,j,k,l,ao_tc_sym_two_e_pot_map) : routine to get the integrals from ao_tc_sym_two_e_pot_map. 
++) ao_tc_sym_two_e_pot(i,j,k,l) : FUNCTION that returns the scalar part of TC-potential EXCLUDING the erf(mu r12)/r12. See two_e_ints_gauss.irp.f for more details. 

src/ao_tc_eff_map/compute_ints_eff_pot.irp.f

@@ -0,0 +1,75 @@
+subroutine compute_ao_tc_sym_two_e_pot_jl(j, l, n_integrals, buffer_i, buffer_value)
+
+  use map_module
+
+  BEGIN_DOC
+  !  Parallel client for AO integrals of the TC integrals involving purely hermitian operators 
+  END_DOC
+
+  implicit none
+
+  integer, intent(in)             :: j, l
+  integer,intent(out)             :: n_integrals
+  integer(key_kind),intent(out)   :: buffer_i(ao_num*ao_num)
+  real(integral_kind),intent(out) :: buffer_value(ao_num*ao_num)
+
+  integer                         :: i, k
+  integer                         :: kk, m, j1, i1
+  double precision                :: cpu_1, cpu_2, wall_1, wall_2
+  double precision                :: integral, wall_0, integral_pot, integral_erf
+  double precision                :: thr
+
+  logical, external               :: ao_two_e_integral_zero
+  double precision                :: ao_tc_sym_two_e_pot, ao_two_e_integral_erf
+  double precision                :: j1b_gauss_erf, j1b_gauss_coul
+  double precision                :: j1b_gauss_coul_debug
+  double precision                :: j1b_gauss_coul_modifdebug
+  double precision                :: j1b_gauss_coulerf
+
+
+  PROVIDE j1b_gauss
+
+  thr = ao_integrals_threshold
+
+  n_integrals = 0
+
+  j1 = j+ishft(l*l-l,-1)
+  do k = 1, ao_num           ! r1
+    i1 = ishft(k*k-k,-1)
+    if (i1 > j1) then
+      exit
+    endif
+    do i = 1, k
+      i1 += 1
+      if (i1 > j1) then
+        exit
+      endif
+
+      if (ao_two_e_integral_erf_schwartz(i,k)*ao_two_e_integral_erf_schwartz(j,l) < thr ) then
+        cycle
+      endif
+
+      !DIR$ FORCEINLINE
+      integral_pot = ao_tc_sym_two_e_pot  (i, k, j, l)  ! i,k : r1    j,l : r2
+      integral_erf = ao_two_e_integral_erf(i, k, j, l)
+      integral     = integral_erf + integral_pot
+
+      if( j1b_gauss .eq. 1 ) then
+        integral = integral                   & 
+                 + j1b_gauss_coulerf(i, k, j, l)
+      endif
+
+
+      if(abs(integral) < thr) then
+        cycle
+      endif
+
+      n_integrals += 1
+      !DIR$ FORCEINLINE
+      call two_e_integrals_index(i, j, k, l, buffer_i(n_integrals))
+      buffer_value(n_integrals) = integral
+    enddo
+  enddo
+
+end subroutine compute_ao_tc_sym_two_e_pot_jl
+

src/ao_tc_eff_map/integrals_eff_pot_in_map_slave.irp.f

@@ -0,0 +1,194 @@
+subroutine ao_tc_sym_two_e_pot_in_map_slave_tcp(i)
+  implicit none
+  integer, intent(in)            :: i
+  BEGIN_DOC
+! Computes a buffer of integrals. i is the ID of the current thread.
+  END_DOC
+  call ao_tc_sym_two_e_pot_in_map_slave(0,i)
+end
+
+
+subroutine ao_tc_sym_two_e_pot_in_map_slave_inproc(i)
+  implicit none
+  integer, intent(in)            :: i
+  BEGIN_DOC
+! Computes a buffer of integrals. i is the ID of the current thread.
+  END_DOC
+  call ao_tc_sym_two_e_pot_in_map_slave(1,i)
+end
+
+
+
+
+
+subroutine ao_tc_sym_two_e_pot_in_map_slave(thread,iproc)
+  use map_module
+  use f77_zmq
+  implicit none
+  BEGIN_DOC
+! Computes a buffer of integrals
+  END_DOC
+
+  integer, intent(in)            :: thread, iproc
+
+  integer                        :: j,l,n_integrals
+  integer                        :: rc
+  real(integral_kind), allocatable :: buffer_value(:)
+  integer(key_kind), allocatable :: buffer_i(:)
+
+  integer                        :: worker_id, task_id
+  character*(512)                :: task
+
+  integer(ZMQ_PTR),external      :: new_zmq_to_qp_run_socket
+  integer(ZMQ_PTR)               :: zmq_to_qp_run_socket
+
+  integer(ZMQ_PTR), external     :: new_zmq_push_socket
+  integer(ZMQ_PTR)               :: zmq_socket_push
+
+  character*(64)                 :: state
+
+  zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
+
+  integer, external :: connect_to_taskserver
+  if (connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) == -1) then
+    call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
+    return
+  endif
+
+  zmq_socket_push      = new_zmq_push_socket(thread)
+
+  allocate ( buffer_i(ao_num*ao_num), buffer_value(ao_num*ao_num) )
+
+
+  do
+    integer, external :: get_task_from_taskserver
+    if (get_task_from_taskserver(zmq_to_qp_run_socket,worker_id, task_id, task) == -1) then
+      exit
+    endif
+    if (task_id == 0) exit
+    read(task,*) j, l
+    integer, external :: task_done_to_taskserver
+    call compute_ao_tc_sym_two_e_pot_jl(j,l,n_integrals,buffer_i,buffer_value)
+    if (task_done_to_taskserver(zmq_to_qp_run_socket,worker_id,task_id) == -1) then
+        stop 'Unable to send task_done'
+    endif
+    call push_integrals(zmq_socket_push, n_integrals, buffer_i, buffer_value, task_id)
+  enddo
+
+  integer, external :: disconnect_from_taskserver
+  if (disconnect_from_taskserver(zmq_to_qp_run_socket,worker_id) == -1) then
+    continue
+  endif
+  deallocate( buffer_i, buffer_value )
+  call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
+  call end_zmq_push_socket(zmq_socket_push,thread)
+
+end
+
+
+subroutine ao_tc_sym_two_e_pot_in_map_collector(zmq_socket_pull)
+  use map_module
+  use f77_zmq
+  implicit none
+  BEGIN_DOC
+! Collects results from the AO integral calculation
+  END_DOC
+
+  integer(ZMQ_PTR), intent(in)   :: zmq_socket_pull
+  integer                        :: j,l,n_integrals
+  integer                        :: rc
+
+  real(integral_kind), allocatable :: buffer_value(:)
+  integer(key_kind), allocatable :: buffer_i(:)
+
+  integer(ZMQ_PTR),external      :: new_zmq_to_qp_run_socket
+  integer(ZMQ_PTR)               :: zmq_to_qp_run_socket
+
+  integer(ZMQ_PTR), external     :: new_zmq_pull_socket
+
+  integer*8                      :: control, accu, sze
+  integer                        :: task_id, more
+
+  zmq_to_qp_run_socket = new_zmq_to_qp_run_socket()
+
+  sze = ao_num*ao_num
+  allocate ( buffer_i(sze), buffer_value(sze) )
+
+  accu = 0_8
+  more = 1
+  do while (more == 1)
+
+    rc = f77_zmq_recv( zmq_socket_pull, n_integrals, 4, 0)
+    if (rc == -1) then
+      n_integrals = 0
+      return
+    endif
+    if (rc /= 4) then
+      print *, irp_here,  ': f77_zmq_recv( zmq_socket_pull, n_integrals, 4, 0)'
+      stop 'error'
+    endif
+
+    if (n_integrals >= 0) then
+
+      if (n_integrals > sze) then
+        deallocate (buffer_value, buffer_i)
+        sze = n_integrals
+        allocate (buffer_value(sze), buffer_i(sze))
+      endif
+
+      rc = f77_zmq_recv( zmq_socket_pull, buffer_i, key_kind*n_integrals, 0)
+      if (rc /= key_kind*n_integrals) then
+        print *,  rc, key_kind, n_integrals
+        print *, irp_here,  ': f77_zmq_recv( zmq_socket_pull, buffer_i, key_kind*n_integrals, 0)'
+        stop 'error'
+      endif
+
+      rc = f77_zmq_recv( zmq_socket_pull, buffer_value, integral_kind*n_integrals, 0)
+      if (rc /= integral_kind*n_integrals) then
+        print *, irp_here,  ': f77_zmq_recv( zmq_socket_pull, buffer_value, integral_kind*n_integrals, 0)'
+        stop 'error'
+      endif
+
+      rc = f77_zmq_recv( zmq_socket_pull, task_id, 4, 0)
+
+IRP_IF ZMQ_PUSH
+IRP_ELSE
+      rc = f77_zmq_send( zmq_socket_pull, 0, 4, 0)
+      if (rc /= 4) then
+        print *,  irp_here, ' : f77_zmq_send (zmq_socket_pull,...'
+        stop 'error'
+      endif
+IRP_ENDIF
+
+
+      call insert_into_ao_tc_sym_two_e_pot_map(n_integrals,buffer_i,buffer_value)
+      accu += n_integrals
+      if (task_id /= 0) then
+        integer, external :: zmq_delete_task
+        if (zmq_delete_task(zmq_to_qp_run_socket,zmq_socket_pull,task_id,more) == -1) then
+          stop 'Unable to delete task'
+        endif
+      endif
+    endif
+
+  enddo
+
+  deallocate( buffer_i, buffer_value )
+
+  integer (map_size_kind) :: get_ao_tc_sym_two_e_pot_map_size
+  control = get_ao_tc_sym_two_e_pot_map_size(ao_tc_sym_two_e_pot_map)
+
+  if (control /= accu) then
+      print *, ''
+      print *, irp_here
+      print *, 'Control : ', control
+      print *, 'Accu    : ', accu
+      print *, 'Some integrals were lost during the parallel computation.'
+      print *, 'Try to reduce the number of threads.'
+      stop
+  endif
+
+  call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket)
+
+end
+

src/ao_tc_eff_map/j1b_1eInteg.py

@@ -0,0 +1,299 @@
+import sys, os
+QP_PATH=os.environ["QP_EZFIO"]
+sys.path.insert(0,QP_PATH+"/Python/")
+from ezfio import ezfio
+from datetime import datetime
+import time
+from math import exp, sqrt, pi
+import numpy as np
+import subprocess
+from scipy.integrate import tplquad
+import multiprocessing
+from multiprocessing import Pool
+
+
+# _____________________________________________________________________________
+#
+def read_ao():
+
+    with open('ao_data') as f:
+        lines = f.readlines()
+
+    ao_prim_num = np.zeros((ao_num), dtype=int)
+    ao_nucl     = np.zeros((ao_num), dtype=int)
+    ao_power    = np.zeros((ao_num, 3))
+    nucl_coord  = np.zeros((ao_num, 3))
+    ao_expo     = np.zeros((ao_num, ao_num))
+    ao_coef     = np.zeros((ao_num, ao_num))
+
+    iline = 0
+    for j in range(ao_num):
+       
+        line   = lines[iline]
+        iline += 1
+        ao_nucl[j] = int(line) - 1
+
+        line   = lines[iline].split()
+        iline += 1
+        ao_power[j, 0] = float(line[0])
+        ao_power[j, 1] = float(line[1])
+        ao_power[j, 2] = float(line[2])
+
+        line   = lines[iline].split()
+        iline += 1
+        nucl_coord[ao_nucl[j], 0] = float(line[0])
+        nucl_coord[ao_nucl[j], 1] = float(line[1])
+        nucl_coord[ao_nucl[j], 2] = float(line[2])
+
+        line   = lines[iline]
+        iline += 1
+        ao_prim_num[j] = int(line)
+
+        for l in range(ao_prim_num[j]):
+
+            line   = lines[iline].split()
+            iline += 1
+            ao_expo[l, j] = float(line[0])
+            ao_coef[l, j] = float(line[1])
+
+    return( ao_prim_num
+          , ao_nucl
+          , ao_power
+          , nucl_coord 
+          , ao_expo 
+          , ao_coef )
+# _____________________________________________________________________________
+
+
+# _____________________________________________________________________________
+#
+def Gao(X, i_ao):
+
+    ii  = ao_nucl[i_ao]
+    C   = np.array([nucl_coord[ii,0], nucl_coord[ii,1], nucl_coord[ii,2]])
+    Y   = X - C
+    dis = np.dot(Y,Y)
+
+    ip  = np.array([ao_power[i_ao,0], ao_power[i_ao,1], ao_power[i_ao,2]])
+    pol = np.prod(Y**ip)
+
+    xi  = np.sum( ao_coef[:,i_ao] * np.exp(-dis*ao_expo[:,i_ao]) )
+
+    return(xi*pol)
+# _____________________________________________________________________________
+
+
+# _____________________________________________________________________________
+#
+def grad_Gao(X, i_ao):
+
+    ii = ao_nucl[i_ao]
+    C  = np.array([nucl_coord[ii,0], nucl_coord[ii,1], nucl_coord[ii,2]])
+
+    ix = ao_power[i_ao,0]
+    iy = ao_power[i_ao,1]
+    iz = ao_power[i_ao,2]
+
+    Y   = X - C
+    dis = np.dot(Y,Y)
+
+    xm = np.sum(                ao_coef[:,i_ao]*np.exp(-dis*ao_expo[:,i_ao]))
+    xp = np.sum(ao_expo[:,i_ao]*ao_coef[:,i_ao]*np.exp(-dis*ao_expo[:,i_ao]))
+
+    ip  = np.array([ix+1, iy, iz])
+    dx  = -2. * np.prod(Y**ip) * xp 
+    if(ix > 0):
+        ip  = np.array([ix-1, iy, iz])
+        dx += ix * np.prod(Y**ip) * xm
+
+    ip  = np.array([ix, iy+1, iz])
+    dy  = -2. * np.prod(Y**ip) * xp 
+    if(iy > 0):
+        ip  = np.array([ix, iy-1, iz])
+        dy += iy * np.prod(Y**ip) * xm
+
+    ip  = np.array([ix, iy, iz+1])
+    dz  = -2. * np.prod(Y**ip) * xp 
+    if(iz > 0):
+        ip  = np.array([ix, iy, iz-1])
+        dz += iz * np.prod(Y**ip) * xm
+
+    return(np.array([dx, dy, dz]))
+# _____________________________________________________________________________
+
+
+# _____________________________________________________________________________
+#
+#              3 x < XA |       exp[-gama r_C^2] | XB > 
+#            - 2 x < XA | r_A^2 exp[-gama r_C^2] | XB >
+#
+def integ_lap(z, y, x, i_ao, j_ao):
+
+    X = np.array([x, y, z])
+
+    Gi = Gao(X, i_ao)
+    Gj = Gao(X, j_ao)
+
+    c = 0.
+    for k in range(nucl_num):
+        gama = j1b_gauss_pen[k]
+        C    = nucl_coord[k,:]  
+        Y    = X - C
+        dis  = np.dot(Y, Y)
+        arg  = exp(-gama*dis)
+        arg  = exp(-gama*dis)
+        c += ( 3. - 2. * dis * gama ) * arg * gama * Gi * Gj 
+
+    return(c)
+# _____________________________________________________________________________
+
+
+# _____________________________________________________________________________
+#
+#
+def integ_grad2(z, y, x, i_ao, j_ao):
+
+    X = np.array([x, y, z])
+
+    Gi = Gao(X, i_ao)
+    Gj = Gao(X, j_ao)
+
+    c = np.zeros((3))
+    for k in range(nucl_num):
+        gama = j1b_gauss_pen[k]
+        C    = nucl_coord[k,:]  
+        Y    = X - C
+        c   += gama * exp(-gama*np.dot(Y, Y)) * Y
+
+    return(-2*np.dot(c,c)*Gi*Gj)
+# _____________________________________________________________________________
+
+
+# _____________________________________________________________________________
+#
+#
+def integ_nonh(z, y, x, i_ao, j_ao):
+
+    X = np.array([x, y, z])
+
+    Gi = Gao(X, i_ao)
+
+    c = 0.
+    for k in range(nucl_num):
+        gama = j1b_gauss_pen[k]
+        C    = nucl_coord[k,:]  
+        Y    = X - C
+        grad = grad_Gao(X, j_ao)
+        c   += gama * exp(-gama*np.dot(Y,Y)) * np.dot(Y,grad)
+
+    return(2*c*Gi)
+# _____________________________________________________________________________
+
+
+# _____________________________________________________________________________
+#
+def perform_integ( ind_ao ):
+
+    i_ao = ind_ao[0]
+    j_ao = ind_ao[1]
+
+    a      = -15. #-np.Inf
+    b      = +15. #+np.Inf
+    epsrel = 1e-5
+
+    res_lap, err_lap = tplquad( integ_lap
+                              , a, b
+                              , lambda x  : a, lambda x  : b
+                              , lambda x,y: a, lambda x,y: b
+                              , (i_ao, j_ao)
+                              , epsrel=epsrel )
+
+    res_grd, err_grd = tplquad( integ_grad2
+                              , a, b
+                              , lambda x  : a, lambda x  : b
+                              , lambda x,y: a, lambda x,y: b
+                              , (i_ao, j_ao)
+                              , epsrel=epsrel )
+
+    res_nnh, err_nnh = tplquad( integ_nonh
+                              , a, b
+                              , lambda x  : a, lambda x  : b
+                              , lambda x,y: a, lambda x,y: b
+                              , (i_ao, j_ao)
+                              , epsrel=epsrel )
+  
+    return( [ res_lap, err_lap
+            , res_grd, err_grd
+            , res_nnh, err_nnh ])
+# _____________________________________________________________________________
+
+
+# _____________________________________________________________________________
+#
+def integ_eval():
+
+    list_ind = []
+    for i_ao in range(ao_num):
+        for j_ao in range(ao_num):
+            list_ind.append( [i_ao, j_ao] )
+
+    nb_proc = multiprocessing.cpu_count()
+    print(" --- Excexution with {} processors ---\n".format(nb_proc))
+
+    p   = Pool(nb_proc)
+    res = np.array( p.map( perform_integ, list_ind ) )
+
+    ii = 0
+    for i_ao in range(ao_num):
+        for j_ao in range(ao_num):
+            print(" {} {}     {:+e} {:+e}     {:+e} {:+e}".format( i_ao, j_ao
+                 , res[ii][0], res[ii][1], res[ii][2], res[ii][3]) )
+            ii += 1
+
+    p.close()
+# _____________________________________________________________________________
+
+
+
+# _____________________________________________________________________________
+#
+if __name__=="__main__":
+  
+    t0 = time.time()
+
+    EZFIO_file = sys.argv[1]
+    ezfio.set_file(EZFIO_file)
+
+    print(" Today's date:", datetime.now() )
+    print(" EZFIO file = {}".format(EZFIO_file))
+
+    nucl_num      = ezfio.get_nuclei_nucl_num()
+    ao_num        = ezfio.get_ao_basis_ao_num()
+    j1b_gauss_pen = ezfio.get_ao_tc_eff_map_j1b_gauss_pen() 
+
+    ao_prim_num, ao_nucl, ao_power, nucl_coord, ao_expo, ao_coef = read_ao()
+
+    #integ_eval()
+
+    i_ao   = 0 
+    j_ao   = 0
+
+    a      = -5. 
+    b      = +5. 
+    epsrel = 1e-1
+    res_grd, err_grd = tplquad( integ_nonh
+                              , a, b
+                              , lambda x  : a, lambda x  : b
+                              , lambda x,y: a, lambda x,y: b
+                              , (i_ao, j_ao)
+                              , epsrel=epsrel )
+
+    print(res_grd, err_grd)
+ 
+
+    tf = time.time() - t0
+    print(' end after {} min'.format(tf/60.))
+# _____________________________________________________________________________
+
+
+

src/ao_tc_eff_map/j1b_pen.irp.f

@@ -0,0 +1,59 @@
+
+! ---
+
+BEGIN_PROVIDER [ double precision, j1b_gauss_pen, (nucl_num) ]
+
+  BEGIN_DOC
+  ! exponents of the 1-body Jastrow
+  END_DOC
+
+  implicit none
+  logical :: exists
+
+  PROVIDE ezfio_filename
+
+  if (mpi_master) then
+    call ezfio_has_ao_tc_eff_map_j1b_gauss_pen(exists)
+  endif
+
+  IRP_IF MPI_DEBUG
+    print *,  irp_here, mpi_rank
+    call MPI_BARRIER(MPI_COMM_WORLD, ierr)
+  IRP_ENDIF
+
+  IRP_IF MPI
+    include 'mpif.h'
+    integer :: ierr
+    call MPI_BCAST(j1b_gauss_pen, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
+    if (ierr /= MPI_SUCCESS) then
+      stop 'Unable to read j1b_gauss_pen with MPI'
+    endif
+  IRP_ENDIF
+
+  if (exists) then
+
+    if (mpi_master) then
+      write(6,'(A)') '.. >>>>> [ IO READ: j1b_gauss_pen ] <<<<< ..'
+      call ezfio_get_ao_tc_eff_map_j1b_gauss_pen(j1b_gauss_pen)
+      IRP_IF MPI
+        call MPI_BCAST(j1b_gauss_pen, (nucl_num), MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
+        if (ierr /= MPI_SUCCESS) then
+          stop 'Unable to read j1b_gauss_pen with MPI'
+        endif
+      IRP_ENDIF
+    endif
+
+  else
+ 
+    integer :: i
+    do i = 1, nucl_num
+      j1b_gauss_pen(i) = 1d5
+    enddo
+
+  endif
+
+END_PROVIDER
+
+! ---
+
+

src/ao_tc_eff_map/map_integrals_eff_pot.irp.f

@@ -0,0 +1,291 @@
+use map_module
+
+!! AO Map
+!! ======
+
+BEGIN_PROVIDER [ type(map_type), ao_tc_sym_two_e_pot_map ]
+  implicit none
+  BEGIN_DOC
+  ! |AO| integrals
+  END_DOC
+  integer(key_kind)              :: key_max
+  integer(map_size_kind)         :: sze
+  call two_e_integrals_index(ao_num,ao_num,ao_num,ao_num,key_max)
+  sze = key_max
+  call map_init(ao_tc_sym_two_e_pot_map,sze)
+  print*,  'ao_tc_sym_two_e_pot_map map initialized : ', sze
+END_PROVIDER
+
+ BEGIN_PROVIDER [ integer, ao_tc_sym_two_e_pot_cache_min ]
+&BEGIN_PROVIDER [ integer, ao_tc_sym_two_e_pot_cache_max ]
+ implicit none
+ BEGIN_DOC
+ ! Min and max values of the AOs for which the integrals are in the cache
+ END_DOC
+ ao_tc_sym_two_e_pot_cache_min = max(1,ao_num - 63)
+ ao_tc_sym_two_e_pot_cache_max = ao_num
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, ao_tc_sym_two_e_pot_cache, (0:64*64*64*64) ]
+  use map_module
+ implicit none
+ BEGIN_DOC
+ ! Cache of |AO| integrals for fast access
+ END_DOC
+ PROVIDE ao_tc_sym_two_e_pot_in_map
+ integer                        :: i,j,k,l,ii
+ integer(key_kind)              :: idx
+ real(integral_kind)            :: integral
+ !$OMP PARALLEL DO PRIVATE (i,j,k,l,idx,ii,integral)
+ do l=ao_tc_sym_two_e_pot_cache_min,ao_tc_sym_two_e_pot_cache_max
+   do k=ao_tc_sym_two_e_pot_cache_min,ao_tc_sym_two_e_pot_cache_max
+     do j=ao_tc_sym_two_e_pot_cache_min,ao_tc_sym_two_e_pot_cache_max
+       do i=ao_tc_sym_two_e_pot_cache_min,ao_tc_sym_two_e_pot_cache_max
+         !DIR$ FORCEINLINE
+         call two_e_integrals_index(i,j,k,l,idx)
+         !DIR$ FORCEINLINE
+         call map_get(ao_tc_sym_two_e_pot_map,idx,integral)
+         ii = l-ao_tc_sym_two_e_pot_cache_min
+         ii = ior( ishft(ii,6), k-ao_tc_sym_two_e_pot_cache_min)
+         ii = ior( ishft(ii,6), j-ao_tc_sym_two_e_pot_cache_min)
+         ii = ior( ishft(ii,6), i-ao_tc_sym_two_e_pot_cache_min)
+         ao_tc_sym_two_e_pot_cache(ii) = integral
+       enddo
+     enddo
+   enddo
+ enddo
+ !$OMP END PARALLEL DO
+
+END_PROVIDER
+
+
+subroutine insert_into_ao_tc_sym_two_e_pot_map(n_integrals,buffer_i, buffer_values)
+  use map_module
+  implicit none
+  BEGIN_DOC
+  ! Create new entry into |AO| map
+  END_DOC
+
+  integer, intent(in)                :: n_integrals
+  integer(key_kind), intent(inout)   :: buffer_i(n_integrals)
+  real(integral_kind), intent(inout) :: buffer_values(n_integrals)
+
+  call map_append(ao_tc_sym_two_e_pot_map, buffer_i, buffer_values, n_integrals)
+end
+
+double precision function get_ao_tc_sym_two_e_pot(i,j,k,l,map) result(result)
+  use map_module
+  implicit none
+  BEGIN_DOC
+  ! Gets one |AO| two-electron integral from the |AO| map
+  END_DOC
+  integer, intent(in)            :: i,j,k,l
+  integer(key_kind)              :: idx
+  type(map_type), intent(inout)  :: map
+  integer                        :: ii
+  real(integral_kind)            :: tmp
+  logical, external              :: ao_two_e_integral_zero
+  PROVIDE ao_tc_sym_two_e_pot_in_map ao_tc_sym_two_e_pot_cache ao_tc_sym_two_e_pot_cache_min
+  !DIR$ FORCEINLINE
+!  if (ao_two_e_integral_zero(i,j,k,l)) then
+  if (.False.) then
+    tmp = 0.d0
+  !else if (ao_two_e_integral_erf_schwartz(i,k)*ao_two_e_integral_erf_schwartz(j,l) < ao_integrals_threshold) then
+  !  tmp = 0.d0
+  else
+    ii = l-ao_tc_sym_two_e_pot_cache_min
+    ii = ior(ii, k-ao_tc_sym_two_e_pot_cache_min)
+    ii = ior(ii, j-ao_tc_sym_two_e_pot_cache_min)
+    ii = ior(ii, i-ao_tc_sym_two_e_pot_cache_min)
+    if (iand(ii, -64) /= 0) then
+      !DIR$ FORCEINLINE
+      call two_e_integrals_index(i,j,k,l,idx)
+      !DIR$ FORCEINLINE
+      call map_get(map,idx,tmp)
+      tmp = tmp
+    else
+      ii = l-ao_tc_sym_two_e_pot_cache_min
+      ii = ior( ishft(ii,6), k-ao_tc_sym_two_e_pot_cache_min)
+      ii = ior( ishft(ii,6), j-ao_tc_sym_two_e_pot_cache_min)
+      ii = ior( ishft(ii,6), i-ao_tc_sym_two_e_pot_cache_min)
+      tmp = ao_tc_sym_two_e_pot_cache(ii)
+    endif
+  endif
+  result = tmp
+end
+
+
+subroutine get_many_ao_tc_sym_two_e_pot(j,k,l,sze,out_val)
+  use map_module
+  BEGIN_DOC
+  ! Gets multiple |AO| two-electron integral from the |AO| map .
+  ! All i are retrieved for j,k,l fixed.
+  END_DOC
+  implicit none
+  integer, intent(in)            :: j,k,l, sze
+  real(integral_kind), intent(out) :: out_val(sze)
+
+  integer                        :: i
+  integer(key_kind)              :: hash
+  double precision               :: thresh
+! logical, external              :: ao_one_e_integral_zero
+  PROVIDE ao_tc_sym_two_e_pot_in_map ao_tc_sym_two_e_pot_map
+  thresh = ao_integrals_threshold
+
+! if (ao_one_e_integral_zero(j,l)) then
+  if (.False.) then
+    out_val = 0.d0
+    return
+  endif
+
+  double precision :: get_ao_tc_sym_two_e_pot
+  do i=1,sze
+    out_val(i) = get_ao_tc_sym_two_e_pot(i,j,k,l,ao_tc_sym_two_e_pot_map)
+  enddo
+
+end
+
+subroutine get_many_ao_tc_sym_two_e_pot_non_zero(j,k,l,sze,out_val,out_val_index,non_zero_int)
+  use map_module
+  implicit none
+  BEGIN_DOC
+  ! Gets multiple |AO| two-electron integrals from the |AO| map .
+  ! All non-zero i are retrieved for j,k,l fixed.
+  END_DOC
+  integer, intent(in)            :: j,k,l, sze
+  real(integral_kind), intent(out) :: out_val(sze)
+  integer, intent(out)           :: out_val_index(sze),non_zero_int
+
+  integer                        :: i
+  integer(key_kind)              :: hash
+  double precision               :: thresh,tmp
+! logical, external              :: ao_one_e_integral_zero
+  PROVIDE ao_tc_sym_two_e_pot_in_map
+  thresh = ao_integrals_threshold
+
+  non_zero_int = 0
+! if (ao_one_e_integral_zero(j,l)) then
+  if (.False.) then
+    out_val = 0.d0
+    return
+  endif
+
+  non_zero_int = 0
+  do i=1,sze
+    integer, external :: ao_l4
+    double precision, external :: ao_two_e_integral_eff_pot
+    !DIR$ FORCEINLINE
+    !if (ao_two_e_integral_erf_schwartz(i,k)*ao_two_e_integral_erf_schwartz(j,l) < thresh) then
+    !  cycle
+    !endif
+    call two_e_integrals_index(i,j,k,l,hash)
+    call map_get(ao_tc_sym_two_e_pot_map, hash,tmp)
+    if (dabs(tmp) < thresh ) cycle
+    non_zero_int = non_zero_int+1
+    out_val_index(non_zero_int) = i
+    out_val(non_zero_int) = tmp
+  enddo
+
+end
+
+
+function get_ao_tc_sym_two_e_pot_map_size()
+  implicit none
+  integer (map_size_kind) :: get_ao_tc_sym_two_e_pot_map_size
+  BEGIN_DOC
+  ! Returns the number of elements in the |AO| map
+  END_DOC
+  get_ao_tc_sym_two_e_pot_map_size = ao_tc_sym_two_e_pot_map % n_elements
+end
+
+subroutine clear_ao_tc_sym_two_e_pot_map
+  implicit none
+  BEGIN_DOC
+  ! Frees the memory of the |AO| map
+  END_DOC
+  call map_deinit(ao_tc_sym_two_e_pot_map)
+  FREE ao_tc_sym_two_e_pot_map
+end
+
+
+
+subroutine dump_ao_tc_sym_two_e_pot(filename)
+  use map_module
+  implicit none
+  BEGIN_DOC
+  ! Save to disk the |AO| eff_pot integrals
+  END_DOC
+  character*(*), intent(in)      :: filename
+  integer(cache_key_kind), pointer :: key(:)
+  real(integral_kind), pointer   :: val(:)
+  integer*8                      :: i,j, n
+  call ezfio_set_work_empty(.False.)
+  open(unit=66,file=filename,FORM='unformatted')
+  write(66) integral_kind, key_kind
+  write(66) ao_tc_sym_two_e_pot_map%sorted, ao_tc_sym_two_e_pot_map%map_size,    &
+      ao_tc_sym_two_e_pot_map%n_elements
+  do i=0_8,ao_tc_sym_two_e_pot_map%map_size
+    write(66) ao_tc_sym_two_e_pot_map%map(i)%sorted, ao_tc_sym_two_e_pot_map%map(i)%map_size,&
+        ao_tc_sym_two_e_pot_map%map(i)%n_elements
+  enddo
+  do i=0_8,ao_tc_sym_two_e_pot_map%map_size
+    key => ao_tc_sym_two_e_pot_map%map(i)%key
+    val => ao_tc_sym_two_e_pot_map%map(i)%value
+    n = ao_tc_sym_two_e_pot_map%map(i)%n_elements
+    write(66) (key(j), j=1,n), (val(j), j=1,n)
+  enddo
+  close(66)
+
+end
+
+
+
+integer function load_ao_tc_sym_two_e_pot(filename)
+  implicit none
+  BEGIN_DOC
+  ! Read from disk the |AO| eff_pot integrals
+  END_DOC
+  character*(*), intent(in)      :: filename
+  integer*8                      :: i
+  integer(cache_key_kind), pointer :: key(:)
+  real(integral_kind), pointer   :: val(:)
+  integer                        :: iknd, kknd
+  integer*8                      :: n, j
+  load_ao_tc_sym_two_e_pot = 1
+  open(unit=66,file=filename,FORM='unformatted',STATUS='UNKNOWN')
+  read(66,err=98,end=98) iknd, kknd
+  if (iknd /= integral_kind) then
+    print *,  'Wrong integrals kind in file :', iknd
+    stop 1
+  endif
+  if (kknd /= key_kind) then
+    print *,  'Wrong key kind in file :', kknd
+    stop 1
+  endif
+  read(66,err=98,end=98) ao_tc_sym_two_e_pot_map%sorted, ao_tc_sym_two_e_pot_map%map_size,&
+      ao_tc_sym_two_e_pot_map%n_elements
+  do i=0_8, ao_tc_sym_two_e_pot_map%map_size
+    read(66,err=99,end=99) ao_tc_sym_two_e_pot_map%map(i)%sorted,          &
+        ao_tc_sym_two_e_pot_map%map(i)%map_size, ao_tc_sym_two_e_pot_map%map(i)%n_elements
+    call cache_map_reallocate(ao_tc_sym_two_e_pot_map%map(i),ao_tc_sym_two_e_pot_map%map(i)%map_size)
+  enddo
+  do i=0_8, ao_tc_sym_two_e_pot_map%map_size
+    key => ao_tc_sym_two_e_pot_map%map(i)%key
+    val => ao_tc_sym_two_e_pot_map%map(i)%value
+    n = ao_tc_sym_two_e_pot_map%map(i)%n_elements
+    read(66,err=99,end=99) (key(j), j=1,n), (val(j), j=1,n)
+  enddo
+  call map_sort(ao_tc_sym_two_e_pot_map)
+  load_ao_tc_sym_two_e_pot = 0
+  return
+  99 continue
+  call map_deinit(ao_tc_sym_two_e_pot_map)
+  98 continue
+  stop 'Problem reading ao_tc_sym_two_e_pot_map file in work/'
+
+end
+
+
+
+

src/ao_tc_eff_map/one_e_1bgauss_hermit.irp.f

@@ -0,0 +1,519 @@
+
+BEGIN_PROVIDER [ double precision, j1b_gauss_hermII, (ao_num,ao_num)]
+
+  BEGIN_DOC
+  !
+  ! Hermitian part of 1-body Jastrow factow in the |AO| basis set.
+  !
+  !  :math:`\langle \chi_A | -0.5 \grad \tau_{1b} \cdot \grad \tau_{1b} | \chi_B \rangle` 
+  !
+  END_DOC
+
+  implicit none
+
+  integer          :: num_A, num_B
+  integer          :: power_A(3), power_B(3)
+  integer          :: i, j, k1, k2, l, m
+  double precision :: alpha, beta, gama1, gama2
+  double precision :: A_center(3), B_center(3), C_center1(3), C_center2(3)
+  double precision :: c1, c
+
+  integer          :: dim1
+  double precision :: overlap_y, d_a_2, overlap_z, overlap
+
+  double precision :: int_gauss_4G
+
+  PROVIDE j1b_gauss_pen
+
+  ! --------------------------------------------------------------------------------
+  ! -- Dummy call to provide everything
+  dim1        = 100
+  A_center(:) = 0.d0
+  B_center(:) = 1.d0
+  alpha       = 1.d0
+  beta        = 0.1d0
+  power_A(:)  = 1
+  power_B(:)  = 0
+  call overlap_gaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
+                           , overlap_y, d_a_2, overlap_z, overlap, dim1 )
+  ! --------------------------------------------------------------------------------
+  
+
+  j1b_gauss_hermII(1:ao_num,1:ao_num) = 0.d0
+
+ !$OMP PARALLEL                                                 &
+ !$OMP DEFAULT (NONE)                                           &
+ !$OMP PRIVATE (i, j, k1, k2, l, m, alpha, beta, gama1, gama2,  &
+ !$OMP          A_center, B_center, C_center1, C_center2,       &
+ !$OMP          power_A, power_B, num_A, num_B, c1, c)          &
+ !$OMP SHARED (ao_num, ao_prim_num, ao_expo_ordered_transp,     & 
+ !$OMP         ao_power, ao_nucl, nucl_coord,                   &
+ !$OMP         ao_coef_normalized_ordered_transp,               &
+ !$OMP         nucl_num, j1b_gauss_pen, j1b_gauss_hermII)
+
+ !$OMP DO SCHEDULE (dynamic)
+
+  do j = 1, ao_num
+
+    num_A         = ao_nucl(j)
+    power_A(1:3)  = ao_power(j,1:3)
+    A_center(1:3) = nucl_coord(num_A,1:3)
+
+    do i = 1, ao_num
+
+      num_B         = ao_nucl(i)
+      power_B(1:3)  = ao_power(i,1:3)
+      B_center(1:3) = nucl_coord(num_B,1:3)
+
+      do l = 1, ao_prim_num(j)
+        alpha = ao_expo_ordered_transp(l,j)
+
+        do m = 1, ao_prim_num(i)
+          beta = ao_expo_ordered_transp(m,i)
+
+          c = 0.d0
+          do k1 = 1, nucl_num
+            gama1          = j1b_gauss_pen(k1)
+            C_center1(1:3) = nucl_coord(k1,1:3)
+
+            do k2 = 1, nucl_num
+              gama2          = j1b_gauss_pen(k2)
+              C_center2(1:3) = nucl_coord(k2,1:3)
+
+              ! < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] r_C1 \cdot r_C2 | XB >
+              c1 = int_gauss_4G( A_center, B_center, C_center1, C_center2     &
+                               , power_A, power_B, alpha, beta, gama1, gama2  )
+
+              c = c - 2.d0 * gama1 * gama2 * c1
+            enddo
+          enddo
+
+          j1b_gauss_hermII(i,j) = j1b_gauss_hermII(i,j)      & 
+                    + ao_coef_normalized_ordered_transp(l,j) &
+                    * ao_coef_normalized_ordered_transp(m,i) * c
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+END_PROVIDER
+
+
+
+
+
+!_____________________________________________________________________________________________________________
+!
+!               < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] r_C1 \cdot r_C2 | XB >
+!
+double precision function int_gauss_4G( A_center, B_center, C_center1, C_center2, power_A, power_B &
+                                      , alpha, beta, gama1, gama2 )
+
+  ! for max_dim
+  include 'constants.include.F'
+
+  implicit none
+
+  integer         , intent(in) :: power_A(3), power_B(3)
+  double precision, intent(in) :: A_center(3), B_center(3), C_center1(3), C_center2(3)
+  double precision, intent(in) :: alpha, beta, gama1, gama2
+
+  integer                      :: i, dim1, power_C
+  integer                      :: iorder(3)
+  double precision             :: AB_expo, fact_AB, AB_center(3), P_AB(0:max_dim,3)
+  double precision             :: gama, fact_C, C_center(3)
+  double precision             :: cx0, cy0, cz0, c_tmp1, c_tmp2, cx, cy, cz
+  double precision             :: int_tmp
+
+  double precision             :: overlap_gaussian_x
+
+  dim1 = 100
+
+  ! P_AB(0:max_dim,3) polynomial
+  ! AB_center(3)      new center
+  ! AB_expo           new exponent
+  ! fact_AB           constant factor
+  ! iorder(3)         i_order(i) = order of the polynomials
+  call give_explicit_poly_and_gaussian( P_AB, AB_center, AB_expo, fact_AB &
+                                      , iorder, alpha, beta, power_A, power_B, A_center, B_center, dim1)
+
+  call gaussian_product(gama1, C_center1, gama2, C_center2, fact_C, gama, C_center)
+
+  ! <<<
+  ! to avoid multi-evaluation
+  power_C = 0
+
+  cx0 = 0.d0
+  do i = 0, iorder(1)
+    cx0 = cx0 + P_AB(i,1) * overlap_gaussian_x( AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+  enddo
+  cy0 = 0.d0
+  do i = 0, iorder(2)
+    cy0 = cy0 + P_AB(i,2) * overlap_gaussian_x( AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+  enddo
+  cz0 = 0.d0
+  do i = 0, iorder(3)
+    cz0 = cz0 + P_AB(i,3) * overlap_gaussian_x( AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+  enddo
+  ! >>>
+
+  int_tmp = 0.d0
+
+  ! -----------------------------------------------------------------------------------------------
+  !
+  ! x term:
+  !          < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] (x - x_C1) (x - x_C2) | XB > 
+  !
+
+  c_tmp1 = 2.d0 * C_center(1) - C_center1(1) - C_center2(1)
+  c_tmp2 = ( C_center(1) - C_center1(1) ) * ( C_center(1) - C_center2(1) ) 
+
+  cx = 0.d0
+  do i = 0, iorder(1)
+    
+    ! < XA | exp[-gama r_C^2] (x - x_C)^2 | XB >
+    power_C = 2
+    cx      = cx + P_AB(i,1) &
+            * overlap_gaussian_x( AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+
+    ! < XA | exp[-gama r_C^2] (x - x_C) | XB >
+    power_C = 1
+    cx      = cx + P_AB(i,1) * c_tmp1 &
+            * overlap_gaussian_x( AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+
+    ! < XA | exp[-gama r_C^2] | XB >
+    power_C = 0
+    cx      = cx + P_AB(i,1) * c_tmp2 &
+            * overlap_gaussian_x( AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+
+  enddo
+
+  int_tmp += cx * cy0 * cz0
+
+  ! -----------------------------------------------------------------------------------------------
+
+
+  ! -----------------------------------------------------------------------------------------------
+  !
+  ! y term:
+  !          < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] (y - y_C1) (y - y_C2) | XB > 
+  !
+
+  c_tmp1 = 2.d0 * C_center(2) - C_center1(2) - C_center2(2)
+  c_tmp2 = ( C_center(2) - C_center1(2) ) * ( C_center(2) - C_center2(2) ) 
+
+  cy = 0.d0
+  do i = 0, iorder(2)
+    
+    ! < XA | exp[-gama r_C^2] (y - y_C)^2 | XB >
+    power_C = 2
+    cy      = cy + P_AB(i,2) &
+            * overlap_gaussian_x( AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+
+    ! < XA | exp[-gama r_C^2] (y - y_C) | XB >
+    power_C = 1
+    cy      = cy + P_AB(i,2) * c_tmp1 &
+            * overlap_gaussian_x( AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+
+    ! < XA | exp[-gama r_C^2] | XB >
+    power_C = 0
+    cy      = cy + P_AB(i,2) * c_tmp2 &
+            * overlap_gaussian_x( AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+
+  enddo
+
+  int_tmp += cx0 * cy * cz0
+
+  ! -----------------------------------------------------------------------------------------------
+
+
+  ! -----------------------------------------------------------------------------------------------
+  !
+  ! z term:
+  !          < XA | exp[-gama1 r_C1^2 -gama2 r_C2^2] (z - z_C1) (z - z_C2) | XB > 
+  !
+
+  c_tmp1 = 2.d0 * C_center(3) - C_center1(3) - C_center2(3)
+  c_tmp2 = ( C_center(3) - C_center1(3) ) * ( C_center(3) - C_center2(3) ) 
+
+  cz = 0.d0
+  do i = 0, iorder(3)
+    
+    ! < XA | exp[-gama r_C^2] (z - z_C)^2 | XB >
+    power_C = 2
+    cz      = cz + P_AB(i,3) &
+            * overlap_gaussian_x( AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+
+    ! < XA | exp[-gama r_C^2] (z - z_C) | XB >
+    power_C = 1
+    cz      = cz + P_AB(i,3) * c_tmp1 &
+            * overlap_gaussian_x( AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+
+    ! < XA | exp[-gama r_C^2] | XB >
+    power_C = 0
+    cz      = cz + P_AB(i,3) * c_tmp2 &
+            * overlap_gaussian_x( AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+
+  enddo
+
+  int_tmp += cx0 * cy0 * cz
+
+  ! -----------------------------------------------------------------------------------------------
+
+  int_gauss_4G = fact_AB * fact_C * int_tmp
+
+  return
+end function int_gauss_4G
+!_____________________________________________________________________________________________________________
+!_____________________________________________________________________________________________________________
+
+BEGIN_PROVIDER [ double precision, j1b_gauss_hermI, (ao_num,ao_num)]
+
+  BEGIN_DOC
+  !
+  ! Hermitian part of 1-body Jastrow factow in the |AO| basis set.
+  !
+  !  :math:`\langle \chi_A | -0.5 \Delta \tau_{1b} | \chi_B \rangle` 
+  !
+  END_DOC
+
+  implicit none
+
+  integer          :: num_A, num_B
+  integer          :: power_A(3), power_B(3)
+  integer          :: i, j, k, l, m
+  double precision :: alpha, beta, gama
+  double precision :: A_center(3), B_center(3), C_center(3)
+  double precision :: c1, c2, c
+
+  integer          :: dim1
+  double precision :: overlap_y, d_a_2, overlap_z, overlap
+
+  double precision :: int_gauss_r0, int_gauss_r2
+
+  PROVIDE j1b_gauss_pen
+
+  ! --------------------------------------------------------------------------------
+  ! -- Dummy call to provide everything
+  dim1        = 100
+  A_center(:) = 0.d0
+  B_center(:) = 1.d0
+  alpha       = 1.d0
+  beta        = 0.1d0
+  power_A(:)  = 1
+  power_B(:)  = 0
+  call overlap_gaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
+                           , overlap_y, d_a_2, overlap_z, overlap, dim1 )
+  ! --------------------------------------------------------------------------------
+  
+  j1b_gauss_hermI(1:ao_num,1:ao_num) = 0.d0
+
+ !$OMP PARALLEL                                                 &
+ !$OMP DEFAULT (NONE)                                           &
+ !$OMP PRIVATE (i, j, k, l, m, alpha, beta, gama,               &
+ !$OMP          A_center, B_center, C_center, power_A, power_B, &
+ !$OMP          num_A, num_B, c1, c2, c)                        &
+ !$OMP SHARED (ao_num, ao_prim_num, ao_expo_ordered_transp,     & 
+ !$OMP         ao_power, ao_nucl, nucl_coord,                   &
+ !$OMP         ao_coef_normalized_ordered_transp,               &
+ !$OMP         nucl_num, j1b_gauss_pen, j1b_gauss_hermI)
+
+ !$OMP DO SCHEDULE (dynamic)
+
+  do j = 1, ao_num
+
+    num_A         = ao_nucl(j)
+    power_A(1:3)  = ao_power(j,1:3)
+    A_center(1:3) = nucl_coord(num_A,1:3)
+
+    do i = 1, ao_num
+
+      num_B         = ao_nucl(i)
+      power_B(1:3)  = ao_power(i,1:3)
+      B_center(1:3) = nucl_coord(num_B,1:3)
+
+      do l = 1, ao_prim_num(j)
+        alpha = ao_expo_ordered_transp(l,j)
+
+        do m = 1, ao_prim_num(i)
+          beta = ao_expo_ordered_transp(m,i)
+
+          c = 0.d0
+          do k = 1, nucl_num
+
+            gama          = j1b_gauss_pen(k)
+            C_center(1:3) = nucl_coord(k,1:3)
+
+            ! < XA | exp[-gama r_C^2] | XB >
+            c1 = int_gauss_r0( A_center, B_center, C_center        &
+                             , power_A, power_B, alpha, beta, gama )
+
+            ! < XA | r_A^2 exp[-gama r_C^2] | XB >
+            c2 = int_gauss_r2( A_center, B_center, C_center        &
+                             , power_A, power_B, alpha, beta, gama )
+
+            c = c + 3.d0 * gama * c1 - 2.d0 * gama * gama * c2
+          enddo
+
+          j1b_gauss_hermI(i,j) = j1b_gauss_hermI(i,j)      & 
+                  + ao_coef_normalized_ordered_transp(l,j) &
+                  * ao_coef_normalized_ordered_transp(m,i) * c
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+END_PROVIDER
+
+
+!_____________________________________________________________________________________________________________
+!
+!                             < XA | exp[-gama r_C^2] | XB >
+!
+double precision function int_gauss_r0(A_center, B_center, C_center, power_A, power_B, alpha, beta, gama)
+
+  ! for max_dim
+  include 'constants.include.F'
+
+  implicit none
+
+  integer         , intent(in) :: power_A(3), power_B(3)
+  double precision, intent(in) :: A_center(3), B_center(3), C_center(3)
+  double precision, intent(in) :: alpha, beta, gama 
+
+  integer                      :: i, power_C, dim1
+  integer                      :: iorder(3)
+  integer                      :: nmax
+  double precision             :: AB_expo, fact_AB, AB_center(3), P_AB(0:max_dim,3)
+  double precision             :: cx, cy, cz 
+
+  double precision             :: overlap_gaussian_x 
+
+  dim1 = 100
+
+  ! P_AB(0:max_dim,3) polynomial
+  ! AB_center(3)      new center
+  ! AB_expo           new exponent
+  ! fact_AB           constant factor
+  ! iorder(3)         i_order(i) = order of the polynomials
+  call give_explicit_poly_and_gaussian( P_AB, AB_center, AB_expo, fact_AB &
+                                      , iorder, alpha, beta, power_A, power_B, A_center, B_center, dim1)
+
+  if( fact_AB .lt. 1d-20 ) then
+    int_gauss_r0 = 0.d0
+    return
+  endif
+
+  power_C = 0
+  cx = 0.d0
+  do i = 0, iorder(1)
+    cx = cx + P_AB(i,1) * overlap_gaussian_x(AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+  enddo
+  cy = 0.d0
+  do i = 0, iorder(2)
+    cy = cy + P_AB(i,2) * overlap_gaussian_x(AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+  enddo
+  cz = 0.d0
+  do i = 0, iorder(3)
+    cz = cz + P_AB(i,3) * overlap_gaussian_x(AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+  enddo
+
+  int_gauss_r0 = fact_AB * cx * cy * cz
+
+  return
+end function int_gauss_r0 
+!_____________________________________________________________________________________________________________
+!_____________________________________________________________________________________________________________
+
+
+
+!_____________________________________________________________________________________________________________
+!
+!                             < XA | r_C^2 exp[-gama r_C^2] | XB >
+!
+double precision function int_gauss_r2(A_center, B_center, C_center, power_A, power_B, alpha, beta, gama)
+
+  ! for max_dim
+  include 'constants.include.F'
+
+  implicit none
+
+  integer,          intent(in) :: power_A(3), power_B(3)
+  double precision, intent(in) :: A_center(3), B_center(3), C_center(3)
+  double precision, intent(in) :: alpha, beta, gama 
+
+  integer                      :: i, power_C, dim1
+  integer                      :: iorder(3)
+  double precision             :: AB_expo, fact_AB, AB_center(3), P_AB(0:max_dim,3)
+  double precision             :: cx0, cy0, cz0, cx, cy, cz
+  double precision             :: int_tmp
+
+  double precision             :: overlap_gaussian_x
+
+  dim1 = 100
+
+  ! P_AB(0:max_dim,3) polynomial centered on AB_center
+  ! AB_center(3)      new center
+  ! AB_expo           new exponent
+  ! fact_AB           constant factor
+  ! iorder(3)         i_order(i) = order of the polynomials
+  call give_explicit_poly_and_gaussian( P_AB, AB_center, AB_expo, fact_AB &
+                                      , iorder, alpha, beta, power_A, power_B, A_center, B_center, dim1)
+
+  ! <<<
+  ! to avoid multi-evaluation
+  power_C = 0
+
+  cx0 = 0.d0
+  do i = 0, iorder(1)
+    cx0 = cx0 + P_AB(i,1) * overlap_gaussian_x(AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+  enddo
+  cy0 = 0.d0
+  do i = 0, iorder(2)
+    cy0 = cy0 + P_AB(i,2) * overlap_gaussian_x(AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+  enddo
+  cz0 = 0.d0
+  do i = 0, iorder(3)
+    cz0 = cz0 + P_AB(i,3) * overlap_gaussian_x(AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+  enddo
+  ! >>>
+
+  int_tmp = 0.d0
+
+  power_C = 2
+
+  ! ( x - XC)^2
+  cx = 0.d0
+  do i = 0, iorder(1)
+    cx = cx + P_AB(i,1) * overlap_gaussian_x(AB_center(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+  enddo
+  int_tmp += cx * cy0 * cz0
+
+  ! ( y - YC)^2
+  cy = 0.d0
+  do i = 0, iorder(2)
+    cy = cy + P_AB(i,2) * overlap_gaussian_x(AB_center(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+  enddo
+  int_tmp += cx0 * cy * cz0
+
+  ! ( z - ZC)^2
+  cz = 0.d0
+  do i = 0, iorder(3)
+    cz = cz + P_AB(i,3) * overlap_gaussian_x(AB_center(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+  enddo
+  int_tmp += cx0 * cy0 * cz
+
+  int_gauss_r2 = fact_AB * int_tmp
+
+  return
+end function int_gauss_r2
+!_____________________________________________________________________________________________________________
+!_____________________________________________________________________________________________________________

src/ao_tc_eff_map/one_e_1bgauss_nonherm.irp.f

@@ -0,0 +1,319 @@
+BEGIN_PROVIDER [ double precision, j1b_gauss_nonherm, (ao_num,ao_num)]
+
+  BEGIN_DOC
+  !
+  ! Hermitian part of 1-body Jastrow factow in the |AO| basis set.
+  !
+  !              \langle \chi_i | - grad \tau_{1b} \cdot grad | \chi_j \rangle  = 
+  !  2 \sum_A aA \langle \chi_i | exp[-aA riA^2] (ri-rA) \cdot grad | \chi_j \rangle
+  !
+  END_DOC
+
+  implicit none
+
+  integer          :: num_A, num_B
+  integer          :: power_A(3), power_B(3)
+  integer          :: i, j, k, l, m
+  double precision :: alpha, beta, gama
+  double precision :: A_center(3), B_center(3), C_center(3)
+  double precision :: c1, c
+
+  integer          :: dim1
+  double precision :: overlap_y, d_a_2, overlap_z, overlap
+
+  double precision :: int_gauss_deriv
+
+  PROVIDE j1b_gauss_pen
+
+  ! --------------------------------------------------------------------------------
+  ! -- Dummy call to provide everything
+  dim1        = 100
+  A_center(:) = 0.d0
+  B_center(:) = 1.d0
+  alpha       = 1.d0
+  beta        = 0.1d0
+  power_A(:)  = 1
+  power_B(:)  = 0
+  call overlap_gaussian_xyz( A_center, B_center, alpha, beta, power_A, power_B &
+                           , overlap_y, d_a_2, overlap_z, overlap, dim1 )
+  ! --------------------------------------------------------------------------------
+  
+
+  j1b_gauss_nonherm(1:ao_num,1:ao_num) = 0.d0
+
+ !$OMP PARALLEL                                                 &
+ !$OMP DEFAULT (NONE)                                           &
+ !$OMP PRIVATE (i, j, k, l, m, alpha, beta, gama,               &
+ !$OMP          A_center, B_center, C_center, power_A, power_B, &
+ !$OMP          num_A, num_B, c1, c)                            &
+ !$OMP SHARED (ao_num, ao_prim_num, ao_expo_ordered_transp,     & 
+ !$OMP         ao_power, ao_nucl, nucl_coord,                   &
+ !$OMP         ao_coef_normalized_ordered_transp,               &
+ !$OMP         nucl_num, j1b_gauss_pen, j1b_gauss_nonherm)
+
+ !$OMP DO SCHEDULE (dynamic)
+
+  do j = 1, ao_num
+
+    num_A         = ao_nucl(j)
+    power_A(1:3)  = ao_power(j,1:3)
+    A_center(1:3) = nucl_coord(num_A,1:3)
+
+    do i = 1, ao_num
+
+      num_B         = ao_nucl(i)
+      power_B(1:3)  = ao_power(i,1:3)
+      B_center(1:3) = nucl_coord(num_B,1:3)
+
+      do l = 1, ao_prim_num(j)
+        alpha = ao_expo_ordered_transp(l,j)
+
+        do m = 1, ao_prim_num(i)
+          beta = ao_expo_ordered_transp(m,i)
+
+          c = 0.d0
+          do k = 1, nucl_num
+
+            gama          = j1b_gauss_pen(k)
+            C_center(1:3) = nucl_coord(k,1:3)
+
+            !  \langle \chi_A | exp[-gama r_C^2] r_C \cdot grad | \chi_B \rangle
+            c1 = int_gauss_deriv( A_center, B_center, C_center        &
+                                , power_A, power_B, alpha, beta, gama )
+
+            c = c + 2.d0 * gama * c1 
+          enddo
+
+          j1b_gauss_nonherm(i,j) =  j1b_gauss_nonherm(i,j) & 
+                  + ao_coef_normalized_ordered_transp(l,j) &
+                  * ao_coef_normalized_ordered_transp(m,i) * c
+
+        enddo
+      enddo
+    enddo
+  enddo
+
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+END_PROVIDER
+
+
+
+
+
+!_____________________________________________________________________________________________________________
+!
+!                            < XA | exp[-gama r_C^2] r_C \cdot grad | XB >
+!
+double precision function int_gauss_deriv(A_center, B_center, C_center, power_A, power_B, alpha, beta, gama)
+
+  ! for max_dim
+  include 'constants.include.F'
+
+  implicit none
+
+  double precision, intent(in) :: A_center(3), B_center(3), C_center(3)
+  integer         , intent(in) :: power_A(3), power_B(3)
+  double precision, intent(in) :: alpha, beta, gama 
+
+  integer                      :: i, power_C, dim1
+  integer                      :: iorder(3), power_D(3)
+  double precision             :: AB_expo
+  double precision             :: fact_AB, center_AB(3), pol_AB(0:max_dim,3)
+  double precision             :: cx, cy, cz
+
+  double precision             :: overlap_gaussian_x
+
+  dim1 = 100
+
+  int_gauss_deriv = 0.d0
+
+  ! ===============
+  ! term I:
+  !     \partial_x
+  ! ===============
+
+  if( power_B(1) .ge. 1 ) then
+
+    power_D(1) = power_B(1) - 1
+    power_D(2) = power_B(2)
+    power_D(3) = power_B(3)
+
+    call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB &
+                                        , iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1)
+    power_C = 1
+    cx = 0.d0
+    do i = 0, iorder(1)
+      cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+    enddo
+    power_C = 0
+    cy = 0.d0
+    do i = 0, iorder(2)
+      cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+    enddo
+    power_C = 0
+    cz = 0.d0
+    do i = 0, iorder(3)
+      cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+    enddo
+
+    int_gauss_deriv = int_gauss_deriv + fact_AB * dble(power_B(1)) * cx * cy * cz
+  endif
+
+  ! ===============
+
+  power_D(1) = power_B(1) + 1
+  power_D(2) = power_B(2)
+  power_D(3) = power_B(3)
+
+  call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB &
+                                      , iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1)
+  power_C = 1
+  cx = 0.d0
+  do i = 0, iorder(1)
+    cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+  enddo
+  power_C = 0
+  cy = 0.d0
+  do i = 0, iorder(2)
+    cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+  enddo
+  power_C = 0
+  cz = 0.d0
+  do i = 0, iorder(3)
+    cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+  enddo
+
+  int_gauss_deriv = int_gauss_deriv - 2.d0 * beta * fact_AB * cx * cy * cz
+
+  ! ===============
+  ! ===============
+
+
+  ! ===============
+  ! term II:
+  !     \partial_y
+  ! ===============
+
+  if( power_B(2) .ge. 1 ) then
+
+    power_D(1) = power_B(1) 
+    power_D(2) = power_B(2) - 1
+    power_D(3) = power_B(3)
+
+    call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB &
+                                        , iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1)
+    power_C = 0
+    cx = 0.d0
+    do i = 0, iorder(1)
+      cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+    enddo
+    power_C = 1
+    cy = 0.d0
+    do i = 0, iorder(2)
+      cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+    enddo
+    power_C = 0
+    cz = 0.d0
+    do i = 0, iorder(3)
+      cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+    enddo
+
+    int_gauss_deriv = int_gauss_deriv + fact_AB * dble(power_B(2)) * cx * cy * cz
+  endif
+
+  ! ===============
+
+  power_D(1) = power_B(1) 
+  power_D(2) = power_B(2) + 1
+  power_D(3) = power_B(3)
+
+  call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB &
+                                      , iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1)
+  power_C = 0
+  cx = 0.d0
+  do i = 0, iorder(1)
+    cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+  enddo
+  power_C = 1
+  cy = 0.d0
+  do i = 0, iorder(2)
+    cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+  enddo
+  power_C = 0
+  cz = 0.d0
+  do i = 0, iorder(3)
+    cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+  enddo
+
+  int_gauss_deriv = int_gauss_deriv - 2.d0 * beta * fact_AB * cx * cy * cz
+
+  ! ===============
+  ! ===============
+
+  ! ===============
+  ! term III:
+  !     \partial_z
+  ! ===============
+
+  if( power_B(3) .ge. 1 ) then
+
+    power_D(1) = power_B(1) 
+    power_D(2) = power_B(2) 
+    power_D(3) = power_B(3) - 1
+
+    call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB &
+                                        , iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1)
+    power_C = 0
+    cx = 0.d0
+    do i = 0, iorder(1)
+      cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+    enddo
+    power_C = 0
+    cy = 0.d0
+    do i = 0, iorder(2)
+      cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+    enddo
+    power_C = 1
+    cz = 0.d0
+    do i = 0, iorder(3)
+      cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+    enddo
+
+    int_gauss_deriv = int_gauss_deriv + fact_AB * dble(power_B(3)) * cx * cy * cz
+  endif
+
+  ! ===============
+
+  power_D(1) = power_B(1) 
+  power_D(2) = power_B(2)
+  power_D(3) = power_B(3) + 1
+
+  call give_explicit_poly_and_gaussian( pol_AB, center_AB, AB_expo, fact_AB &
+                                      , iorder, alpha, beta, power_A, power_D, A_center, B_center, dim1)
+  power_C = 0
+  cx = 0.d0
+  do i = 0, iorder(1)
+    cx = cx + pol_AB(i,1) * overlap_gaussian_x( center_AB(1), C_center(1), AB_expo, gama, i, power_C, dim1)
+  enddo
+  power_C = 0
+  cy = 0.d0
+  do i = 0, iorder(2)
+    cy = cy + pol_AB(i,2) * overlap_gaussian_x( center_AB(2), C_center(2), AB_expo, gama, i, power_C, dim1)
+  enddo
+  power_C = 1
+  cz = 0.d0
+  do i = 0, iorder(3)
+    cz = cz + pol_AB(i,3) * overlap_gaussian_x( center_AB(3), C_center(3), AB_expo, gama, i, power_C, dim1)
+  enddo
+
+  int_gauss_deriv = int_gauss_deriv - 2.d0 * beta * fact_AB * cx * cy * cz
+
+  ! ===============
+  ! ===============
+
+  return
+end function int_gauss_deriv
+!_____________________________________________________________________________________________________________
+!_____________________________________________________________________________________________________________

src/ao_tc_eff_map/potential.irp.f

@@ -0,0 +1,203 @@
+BEGIN_PROVIDER [integer, n_gauss_eff_pot]
+ implicit none
+ BEGIN_DOC
+! number of gaussians to represent the effective potential :
+!
+! V(mu,r12) = -0.25 * (1 - erf(mu*r12))^2 + 1/(\sqrt(pi)mu) * exp(-(mu*r12)^2)
+!
+! Here (1 - erf(mu*r12))^2 is expanded in Gaussians as Eqs A11-A20 in JCP 154, 084119 (2021)
+ END_DOC
+ n_gauss_eff_pot = n_max_fit_slat + 1
+END_PROVIDER 
+
+BEGIN_PROVIDER [integer, n_gauss_eff_pot_deriv]
+ implicit none
+ BEGIN_DOC
+! V(r12) = -(1 - erf(mu*r12))^2 is expanded in Gaussians as Eqs A11-A20 in JCP 154, 084119 (2021)
+ END_DOC
+ n_gauss_eff_pot_deriv = n_max_fit_slat 
+END_PROVIDER 
+
+ BEGIN_PROVIDER [double precision, expo_gauss_eff_pot, (n_gauss_eff_pot)]
+&BEGIN_PROVIDER [double precision, coef_gauss_eff_pot, (n_gauss_eff_pot)]
+ implicit none
+ BEGIN_DOC
+! Coefficients and exponents of the Fit on Gaussians of V(X) = -(1 - erf(mu*X))^2 + 1/(\sqrt(pi)mu) * exp(-(mu*X)^2)
+!
+! V(X) = \sum_{i=1,n_gauss_eff_pot} coef_gauss_eff_pot(i) * exp(-expo_gauss_eff_pot(i) * X^2)
+!
+! Relies on the fit proposed in Eqs A11-A20 in JCP 154, 084119 (2021)
+ END_DOC
+ include 'constants.include.F'
+
+ integer :: i
+ ! fit of the -0.25 * (1 - erf(mu*x))^2 with n_max_fit_slat gaussians 
+ do i = 1, n_max_fit_slat
+  expo_gauss_eff_pot(i) = expo_gauss_1_erf_x_2(i) 
+  coef_gauss_eff_pot(i) = -0.25d0 * coef_gauss_1_erf_x_2(i) ! -1/4 * (1 - erf(mu*x))^2
+ enddo
+ ! Analytical Gaussian part of the potential: + 1/(\sqrt(pi)mu) * exp(-(mu*x)^2) 
+ expo_gauss_eff_pot(n_max_fit_slat+1) = mu_erf * mu_erf
+ coef_gauss_eff_pot(n_max_fit_slat+1) =  1.d0 * mu_erf * inv_sq_pi
+
+END_PROVIDER 
+
+
+double precision function eff_pot_gauss(x,mu)
+ implicit none
+ BEGIN_DOC
+ ! V(mu,r12) = -0.25 * (1 - erf(mu*r12))^2 + 1/(\sqrt(pi)mu) * exp(-(mu*r12)^2)
+ END_DOC
+ double precision, intent(in) :: x,mu
+ eff_pot_gauss =  mu/dsqrt(dacos(-1.d0)) * dexp(-mu*mu*x*x) - 0.25d0 * (1.d0 - derf(mu*x))**2.d0
+end
+
+
+
+! -------------------------------------------------------------------------------------------------
+! ---
+
+double precision function eff_pot_fit_gauss(x)
+ implicit none
+ BEGIN_DOC
+ ! V(mu,r12) = -0.25 * (1 - erf(mu*r12))^2 + 1/(\sqrt(pi)mu) * exp(-(mu*r12)^2) 
+ ! 
+ ! but fitted with gaussians 
+ END_DOC
+ double precision, intent(in) :: x
+ integer :: i
+ double precision :: alpha
+ eff_pot_fit_gauss = derf(mu_erf*x)/x
+ do i = 1, n_gauss_eff_pot
+  alpha = expo_gauss_eff_pot(i)
+  eff_pot_fit_gauss += coef_gauss_eff_pot(i) * dexp(-alpha*x*x)
+ enddo
+end
+
+BEGIN_PROVIDER [integer, n_fit_1_erf_x]
+ implicit none
+ BEGIN_DOC
+! 
+ END_DOC
+ n_fit_1_erf_x = 2
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [double precision, expos_slat_gauss_1_erf_x, (n_fit_1_erf_x)]
+ implicit none
+ BEGIN_DOC
+! 1 - erf(mu*x) is fitted with a Slater and gaussian as in Eq.A15 of  JCP 154, 084119 (2021)
+!
+! 1 - erf(mu*x) = e^{-expos_slat_gauss_1_erf_x(1) * mu *x} * e^{-expos_slat_gauss_1_erf_x(2) * mu^2 * x^2}
+ END_DOC
+ expos_slat_gauss_1_erf_x(1) = 1.09529d0
+ expos_slat_gauss_1_erf_x(2) = 0.756023d0
+END_PROVIDER 
+
+ BEGIN_PROVIDER [double precision, expo_gauss_1_erf_x, (n_max_fit_slat)]
+&BEGIN_PROVIDER [double precision, coef_gauss_1_erf_x, (n_max_fit_slat)]
+ implicit none
+ BEGIN_DOC
+! (1 - erf(mu*x)) = \sum_i coef_gauss_1_erf_x(i) * exp(-expo_gauss_1_erf_x(i) * x^2)
+!
+! This is based on a fit of (1 - erf(mu*x)) by exp(-alpha * x) exp(-beta*mu^2x^2) 
+!
+! and the slater function exp(-alpha * x) is fitted with n_max_fit_slat gaussians 
+!
+! See Appendix 2 of JCP 154, 084119 (2021)
+ END_DOC
+ integer :: i
+ double precision :: expos(n_max_fit_slat),alpha,beta
+ alpha = expos_slat_gauss_1_erf_x(1) * mu_erf
+ call expo_fit_slater_gam(alpha,expos)
+ beta = expos_slat_gauss_1_erf_x(2) * mu_erf**2.d0
+ 
+ do i = 1, n_max_fit_slat
+  expo_gauss_1_erf_x(i) = expos(i) + beta
+  coef_gauss_1_erf_x(i) = coef_fit_slat_gauss(i)
+ enddo
+END_PROVIDER 
+
+double precision function fit_1_erf_x(x)
+ implicit none
+ double precision, intent(in) :: x
+ BEGIN_DOC
+! fit_1_erf_x(x) = \sum_i c_i exp (-alpha_i x^2) \approx (1 - erf(mu*x))
+ END_DOC
+ integer :: i
+ fit_1_erf_x = 0.d0
+ do i = 1, n_max_fit_slat
+  fit_1_erf_x += dexp(-expo_gauss_1_erf_x(i) *x*x) * coef_gauss_1_erf_x(i)
+ enddo
+
+end
+
+ BEGIN_PROVIDER [double precision, expo_gauss_1_erf_x_2, (n_max_fit_slat)]
+&BEGIN_PROVIDER [double precision, coef_gauss_1_erf_x_2, (n_max_fit_slat)]
+ implicit none
+ BEGIN_DOC
+! (1 - erf(mu*x))^2 = \sum_i coef_gauss_1_erf_x_2(i) * exp(-expo_gauss_1_erf_x_2(i) * x^2)
+!
+! This is based on a fit of (1 - erf(mu*x)) by exp(-alpha * x) exp(-beta*mu^2x^2)
+!
+! and the slater function exp(-alpha * x) is fitted with n_max_fit_slat gaussians 
+ END_DOC
+ integer :: i
+ double precision :: expos(n_max_fit_slat),alpha,beta
+ alpha = 2.d0 * expos_slat_gauss_1_erf_x(1) * mu_erf
+ call expo_fit_slater_gam(alpha,expos)
+ beta = 2.d0 * expos_slat_gauss_1_erf_x(2) * mu_erf**2.d0
+ do i = 1, n_max_fit_slat
+  expo_gauss_1_erf_x_2(i) = expos(i) + beta
+  coef_gauss_1_erf_x_2(i) = coef_fit_slat_gauss(i)
+ enddo
+END_PROVIDER 
+
+double precision function fit_1_erf_x_2(x)
+ implicit none
+ double precision, intent(in) :: x
+ BEGIN_DOC
+! fit_1_erf_x_2(x) = \sum_i c_i exp (-alpha_i x^2) \approx (1 - erf(mu*x))^2
+ END_DOC
+ integer :: i
+ fit_1_erf_x_2 = 0.d0
+ do i = 1, n_max_fit_slat
+  fit_1_erf_x_2 += dexp(-expo_gauss_1_erf_x_2(i) *x*x) * coef_gauss_1_erf_x_2(i)
+ enddo
+
+end
+
+subroutine inv_r_times_poly(r, dist_r, dist_vec, poly)
+ implicit none
+ BEGIN_DOC
+! returns 
+!
+! poly(1) = x / sqrt(x^2+y^2+z^2), poly(2) = y / sqrt(x^2+y^2+z^2), poly(3) = z / sqrt(x^2+y^2+z^2)
+!
+! with the arguments  
+!
+! r(1)  = x, r(2) = y, r(3) = z, dist_r = sqrt(x^2+y^2+z^2)
+!
+! dist_vec(1) = sqrt(y^2+z^2), dist_vec(2) = sqrt(x^2+z^2), dist_vec(3) = sqrt(x^2+y^2)
+ END_DOC
+ double precision, intent(in) :: r(3), dist_r, dist_vec(3)
+ double precision, intent(out):: poly(3)
+ double precision :: inv_dist
+ integer :: i
+ if (dist_r.gt. 1.d-8)then
+  inv_dist = 1.d0/dist_r
+  do i = 1, 3
+   poly(i) = r(i) * inv_dist 
+  enddo
+ else
+  do i = 1, 3
+   if(dabs(r(i)).lt.dist_vec(i))then
+    inv_dist = 1.d0/dist_r
+    poly(i) = r(i) * inv_dist 
+   else !if(dabs(r(i)))then
+    poly(i) = 1.d0 
+!    poly(i) = 0.d0 
+   endif
+  enddo
+ endif
+end                      

src/ao_tc_eff_map/providers_ao_eff_pot.irp.f

@@ -0,0 +1,86 @@
+
+BEGIN_PROVIDER [ logical, ao_tc_sym_two_e_pot_in_map ]
+  implicit none
+  use f77_zmq
+  use map_module
+  BEGIN_DOC
+  !  Map of Atomic integrals
+  !     i(r1) j(r2) 1/r12 k(r1) l(r2)
+  END_DOC
+
+  integer                        :: i,j,k,l
+  double precision               :: ao_tc_sym_two_e_pot,cpu_1,cpu_2, wall_1, wall_2
+  double precision               :: integral, wall_0
+  include 'utils/constants.include.F'
+
+  ! For integrals file
+  integer(key_kind),allocatable  :: buffer_i(:)
+  integer,parameter              :: size_buffer = 1024*64
+  real(integral_kind),allocatable :: buffer_value(:)
+
+  integer                        :: n_integrals, rc
+  integer                        :: kk, m, j1, i1, lmax
+  character*(64)                 :: fmt
+
+  !double precision               :: j1b_gauss_coul_debug
+  !integral = j1b_gauss_coul_debug(1,1,1,1)
+
+  integral = ao_tc_sym_two_e_pot(1,1,1,1)
+
+  double precision               :: map_mb
+
+  print*, 'Providing the ao_tc_sym_two_e_pot_map integrals'
+  call wall_time(wall_0)
+  call wall_time(wall_1)
+  call cpu_time(cpu_1)
+
+  integer(ZMQ_PTR) :: zmq_to_qp_run_socket, zmq_socket_pull
+  call new_parallel_job(zmq_to_qp_run_socket,zmq_socket_pull,'ao_tc_sym_two_e_pot')
+
+  character(len=:), allocatable :: task
+  allocate(character(len=ao_num*12) :: task)
+  write(fmt,*) '(', ao_num, '(I5,X,I5,''|''))'
+  do l=1,ao_num
+    write(task,fmt) (i,l, i=1,l)
+    integer, external :: add_task_to_taskserver
+    if (add_task_to_taskserver(zmq_to_qp_run_socket,trim(task)) == -1) then
+      stop 'Unable to add task to server'
+    endif
+  enddo
+  deallocate(task)
+
+  integer, external :: zmq_set_running
+  if (zmq_set_running(zmq_to_qp_run_socket) == -1) then
+    print *,  irp_here, ': Failed in zmq_set_running'
+  endif
+
+  PROVIDE nproc
+  !$OMP PARALLEL DEFAULT(shared) private(i) num_threads(nproc+1)
+      i = omp_get_thread_num()
+      if (i==0) then
+        call ao_tc_sym_two_e_pot_in_map_collector(zmq_socket_pull)
+      else
+        call ao_tc_sym_two_e_pot_in_map_slave_inproc(i)
+      endif
+  !$OMP END PARALLEL
+
+  call end_parallel_job(zmq_to_qp_run_socket, zmq_socket_pull, 'ao_tc_sym_two_e_pot')
+
+
+  print*, 'Sorting the map'
+  call map_sort(ao_tc_sym_two_e_pot_map)
+  call cpu_time(cpu_2)
+  call wall_time(wall_2)
+  integer(map_size_kind)         :: get_ao_tc_sym_two_e_pot_map_size, ao_eff_pot_map_size
+  ao_eff_pot_map_size = get_ao_tc_sym_two_e_pot_map_size()
+
+  print*, 'AO eff_pot integrals provided:'
+  print*, ' Size of AO eff_pot map :         ', map_mb(ao_tc_sym_two_e_pot_map) ,'MB'
+  print*, ' Number of AO eff_pot integrals :', ao_eff_pot_map_size
+  print*, ' cpu  time :',cpu_2 - cpu_1, 's'
+  print*, ' wall time :',wall_2 - wall_1, 's  ( x ', (cpu_2-cpu_1)/(wall_2-wall_1+tiny(1.d0)), ' )'
+
+  ao_tc_sym_two_e_pot_in_map = .True.
+
+
+END_PROVIDER

src/ao_tc_eff_map/two_e_1bgauss_coul.irp.f

@@ -0,0 +1,800 @@
+double precision function j1b_gauss_coul(i, j, k, l)
+
+  BEGIN_DOC
+  ! 
+  !  integral in the AO basis:
+  !     i(r1) j(r1) f(r12) k(r2) l(r2)
+  !
+  !  with:
+  !     f(r12) = - [ 0.5 / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ]
+  !            = [ 1 / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
+  !                                     + (r2-RA)^2 exp(-aA r2A^2) 
+  !                                     - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) 
+  !                                     - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
+  !
+  END_DOC
+
+  include 'utils/constants.include.F'
+
+  implicit none
+
+  integer, intent(in) :: i, j, k, l
+
+  integer             :: p, q, r, s, ii
+  integer             :: num_i, num_j, num_k, num_l, num_ii 
+  integer             :: I_power(3), J_power(3), K_power(3), L_power(3)
+  integer             :: iorder_p(3), iorder_q(3)
+  integer             :: shift_P(3), shift_Q(3)
+  integer             :: dim1
+
+  double precision    :: coef1, coef2, coef3, coef4
+  double precision    :: expo1, expo2, expo3, expo4
+  double precision    :: p_inv, q_inv
+  double precision    :: P_new_tmp(0:max_dim,3), P_center_tmp(3), fact_p_tmp, pp_tmp
+  double precision    :: Q_new_tmp(0:max_dim,3), Q_center_tmp(3), fact_q_tmp, qq_tmp
+  double precision    :: P_new(0:max_dim,3), P_center(3), fact_p, pp
+  double precision    :: Q_new(0:max_dim,3), Q_center(3), fact_q, qq
+  double precision    :: I_center(3), J_center(3), K_center(3), L_center(3)
+  double precision    :: expoii, factii, Centerii(3)
+  double precision    :: ff, gg, cx, cy, cz
+
+  double precision    :: general_primitive_integral_coul_shifted
+  
+  PROVIDE j1b_gauss_pen
+
+  dim1 = n_pt_max_integrals
+
+  num_i = ao_nucl(i)
+  num_j = ao_nucl(j)
+  num_k = ao_nucl(k)
+  num_l = ao_nucl(l)
+
+  do p = 1, 3
+    I_power(p)  = ao_power(i,p)
+    J_power(p)  = ao_power(j,p)
+    K_power(p)  = ao_power(k,p)
+    L_power(p)  = ao_power(l,p)
+    I_center(p) = nucl_coord(num_i,p)
+    J_center(p) = nucl_coord(num_j,p)
+    K_center(p) = nucl_coord(num_k,p)
+    L_center(p) = nucl_coord(num_l,p)
+  enddo
+
+  j1b_gauss_coul = 0.d0
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  !
+  !                               [ 1 / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
+  !
+  ! -------------------------------------------------------------------------------------------------------------------
+
+  shift_Q = (/ 0, 0, 0 /)
+ 
+  do p = 1, ao_prim_num(i)
+    coef1 = ao_coef_normalized_ordered_transp(p, i)
+    expo1 = ao_expo_ordered_transp(p, i)
+
+    do q = 1, ao_prim_num(j)
+      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+      expo2 = ao_expo_ordered_transp(q, j)
+
+      call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 &
+                                          , I_power, J_power, I_center, J_center, dim1                          )
+
+      do r = 1, ao_prim_num(k)
+        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+        expo3 = ao_expo_ordered_transp(r, k)
+
+        do s = 1, ao_prim_num(l)
+          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+          expo4 = ao_expo_ordered_transp(s, l)
+ 
+          call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 &
+                                              , K_power, L_power, K_center, L_center, dim1          )
+          q_inv = 1.d0 / qq
+
+          cx = 0.d0
+          cy = 0.d0
+          cz = 0.d0
+          do ii = 1, nucl_num
+            expoii        = j1b_gauss_pen(ii)
+            Centerii(1:3) = nucl_coord(ii, 1:3)
+
+            call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center)
+
+            fact_p = fact_p_tmp * factii
+            p_inv  = 1.d0 / pp
+
+            ! pol centerd on P_center_tmp ==> centerd on P_center
+            call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new)
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! x term:
+
+            ff = P_center(1) - Centerii(1) 
+
+            shift_P = (/ 2, 0, 0 /)
+            cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_P = (/ 1, 0, 0 /)
+            cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P             &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q             )
+
+            shift_P = (/ 0, 0, 0 /)
+            cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! y term:
+
+            ff = P_center(2) - Centerii(2) 
+
+            shift_P = (/ 0, 2, 0 /)
+            cy = cy + expoii * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_P = (/ 0, 1, 0 /)
+            cy = cy + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P             &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q             )
+
+            shift_P = (/ 0, 0, 0 /)
+            cy = cy + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! z term:
+
+            ff = P_center(3) - Centerii(3) 
+
+            shift_P = (/ 0, 0, 2 /)
+            cz = cz + expoii * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_P = (/ 0, 0, 1 /)
+            cz = cz + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P             &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q             )
+
+            shift_P = (/ 0, 0, 0 /)
+            cz = cz + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+          enddo
+
+          j1b_gauss_coul = j1b_gauss_coul + coef4 * ( cx + cy + cz )
+        enddo ! s
+      enddo  ! r
+    enddo   ! q
+  enddo    ! p
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  ! -------------------------------------------------------------------------------------------------------------------
+
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  !
+  !                               [ 1 / r12 ] \sum_A a_A [ (r2-RA)^2 exp(-aA r2A^2)
+  !
+  ! -------------------------------------------------------------------------------------------------------------------
+
+  shift_P = (/ 0, 0, 0 /)
+ 
+  do p = 1, ao_prim_num(i)
+    coef1 = ao_coef_normalized_ordered_transp(p, i)
+    expo1 = ao_expo_ordered_transp(p, i)
+
+    do q = 1, ao_prim_num(j)
+      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+      expo2 = ao_expo_ordered_transp(q, j)
+
+      call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 &
+                                          , I_power, J_power, I_center, J_center, dim1          )
+      p_inv = 1.d0 / pp
+
+      do r = 1, ao_prim_num(k)
+        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+        expo3 = ao_expo_ordered_transp(r, k)
+
+        do s = 1, ao_prim_num(l)
+          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+          expo4 = ao_expo_ordered_transp(s, l)
+ 
+          call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 &
+                                              , K_power, L_power, K_center, L_center, dim1                          )
+
+          cx = 0.d0
+          cy = 0.d0
+          cz = 0.d0
+          do ii = 1, nucl_num
+            expoii        = j1b_gauss_pen(ii)
+            Centerii(1:3) = nucl_coord(ii, 1:3)
+
+            call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center)
+
+            fact_q = fact_q_tmp * factii
+            q_inv  = 1.d0 / qq
+
+            ! pol centerd on Q_center_tmp ==> centerd on Q_center
+            call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new)
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! x term:
+
+            ff = Q_center(1) - Centerii(1) 
+
+            shift_Q = (/ 2, 0, 0 /)
+            cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_Q = (/ 1, 0, 0 /)
+            cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P             &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q             )
+
+            shift_Q = (/ 0, 0, 0 /)
+            cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! y term:
+
+            ff = Q_center(2) - Centerii(2) 
+
+            shift_Q = (/ 0, 2, 0 /)
+            cy = cy + expoii * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_Q = (/ 0, 1, 0 /)
+            cy = cy + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P             &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q             )
+
+            shift_Q = (/ 0, 0, 0 /)
+            cy = cy + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! z term:
+
+            ff = Q_center(3) - Centerii(3) 
+
+            shift_Q = (/ 0, 0, 2 /)
+            cz = cz + expoii * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_Q = (/ 0, 0, 1 /)
+            cz = cz + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P             &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q             )
+
+            shift_Q = (/ 0, 0, 0 /)
+            cz = cz + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+          enddo
+
+          j1b_gauss_coul = j1b_gauss_coul + coef4 * ( cx + cy + cz )
+        enddo ! s
+      enddo  ! r
+    enddo   ! q
+  enddo    ! p
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  ! -------------------------------------------------------------------------------------------------------------------
+
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  !
+  !                          - [ 1 / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) ]
+  !
+  ! -------------------------------------------------------------------------------------------------------------------
+ 
+  do p = 1, ao_prim_num(i)
+    coef1 = ao_coef_normalized_ordered_transp(p, i)
+    expo1 = ao_expo_ordered_transp(p, i)
+
+    do q = 1, ao_prim_num(j)
+      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+      expo2 = ao_expo_ordered_transp(q, j)
+
+      call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 &
+                                          , I_power, J_power, I_center, J_center, dim1                          )
+
+      do r = 1, ao_prim_num(k)
+        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+        expo3 = ao_expo_ordered_transp(r, k)
+
+        do s = 1, ao_prim_num(l)
+          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+          expo4 = ao_expo_ordered_transp(s, l)
+ 
+          call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 &
+                                              , K_power, L_power, K_center, L_center, dim1          )
+          q_inv = 1.d0 / qq
+
+          cx = 0.d0
+          cy = 0.d0
+          cz = 0.d0
+          do ii = 1, nucl_num
+            expoii        = j1b_gauss_pen(ii)
+            Centerii(1:3) = nucl_coord(ii, 1:3)
+
+            call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center)
+
+            fact_p = fact_p_tmp * factii
+            p_inv  = 1.d0 / pp
+
+            ! pol centerd on P_center_tmp ==> centerd on P_center
+            call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new)
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! x term:
+
+            ff = P_center(1) - Centerii(1) 
+            gg = Q_center(1) - Centerii(1) 
+
+            shift_p = (/ 1, 0, 0 /)
+            shift_Q = (/ 1, 0, 0 /)
+            cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 1, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cx = cx + expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 1, 0, 0 /)
+            cx = cx + expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cx = cx + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! y term:
+
+            ff = P_center(2) - Centerii(2) 
+            gg = Q_center(2) - Centerii(2) 
+
+            shift_p = (/ 0, 1, 0 /)
+            shift_Q = (/ 0, 1, 0 /)
+            cy = cy + expoii * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 1, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cy = cy + expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 1, 0 /)
+            cy = cy + expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cy = cy + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! z term:
+
+            ff = P_center(3) - Centerii(3) 
+            gg = Q_center(3) - Centerii(3) 
+
+            shift_p = (/ 0, 0, 1 /)
+            shift_Q = (/ 0, 0, 1 /)
+            cz = cz + expoii * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 1 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cz = cz + expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 1 /)
+            cz = cz + expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cz = cz + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+          enddo
+
+          j1b_gauss_coul = j1b_gauss_coul - coef4 * ( cx + cy + cz )
+        enddo ! s
+      enddo  ! r
+    enddo   ! q
+  enddo    ! p
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  ! -------------------------------------------------------------------------------------------------------------------
+
+
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  !
+  !                          - [ 1 / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
+  !
+  ! -------------------------------------------------------------------------------------------------------------------
+ 
+  do p = 1, ao_prim_num(i)
+    coef1 = ao_coef_normalized_ordered_transp(p, i)
+    expo1 = ao_expo_ordered_transp(p, i)
+
+    do q = 1, ao_prim_num(j)
+      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+      expo2 = ao_expo_ordered_transp(q, j)
+
+      call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 &
+                                          , I_power, J_power, I_center, J_center, dim1          )
+      p_inv = 1.d0 / pp
+
+      do r = 1, ao_prim_num(k)
+        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+        expo3 = ao_expo_ordered_transp(r, k)
+
+        do s = 1, ao_prim_num(l)
+          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+          expo4 = ao_expo_ordered_transp(s, l)
+ 
+          call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 &
+                                              , K_power, L_power, K_center, L_center, dim1                          )
+
+          cx = 0.d0
+          cy = 0.d0
+          cz = 0.d0
+          do ii = 1, nucl_num
+            expoii        = j1b_gauss_pen(ii)
+            Centerii(1:3) = nucl_coord(ii, 1:3)
+
+            call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center)
+
+            fact_q = fact_q_tmp * factii
+            q_inv  = 1.d0 / qq
+
+            ! pol centerd on Q_center_tmp ==> centerd on Q_center
+            call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new)
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! x term:
+
+            ff = P_center(1) - Centerii(1) 
+            gg = Q_center(1) - Centerii(1) 
+
+            shift_p = (/ 1, 0, 0 /)
+            shift_Q = (/ 1, 0, 0 /)
+            cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 1, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cx = cx + expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 1, 0, 0 /)
+            cx = cx + expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cx = cx + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! y term:
+
+            ff = P_center(2) - Centerii(2) 
+            gg = Q_center(2) - Centerii(2) 
+
+            shift_p = (/ 0, 1, 0 /)
+            shift_Q = (/ 0, 1, 0 /)
+            cy = cy + expoii * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+ 
+            shift_p = (/ 0, 1, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cy = cy + expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 1, 0 /)
+            cy = cy + expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cy = cy + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! z term:
+
+            ff = P_center(3) - Centerii(3) 
+            gg = Q_center(3) - Centerii(3) 
+
+            shift_p = (/ 0, 0, 1 /)
+            shift_Q = (/ 0, 0, 1 /)
+            cz = cz + expoii * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 1 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cz = cz + expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 1 /)
+            cz = cz + expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cz = cz + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+          enddo
+
+          j1b_gauss_coul = j1b_gauss_coul - coef4 * ( cx + cy + cz )
+
+        enddo ! s
+      enddo  ! r
+    enddo   ! q
+  enddo    ! p
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  ! -------------------------------------------------------------------------------------------------------------------
+
+  return
+end function j1b_gauss_coul
+
+
+
+
+!______________________________________________________________________________________________________________________
+!______________________________________________________________________________________________________________________
+
+double precision function general_primitive_integral_coul_shifted( dim                                                  &
+                                                                 , P_new, P_center, fact_p, p, p_inv, iorder_p, shift_P &
+                                                                 , Q_new, Q_center, fact_q, q, q_inv, iorder_q, shift_Q )
+
+  include 'utils/constants.include.F'
+
+  implicit none
+
+  integer,          intent(in) :: dim
+  integer,          intent(in) :: iorder_p(3), shift_P(3)
+  integer,          intent(in) :: iorder_q(3), shift_Q(3)
+  double precision, intent(in) :: P_new(0:max_dim,3), P_center(3), fact_p, p, p_inv
+  double precision, intent(in) :: Q_new(0:max_dim,3), Q_center(3), fact_q, q, q_inv
+
+  integer                      :: n_Ix, n_Iy, n_Iz, nx, ny, nz
+  integer                      :: ix, iy, iz, jx, jy, jz, i
+  integer                      :: n_pt_tmp, n_pt_out, iorder
+  integer                      :: ii, jj
+  double precision             :: rho, dist
+  double precision             :: dx(0:max_dim), Ix_pol(0:max_dim)
+  double precision             :: dy(0:max_dim), Iy_pol(0:max_dim)
+  double precision             :: dz(0:max_dim), Iz_pol(0:max_dim)
+  double precision             :: a, b, c, d, e, f, accu, pq, const
+  double precision             :: pq_inv, p10_1, p10_2, p01_1, p01_2, pq_inv_2
+  double precision             :: d1(0:max_dim), d_poly(0:max_dim)
+  double precision             :: p_plus_q
+
+  double precision             :: rint_sum
+
+  general_primitive_integral_coul_shifted = 0.d0
+
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: dx, Ix_pol, dy, Iy_pol, dz, Iz_pol
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: d1, d_poly
+
+  ! Gaussian Product
+  ! ----------------
+  p_plus_q = (p+q) 
+  pq       = p_inv * 0.5d0 * q_inv
+  pq_inv   = 0.5d0 / p_plus_q
+  p10_1    = q * pq             ! 1/(2p)
+  p01_1    = p * pq             ! 1/(2q)
+  pq_inv_2 = pq_inv + pq_inv
+  p10_2    = pq_inv_2 * p10_1 * q ! 0.5d0 * q / (pq + p*p)
+  p01_2    = pq_inv_2 * p01_1 * p ! 0.5d0 * p / (q*q + pq)
+
+  accu = 0.d0
+
+  iorder = iorder_p(1) + iorder_q(1) + iorder_p(1) + iorder_q(1)
+  iorder = iorder + shift_P(1) + shift_Q(1)
+  iorder = iorder + shift_P(1) + shift_Q(1)
+  !DIR$ VECTOR ALIGNED
+  do ix = 0, iorder
+    Ix_pol(ix) = 0.d0
+  enddo
+  n_Ix = 0
+  do ix = 0, iorder_p(1)
+
+    ii = ix + shift_P(1)
+    a  = P_new(ix,1)
+    if(abs(a) < thresh) cycle
+
+    do jx = 0, iorder_q(1)
+
+      jj = jx + shift_Q(1)
+      d  = a * Q_new(jx,1)
+      if(abs(d) < thresh) cycle
+
+      !DEC$ FORCEINLINE
+      call give_polynom_mult_center_x( P_center(1), Q_center(1), ii, jj &
+                                     , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dx, nx )
+      !DEC$ FORCEINLINE
+      call add_poly_multiply(dx, nx, d, Ix_pol, n_Ix)
+    enddo
+  enddo
+  if(n_Ix == -1) then
+    return
+  endif
+
+  iorder = iorder_p(2) + iorder_q(2) + iorder_p(2) + iorder_q(2)
+  iorder = iorder + shift_P(2) + shift_Q(2)
+  iorder = iorder + shift_P(2) + shift_Q(2)
+  !DIR$ VECTOR ALIGNED
+  do ix = 0, iorder
+    Iy_pol(ix) = 0.d0
+  enddo
+  n_Iy = 0
+  do iy = 0, iorder_p(2)
+
+    if(abs(P_new(iy,2)) > thresh) then
+
+      ii = iy + shift_P(2)
+      b  = P_new(iy,2)
+
+      do jy = 0, iorder_q(2)
+
+        jj = jy + shift_Q(2)
+        e  = b * Q_new(jy,2)
+        if(abs(e) < thresh) cycle
+
+        !DEC$ FORCEINLINE
+        call give_polynom_mult_center_x( P_center(2), Q_center(2), ii, jj &
+                                       , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dy, ny )
+        !DEC$ FORCEINLINE
+        call add_poly_multiply(dy, ny, e, Iy_pol, n_Iy)
+      enddo
+    endif
+  enddo
+  if(n_Iy == -1) then
+    return
+  endif
+
+  iorder = iorder_p(3) + iorder_q(3) + iorder_p(3) + iorder_q(3)
+  iorder = iorder + shift_P(3) + shift_Q(3)
+  iorder = iorder + shift_P(3) + shift_Q(3)
+  do ix = 0, iorder
+    Iz_pol(ix) = 0.d0
+  enddo
+  n_Iz = 0
+  do iz = 0, iorder_p(3)
+
+    if( abs(P_new(iz,3)) > thresh ) then
+
+      ii = iz + shift_P(3)
+      c  = P_new(iz,3)
+
+      do jz = 0, iorder_q(3)
+
+        jj = jz + shift_Q(3)
+        f  = c * Q_new(jz,3)
+        if(abs(f) < thresh) cycle
+
+        !DEC$ FORCEINLINE
+        call give_polynom_mult_center_x( P_center(3), Q_center(3), ii, jj &
+                                       , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dz, nz )
+        !DEC$ FORCEINLINE
+        call add_poly_multiply(dz, nz, f, Iz_pol, n_Iz)
+      enddo
+    endif
+  enddo
+  if(n_Iz == -1) then
+    return
+  endif
+
+  rho = p * q * pq_inv_2
+  dist = (P_center(1) - Q_center(1)) * (P_center(1) - Q_center(1)) &
+       + (P_center(2) - Q_center(2)) * (P_center(2) - Q_center(2)) &
+       + (P_center(3) - Q_center(3)) * (P_center(3) - Q_center(3))
+  const = dist*rho
+
+  n_pt_tmp = n_Ix + n_Iy
+  do i = 0, n_pt_tmp
+    d_poly(i) = 0.d0
+  enddo
+
+  !DEC$ FORCEINLINE
+  call multiply_poly(Ix_pol, n_Ix, Iy_pol, n_Iy, d_poly, n_pt_tmp)
+  if(n_pt_tmp == -1) then
+    return
+  endif
+  n_pt_out = n_pt_tmp + n_Iz
+  do i = 0, n_pt_out
+    d1(i) = 0.d0
+  enddo
+
+  !DEC$ FORCEINLINE
+  call multiply_poly(d_poly, n_pt_tmp, Iz_pol, n_Iz, d1, n_pt_out)
+  accu = accu + rint_sum(n_pt_out, const, d1)
+
+  general_primitive_integral_coul_shifted = fact_p * fact_q * accu * pi_5_2 * p_inv * q_inv / dsqrt(p_plus_q)
+
+  return
+end function general_primitive_integral_coul_shifted
+!______________________________________________________________________________________________________________________
+!______________________________________________________________________________________________________________________

src/ao_tc_eff_map/two_e_1bgauss_coul_acc.irp.f

@@ -0,0 +1,433 @@
+double precision function j1b_gauss_coul_acc(i, j, k, l)
+
+  BEGIN_DOC
+  ! 
+  !  integral in the AO basis:
+  !     i(r1) j(r1) f(r12) k(r2) l(r2)
+  !
+  !  with:
+  !     f(r12) = - [ 0.5 / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ]
+  !            = [ 1 / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
+  !                                     + (r2-RA)^2 exp(-aA r2A^2) 
+  !                                     - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) 
+  !                                     - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
+  !
+  END_DOC
+
+  include 'utils/constants.include.F'
+
+  implicit none
+
+  integer, intent(in) :: i, j, k, l
+
+  integer             :: p, q, r, s, ii
+  integer             :: num_i, num_j, num_k, num_l, num_ii 
+  integer             :: I_power(3), J_power(3), K_power(3), L_power(3)
+  integer             :: iorder_p(3), iorder_q(3)
+  integer             :: shift_P(3), shift_Q(3)
+  integer             :: dim1
+
+  double precision    :: coef1, coef2, coef3, coef4
+  double precision    :: expo1, expo2, expo3, expo4
+  double precision    :: p1_inv, q1_inv, p2_inv, q2_inv
+  double precision    :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1
+  double precision    :: P2_new(0:max_dim,3), P2_center(3), fact_p2, pp2
+  double precision    :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1
+  double precision    :: Q2_new(0:max_dim,3), Q2_center(3), fact_q2, qq2
+  double precision    :: I_center(3), J_center(3), K_center(3), L_center(3)
+  double precision    :: expoii, factii, Centerii(3)
+  double precision    :: ff, gg, cx, cy, cz
+
+  double precision    :: general_primitive_integral_coul_shifted
+  !double precision    :: j1b_gauss_coul_schwartz_accel
+  
+  PROVIDE j1b_gauss_pen
+
+  dim1 = n_pt_max_integrals
+
+  ! TODO
+  !if( ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then
+  !  j1b_gauss_coul_schwartz_accel = j1b_gauss_coul_schwartz_accel(i, j, k, l)
+  !  return
+  !endif
+
+  num_i = ao_nucl(i)
+  num_j = ao_nucl(j)
+  num_k = ao_nucl(k)
+  num_l = ao_nucl(l)
+
+  do p = 1, 3
+    I_power(p)  = ao_power(i,p)
+    J_power(p)  = ao_power(j,p)
+    K_power(p)  = ao_power(k,p)
+    L_power(p)  = ao_power(l,p)
+    I_center(p) = nucl_coord(num_i,p)
+    J_center(p) = nucl_coord(num_j,p)
+    K_center(p) = nucl_coord(num_k,p)
+    L_center(p) = nucl_coord(num_l,p)
+  enddo
+
+  j1b_gauss_coul_acc = 0.d0
+
+  do p = 1, ao_prim_num(i)
+    coef1 = ao_coef_normalized_ordered_transp(p, i)
+    expo1 = ao_expo_ordered_transp(p, i)
+
+    do q = 1, ao_prim_num(j)
+      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+      expo2 = ao_expo_ordered_transp(q, j)
+
+      call give_explicit_poly_and_gaussian( P1_new, P1_center, pp1, fact_p1, iorder_p, expo1, expo2 &
+                                          , I_power, J_power, I_center, J_center, dim1 )
+      p1_inv = 1.d0 / pp1
+
+      do r = 1, ao_prim_num(k)
+        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+        expo3 = ao_expo_ordered_transp(r, k)
+
+        do s = 1, ao_prim_num(l)
+          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+          expo4 = ao_expo_ordered_transp(s, l)
+ 
+          call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 &
+                                              , K_power, L_power, K_center, L_center, dim1 )
+          q1_inv = 1.d0 / qq1
+
+          cx = 0.d0
+          cy = 0.d0
+          cz = 0.d0
+          do ii = 1, nucl_num
+            expoii        = j1b_gauss_pen(ii)
+            Centerii(1:3) = nucl_coord(ii, 1:3)
+
+            call gaussian_product(pp1, P1_center, expoii, Centerii, factii, pp2, P2_center)
+            fact_p2 = fact_p1 * factii
+            p2_inv  = 1.d0 / pp2
+            call pol_modif_center( P1_center, P2_center, iorder_p, P1_new, P2_new)
+
+            call gaussian_product(qq1, Q1_center, expoii, Centerii, factii, qq2, Q2_center)
+            fact_q2 = fact_q1 * factii
+            q2_inv  = 1.d0 / qq2
+            call pol_modif_center( Q1_center, Q2_center, iorder_q, Q1_new, Q2_new)
+
+
+            ! ----------------------------------------------------------------------------------------------------
+            !                         [ 1 / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
+            ! ----------------------------------------------------------------------------------------------------
+
+            shift_Q = (/ 0, 0, 0 /)
+
+            ! x term:
+            ff = P2_center(1) - Centerii(1) 
+
+            shift_P = (/ 2, 0, 0 /)
+            cx = cx + expoii * general_primitive_integral_coul_shifted( dim1      &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_P = (/ 1, 0, 0 /)
+            cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P        &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q        )
+
+            shift_P = (/ 0, 0, 0 /)
+            cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+
+            ! y term:
+            ff = P2_center(2) - Centerii(2) 
+
+            shift_P = (/ 0, 2, 0 /)
+            cy = cy + expoii * general_primitive_integral_coul_shifted( dim1      &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_P = (/ 0, 1, 0 /)
+            cy = cy + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P        &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q        )
+
+            shift_P = (/ 0, 0, 0 /)
+            cy = cy + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+
+            ! z term:
+            ff = P2_center(3) - Centerii(3) 
+
+            shift_P = (/ 0, 0, 2 /)
+            cz = cz + expoii * general_primitive_integral_coul_shifted( dim1      &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_P = (/ 0, 0, 1 /)
+            cz = cz + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P        &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q        )
+
+            shift_P = (/ 0, 0, 0 /)
+            cz = cz + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+
+
+            ! ----------------------------------------------------------------------------------------------------
+            !                         [ 1 / r12 ] \sum_A a_A [ (r2-RA)^2 exp(-aA r2A^2)
+            ! ----------------------------------------------------------------------------------------------------
+
+            shift_P = (/ 0, 0, 0 /)
+
+            ! x term:
+            ff = Q2_center(1) - Centerii(1) 
+
+            shift_Q = (/ 2, 0, 0 /)
+            cx = cx + expoii * general_primitive_integral_coul_shifted( dim1      &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_Q = (/ 1, 0, 0 /)
+            cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P        &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q        )
+
+            shift_Q = (/ 0, 0, 0 /)
+            cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+
+            ! y term:
+            ff = Q2_center(2) - Centerii(2) 
+
+            shift_Q = (/ 0, 2, 0 /)
+            cy = cy + expoii * general_primitive_integral_coul_shifted( dim1      &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_Q = (/ 0, 1, 0 /)
+            cy = cy + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P        &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q        )
+
+            shift_Q = (/ 0, 0, 0 /)
+            cy = cy + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+
+            ! z term:
+            ff = Q2_center(3) - Centerii(3) 
+
+            shift_Q = (/ 0, 0, 2 /)
+            cz = cz + expoii * general_primitive_integral_coul_shifted( dim1      &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_Q = (/ 0, 0, 1 /)
+            cz = cz + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P        &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q        )
+
+            shift_Q = (/ 0, 0, 0 /)
+            cz = cz + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+
+
+            ! ----------------------------------------------------------------------------------------------------
+            !                 - [ 1 / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) ]
+            ! ----------------------------------------------------------------------------------------------------
+
+            ! x term:
+            ff = P2_center(1) - Centerii(1) 
+            gg = Q1_center(1) - Centerii(1) 
+
+            shift_p = (/ 1, 0, 0 /)
+            shift_Q = (/ 1, 0, 0 /)
+            cx = cx - expoii * general_primitive_integral_coul_shifted( dim1      &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 1, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cx = cx - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 1, 0, 0 /)
+            cx = cx - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cx = cx - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+
+            ! y term:
+            ff = P2_center(2) - Centerii(2) 
+            gg = Q1_center(2) - Centerii(2) 
+
+            shift_p = (/ 0, 1, 0 /)
+            shift_Q = (/ 0, 1, 0 /)
+            cy = cy - expoii * general_primitive_integral_coul_shifted( dim1      &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 1, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cy = cy - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 1, 0 /)
+            cy = cy - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cy = cy - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+
+            ! z term:
+            ff = P2_center(3) - Centerii(3) 
+            gg = Q1_center(3) - Centerii(3) 
+
+            shift_p = (/ 0, 0, 1 /)
+            shift_Q = (/ 0, 0, 1 /)
+            cz = cz - expoii * general_primitive_integral_coul_shifted( dim1      &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 1 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cz = cz - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 1 /)
+            cz = cz - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cz = cz - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+
+
+            ! ----------------------------------------------------------------------------------------------------
+            !                 - [ 1 / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
+            ! ----------------------------------------------------------------------------------------------------
+
+            ! x term:
+            ff = P1_center(1) - Centerii(1) 
+            gg = Q2_center(1) - Centerii(1) 
+
+            shift_p = (/ 1, 0, 0 /)
+            shift_Q = (/ 1, 0, 0 /)
+            cx = cx - expoii * general_primitive_integral_coul_shifted( dim1      &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 1, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cx = cx - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 1, 0, 0 /)
+            cx = cx - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cx = cx - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+
+            ! y term:
+            ff = P1_center(2) - Centerii(2) 
+            gg = Q2_center(2) - Centerii(2) 
+
+            shift_p = (/ 0, 1, 0 /)
+            shift_Q = (/ 0, 1, 0 /)
+            cy = cy - expoii * general_primitive_integral_coul_shifted( dim1      &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 1, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cy = cy - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 1, 0 /)
+            cy = cy - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cy = cy - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+
+            ! z term:
+            ff = P1_center(3) - Centerii(3) 
+            gg = Q2_center(3) - Centerii(3) 
+
+            shift_p = (/ 0, 0, 1 /)
+            shift_Q = (/ 0, 0, 1 /)
+            cz = cz - expoii * general_primitive_integral_coul_shifted( dim1      &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 1 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cz = cz - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 1 /)
+            cz = cz - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cz = cz - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+          enddo
+
+          j1b_gauss_coul_acc = j1b_gauss_coul_acc + coef4 * ( cx + cy + cz )
+        enddo ! s
+      enddo  ! r
+    enddo   ! q
+  enddo    ! p
+
+  return
+end function j1b_gauss_coul_acc

src/ao_tc_eff_map/two_e_1bgauss_coul_debug.irp.f

@@ -0,0 +1,397 @@
+double precision function j1b_gauss_coul_debug(i, j, k, l)
+
+  BEGIN_DOC
+  ! 
+  !  integral in the AO basis:
+  !     i(r1) j(r1) f(r12) k(r2) l(r2)
+  !
+  !  with:
+  !     f(r12) = - [ 0.5 / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ]
+  !            = [ 1 / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
+  !                                     + (r2-RA)^2 exp(-aA r2A^2) 
+  !                                     - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) 
+  !                                     - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
+  !
+  END_DOC
+
+  include 'utils/constants.include.F'
+
+  implicit none
+
+  integer, intent(in) :: i, j, k, l
+
+  integer             :: p, q, r, s, ii
+  integer             :: num_i, num_j, num_k, num_l, num_ii 
+  integer             :: I_power(3), J_power(3), K_power(3), L_power(3)
+  integer             :: iorder_p(3), iorder_q(3)
+  integer             :: shift_P(3), shift_Q(3)
+  integer             :: dim1
+
+  double precision    :: coef1, coef2, coef3, coef4
+  double precision    :: expo1, expo2, expo3, expo4
+  double precision    :: p_inv, q_inv
+  double precision    :: P_new_tmp(0:max_dim,3), P_center_tmp(3), fact_p_tmp, pp_tmp
+  double precision    :: Q_new_tmp(0:max_dim,3), Q_center_tmp(3), fact_q_tmp, qq_tmp
+  double precision    :: P_new(0:max_dim,3), P_center(3), fact_p, pp
+  double precision    :: Q_new(0:max_dim,3), Q_center(3), fact_q, qq
+  double precision    :: I_center(3), J_center(3), K_center(3), L_center(3)
+  double precision    :: expoii, factii, Centerii(3)
+  double precision    :: ff, gg, cx, cy, cz
+
+  double precision    :: general_primitive_integral_coul_shifted
+  
+  PROVIDE j1b_gauss_pen
+
+  dim1 = n_pt_max_integrals
+
+  num_i = ao_nucl(i)
+  num_j = ao_nucl(j)
+  num_k = ao_nucl(k)
+  num_l = ao_nucl(l)
+
+  do p = 1, 3
+    I_power(p)  = ao_power(i,p)
+    J_power(p)  = ao_power(j,p)
+    K_power(p)  = ao_power(k,p)
+    L_power(p)  = ao_power(l,p)
+    I_center(p) = nucl_coord(num_i,p)
+    J_center(p) = nucl_coord(num_j,p)
+    K_center(p) = nucl_coord(num_k,p)
+    L_center(p) = nucl_coord(num_l,p)
+  enddo
+
+  j1b_gauss_coul_debug = 0.d0
+
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  !
+  !                               [ 1 / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
+  !
+  ! -------------------------------------------------------------------------------------------------------------------
+
+  shift_Q = (/ 0, 0, 0 /)
+ 
+  do p = 1, ao_prim_num(i)
+    coef1 = ao_coef_normalized_ordered_transp(p, i)
+    expo1 = ao_expo_ordered_transp(p, i)
+
+    do q = 1, ao_prim_num(j)
+      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+      expo2 = ao_expo_ordered_transp(q, j)
+
+      call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 &
+                                          , I_power, J_power, I_center, J_center, dim1                          )
+
+      do r = 1, ao_prim_num(k)
+        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+        expo3 = ao_expo_ordered_transp(r, k)
+
+        do s = 1, ao_prim_num(l)
+          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+          expo4 = ao_expo_ordered_transp(s, l)
+ 
+          call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 &
+                                              , K_power, L_power, K_center, L_center, dim1          )
+          q_inv = 1.d0 / qq
+
+          cx = 0.d0
+          do ii = 1, nucl_num
+            expoii        = j1b_gauss_pen(ii)
+            Centerii(1:3) = nucl_coord(ii, 1:3)
+
+            call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center)
+
+            fact_p = fact_p_tmp * factii
+            p_inv  = 1.d0 / pp
+
+            ! pol centerd on P_center_tmp ==> centerd on P_center
+            call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new)
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! x term:
+
+            ff = P_center(1) - Centerii(1) 
+
+            shift_P = (/ 2, 0, 0 /)
+            cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_P = (/ 1, 0, 0 /)
+            cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P             &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q             )
+
+            shift_P = (/ 0, 0, 0 /)
+            cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+          enddo
+
+          j1b_gauss_coul_debug = j1b_gauss_coul_debug + coef4 * cx 
+        enddo ! s
+      enddo  ! r
+    enddo   ! q
+  enddo    ! p
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  ! -------------------------------------------------------------------------------------------------------------------
+
+
+!  ! -------------------------------------------------------------------------------------------------------------------
+!  !
+!  !                               [ 1 / r12 ] \sum_A a_A [ (r2-RA)^2 exp(-aA r2A^2)
+!  !
+!  ! -------------------------------------------------------------------------------------------------------------------
+!
+!  shift_P = (/ 0, 0, 0 /)
+! 
+!  do p = 1, ao_prim_num(i)
+!    coef1 = ao_coef_normalized_ordered_transp(p, i)
+!    expo1 = ao_expo_ordered_transp(p, i)
+!
+!    do q = 1, ao_prim_num(j)
+!      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+!      expo2 = ao_expo_ordered_transp(q, j)
+!
+!      call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 &
+!                                          , I_power, J_power, I_center, J_center, dim1          )
+!      p_inv = 1.d0 / pp
+!
+!      do r = 1, ao_prim_num(k)
+!        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+!        expo3 = ao_expo_ordered_transp(r, k)
+!
+!        do s = 1, ao_prim_num(l)
+!          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+!          expo4 = ao_expo_ordered_transp(s, l)
+! 
+!          call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 &
+!                                              , K_power, L_power, K_center, L_center, dim1                          )
+!
+!          cx = 0.d0
+!          do ii = 1, nucl_num
+!            expoii        = j1b_gauss_pen(ii)
+!            Centerii(1:3) = nucl_coord(ii, 1:3)
+!
+!            call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center)
+!
+!            fact_q = fact_q_tmp * factii
+!            q_inv  = 1.d0 / qq
+!
+!            ! pol centerd on Q_center_tmp ==> centerd on Q_center
+!            call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new)
+!
+!            ! ----------------------------------------------------------------------------------------------------
+!            ! x term:
+!
+!            ff = Q_center(1) - Centerii(1) 
+!
+!            shift_Q = (/ 2, 0, 0 /)
+!            cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
+!                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+!                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+!
+!            shift_Q = (/ 1, 0, 0 /)
+!            cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+!                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P             &
+!                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q             )
+!
+!            shift_Q = (/ 0, 0, 0 /)
+!            cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+!                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+!                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+!
+!            ! ----------------------------------------------------------------------------------------------------
+!
+!          enddo
+!
+!          j1b_gauss_coul_debug = j1b_gauss_coul_debug + coef4 * cx
+!        enddo ! s
+!      enddo  ! r
+!    enddo   ! q
+!  enddo    ! p
+!
+!  ! -------------------------------------------------------------------------------------------------------------------
+!  ! -------------------------------------------------------------------------------------------------------------------
+
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  !
+  !                          - [ 1 / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) ]
+  !
+  ! -------------------------------------------------------------------------------------------------------------------
+ 
+  do p = 1, ao_prim_num(i)
+    coef1 = ao_coef_normalized_ordered_transp(p, i)
+    expo1 = ao_expo_ordered_transp(p, i)
+
+    do q = 1, ao_prim_num(j)
+      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+      expo2 = ao_expo_ordered_transp(q, j)
+
+      call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 &
+                                          , I_power, J_power, I_center, J_center, dim1                          )
+
+      do r = 1, ao_prim_num(k)
+        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+        expo3 = ao_expo_ordered_transp(r, k)
+
+        do s = 1, ao_prim_num(l)
+          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+          expo4 = ao_expo_ordered_transp(s, l)
+ 
+          call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 &
+                                              , K_power, L_power, K_center, L_center, dim1          )
+          q_inv = 1.d0 / qq
+
+          cx = 0.d0
+          do ii = 1, nucl_num
+            expoii        = j1b_gauss_pen(ii)
+            Centerii(1:3) = nucl_coord(ii, 1:3)
+
+            call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center)
+
+            fact_p = fact_p_tmp * factii
+            p_inv  = 1.d0 / pp
+
+            ! pol centerd on P_center_tmp ==> centerd on P_center
+            call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new)
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! x term:
+
+            ff = P_center(1) - Centerii(1) 
+            gg = Q_center(1) - Centerii(1) 
+
+            shift_P = (/ 1, 0, 0 /)
+            shift_Q = (/ 1, 0, 0 /)
+            cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_P = (/ 1, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cx = cx + expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_P = (/ 0, 0, 0 /)
+            shift_Q = (/ 1, 0, 0 /)
+            cx = cx + expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_P = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cx = cx + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+          enddo
+
+          j1b_gauss_coul_debug = j1b_gauss_coul_debug - coef4 * cx
+        enddo ! s
+      enddo  ! r
+    enddo   ! q
+  enddo    ! p
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  ! -------------------------------------------------------------------------------------------------------------------
+
+
+
+!  ! -------------------------------------------------------------------------------------------------------------------
+!  !
+!  !                          - [ 1 / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
+!  !
+!  ! -------------------------------------------------------------------------------------------------------------------
+! 
+!  do p = 1, ao_prim_num(i)
+!    coef1 = ao_coef_normalized_ordered_transp(p, i)
+!    expo1 = ao_expo_ordered_transp(p, i)
+!
+!    do q = 1, ao_prim_num(j)
+!      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+!      expo2 = ao_expo_ordered_transp(q, j)
+!
+!      call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 &
+!                                          , I_power, J_power, I_center, J_center, dim1          )
+!      p_inv = 1.d0 / pp
+!
+!      do r = 1, ao_prim_num(k)
+!        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+!        expo3 = ao_expo_ordered_transp(r, k)
+!
+!        do s = 1, ao_prim_num(l)
+!          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+!          expo4 = ao_expo_ordered_transp(s, l)
+! 
+!          call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 &
+!                                              , K_power, L_power, K_center, L_center, dim1                          )
+!
+!          cx = 0.d0
+!          do ii = 1, nucl_num
+!            expoii        = j1b_gauss_pen(ii)
+!            Centerii(1:3) = nucl_coord(ii, 1:3)
+!
+!            call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center)
+!
+!            fact_q = fact_q_tmp * factii
+!            q_inv  = 1.d0 / qq
+!
+!            ! pol centerd on Q_center_tmp ==> centerd on Q_center
+!            call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new)
+!
+!            ! ----------------------------------------------------------------------------------------------------
+!            ! x term:
+!
+!            ff = P_center(1) - Centerii(1) 
+!            gg = Q_center(1) - Centerii(1) 
+!
+!            shift_P = (/ 1, 0, 0 /)
+!            shift_Q = (/ 1, 0, 0 /)
+!            cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
+!                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+!                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+!
+!            shift_P = (/ 1, 0, 0 /)
+!            shift_Q = (/ 0, 0, 0 /)
+!            cx = cx + expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+!                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+!                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+!
+!            shift_P = (/ 0, 0, 0 /)
+!            shift_Q = (/ 1, 0, 0 /)
+!            cx = cx + expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+!                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+!                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+!
+!            shift_P = (/ 0, 0, 0 /)
+!            shift_Q = (/ 0, 0, 0 /)
+!            cx = cx + expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+!                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+!                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+!
+!            ! ----------------------------------------------------------------------------------------------------
+!
+!          enddo
+!
+!          j1b_gauss_coul_debug = j1b_gauss_coul_debug - coef4 * cx
+!
+!        enddo ! s
+!      enddo  ! r
+!    enddo   ! q
+!  enddo    ! p
+!
+!  ! -------------------------------------------------------------------------------------------------------------------
+!  ! -------------------------------------------------------------------------------------------------------------------
+
+  return
+end function j1b_gauss_coul_debug
+

src/ao_tc_eff_map/two_e_1bgauss_coul_modifdebug.irp.f

@@ -0,0 +1,324 @@
+double precision function j1b_gauss_coul_modifdebug(i, j, k, l)
+
+  include 'utils/constants.include.F'
+
+  implicit none
+
+  integer, intent(in) :: i, j, k, l
+
+  integer             :: p, q, r, s, ii
+  integer             :: num_i, num_j, num_k, num_l, num_ii 
+  integer             :: I_power(3), J_power(3), K_power(3), L_power(3)
+  integer             :: iorder_p(3), iorder_q(3)
+  integer             :: shift_P(3), shift_Q(3)
+  integer             :: dim1
+
+  double precision    :: coef1, coef2, coef3, coef4
+  double precision    :: expo1, expo2, expo3, expo4
+  double precision    :: p_inv, q_inv
+  double precision    :: P_new_tmp(0:max_dim,3), P_center_tmp(3), fact_p_tmp, pp_tmp
+  double precision    :: Q_new_tmp(0:max_dim,3), Q_center_tmp(3), fact_q_tmp, qq_tmp
+  double precision    :: P_new(0:max_dim,3), P_center(3), fact_p, pp
+  double precision    :: Q_new(0:max_dim,3), Q_center(3), fact_q, qq
+  double precision    :: I_center(3), J_center(3), K_center(3), L_center(3)
+  double precision    :: expoii, factii, Centerii(3)
+  double precision    :: ff, gg, cx, cy, cz
+
+  double precision    :: general_primitive_integral_coul
+  double precision    :: general_primitive_integral_coul_shifted
+  double precision    :: ao_two_e_integral
+  
+  PROVIDE j1b_gauss_pen
+
+  dim1 = n_pt_max_integrals
+
+  num_i = ao_nucl(i)
+  num_j = ao_nucl(j)
+  num_k = ao_nucl(k)
+  num_l = ao_nucl(l)
+
+  do p = 1, 3
+    I_power(p)  = ao_power(i,p)
+    J_power(p)  = ao_power(j,p)
+    K_power(p)  = ao_power(k,p)
+    L_power(p)  = ao_power(l,p)
+    I_center(p) = nucl_coord(num_i,p)
+    J_center(p) = nucl_coord(num_j,p)
+    K_center(p) = nucl_coord(num_k,p)
+    L_center(p) = nucl_coord(num_l,p)
+  enddo
+
+  j1b_gauss_coul_modifdebug = 0.d0
+
+!  do ii = 1, nucl_num
+!    expoii = j1b_gauss_pen(ii)
+!    j1b_gauss_coul_modifdebug += expoii * ao_two_e_integral(i, j, k, l)
+!  enddo
+
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  !
+  !                               [ 1 / r12 ] \sum_A a_A exp(-aA r1A^2)
+  !
+  ! -------------------------------------------------------------------------------------------------------------------
+
+  shift_P = (/ 0, 0, 0 /)
+  shift_Q = (/ 0, 0, 0 /)
+ 
+  do p = 1, ao_prim_num(i)
+    coef1 = ao_coef_normalized_ordered_transp(p, i)
+    expo1 = ao_expo_ordered_transp(p, i)
+
+    do q = 1, ao_prim_num(j)
+      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+      expo2 = ao_expo_ordered_transp(q, j)
+
+      call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 &
+                                          , I_power, J_power, I_center, J_center, dim1                          )
+
+      do r = 1, ao_prim_num(k)
+        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+        expo3 = ao_expo_ordered_transp(r, k)
+
+        do s = 1, ao_prim_num(l)
+          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+          expo4 = ao_expo_ordered_transp(s, l)
+ 
+          call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 &
+                                              , K_power, L_power, K_center, L_center, dim1          )
+          q_inv = 1.d0 / qq
+
+          cx = 0.d0
+          do ii = 1, nucl_num
+            expoii        = j1b_gauss_pen(ii)
+            Centerii(1:3) = nucl_coord(ii, 1:3)
+
+            call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center)
+            fact_p = fact_p_tmp * factii
+            p_inv  = 1.d0 / pp
+            P_new(:,:) = 0.d0
+            call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new)
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! x term:
+
+            cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+          enddo
+
+          j1b_gauss_coul_modifdebug = j1b_gauss_coul_modifdebug + coef4 * cx 
+        enddo ! s
+      enddo  ! r
+    enddo   ! q
+  enddo    ! p
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  ! -------------------------------------------------------------------------------------------------------------------
+
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  !
+  !                               [ 1 / r12 ] \sum_A a_A exp(-aA r2A^2)
+  !
+  ! -------------------------------------------------------------------------------------------------------------------
+
+  shift_P = (/ 0, 0, 0 /)
+  shift_Q = (/ 0, 0, 0 /)
+ 
+  do p = 1, ao_prim_num(i)
+    coef1 = ao_coef_normalized_ordered_transp(p, i)
+    expo1 = ao_expo_ordered_transp(p, i)
+
+    do q = 1, ao_prim_num(j)
+      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+      expo2 = ao_expo_ordered_transp(q, j)
+
+      call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 &
+                                          , I_power, J_power, I_center, J_center, dim1 )
+      p_inv  = 1.d0 / pp
+
+      do r = 1, ao_prim_num(k)
+        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+        expo3 = ao_expo_ordered_transp(r, k)
+
+        do s = 1, ao_prim_num(l)
+          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+          expo4 = ao_expo_ordered_transp(s, l)
+ 
+          call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 &
+                                              , K_power, L_power, K_center, L_center, dim1 )
+
+          cx = 0.d0
+          do ii = 1, nucl_num
+            expoii        = j1b_gauss_pen(ii)
+            Centerii(1:3) = nucl_coord(ii, 1:3)
+
+            call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center)
+            fact_q = fact_q_tmp * factii
+            Q_inv  = 1.d0 / qq
+            call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new)
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! x term:
+
+            cx = cx + expoii * general_primitive_integral_coul_shifted( dim1 &
+                     , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                     , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+          enddo
+
+          j1b_gauss_coul_modifdebug = j1b_gauss_coul_modifdebug + coef4 * cx 
+        enddo ! s
+      enddo  ! r
+    enddo   ! q
+  enddo    ! p
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  ! -------------------------------------------------------------------------------------------------------------------
+
+  return
+end function j1b_gauss_coul_modifdebug
+
+
+
+
+double precision function general_primitive_integral_coul(dim,            &
+      P_new,P_center,fact_p,p,p_inv,iorder_p,                        &
+      Q_new,Q_center,fact_q,q,q_inv,iorder_q)
+  implicit none
+  BEGIN_DOC
+  ! Computes the integral <pq|rs> where p,q,r,s are Gaussian primitives
+  END_DOC
+  integer,intent(in)             :: dim
+  include 'utils/constants.include.F'
+  double precision, intent(in)   :: P_new(0:max_dim,3),P_center(3),fact_p,p,p_inv
+  double precision, intent(in)   :: Q_new(0:max_dim,3),Q_center(3),fact_q,q,q_inv
+  integer, intent(in)            :: iorder_p(3)
+  integer, intent(in)            :: iorder_q(3)
+
+  double precision               :: r_cut,gama_r_cut,rho,dist
+  double precision               :: dx(0:max_dim),Ix_pol(0:max_dim),dy(0:max_dim),Iy_pol(0:max_dim),dz(0:max_dim),Iz_pol(0:max_dim)
+  integer                        :: n_Ix,n_Iy,n_Iz,nx,ny,nz
+  double precision               :: bla
+  integer                        :: ix,iy,iz,jx,jy,jz,i
+  double precision               :: a,b,c,d,e,f,accu,pq,const
+  double precision               :: pq_inv, p10_1, p10_2, p01_1, p01_2,pq_inv_2
+  integer                        :: n_pt_tmp,n_pt_out, iorder
+  double precision               :: d1(0:max_dim),d_poly(0:max_dim),rint,d1_screened(0:max_dim)
+
+  general_primitive_integral_coul = 0.d0
+
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: dx,Ix_pol,dy,Iy_pol,dz,Iz_pol
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: d1, d_poly
+
+  ! Gaussian Product
+  ! ----------------
+
+  pq = p_inv*0.5d0*q_inv
+  pq_inv = 0.5d0/(p+q)
+  p10_1 = q*pq  ! 1/(2p)
+  p01_1 = p*pq  ! 1/(2q)
+  pq_inv_2 = pq_inv+pq_inv
+  p10_2 = pq_inv_2 * p10_1*q !0.5d0*q/(pq + p*p)
+  p01_2 = pq_inv_2 * p01_1*p !0.5d0*p/(q*q + pq)
+
+
+  accu = 0.d0
+  iorder = iorder_p(1)+iorder_q(1)+iorder_p(1)+iorder_q(1)
+  do ix=0,iorder
+    Ix_pol(ix) = 0.d0
+  enddo
+  n_Ix = 0
+  do ix = 0, iorder_p(1)
+    if (abs(P_new(ix,1)) < thresh) cycle
+    a = P_new(ix,1)
+    do jx = 0, iorder_q(1)
+      d = a*Q_new(jx,1)
+      if (abs(d) < thresh) cycle
+      !DIR$ FORCEINLINE
+      call give_polynom_mult_center_x(P_center(1),Q_center(1),ix,jx,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dx,nx)
+      !DIR$ FORCEINLINE
+      call add_poly_multiply(dx,nx,d,Ix_pol,n_Ix)
+    enddo
+  enddo
+  if (n_Ix == -1) then
+    return
+  endif
+  iorder = iorder_p(2)+iorder_q(2)+iorder_p(2)+iorder_q(2)
+  do ix=0, iorder
+    Iy_pol(ix) = 0.d0
+  enddo
+  n_Iy = 0
+  do iy = 0, iorder_p(2)
+    if (abs(P_new(iy,2)) > thresh) then
+      b = P_new(iy,2)
+      do jy = 0, iorder_q(2)
+        e = b*Q_new(jy,2)
+        if (abs(e) < thresh) cycle
+        !DIR$ FORCEINLINE
+        call   give_polynom_mult_center_x(P_center(2),Q_center(2),iy,jy,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dy,ny)
+        !DIR$ FORCEINLINE
+        call add_poly_multiply(dy,ny,e,Iy_pol,n_Iy)
+      enddo
+    endif
+  enddo
+  if (n_Iy == -1) then
+    return
+  endif
+
+  iorder = iorder_p(3)+iorder_q(3)+iorder_p(3)+iorder_q(3)
+  do ix=0,iorder
+    Iz_pol(ix) = 0.d0
+  enddo
+  n_Iz = 0
+  do iz = 0, iorder_p(3)
+    if (abs(P_new(iz,3)) > thresh) then
+      c = P_new(iz,3)
+      do jz = 0, iorder_q(3)
+        f = c*Q_new(jz,3)
+        if (abs(f) < thresh) cycle
+        !DIR$ FORCEINLINE
+        call   give_polynom_mult_center_x(P_center(3),Q_center(3),iz,jz,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dz,nz)
+        !DIR$ FORCEINLINE
+        call add_poly_multiply(dz,nz,f,Iz_pol,n_Iz)
+      enddo
+    endif
+  enddo
+  if (n_Iz == -1) then
+    return
+  endif
+
+  rho = p*q *pq_inv_2
+  dist =  (P_center(1) - Q_center(1))*(P_center(1) - Q_center(1)) +  &
+      (P_center(2) - Q_center(2))*(P_center(2) - Q_center(2)) +      &
+      (P_center(3) - Q_center(3))*(P_center(3) - Q_center(3))
+  const = dist*rho
+
+  n_pt_tmp = n_Ix+n_Iy
+  do i=0,n_pt_tmp
+    d_poly(i)=0.d0
+  enddo
+
+  !DIR$ FORCEINLINE
+  call multiply_poly(Ix_pol,n_Ix,Iy_pol,n_Iy,d_poly,n_pt_tmp)
+  if (n_pt_tmp == -1) then
+    return
+  endif
+  n_pt_out = n_pt_tmp+n_Iz
+  do i=0,n_pt_out
+    d1(i)=0.d0
+  enddo
+
+  !DIR$ FORCEINLINE
+  call multiply_poly(d_poly ,n_pt_tmp ,Iz_pol,n_Iz,d1,n_pt_out)
+  double precision               :: rint_sum
+  accu = accu + rint_sum(n_pt_out,const,d1)
+
+  general_primitive_integral_coul = fact_p * fact_q * accu *pi_5_2*p_inv*q_inv/dsqrt(p+q)
+end function general_primitive_integral_coul

src/ao_tc_eff_map/two_e_1bgauss_coulerf.irp.f

@@ -0,0 +1,102 @@
+double precision function j1b_gauss_coulerf(i, j, k, l)
+
+  BEGIN_DOC
+  ! 
+  !  integral in the AO basis:
+  !     i(r1) j(r1) f(r12) k(r2) l(r2)
+  !
+  !  with:
+  !     f(r12) = - [ (0.5 - 0.5 erf(mu r12)) / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ]
+  !            = [ (1 - erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
+  !                                                    + (r2-RA)^2 exp(-aA r2A^2) 
+  !                                                    - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2)
+  !                                                    - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
+  !
+  END_DOC
+
+  include 'utils/constants.include.F'
+
+  implicit none
+
+  integer, intent(in) :: i, j, k, l
+
+  integer             :: p, q, r, s
+  integer             :: num_i, num_j, num_k, num_l, num_ii 
+  integer             :: I_power(3), J_power(3), K_power(3), L_power(3)
+  integer             :: iorder_p(3), iorder_q(3)
+  integer             :: shift_P(3), shift_Q(3)
+  integer             :: dim1
+
+  double precision    :: coef1, coef2, coef3, coef4
+  double precision    :: expo1, expo2, expo3, expo4
+  double precision    :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1, p1_inv
+  double precision    :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1, q1_inv
+  double precision    :: I_center(3), J_center(3), K_center(3), L_center(3)
+  double precision    :: ff, gg, cx, cy, cz
+
+  double precision    :: j1b_gauss_coulerf_schwartz
+  
+  PROVIDE j1b_gauss_pen
+
+  dim1 = n_pt_max_integrals
+
+  if( ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then
+    j1b_gauss_coulerf = j1b_gauss_coulerf_schwartz(i, j, k, l)
+    return
+  endif
+
+  num_i = ao_nucl(i)
+  num_j = ao_nucl(j)
+  num_k = ao_nucl(k)
+  num_l = ao_nucl(l)
+
+  do p = 1, 3
+    I_power(p)  = ao_power(i,p)
+    J_power(p)  = ao_power(j,p)
+    K_power(p)  = ao_power(k,p)
+    L_power(p)  = ao_power(l,p)
+    I_center(p) = nucl_coord(num_i,p)
+    J_center(p) = nucl_coord(num_j,p)
+    K_center(p) = nucl_coord(num_k,p)
+    L_center(p) = nucl_coord(num_l,p)
+  enddo
+
+  j1b_gauss_coulerf = 0.d0
+
+  do p = 1, ao_prim_num(i)
+    coef1 = ao_coef_normalized_ordered_transp(p, i)
+    expo1 = ao_expo_ordered_transp(p, i)
+
+    do q = 1, ao_prim_num(j)
+      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+      expo2 = ao_expo_ordered_transp(q, j)
+
+      call give_explicit_poly_and_gaussian( P1_new, P1_center, pp1, fact_p1, iorder_p, expo1, expo2 &
+                                          , I_power, J_power, I_center, J_center, dim1 )
+      p1_inv = 1.d0 / pp1
+
+      do r = 1, ao_prim_num(k)
+        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+        expo3 = ao_expo_ordered_transp(r, k)
+
+        do s = 1, ao_prim_num(l)
+          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+          expo4 = ao_expo_ordered_transp(s, l)
+ 
+          call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 &
+                                              , K_power, L_power, K_center, L_center, dim1 )
+          q1_inv = 1.d0 / qq1
+
+          call get_cxcycz( dim1, cx, cy, cz                                  &
+                         , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p &
+                         , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q )
+
+          j1b_gauss_coulerf = j1b_gauss_coulerf + coef4 * ( cx + cy + cz )
+        enddo ! s
+      enddo  ! r
+    enddo   ! q
+  enddo    ! p
+
+  return
+end function j1b_gauss_coulerf
+

src/ao_tc_eff_map/two_e_1bgauss_coulerf_schwartz.irp.f

@@ -0,0 +1,624 @@
+double precision function j1b_gauss_coulerf_schwartz(i, j, k, l)
+
+  BEGIN_DOC
+  ! 
+  !  integral in the AO basis:
+  !     i(r1) j(r1) f(r12) k(r2) l(r2)
+  !
+  !  with:
+  !     f(r12) = - [ (0.5 - 0.5 erf(mu r12)) / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ]
+  !            = [ (1 - erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
+  !                                                    + (r2-RA)^2 exp(-aA r2A^2) 
+  !                                                    - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2)
+  !                                                    - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
+  !
+  END_DOC
+
+  include 'utils/constants.include.F'
+
+  implicit none
+
+  integer, intent(in)           :: i, j, k, l
+
+  integer                       :: p, q, r, s
+  integer                       :: num_i, num_j, num_k, num_l, num_ii 
+  integer                       :: I_power(3), J_power(3), K_power(3), L_power(3)
+  integer                       :: iorder_p(3), iorder_q(3)
+  integer                       :: dim1
+
+  double precision              :: coef1, coef2, coef3, coef4
+  double precision              :: expo1, expo2, expo3, expo4
+  double precision              :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1, p1_inv
+  double precision              :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1, q1_inv
+  double precision              :: I_center(3), J_center(3), K_center(3), L_center(3)
+  double precision              :: cx, cy, cz
+  double precision              :: schwartz_ij, thr
+  double precision, allocatable :: schwartz_kl(:,:) 
+
+  PROVIDE j1b_gauss_pen
+
+  dim1 = n_pt_max_integrals
+  thr  = ao_integrals_threshold * ao_integrals_threshold
+
+  num_i = ao_nucl(i)
+  num_j = ao_nucl(j)
+  num_k = ao_nucl(k)
+  num_l = ao_nucl(l)
+
+  do p = 1, 3
+    I_power(p)  = ao_power(i,p)
+    J_power(p)  = ao_power(j,p)
+    K_power(p)  = ao_power(k,p)
+    L_power(p)  = ao_power(l,p)
+    I_center(p) = nucl_coord(num_i,p)
+    J_center(p) = nucl_coord(num_j,p)
+    K_center(p) = nucl_coord(num_k,p)
+    L_center(p) = nucl_coord(num_l,p)
+  enddo
+
+
+  allocate( schwartz_kl(0:ao_prim_num(l) , 0:ao_prim_num(k)) )
+
+  schwartz_kl(0,0) = 0.d0
+  do r = 1, ao_prim_num(k)
+    expo3 = ao_expo_ordered_transp(r,k)
+    coef3 = ao_coef_normalized_ordered_transp(r,k) * ao_coef_normalized_ordered_transp(r,k)
+
+    schwartz_kl(0,r) = 0.d0
+    do s = 1, ao_prim_num(l)
+      expo4 = ao_expo_ordered_transp(s,l)
+      coef4 = coef3 * ao_coef_normalized_ordered_transp(s,l) * ao_coef_normalized_ordered_transp(s,l)
+
+      call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 &
+                                          , K_power, L_power, K_center, L_center, dim1 )
+      q1_inv = 1.d0 / qq1
+
+      call get_cxcycz( dim1, cx, cy, cz                                  &
+                     , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q &
+                     , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q )
+
+      schwartz_kl(s,r) = coef4 * dabs( cx + cy + cz )
+      schwartz_kl(0,r) = max( schwartz_kl(0,r) , schwartz_kl(s,r) )
+    enddo
+
+    schwartz_kl(0,0) = max( schwartz_kl(0,r) , schwartz_kl(0,0) )
+  enddo
+
+
+  j1b_gauss_coulerf_schwartz = 0.d0
+
+  do p = 1, ao_prim_num(i)
+    expo1 = ao_expo_ordered_transp(p, i)
+    coef1 = ao_coef_normalized_ordered_transp(p, i)
+
+    do q = 1, ao_prim_num(j)
+      expo2 = ao_expo_ordered_transp(q, j)
+      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+
+      call give_explicit_poly_and_gaussian( P1_new, P1_center, pp1, fact_p1, iorder_p, expo1, expo2 &
+                                          , I_power, J_power, I_center, J_center, dim1 )
+      p1_inv = 1.d0 / pp1
+
+      call get_cxcycz( dim1, cx, cy, cz                                  &
+                     , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p &
+                     , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p )
+
+      schwartz_ij = coef2 * coef2 * dabs( cx + cy + cz )
+      if( schwartz_kl(0,0) * schwartz_ij < thr ) cycle
+
+      do r = 1, ao_prim_num(k)
+        if( schwartz_kl(0,r) * schwartz_ij < thr ) cycle
+        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+        expo3 = ao_expo_ordered_transp(r, k)
+
+        do s = 1, ao_prim_num(l)
+          if( schwartz_kl(s,r) * schwartz_ij < thr ) cycle
+          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+          expo4 = ao_expo_ordered_transp(s, l)
+ 
+          call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 &
+                                              , K_power, L_power, K_center, L_center, dim1 )
+          q1_inv = 1.d0 / qq1
+
+          call get_cxcycz( dim1, cx, cy, cz                                  &
+                         , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p &
+                         , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q )
+
+          j1b_gauss_coulerf_schwartz = j1b_gauss_coulerf_schwartz + coef4 * ( cx + cy + cz )
+        enddo ! s
+      enddo  ! r
+    enddo   ! q
+  enddo    ! p
+
+  deallocate( schwartz_kl )
+
+  return
+end function j1b_gauss_coulerf_schwartz
+
+
+
+
+
+subroutine get_cxcycz( dim1, cx, cy, cz                                  &
+                     , P1_center, P1_new, pp1, fact_p1, p1_inv, iorder_p &
+                     , Q1_center, Q1_new, qq1, fact_q1, q1_inv, iorder_q )
+
+  include 'utils/constants.include.F'
+
+  implicit none
+
+  integer,          intent(in)  :: dim1
+  integer,          intent(in)  :: iorder_p(3), iorder_q(3)
+  double precision, intent(in)  :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1, p1_inv
+  double precision, intent(in)  :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1, q1_inv
+  double precision, intent(out) :: cx, cy, cz
+
+  integer                       :: ii
+  integer                       :: shift_P(3), shift_Q(3)
+  double precision              :: expoii, factii, Centerii(3)
+  double precision              :: P2_new(0:max_dim,3), P2_center(3), fact_p2, pp2, p2_inv
+  double precision              :: Q2_new(0:max_dim,3), Q2_center(3), fact_q2, qq2, q2_inv
+  double precision              :: ff, gg
+
+  double precision              :: general_primitive_integral_erf_shifted
+  double precision              :: general_primitive_integral_coul_shifted
+
+  cx = 0.d0
+  cy = 0.d0
+  cz = 0.d0
+  do ii = 1, nucl_num
+
+    expoii        = j1b_gauss_pen(ii)
+    Centerii(1:3) = nucl_coord(ii, 1:3)
+
+    call gaussian_product(pp1, P1_center, expoii, Centerii, factii, pp2, P2_center)
+    fact_p2 = fact_p1 * factii
+    p2_inv  = 1.d0 / pp2
+    call pol_modif_center( P1_center, P2_center, iorder_p, P1_new, P2_new )
+
+    call gaussian_product(qq1, Q1_center, expoii, Centerii, factii, qq2, Q2_center)
+    fact_q2 = fact_q1 * factii
+    q2_inv  = 1.d0 / qq2
+    call pol_modif_center( Q1_center, Q2_center, iorder_q, Q1_new, Q2_new )
+
+
+    ! ----------------------------------------------------------------------------------------------------
+    !                     [ (1-erf(mu r12)) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
+    ! ----------------------------------------------------------------------------------------------------
+
+    shift_Q = (/ 0, 0, 0 /)
+
+    ! x term:
+    ff = P2_center(1) - Centerii(1) 
+
+    shift_P = (/ 2, 0, 0 /)
+    cx = cx + expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cx = cx - expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_P = (/ 1, 0, 0 /)
+    cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P        &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q        )
+    cx = cx - expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P       &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q       )
+
+    shift_P = (/ 0, 0, 0 /)
+    cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+    cx = cx - expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+    ! y term:
+    ff = P2_center(2) - Centerii(2) 
+
+    shift_P = (/ 0, 2, 0 /)
+    cy = cy + expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cy = cy - expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_P = (/ 0, 1, 0 /)
+    cy = cy + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P        &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q        )
+    cy = cy - expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P       &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q       )
+
+    shift_P = (/ 0, 0, 0 /)
+    cy = cy + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+    cy = cy - expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+    ! z term:
+    ff = P2_center(3) - Centerii(3) 
+
+    shift_P = (/ 0, 0, 2 /)
+    cz = cz + expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cz = cz - expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_P = (/ 0, 0, 1 /)
+    cz = cz + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P        &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q        )
+    cz = cz - expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P       &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q       )
+
+    shift_P = (/ 0, 0, 0 /)
+    cz = cz + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+    cz = cz - expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+    ! ----------------------------------------------------------------------------------------------------
+
+
+
+    ! ----------------------------------------------------------------------------------------------------
+    !                     [ (1-erf(mu r12)) / r12 ] \sum_A a_A [ (r2-RA)^2 exp(-aA r2A^2)
+    ! ----------------------------------------------------------------------------------------------------
+
+    shift_P = (/ 0, 0, 0 /)
+
+    ! x term:
+    ff = Q2_center(1) - Centerii(1) 
+
+    shift_Q = (/ 2, 0, 0 /)
+    cx = cx + expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cx = cx - expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_Q = (/ 1, 0, 0 /)
+    cx = cx + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P        &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q        )
+    cx = cx - expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P       &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q       )
+
+    shift_Q = (/ 0, 0, 0 /)
+    cx = cx + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+    cx = cx - expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+    ! y term:
+    ff = Q2_center(2) - Centerii(2) 
+
+    shift_Q = (/ 0, 2, 0 /)
+    cy = cy + expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cy = cy - expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_Q = (/ 0, 1, 0 /)
+    cy = cy + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P        &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q        )
+    cy = cy - expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P       &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q       )
+
+    shift_Q = (/ 0, 0, 0 /)
+    cy = cy + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+    cy = cy - expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+    ! z term:
+    ff = Q2_center(3) - Centerii(3) 
+
+    shift_Q = (/ 0, 0, 2 /)
+    cz = cz + expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cz = cz - expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_Q = (/ 0, 0, 1 /)
+    cz = cz + expoii * 2.d0 * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P        &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q        )
+    cz = cz - expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P       &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q       )
+
+    shift_Q = (/ 0, 0, 0 /)
+    cz = cz + expoii * ff * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+    cz = cz - expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+    ! ----------------------------------------------------------------------------------------------------
+
+
+
+    ! ----------------------------------------------------------------------------------------------------
+    !              - [ (1-erf(mu r12)) / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) ]
+    ! ----------------------------------------------------------------------------------------------------
+
+    ! x term:
+    ff = P2_center(1) - Centerii(1) 
+    gg = Q1_center(1) - Centerii(1) 
+
+    shift_p = (/ 1, 0, 0 /)
+    shift_Q = (/ 1, 0, 0 /)
+    cx = cx - expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cx = cx + expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 1, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cx = cx - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cx = cx + expoii * gg * general_primitive_integral_erf_shifted( dim1  &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 1, 0, 0 /)
+    cx = cx - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cx = cx + expoii * ff * general_primitive_integral_erf_shifted( dim1  &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cx = cx - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+    cx = cx + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+    ! y term:
+    ff = P2_center(2) - Centerii(2) 
+    gg = Q1_center(2) - Centerii(2) 
+
+    shift_p = (/ 0, 1, 0 /)
+    shift_Q = (/ 0, 1, 0 /)
+    cy = cy - expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cy = cy + expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 1, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cy = cy - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cy = cy + expoii * gg * general_primitive_integral_erf_shifted( dim1  &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 1, 0 /)
+    cy = cy - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cy = cy + expoii * ff * general_primitive_integral_erf_shifted( dim1  &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cy = cy - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+    cy = cy + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+    ! z term:
+    ff = P2_center(3) - Centerii(3) 
+    gg = Q1_center(3) - Centerii(3) 
+
+    shift_p = (/ 0, 0, 1 /)
+    shift_Q = (/ 0, 0, 1 /)
+    cz = cz - expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cz = cz + expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 1 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cz = cz - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cz = cz + expoii * gg * general_primitive_integral_erf_shifted( dim1  &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 1 /)
+    cz = cz - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+    cz = cz + expoii * ff * general_primitive_integral_erf_shifted( dim1  &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cz = cz - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P      &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q      )
+    cz = cz + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+             , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+             , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+    ! ----------------------------------------------------------------------------------------------------
+
+
+
+    ! ----------------------------------------------------------------------------------------------------
+    !              - [ (1-erf(mu r12)) / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
+    ! ----------------------------------------------------------------------------------------------------
+
+    ! x term:
+    ff = P1_center(1) - Centerii(1) 
+    gg = Q2_center(1) - Centerii(1) 
+
+    shift_p = (/ 1, 0, 0 /)
+    shift_Q = (/ 1, 0, 0 /)
+    cx = cx - expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cx = cx + expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 1, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cx = cx - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cx = cx + expoii * gg * general_primitive_integral_erf_shifted( dim1  &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 1, 0, 0 /)
+    cx = cx - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cx = cx + expoii * ff * general_primitive_integral_erf_shifted( dim1  &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cx = cx - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+    cx = cx + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+    ! y term:
+    ff = P1_center(2) - Centerii(2) 
+    gg = Q2_center(2) - Centerii(2) 
+
+    shift_p = (/ 0, 1, 0 /)
+    shift_Q = (/ 0, 1, 0 /)
+    cy = cy - expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cy = cy + expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 1, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cy = cy - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cy = cy + expoii * gg * general_primitive_integral_erf_shifted( dim1  &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 1, 0 /)
+    cy = cy - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cy = cy + expoii * ff * general_primitive_integral_erf_shifted( dim1  &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cy = cy - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+    cy = cy + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+    ! z term:
+    ff = P1_center(3) - Centerii(3) 
+    gg = Q2_center(3) - Centerii(3) 
+
+    shift_p = (/ 0, 0, 1 /)
+    shift_Q = (/ 0, 0, 1 /)
+    cz = cz - expoii * general_primitive_integral_coul_shifted( dim1      &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cz = cz + expoii * general_primitive_integral_erf_shifted( dim1       &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 1 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cz = cz - expoii * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cz = cz + expoii * gg * general_primitive_integral_erf_shifted( dim1  &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 1 /)
+    cz = cz - expoii * ff * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+    cz = cz + expoii * ff * general_primitive_integral_erf_shifted( dim1  &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+    shift_p = (/ 0, 0, 0 /)
+    shift_Q = (/ 0, 0, 0 /)
+    cz = cz - expoii * ff * gg * general_primitive_integral_coul_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P      &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q      )
+    cz = cz + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+             , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+             , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+    ! ----------------------------------------------------------------------------------------------------
+
+  enddo
+
+  return
+end subroutine get_cxcycz
+

src/ao_tc_eff_map/two_e_1bgauss_erf.irp.f

@@ -0,0 +1,854 @@
+double precision function j1b_gauss_erf(i, j, k, l)
+
+  BEGIN_DOC
+  ! 
+  !  integral in the AO basis:
+  !     i(r1) j(r1) f(r12) k(r2) l(r2)
+  !
+  !  with:
+  !     f(r12) = - [ -0.5 erf(mu r12) / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ]
+  !            = - [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
+  !                                                 + (r2-RA)^2 exp(-aA r2A^2) 
+  !                                                 - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2)
+  !                                                 - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
+  !
+  END_DOC
+
+  include 'utils/constants.include.F'
+
+  implicit none
+
+  integer, intent(in) :: i, j, k, l
+
+  integer             :: p, q, r, s, ii
+  integer             :: num_i, num_j, num_k, num_l, num_ii 
+  integer             :: I_power(3), J_power(3), K_power(3), L_power(3)
+  integer             :: iorder_p(3), iorder_q(3)
+  integer             :: shift_P(3), shift_Q(3)
+  integer             :: dim1
+
+  double precision    :: coef1, coef2, coef3, coef4
+  double precision    :: expo1, expo2, expo3, expo4
+  double precision    :: p_inv, q_inv
+  double precision    :: P_new_tmp(0:max_dim,3), P_center_tmp(3), fact_p_tmp, pp_tmp
+  double precision    :: Q_new_tmp(0:max_dim,3), Q_center_tmp(3), fact_q_tmp, qq_tmp
+  double precision    :: P_new(0:max_dim,3), P_center(3), fact_p, pp
+  double precision    :: Q_new(0:max_dim,3), Q_center(3), fact_q, qq
+  double precision    :: I_center(3), J_center(3), K_center(3), L_center(3)
+  double precision    :: expoii, factii, Centerii(3)
+  double precision    :: ff, gg, cx, cy, cz
+
+  double precision    :: general_primitive_integral_erf_shifted
+  
+  PROVIDE mu_erf
+  PROVIDE j1b_gauss_pen
+
+  dim1 = n_pt_max_integrals
+
+  num_i = ao_nucl(i)
+  num_j = ao_nucl(j)
+  num_k = ao_nucl(k)
+  num_l = ao_nucl(l)
+
+  do p = 1, 3
+    I_power(p)  = ao_power(i,p)
+    J_power(p)  = ao_power(j,p)
+    K_power(p)  = ao_power(k,p)
+    L_power(p)  = ao_power(l,p)
+    I_center(p) = nucl_coord(num_i,p)
+    J_center(p) = nucl_coord(num_j,p)
+    K_center(p) = nucl_coord(num_k,p)
+    L_center(p) = nucl_coord(num_l,p)
+  enddo
+
+  j1b_gauss_erf = 0.d0
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  !
+  !               - [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
+  !
+  ! -------------------------------------------------------------------------------------------------------------------
+
+  shift_Q(1) = 0
+  shift_Q(2) = 0
+  shift_Q(3) = 0
+ 
+  do p = 1, ao_prim_num(i)
+    coef1 = ao_coef_normalized_ordered_transp(p, i)
+    expo1 = ao_expo_ordered_transp(p, i)
+
+    do q = 1, ao_prim_num(j)
+      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+      expo2 = ao_expo_ordered_transp(q, j)
+
+      call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 &
+                                          , I_power, J_power, I_center, J_center, dim1                          )
+
+      do r = 1, ao_prim_num(k)
+        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+        expo3 = ao_expo_ordered_transp(r, k)
+
+        do s = 1, ao_prim_num(l)
+          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+          expo4 = ao_expo_ordered_transp(s, l)
+ 
+          call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 &
+                                              , K_power, L_power, K_center, L_center, dim1          )
+          q_inv = 1.d0 / qq
+
+          cx = 0.d0
+          cy = 0.d0
+          cz = 0.d0
+          do ii = 1, nucl_num
+            expoii        = j1b_gauss_pen(ii)
+            Centerii(1:3) = nucl_coord(ii, 1:3)
+
+            call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center)
+
+            fact_p = fact_p_tmp * factii
+            p_inv  = 1.d0 / pp
+
+            ! pol centerd on P_center_tmp ==> centerd on P_center
+            call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new)
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! x term:
+
+            shift_P(2) = 0
+            shift_P(3) = 0
+
+            ff = P_center(1) - Centerii(1) 
+
+            shift_P(1) = 2
+            cx = cx + expoii * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_P(1) = 1
+            cx = cx + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P             &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q             )
+
+            shift_P(1) = 0
+            cx = cx + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! y term:
+
+            shift_P(1) = 0
+            shift_P(3) = 0
+
+            ff = P_center(2) - Centerii(2) 
+
+            shift_P(2) = 2
+            cy = cy + expoii * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_P(2) = 1
+            cy = cy + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P             &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q             )
+
+            shift_P(2) = 0
+            cy = cy + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! z term:
+
+            shift_P(1) = 0
+            shift_P(2) = 0
+
+            ff = P_center(3) - Centerii(3) 
+
+            shift_P(3) = 2
+            cz = cz + expoii * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_P(3) = 1
+            cz = cz + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P             &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q             )
+
+            shift_P(3) = 0
+            cz = cz + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+          enddo
+
+          j1b_gauss_erf = j1b_gauss_erf - coef4 * ( cx + cy + cz )
+        enddo ! s
+      enddo  ! r
+    enddo   ! q
+  enddo    ! p
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  ! -------------------------------------------------------------------------------------------------------------------
+
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  !
+  !               - [ erf(mu r12) / r12 ] \sum_A a_A [ (r2-RA)^2 exp(-aA r2A^2)
+  !
+  ! -------------------------------------------------------------------------------------------------------------------
+
+  shift_P(1) = 0
+  shift_P(2) = 0
+  shift_P(3) = 0
+ 
+  do p = 1, ao_prim_num(i)
+    coef1 = ao_coef_normalized_ordered_transp(p, i)
+    expo1 = ao_expo_ordered_transp(p, i)
+
+    do q = 1, ao_prim_num(j)
+      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+      expo2 = ao_expo_ordered_transp(q, j)
+
+      call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 &
+                                          , I_power, J_power, I_center, J_center, dim1          )
+      p_inv = 1.d0 / pp
+
+      do r = 1, ao_prim_num(k)
+        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+        expo3 = ao_expo_ordered_transp(r, k)
+
+        do s = 1, ao_prim_num(l)
+          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+          expo4 = ao_expo_ordered_transp(s, l)
+ 
+          call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 &
+                                              , K_power, L_power, K_center, L_center, dim1                          )
+
+          cx = 0.d0
+          cy = 0.d0
+          cz = 0.d0
+          do ii = 1, nucl_num
+            expoii        = j1b_gauss_pen(ii)
+            Centerii(1:3) = nucl_coord(ii, 1:3)
+
+            call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center)
+
+            fact_q = fact_q_tmp * factii
+            q_inv  = 1.d0 / qq
+
+            ! pol centerd on Q_center_tmp ==> centerd on Q_center
+            call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new)
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! x term:
+
+            shift_Q(2) = 0
+            shift_Q(3) = 0
+
+            ff = Q_center(1) - Centerii(1) 
+
+            shift_Q(1) = 2
+            cx = cx + expoii * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_Q(1) = 1
+            cx = cx + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P             &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q             )
+
+            shift_Q(1) = 0
+            cx = cx + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! y term:
+
+            shift_Q(1) = 0
+            shift_Q(3) = 0
+
+            ff = Q_center(2) - Centerii(2) 
+
+            shift_Q(2) = 2
+            cy = cy + expoii * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_Q(2) = 1
+            cy = cy + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P             &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q             )
+
+            shift_Q(2) = 0
+            cy = cy + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! z term:
+
+            shift_Q(1) = 0
+            shift_Q(2) = 0
+
+            ff = Q_center(3) - Centerii(3) 
+
+            shift_Q(3) = 2
+            cz = cz + expoii * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_Q(3) = 1
+            cz = cz + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P             &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q             )
+
+            shift_Q(3) = 0
+            cz = cz + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+          enddo
+
+          j1b_gauss_erf = j1b_gauss_erf - coef4 * ( cx + cy + cz )
+        enddo ! s
+      enddo  ! r
+    enddo   ! q
+  enddo    ! p
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  ! -------------------------------------------------------------------------------------------------------------------
+
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  !
+  !                  [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) ]
+  !
+  ! -------------------------------------------------------------------------------------------------------------------
+ 
+  do p = 1, ao_prim_num(i)
+    coef1 = ao_coef_normalized_ordered_transp(p, i)
+    expo1 = ao_expo_ordered_transp(p, i)
+
+    do q = 1, ao_prim_num(j)
+      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+      expo2 = ao_expo_ordered_transp(q, j)
+
+      call give_explicit_poly_and_gaussian( P_new_tmp, P_center_tmp, pp_tmp, fact_p_tmp, iorder_p, expo1, expo2 &
+                                          , I_power, J_power, I_center, J_center, dim1                          )
+
+      do r = 1, ao_prim_num(k)
+        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+        expo3 = ao_expo_ordered_transp(r, k)
+
+        do s = 1, ao_prim_num(l)
+          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+          expo4 = ao_expo_ordered_transp(s, l)
+ 
+          call give_explicit_poly_and_gaussian( Q_new, Q_center, qq, fact_q, iorder_q, expo3, expo4 &
+                                              , K_power, L_power, K_center, L_center, dim1          )
+          q_inv = 1.d0 / qq
+
+          cx = 0.d0
+          cy = 0.d0
+          cz = 0.d0
+          do ii = 1, nucl_num
+            expoii        = j1b_gauss_pen(ii)
+            Centerii(1:3) = nucl_coord(ii, 1:3)
+
+            call gaussian_product(pp_tmp, P_center_tmp, expoii, Centerii, factii, pp, P_center)
+
+            fact_p = fact_p_tmp * factii
+            p_inv  = 1.d0 / pp
+
+            ! pol centerd on P_center_tmp ==> centerd on P_center
+            call pol_modif_center( P_center_tmp, P_center, iorder_p, P_new_tmp, P_new)
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! x term:
+
+            shift_P(2) = 0
+            shift_P(3) = 0
+            shift_Q(2) = 0
+            shift_Q(3) = 0
+
+            ff = P_center(1) - Centerii(1) 
+            gg = Q_center(1) - Centerii(1) 
+
+            shift_P(1) = 1
+            shift_Q(1) = 1
+            cx = cx + expoii * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_P(1) = 1
+            shift_Q(1) = 0
+            cx = cx + expoii * gg * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_P(1) = 0
+            shift_Q(1) = 1
+            cx = cx + expoii * ff * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_P(1) = 0
+            shift_Q(1) = 0
+            cx = cx + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! y term:
+
+            shift_P(1) = 0
+            shift_P(3) = 0
+            shift_Q(1) = 0
+            shift_Q(3) = 0
+
+            ff = P_center(2) - Centerii(2) 
+            gg = Q_center(2) - Centerii(2) 
+
+            shift_P(2) = 1
+            shift_Q(2) = 1
+            cy = cy + expoii * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_P(2) = 1
+            shift_Q(2) = 0
+            cy = cy + expoii * gg * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_P(2) = 0
+            shift_Q(2) = 1
+            cy = cy + expoii * ff * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_P(2) = 0
+            shift_Q(2) = 0
+            cy = cy + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! z term:
+
+            shift_P(1) = 0
+            shift_P(2) = 0
+            shift_Q(1) = 0
+            shift_Q(2) = 0
+
+            ff = P_center(3) - Centerii(3) 
+            gg = Q_center(3) - Centerii(3) 
+
+            shift_P(3) = 1
+            shift_Q(3) = 1
+            cz = cz + expoii * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_P(3) = 1
+            shift_Q(3) = 0
+            cz = cz + expoii * gg * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_P(3) = 0
+            shift_Q(3) = 1
+            cz = cz + expoii * ff * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_P(3) = 0
+            shift_Q(3) = 0
+            cz = cz + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+          enddo
+
+          j1b_gauss_erf = j1b_gauss_erf + coef4 * ( cx + cy + cz )
+        enddo ! s
+      enddo  ! r
+    enddo   ! q
+  enddo    ! p
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  ! -------------------------------------------------------------------------------------------------------------------
+
+
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  !
+  !                  [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
+  !
+  ! -------------------------------------------------------------------------------------------------------------------
+ 
+  do p = 1, ao_prim_num(i)
+    coef1 = ao_coef_normalized_ordered_transp(p, i)
+    expo1 = ao_expo_ordered_transp(p, i)
+
+    do q = 1, ao_prim_num(j)
+      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+      expo2 = ao_expo_ordered_transp(q, j)
+
+      call give_explicit_poly_and_gaussian( P_new, P_center, pp, fact_p, iorder_p, expo1, expo2 &
+                                          , I_power, J_power, I_center, J_center, dim1          )
+      p_inv = 1.d0 / pp
+
+      do r = 1, ao_prim_num(k)
+        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+        expo3 = ao_expo_ordered_transp(r, k)
+
+        do s = 1, ao_prim_num(l)
+          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+          expo4 = ao_expo_ordered_transp(s, l)
+ 
+          call give_explicit_poly_and_gaussian( Q_new_tmp, Q_center_tmp, qq_tmp, fact_q_tmp, iorder_q, expo3, expo4 &
+                                              , K_power, L_power, K_center, L_center, dim1                          )
+
+          cx = 0.d0
+          cy = 0.d0
+          cz = 0.d0
+          do ii = 1, nucl_num
+            expoii        = j1b_gauss_pen(ii)
+            Centerii(1:3) = nucl_coord(ii, 1:3)
+
+            call gaussian_product(qq_tmp, Q_center_tmp, expoii, Centerii, factii, qq, Q_center)
+
+            fact_q = fact_q_tmp * factii
+            q_inv  = 1.d0 / qq
+
+            ! pol centerd on Q_center_tmp ==> centerd on Q_center
+            call pol_modif_center( Q_center_tmp, Q_center, iorder_q, Q_new_tmp, Q_new)
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! x term:
+
+            shift_P(2) = 0
+            shift_P(3) = 0
+            shift_Q(2) = 0
+            shift_Q(3) = 0
+
+            ff = P_center(1) - Centerii(1) 
+            gg = Q_center(1) - Centerii(1) 
+
+            shift_P(1) = 1
+            shift_Q(1) = 1
+            cx = cx + expoii * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_P(1) = 1
+            shift_Q(1) = 0
+            cx = cx + expoii * gg * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_P(1) = 0
+            shift_Q(1) = 1
+            cx = cx + expoii * ff * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_P(1) = 0
+            shift_Q(1) = 0
+            cx = cx + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! y term:
+
+            shift_P(1) = 0
+            shift_P(3) = 0
+            shift_Q(1) = 0
+            shift_Q(3) = 0
+
+            ff = P_center(2) - Centerii(2) 
+            gg = Q_center(2) - Centerii(2) 
+
+            shift_P(2) = 1
+            shift_Q(2) = 1
+            cy = cy + expoii * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_P(2) = 1
+            shift_Q(2) = 0
+            cy = cy + expoii * gg * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_P(2) = 0
+            shift_Q(2) = 1
+            cy = cy + expoii * ff * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_P(2) = 0
+            shift_Q(2) = 0
+            cy = cy + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+            ! ----------------------------------------------------------------------------------------------------
+            ! z term:
+
+            shift_P(1) = 0
+            shift_P(2) = 0
+            shift_Q(1) = 0
+            shift_Q(2) = 0
+
+            ff = P_center(3) - Centerii(3) 
+            gg = Q_center(3) - Centerii(3) 
+
+            shift_P(3) = 1
+            shift_Q(3) = 1
+            cz = cz + expoii * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q )
+
+            shift_P(3) = 1
+            shift_Q(3) = 0
+            cz = cz + expoii * gg * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_P(3) = 0
+            shift_Q(3) = 1
+            cz = cz + expoii * ff * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P      &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q      )
+
+            shift_P(3) = 0
+            shift_Q(3) = 0
+            cz = cz + expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+                    , P_new, P_center, fact_p, pp, p_inv, iorder_p, shift_P           &
+                    , Q_new, Q_center, fact_q, qq, q_inv, iorder_q, shift_Q           )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+          enddo
+
+          j1b_gauss_erf = j1b_gauss_erf + coef4 * ( cx + cy + cz )
+
+        enddo ! s
+      enddo  ! r
+    enddo   ! q
+  enddo    ! p
+
+  ! -------------------------------------------------------------------------------------------------------------------
+  ! -------------------------------------------------------------------------------------------------------------------
+
+
+  return
+end function j1b_gauss_erf
+
+
+
+
+!______________________________________________________________________________________________________________________
+!______________________________________________________________________________________________________________________
+
+double precision function general_primitive_integral_erf_shifted( dim                                                  &
+                                                                , P_new, P_center, fact_p, p, p_inv, iorder_p, shift_P &
+                                                                , Q_new, Q_center, fact_q, q, q_inv, iorder_q, shift_Q )
+
+  include 'utils/constants.include.F'
+
+  implicit none
+
+  integer,          intent(in) :: dim
+  integer,          intent(in) :: iorder_p(3), shift_P(3)
+  integer,          intent(in) :: iorder_q(3), shift_Q(3)
+  double precision, intent(in) :: P_new(0:max_dim,3), P_center(3), fact_p, p, p_inv
+  double precision, intent(in) :: Q_new(0:max_dim,3), Q_center(3), fact_q, q, q_inv
+
+  integer                      :: n_Ix, n_Iy, n_Iz, nx, ny, nz
+  integer                      :: ix, iy, iz, jx, jy, jz, i
+  integer                      :: n_pt_tmp, n_pt_out, iorder
+  integer                      :: ii, jj
+  double precision             :: rho, dist
+  double precision             :: dx(0:max_dim), Ix_pol(0:max_dim)
+  double precision             :: dy(0:max_dim), Iy_pol(0:max_dim)
+  double precision             :: dz(0:max_dim), Iz_pol(0:max_dim)
+  double precision             :: a, b, c, d, e, f, accu, pq, const
+  double precision             :: pq_inv, p10_1, p10_2, p01_1, p01_2, pq_inv_2
+  double precision             :: d1(0:max_dim), d_poly(0:max_dim)
+  double precision             :: p_plus_q
+
+  double precision             :: rint_sum
+
+  general_primitive_integral_erf_shifted = 0.d0
+
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: dx, Ix_pol, dy, Iy_pol, dz, Iz_pol
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: d1, d_poly
+
+  ! Gaussian Product
+  ! ----------------
+  p_plus_q = (p+q) * ( (p*q)/(p+q) + mu_erf*mu_erf ) / (mu_erf*mu_erf)
+  pq       = p_inv * 0.5d0 * q_inv
+  pq_inv   = 0.5d0 / p_plus_q
+  p10_1    = q * pq             ! 1/(2p)
+  p01_1    = p * pq             ! 1/(2q)
+  pq_inv_2 = pq_inv + pq_inv
+  p10_2    = pq_inv_2 * p10_1 * q ! 0.5d0 * q / (pq + p*p)
+  p01_2    = pq_inv_2 * p01_1 * p ! 0.5d0 * p / (q*q + pq)
+
+  accu = 0.d0
+
+  iorder = iorder_p(1) + iorder_q(1) + iorder_p(1) + iorder_q(1)
+  iorder = iorder + shift_P(1) + shift_Q(1)
+  iorder = iorder + shift_P(1) + shift_Q(1)
+  !DIR$ VECTOR ALIGNED
+  do ix = 0, iorder
+    Ix_pol(ix) = 0.d0
+  enddo
+  n_Ix = 0
+  do ix = 0, iorder_p(1)
+
+    ii = ix + shift_P(1)
+    a  = P_new(ix,1)
+    if(abs(a) < thresh) cycle
+
+    do jx = 0, iorder_q(1)
+
+      jj = jx + shift_Q(1)
+      d  = a * Q_new(jx,1)
+      if(abs(d) < thresh) cycle
+
+      !DEC$ FORCEINLINE
+      call give_polynom_mult_center_x( P_center(1), Q_center(1), ii, jj &
+                                     , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dx, nx )
+      !DEC$ FORCEINLINE
+      call add_poly_multiply(dx, nx, d, Ix_pol, n_Ix)
+    enddo
+  enddo
+  if(n_Ix == -1) then
+    return
+  endif
+
+  iorder = iorder_p(2) + iorder_q(2) + iorder_p(2) + iorder_q(2)
+  iorder = iorder + shift_P(2) + shift_Q(2)
+  iorder = iorder + shift_P(2) + shift_Q(2)
+  !DIR$ VECTOR ALIGNED
+  do ix = 0, iorder
+    Iy_pol(ix) = 0.d0
+  enddo
+  n_Iy = 0
+  do iy = 0, iorder_p(2)
+
+    if(abs(P_new(iy,2)) > thresh) then
+
+      ii = iy + shift_P(2)
+      b  = P_new(iy,2)
+
+      do jy = 0, iorder_q(2)
+
+        jj = jy + shift_Q(2)
+        e  = b * Q_new(jy,2)
+        if(abs(e) < thresh) cycle
+
+        !DEC$ FORCEINLINE
+        call give_polynom_mult_center_x( P_center(2), Q_center(2), ii, jj &
+                                       , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dy, ny )
+        !DEC$ FORCEINLINE
+        call add_poly_multiply(dy, ny, e, Iy_pol, n_Iy)
+      enddo
+    endif
+  enddo
+  if(n_Iy == -1) then
+    return
+  endif
+
+  iorder = iorder_p(3) + iorder_q(3) + iorder_p(3) + iorder_q(3)
+  iorder = iorder + shift_P(3) + shift_Q(3)
+  iorder = iorder + shift_P(3) + shift_Q(3)
+  do ix = 0, iorder
+    Iz_pol(ix) = 0.d0
+  enddo
+  n_Iz = 0
+  do iz = 0, iorder_p(3)
+
+    if( abs(P_new(iz,3)) > thresh ) then
+
+      ii = iz + shift_P(3)
+      c  = P_new(iz,3)
+
+      do jz = 0, iorder_q(3)
+
+        jj = jz + shift_Q(3)
+        f  = c * Q_new(jz,3)
+        if(abs(f) < thresh) cycle
+
+        !DEC$ FORCEINLINE
+        call give_polynom_mult_center_x( P_center(3), Q_center(3), ii, jj &
+                                       , p, q, iorder, pq_inv, pq_inv_2, p10_1, p01_1, p10_2, p01_2, dz, nz )
+        !DEC$ FORCEINLINE
+        call add_poly_multiply(dz, nz, f, Iz_pol, n_Iz)
+      enddo
+    endif
+  enddo
+  if(n_Iz == -1) then
+    return
+  endif
+
+  rho = p * q * pq_inv_2
+  dist = (P_center(1) - Q_center(1)) * (P_center(1) - Q_center(1)) &
+       + (P_center(2) - Q_center(2)) * (P_center(2) - Q_center(2)) &
+       + (P_center(3) - Q_center(3)) * (P_center(3) - Q_center(3))
+  const = dist*rho
+
+  n_pt_tmp = n_Ix + n_Iy
+  do i = 0, n_pt_tmp
+    d_poly(i) = 0.d0
+  enddo
+
+  !DEC$ FORCEINLINE
+  call multiply_poly(Ix_pol, n_Ix, Iy_pol, n_Iy, d_poly, n_pt_tmp)
+  if(n_pt_tmp == -1) then
+    return
+  endif
+  n_pt_out = n_pt_tmp + n_Iz
+  do i = 0, n_pt_out
+    d1(i) = 0.d0
+  enddo
+
+  !DEC$ FORCEINLINE
+  call multiply_poly(d_poly, n_pt_tmp, Iz_pol, n_Iz, d1, n_pt_out)
+  accu = accu + rint_sum(n_pt_out, const, d1)
+
+  general_primitive_integral_erf_shifted = fact_p * fact_q * accu * pi_5_2 * p_inv * q_inv / dsqrt(p_plus_q)
+
+  return
+end function general_primitive_integral_erf_shifted
+!______________________________________________________________________________________________________________________
+!______________________________________________________________________________________________________________________

src/ao_tc_eff_map/two_e_1bgauss_erf_acc.irp.f

@@ -0,0 +1,433 @@
+double precision function j1b_gauss_erf_acc(i, j, k, l)
+
+  BEGIN_DOC
+  ! 
+  !  integral in the AO basis:
+  !     i(r1) j(r1) f(r12) k(r2) l(r2)
+  !
+  !  with:
+  !     f(r12) = - [ -0.5 erf(mu r12) / r12 ] (r1-r2) \cdot \sum_A (-2 a_A) [ r1A exp(-aA r1A^2) - r2A exp(-aA r2A^2) ]
+  !            = - [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
+  !                                                 + (r2-RA)^2 exp(-aA r2A^2) 
+  !                                                 - (r1-RA) \cdot (r2-RA) exp(-aA r1A^2)
+  !                                                 - (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
+  !
+  END_DOC
+
+  include 'utils/constants.include.F'
+
+  implicit none
+
+  integer, intent(in) :: i, j, k, l
+
+  integer             :: p, q, r, s, ii
+  integer             :: num_i, num_j, num_k, num_l, num_ii 
+  integer             :: I_power(3), J_power(3), K_power(3), L_power(3)
+  integer             :: iorder_p(3), iorder_q(3)
+  integer             :: shift_P(3), shift_Q(3)
+  integer             :: dim1
+
+  double precision    :: coef1, coef2, coef3, coef4
+  double precision    :: expo1, expo2, expo3, expo4
+  double precision    :: p1_inv, q1_inv, p2_inv, q2_inv
+  double precision    :: P1_new(0:max_dim,3), P1_center(3), fact_p1, pp1
+  double precision    :: P2_new(0:max_dim,3), P2_center(3), fact_p2, pp2
+  double precision    :: Q1_new(0:max_dim,3), Q1_center(3), fact_q1, qq1
+  double precision    :: Q2_new(0:max_dim,3), Q2_center(3), fact_q2, qq2
+  double precision    :: I_center(3), J_center(3), K_center(3), L_center(3)
+  double precision    :: expoii, factii, Centerii(3)
+  double precision    :: ff, gg, cx, cy, cz
+
+  double precision    :: general_primitive_integral_erf_shifted
+  !double precision    :: j1b_gauss_erf_schwartz_accel
+  
+  PROVIDE j1b_gauss_pen
+
+  dim1 = n_pt_max_integrals
+
+  ! TODO
+  !if( ao_prim_num(i) * ao_prim_num(j) * ao_prim_num(k) * ao_prim_num(l) > 1024 ) then
+  !  j1b_gauss_erf_schwartz_accel = j1b_gauss_erf_schwartz_accel(i, j, k, l)
+  !  return
+  !endif
+
+  num_i = ao_nucl(i)
+  num_j = ao_nucl(j)
+  num_k = ao_nucl(k)
+  num_l = ao_nucl(l)
+
+  do p = 1, 3
+    I_power(p)  = ao_power(i,p)
+    J_power(p)  = ao_power(j,p)
+    K_power(p)  = ao_power(k,p)
+    L_power(p)  = ao_power(l,p)
+    I_center(p) = nucl_coord(num_i,p)
+    J_center(p) = nucl_coord(num_j,p)
+    K_center(p) = nucl_coord(num_k,p)
+    L_center(p) = nucl_coord(num_l,p)
+  enddo
+
+  j1b_gauss_erf_acc = 0.d0
+
+  do p = 1, ao_prim_num(i)
+    coef1 = ao_coef_normalized_ordered_transp(p, i)
+    expo1 = ao_expo_ordered_transp(p, i)
+
+    do q = 1, ao_prim_num(j)
+      coef2 = coef1 * ao_coef_normalized_ordered_transp(q, j)
+      expo2 = ao_expo_ordered_transp(q, j)
+
+      call give_explicit_poly_and_gaussian( P1_new, P1_center, pp1, fact_p1, iorder_p, expo1, expo2 &
+                                          , I_power, J_power, I_center, J_center, dim1 )
+      p1_inv = 1.d0 / pp1
+
+      do r = 1, ao_prim_num(k)
+        coef3 = coef2 * ao_coef_normalized_ordered_transp(r, k)
+        expo3 = ao_expo_ordered_transp(r, k)
+
+        do s = 1, ao_prim_num(l)
+          coef4 = coef3 * ao_coef_normalized_ordered_transp(s, l)
+          expo4 = ao_expo_ordered_transp(s, l)
+ 
+          call give_explicit_poly_and_gaussian( Q1_new, Q1_center, qq1, fact_q1, iorder_q, expo3, expo4 &
+                                              , K_power, L_power, K_center, L_center, dim1 )
+          q1_inv = 1.d0 / qq1
+
+          cx = 0.d0
+          cy = 0.d0
+          cz = 0.d0
+          do ii = 1, nucl_num
+            expoii        = j1b_gauss_pen(ii)
+            Centerii(1:3) = nucl_coord(ii, 1:3)
+
+            call gaussian_product(pp1, P1_center, expoii, Centerii, factii, pp2, P2_center)
+            fact_p2 = fact_p1 * factii
+            p2_inv  = 1.d0 / pp2
+            call pol_modif_center( P1_center, P2_center, iorder_p, P1_new, P2_new)
+
+            call gaussian_product(qq1, Q1_center, expoii, Centerii, factii, qq2, Q2_center)
+            fact_q2 = fact_q1 * factii
+            q2_inv  = 1.d0 / qq2
+            call pol_modif_center( Q1_center, Q2_center, iorder_q, Q1_new, Q2_new)
+
+
+            ! ----------------------------------------------------------------------------------------------------
+            !                         [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA)^2 exp(-aA r1A^2)
+            ! ----------------------------------------------------------------------------------------------------
+
+            shift_Q = (/ 0, 0, 0 /)
+
+            ! x term:
+            ff = P2_center(1) - Centerii(1) 
+
+            shift_P = (/ 2, 0, 0 /)
+            cx = cx + expoii * general_primitive_integral_erf_shifted( dim1       &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_P = (/ 1, 0, 0 /)
+            cx = cx + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P       &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q       )
+
+            shift_P = (/ 0, 0, 0 /)
+            cx = cx + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+            ! y term:
+            ff = P2_center(2) - Centerii(2) 
+
+            shift_P = (/ 0, 2, 0 /)
+            cy = cy + expoii * general_primitive_integral_erf_shifted( dim1       &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_P = (/ 0, 1, 0 /)
+            cy = cy + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P       &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q       )
+
+            shift_P = (/ 0, 0, 0 /)
+            cy = cy + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+            ! z term:
+            ff = P2_center(3) - Centerii(3) 
+
+            shift_P = (/ 0, 0, 2 /)
+            cz = cz + expoii * general_primitive_integral_erf_shifted( dim1       &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_P = (/ 0, 0, 1 /)
+            cz = cz + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P       &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q       )
+
+            shift_P = (/ 0, 0, 0 /)
+            cz = cz + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+
+
+            ! ----------------------------------------------------------------------------------------------------
+            !                         [ erf(mu r12) / r12 ] \sum_A a_A [ (r2-RA)^2 exp(-aA r2A^2)
+            ! ----------------------------------------------------------------------------------------------------
+
+            shift_P = (/ 0, 0, 0 /)
+
+            ! x term:
+            ff = Q2_center(1) - Centerii(1) 
+
+            shift_Q = (/ 2, 0, 0 /)
+            cx = cx + expoii * general_primitive_integral_erf_shifted( dim1       &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_Q = (/ 1, 0, 0 /)
+            cx = cx + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P       &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q       )
+
+            shift_Q = (/ 0, 0, 0 /)
+            cx = cx + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+            ! y term:
+            ff = Q2_center(2) - Centerii(2) 
+
+            shift_Q = (/ 0, 2, 0 /)
+            cy = cy + expoii * general_primitive_integral_erf_shifted( dim1       &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_Q = (/ 0, 1, 0 /)
+            cy = cy + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P       &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q       )
+
+            shift_Q = (/ 0, 0, 0 /)
+            cy = cy + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+            ! z term:
+            ff = Q2_center(3) - Centerii(3) 
+
+            shift_Q = (/ 0, 0, 2 /)
+            cz = cz + expoii * general_primitive_integral_erf_shifted( dim1       &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_Q = (/ 0, 0, 1 /)
+            cz = cz + expoii * 2.d0 * ff * general_primitive_integral_erf_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P       &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q       )
+
+            shift_Q = (/ 0, 0, 0 /)
+            cz = cz + expoii * ff * ff * general_primitive_integral_erf_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+
+
+            ! ----------------------------------------------------------------------------------------------------
+            !                 - [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r1A^2) ]
+            ! ----------------------------------------------------------------------------------------------------
+
+            ! x term:
+            ff = P2_center(1) - Centerii(1) 
+            gg = Q1_center(1) - Centerii(1) 
+
+            shift_p = (/ 1, 0, 0 /)
+            shift_Q = (/ 1, 0, 0 /)
+            cx = cx - expoii * general_primitive_integral_erf_shifted( dim1       &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 1, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cx = cx - expoii * gg * general_primitive_integral_erf_shifted( dim1  &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 1, 0, 0 /)
+            cx = cx - expoii * ff * general_primitive_integral_erf_shifted( dim1  &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cx = cx - expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+            ! y term:
+            ff = P2_center(2) - Centerii(2) 
+            gg = Q1_center(2) - Centerii(2) 
+
+            shift_p = (/ 0, 1, 0 /)
+            shift_Q = (/ 0, 1, 0 /)
+            cy = cy - expoii * general_primitive_integral_erf_shifted( dim1       &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 1, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cy = cy - expoii * gg * general_primitive_integral_erf_shifted( dim1  &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 1, 0 /)
+            cy = cy - expoii * ff * general_primitive_integral_erf_shifted( dim1  &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cy = cy - expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+            ! z term:
+            ff = P2_center(3) - Centerii(3) 
+            gg = Q1_center(3) - Centerii(3) 
+
+            shift_p = (/ 0, 0, 1 /)
+            shift_Q = (/ 0, 0, 1 /)
+            cz = cz - expoii * general_primitive_integral_erf_shifted( dim1       &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 1 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cz = cz - expoii * gg * general_primitive_integral_erf_shifted( dim1  &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 1 /)
+            cz = cz - expoii * ff * general_primitive_integral_erf_shifted( dim1  &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cz = cz - expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+                     , P2_new, P2_center, fact_p2, pp2, p2_inv, iorder_p, shift_P     &
+                     , Q1_new, Q1_center, fact_q1, qq1, q1_inv, iorder_q, shift_Q     )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+
+
+            ! ----------------------------------------------------------------------------------------------------
+            !                 - [ erf(mu r12) / r12 ] \sum_A a_A [ (r1-RA) \cdot (r2-RA) exp(-aA r2A^2) ]
+            ! ----------------------------------------------------------------------------------------------------
+
+            ! x term:
+            ff = P1_center(1) - Centerii(1) 
+            gg = Q2_center(1) - Centerii(1) 
+
+            shift_p = (/ 1, 0, 0 /)
+            shift_Q = (/ 1, 0, 0 /)
+            cx = cx - expoii * general_primitive_integral_erf_shifted( dim1       &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 1, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cx = cx - expoii * gg * general_primitive_integral_erf_shifted( dim1  &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 1, 0, 0 /)
+            cx = cx - expoii * ff * general_primitive_integral_erf_shifted( dim1  &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cx = cx - expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+            ! y term:
+            ff = P1_center(2) - Centerii(2) 
+            gg = Q2_center(2) - Centerii(2) 
+
+            shift_p = (/ 0, 1, 0 /)
+            shift_Q = (/ 0, 1, 0 /)
+            cy = cy - expoii * general_primitive_integral_erf_shifted( dim1       &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 1, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cy = cy - expoii * gg * general_primitive_integral_erf_shifted( dim1  &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 1, 0 /)
+            cy = cy - expoii * ff * general_primitive_integral_erf_shifted( dim1  &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cy = cy - expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+            ! z term:
+            ff = P1_center(3) - Centerii(3) 
+            gg = Q2_center(3) - Centerii(3) 
+
+            shift_p = (/ 0, 0, 1 /)
+            shift_Q = (/ 0, 0, 1 /)
+            cz = cz - expoii * general_primitive_integral_erf_shifted( dim1       &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 1 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cz = cz - expoii * gg * general_primitive_integral_erf_shifted( dim1  &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 1 /)
+            cz = cz - expoii * ff * general_primitive_integral_erf_shifted( dim1  &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q )
+
+            shift_p = (/ 0, 0, 0 /)
+            shift_Q = (/ 0, 0, 0 /)
+            cz = cz - expoii * ff * gg * general_primitive_integral_erf_shifted( dim1 &
+                     , P1_new, P1_center, fact_p1, pp1, p1_inv, iorder_p, shift_P     &
+                     , Q2_new, Q2_center, fact_q2, qq2, q2_inv, iorder_q, shift_Q     )
+
+            ! ----------------------------------------------------------------------------------------------------
+
+          enddo
+
+          j1b_gauss_erf_acc = j1b_gauss_erf_acc - coef4 * ( cx + cy + cz )
+        enddo ! s
+      enddo  ! r
+    enddo   ! q
+  enddo    ! p
+
+  return
+end function j1b_gauss_erf_acc

src/ao_tc_eff_map/two_e_ints_gauss.irp.f

@@ -0,0 +1,326 @@
+double precision function ao_tc_sym_two_e_pot(i,j,k,l)
+  implicit none
+  BEGIN_DOC
+  !  integral of the AO basis <ik|jl> or (ij|kl)
+  !     i(r1) j(r1) (tc_pot(r12,mu)) k(r2) l(r2)
+  !
+  ! where (tc_pot(r12,mu)) is the scalar part of the potential EXCLUDING the term erf(mu r12)/r12. 
+  !
+  ! See Eq. (32) of JCP 154, 084119 (2021). 
+  END_DOC
+  integer,intent(in)             :: i,j,k,l
+  integer                        :: p,q,r,s
+  double precision               :: I_center(3),J_center(3),K_center(3),L_center(3)
+  integer                        :: num_i,num_j,num_k,num_l,dim1,I_power(3),J_power(3),K_power(3),L_power(3)
+  double precision               :: integral
+  include 'utils/constants.include.F'
+  double precision               :: P_new(0:max_dim,3),P_center(3),fact_p,pp
+  double precision               :: Q_new(0:max_dim,3),Q_center(3),fact_q,qq
+  integer                        :: iorder_p(3), iorder_q(3)
+  double precision, allocatable  :: schwartz_kl(:,:)
+  double precision               :: schwartz_ij
+  double precision :: scw_gauss_int,general_primitive_integral_gauss
+
+  dim1 = n_pt_max_integrals
+
+  num_i = ao_nucl(i)
+  num_j = ao_nucl(j)
+  num_k = ao_nucl(k)
+  num_l = ao_nucl(l)
+  ao_tc_sym_two_e_pot = 0.d0
+  double precision               :: thr
+  thr = ao_integrals_threshold*ao_integrals_threshold
+
+  allocate(schwartz_kl(0:ao_prim_num(l),0:ao_prim_num(k)))
+
+      double precision               :: coef3
+      double precision               :: coef2
+      double precision               :: p_inv,q_inv
+      double precision               :: coef1
+      double precision               :: coef4
+
+    do p = 1, 3
+      I_power(p) = ao_power(i,p)
+      J_power(p) = ao_power(j,p)
+      K_power(p) = ao_power(k,p)
+      L_power(p) = ao_power(l,p)
+      I_center(p) = nucl_coord(num_i,p)
+      J_center(p) = nucl_coord(num_j,p)
+      K_center(p) = nucl_coord(num_k,p)
+      L_center(p) = nucl_coord(num_l,p)
+    enddo
+
+    schwartz_kl(0,0) = 0.d0
+    do r = 1, ao_prim_num(k)
+      coef1 = ao_coef_normalized_ordered_transp(r,k)*ao_coef_normalized_ordered_transp(r,k)
+      schwartz_kl(0,r) = 0.d0
+      do s = 1, ao_prim_num(l)
+        coef2 = coef1 * ao_coef_normalized_ordered_transp(s,l) * ao_coef_normalized_ordered_transp(s,l)
+        call give_explicit_poly_and_gaussian(Q_new,Q_center,qq,fact_q,iorder_q,&
+            ao_expo_ordered_transp(r,k),ao_expo_ordered_transp(s,l),                 &
+            K_power,L_power,K_center,L_center,dim1)
+        q_inv = 1.d0/qq
+        scw_gauss_int = general_primitive_integral_gauss(dim1,              &
+                Q_new,Q_center,fact_q,qq,q_inv,iorder_q,             &
+                Q_new,Q_center,fact_q,qq,q_inv,iorder_q)
+
+        schwartz_kl(s,r) = dabs(scw_gauss_int * coef2)
+        schwartz_kl(0,r) = max(schwartz_kl(0,r),schwartz_kl(s,r))
+      enddo
+      schwartz_kl(0,0) = max(schwartz_kl(0,r),schwartz_kl(0,0))
+    enddo
+    do p = 1, ao_prim_num(i)
+      coef1 = ao_coef_normalized_ordered_transp(p,i)
+      do q = 1, ao_prim_num(j)
+        coef2 = coef1*ao_coef_normalized_ordered_transp(q,j)
+        call give_explicit_poly_and_gaussian(P_new,P_center,pp,fact_p,iorder_p,&
+            ao_expo_ordered_transp(p,i),ao_expo_ordered_transp(q,j),                 &
+            I_power,J_power,I_center,J_center,dim1)
+        p_inv = 1.d0/pp
+        scw_gauss_int = general_primitive_integral_gauss(dim1,              &
+                P_new,P_center,fact_p,pp,p_inv,iorder_p,             &
+                P_new,P_center,fact_p,pp,p_inv,iorder_p)
+        schwartz_ij = dabs(scw_gauss_int * coef2*coef2)
+        if (schwartz_kl(0,0)*schwartz_ij < thr) then
+           cycle
+        endif
+        do r = 1, ao_prim_num(k)
+          if (schwartz_kl(0,r)*schwartz_ij < thr) then
+             cycle
+          endif
+          coef3 = coef2*ao_coef_normalized_ordered_transp(r,k)
+          do s = 1, ao_prim_num(l)
+            if (schwartz_kl(s,r)*schwartz_ij < thr) then
+               cycle
+            endif
+            coef4 = coef3*ao_coef_normalized_ordered_transp(s,l)
+            call give_explicit_poly_and_gaussian(Q_new,Q_center,qq,fact_q,iorder_q, &
+                ao_expo_ordered_transp(r,k),ao_expo_ordered_transp(s,l),            &
+                K_power,L_power,K_center,L_center,dim1)
+            q_inv = 1.d0/qq
+            integral = general_primitive_integral_gauss(dim1,              &
+                P_new,P_center,fact_p,pp,p_inv,iorder_p,             &
+                Q_new,Q_center,fact_q,qq,q_inv,iorder_q)
+            ao_tc_sym_two_e_pot = ao_tc_sym_two_e_pot + coef4 * integral
+          enddo ! s
+        enddo  ! r
+      enddo   ! q
+    enddo    ! p
+
+  deallocate (schwartz_kl)
+
+end
+
+
+double precision function general_primitive_integral_gauss(dim,      &
+      P_new,P_center,fact_p,p,p_inv,iorder_p,                        &
+      Q_new,Q_center,fact_q,q,q_inv,iorder_q)
+  implicit none
+  BEGIN_DOC
+  ! Computes the integral <pq|rs> where p,q,r,s are Gaussian primitives
+  END_DOC
+  integer,intent(in)             :: dim
+  include 'utils/constants.include.F'
+  double precision, intent(in)   :: P_new(0:max_dim,3),P_center(3),fact_p,p,p_inv
+  double precision, intent(in)   :: Q_new(0:max_dim,3),Q_center(3),fact_q,q,q_inv
+  integer, intent(in)            :: iorder_p(3)
+  integer, intent(in)            :: iorder_q(3)
+
+  double precision               :: r_cut,gama_r_cut,rho,dist
+  double precision               :: dx(0:max_dim),Ix_pol(0:max_dim),dy(0:max_dim),Iy_pol(0:max_dim),dz(0:max_dim),Iz_pol(0:max_dim)
+  integer                        :: n_Ix,n_Iy,n_Iz,nx,ny,nz
+  double precision               :: bla
+  integer                        :: ix,iy,iz,jx,jy,jz,i
+  double precision               :: a,b,c,d,e,f,accu,pq,const
+  double precision               :: pq_inv, p10_1, p10_2, p01_1, p01_2,pq_inv_2
+  integer                        :: n_pt_tmp,n_pt_out, iorder
+  double precision               :: d1(0:max_dim),d_poly(0:max_dim),rint,d1_screened(0:max_dim)
+  double precision :: thr
+
+  thr = ao_integrals_threshold
+
+  general_primitive_integral_gauss = 0.d0
+
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: dx,Ix_pol,dy,Iy_pol,dz,Iz_pol
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: d1, d_poly
+
+  ! Gaussian Product
+  ! ----------------
+
+  pq = p_inv*0.5d0*q_inv
+  pq_inv = 0.5d0/(p+q)
+  p10_1 = q*pq  ! 1/(2p)
+  p01_1 = p*pq  ! 1/(2q)
+  pq_inv_2 = pq_inv+pq_inv
+  p10_2 = pq_inv_2 * p10_1*q !0.5d0*q/(pq + p*p)
+  p01_2 = pq_inv_2 * p01_1*p !0.5d0*p/(q*q + pq)
+
+
+  accu = 0.d0
+  iorder = iorder_p(1)+iorder_q(1)+iorder_p(1)+iorder_q(1)
+  do ix=0,iorder
+    Ix_pol(ix) = 0.d0
+  enddo
+  n_Ix = 0
+  do ix = 0, iorder_p(1)
+    if (abs(P_new(ix,1)) < thr) cycle
+    a = P_new(ix,1)
+    do jx = 0, iorder_q(1)
+      d = a*Q_new(jx,1)
+      if (abs(d) < thr) cycle
+      !DIR$ FORCEINLINE
+      call give_polynom_mult_center_x(P_center(1),Q_center(1),ix,jx,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dx,nx)
+      !DIR$ FORCEINLINE
+      call add_poly_multiply(dx,nx,d,Ix_pol,n_Ix)
+    enddo
+  enddo
+  if (n_Ix == -1) then
+    return
+  endif
+  iorder = iorder_p(2)+iorder_q(2)+iorder_p(2)+iorder_q(2)
+  do ix=0, iorder
+    Iy_pol(ix) = 0.d0
+  enddo
+  n_Iy = 0
+  do iy = 0, iorder_p(2)
+    if (abs(P_new(iy,2)) > thr) then
+      b = P_new(iy,2)
+      do jy = 0, iorder_q(2)
+        e = b*Q_new(jy,2)
+        if (abs(e) < thr) cycle
+        !DIR$ FORCEINLINE
+        call   give_polynom_mult_center_x(P_center(2),Q_center(2),iy,jy,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dy,ny)
+        !DIR$ FORCEINLINE
+        call add_poly_multiply(dy,ny,e,Iy_pol,n_Iy)
+      enddo
+    endif
+  enddo
+  if (n_Iy == -1) then
+    return
+  endif
+
+  iorder = iorder_p(3)+iorder_q(3)+iorder_p(3)+iorder_q(3)
+  do ix=0,iorder
+    Iz_pol(ix) = 0.d0
+  enddo
+  n_Iz = 0
+  do iz = 0, iorder_p(3)
+    if (abs(P_new(iz,3)) > thr) then
+      c = P_new(iz,3)
+      do jz = 0, iorder_q(3)
+        f = c*Q_new(jz,3)
+        if (abs(f) < thr) cycle
+        !DIR$ FORCEINLINE
+        call   give_polynom_mult_center_x(P_center(3),Q_center(3),iz,jz,p,q,iorder,pq_inv,pq_inv_2,p10_1,p01_1,p10_2,p01_2,dz,nz)
+        !DIR$ FORCEINLINE
+        call add_poly_multiply(dz,nz,f,Iz_pol,n_Iz)
+      enddo
+    endif
+  enddo
+  if (n_Iz == -1) then
+    return
+  endif
+
+  rho = p*q *pq_inv_2
+  dist =  (P_center(1) - Q_center(1))*(P_center(1) - Q_center(1)) +  &
+      (P_center(2) - Q_center(2))*(P_center(2) - Q_center(2)) +      &
+      (P_center(3) - Q_center(3))*(P_center(3) - Q_center(3))
+  const = dist*rho
+
+  n_pt_tmp = n_Ix+n_Iy
+  do i=0,n_pt_tmp
+    d_poly(i)=0.d0
+  enddo
+
+  !DIR$ FORCEINLINE
+  call multiply_poly(Ix_pol,n_Ix,Iy_pol,n_Iy,d_poly,n_pt_tmp)
+  if (n_pt_tmp == -1) then
+    return
+  endif
+  n_pt_out = n_pt_tmp+n_Iz
+  do i=0,n_pt_out
+    d1(i)=0.d0
+  enddo
+
+  !DIR$ FORCEINLINE
+  call multiply_poly(d_poly ,n_pt_tmp ,Iz_pol,n_Iz,d1,n_pt_out)
+
+  double precision :: aa,c_a,t_a,rho_old,w_a,pi_3,prefactor,inv_pq_3_2
+  double precision :: gauss_int
+  integer :: m
+  gauss_int = 0.d0
+  pi_3 = pi*pi*pi
+  inv_pq_3_2 = (p_inv * q_inv)**(1.5d0)
+  rho_old = (p*q)/(p+q)
+  prefactor = pi_3 * inv_pq_3_2 * fact_p * fact_q 
+  do i = 1, n_gauss_eff_pot ! browse the gaussians with different expo/coef
+   aa = expo_gauss_eff_pot(i) 
+   c_a = coef_gauss_eff_pot(i)
+   t_a = dsqrt( aa /(rho_old + aa) ) 
+   w_a = dexp(-t_a*t_a*rho_old*dist)
+   accu = 0.d0
+   ! evaluation of the polynom Ix(t_a) * Iy(t_a) * Iz(t_a)
+   do m = 0, n_pt_out,2
+    accu += d1(m) * (t_a)**(dble(m)) 
+   enddo
+   ! equation A8 of PRA-70-062505 (2004) of Toul. Col. Sav. 
+   gauss_int = gauss_int + c_a * prefactor * (1.d0 - t_a*t_a)**(1.5d0) * w_a * accu
+  enddo
+
+  general_primitive_integral_gauss = gauss_int
+end
+
+subroutine compute_ao_integrals_gauss_jl(j,l,n_integrals,buffer_i,buffer_value)
+  implicit none
+  use map_module
+  BEGIN_DOC
+  !  Parallel client for AO integrals
+  END_DOC
+
+  integer, intent(in)            :: j,l
+  integer,intent(out)            :: n_integrals
+  integer(key_kind),intent(out)  :: buffer_i(ao_num*ao_num)
+  real(integral_kind),intent(out) :: buffer_value(ao_num*ao_num)
+
+  integer                        :: i,k
+  double precision               :: cpu_1,cpu_2, wall_1, wall_2
+  double precision               :: integral, wall_0
+  double precision               :: thr,ao_tc_sym_two_e_pot
+  integer                        :: kk, m, j1, i1
+  logical, external              :: ao_two_e_integral_zero
+
+  thr = ao_integrals_threshold
+
+  n_integrals = 0
+
+  j1 = j+ishft(l*l-l,-1)
+  do k = 1, ao_num           ! r1
+    i1 = ishft(k*k-k,-1)
+    if (i1 > j1) then
+      exit
+    endif
+    do i = 1, k
+      i1 += 1
+      if (i1 > j1) then
+        exit
+      endif
+!      if (ao_two_e_integral_zero(i,j,k,l)) then
+      if (.False.) then
+        cycle
+      endif
+      if (ao_two_e_integral_erf_schwartz(i,k)*ao_two_e_integral_erf_schwartz(j,l) < thr ) then
+        cycle
+      endif
+      !DIR$ FORCEINLINE
+      integral = ao_tc_sym_two_e_pot(i,k,j,l)  ! i,k : r1    j,l : r2
+      if (abs(integral) < thr) then
+        cycle
+      endif
+      n_integrals += 1
+      !DIR$ FORCEINLINE
+      call two_e_integrals_index(i,j,k,l,buffer_i(n_integrals))
+      buffer_value(n_integrals) = integral
+    enddo
+  enddo
+
+end

src/bi_ort_ints/NEED

@@ -0,0 +1,3 @@
+non_h_ints_mu
+ao_tc_eff_map
+bi_ortho_mos

src/bi_ort_ints/README.rst

@@ -0,0 +1,25 @@
+===========
+bi_ort_ints
+===========
+
+This module contains all necessary integrals for the TC Hamiltonian in a bi-orthonormal (BO) MO Basis.
+See in bi_ortho_basis for more information. 
+The main providers are : 
+
+One-electron integrals 
+----------------------
++) ao_one_e_integrals_tc_tot : total one-electron Hamiltonian which might include non hermitian part coming from one-e correlation factor. 
++) mo_bi_ortho_tc_one_e : one-electron Hamiltonian (h_core+one-J terms) on the BO-MO basis. 
++) mo_bi_orth_bipole_x  : x-component of the dipole operator on the BO-MO basis. (Same for y,z) 
+
+Two-electron integrals 
+----------------------
++) ao_two_e_tc_tot : Total two-electron operator (including the non-hermitian term of the TC Hamiltonian) on the AO basis
++) mo_bi_ortho_tc_two_e : Total two-electron operator on the BO-MO basis
+
+Three-electron integrals 
+------------------------
++) three_body_ints_bi_ort : 6-indices three-electron tensor (-L) on the BO-MO basis. WARNING :: N^6 storage !
++) three_e_3_idx_direct_bi_ort : DIRECT term with 3 different indices of the -L operator. These terms appear in the DIAGONAL matrix element of the -L operator. The 5 other permutations needed to compute matrix elements can be found in three_body_ijm.irp.f 
++) three_e_4_idx_direct_bi_ort : DIRECT term with 4 different indices of the -L operator. These terms appear in the OFF-DIAGONAL matrix element of the -L operator including SINGLE EXCITATIONS. The 5 other permutations needed to compute matrix elements can be found in three_body_ijmk.irp.f 
++) three_e_5_idx_direct_bi_ort : DIRECT term with 5 different indices of the -L operator. These terms appear in the OFF-DIAGONAL matrix element of the -L operator including DOUBLE EXCITATIONS. The 5 other permutations needed to compute matrix elements can be found in three_body_ijmkl.irp.f 

src/bi_ort_ints/bi_ort_ints.irp.f

@@ -0,0 +1,123 @@
+program bi_ort_ints
+  implicit none
+  BEGIN_DOC
+! TODO : Put the documentation of the program here
+  END_DOC
+  my_grid_becke = .True.
+  my_n_pt_r_grid = 30
+  my_n_pt_a_grid = 50
+  touch  my_grid_becke my_n_pt_r_grid my_n_pt_a_grid
+!  call test_overlap
+!  call routine_twoe
+!  call routine_onee
+!  call test_v_ki_bi_ortho
+!  call test_x_v_ki_bi_ortho
+!  call test_3_body_bi_ort
+!  call test_3_e_diag
+!  call test_3_e_diag_cycle1
+! call test_3_e
+  call routine_test_one_int
+end
+
+subroutine routine_test_one_int
+ implicit none
+ integer :: p,q,r,s,ii
+ integer :: i,j
+ i = 3
+ j = 5
+ double precision :: accu
+ double precision, allocatable :: vec(:)
+ integer, allocatable :: iorder(:)
+ allocate(vec(ao_num**4),iorder(ao_num**4))
+ accu = 0.d0
+ ii = 0
+ do p = 1, ao_num ! 
+  do q = 1, ao_num
+   do r = 1, ao_num
+    do s = 1, ao_num
+     !<ji | ji>
+     !             
+     !                                                          j j i i
+     if(dabs(mo_l_coef(s,j) * mo_l_coef(q,i) * ao_two_e_tc_tot(s,r,q,p) * mo_r_coef(p,i) * mo_r_coef(r,j)).gt.10)then 
+     write(33,'(3(F16.10,X),4(I3,X))')mo_l_coef(s,j) * mo_l_coef(q,i)* mo_r_coef(p,i) * mo_r_coef(r,j) , ao_two_e_tc_tot(s,r,q,p), mo_l_coef(s,j) * mo_l_coef(q,i) * ao_two_e_tc_tot(s,r,q,p) * mo_r_coef(p,i) * mo_r_coef(r,j) , s,q,p,r
+     endif
+     ii += 1
+     iorder(ii) = ii 
+     vec(ii) = mo_l_coef(s,j) * mo_l_coef(q,i) * ao_two_e_tc_tot(s,r,q,p) * mo_r_coef(p,i) * mo_r_coef(r,j) 
+     accu +=  mo_l_coef(s,j) * mo_l_coef(q,i) * ao_two_e_tc_tot(s,r,q,p) * mo_r_coef(p,i) * mo_r_coef(r,j) 
+    enddo
+   enddo
+  enddo
+ enddo
+ call dsort(vec,iorder,ao_num**4)
+ accu = 0.d0
+ do i = 1, ao_num**4
+   accu += vec(i)
+   write(34,*)i,vec(i),accu
+ enddo
+
+ print*,'accu = ',accu
+ 
+
+end
+
+subroutine routine_twoe
+ implicit none
+ integer :: i,j,k,l
+ double precision :: old, get_mo_two_e_integral_tc_int
+ double precision :: ref,new, accu, contrib, bi_ortho_mo_ints
+ accu = 0.d0
+ print*,'Testing the bi ortho two e'
+ do j = 1, mo_num
+  do i = 1, mo_num
+   do l = 1, mo_num
+    do k = 1, mo_num
+     ! mo_non_hermit_term(k,l,i,j) = <k l| V(r_12) |i j>
+!      ref = bi_ortho_mo_ints(k,l,i,j)
+      ref = bi_ortho_mo_ints(l,k,j,i)
+      new = mo_bi_ortho_tc_two_e(l,k,j,i)
+!      old = get_mo_two_e_integral_tc_int(k,l,i,j,mo_integrals_tc_int_map)
+!      old += mo_non_hermit_term(l,k,j,i)
+
+      contrib = dabs(ref - new)
+      if(dabs(ref).gt.1.d-10)then
+       if(contrib.gt.1.d-10)then
+        print*,k,l,i,j
+        print*,ref,new,contrib
+       endif
+      endif
+      accu += contrib
+    enddo
+   enddo
+  enddo
+ enddo
+ print*,'accu = ',accu/(dble(mo_num)**4)
+
+end
+
+subroutine routine_onee
+ implicit none
+ integer :: i,k
+ double precision :: ref,new,accu,contrib
+ print*,'Testing the bi ortho one e'
+ accu = 0.d0
+ do i = 1, mo_num
+  do k = 1, mo_num
+   ref = mo_bi_ortho_tc_one_e_slow(k,i)
+   new = mo_bi_ortho_tc_one_e(k,i)
+   contrib = dabs(ref - new)
+   if(dabs(ref).gt.1.d-10)then
+    if(contrib .gt. 1.d-10)then
+     print*,'i,k',i,k
+     print*,ref,new,contrib
+    endif
+   endif
+   accu += contrib
+  enddo
+ enddo
+ print*,'accu = ',accu/mo_num**2
+end
+
+
+
+

src/bi_ort_ints/one_e_bi_ort.irp.f

@@ -0,0 +1,70 @@
+
+! ---
+
+BEGIN_PROVIDER [double precision, ao_one_e_integrals_tc_tot, (ao_num,ao_num)]
+
+  implicit none
+  integer :: i, j
+
+  ao_one_e_integrals_tc_tot = ao_one_e_integrals      
+
+  provide j1b_gauss
+
+  if(j1b_gauss .eq. 1) then
+
+    do i = 1, ao_num
+      do j = 1, ao_num
+        ao_one_e_integrals_tc_tot(j,i) += ( j1b_gauss_hermI  (j,i) &
+                                          + j1b_gauss_hermII (j,i) &
+                                          + j1b_gauss_nonherm(j,i) )
+      enddo
+    enddo
+
+  endif
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, mo_bi_ortho_tc_one_e, (mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! mo_bi_ortho_tc_one_e(k,i) = <MO^L_k | h_c | MO^R_i>
+ END_DOC
+ integer :: i,k,p,q
+ 
+  call ao_to_mo_bi_ortho(ao_one_e_integrals_tc_tot, ao_num, mo_bi_ortho_tc_one_e, mo_num)
+
+END_PROVIDER 
+
+! ---
+
+ BEGIN_PROVIDER [double precision, mo_bi_orth_bipole_x , (mo_num,mo_num)]
+&BEGIN_PROVIDER [double precision, mo_bi_orth_bipole_y , (mo_num,mo_num)]
+&BEGIN_PROVIDER [double precision, mo_bi_orth_bipole_z , (mo_num,mo_num)]
+ BEGIN_DOC
+ ! array of the integrals of MO_i * x MO_j
+ ! array of the integrals of MO_i * y MO_j
+ ! array of the integrals of MO_i * z MO_j
+ END_DOC
+ implicit none
+
+  call ao_to_mo_bi_ortho(                                                     &
+      ao_dipole_x,                                                   &
+      size(ao_dipole_x,1),                                           &
+      mo_bi_orth_bipole_x,                                                   &
+      size(mo_bi_orth_bipole_x,1)                                            &
+      )
+  call ao_to_mo_bi_ortho(                                                     &
+      ao_dipole_y,                                                   &
+      size(ao_dipole_y,1),                                           &
+      mo_bi_orth_bipole_y,                                                   &
+      size(mo_bi_orth_bipole_y,1)                                            &
+      )
+  call ao_to_mo_bi_ortho(                                                     &
+      ao_dipole_z,                                                   &
+      size(ao_dipole_z,1),                                           &
+      mo_bi_orth_bipole_z,                                                   &
+      size(mo_bi_orth_bipole_z,1)                                            &
+      )
+
+END_PROVIDER
+

src/bi_ort_ints/semi_num_ints_mo.irp.f

@@ -0,0 +1,177 @@
+BEGIN_PROVIDER [ double precision, mo_v_ki_bi_ortho_erf_rk_cst_mu, ( mo_num, mo_num,n_points_final_grid)]
+ implicit none
+ BEGIN_DOC
+! mo_v_ki_bi_ortho_erf_rk_cst_mu(k,i,ip) = int dr chi_k(r) phi_i(r) (erf(mu |r - R_ip|) - 1 )/(2|r - R_ip|) on the BI-ORTHO MO basis 
+! 
+! where phi_k(r) is a LEFT MOs and phi_i(r) is a RIGHT MO
+!
+! R_ip = the "ip"-th point of the DFT Grid
+ END_DOC
+ integer :: ipoint
+ !$OMP PARALLEL                  &
+ !$OMP DEFAULT (NONE)            &
+ !$OMP PRIVATE (ipoint) & 
+ !$OMP SHARED (n_points_final_grid,v_ij_erf_rk_cst_mu,mo_v_ki_bi_ortho_erf_rk_cst_mu)
+ !$OMP DO SCHEDULE (dynamic)
+! TODO :: optimization : transform into a DGEMM
+ do ipoint = 1, n_points_final_grid
+   call ao_to_mo_bi_ortho(v_ij_erf_rk_cst_mu(1,1,ipoint),size(v_ij_erf_rk_cst_mu,1),mo_v_ki_bi_ortho_erf_rk_cst_mu(1,1,ipoint),size(mo_v_ki_bi_ortho_erf_rk_cst_mu,1))
+ enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+ mo_v_ki_bi_ortho_erf_rk_cst_mu = mo_v_ki_bi_ortho_erf_rk_cst_mu * 0.5d0
+END_PROVIDER 
+
+
+BEGIN_PROVIDER [ double precision, mo_v_ki_bi_ortho_erf_rk_cst_mu_transp, ( n_points_final_grid,mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! int dr phi_i(r) phi_j(r) (erf(mu(R) |r - R|) - 1)/(2|r - R|) on the BI-ORTHO MO basis
+ END_DOC
+ integer :: ipoint,i,j
+ do i = 1, mo_num
+  do j = 1, mo_num
+   do ipoint = 1, n_points_final_grid
+    mo_v_ki_bi_ortho_erf_rk_cst_mu_transp(ipoint,j,i) = mo_v_ki_bi_ortho_erf_rk_cst_mu(j,i,ipoint)
+   enddo
+  enddo
+ enddo
+! FREE mo_v_ki_bi_ortho_erf_rk_cst_mu
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, mo_x_v_ki_bi_ortho_erf_rk_cst_mu, ( mo_num, mo_num,3,n_points_final_grid)]
+ implicit none
+ BEGIN_DOC
+! mo_x_v_ki_bi_ortho_erf_rk_cst_mu(k,i,m,ip) = int dr x(m) * chi_k(r) phi_i(r) (erf(mu |r - R_ip|) - 1)/2|r - R_ip| on the BI-ORTHO MO basis 
+!
+! where chi_k(r)/phi_i(r) are left/right MOs, m=1 => x(m) = x, m=2 => x(m) = y, m=3 => x(m) = z,
+!
+! R_ip = the "ip"-th point of the DFT Grid
+ END_DOC
+ integer :: ipoint,m
+ !$OMP PARALLEL                  &
+ !$OMP DEFAULT (NONE)            &
+ !$OMP PRIVATE (ipoint,m) & 
+ !$OMP SHARED (n_points_final_grid,x_v_ij_erf_rk_cst_mu_transp,mo_x_v_ki_bi_ortho_erf_rk_cst_mu)
+ !$OMP DO SCHEDULE (dynamic)
+! TODO :: optimization : transform into a DGEMM
+ do ipoint = 1, n_points_final_grid
+  do m = 1, 3
+   call ao_to_mo_bi_ortho(x_v_ij_erf_rk_cst_mu_transp(1,1,m,ipoint),size(x_v_ij_erf_rk_cst_mu_transp,1),mo_x_v_ki_bi_ortho_erf_rk_cst_mu(1,1,m,ipoint),size(mo_x_v_ki_bi_ortho_erf_rk_cst_mu,1))
+  enddo
+ enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+ mo_x_v_ki_bi_ortho_erf_rk_cst_mu = 0.5d0 * mo_x_v_ki_bi_ortho_erf_rk_cst_mu
+
+END_PROVIDER 
+
+! ---
+BEGIN_PROVIDER [ double precision, mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp, (n_points_final_grid, 3, mo_num, mo_num)]
+  implicit none
+  integer :: i, j, m, ipoint
+  do i = 1, mo_num
+    do j = 1, mo_num
+      do m = 1, 3
+        do ipoint = 1, n_points_final_grid
+          mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp(ipoint,m,j,i) = mo_x_v_ki_bi_ortho_erf_rk_cst_mu(j,i,m,ipoint)
+        enddo
+      enddo
+    enddo
+  enddo
+END_PROVIDER 
+
+! ---
+
+
+BEGIN_PROVIDER [ double precision, x_W_ki_bi_ortho_erf_rk, (n_points_final_grid, 3, mo_num, mo_num)]
+  BEGIN_DOC
+  ! x_W_ki_bi_ortho_erf_rk(ip,m,k,i) = \int dr chi_k(r) (1 - erf(mu |r-R_ip|)) (x(m)-X(m)_ip) phi_i(r) ON THE BI-ORTHO MO BASIS 
+!
+! where chi_k(r)/phi_i(r) are left/right MOs, m=1 => X(m) = x, m=2 => X(m) = y, m=3 => X(m) = z,
+!
+! R_ip = the "ip"-th point of the DFT Grid
+  END_DOC
+ 
+  implicit none
+  include 'constants.include.F'
+ 
+  integer          :: ipoint, m, i, k
+  double precision :: xyz
+  double precision :: wall0, wall1
+ 
+  print*,'providing x_W_ki_bi_ortho_erf_rk ...'
+  call wall_time(wall0)
+
+ !$OMP PARALLEL                   &
+ !$OMP DEFAULT (NONE)             &
+ !$OMP PRIVATE (ipoint,m,i,k,xyz) & 
+ !$OMP SHARED (x_W_ki_bi_ortho_erf_rk,n_points_final_grid,mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp,mo_v_ki_bi_ortho_erf_rk_cst_mu_transp,mo_num,final_grid_points) 
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do k = 1, mo_num
+      do m = 1, 3
+        do ipoint = 1, n_points_final_grid
+          xyz = final_grid_points(m,ipoint)
+          x_W_ki_bi_ortho_erf_rk(ipoint,m,k,i) = mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp(ipoint,m,k,i) - xyz * mo_v_ki_bi_ortho_erf_rk_cst_mu_transp(ipoint,k,i)
+        enddo
+      enddo
+    enddo
+  enddo
+
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+ ! FREE mo_v_ki_bi_ortho_erf_rk_cst_mu_transp 
+ ! FREE mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp
+
+  call wall_time(wall1)
+  print*,'time to provide x_W_ki_bi_ortho_erf_rk = ',wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, x_W_ki_bi_ortho_erf_rk_diag, (n_points_final_grid, 3, mo_num)]
+  BEGIN_DOC
+  ! x_W_ki_bi_ortho_erf_rk_diag(ip,m,i) = \int dr chi_i(r) (1 - erf(mu |r-R_ip|)) (x(m)-X(m)_ip) phi_i(r) ON THE BI-ORTHO MO BASIS 
+!
+! where chi_k(r)/phi_i(r) are left/right MOs, m=1 => X(m) = x, m=2 => X(m) = y, m=3 => X(m) = z,
+!
+! R_ip = the "ip"-th point of the DFT Grid
+  END_DOC
+
+  implicit none
+  include 'constants.include.F'
+ 
+  integer          :: ipoint, m, i
+  double precision :: xyz
+  double precision :: wall0, wall1
+ 
+  print*,'providing x_W_ki_bi_ortho_erf_rk_diag ...'
+  call wall_time(wall0)
+
+ !$OMP PARALLEL                 &
+ !$OMP DEFAULT (NONE)           &
+ !$OMP PRIVATE (ipoint,m,i,xyz) & 
+ !$OMP SHARED (x_W_ki_bi_ortho_erf_rk_diag,n_points_final_grid,mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp,mo_v_ki_bi_ortho_erf_rk_cst_mu_transp,mo_num,final_grid_points) 
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+    do m = 1, 3
+      do ipoint = 1, n_points_final_grid
+        xyz = final_grid_points(m,ipoint)
+        x_W_ki_bi_ortho_erf_rk_diag(ipoint,m,i) = mo_x_v_ki_bi_ortho_erf_rk_cst_mu_transp(ipoint,m,i,i) - xyz * mo_v_ki_bi_ortho_erf_rk_cst_mu_transp(ipoint,i,i)
+      enddo
+    enddo
+  enddo
+
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  call wall_time(wall1)
+  print*,'time to provide x_W_ki_bi_ortho_erf_rk_diag = ',wall1 - wall0
+
+END_PROVIDER 
+
+! ---
+

src/bi_ort_ints/three_body_ijm.irp.f

@@ -0,0 +1,304 @@
+BEGIN_PROVIDER [ double precision, three_e_3_idx_direct_bi_ort, (mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! matrix element of the -L  three-body operator ON A BI ORTHONORMAL BASIS for the direct terms 
+!
+! three_e_3_idx_direct_bi_ort(m,j,i) = <mji|-L|mji>
+! 
+! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+ END_DOC
+ integer :: i,j,m
+ double precision :: integral, wall1, wall0
+ character*(128) :: name_file 
+ three_e_3_idx_direct_bi_ort = 0.d0
+ print*,'Providing the three_e_3_idx_direct_bi_ort ...'
+ call wall_time(wall0)
+ name_file = 'six_index_tensor'
+ provide x_W_ki_bi_ortho_erf_rk mos_r_in_r_array_transp mos_l_in_r_array_transp
+ !$OMP PARALLEL                  &
+ !$OMP DEFAULT (NONE)            &
+ !$OMP PRIVATE (i,j,m,integral) & 
+ !$OMP SHARED (mo_num,three_e_3_idx_direct_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+   do j = 1, mo_num
+    do m = j, mo_num
+      call give_integrals_3_body_bi_ort(m,j,i,m,j,i,integral)
+      three_e_3_idx_direct_bi_ort(m,j,i) = -1.d0 * integral 
+    enddo
+   enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+ call wall_time(wall1)
+ print*,'wall time for three_e_3_idx_direct_bi_ort',wall1 - wall0
+ 
+  do i = 1, mo_num
+   do j = 1, mo_num
+    do m = 1, j
+     three_e_3_idx_direct_bi_ort(m,j,i) = three_e_3_idx_direct_bi_ort(j,m,i)
+    enddo
+   enddo
+  enddo
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, three_e_3_idx_cycle_1_bi_ort, (mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! matrix element of the -L  three-body operator ON A BI ORTHONORMAL BASIS for the first cyclic permutation 
+!
+! three_e_3_idx_direct_bi_ort(m,j,i) = <mji|-L|jim>
+!
+! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+ END_DOC
+ integer :: i,j,m
+ double precision :: integral, wall1, wall0
+ character*(128) :: name_file 
+ three_e_3_idx_cycle_1_bi_ort = 0.d0
+ print*,'Providing the three_e_3_idx_cycle_1_bi_ort ...'
+ call wall_time(wall0)
+ name_file = 'six_index_tensor'
+ provide x_W_ki_bi_ortho_erf_rk mos_r_in_r_array_transp mos_l_in_r_array_transp
+ !$OMP PARALLEL                  &
+ !$OMP DEFAULT (NONE)            &
+ !$OMP PRIVATE (i,j,m,integral) & 
+ !$OMP SHARED (mo_num,three_e_3_idx_cycle_1_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+   do j = 1, mo_num
+    do m = j, mo_num
+      call give_integrals_3_body_bi_ort(m,j,i,j,i,m,integral)
+      three_e_3_idx_cycle_1_bi_ort(m,j,i) = -1.d0 * integral 
+    enddo
+   enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+ call wall_time(wall1)
+
+  do i = 1, mo_num
+   do j = 1, mo_num
+    do m = 1, j
+     three_e_3_idx_cycle_1_bi_ort(m,j,i) = three_e_3_idx_cycle_1_bi_ort(j,m,i)
+    enddo
+   enddo
+  enddo
+ print*,'wall time for three_e_3_idx_cycle_1_bi_ort',wall1 - wall0
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, three_e_3_idx_cycle_2_bi_ort, (mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! matrix element of the -L  three-body operator ON A BI ORTHONORMAL BASIS for the second cyclic permutation 
+!
+! three_e_3_idx_direct_bi_ort(m,j,i) = <mji|-L|imj>
+!
+! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+ END_DOC
+ integer :: i,j,m
+ double precision :: integral, wall1, wall0
+ character*(128) :: name_file 
+ three_e_3_idx_cycle_2_bi_ort = 0.d0
+ print*,'Providing the three_e_3_idx_cycle_2_bi_ort ...'
+ call wall_time(wall0)
+ name_file = 'six_index_tensor'
+ provide x_W_ki_bi_ortho_erf_rk mos_r_in_r_array_transp mos_l_in_r_array_transp
+ !$OMP PARALLEL                  &
+ !$OMP DEFAULT (NONE)            &
+ !$OMP PRIVATE (i,j,m,integral) & 
+ !$OMP SHARED (mo_num,three_e_3_idx_cycle_2_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+   do j = 1, mo_num
+    do m = j, mo_num
+      call give_integrals_3_body_bi_ort(m,j,i,i,m,j,integral)
+      three_e_3_idx_cycle_2_bi_ort(m,j,i) = -1.d0 * integral 
+    enddo
+   enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+ call wall_time(wall1)
+  do i = 1, mo_num
+   do j = 1, mo_num
+    do m = 1, j
+     three_e_3_idx_cycle_2_bi_ort(m,j,i) = three_e_3_idx_cycle_2_bi_ort(j,m,i)
+    enddo
+   enddo
+  enddo
+ print*,'wall time for three_e_3_idx_cycle_2_bi_ort',wall1 - wall0
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, three_e_3_idx_exch23_bi_ort, (mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! matrix element of the -L  three-body operator ON A BI ORTHONORMAL BASIS for the permutations of particle 2 and 3
+!
+! three_e_3_idx_exch23_bi_ort(m,j,i) = <mji|-L|jmi>
+! 
+! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+ END_DOC
+ integer :: i,j,m
+ double precision :: integral, wall1, wall0
+ character*(128) :: name_file 
+ three_e_3_idx_exch23_bi_ort = 0.d0
+ print*,'Providing the three_e_3_idx_exch23_bi_ort ...'
+ call wall_time(wall0)
+ name_file = 'six_index_tensor'
+ provide x_W_ki_bi_ortho_erf_rk mos_r_in_r_array_transp mos_l_in_r_array_transp
+ !$OMP PARALLEL                  &
+ !$OMP DEFAULT (NONE)            &
+ !$OMP PRIVATE (i,j,m,integral) & 
+ !$OMP SHARED (mo_num,three_e_3_idx_exch23_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+   do j = 1, mo_num
+    do m = j, mo_num
+      call give_integrals_3_body_bi_ort(m,j,i,j,m,i,integral)
+      three_e_3_idx_exch23_bi_ort(m,j,i) = -1.d0 * integral 
+    enddo
+   enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+  do i = 1, mo_num
+   do j = 1, mo_num
+    do m = 1, j
+     three_e_3_idx_exch23_bi_ort(m,j,i) = three_e_3_idx_exch23_bi_ort(j,m,i)
+    enddo
+   enddo
+  enddo
+ call wall_time(wall1)
+ print*,'wall time for three_e_3_idx_exch23_bi_ort',wall1 - wall0
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, three_e_3_idx_exch13_bi_ort, (mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! matrix element of the -L  three-body operator ON A BI ORTHONORMAL BASIS for the permutations of particle 1 and 3
+!
+! three_e_3_idx_exch13_bi_ort(m,j,i) = <mji|-L|ijm>
+! 
+! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+ END_DOC
+ integer :: i,j,m
+ double precision :: integral, wall1, wall0
+ character*(128) :: name_file 
+ three_e_3_idx_exch13_bi_ort = 0.d0
+ print*,'Providing the three_e_3_idx_exch13_bi_ort ...'
+ call wall_time(wall0)
+ name_file = 'six_index_tensor'
+ provide x_W_ki_bi_ortho_erf_rk mos_r_in_r_array_transp mos_l_in_r_array_transp
+ !$OMP PARALLEL                  &
+ !$OMP DEFAULT (NONE)            &
+ !$OMP PRIVATE (i,j,m,integral) & 
+ !$OMP SHARED (mo_num,three_e_3_idx_exch13_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+   do j = 1, mo_num
+    do m = j, mo_num
+      call give_integrals_3_body_bi_ort(m,j,i,i,j,m,integral)
+      three_e_3_idx_exch13_bi_ort(m,j,i) = -1.d0 * integral 
+    enddo
+   enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+  do i = 1, mo_num
+   do j = 1, mo_num
+    do m = 1, j
+     three_e_3_idx_exch13_bi_ort(m,j,i) = three_e_3_idx_exch13_bi_ort(j,m,i)
+    enddo
+   enddo
+  enddo
+ call wall_time(wall1)
+ print*,'wall time for three_e_3_idx_exch13_bi_ort',wall1 - wall0
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, three_e_3_idx_exch12_bi_ort, (mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! matrix element of the -L  three-body operator ON A BI ORTHONORMAL BASIS for the permutations of particle 1 and 2
+!
+! three_e_3_idx_exch12_bi_ort(m,j,i) = <mji|-L|mij>
+! 
+! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+ END_DOC
+ integer :: i,j,m
+ double precision :: integral, wall1, wall0
+ character*(128) :: name_file 
+ three_e_3_idx_exch12_bi_ort = 0.d0
+ print*,'Providing the three_e_3_idx_exch12_bi_ort ...'
+ call wall_time(wall0)
+ name_file = 'six_index_tensor'
+ provide x_W_ki_bi_ortho_erf_rk mos_r_in_r_array_transp mos_l_in_r_array_transp
+ !$OMP PARALLEL                  &
+ !$OMP DEFAULT (NONE)            &
+ !$OMP PRIVATE (i,j,m,integral) & 
+ !$OMP SHARED (mo_num,three_e_3_idx_exch12_bi_ort)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+   do j = 1, mo_num
+    do m = 1, mo_num
+      call give_integrals_3_body_bi_ort(m,j,i,m,i,j,integral)
+      three_e_3_idx_exch12_bi_ort(m,j,i) = -1.d0 * integral 
+    enddo
+   enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+ call wall_time(wall1)
+ print*,'wall time for three_e_3_idx_exch12_bi_ort',wall1 - wall0
+
+END_PROVIDER 
+
+
+BEGIN_PROVIDER [ double precision, three_e_3_idx_exch12_bi_ort_new, (mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! matrix element of the -L  three-body operator ON A BI ORTHONORMAL BASIS for the permutations of particle 1 and 2
+!
+! three_e_3_idx_exch12_bi_ort_new(m,j,i) = <mji|-L|mij>
+! 
+! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+ END_DOC
+ integer :: i,j,m
+ double precision :: integral, wall1, wall0
+ character*(128) :: name_file 
+ three_e_3_idx_exch12_bi_ort_new = 0.d0
+ print*,'Providing the three_e_3_idx_exch12_bi_ort_new ...'
+ call wall_time(wall0)
+ name_file = 'six_index_tensor'
+ provide x_W_ki_bi_ortho_erf_rk mos_r_in_r_array_transp mos_l_in_r_array_transp
+ !$OMP PARALLEL                  &
+ !$OMP DEFAULT (NONE)            &
+ !$OMP PRIVATE (i,j,m,integral) & 
+ !$OMP SHARED (mo_num,three_e_3_idx_exch12_bi_ort_new)
+ !$OMP DO SCHEDULE (dynamic)
+  do i = 1, mo_num
+   do j = 1, mo_num
+    do m = j, mo_num
+      call give_integrals_3_body_bi_ort(m,j,i,m,i,j,integral)
+      three_e_3_idx_exch12_bi_ort_new(m,j,i) = -1.d0 * integral 
+    enddo
+   enddo
+  enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+  do i = 1, mo_num
+   do j = 1, mo_num
+    do m = 1, j
+     three_e_3_idx_exch12_bi_ort_new(m,j,i) = three_e_3_idx_exch12_bi_ort_new(j,m,i)
+    enddo
+   enddo
+  enddo
+ call wall_time(wall1)
+ print*,'wall time for three_e_3_idx_exch12_bi_ort_new',wall1 - wall0
+
+END_PROVIDER 
+

src/bi_ort_ints/three_body_ijmk.irp.f

@@ -0,0 +1,228 @@
+BEGIN_PROVIDER [ double precision, three_e_4_idx_direct_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! matrix element of the -L  three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
+!
+!three_e_4_idx_direct_bi_ort(m,j,k,i) = <mjk|-L|mji> ::: notice that i is the RIGHT MO and k is the LEFT MO
+!
+! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+ END_DOC
+ integer :: i,j,k,m
+ double precision :: integral, wall1, wall0
+ character*(128) :: name_file 
+ three_e_4_idx_direct_bi_ort = 0.d0
+ print*,'Providing the three_e_4_idx_direct_bi_ort ...'
+ call wall_time(wall0)
+  provide x_W_ki_bi_ortho_erf_rk mos_r_in_r_array_transp mos_l_in_r_array_transp
+  !$OMP PARALLEL                  &
+  !$OMP DEFAULT (NONE)            &
+  !$OMP PRIVATE (i,j,k,m,integral) & 
+  !$OMP SHARED (mo_num,three_e_4_idx_direct_bi_ort)
+  !$OMP DO SCHEDULE (dynamic)
+   do i = 1, mo_num
+    do k = 1, mo_num
+     do j = 1, mo_num
+      do m = 1, mo_num
+        call give_integrals_3_body_bi_ort(m,j,k,m,j,i,integral)
+        three_e_4_idx_direct_bi_ort(m,j,k,i) = -1.d0 * integral 
+      enddo
+     enddo
+    enddo
+   enddo
+  !$OMP END DO
+  !$OMP END PARALLEL
+ call wall_time(wall1)
+ print*,'wall time for three_e_4_idx_direct_bi_ort',wall1 - wall0
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, three_e_4_idx_cycle_1_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! matrix element of the -L  three-body operator FOR THE FIRST CYCLIC PERMUTATION TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
+!
+!three_e_4_idx_cycle_1_bi_ort(m,j,k,i) = <mjk|-L|jim> ::: notice that i is the RIGHT MO and k is the LEFT MO
+!
+! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+ END_DOC
+ integer :: i,j,k,m
+ double precision :: integral, wall1, wall0
+ character*(128) :: name_file 
+ three_e_4_idx_cycle_1_bi_ort = 0.d0
+ print*,'Providing the three_e_4_idx_cycle_1_bi_ort ...'
+ call wall_time(wall0)
+  provide x_W_ki_bi_ortho_erf_rk mos_r_in_r_array_transp mos_l_in_r_array_transp
+  !$OMP PARALLEL                  &
+  !$OMP DEFAULT (NONE)            &
+  !$OMP PRIVATE (i,j,k,m,integral) & 
+  !$OMP SHARED (mo_num,three_e_4_idx_cycle_1_bi_ort)
+  !$OMP DO SCHEDULE (dynamic)
+   do i = 1, mo_num
+    do k = 1, mo_num
+     do j = 1, mo_num
+      do m = 1, mo_num
+        call give_integrals_3_body_bi_ort(m,j,k,j,i,m,integral)
+        three_e_4_idx_cycle_1_bi_ort(m,j,k,i) = -1.d0 * integral 
+      enddo
+     enddo
+    enddo
+   enddo
+  !$OMP END DO
+  !$OMP END PARALLEL
+ call wall_time(wall1)
+ print*,'wall time for three_e_4_idx_cycle_1_bi_ort',wall1 - wall0
+
+END_PROVIDER 
+
+
+BEGIN_PROVIDER [ double precision, three_e_4_idx_cycle_2_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! matrix element of the -L  three-body operator FOR THE FIRST CYCLIC PERMUTATION TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
+!
+!three_e_4_idx_cycle_2_bi_ort(m,j,k,i) = <mjk|-L|imj> ::: notice that i is the RIGHT MO and k is the LEFT MO
+!
+! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+ END_DOC
+ integer :: i,j,k,m
+ double precision :: integral, wall1, wall0
+ character*(128) :: name_file 
+ three_e_4_idx_cycle_2_bi_ort = 0.d0
+ print*,'Providing the three_e_4_idx_cycle_2_bi_ort ...'
+ call wall_time(wall0)
+  provide x_W_ki_bi_ortho_erf_rk mos_r_in_r_array_transp mos_l_in_r_array_transp
+  !$OMP PARALLEL                  &
+  !$OMP DEFAULT (NONE)            &
+  !$OMP PRIVATE (i,j,k,m,integral) & 
+  !$OMP SHARED (mo_num,three_e_4_idx_cycle_2_bi_ort)
+  !$OMP DO SCHEDULE (dynamic)
+   do i = 1, mo_num
+    do k = 1, mo_num
+     do j = 1, mo_num
+      do m = 1, mo_num
+        call give_integrals_3_body_bi_ort(m,j,k,i,m,j,integral)
+        three_e_4_idx_cycle_2_bi_ort(m,j,k,i) = -1.d0 * integral 
+      enddo
+     enddo
+    enddo
+   enddo
+  !$OMP END DO
+  !$OMP END PARALLEL
+ call wall_time(wall1)
+ print*,'wall time for three_e_4_idx_cycle_2_bi_ort',wall1 - wall0
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, three_e_4_idx_exch23_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! matrix element of the -L  three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
+!
+!three_e_4_idx_exch23_bi_ort(m,j,k,i) = <mjk|-L|jmi> ::: notice that i is the RIGHT MO and k is the LEFT MO
+!
+! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+ END_DOC
+ integer :: i,j,k,m
+ double precision :: integral, wall1, wall0
+ character*(128) :: name_file 
+ three_e_4_idx_exch23_bi_ort = 0.d0
+ print*,'Providing the three_e_4_idx_exch23_bi_ort ...'
+ call wall_time(wall0)
+  provide x_W_ki_bi_ortho_erf_rk mos_r_in_r_array_transp mos_l_in_r_array_transp
+  !$OMP PARALLEL                  &
+  !$OMP DEFAULT (NONE)            &
+  !$OMP PRIVATE (i,j,k,m,integral) & 
+  !$OMP SHARED (mo_num,three_e_4_idx_exch23_bi_ort)
+  !$OMP DO SCHEDULE (dynamic)
+   do i = 1, mo_num
+    do k = 1, mo_num
+     do j = 1, mo_num
+      do m = 1, mo_num
+        call give_integrals_3_body_bi_ort(m,j,k,j,m,i,integral)
+        three_e_4_idx_exch23_bi_ort(m,j,k,i) = -1.d0 * integral 
+      enddo
+     enddo
+    enddo
+   enddo
+  !$OMP END DO
+  !$OMP END PARALLEL
+ call wall_time(wall1)
+ print*,'wall time for three_e_4_idx_exch23_bi_ort',wall1 - wall0
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, three_e_4_idx_exch13_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! matrix element of the -L  three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
+!
+!three_e_4_idx_exch13_bi_ort(m,j,k,i) = <mjk|-L|jmi> ::: notice that i is the RIGHT MO and k is the LEFT MO
+!
+! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+ END_DOC
+ integer :: i,j,k,m
+ double precision :: integral, wall1, wall0
+ character*(128) :: name_file 
+ three_e_4_idx_exch13_bi_ort = 0.d0
+ print*,'Providing the three_e_4_idx_exch13_bi_ort ...'
+ call wall_time(wall0)
+  provide x_W_ki_bi_ortho_erf_rk mos_r_in_r_array_transp mos_l_in_r_array_transp
+  !$OMP PARALLEL                  &
+  !$OMP DEFAULT (NONE)            &
+  !$OMP PRIVATE (i,j,k,m,integral) & 
+  !$OMP SHARED (mo_num,three_e_4_idx_exch13_bi_ort)
+  !$OMP DO SCHEDULE (dynamic)
+   do i = 1, mo_num
+    do k = 1, mo_num
+     do j = 1, mo_num
+      do m = 1, mo_num
+        call give_integrals_3_body_bi_ort(m,j,k,i,j,m,integral)
+        three_e_4_idx_exch13_bi_ort(m,j,k,i) = -1.d0 * integral 
+      enddo
+     enddo
+    enddo
+   enddo
+  !$OMP END DO
+  !$OMP END PARALLEL
+ call wall_time(wall1)
+ print*,'wall time for three_e_4_idx_exch13_bi_ort',wall1 - wall0
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, three_e_4_idx_exch12_bi_ort, (mo_num, mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! matrix element of the -L  three-body operator FOR THE DIRECT TERMS OF SINGLE EXCITATIONS AND BI ORTHO MOs
+!
+!three_e_4_idx_exch12_bi_ort(m,j,k,i) = <mjk|-L|jmi> ::: notice that i is the RIGHT MO and k is the LEFT MO
+!
+! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+ END_DOC
+ integer :: i,j,k,m
+ double precision :: integral, wall1, wall0
+ character*(128) :: name_file 
+ three_e_4_idx_exch12_bi_ort = 0.d0
+ print*,'Providing the three_e_4_idx_exch12_bi_ort ...'
+ call wall_time(wall0)
+  provide x_W_ki_bi_ortho_erf_rk mos_r_in_r_array_transp mos_l_in_r_array_transp
+  !$OMP PARALLEL                  &
+  !$OMP DEFAULT (NONE)            &
+  !$OMP PRIVATE (i,j,k,m,integral) & 
+  !$OMP SHARED (mo_num,three_e_4_idx_exch12_bi_ort)
+  !$OMP DO SCHEDULE (dynamic)
+   do i = 1, mo_num
+    do k = 1, mo_num
+     do j = 1, mo_num
+      do m = 1, mo_num
+       call give_integrals_3_body_bi_ort(m,j,k,m,i,j,integral)
+       three_e_4_idx_exch12_bi_ort(m,j,k,i) = -1.d0 * integral 
+      enddo
+     enddo
+    enddo
+   enddo
+  !$OMP END DO
+  !$OMP END PARALLEL
+ call wall_time(wall1)
+ print*,'wall time for three_e_4_idx_exch12_bi_ort',wall1 - wall0
+
+END_PROVIDER 

src/bi_ort_ints/three_body_ijmkl.irp.f

@@ -0,0 +1,240 @@
+BEGIN_PROVIDER [ double precision, three_e_5_idx_direct_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! matrix element of the -L  three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
+!
+!three_e_5_idx_direct_bi_ort(m,l,j,k,i) = <mjk|-L|mji> ::: notice that i is the RIGHT MO and k is the LEFT MO
+!
+! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+ END_DOC
+ integer :: i,j,k,m,l
+ double precision :: integral, wall1, wall0
+ character*(128) :: name_file 
+ three_e_5_idx_direct_bi_ort = 0.d0
+ print*,'Providing the three_e_5_idx_direct_bi_ort ...'
+ call wall_time(wall0)
+  provide x_W_ki_bi_ortho_erf_rk mos_r_in_r_array_transp mos_l_in_r_array_transp
+  !$OMP PARALLEL                  &
+  !$OMP DEFAULT (NONE)            &
+  !$OMP PRIVATE (i,j,k,m,l,integral) & 
+  !$OMP SHARED (mo_num,three_e_5_idx_direct_bi_ort)
+  !$OMP DO SCHEDULE (dynamic)
+   do i = 1, mo_num
+    do k = 1, mo_num
+     do j = 1, mo_num
+      do l = 1, mo_num
+       do m = 1, mo_num
+        call give_integrals_3_body_bi_ort(m,l,k,m,j,i,integral)
+        three_e_5_idx_direct_bi_ort(m,l,j,k,i) = -1.d0 * integral 
+       enddo
+      enddo
+     enddo
+    enddo
+   enddo
+  !$OMP END DO
+  !$OMP END PARALLEL
+ call wall_time(wall1)
+ print*,'wall time for three_e_5_idx_direct_bi_ort',wall1 - wall0
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, three_e_5_idx_cycle_1_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! matrix element of the -L  three-body operator FOR THE FIRST CYCLIC PERMUTATION TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
+!
+!three_e_5_idx_cycle_1_bi_ort(m,l,j,k,i) = <mlk|-L|jim> ::: notice that i is the RIGHT MO and k is the LEFT MO
+!
+! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+ END_DOC
+ integer :: i,j,k,m,l
+ double precision :: integral, wall1, wall0
+ character*(128) :: name_file 
+ three_e_5_idx_cycle_1_bi_ort = 0.d0
+ print*,'Providing the three_e_5_idx_cycle_1_bi_ort ...'
+ call wall_time(wall0)
+  provide x_W_ki_bi_ortho_erf_rk mos_r_in_r_array_transp mos_l_in_r_array_transp
+  !$OMP PARALLEL                  &
+  !$OMP DEFAULT (NONE)            &
+  !$OMP PRIVATE (i,j,k,m,l,integral) & 
+  !$OMP SHARED (mo_num,three_e_5_idx_cycle_1_bi_ort)
+  !$OMP DO SCHEDULE (dynamic)
+   do i = 1, mo_num
+    do k = 1, mo_num
+     do j = 1, mo_num
+      do l = 1, mo_num
+       do m = 1, mo_num
+         call give_integrals_3_body_bi_ort(m,l,k,j,i,m,integral)
+         three_e_5_idx_cycle_1_bi_ort(m,l,j,k,i) = -1.d0 * integral 
+       enddo
+      enddo
+     enddo
+    enddo
+   enddo
+  !$OMP END DO
+  !$OMP END PARALLEL
+ call wall_time(wall1)
+ print*,'wall time for three_e_5_idx_cycle_1_bi_ort',wall1 - wall0
+
+END_PROVIDER 
+
+
+BEGIN_PROVIDER [ double precision, three_e_5_idx_cycle_2_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! matrix element of the -L  three-body operator FOR THE FIRST CYCLIC PERMUTATION TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
+!
+!three_e_5_idx_cycle_2_bi_ort(m,l,j,k,i) = <mlk|-L|imj> ::: notice that i is the RIGHT MO and k is the LEFT MO
+!
+! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+ END_DOC
+ integer :: i,j,k,m,l
+ double precision :: integral, wall1, wall0
+ character*(128) :: name_file 
+ three_e_5_idx_cycle_2_bi_ort = 0.d0
+ print*,'Providing the three_e_5_idx_cycle_2_bi_ort ...'
+ call wall_time(wall0)
+  provide x_W_ki_bi_ortho_erf_rk mos_r_in_r_array_transp mos_l_in_r_array_transp
+  !$OMP PARALLEL                  &
+  !$OMP DEFAULT (NONE)            &
+  !$OMP PRIVATE (i,j,k,m,l,integral) & 
+  !$OMP SHARED (mo_num,three_e_5_idx_cycle_2_bi_ort)
+  !$OMP DO SCHEDULE (dynamic)
+   do i = 1, mo_num
+    do k = 1, mo_num
+     do j = 1, mo_num
+      do m = 1, mo_num
+       do l = 1, mo_num
+        call give_integrals_3_body_bi_ort(m,l,k,i,m,j,integral)
+        three_e_5_idx_cycle_2_bi_ort(m,l,j,k,i) = -1.d0 * integral 
+       enddo
+      enddo
+     enddo
+    enddo
+   enddo
+  !$OMP END DO
+  !$OMP END PARALLEL
+ call wall_time(wall1)
+ print*,'wall time for three_e_5_idx_cycle_2_bi_ort',wall1 - wall0
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, three_e_5_idx_exch23_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! matrix element of the -L  three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
+!
+!three_e_5_idx_exch23_bi_ort(m,l,j,k,i) = <mlk|-L|jmi> ::: notice that i is the RIGHT MO and k is the LEFT MO
+!
+! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+ END_DOC
+ integer :: i,j,k,m,l
+ double precision :: integral, wall1, wall0
+ character*(128) :: name_file 
+ three_e_5_idx_exch23_bi_ort = 0.d0
+ print*,'Providing the three_e_5_idx_exch23_bi_ort ...'
+ call wall_time(wall0)
+  provide x_W_ki_bi_ortho_erf_rk mos_r_in_r_array_transp mos_l_in_r_array_transp
+  !$OMP PARALLEL                  &
+  !$OMP DEFAULT (NONE)            &
+  !$OMP PRIVATE (i,j,k,m,l,integral) & 
+  !$OMP SHARED (mo_num,three_e_5_idx_exch23_bi_ort)
+  !$OMP DO SCHEDULE (dynamic)
+   do i = 1, mo_num
+    do k = 1, mo_num
+     do j = 1, mo_num
+      do l = 1, mo_num
+       do m = 1, mo_num
+        call give_integrals_3_body_bi_ort(m,l,k,j,m,i,integral)
+        three_e_5_idx_exch23_bi_ort(m,l,j,k,i) = -1.d0 * integral 
+       enddo
+      enddo
+     enddo
+    enddo
+   enddo
+  !$OMP END DO
+  !$OMP END PARALLEL
+ call wall_time(wall1)
+ print*,'wall time for three_e_5_idx_exch23_bi_ort',wall1 - wall0
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, three_e_5_idx_exch13_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! matrix element of the -L  three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
+!
+!three_e_5_idx_exch13_bi_ort(m,l,j,k,i) = <mlk|-L|jmi> ::: notice that i is the RIGHT MO and k is the LEFT MO
+!
+! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+ END_DOC
+ integer :: i,j,k,m,l
+ double precision :: integral, wall1, wall0
+ character*(128) :: name_file 
+ three_e_5_idx_exch13_bi_ort = 0.d0
+ print*,'Providing the three_e_5_idx_exch13_bi_ort ...'
+ call wall_time(wall0)
+  provide x_W_ki_bi_ortho_erf_rk mos_r_in_r_array_transp mos_l_in_r_array_transp
+  !$OMP PARALLEL                  &
+  !$OMP DEFAULT (NONE)            &
+  !$OMP PRIVATE (i,j,k,m,l,integral) & 
+  !$OMP SHARED (mo_num,three_e_5_idx_exch13_bi_ort)
+  !$OMP DO SCHEDULE (dynamic)
+   do i = 1, mo_num
+    do k = 1, mo_num
+     do j = 1, mo_num
+      do l = 1, mo_num
+       do m = 1, mo_num
+        call give_integrals_3_body_bi_ort(m,l,k,i,j,m,integral)
+        three_e_5_idx_exch13_bi_ort(m,l,j,k,i) = -1.d0 * integral 
+       enddo
+      enddo
+     enddo
+    enddo
+   enddo
+  !$OMP END DO
+  !$OMP END PARALLEL
+ call wall_time(wall1)
+ print*,'wall time for three_e_5_idx_exch13_bi_ort',wall1 - wall0
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [ double precision, three_e_5_idx_exch12_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! matrix element of the -L  three-body operator FOR THE DIRECT TERMS OF DOUBLE EXCITATIONS AND BI ORTHO MOs
+!
+!three_e_5_idx_exch12_bi_ort(m,l,j,k,i) = <mlk|-L|jmi> ::: notice that i is the RIGHT MO and k is the LEFT MO
+!
+! notice the -1 sign: in this way three_e_3_idx_direct_bi_ort can be directly used to compute Slater rules with a + sign
+ END_DOC
+ integer :: i,j,k,m,l
+ double precision :: integral, wall1, wall0
+ character*(128) :: name_file 
+ three_e_5_idx_exch12_bi_ort = 0.d0
+ print*,'Providing the three_e_5_idx_exch12_bi_ort ...'
+ call wall_time(wall0)
+  provide x_W_ki_bi_ortho_erf_rk mos_r_in_r_array_transp mos_l_in_r_array_transp
+  !$OMP PARALLEL                  &
+  !$OMP DEFAULT (NONE)            &
+  !$OMP PRIVATE (i,j,k,m,l,integral) & 
+  !$OMP SHARED (mo_num,three_e_5_idx_exch12_bi_ort)
+  !$OMP DO SCHEDULE (dynamic)
+   do i = 1, mo_num
+    do k = 1, mo_num
+     do j = 1, mo_num
+      do l = 1, mo_num
+       do m = 1, mo_num
+        call give_integrals_3_body_bi_ort(m,l,k,m,i,j,integral)
+        three_e_5_idx_exch12_bi_ort(m,l,j,k,i) = -1.d0 * integral 
+       enddo
+      enddo
+     enddo
+    enddo
+   enddo
+  !$OMP END DO
+  !$OMP END PARALLEL
+ call wall_time(wall1)
+ print*,'wall time for three_e_5_idx_exch12_bi_ort',wall1 - wall0
+
+END_PROVIDER 

src/bi_ort_ints/three_body_ints_bi_ort.irp.f

@@ -0,0 +1,78 @@
+BEGIN_PROVIDER [ double precision, three_body_ints_bi_ort, (mo_num, mo_num, mo_num, mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! matrix element of the -L  three-body operator 
+!
+! notice the -1 sign: in this way three_body_ints_bi_ort can be directly used to compute Slater rules :)
+ END_DOC
+ integer :: i,j,k,l,m,n
+ double precision :: integral, wall1, wall0
+ character*(128) :: name_file 
+ three_body_ints_bi_ort = 0.d0
+ print*,'Providing the three_body_ints_bi_ort ...'
+ call wall_time(wall0)
+ name_file = 'six_index_tensor'
+! if(read_three_body_ints_bi_ort)then
+!  call read_fcidump_3_tc(three_body_ints_bi_ort)
+! else
+!  if(read_three_body_ints_bi_ort)then
+!   print*,'Reading three_body_ints_bi_ort from disk ...'
+!   call read_array_6_index_tensor(mo_num,three_body_ints_bi_ort,name_file)
+!  else
+  provide x_W_ki_bi_ortho_erf_rk mos_r_in_r_array_transp mos_l_in_r_array_transp
+  !$OMP PARALLEL                  &
+  !$OMP DEFAULT (NONE)            &
+  !$OMP PRIVATE (i,j,k,l,m,n,integral) & 
+  !$OMP SHARED (mo_num,three_body_ints_bi_ort)
+  !$OMP DO SCHEDULE (dynamic)
+   do i = 1, mo_num
+    do j = 1, mo_num
+     do m = 1, mo_num
+      do k = 1, mo_num
+       do l = 1, mo_num
+        do n = 1, mo_num
+           call give_integrals_3_body_bi_ort(n,l,k,m,j,i,integral)
+           three_body_ints_bi_ort(n,l,k,m,j,i) = -1.d0 * integral 
+        enddo
+       enddo
+      enddo
+     enddo
+    enddo
+   enddo
+  !$OMP END DO
+  !$OMP END PARALLEL
+!  endif
+! endif
+ call wall_time(wall1)
+ print*,'wall time for three_body_ints_bi_ort',wall1 - wall0
+! if(write_three_body_ints_bi_ort)then
+!  print*,'Writing three_body_ints_bi_ort on disk ...'
+!  call write_array_6_index_tensor(mo_num,three_body_ints_bi_ort,name_file)
+!  call ezfio_set_three_body_ints_bi_ort_io_three_body_ints_bi_ort("Read")
+! endif
+
+END_PROVIDER 
+
+subroutine give_integrals_3_body_bi_ort(n,l,k,m,j,i,integral)
+ implicit none
+ double precision, intent(out) :: integral
+ integer, intent(in) :: n,l,k,m,j,i
+ double precision :: weight
+ BEGIN_DOC
+! <n l k|-L|m j i> with a BI ORTHONORMAL ORBITALS 
+ END_DOC
+ integer :: ipoint,mm
+ integral = 0.d0
+ do mm = 1, 3
+  do ipoint = 1, n_points_final_grid
+   weight = final_weight_at_r_vector(ipoint)                                                                          
+   integral += weight * mos_l_in_r_array_transp(ipoint,k) * mos_r_in_r_array_transp(ipoint,i) & 
+                      * x_W_ki_bi_ortho_erf_rk(ipoint,mm,n,m) * x_W_ki_bi_ortho_erf_rk(ipoint,mm,l,j) 
+   integral += weight * mos_l_in_r_array_transp(ipoint,l) * mos_r_in_r_array_transp(ipoint,j) & 
+                      * x_W_ki_bi_ortho_erf_rk(ipoint,mm,n,m) * x_W_ki_bi_ortho_erf_rk(ipoint,mm,k,i) 
+   integral += weight * mos_l_in_r_array_transp(ipoint,n) * mos_r_in_r_array_transp(ipoint,m) & 
+                      * x_W_ki_bi_ortho_erf_rk(ipoint,mm,l,j) * x_W_ki_bi_ortho_erf_rk(ipoint,mm,k,i) 
+  enddo
+ enddo
+end
+

src/bi_ort_ints/total_twoe_pot.irp.f

@@ -0,0 +1,138 @@
+BEGIN_PROVIDER [double precision, ao_two_e_tc_tot, (ao_num, ao_num, ao_num, ao_num) ]
+ integer :: i,j,k,l
+ BEGIN_DOC
+! ao_two_e_tc_tot(k,i,l,j) = (ki|V^TC(r_12)|lj) = <lk| V^TC(r_12) |ji> where V^TC(r_12) is the total TC operator 
+!
+! including both hermitian and non hermitian parts. THIS IS IN CHEMIST NOTATION. 
+!
+! WARNING :: non hermitian ! acts on "the right functions" (i,j)
+ END_DOC
+ double precision :: integral_sym, integral_nsym, get_ao_tc_sym_two_e_pot
+ PROVIDE ao_tc_sym_two_e_pot_in_map
+ do j = 1, ao_num
+  do l = 1, ao_num
+   do i = 1, ao_num
+    do k = 1, ao_num
+     integral_sym  = get_ao_tc_sym_two_e_pot(i,j,k,l,ao_tc_sym_two_e_pot_map)
+     ! ao_non_hermit_term_chemist(k,i,l,j) = < k l | [erf( mu r12) - 1] d/d_r12 | i j > on the AO basis
+     integral_nsym = ao_non_hermit_term_chemist(k,i,l,j)
+     ao_two_e_tc_tot(k,i,l,j) = integral_sym + integral_nsym 
+    enddo
+   enddo
+  enddo
+ enddo
+END_PROVIDER 
+
+
+double precision function bi_ortho_mo_ints(l,k,j,i)
+ implicit none
+ BEGIN_DOC
+! <mo^L_k mo^L_l | V^TC(r_12) | mo^R_i mo^R_j>
+!
+! WARNING :: very naive, super slow, only used to DEBUG.
+ END_DOC
+ integer, intent(in) :: i,j,k,l
+ integer :: m,n,p,q
+ bi_ortho_mo_ints = 0.d0
+ do m = 1, ao_num
+  do p = 1, ao_num
+   do n = 1, ao_num
+    do q = 1, ao_num
+     !                                   p1h1p2h2   l1                  l2              r1               r2
+     bi_ortho_mo_ints += ao_two_e_tc_tot(n,q,m,p) * mo_l_coef(m,l) * mo_l_coef(n,k) * mo_r_coef(p,j) * mo_r_coef(q,i)
+    enddo
+   enddo
+  enddo
+ enddo
+
+end
+
+! ---
+
+BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_two_e_chemist, (mo_num, mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! mo_bi_ortho_tc_two_e_chemist(k,i,l,j) = <k l|V(r_12)|i j> where i,j are right MOs and k,l are left MOs
+ END_DOC
+ integer :: i,j,k,l,m,n,p,q
+ double precision, allocatable :: mo_tmp_1(:,:,:,:),mo_tmp_2(:,:,:,:),mo_tmp_3(:,:,:,:)
+
+!! TODO :: transform into DEGEMM
+ 
+ allocate(mo_tmp_1(mo_num,ao_num,ao_num,ao_num))
+ mo_tmp_1 = 0.d0
+ do m = 1, ao_num
+  do p = 1, ao_num
+   do n = 1, ao_num
+    do q = 1, ao_num
+     do k = 1, mo_num
+      !       (k n|p m)    = sum_q c_qk * (q n|p m)
+      mo_tmp_1(k,n,p,m) += mo_l_coef_transp(k,q) * ao_two_e_tc_tot(q,n,p,m)
+     enddo
+    enddo
+   enddo
+  enddo
+ enddo
+ allocate(mo_tmp_2(mo_num,mo_num,ao_num,ao_num))
+ mo_tmp_2 = 0.d0
+ do m = 1, ao_num
+  do p = 1, ao_num
+   do n = 1, ao_num
+    do i = 1, mo_num
+     do k = 1, mo_num
+      !       (k i|p m) = sum_n c_ni * (k n|p m)
+      mo_tmp_2(k,i,p,m) += mo_r_coef_transp(i,n) * mo_tmp_1(k,n,p,m)
+     enddo
+    enddo
+   enddo
+  enddo
+ enddo
+ deallocate(mo_tmp_1)
+ allocate(mo_tmp_1(mo_num,mo_num,mo_num,ao_num))
+ mo_tmp_1 = 0.d0
+ do m = 1, ao_num
+  do p = 1, ao_num
+   do l = 1, mo_num
+    do i = 1, mo_num
+     do k = 1, mo_num
+      mo_tmp_1(k,i,l,m) += mo_l_coef_transp(l,p) * mo_tmp_2(k,i,p,m)
+     enddo
+    enddo
+   enddo
+  enddo
+ enddo
+ deallocate(mo_tmp_2)
+ mo_bi_ortho_tc_two_e_chemist = 0.d0 
+ do m = 1, ao_num
+  do j = 1, mo_num
+   do l = 1, mo_num
+    do i = 1, mo_num
+     do k = 1, mo_num
+      mo_bi_ortho_tc_two_e_chemist(k,i,l,j) += mo_r_coef_transp(j,m)  * mo_tmp_1(k,i,l,m)
+     enddo
+    enddo
+   enddo
+  enddo
+ enddo
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [double precision, mo_bi_ortho_tc_two_e, (mo_num, mo_num, mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! mo_bi_ortho_tc_two_e(k,l,i,j) = <k l| V(r_12) |i j> where i,j are right MOs and k,l are left MOs
+!
+! the potential V(r_12) contains ALL TWO-E CONTRIBUTION OF THE TC-HAMILTONIAN
+ END_DOC
+ integer :: i,j,k,l
+ do j = 1, mo_num
+  do i = 1, mo_num
+   do l = 1, mo_num
+    do k = 1, mo_num
+     !                                                         (k i|l j) = <k l|V(r_12)|i j>
+     mo_bi_ortho_tc_two_e(k,l,i,j) = mo_bi_ortho_tc_two_e_chemist(k,i,l,j)
+    enddo
+   enddo
+  enddo
+ enddo
+END_PROVIDER 

src/bi_ortho_aos/NEED

@@ -0,0 +1,2 @@
+basis
+ao_basis

src/bi_ortho_aos/README.rst

@@ -0,0 +1,5 @@
+============
+bi_ortho_aos
+============
+
+TODO

src/bi_ortho_aos/aos_l.irp.f

@@ -0,0 +1,97 @@
+ BEGIN_PROVIDER [ double precision, ao_coef_l , (ao_num,ao_prim_num_max) ]
+ implicit none
+ BEGIN_DOC
+! Primitive coefficients and exponents for each atomic orbital. Copied from shell info.
+ END_DOC
+
+ integer :: i, l
+ do i=1,ao_num
+   l = ao_shell(i)
+   ao_coef_l(i,:) = shell_coef(l,:)
+ end do
+END_PROVIDER
+
+ BEGIN_PROVIDER [ double precision, ao_coef_l_normalized, (ao_num,ao_prim_num_max) ]
+&BEGIN_PROVIDER [ double precision, ao_coef_l_normalization_factor, (ao_num) ]
+  implicit none
+  BEGIN_DOC
+  ! Coefficients including the |AO| normalization
+  END_DOC
+
+  do i=1,ao_num
+    l = ao_shell(i)
+    ao_coef_l_normalized(i,:) = shell_coef(l,:) * shell_normalization_factor(l)
+  end do
+
+  double precision               :: norm,overlap_x,overlap_y,overlap_z,C_A(3), c
+  integer                        :: l, powA(3), nz
+  integer                        :: i,j,k
+  nz=100
+  C_A = 0.d0
+
+  do i=1,ao_num
+
+    powA(1) = ao_power(i,1)
+    powA(2) = ao_power(i,2)
+    powA(3) = ao_power(i,3)
+
+    ! Normalization of the primitives
+    if (primitives_normalized) then
+      do j=1,ao_prim_num(i)
+        call overlap_gaussian_xyz(C_A,C_A,ao_expo(i,j),ao_expo(i,j), &
+           powA,powA,overlap_x,overlap_y,overlap_z,norm,nz)
+        ao_coef_l_normalized(i,j) = ao_coef_l_normalized(i,j)/dsqrt(norm)
+      enddo
+    endif
+    ! Normalization of the contracted basis functions
+    if (ao_normalized) then
+      norm = 0.d0
+      do j=1,ao_prim_num(i)
+        do k=1,ao_prim_num(i)
+          call overlap_gaussian_xyz(C_A,C_A,ao_expo(i,j),ao_expo(i,k),powA,powA,overlap_x,overlap_y,overlap_z,c,nz)
+          norm = norm+c*ao_coef_l_normalized(i,j)*ao_coef_l_normalized(i,k)
+        enddo
+      enddo
+      ao_coef_l_normalization_factor(i) = 1.d0/dsqrt(norm)
+    else
+      ao_coef_l_normalization_factor(i) = 1.d0
+    endif
+  enddo
+
+END_PROVIDER
+
+ BEGIN_PROVIDER [ double precision, ao_coef_l_normalized_ordered, (ao_num,ao_prim_num_max) ]
+  implicit none
+  BEGIN_DOC
+  ! Sorted primitives to accelerate 4 index |MO| transformation
+  END_DOC
+
+  integer                        :: iorder(ao_prim_num_max)
+  double precision               :: d(ao_prim_num_max,2)
+  integer                        :: i,j
+  do i=1,ao_num
+    do j=1,ao_prim_num(i)
+      iorder(j) = j
+      d(j,2) = ao_coef_l_normalized(i,j)
+    enddo
+    call dsort(d(1,1),iorder,ao_prim_num(i))
+    call dset_order(d(1,2),iorder,ao_prim_num(i))
+    do j=1,ao_prim_num(i)
+      ao_coef_l_normalized_ordered(i,j) = d(j,2)
+    enddo
+  enddo
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, ao_coef_l_normalized_ordered_transp, (ao_prim_num_max,ao_num) ]
+  implicit none
+  BEGIN_DOC
+  ! Transposed :c:data:`ao_coef_l_normalized_ordered`
+  END_DOC
+  integer                        :: i,j
+  do j=1, ao_num
+    do i=1, ao_prim_num_max
+      ao_coef_l_normalized_ordered_transp(i,j) = ao_coef_l_normalized_ordered(j,i)
+    enddo
+  enddo
+END_PROVIDER
+

src/bi_ortho_aos/aos_r.irp.f

@@ -0,0 +1,97 @@
+ BEGIN_PROVIDER [ double precision, ao_coef_r , (ao_num,ao_prim_num_max) ]
+ implicit none
+ BEGIN_DOC
+! Primitive coefficients and exponents for each atomic orbital. Copied from shell info.
+ END_DOC
+
+ integer :: i, l
+ do i=1,ao_num
+   l = ao_shell(i)
+   ao_coef_r(i,:) = shell_coef(l,:)
+ end do
+END_PROVIDER
+
+ BEGIN_PROVIDER [ double precision, ao_coef_r_normalized, (ao_num,ao_prim_num_max) ]
+&BEGIN_PROVIDER [ double precision, ao_coef_r_normalization_factor, (ao_num) ]
+  implicit none
+  BEGIN_DOC
+  ! Coefficients including the |AO| normalization
+  END_DOC
+
+  do i=1,ao_num
+    l = ao_shell(i)
+    ao_coef_r_normalized(i,:) = shell_coef(l,:) * shell_normalization_factor(l)
+  end do
+
+  double precision               :: norm,overlap_x,overlap_y,overlap_z,C_A(3), c
+  integer                        :: l, powA(3), nz
+  integer                        :: i,j,k
+  nz=100
+  C_A = 0.d0
+
+  do i=1,ao_num
+
+    powA(1) = ao_power(i,1)
+    powA(2) = ao_power(i,2)
+    powA(3) = ao_power(i,3)
+
+    ! Normalization of the primitives
+    if (primitives_normalized) then
+      do j=1,ao_prim_num(i)
+        call overlap_gaussian_xyz(C_A,C_A,ao_expo(i,j),ao_expo(i,j), &
+           powA,powA,overlap_x,overlap_y,overlap_z,norm,nz)
+        ao_coef_r_normalized(i,j) = ao_coef_r_normalized(i,j)/dsqrt(norm)
+      enddo
+    endif
+    ! Normalization of the contracted basis functions
+    if (ao_normalized) then
+      norm = 0.d0
+      do j=1,ao_prim_num(i)
+        do k=1,ao_prim_num(i)
+          call overlap_gaussian_xyz(C_A,C_A,ao_expo(i,j),ao_expo(i,k),powA,powA,overlap_x,overlap_y,overlap_z,c,nz)
+          norm = norm+c*ao_coef_r_normalized(i,j)*ao_coef_r_normalized(i,k)
+        enddo
+      enddo
+      ao_coef_r_normalization_factor(i) = 1.d0/dsqrt(norm)
+    else
+      ao_coef_r_normalization_factor(i) = 1.d0
+    endif
+  enddo
+
+END_PROVIDER
+
+ BEGIN_PROVIDER [ double precision, ao_coef_r_normalized_ordered, (ao_num,ao_prim_num_max) ]
+  implicit none
+  BEGIN_DOC
+  ! Sorted primitives to accelerate 4 index |MO| transformation
+  END_DOC
+
+  integer                        :: iorder(ao_prim_num_max)
+  double precision               :: d(ao_prim_num_max,2)
+  integer                        :: i,j
+  do i=1,ao_num
+    do j=1,ao_prim_num(i)
+      iorder(j) = j
+      d(j,2) = ao_coef_r_normalized(i,j)
+    enddo
+    call dsort(d(1,1),iorder,ao_prim_num(i))
+    call dset_order(d(1,2),iorder,ao_prim_num(i))
+    do j=1,ao_prim_num(i)
+      ao_coef_r_normalized_ordered(i,j) = d(j,2)
+    enddo
+  enddo
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, ao_coef_r_normalized_ordered_transp, (ao_prim_num_max,ao_num) ]
+  implicit none
+  BEGIN_DOC
+  ! Transposed :c:data:`ao_coef_r_normalized_ordered`
+  END_DOC
+  integer                        :: i,j
+  do j=1, ao_num
+    do i=1, ao_prim_num_max
+      ao_coef_r_normalized_ordered_transp(i,j) = ao_coef_r_normalized_ordered(j,i)
+    enddo
+  enddo
+END_PROVIDER
+

src/bi_ortho_mos/EZFIO.cfg

@@ -0,0 +1,11 @@
+[mo_r_coef]
+type: double precision
+doc: right-coefficient of the i-th |AO| on the j-th |MO|
+interface: ezfio
+size: (ao_basis.ao_num,mo_basis.mo_num)
+
+[mo_l_coef]
+type: double precision
+doc: right-coefficient of the i-th |AO| on the j-th |MO|
+interface: ezfio
+size: (ao_basis.ao_num,mo_basis.mo_num)

src/bi_ortho_mos/NEED

@@ -0,0 +1,3 @@
+mo_basis
+becke_numerical_grid
+dft_utils_in_r

src/bi_ortho_mos/bi_density.irp.f

@@ -0,0 +1,49 @@
+
+! ---
+
+BEGIN_PROVIDER [double precision, TCSCF_bi_ort_dm_ao_alpha, (ao_num, ao_num) ]
+  implicit none
+ BEGIN_DOC
+! TCSCF_bi_ort_dm_ao_alpha(i,j) = <Chi_0| a^dagger_i,alpha a_j,alpha |Phi_0> where i,j are AO basis. 
+!
+! This is the equivalent of the alpha density of the HF Slater determinant, but with a couple of bi-orthonormal Slater determinant |Chi_0> and |Phi_0>
+ END_DOC
+  call dgemm( 'N', 'T', ao_num, ao_num, elec_alpha_num, 1.d0               &
+            , mo_l_coef, size(mo_l_coef, 1), mo_r_coef, size(mo_r_coef, 1) &
+            , 0.d0, TCSCF_bi_ort_dm_ao_alpha, size(TCSCF_bi_ort_dm_ao_alpha, 1) )
+END_PROVIDER
+
+! ---
+
+BEGIN_PROVIDER [ double precision, TCSCF_bi_ort_dm_ao_beta, (ao_num, ao_num) ]
+  implicit none
+ BEGIN_DOC
+! TCSCF_bi_ort_dm_ao_beta(i,j) = <Chi_0| a^dagger_i,beta a_j,beta |Phi_0> where i,j are AO basis. 
+!
+! This is the equivalent of the beta density of the HF Slater determinant, but with a couple of bi-orthonormal Slater determinant |Chi_0> and |Phi_0>
+ END_DOC
+  call dgemm( 'N', 'T', ao_num, ao_num, elec_beta_num, 1.d0               &
+            , mo_l_coef, size(mo_l_coef, 1), mo_r_coef, size(mo_r_coef, 1) &
+            , 0.d0, TCSCF_bi_ort_dm_ao_beta, size(TCSCF_bi_ort_dm_ao_beta, 1) )
+END_PROVIDER
+
+! ---
+
+BEGIN_PROVIDER [ double precision, TCSCF_bi_ort_dm_ao, (ao_num, ao_num) ]
+  implicit none
+ BEGIN_DOC
+! TCSCF_bi_ort_dm_ao(i,j) = <Chi_0| a^dagger_i,beta+alpha a_j,beta+alpha |Phi_0> where i,j are AO basis. 
+!
+! This is the equivalent of the total electronic density of the HF Slater determinant, but with a couple of bi-orthonormal Slater determinant |Chi_0> and |Phi_0>
+ END_DOC
+  ASSERT ( size(TCSCF_bi_ort_dm_ao, 1) == size(TCSCF_bi_ort_dm_ao_alpha, 1) )
+  if( elec_alpha_num==elec_beta_num ) then
+    TCSCF_bi_ort_dm_ao = TCSCF_bi_ort_dm_ao_alpha + TCSCF_bi_ort_dm_ao_alpha
+  else
+    ASSERT ( size(TCSCF_bi_ort_dm_ao, 1) == size(TCSCF_bi_ort_dm_ao_beta, 1))
+    TCSCF_bi_ort_dm_ao = TCSCF_bi_ort_dm_ao_alpha + TCSCF_bi_ort_dm_ao_beta
+  endif
+END_PROVIDER
+
+! ---
+

src/bi_ortho_mos/bi_ort_mos_in_r.irp.f

@@ -0,0 +1,137 @@
+
+! TODO: left & right MO without duplicate AO calculation
+
+! ---
+
+BEGIN_PROVIDER[double precision, mos_r_in_r_array, (mo_num, n_points_final_grid)]
+
+  BEGIN_DOC
+  ! mos_in_r_array(i,j) = value of the ith RIGHT mo on the jth grid point
+  END_DOC
+
+  implicit none
+  integer          :: i, j
+  double precision :: mos_array(mo_num), r(3)
+
+ !$OMP PARALLEL DO &
+ !$OMP DEFAULT (NONE)  &
+ !$OMP PRIVATE (i, j, r, mos_array) & 
+ !$OMP SHARED (mos_r_in_r_array, n_points_final_grid, mo_num, final_grid_points)
+  do i = 1, n_points_final_grid
+    r(1) = final_grid_points(1,i)
+    r(2) = final_grid_points(2,i)
+    r(3) = final_grid_points(3,i)
+    call give_all_mos_r_at_r(r, mos_array)
+    do j = 1, mo_num
+      mos_r_in_r_array(j,i) = mos_array(j)
+    enddo
+  enddo
+ !$OMP END PARALLEL DO
+ 
+END_PROVIDER
+
+! ---
+
+BEGIN_PROVIDER[double precision, mos_r_in_r_array_transp, (n_points_final_grid, mo_num)]
+
+  BEGIN_DOC
+  ! mos_r_in_r_array_transp(i,j) = value of the jth mo on the ith grid point
+  END_DOC
+
+  implicit none
+  integer :: i,j
+
+  do i = 1, n_points_final_grid
+    do j = 1, mo_num
+      mos_r_in_r_array_transp(i,j) = mos_r_in_r_array(j,i) 
+    enddo
+  enddo
+ 
+END_PROVIDER
+
+! ---
+
+subroutine give_all_mos_r_at_r(r, mos_r_array)
+
+  BEGIN_DOC
+  ! mos_r_array(i) = ith RIGHT MO function evaluated at "r"
+  END_DOC
+
+  implicit none
+  double precision, intent(in)  :: r(3)
+  double precision, intent(out) :: mos_r_array(mo_num)
+  double precision              :: aos_array(ao_num)
+
+  call give_all_aos_at_r(r, aos_array)
+  call dgemv('N', mo_num, ao_num, 1.d0, mo_r_coef_transp, mo_num, aos_array, 1, 0.d0, mos_r_array, 1)
+
+end subroutine give_all_mos_r_at_r
+
+! ---
+
+BEGIN_PROVIDER[double precision, mos_l_in_r_array, (mo_num, n_points_final_grid)]
+
+  BEGIN_DOC
+  ! mos_in_r_array(i,j) = value of the ith LEFT mo on the jth grid point
+  END_DOC
+
+  implicit none
+  integer          :: i, j
+  double precision :: mos_array(mo_num), r(3)
+
+ !$OMP PARALLEL DO &
+ !$OMP DEFAULT (NONE)  &
+ !$OMP PRIVATE (i,r,mos_array,j) & 
+ !$OMP SHARED(mos_l_in_r_array,n_points_final_grid,mo_num,final_grid_points)
+  do i = 1, n_points_final_grid
+    r(1) = final_grid_points(1,i)
+    r(2) = final_grid_points(2,i)
+    r(3) = final_grid_points(3,i)
+    call give_all_mos_l_at_r(r, mos_array)
+    do j = 1, mo_num
+      mos_l_in_r_array(j,i) = mos_array(j)
+    enddo
+  enddo
+ !$OMP END PARALLEL DO
+ 
+END_PROVIDER
+
+! ---
+
+subroutine give_all_mos_l_at_r(r, mos_l_array)
+
+  BEGIN_DOC
+  ! mos_l_array(i) = ith LEFT MO function evaluated at "r"
+  END_DOC
+
+  implicit none
+  double precision, intent(in)  :: r(3)
+  double precision, intent(out) :: mos_l_array(mo_num)
+  double precision              :: aos_array(ao_num)
+
+  call give_all_aos_at_r(r, aos_array)
+  call dgemv('N', mo_num, ao_num, 1.d0, mo_l_coef_transp, mo_num, aos_array, 1, 0.d0, mos_l_array, 1)
+
+end subroutine give_all_mos_l_at_r
+
+! ---
+
+BEGIN_PROVIDER[double precision, mos_l_in_r_array_transp,(n_points_final_grid,mo_num)]
+
+  BEGIN_DOC
+  ! mos_l_in_r_array_transp(i,j) = value of the jth mo on the ith grid point
+  END_DOC
+
+  implicit none
+  integer :: i, j
+
+  do i = 1, n_points_final_grid
+    do j = 1, mo_num
+      mos_l_in_r_array_transp(i,j) = mos_l_in_r_array(j,i) 
+    enddo
+  enddo
+ 
+END_PROVIDER
+
+! ---
+

src/bi_ortho_mos/grad_bi_ort_mos_in_r.irp.f

@@ -0,0 +1,100 @@
+ BEGIN_PROVIDER[double precision, mos_r_grad_in_r_array,(mo_num,n_points_final_grid,3)]
+ implicit none
+ BEGIN_DOC
+ ! mos_r_grad_in_r_array(i,j,k)          = value of the kth component of the gradient of ith RIGHT mo on the jth grid point
+ !
+ ! k = 1 : x, k= 2, y, k  3, z
+ END_DOC
+ integer :: m
+ mos_r_grad_in_r_array = 0.d0
+ do m=1,3
+  call dgemm('N','N',mo_num,n_points_final_grid,ao_num,1.d0,mo_r_coef_transp,mo_num,aos_grad_in_r_array(1,1,m),ao_num,0.d0,mos_r_grad_in_r_array(1,1,m),mo_num)
+ enddo
+ END_PROVIDER
+
+ BEGIN_PROVIDER[double precision, mos_r_grad_in_r_array_transp,(3,mo_num,n_points_final_grid)]
+ implicit none
+ BEGIN_DOC
+ ! mos_r_grad_in_r_array_transp(i,j,k)   = value of the kth component of the gradient of jth RIGHT mo on the ith grid point
+ !
+ ! k = 1 : x, k= 2, y, k  3, z
+ END_DOC
+ integer :: m
+ integer  :: i,j
+ mos_r_grad_in_r_array_transp = 0.d0
+ do i = 1, n_points_final_grid
+  do j = 1, mo_num
+   do m = 1, 3
+     mos_r_grad_in_r_array_transp(m,j,i) = mos_r_grad_in_r_array(j,i,m)
+   enddo
+  enddo
+ enddo                                                                                                                                                                                 
+ END_PROVIDER
+
+ BEGIN_PROVIDER[double precision, mos_r_grad_in_r_array_transp_bis,(3,n_points_final_grid,mo_num)]
+ implicit none
+ BEGIN_DOC
+ ! mos_r_grad_in_r_array_transp(i,j,k)   = value of the ith component of the gradient on the jth grid point of jth RIGHT MO 
+ END_DOC
+ integer :: m
+ integer  :: i,j
+ mos_r_grad_in_r_array_transp_bis = 0.d0
+ do j = 1, mo_num
+  do i = 1, n_points_final_grid
+   do m = 1, 3
+     mos_r_grad_in_r_array_transp_bis(m,i,j) = mos_r_grad_in_r_array(j,i,m)
+   enddo
+  enddo
+ enddo                                                                                                                                                                                 
+ END_PROVIDER
+
+
+ BEGIN_PROVIDER[double precision, mos_l_grad_in_r_array,(mo_num,n_points_final_grid,3)]
+ implicit none
+ BEGIN_DOC
+ ! mos_l_grad_in_r_array(i,j,k)          = value of the kth component of the gradient of ith RIGHT mo on the jth grid point
+ !
+ ! k = 1 : x, k= 2, y, k  3, z
+ END_DOC
+ integer :: m
+ mos_l_grad_in_r_array = 0.d0
+ do m=1,3
+  call dgemm('N','N',mo_num,n_points_final_grid,ao_num,1.d0,mo_r_coef_transp,mo_num,aos_grad_in_r_array(1,1,m),ao_num,0.d0,mos_l_grad_in_r_array(1,1,m),mo_num)
+ enddo
+ END_PROVIDER
+
+ BEGIN_PROVIDER[double precision, mos_l_grad_in_r_array_transp,(3,mo_num,n_points_final_grid)]
+ implicit none
+ BEGIN_DOC
+ ! mos_l_grad_in_r_array_transp(i,j,k)   = value of the kth component of the gradient of jth RIGHT mo on the ith grid point
+ !
+ ! k = 1 : x, k= 2, y, k  3, z
+ END_DOC
+ integer :: m
+ integer  :: i,j
+ mos_l_grad_in_r_array_transp = 0.d0
+ do i = 1, n_points_final_grid
+  do j = 1, mo_num
+   do m = 1, 3
+     mos_l_grad_in_r_array_transp(m,j,i) = mos_l_grad_in_r_array(j,i,m)
+   enddo
+  enddo
+ enddo                                                                                                                                                                                 
+ END_PROVIDER
+
+ BEGIN_PROVIDER[double precision, mos_l_grad_in_r_array_transp_bis,(3,n_points_final_grid,mo_num)]
+ implicit none
+ BEGIN_DOC
+ ! mos_l_grad_in_r_array_transp(i,j,k)   = value of the ith component of the gradient on the jth grid point of jth RIGHT MO 
+ END_DOC
+ integer :: m
+ integer  :: i,j
+ mos_l_grad_in_r_array_transp_bis = 0.d0
+ do j = 1, mo_num
+  do i = 1, n_points_final_grid
+   do m = 1, 3
+     mos_l_grad_in_r_array_transp_bis(m,i,j) = mos_l_grad_in_r_array(j,i,m)
+   enddo
+  enddo
+ enddo                                                                                                                                                                                 
+ END_PROVIDER

src/bi_ortho_mos/mos_rl.irp.f

@@ -0,0 +1,173 @@
+subroutine ao_to_mo_bi_ortho(A_ao, LDA_ao, A_mo, LDA_mo)
+
+  BEGIN_DOC
+  ! Transform A from the |AO| basis to the BI ORTHONORMAL MOS 
+  !
+  ! $C_L^\dagger.A_{ao}.C_R$ where C_L and C_R are the LEFT and RIGHT MO coefs
+  END_DOC
+
+  implicit none
+  integer, intent(in)           :: LDA_ao,LDA_mo
+  double precision, intent(in)  :: A_ao(LDA_ao,ao_num)
+  double precision, intent(out) :: A_mo(LDA_mo,mo_num)
+  double precision, allocatable :: T(:,:)
+
+  allocate ( T(ao_num,mo_num) )
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T
+  integer :: i,j,p,q
+
+  call dgemm('N', 'N', ao_num, mo_num, ao_num,  &
+      1.d0, A_ao, LDA_ao,                       &
+      mo_r_coef, size(mo_r_coef, 1),            &
+      0.d0, T, size(T, 1))
+
+  call dgemm('T', 'N', mo_num, mo_num, ao_num, &
+      1.d0, mo_l_coef, size(mo_l_coef, 1),     &
+      T, ao_num,                               &
+      0.d0, A_mo, size(A_mo, 1))
+
+!  call restore_symmetry(mo_num,mo_num,A_mo,size(A_mo,1),1.d-12)
+ deallocate(T)
+
+end subroutine ao_to_mo_bi_ortho
+
+! ---
+
+BEGIN_PROVIDER [ double precision, mo_r_coef, (ao_num, mo_num) ]
+
+  BEGIN_DOC
+  !
+  ! Molecular right-orbital coefficients on |AO| basis set
+  !
+  END_DOC
+
+  implicit none
+  integer :: i, j
+  logical :: exists
+
+  PROVIDE ezfio_filename
+
+  if (mpi_master) then
+    call ezfio_has_bi_ortho_mos_mo_r_coef(exists)
+  endif
+  IRP_IF MPI_DEBUG
+    print *,  irp_here, mpi_rank
+    call MPI_BARRIER(MPI_COMM_WORLD, ierr)
+  IRP_ENDIF
+  IRP_IF MPI
+    include 'mpif.h'
+    integer :: ierr
+    call MPI_BCAST(exists, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr)
+    if (ierr /= MPI_SUCCESS) then
+      stop 'Unable to read mo_r_coef with MPI'
+    endif
+  IRP_ENDIF
+
+  if (exists) then
+    if (mpi_master) then
+      call ezfio_get_bi_ortho_mos_mo_r_coef(mo_r_coef)
+      write(*,*) 'Read mo_r_coef'
+    endif
+    IRP_IF MPI
+      call MPI_BCAST(mo_r_coef, mo_num*ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
+      if (ierr /= MPI_SUCCESS) then
+        stop 'Unable to read mo_r_coef with MPI'
+      endif
+    IRP_ENDIF
+  else
+
+    print*, 'mo_r_coef are mo_coef'
+    do i = 1, mo_num
+      do j = 1, ao_num
+        mo_r_coef(j,i) = mo_coef(j,i)
+      enddo
+    enddo
+  endif
+
+END_PROVIDER
+
+! ---
+
+BEGIN_PROVIDER [ double precision, mo_l_coef, (ao_num, mo_num) ]
+
+  BEGIN_DOC
+  !
+  ! Molecular left-orbital coefficients on |AO| basis set
+  !
+  END_DOC
+
+  implicit none
+  integer :: i, j
+  logical :: exists
+
+  PROVIDE ezfio_filename
+
+  if (mpi_master) then
+    call ezfio_has_bi_ortho_mos_mo_l_coef(exists)
+  endif
+  IRP_IF MPI_DEBUG
+    print *,  irp_here, mpi_rank
+    call MPI_BARRIER(MPI_COMM_WORLD, ierr)
+  IRP_ENDIF
+  IRP_IF MPI
+    include 'mpif.h'
+    integer :: ierr
+    call MPI_BCAST(exists, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, ierr)
+    if (ierr /= MPI_SUCCESS) then
+      stop 'Unable to read mo_l_coef with MPI'
+    endif
+  IRP_ENDIF
+
+  if (exists) then
+    if (mpi_master) then
+      call ezfio_get_bi_ortho_mos_mo_l_coef(mo_l_coef)
+      write(*,*) 'Read mo_l_coef'
+    endif
+    IRP_IF MPI
+      call MPI_BCAST(mo_l_coef, mo_num*ao_num, MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr)
+      if (ierr /= MPI_SUCCESS) then
+        stop 'Unable to read mo_l_coef with MPI'
+      endif
+    IRP_ENDIF
+  else
+
+    print*, 'mo_r_coef are mo_coef'
+    do i = 1, mo_num
+      do j = 1, ao_num
+        mo_l_coef(j,i) = mo_coef(j,i)
+      enddo
+    enddo
+  endif
+
+END_PROVIDER
+
+! ---
+
+BEGIN_PROVIDER [ double precision, mo_r_coef_transp, (mo_num, ao_num)]
+
+  implicit none
+  integer :: j, m
+  do j = 1, mo_num
+    do m = 1, ao_num
+      mo_r_coef_transp(j,m) = mo_r_coef(m,j)
+    enddo
+  enddo
+
+END_PROVIDER 
+
+! ---
+
+BEGIN_PROVIDER [ double precision, mo_l_coef_transp, (mo_num, ao_num)]
+
+  implicit none
+  integer :: j, m
+  do j = 1, mo_num
+    do m = 1, ao_num
+      mo_l_coef_transp(j,m) = mo_l_coef(m,j)
+    enddo
+  enddo
+
+END_PROVIDER 
+
+! ---
+

src/bi_ortho_mos/overlap.irp.f

@@ -0,0 +1,120 @@
+
+
+ BEGIN_PROVIDER [ double precision, overlap_bi_ortho, (mo_num, mo_num)]
+&BEGIN_PROVIDER [ double precision, overlap_diag_bi_ortho, (mo_num)]
+
+  BEGIN_DOC
+  ! Overlap matrix between the RIGHT and LEFT MOs. Should be the identity matrix 
+  END_DOC
+
+  implicit none
+  integer                       :: i, k, m, n
+  double precision              :: accu_d, accu_nd 
+  double precision, allocatable :: tmp(:,:)
+  
+ ! TODO : re do the DEGEMM
+
+  overlap_bi_ortho = 0.d0
+  do i = 1, mo_num
+    do k = 1, mo_num
+      do m = 1, ao_num
+        do n = 1, ao_num
+          overlap_bi_ortho(k,i) += ao_overlap(n,m) * mo_l_coef(n,k) * mo_r_coef(m,i)
+        enddo
+      enddo
+    enddo
+  enddo
+
+!  allocate( tmp(mo_num,ao_num) )
+!
+!  ! tmp <-- L.T x S_ao
+!  call dgemm( "T", "N", mo_num, ao_num, ao_num, 1.d0                         & 
+!            , mo_l_coef, size(mo_l_coef, 1), ao_overlap, size(ao_overlap, 1) &
+!            , 0.d0, tmp, size(tmp, 1) )
+!
+!  ! S <-- tmp x R
+!  call dgemm( "N", "N", mo_num, mo_num, ao_num, 1.d0           & 
+!            , tmp, size(tmp, 1), mo_r_coef, size(mo_r_coef, 1) &
+!            , 0.d0, overlap_bi_ortho, size(overlap_bi_ortho, 1) )
+!
+!  deallocate( tmp )
+
+  do i = 1, mo_num
+    overlap_diag_bi_ortho(i) = overlap_bi_ortho(i,i)
+  enddo
+
+  accu_d  = 0.d0
+  accu_nd = 0.d0
+  do i = 1, mo_num
+    do k = 1, mo_num
+      if(i==k) then
+        accu_d += dabs(overlap_bi_ortho(k,i))
+      else
+        accu_nd += dabs(overlap_bi_ortho(k,i))
+      endif
+    enddo 
+  enddo
+  accu_d = accu_d/dble(mo_num)
+  accu_nd = accu_nd/dble(mo_num**2-mo_num)
+  if(dabs(accu_d-1.d0).gt.1.d-10.or.dabs(accu_nd).gt.1.d-10)then
+    print*,'Warning !!!'
+    print*,'Average trace of overlap_bi_ortho is different from 1 by ', accu_d
+    print*,'And bi orthogonality is off by an average of ',accu_nd
+    print*,'****************'
+    print*,'Overlap matrix betwee mo_l_coef and mo_r_coef  '
+    do i = 1, mo_num
+      write(*,'(100(F16.10,X))')overlap_bi_ortho(i,:)
+    enddo
+  endif
+  print*,'Average trace of overlap_bi_ortho (should be 1.)'
+  print*,'accu_d  = ',accu_d
+  print*,'Sum of off diagonal terms of overlap_bi_ortho (should be zero)'
+  print*,'accu_nd = ',accu_nd
+  print*,'****************'
+ 
+END_PROVIDER 
+
+! ---
+
+
+ BEGIN_PROVIDER [ double precision, overlap_mo_r, (mo_num, mo_num)]
+&BEGIN_PROVIDER [ double precision, overlap_mo_l, (mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! overlap_mo_r_mo(j,i) = <MO_i|MO_R_j>
+ END_DOC
+ integer :: i,j,p,q
+ overlap_mo_r= 0.d0
+ overlap_mo_l= 0.d0
+ do i = 1, mo_num
+   do j = 1, mo_num
+    do p = 1, ao_num
+     do q = 1, ao_num
+      overlap_mo_r(j,i) += mo_r_coef(q,i) * mo_r_coef(p,j) * ao_overlap(q,p) 
+      overlap_mo_l(j,i) += mo_l_coef(q,i) * mo_l_coef(p,j) * ao_overlap(q,p)
+     enddo
+    enddo
+   enddo
+ enddo
+END_PROVIDER 
+
+ BEGIN_PROVIDER [ double precision, overlap_mo_r_mo, (mo_num, mo_num)]
+&BEGIN_PROVIDER [ double precision, overlap_mo_l_mo, (mo_num, mo_num)]
+ implicit none
+ BEGIN_DOC
+! overlap_mo_r_mo(j,i) = <MO_j|MO_R_i>
+ END_DOC
+ integer :: i,j,p,q
+ overlap_mo_r_mo = 0.d0
+ overlap_mo_l_mo = 0.d0
+ do i = 1, mo_num
+   do j = 1, mo_num
+    do p = 1, ao_num
+     do q = 1, ao_num
+      overlap_mo_r_mo(j,i) += mo_coef(p,j) * mo_r_coef(q,i) * ao_overlap(q,p)
+      overlap_mo_l_mo(j,i) += mo_coef(p,j) * mo_l_coef(q,i) * ao_overlap(q,p)
+     enddo
+    enddo
+   enddo
+ enddo
+END_PROVIDER 

src/non_h_ints_mu/NEED

@@ -0,0 +1,2 @@
+ao_tc_eff_map
+bi_ortho_mos

src/non_h_ints_mu/README.rst

@@ -0,0 +1,11 @@
+=============
+non_h_ints_mu
+=============
+
+Computes the non hermitian potential of the mu-TC Hamiltonian on the AO and BI-ORTHO MO basis.
+The operator is defined in Eq. 33 of JCP 154, 084119 (2021)
+
+The two providers are :
++) ao_non_hermit_term_chemist which returns the non hermitian part of the two-electron TC Hamiltonian on the MO basis. 
++) mo_non_hermit_term_chemist which returns the non hermitian part of the two-electron TC Hamiltonian on the BI-ORTHO MO basis. 
+

src/non_h_ints_mu/grad_tc_int.irp.f

@@ -0,0 +1,177 @@
+BEGIN_PROVIDER [double precision, ao_non_hermit_term_chemist, (ao_num, ao_num, ao_num, ao_num)]
+ implicit none
+BEGIN_DOC
+!                            1 1 2 2      1 2                                1 2 
+!
+! ao_non_hermit_term_chemist(k,i,l,j) = < k l | [erf( mu r12) - 1] d/d_r12 | i j > on the AO basis
+END_DOC
+ integer :: i,j,k,l,ipoint,m
+ double precision :: weight1,thr,r(3)
+ thr = 1.d-8
+ double precision, allocatable :: b_mat(:,:,:,:),ac_mat(:,:,:,:)
+! provide v_ij_erf_rk_cst_mu 
+ provide v_ij_erf_rk_cst_mu x_v_ij_erf_rk_cst_mu
+  call wall_time(wall0)
+ allocate(b_mat(n_points_final_grid,ao_num,ao_num,3),ac_mat(ao_num, ao_num, ao_num, ao_num))
+ !$OMP PARALLEL                  &
+ !$OMP DEFAULT (NONE)            &
+ !$OMP PRIVATE (i,k,m,ipoint,r,weight1) & 
+ !$OMP SHARED (aos_in_r_array_transp,aos_grad_in_r_array_transp_bis,b_mat)& 
+ !$OMP SHARED (ao_num,n_points_final_grid,final_grid_points,final_weight_at_r_vector)
+ !$OMP DO SCHEDULE (static)
+ do m = 1, 3
+  do i = 1, ao_num
+   do k = 1, ao_num
+    do ipoint = 1, n_points_final_grid
+     r(1) = final_grid_points(1,ipoint)
+     r(2) = final_grid_points(2,ipoint)
+     r(3) = final_grid_points(3,ipoint)
+     weight1 = final_weight_at_r_vector(ipoint)
+     b_mat(ipoint,k,i,m) = 0.5d0 * aos_in_r_array_transp(ipoint,k) * r(m) * weight1 * aos_grad_in_r_array_transp_bis(ipoint,i,m) 
+    enddo
+   enddo
+  enddo
+ enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  ac_mat = 0.d0
+  do m = 1, 3
+   !           A   B^T  dim(A,1)       dim(B,2)       dim(A,2)        alpha * A                LDA 
+   call dgemm("N","N",ao_num*ao_num,ao_num*ao_num,n_points_final_grid,1.d0,v_ij_erf_rk_cst_mu(1,1,1),ao_num*ao_num & 
+                     ,b_mat(1,1,1,m),n_points_final_grid,1.d0,ac_mat,ao_num*ao_num)
+  enddo
+
+ !$OMP PARALLEL                  &
+ !$OMP DEFAULT (NONE)            &
+ !$OMP PRIVATE (i,k,m,ipoint,weight1) & 
+ !$OMP SHARED (aos_in_r_array_transp,aos_grad_in_r_array_transp_bis,b_mat,ao_num,n_points_final_grid,final_weight_at_r_vector)
+ !$OMP DO SCHEDULE (static)
+ do m = 1, 3
+  do i = 1, ao_num
+   do k = 1, ao_num
+    do ipoint = 1, n_points_final_grid
+     weight1 = final_weight_at_r_vector(ipoint)
+     b_mat(ipoint,k,i,m) = 0.5d0 * aos_in_r_array_transp(ipoint,k) * weight1 * aos_grad_in_r_array_transp_bis(ipoint,i,m) 
+    enddo
+   enddo
+  enddo
+ enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+
+  do m = 1, 3
+   !           A   B^T  dim(A,1)       dim(B,2)       dim(A,2)        alpha * A                LDA 
+   call dgemm("N","N",ao_num*ao_num,ao_num*ao_num,n_points_final_grid,-1.d0,x_v_ij_erf_rk_cst_mu(1,1,1,m),ao_num*ao_num & 
+                     ,b_mat(1,1,1,m),n_points_final_grid,1.d0,ac_mat,ao_num*ao_num)
+  enddo
+
+ !$OMP PARALLEL                  &
+ !$OMP DEFAULT (NONE)            &
+ !$OMP PRIVATE (i,k,j,l) & 
+ !$OMP SHARED (ac_mat,ao_non_hermit_term_chemist,ao_num)
+ !$OMP DO SCHEDULE (static)
+ do j = 1, ao_num
+  do l = 1, ao_num
+   do i = 1, ao_num
+    do k = 1, ao_num
+      ao_non_hermit_term_chemist(k,i,l,j) = ac_mat(k,i,l,j) + ac_mat(l,j,k,i)    
+    enddo
+   enddo
+  enddo
+ enddo
+ !$OMP END DO
+ !$OMP END PARALLEL
+  double precision :: wall1, wall0
+  call wall_time(wall1)
+  print*,'wall time dgemm ',wall1 - wall0
+END_PROVIDER 
+
+BEGIN_PROVIDER [double precision, mo_non_hermit_term_chemist, (mo_num, mo_num, mo_num, mo_num)]
+ implicit none
+BEGIN_DOC
+!                            1 1 2 2      1 2                                1 2 
+!
+! mo_non_hermit_term_chemist(k,i,l,j) = < k l | [erf( mu r12) - 1] d/d_r12 | i j > on the MO basis
+END_DOC
+ integer :: i,j,k,l,m,n,p,q
+ double precision, allocatable :: mo_tmp_1(:,:,:,:),mo_tmp_2(:,:,:,:),mo_tmp_3(:,:,:,:)
+ 
+ allocate(mo_tmp_1(mo_num,ao_num,ao_num,ao_num))
+ ! TODO :: optimization :: transform into DGEM
+ mo_tmp_1 = 0.d0
+ do m = 1, ao_num
+  do p = 1, ao_num
+   do n = 1, ao_num
+    do q = 1, ao_num
+     do k = 1, mo_num
+      !       (k n|p m)    = sum_q c_qk * (q n|p m)
+      mo_tmp_1(k,n,p,m) += mo_coef_transp(k,q) * ao_non_hermit_term_chemist(q,n,p,m)
+     enddo
+    enddo
+   enddo
+  enddo
+ enddo
+ free ao_non_hermit_term_chemist 
+ allocate(mo_tmp_2(mo_num,mo_num,ao_num,ao_num))
+ mo_tmp_2 = 0.d0
+ do m = 1, ao_num
+  do p = 1, ao_num
+   do n = 1, ao_num
+    do i = 1, mo_num
+     do k = 1, mo_num
+      !       (k i|p m) = sum_n c_ni * (k n|p m)
+      mo_tmp_2(k,i,p,m) += mo_coef_transp(i,n) * mo_tmp_1(k,n,p,m)
+     enddo
+    enddo
+   enddo
+  enddo
+ enddo
+ deallocate(mo_tmp_1)
+ allocate(mo_tmp_1(mo_num,mo_num,mo_num,ao_num))
+ mo_tmp_1 = 0.d0
+ do m = 1, ao_num
+  do p = 1, ao_num
+   do l = 1, mo_num
+    do i = 1, mo_num
+     do k = 1, mo_num
+      mo_tmp_1(k,i,l,m) += mo_coef_transp(l,p) * mo_tmp_2(k,i,p,m)
+     enddo
+    enddo
+   enddo
+  enddo
+ enddo
+ deallocate(mo_tmp_2)
+ mo_non_hermit_term_chemist = 0.d0
+ do m = 1, ao_num
+  do j = 1, mo_num
+   do l = 1, mo_num
+    do i = 1, mo_num
+     do k = 1, mo_num
+      mo_non_hermit_term_chemist(k,i,l,j) += mo_coef_transp(j,m)  * mo_tmp_1(k,i,l,m)
+     enddo
+    enddo
+   enddo
+  enddo
+ enddo
+
+END_PROVIDER 
+
+BEGIN_PROVIDER [double precision, mo_non_hermit_term, (mo_num, mo_num, mo_num, mo_num)]
+ implicit none
+BEGIN_DOC
+!                    1 2 1 2      1 2                                1 2 
+!
+! mo_non_hermit_term(k,l,i,j) = < k l | [erf( mu r12) - 1] d/d_r12 | i j > on the MO basis
+END_DOC
+ integer :: i,j,k,l
+ do j = 1, mo_num
+  do i = 1, mo_num
+   do l = 1, mo_num
+    do k = 1, mo_num
+     mo_non_hermit_term(k,l,i,j) = mo_non_hermit_term_chemist(k,i,l,j)
+    enddo
+   enddo
+  enddo
+ enddo
+END_PROVIDER 

src/utils/integration.irp.f

@@ -412,6 +412,79 @@ subroutine recentered_poly2(P_new,x_A,x_P,a,P_new2,x_B,x_Q,b)
   enddo
 end
 
+subroutine pol_modif_center(A_center, B_center, iorder, A_pol, B_pol) 
+
+  BEGIN_DOC
+  ! 
+  ! Transform the pol centerd on A:
+  !       [ \sum_i ax_i (x-x_A)^i ] [ \sum_j ay_j (y-y_A)^j ] [ \sum_k az_k (z-z_A)^k ] 
+  ! to a pol centered on B
+  !       [ \sum_i bx_i (x-x_B)^i ] [ \sum_j by_j (y-y_B)^j ] [ \sum_k bz_k (z-z_B)^k ] 
+  !
+  END_DOC
+
+  ! useful for max_dim
+  include 'constants.include.F'
+
+  implicit none
+
+  integer,          intent(in)  :: iorder(3)
+  double precision, intent(in)  :: A_center(3), B_center(3)
+  double precision, intent(in)  :: A_pol(0:max_dim, 3)
+  double precision, intent(out) :: B_pol(0:max_dim, 3)
+
+  integer                       :: i, Lmax
+
+  do i = 1, 3
+    Lmax = iorder(i)
+    call pol_modif_center_x( A_center(i), B_center(i), Lmax, A_pol(0:Lmax, i), B_pol(0:Lmax, i) ) 
+  enddo
+
+  return
+end subroutine pol_modif_center
+
+
+
+subroutine pol_modif_center_x(A_center, B_center, iorder, A_pol, B_pol) 
+
+  BEGIN_DOC
+  ! 
+  ! Transform the pol centerd on A:
+  !       [ \sum_i ax_i (x-x_A)^i ] 
+  ! to a pol centered on B
+  !       [ \sum_i bx_i (x-x_B)^i ] 
+  !
+  ! bx_i = \sum_{j=i}^{iorder} ax_j (x_B - x_A)^(j-i) j! / [ i! (j-i)! ]
+  !      = \sum_{j=i}^{iorder} ax_j (x_B - x_A)^(j-i) binom_func(j,i)
+  !
+  END_DOC
+
+  implicit none
+
+  integer,          intent(in)  :: iorder
+  double precision, intent(in)  :: A_center, B_center
+  double precision, intent(in)  :: A_pol(0:iorder)
+  double precision, intent(out) :: B_pol(0:iorder)
+
+  integer                       :: i, j
+  double precision              :: fact_tmp, dx
+
+  double precision              :: binom_func
+
+  dx = B_center - A_center
+
+  do i = 0, iorder
+    fact_tmp = 0.d0
+    do j = i, iorder
+      fact_tmp += A_pol(j) * binom_func(j, i) * dx**dble(j-i)
+    enddo
+    B_pol(i) = fact_tmp
+  enddo
+
+  return
+end subroutine pol_modif_center_x
+
+