adjust_decay_channels Subroutine

public subroutine adjust_decay_channels()

Arguments

None

Contents

Source Code


Source Code

    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