subroutine stochRoundSpawn(iter_data, SignTemp, i, j, scFVal, ScaledOccupiedThresh, &
tTruncate)
type(fcimc_iter_data), intent(inout) :: iter_data
real(dp), intent(inout) :: SignTemp(lenof_sign)
integer, intent(in) :: i, j
real(dp), intent(in) :: scFVal, ScaledOccupiedThresh
logical, intent(in) :: tTruncate
real(dp) :: pRemove, r
integer :: run
run = part_type_to_run(j)
if ((abs(SignTemp(j)) > 1.e-12_dp) .and. (abs(SignTemp(j)) < ScaledOccupiedThresh)) then
! We remove this walker with probability OccupiedThresh - Sign/ScaleFactor
pRemove = 1.0_dp - abs(SignTemp(j)) / (ScaledOccupiedThresh)
r = genrand_real2_dSFMT()
if (pRemove > r) then
! Remove this walker.
NoRemoved(run) = NoRemoved(run) + abs(SignTemp(j))
!Annihilated = Annihilated + abs(SignTemp(j))
!iter_data%nannihil = iter_data%nannihil + abs(SignTemp(j))
iter_data%nremoved(j) = iter_data%nremoved(j) &
+ abs(SignTemp(j))
SignTemp(j) = 0.0_dp
call nullify_ilut_part(SpawnedParts(:, i), j)
else
!Round up
NoBorn(run) = NoBorn(run) + OccupiedThresh * scFVal - abs(SignTemp(j))
iter_data%nborn(j) = iter_data%nborn(j) &
+ scaledOccupiedThresh - abs(SignTemp(j))
SignTemp(j) = sign(scaledOccupiedThresh, SignTemp(j))
call encode_part_sign(SpawnedParts(:, i), SignTemp(j), j)
end if
else if (abs(SignTemp(j)) > eps) then
! truncate down to a minimum number of spawns to
! prevent blooms if requested
! in guga ignore multi-spawn events and still truncate!
! we already truncate in the spawing step witout energy scaling!
if (tGUGA .and. t_truncate_spawns .and. tEScaleWalkers) then
if (abs(SignTemp(j)) > n_truncate_spawns * scFVal) then
#ifdef DEBUG_
print *, " ------------"
print *, " spawn unto an UN-OCCUPIED CSF above Threshold!"
print *, " Parent was initiator?: ", &
any_run_is_initiator(SpawnedParts(:, i))
print *, " Parent was in deterministic space?: ", &
test_flag_multi(SpawnedParts(:, i), flag_deterministic)
print *, " ------------"
#endif
end if
call truncateSpawn(iter_data, SignTemp, i, j, scFVal, 1.0_dp)
call encode_part_sign(SpawnedParts(:, i), SignTemp(j), j)
return
else if (tTruncate) then
call truncateSpawn(iter_data, SignTemp, i, j, scFVal, 1.0_dp)
call encode_part_sign(SpawnedParts(:, i), SignTemp(j), j)
end if
end if
end subroutine stochRoundSpawn