From 2381c904db758d2836ecf71f2cbf2b1ec84392b3 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 1 Sep 2021 19:23:58 +0200 Subject: [PATCH] Fixed bug without pseudos --- src/PROPERTIES/properties_ci.irp.f | 48 ++++++++++++++++-------------- src/det.irp.f | 1 + 2 files changed, 27 insertions(+), 22 deletions(-) diff --git a/src/PROPERTIES/properties_ci.irp.f b/src/PROPERTIES/properties_ci.irp.f index 01aa5c9..c3d096e 100644 --- a/src/PROPERTIES/properties_ci.irp.f +++ b/src/PROPERTIES/properties_ci.irp.f @@ -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 * & diff --git a/src/det.irp.f b/src/det.irp.f index 48bd252..9934b0f 100644 --- a/src/det.irp.f +++ b/src/det.irp.f @@ -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