calcFullStartL2R Subroutine

public subroutine calcFullStartL2R(ilut, csf_i, excitInfo, excitations, nExcits, posSwitches, negSwitches, t_no_singles_opt)

Arguments

Type IntentOptional Attributes Name
integer(kind=n_int), intent(in) :: ilut(0:nifguga)
type(CSF_Info_t), intent(in) :: csf_i
type(ExcitationInformation_t), intent(inout) :: excitInfo
integer(kind=n_int), intent(out), allocatable :: excitations(:,:)
integer, intent(out) :: nExcits
real(kind=dp), intent(in) :: posSwitches(nSpatOrbs)
real(kind=dp), intent(in) :: negSwitches(nSpatOrbs)
logical, intent(in), optional :: t_no_singles_opt

Contents

Source Code


Source Code

    subroutine calcFullStartL2R(ilut, csf_i, excitInfo, excitations, nExcits, &
                                posSwitches, negSwitches, t_no_singles_opt)
        integer(n_int), intent(in) :: ilut(0:nifguga)
        type(CSF_Info_t), intent(in) :: csf_i
        type(ExcitationInformation_t), intent(inout) :: excitInfo
        integer(n_int), intent(out), allocatable :: excitations(:, :)
        integer, intent(out) :: nExcits
        real(dp), intent(in) :: posSwitches(nSpatOrbs), negSwitches(nSpatOrbs)
        logical, intent(in), optional :: t_no_singles_opt
        character(*), parameter :: this_routine = "calcFullStartL2R"

        integer :: ierr, iOrb, start, ende, semi, gen
        real(dp) :: minusWeight, plusWeight, zeroWeight
        type(WeightObj_t) :: weights
        integer(n_int), allocatable :: tempExcits(:, :)
        logical :: t_no_singles

        ASSERT(.not. isZero(ilut, excitInfo%fullStart))
        ASSERT(isProperCSF_ilut(ilut))

        ! create the fullStart
        start = excitInfo%fullStart
        ende = excitInfo%fullEnd
        semi = excitInfo%firstEnd
        gen = excitInfo%firstGen

        if (present(t_no_singles_opt)) then
            t_no_singles = t_no_singles_opt
        else
            t_no_singles = .false.
        end if

        if (t_no_singles .and. csf_i%stepvector(start) == 3) then
            nExcits = 0
            allocate(excitations(0, 0), stat=ierr)
            return
        end if

        ! create correct weights:
        weights = init_fullStartWeight(csf_i, semi, ende, negSwitches(semi), &
                                       posSwitches(semi), csf_i%B_real(semi))

        minusWeight = weights%proc%minus(negSwitches(start), csf_i%B_real(start), weights%dat)
        plusWeight = weights%proc%plus(posSwitches(start), csf_i%B_real(start), weights%dat)
        zeroWeight = weights%proc%zero(negSwitches(start), posSwitches(start), &
                                       csf_i%B_real(start), weights%dat)

        if (t_mixed_hubbard) then
            if (csf_i%stepvector(start) == 3) then
                nExcits = 0
                allocate(excitations(0, 0), stat=ierr)
                return
            end if
        end if

        ! check if first value is 3, so only 0 branch is compatible
        call mixedFullStart(ilut, csf_i, excitInfo, plusWeight, minusWeight, zeroWeight, tempExcits, &
                            nExcits)

        ! then do pseudo double until semi stop
        ! should check for LR(3) start here, have to do nothing if a 3 at
        ! the full start since all matrix elements are one..
        if (csf_i%stepvector(start) /= 3) then
            do iOrb = start + 1, semi - 1
                call doubleUpdate(ilut, csf_i, iOrb, excitInfo, weights, tempExcits, nExcits, &
                                  negSwitches, posSwitches)
            end do
        end if

        if (t_mixed_hubbard) then
            ! TODO abort x0 branch..
        end if

        ! then deal with the specific semi-stop here
        ! but todo update weights here..
        weights = weights%ptr
        plusWeight = weights%proc%plus(posSwitches(semi), csf_i%B_real(semi), &
                                       weights%dat)
        minusWeight = weights%proc%minus(negSwitches(semi), csf_i%B_real(semi), &
                                         weights%dat)

        call calcLoweringSemiStop(ilut, csf_i, excitInfo, tempExcits, nExcits, plusWeight, &
                                  minusWeight, t_no_singles)

        ! then reset weights todo!
        excitInfo%currentGen = excitInfo%lastGen

        ! and continue on with single excitation region
        do iOrb = semi + 1, ende - 1
            call singleUpdate(ilut, csf_i, iOrb, excitInfo, posSwitches, negSwitches, &
                              weights, tempExcits, nExcits)
        end do

        ! and normal single end
        call singleEnd(ilut, csf_i, excitInfo, tempExcits, nExcits, excitations)

    end subroutine calcFullStartL2R