QuantumPackage/plugins/local/non_h_ints_mu/jastrow_psi.irp.f

BEGIN_PROVIDER [ double precision, c_ij_ab_jastrow, (mo_num, mo_num, elec_alpha_num, elec_beta_num)]
 implicit none
 integer :: iunit, getUnitAndOpen
 c_ij_ab_jastrow = 0.d0
 iunit = getUnitAndOpen(trim(ezfio_work_dir)//'c_ij_ab', 'R')                                                     
 read(iunit) c_ij_ab_jastrow
 close(iunit)
 print*,'c_ij_ab_jastrow = '
 integer :: i,j,a,b
 do i = 1, elec_beta_num ! r2
  do j = 1, elec_alpha_num ! r1
   do a = elec_beta_num+1, mo_num ! r2
    do b = elec_alpha_num+1, mo_num ! r1 
!     print*,b,a,j,i
     print*,c_ij_ab_jastrow(b,a,j,i),b,a,j,i
     if(dabs(c_ij_ab_jastrow(b,a,j,i)).lt.1.d-12)then
      c_ij_ab_jastrow(b,a,j,i) = 0.d0
     endif
    enddo
   enddo
  enddo
 enddo
END_PROVIDER 

double precision function jastrow_psi(r1,r2)
 implicit none
 double precision, intent(in) :: r1(3), r2(3)
 integer :: i,j,a,b
 double precision, allocatable :: mos_array_r1(:), mos_array_r2(:)
 allocate(mos_array_r1(mo_num), mos_array_r2(mo_num))
 call give_all_mos_at_r(r1,mos_array_r1)
 call give_all_mos_at_r(r2,mos_array_r2)
 double precision :: eps,coef, numerator,denominator
 double precision :: phi_i_phi_j
 eps = a_boys
 jastrow_psi= 0.d0
 do i = 1, elec_beta_num ! r1
  do j = 1, elec_alpha_num ! r2
   phi_i_phi_j = mos_array_r1(i) * mos_array_r2(j) + eps
   denominator = 1.d0/phi_i_phi_j
   do a = elec_beta_num+1, mo_num ! r1
    do b = elec_alpha_num+1, mo_num ! r2 
     coef = c_ij_ab_jastrow(b,a,j,i)
     numerator = mos_array_r2(b) * mos_array_r1(a)
     jastrow_psi += coef * numerator*denominator
    enddo
   enddo
  enddo
 enddo
end

subroutine get_grad_r1_jastrow_psi(r1,r2,grad_j_psi_r1,jast)
 implicit none
 double precision, intent(in) :: r1(3), r2(3)
 double precision, intent(out):: grad_j_psi_r1(3),jast
 integer :: i,j,a,b
 double precision, allocatable :: mos_array_r1(:), mos_array_r2(:)
 double precision, allocatable :: mos_grad_array_r1(:,:),mos_grad_array_r2(:,:)
 double precision :: num_j, denom_j, num_j_grad(3), denom_j_grad(3),delta,coef
 double precision :: inv_denom_j
 allocate(mos_array_r1(mo_num), mos_array_r2(mo_num))
 allocate(mos_grad_array_r1(3,mo_num), mos_grad_array_r2(3,mo_num))
 delta = a_boys
 call give_all_mos_and_grad_at_r(r1,mos_array_r1,mos_grad_array_r1)
 call give_all_mos_and_grad_at_r(r2,mos_array_r2,mos_grad_array_r2)
 grad_j_psi_r1 = 0.d0
 jast = 0.d0
 do i = 1, elec_beta_num ! r1
  do j = 1, elec_alpha_num ! r2
   call denom_jpsi(i,j,delta,mos_array_r1,mos_grad_array_r1,mos_array_r2,denom_j, denom_j_grad)
   inv_denom_j = 1.d0/denom_j
   do a = elec_beta_num+1, mo_num ! r1
    do b = elec_alpha_num+1, mo_num ! r2 
     call numerator_psi(a,b,mos_array_r1,mos_grad_array_r1,mos_array_r2,num_j, num_j_grad)
     coef = c_ij_ab_jastrow(b,a,j,i)
     jast += coef * num_j * inv_denom_j
     grad_j_psi_r1 += coef * (num_j_grad * denom_j - num_j * denom_j_grad) * inv_denom_j * inv_denom_j
    enddo
   enddo
  enddo
 enddo
 if(jast.lt.-1.d0.or.dabs(jast).gt.1.d0)then
  print*,'pb ! '
  print*,jast
  print*,dsqrt(r1(1)**2+r1(2)**2+r1(3)**2),dsqrt(r2(1)**2+r2(2)**2+r2(3)**2)
  print*,r1
!  print*,mos_array_r1(1:2)
  print*,r2
!  print*,mos_array_r2(1:2)
  stop
 endif
 if(log_jpsi)then
  grad_j_psi_r1 = grad_j_psi_r1/(1.d0 + jast)
 endif

end


subroutine denom_jpsi(i,j,delta,mos_array_r1,mos_grad_array_r1,mos_array_r2,denom, grad_denom)
 implicit none
 integer, intent(in)           :: i,j
 double precision, intent(in)  :: mos_array_r1(mo_num),mos_grad_array_r1(3,mo_num),mos_array_r2(mo_num),delta
 double precision, intent(out) :: denom, grad_denom(3)
 double precision :: coef,phi_i_phi_j,inv_phi_i_phi_j,inv_phi_i_phi_j_2
 phi_i_phi_j = mos_array_r1(i) * mos_array_r2(j)
 if(phi_i_phi_j /= 0.d0)then
  inv_phi_i_phi_j   = 1.d0/phi_i_phi_j
  inv_phi_i_phi_j_2 = 1.d0/(phi_i_phi_j * phi_i_phi_j)
 else
  inv_phi_i_phi_j   = huge(1.0)
  inv_phi_i_phi_j_2 = huge(1.d0)
 endif
 denom         = phi_i_phi_j + delta * inv_phi_i_phi_j
 grad_denom(:) = (1.d0 - delta*inv_phi_i_phi_j_2) * mos_array_r2(j) * mos_grad_array_r1(:,i)
end

subroutine numerator_psi(a,b,mos_array_r1,mos_grad_array_r1,mos_array_r2,num, grad_num)
 implicit none
 integer, intent(in)           :: a,b
 double precision, intent(in)  :: mos_array_r1(mo_num),mos_grad_array_r1(3,mo_num),mos_array_r2(mo_num)
 double precision, intent(out) :: num, grad_num(3)
 num = mos_array_r1(a) * mos_array_r2(b)
 grad_num(:) = mos_array_r2(b) * mos_grad_array_r1(:,a)
end