LCPQ/qmcchem
10
1
Fork 1
mirror of https://gitlab.com/scemama/qmcchem.git synced 2025-01-02 17:45:39 +01:00
Code Releases Activity

Fixed bug without pseudos

Browse Source
This commit is contained in:
Anthony Scemama 2021-09-01 19:23:58 +02:00
parent 4cbb4f6a2d
commit 2381c904db
2 changed files with 27 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -131,13 +131,14 @@ BEGIN_PROVIDER [ double precision, ci_h_matrix, (size_ci_h_matrix) ]
h = 0.d0 h = 0.d0
do e=1,elec_beta_num do e=1,elec_beta_num
h += & h += &
det_beta_grad_lapl(1,e,n) * jast_grad_jast_inv_x(e) + & 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(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(e) det_beta_grad_lapl(3,e,n) * jast_grad_jast_inv_z(elec_alpha_num+e)
enddo enddo
T += 2.d0*( g * det_beta_value(n) + h * det_alpha_value(m) ) T += 2.d0*( g * det_beta_value(n) + h * det_alpha_value(m) )
g = det_alpha_value(m)*det_beta_value(n) g = det_alpha_value(m)*det_beta_value(n)
V = E_pot* g V = E_pot* g
if (do_pseudo) then
do e=1,elec_alpha_num do e=1,elec_alpha_num
V -= pseudo_non_local(e)* g V -= pseudo_non_local(e)* g
V += det_alpha_pseudo(e,m) * det_beta_value(n) V += det_alpha_pseudo(e,m) * det_beta_value(n)
@ -146,6 +147,7 @@ BEGIN_PROVIDER [ double precision, ci_h_matrix, (size_ci_h_matrix) ]
V -= pseudo_non_local(e)* g V -= pseudo_non_local(e)* g
V += det_alpha_value(m) * det_beta_pseudo(e,n) V += det_alpha_value(m) * det_beta_pseudo(e,n)
enddo enddo
endif
f = -0.5d0*T + V f = -0.5d0*T + V
f *= psidet_inv * psidet_inv f *= psidet_inv * psidet_inv
do k=1,det_num do k=1,det_num
@ -202,13 +204,14 @@ BEGIN_PROVIDER [ double precision, ci_h_matrix_diag, (size_ci_h_matrix_diag) ]
h = 0.d0 h = 0.d0
do e=1,elec_beta_num do e=1,elec_beta_num
h += & h += &
det_beta_grad_lapl(1,e,n) * jast_grad_jast_inv_x(e) + & 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(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(e) det_beta_grad_lapl(3,e,n) * jast_grad_jast_inv_z(elec_alpha_num+e)
enddo enddo
T += 2.d0*( g * det_beta_value(n) + h * det_alpha_value(m) ) T += 2.d0*( g * det_beta_value(n) + h * det_alpha_value(m) )
g = det_alpha_value(m)*det_beta_value(n) g = det_alpha_value(m)*det_beta_value(n)
V = E_pot* g V = E_pot* g
if (do_pseudo) then
do e=1,elec_alpha_num do e=1,elec_alpha_num
V -= pseudo_non_local(e)* g V -= pseudo_non_local(e)* g
V += det_alpha_pseudo(e,m) * det_beta_value(n) V += det_alpha_pseudo(e,m) * det_beta_value(n)
@ -217,6 +220,7 @@ BEGIN_PROVIDER [ double precision, ci_h_matrix_diag, (size_ci_h_matrix_diag) ]
V -= pseudo_non_local(e)* g V -= pseudo_non_local(e)* g
V += det_alpha_value(m) * det_beta_pseudo(e,n) V += det_alpha_value(m) * det_beta_pseudo(e,n)
enddo enddo
endif
f = -0.5d0*T + V f = -0.5d0*T + V
f *= psidet_inv * psidet_inv f *= psidet_inv * psidet_inv
ci_h_matrix_diag(l) = f * & ci_h_matrix_diag(l) = f * &

1
src/det.irp.f
View File

@ -1683,6 +1683,7 @@ END_PROVIDER
if (ifirst == 0) then if (ifirst == 0) then
ifirst = 1 ifirst = 1
psidet_grad_lapl = 0.d0 psidet_grad_lapl = 0.d0
pseudo_non_local = 0.d0
endif endif
integer :: i,j,k, l integer :: i,j,k, l