subroutine walker_death(iter_data, DetCurr, iLutCurr, Kii, RealwSign, &
DetPosition, walkExcitLevel, t_core_die_)
use global_det_data, only: get_iter_occ_tot, get_av_sgn_tot, &
set_iter_occ_tot, set_av_sgn_tot
use global_det_data, only: len_av_sgn_tot, len_iter_occ_tot
use rdm_data, only: one_rdms, two_rdm_spawn, rdm_definitions, &
inits_one_rdms, two_rdm_inits_spawn
use semi_stoch_procs, only: check_determ_flag
integer, intent(in) :: DetCurr(nel)
real(dp), dimension(lenof_sign), intent(in) :: RealwSign
integer(kind=n_int), intent(in) :: iLutCurr(0:niftot)
real(dp), intent(in) :: Kii
integer, intent(in) :: DetPosition
type(fcimc_iter_data), intent(inout) :: iter_data
logical, intent(in), optional :: t_core_die_
real(dp) :: iDie(lenof_sign), CopySign(lenof_sign)
real(dp) :: av_sign(len_av_sgn_tot), iter_occ(len_iter_occ_tot)
integer, intent(in) :: walkExcitLevel
integer :: i, irdm, run
logical :: tCoreDet(lenof_sign), t_core_die
character(len=*), parameter :: t_r = "walker_death"
! Do particles on determinant die? iDie can be both +ve (deaths), or
! -ve (births, if shift > 0)
do run = 1, inum_runs
tCoreDet(min_part_type(run):max_part_type(run)) = check_determ_flag(iLutCurr, run)
end do
iDie = attempt_die(DetCurr, Kii, realwSign, WalkExcitLevel, DetPosition)
def_default(t_core_die, t_core_die_, .true.)
if (.not. t_core_die) then
where (tCoredet) iDie = 0.0_dp
end if
IFDEBUG(FCIMCDebug, 3) then
if (sum(abs(iDie)) > 1.0e-10_dp) then
write(stdout, "(A)", advance='no') "Death: "
do i = 1, lenof_sign - 1
write(stdout, "(f10.5)", advance='no') iDie(i)
end do
write(stdout, "(f10.5)") iDie(i)
end if
end if
! Update death counter
iter_data%ndied = iter_data%ndied + min(iDie, abs(RealwSign))
#ifdef CMPLX_
do run = 1, inum_runs
NoDied(run) = NoDied(run) &
+ sum(min(iDie(min_part_type(run):max_part_type(run)), abs(RealwSign(min_part_type(run):max_part_type(run)))))
end do
#else
NoDied = NoDied + min(iDie, abs(RealwSign))
#endif
! Count any antiparticles
iter_data%nborn = iter_data%nborn + max(iDie - abs(RealwSign), 0.0_dp)
#ifdef CMPLX_
do run = 1, inum_runs
NoBorn(run) = NoBorn(run) &
+ sum(max(iDie(min_part_type(run):max_part_type(run)) &
- abs(RealwSign(min_part_type(run):max_part_type(run))), 0.0_dp))
end do
#else
NoBorn = NoBorn + max(iDie - abs(RealwSign), 0.0_dp)
#endif
! Calculate new number of signed particles on the det.
CopySign = RealwSign - (iDie * sign(1.0_dp, RealwSign))
! In the initiator approximation, abort any anti-particles.
if (tTruncInitiator .and. any(abs(CopySign) > 1.0e-12_dp)) then
do i = 1, lenof_sign
if (CopySign(i) > 0.0_dp .neqv. RealwSign(i) > 0.0_dp) then
NoAborted(i) = NoAborted(i) + abs(CopySign(i))
iter_data%naborted(i) = iter_data%naborted(i) &
+ abs(CopySign(i))
if (test_flag(ilutCurr, get_initiator_flag(i))) &
NoAddedInitiators = NoAddedInitiators - 1_int64
CopySign(i) = 0
end if
end do
end if
if (any(abs(CopySign) > 1.0e-12_dp) .or. any(tCoreDet)) then
! For the hashed walker main list, the particles don't move.
! Therefore just adjust the weight.
call encode_sign(CurrentDets(:, DetPosition), CopySign)
else
! All walkers died.
if (tFillingStochRDMonFly) then
av_sign = get_av_sgn_tot(DetPosition)
iter_occ = get_iter_occ_tot(DetPosition)
call det_removed_fill_diag_rdm(two_rdm_spawn, one_rdms, CurrentDets(:, DetPosition), av_sign, iter_occ)
if (tInitsRDM .and. all_runs_are_initiator(CurrentDets(:, DetPosition))) &
call det_removed_fill_diag_rdm(two_rdm_inits_spawn, inits_one_rdms, &
CurrentDets(:, DetPosition), av_sign, iter_occ, .false.)
! Set the average sign and occupation iteration to zero, so
! that the same contribution will not be added in in
! CalcHashTableStats, if this determinant is not overwritten
! before then
av_sign = 0.0_dp
iter_occ = 0.0_dp
call set_av_sgn_tot(DetPosition, av_sign)
call set_iter_occ_tot(DetPosition, iter_occ)
end if
if (tTruncInitiator) then
! All particles on this determinant have gone. If the determinant was an initiator, update the stats
do i = 1, lenof_sign
if (test_flag(iLutCurr, get_initiator_flag(i))) then
NoAddedInitiators(i) = NoAddedInitiators(i) - 1_int64
end if
end do
end if
! Remove the determinant from the indexing list
if (.not. tAccumEmptyDet(CurrentDets(:, DetPosition))) call RemoveHashDet(HashIndex, DetCurr, DetPosition)
! Encode a null det to be picked up
call encode_sign(CurrentDets(:, DetPosition), null_part)
end if
! Test - testsuite, RDM still work, both still work with Linscalealgo (all in debug)
! Null particle not kept if antiparticles aborted.
! When are the null particles removed?
end subroutine walker_death