subroutine adjust_decay_channels()
use FciMCData, only: AllTotParts
use CalcData, only: InitWalkers
use Parallel_neci, only: nProcessors
use real_time_data, only: alphaDamping, etaDamping, tStartVariation, rotThresh, &
numSnapShotOrbs, tLowerThreshold
implicit none
real(dp) :: allWalkersOld(lenof_sign), walkersOld(lenof_sign)
real(dp) :: deltaAlpha, deltaEta
! once the walker number exceeds the total walkers set in the input, start
! adjusting the damping and the real/imag timestep ratio
if (.not. tStartVariation) then
if (sum(AllTotParts) / inum_runs > rotThresh) tStartVariation = .true.
if (tLowerThreshold) then
if (tStartVariation) then
tStartVariation = .false.
else
tStartVariation = .true.
end if
end if
end if
! once started, we have to do so forever, else we might kill all walkers
if (tStartVariation) then
call MPIReduce(TotPartsLastAlpha, MPI_Sum, allWalkersOld)
! as AllTotParts is only reduced for shift computation, we need to
! do it here manually (TotParts is recomputed every iteration as
! a part of the RK-Scheme)
call MPIReduce(TotParts, MPI_Sum, AllTotParts)
if (iProcIndex == root) then
! compare the walker number the last time the angle was adjusted to
! the walker number now
if (tDynamicAlpha) then
deltaAlpha = alphaDamping * atan(sum(AllTotParts) / real(sum(allWalkersOld), dp) - 1)
real_time_info%time_angle = real_time_info%time_angle + deltaAlpha
end if
! if the damping is also to be adjusted on the fly, do so here
if (tDynamicDamping) then
deltaEta = etaDamping * log(sum(AllTotParts) / real(sum(allWalkersOld), dp)) / &
(tau_real * stepsAlpha)
real_time_info%damping = real_time_info%damping - deltaEta
end if
end if
! communicate the updated quantities
if (tDynamicAlpha) then
call MPIBCast(real_time_info%time_angle)
! Store the value of alpha in a log, overwriting an old value
alphaLog(alphaLogPos) = real_time_info%time_angle
alphaLogPos = alphaLogPos + 1
! set back the position if exceeding the end
if (alphaLogPos > alphaLogSize) alphaLogPos = 1
!possibly change the stepsize
call adjust_stepsAlpha()
end if
if (tDynamicDamping) call MPIBCast(real_time_info%damping)
end if
TotPartsLastAlpha = TotParts
end subroutine adjust_decay_channels