subroutine calcRemainingSwitches_excitInfo_double(csf_i, excitInfo, &
posSwitches, negSwitches)
! subroutine to determine the number of remaining switches for double
! excitations between spatial orbitals (i,j,k,l). orbital indices are
! given in type(excitationInformation), extra flag is needed to
! indicate that this is a double excitaiton then
type(CSF_Info_t), intent(in) :: csf_i
type(ExcitationInformation_t), intent(in) :: excitInfo
real(dp), intent(out) :: posSwitches(nSpatOrbs), negSwitches(nSpatOrbs)
integer :: iOrb, end1
real(dp) :: oneCount, twoCount
! have to calc. the overlap range of the excitations to more
! efficiently decide between different kind of double excitations
! even better, get all possible information through excitationIdentifier
! assume exitInfo already calculated in calling function
! update: already given as input
!excitInfo = excitationIdentifier(i, j, k, l)
! intitialize values
oneCount = 0.0_dp
twoCount = 0.0_dp
posSwitches = 0.0_dp
negSwitches = 0.0_dp
if (excitInfo%typ == excit_type%raising .or. &
excitInfo%typ == excit_type%lowering) then
call calcRemainingSwitches_excitInfo_single(csf_i, excitInfo, &
posSwitches, negSwitches)
else
select case (excitInfo%overlap)
case (0)
do iOrb = excitInfo%fullEnd - 1, excitInfo%secondStart, -1
posSwitches(iOrb) = twoCount
negSwitches(iOrb) = oneCount
select case (csf_i%stepvector(iOrb))
case (1)
oneCount = oneCount + 1.0_dp
case (2)
twoCount = twoCount + 1.0_dp
end select
end do
! reset count past second excitations:
oneCount = 0.0_dp
twoCount = 0.0_dp
do iOrb = excitInfo%firstEnd - 1, excitInfo%fullStart, -1
posSwitches(iOrb) = twoCount
negSwitches(iOrb) = oneCount
select case (csf_i%stepvector(iOrb))
case (1)
oneCount = oneCount + 1.0_dp
case (2)
twoCount = twoCount + 1.0_dp
end select
end do
case (1)
! not quite sure anymore why, but have to treat single overlap
! excitations with alike generators different then mixed
! because it is like a single excitation over the whole excitation
! range
if (excitInfo%gen1 /= excitInfo%gen2) then
end1 = 0
else
end1 = excitInfo%firstEnd
end if
do iOrb = excitInfo%fullEnd - 1, excitInfo%firstEnd, -1
posSwitches(iOrb) = twoCount
negSwitches(iOrb) = oneCount
select case (csf_i%stepvector(iOrb))
case (1)
oneCount = oneCount + 1.0_dp
case (2)
twoCount = twoCount + 1.0_dp
end select
end do
! reset the switch number if alike generators are present.
! now i am confused.. no its fine.. we actually never want to
! go into single overlap with alike generators, since it is
! actually a single excitation then!
if (excitInfo%gen1 == excitInfo%gen2) then
oneCount = 0.0_dp
twoCount = 0.0_dp
end if
do iOrb = excitInfo%firstEnd - 1, excitInfo%fullStart, -1
posSwitches(iOrb) = twoCount
negSwitches(iOrb) = oneCount
select case (csf_i%stepvector(iOrb))
case (1)
oneCount = oneCount + 1.0_dp
case (2)
twoCount = twoCount + 1.0_dp
end select
end do
case default
! proper overlap ranges:
! do all those excitations in the same way, although this means
! for some, that too much work is done.. e.g. for full-start
! excitations with alike generators. where only the delta b = 0
! branch has non-zero matrix elements in the overlap region
! but these things can be handled in the excitations calculation
! for certain index combinations some loops wont get executed
do iOrb = excitInfo%fullEnd - 1, excitInfo%firstEnd, -1
posSwitches(iOrb) = twoCount
negSwitches(iOrb) = oneCount
select case (csf_i%stepvector(iOrb))
case (1)
oneCount = oneCount + 1.0_dp
case (2)
twoCount = twoCount + 1.0_dp
end select
end do
oneCount = 0.0_dp
twoCount = 0.0_dp
do iOrb = excitInfo%firstEnd - 1, excitInfo%secondStart, -1
posSwitches(iOrb) = twoCount
negSwitches(iOrb) = oneCount
select case (csf_i%stepvector(iOrb))
case (1)
oneCount = oneCount + 1.0_dp
case (2)
twoCount = twoCount + 1.0_dp
end select
end do
oneCount = 0.0_dp
twoCount = 0.0_dp
do iOrb = excitInfo%secondStart - 1, excitInfo%fullStart, -1
posSwitches(iOrb) = twoCount
negSwitches(iOrb) = oneCount
select case (csf_i%stepvector(iOrb))
case (1)
oneCount = oneCount + 1.0_dp
case (2)
twoCount = twoCount + 1.0_dp
end select
end do
oneCount = 0.0_dp
twoCount = 0.0_dp
end select
end if
end subroutine calcRemainingSwitches_excitInfo_double