LCPQ
/
qmcchem
mirror of https://gitlab.com/scemama/qmcchem.git
10
1
Fork 1
Code Releases Activity

Fixed dmc_dress

This commit is contained in:
Anthony Scemama 2021-09-07 18:48:30 +02:00
parent 2381c904db
commit 8471cb050a
3 changed files with 111 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

146
src/PROPERTIES/properties_ci.irp.f
View File

@ -46,14 +46,8 @@ BEGIN_PROVIDER [ double precision, ci_h_psidet, (size_ci_h_psidet) ]
do k=1,det_num
i = det_coef_matrix_rows(k)
j = det_coef_matrix_columns(k)
T = 0.d0
do l=1,elec_alpha_num
T += det_alpha_grad_lapl(4,l,i)*det_beta_value (j)
enddo
do l=1,elec_beta_num
T += det_beta_grad_lapl (4,l,j)*det_alpha_value(i)
enddo
ci_h_psidet(k) = -0.5d0*T + E_pot * det_alpha_value(i)*det_beta_value (j)
T = det_alpha_lapl_sum(i)*det_beta_value(j) + det_beta_lapl_sum(j)*det_alpha_value(i)
ci_h_psidet(k) = -0.5d0*T + (E_pot + E_nucl) * det_alpha_value(i)*det_beta_value (j)
ci_h_psidet(k) *= psi_value_inv * jast_value_inv
enddo
@ -100,44 +94,43 @@ BEGIN_PROVIDER [ double precision, ci_h_matrix, (size_ci_h_matrix) ]
END_DOC
integer :: i, j, k, l, m, n, e
double precision :: f, g, h, T, V
double precision :: f, g, h, T, V, j_lapl_inv
! (Lapl J)/J
j_lapl_inv = 0.d0
do e=1,elec_num
j_lapl_inv += jast_lapl_jast_inv(e)
enddo
do l=1,det_num
m = det_coef_matrix_rows(l)
n = det_coef_matrix_columns(l)
! Lapl D
g = 0.d0
do e=1,elec_alpha_num
g += det_alpha_grad_lapl(4,e,m) * det_beta_value (n)
enddo
do e=1,elec_beta_num
g += det_alpha_value(m) * det_beta_grad_lapl(4,e,n)
enddo
T = g
! D (Lapl J)/J
g = 0.d0
do e=1,elec_num
g += jast_lapl_jast_inv(e)
enddo
T += det_alpha_value(m) * det_beta_value(n) * g
! 2 (grad D).(Grad J)/J
g = 0.d0
do e=1,elec_alpha_num
g += &
det_alpha_grad_lapl(1,e,m) * jast_grad_jast_inv_x(e) + &
det_alpha_grad_lapl(2,e,m) * jast_grad_jast_inv_y(e) + &
det_alpha_grad_lapl(3,e,m) * jast_grad_jast_inv_z(e)
enddo
h = 0.d0
do e=1,elec_beta_num
h += &
det_beta_grad_lapl(1,e,n) * jast_grad_jast_inv_x(elec_alpha_num+e) + &
det_beta_grad_lapl(2,e,n) * jast_grad_jast_inv_y(elec_alpha_num+e) + &
det_beta_grad_lapl(3,e,n) * jast_grad_jast_inv_z(elec_alpha_num+e)
enddo
T += 2.d0*( g * det_beta_value(n) + h * det_alpha_value(m) )
T = det_alpha_lapl_sum(m) * det_beta_value (n) &
+ det_alpha_value(m) * det_beta_lapl_sum(n)
if (j_lapl_inv /= 0.d0) then
! D (Lapl J)/J
T += det_alpha_value(m) * det_beta_value(n) * j_lapl_inv
! 2 (grad D).(Grad J)/J
g = 0.d0
do e=1,elec_alpha_num
g += &
det_alpha_grad_lapl(1,e,m) * jast_grad_jast_inv_x(e) + &
det_alpha_grad_lapl(2,e,m) * jast_grad_jast_inv_y(e) + &
det_alpha_grad_lapl(3,e,m) * jast_grad_jast_inv_z(e)
enddo
h = 0.d0
do e=1,elec_beta_num
h += &
det_beta_grad_lapl(1,e,n) * jast_grad_jast_inv_x(elec_alpha_num+e) + &
det_beta_grad_lapl(2,e,n) * jast_grad_jast_inv_y(elec_alpha_num+e) + &
det_beta_grad_lapl(3,e,n) * jast_grad_jast_inv_z(elec_alpha_num+e)
enddo
T += 2.d0*( g * det_beta_value(n) + h * det_alpha_value(m) )
endif
g = det_alpha_value(m)*det_beta_value(n)
V = E_pot* g
V = (E_pot + E_nucl)* g
if (do_pseudo) then
do e=1,elec_alpha_num
V -= pseudo_non_local(e)* g
@ -157,7 +150,6 @@ BEGIN_PROVIDER [ double precision, ci_h_matrix, (size_ci_h_matrix) ]
det_alpha_value(i)*det_beta_value (j)
enddo
enddo
ci_h_matrix_min = min(ci_h_matrix_min,minval(ci_h_matrix))
ci_h_matrix_max = max(ci_h_matrix_max,maxval(ci_h_matrix))
SOFT_TOUCH ci_h_matrix_min ci_h_matrix_max
@ -265,21 +257,77 @@ BEGIN_PROVIDER [ double precision, ci_dress, (size_ci_dress) ]
END_DOC
integer :: i, j, k, l
double precision :: T, h_psidet, dij, f
double precision :: T, h_psidet, dij, f, E_noJ, dE
h_psidet = -0.5d0*psidet_lapl*psidet_inv + E_pot + E_nucl
E_noJ = h_psidet
dE = E_loc - E_noJ
do k=1,det_num
i = det_coef_matrix_rows(k)
j = det_coef_matrix_columns(k)
dij = det_alpha_value(i)*det_beta_value(j)
T = det_beta_lapl_sum(j)*det_alpha_value(i) + &
det_alpha_lapl_sum(j)*det_beta_value(i)
h_psidet = -0.5d0*T + E_pot * dij
f = psi_value_inv * jast_value_inv
ci_dress(k) = f*(E_loc * dij - h_psidet)
f = det_alpha_value(i)*det_beta_value(j) * psi_value_inv * jast_value_inv
ci_dress(k) = dE * f
enddo
return
integer :: m, n, e
double precision :: g, h, V, j_lapl_inv, det_ab
! (Lapl J)/J
j_lapl_inv = 0.d0
do e=1,elec_num
j_lapl_inv += jast_lapl_jast_inv(e)
enddo
do l=1,det_num
m = det_coef_matrix_rows(l)
n = det_coef_matrix_columns(l)
! Lapl D
! T = det_alpha_lapl_sum(m) * det_beta_value (n) &
! + det_alpha_value(m) * det_beta_lapl_sum(n)
! det_ab = det_alpha_value(m)*det_beta_value(n)
! ci_dress(l) = -0.5d0*T + (E_pot + E_nucl) * det_ab
T = 0.d0
ci_dress(l) = 0.d0
! D (Lapl J)/J
T += det_alpha_value(m) * det_beta_value(n) * j_lapl_inv
! 2 (grad D).(Grad J)/J
g = 0.d0
do e=1,elec_alpha_num
g += &
det_alpha_grad_lapl(1,e,m) * jast_grad_jast_inv_x(e) + &
det_alpha_grad_lapl(2,e,m) * jast_grad_jast_inv_y(e) + &
det_alpha_grad_lapl(3,e,m) * jast_grad_jast_inv_z(e)
enddo
h = 0.d0
do e=1,elec_beta_num
h += &
det_beta_grad_lapl(1,e,n) * jast_grad_jast_inv_x(elec_alpha_num+e) + &
det_beta_grad_lapl(2,e,n) * jast_grad_jast_inv_y(elec_alpha_num+e) + &
det_beta_grad_lapl(3,e,n) * jast_grad_jast_inv_z(elec_alpha_num+e)
enddo
T += 2.d0*( g * det_beta_value(n) + h * det_alpha_value(m) )
V = 0.d0 ! (E_pot + E_nucl)* det_ab
if (do_pseudo) then
do e=1,elec_alpha_num
V -= pseudo_non_local(e)* det_ab
V += det_alpha_pseudo(e,m) * det_beta_value(n)
enddo
do e=1,elec_beta_num
V -= pseudo_non_local(e)* det_ab
V += det_alpha_value(m) * det_beta_pseudo(e,n)
enddo
endif
f = -0.5d0*T + V !- ci_dress(l)
ci_dress(l) = f * psi_value_inv * jast_value_inv * jast_value_inv
enddo
ci_dress_min = min(ci_dress_min,minval(ci_dress))
ci_dress_max = max(ci_dress_max,maxval(ci_dress))
SOFT_TOUCH ci_dress_min ci_dress_max
END_PROVIDER

14
src/det.irp.f
View File

@ -2155,3 +2155,17 @@ END_PROVIDER
enddo
END_PROVIDER
BEGIN_PROVIDER [ double precision, psidet_lapl ]
implicit none
BEGIN_DOC
! Laplacian of the wave functionwithout Jastrow
END_DOC
integer :: i, j
psidet_lapl = 0.d0
do j=1,elec_num
psidet_lapl = psidet_lapl + psidet_grad_lapl(4,j)
enddo
END_PROVIDER

1
src/psi.irp.f
View File

@ -26,7 +26,6 @@ BEGIN_PROVIDER [ double precision, psi_value_inv2 ]
psi_value_inv2 = psi_value_inv*psi_value_inv
END_PROVIDER
BEGIN_PROVIDER [ double precision, psi_lapl, (elec_num_8) ]
implicit none
BEGIN_DOC