mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-25 13:03:28 +01:00
125 lines
4.3 KiB
Fortran
125 lines
4.3 KiB
Fortran
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
|