LCPQ/qmcchem
10
1
Fork 1
mirror of https://gitlab.com/scemama/qmcchem.git synced 2024-11-19 04:22:21 +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

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

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

1
src/det.irp.f
View File

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