subroutine add_en2_pert_for_init_calc(ispawn, abort, nJ, SpawnedSign)
! Add a contribution to the second-order Epstein-Nesbet correction to
! initiator error.
! 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, and abort is array
! specifying whether each of the spawnings are about to be aborted
! due to the initiator criterion.
integer, intent(in) :: ispawn
logical, intent(in) :: abort(lenof_sign)
integer, intent(in) :: nJ(nel)
real(dp), intent(in):: SpawnedSign(lenof_sign)
integer :: istate
real(dp) :: contrib_sign(en_pert_main%sign_length)
logical :: pert_contrib(en_pert_main%sign_length)
! RDM-energy-based estimate:
! 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
! Was a non-zero contribution aborted on *both* replicas for
! a given state?
if (abort(2 * istate - 1) .and. abort(2 * istate) .and. &
abs(SpawnedSign(2 * istate - 1)) > 1.e-12_dp .and. &
abs(SpawnedSign(2 * istate)) > 1.e-12_dp) &
pert_contrib(istate) = .true.
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
end subroutine add_en2_pert_for_init_calc