subroutine add_en2_pert_for_trunc_calc(ispawn, nJ, SpawnedSign, iter_data)
! Add a contribution to the second-order Epstein-Nesbet correction to
! error due to truncation of the Hilbert space being sampled.
! This adds a correction for the determinant at position ispawn in
! the spawning array, and nJ is an array holding the occupied
! electrons on this determinant. SpawnedSign is the array of
! amplitudes spawned onto this determinant.
integer, intent(in) :: ispawn
integer, intent(in) :: nJ(nel)
real(dp), intent(inout):: SpawnedSign(lenof_sign)
type(fcimc_iter_data), intent(inout) :: iter_data
integer :: j, istate
real(dp) :: contrib_sign(en_pert_main%sign_length)
logical :: pert_contrib(en_pert_main%sign_length)
! Only add a contribution if we've started accumulating this estimate.
if (tEN2Started) then
pert_contrib = .false.
do istate = 1, en_pert_main%sign_length
if (abs(SpawnedSign(2 * istate - 1)) > 1.e-12_dp .and. &
abs(SpawnedSign(2 * istate)) > 1.e-12_dp) then
pert_contrib(istate) = .true.
end if
end do
if (any(pert_contrib)) then
contrib_sign = 0.0_dp
do istate = 1, en_pert_main%sign_length
if (pert_contrib(istate)) then
contrib_sign(istate) = SpawnedSign(2 * istate - 1) * SpawnedSign(2 * istate) / (tau**2)
end if
end do
call add_to_en_pert_t(en_pert_main, nJ, SpawnedParts(:, ispawn), contrib_sign)
end if
end if
! Remove the spawning
do j = 1, lenof_sign
! track the removal for correct logging
iter_data%nremoved(j) = iter_data%nremoved(j) + abs(SpawnedSign(j))
SpawnedSign(j) = 0.0_dp
call encode_part_sign(SpawnedParts(:, ispawn), SpawnedSign(j), j)
end do
end subroutine add_en2_pert_for_trunc_calc