PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-09-13 06:18:30 +02:00
Code Releases Activity

new jpsiking is working on He

Browse Source
This commit is contained in:
eginer 2024-09-08 19:14:15 +02:00
parent 974a4977ac
commit 869efdd077
2 changed files with 29 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
plugins/local/non_h_ints_mu/deb_j_psi.irp.f
View File

@ -1,7 +1,7 @@
program test_j_mu_of_r program test_j_mu_of_r
implicit none implicit none
! call routine_deb_j_psi call routine_deb_j_psi
call routine_deb_denom ! call routine_deb_denom
end end
subroutine routine_deb_j_psi subroutine routine_deb_j_psi
@ -9,7 +9,7 @@ subroutine routine_deb_j_psi
integer :: ipoint,k integer :: ipoint,k
double precision :: r2(3), weight, dr, r1(3), r1bis(3) double precision :: r2(3), weight, dr, r1(3), r1bis(3)
double precision :: accu_grad(3) double precision :: accu_grad(3)
double precision :: jast,grad_jast(3),j_bump,jastrow_psi double precision :: jast,grad_jast(3),j_bump,jastrow_psi,grad_jast_bis(3)
double precision :: jast_p,jast_m,num_grad_jast(3) double precision :: jast_p,jast_m,num_grad_jast(3)
dr = 0.00001d0 dr = 0.00001d0
@ -28,11 +28,11 @@ subroutine routine_deb_j_psi
do k = 1, 3 do k = 1, 3
r1bis= r1 r1bis= r1
r1bis(k) += dr r1bis(k) += dr
jast_p = jastrow_psi(r1bis, r2) call get_grad_r1_jastrow_psi(r1bis,r2,grad_jast_bis,jast_p)
r1bis= r1 r1bis= r1
r1bis(k) -= dr r1bis(k) -= dr
jast_m = jastrow_psi(r1bis, r2) call get_grad_r1_jastrow_psi(r1bis,r2,grad_jast_bis,jast_m)
num_grad_jast(k) = (jast_p - jast_m)/(2.d0* dr) num_grad_jast(k) = (jast_p - jast_m)/(2.d0* dr)
norm += num_grad_jast(k)*num_grad_jast(k) norm += num_grad_jast(k)*num_grad_jast(k)
@ -86,19 +86,19 @@ subroutine routine_deb_denom
r1(1:3) = final_grid_points(1:3,ipoint) r1(1:3) = final_grid_points(1:3,ipoint)
weight = final_weight_at_r_vector(ipoint) weight = final_weight_at_r_vector(ipoint)
call give_all_mos_and_grad_at_r(r1,mos_array_r1,mos_grad_array_r1) call give_all_mos_and_grad_at_r(r1,mos_array_r1,mos_grad_array_r1)
call denom_jpsi(i,j,mos_array_r1,mos_grad_array_r1,mos_array_r2,jast, grad_jast) call denom_jpsi(i,j,a_boys, mos_array_r1,mos_grad_array_r1,mos_array_r2,jast, grad_jast)
double precision :: norm,error double precision :: norm,error
norm = 0.D0 norm = 0.D0
do k = 1, 3 do k = 1, 3
r1bis= r1 r1bis= r1
r1bis(k) += dr r1bis(k) += dr
call give_all_mos_and_grad_at_r(r1bis,mos_array_r1,mos_grad_array_r1) call give_all_mos_and_grad_at_r(r1bis,mos_array_r1,mos_grad_array_r1)
call denom_jpsi(i,j,mos_array_r1,mos_grad_array_r1,mos_array_r2,jast_p, grad_jast_bis) call denom_jpsi(i,j,a_boys, mos_array_r1,mos_grad_array_r1,mos_array_r2,jast_p, grad_jast_bis)
r1bis= r1 r1bis= r1
r1bis(k) -= dr r1bis(k) -= dr
call give_all_mos_and_grad_at_r(r1bis,mos_array_r1,mos_grad_array_r1) call give_all_mos_and_grad_at_r(r1bis,mos_array_r1,mos_grad_array_r1)
call denom_jpsi(i,j,mos_array_r1,mos_grad_array_r1,mos_array_r2,jast_m, grad_jast_bis) call denom_jpsi(i,j,a_boys, mos_array_r1,mos_grad_array_r1,mos_array_r2,jast_m, grad_jast_bis)
num_grad_jast(k) = (jast_p - jast_m)/(2.d0* dr) num_grad_jast(k) = (jast_p - jast_m)/(2.d0* dr)
norm += num_grad_jast(k)*num_grad_jast(k) norm += num_grad_jast(k)*num_grad_jast(k)

