Fill_Hist_ExplicitRDM_this_Iter Subroutine

public subroutine Fill_Hist_ExplicitRDM_this_Iter()

Arguments

None

Contents


Source Code

    subroutine Fill_Hist_ExplicitRDM_this_Iter()

        use bit_reps, only: encode_sign
        use DetCalcData, only: Det, FCIDets
        use hist_data, only: AllHistogram, Histogram
        use global_utilities, only: set_timer, halt_timer
        use Parallel_neci, only: iProcIndex, MPISumAll
        use rdm_data, only: nElRDM_Time, ExcNorm

        integer(n_int) :: iLutnI(0:NIfTot)
        integer :: i, error
        real(dp) :: TempTotParts, NormalisationTemp, Sum_Coeffs, AllNode_norm
        logical :: blank_det
        real(dp), dimension(lenof_sign) :: TempSign

        call set_timer(nElRDM_Time, 30)

        call MPISumAll(Histogram, AllHistogram)

        ExcNorm = 0.0_dp
        if (iProcIndex == 0) then
            do i = 1, Det
                ExcNorm = ExcNorm + AllHistogram(1, i)**2
            end do
            ExcNorm = sqrt(ExcNorm)
        end if

        call MPISumAll(ExcNorm, allNode_norm)
        ExcNorm = allNode_norm

        do i = 1, Det

            ! But if the actual number of determinants on this processor is
            ! less than the number we're running through, feed in 0
            ! determinants and 0 sign.
            if (near_zero(real(Histogram(1, i)))) then
                iLutnI(:) = 0
                blank_det = .true.
            else
                iLutnI(:) = FCIDets(:, i)
                blank_det = .false.
            end if

            TempSign(1) = real(i, dp)
            call encode_sign(iLutnI, TempSign)

            call Add_Hist_ExplicitRDM_Contrib(iLutnI, blank_det)

        end do

        call halt_timer(nElRDM_Time)

    end subroutine Fill_Hist_ExplicitRDM_this_Iter