mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-11-20 04:12:21 +01:00
123 lines
4.1 KiB
Fortran
123 lines
4.1 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(:,:)
|
||
|
|
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))
|
||
|
|
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)
|
||
|
|
double precision :: eps,coef, numerator(3),denominator
|
||
|
|
double precision :: phi_i_phi_j
|
||
|
|
eps = a_boys
|
||
|
|
grad_j_psi_r1 = 0.d0
|
||
|
|
jast = 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
|
||
|
|
denominator *= denominator
|
||
|
|
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)
|
||
|
|
jast += phi_i_phi_j * mos_array_r2(b) * mos_array_r1(a) * coef
|
||
|
|
! print*,b,a,j,i,c_ij_ab_jastrow(b,a,j,i)
|
||
|
|
! print*,'jast = ',jast
|
||
|
|
numerator(:) = mos_array_r2(b) * mos_grad_array_r1(:,a) &
|
||
|
|
* phi_i_phi_j - mos_array_r1(a) * mos_array_r2(b) * mos_array_r2(j) * mos_grad_array_r1(:,i)
|
||
|
|
grad_j_psi_r1 += coef * numerator*denominator
|
||
|
|
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,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)
|
||
|
|
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
|
||
|
|
denom = 0.d0
|
||
|
|
grad_denom = 0.d0
|
||
|
|
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 + a_boys * inv_phi_i_phi_j
|
||
|
|
grad_denom(:) += (1.d0 - a_boys*inv_phi_i_phi_j_2) * mos_array_r2(j) * mos_grad_array_r1(:,i)
|
||
|
|
|
||
|
|
end
|