calcSingleOverlapLowering Subroutine

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

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)

Contents


Source Code

    subroutine calcSingleOverlapLowering(ilut, csf_i, excitInfo, excitations, nExcits, &
                                         posSwitches, negSwitches)
        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)
        character(*), parameter :: this_routine = "calcSingleOverlapLowering"

        integer(n_int), allocatable :: tempExcits(:, :)
        integer(n_int) ::  t(0:nifguga)
        integer :: i, iEx, deltaB, ss
        type(WeightObj_t) :: weights

        ASSERT(isProperCSF_ilut(ilut))
        ASSERT(excitInfo%typ == excit_type%single_overlap_lowering)
        ASSERT(excitInfo%firstGen == gen_type%L)
        ASSERT(excitInfo%lastGen == gen_type%L)

        excitInfo%currentGen = excitInfo%firstGen
        ! have to make specific single start to correctly adress the weights
        weights = init_singleOverlapLowering(csf_i, excitInfo%firstEnd, &
                                             excitInfo%fullEnd, negSwitches(excitInfo%firstEnd), posSwitches(excitInfo%firstEnd), &
                                             csf_i%B_real(excitInfo%firstEnd))

        call createSingleStart(ilut, csf_i, excitInfo, posSwitches, negSwitches, weights, &
                               tempExcits, nExcits)

        ss = excitInfo%secondStart
        ! loop until overlap site
        do i = excitInfo%fullStart + 1, excitInfo%secondStart - 1
            call singleUpdate(ilut, csf_i, i, excitInfo, posSwitches, negSwitches, &
                              weights, tempExcits, nExcits)
        end do

        ! do special stuff at lowering site
        ! two lowerings

        ! has only forced switches at switch possibilities
        if (csf_i%stepvector(ss) == 1) then
            ! switch deltaB = -1 branches
            do iEx = 1, nExcits
                deltaB = getDeltaB(tempExcits(:, iEx))
                if (deltaB == -1) then
                    ! switch 1 - > 2
                    t = tempExcits(:, iEx)
                    clr_orb(t, 2 * ss - 1)
                    set_orb(t, 2 * ss)

                    call setDeltaB(1, t)

                    tempExcits(:, iEx) = t

                    ! no change in matrix elements
                end if
            end do

        else if (csf_i%stepvector(ss) == 2) then
            ! switch deltaB = +1
            do iEx = 1, nExcits
                deltaB = getDeltaB(tempExcits(:, iEx))
                if (deltaB == 1) then
                    ! switch 2 -> 1
                    t = tempExcits(:, iEx)
                    clr_orb(t, 2 * ss)
                    set_orb(t, 2 * ss - 1)

                    call setDeltaB(-1, t)

                    tempExcits(:, iEx) = t
                end if
            end do
        end if

        excitInfo%currentGen = excitInfo%lastGen

        ! update weights here?
        weights = weights%ptr

        ! continue with secon region normally
        do i = excitInfo%secondStart + 1, excitInfo%fullEnd - 1
            call singleUpdate(ilut, csf_i, i, excitInfo, posSwitches, negSwitches, &
                              weights, tempExcits, nExcits)

        end do

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

    end subroutine calcSingleOverlapLowering