40
plugins/local/non_h_ints_mu/jastrow_psi.irp.f
View File

@ -56,29 +56,25 @@ subroutine get_grad_r1_jastrow_psi(r1,r2,grad_j_psi_r1,jast)
integer :: i,j,a,b integer :: i,j,a,b
double precision, allocatable :: mos_array_r1(:), mos_array_r2(:) double precision, allocatable :: mos_array_r1(:), mos_array_r2(:)
double precision, allocatable :: mos_grad_array_r1(:,:),mos_grad_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_array_r1(mo_num), mos_array_r2(mo_num))
allocate(mos_grad_array_r1(3,mo_num), mos_grad_array_r2(3,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(r1,mos_array_r1,mos_grad_array_r1)
call give_all_mos_and_grad_at_r(r2,mos_array_r2,mos_grad_array_r2) 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 grad_j_psi_r1 = 0.d0
jast = 0.d0 jast = 0.d0
do i = 1, elec_beta_num ! r1 do i = 1, elec_beta_num ! r1
do j = 1, elec_alpha_num ! r2 do j = 1, elec_alpha_num ! r2
phi_i_phi_j = mos_array_r1(i) * mos_array_r2(j) + eps call denom_jpsi(i,j,delta,mos_array_r1,mos_grad_array_r1,mos_array_r2,denom_j, denom_j_grad)
denominator = 1.d0/phi_i_phi_j inv_denom_j = 1.d0/denom_j
denominator *= denominator
do a = elec_beta_num+1, mo_num ! r1 do a = elec_beta_num+1, mo_num ! r1
do b = elec_alpha_num+1, mo_num ! r2 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) coef = c_ij_ab_jastrow(b,a,j,i)
jast += phi_i_phi_j * mos_array_r2(b) * mos_array_r1(a) * coef jast += coef * num_j * inv_denom_j
! print*,b,a,j,i,c_ij_ab_jastrow(b,a,j,i) grad_j_psi_r1 += coef * (num_j_grad * denom_j - num_j * denom_j_grad) * inv_denom_j * inv_denom_j
! 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
enddo enddo
@ -100,14 +96,12 @@ subroutine get_grad_r1_jastrow_psi(r1,r2,grad_j_psi_r1,jast)
end end
subroutine denom_jpsi(i,j,mos_array_r1,mos_grad_array_r1,mos_array_r2,denom, grad_denom) subroutine denom_jpsi(i,j,delta,mos_array_r1,mos_grad_array_r1,mos_array_r2,denom, grad_denom)
implicit none implicit none
integer, intent(in) :: i,j 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(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, intent(out) :: denom, grad_denom(3)
double precision :: coef,phi_i_phi_j,inv_phi_i_phi_j,inv_phi_i_phi_j_2 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) phi_i_phi_j = mos_array_r1(i) * mos_array_r2(j)
if(phi_i_phi_j /= 0.d0)then if(phi_i_phi_j /= 0.d0)then
inv_phi_i_phi_j = 1.d0/phi_i_phi_j inv_phi_i_phi_j = 1.d0/phi_i_phi_j
@ -116,7 +110,15 @@ subroutine denom_jpsi(i,j,mos_array_r1,mos_grad_array_r1,mos_array_r2,denom, gra
inv_phi_i_phi_j = huge(1.0) inv_phi_i_phi_j = huge(1.0)
inv_phi_i_phi_j_2 = huge(1.d0) inv_phi_i_phi_j_2 = huge(1.d0)
endif endif
denom += phi_i_phi_j + a_boys * inv_phi_i_phi_j denom = phi_i_phi_j + delta * 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) 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 end