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