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