function CheckAllowedTruncSpawn(WalkExcitLevel, nJ, ilutnJ, IC) &
result(bAllowed)
! Under any currently applied truncation schemes, is an excitation to
! this determinant allowed?
!
! In: WalkExcitLevel - Current excitation level relative to HF
! nJ - Natural integer representation of det
! (not Needed for HPHF/tTruncNOpen/MomInv)
! ilutnJ - Bit representation of det
! IC - Excitation level relative to parent
! Ret: bAllowed - .true. if excitation is allowed
use guga_data, only: ExcitationInformation_t
use guga_bitrepops, only: find_guga_excit_lvl
integer, intent(in) :: nJ(nel), WalkExcitLevel, IC
integer(n_int), intent(in) :: ilutnJ(0:NIfTot)
logical :: bAllowed
integer :: NoInFrozenCore, MinVirt, ExcitLevel, i
integer :: k(3)
type(ExcitationInformation_t) :: excitInfo
#ifdef DEBUG_
character(*), parameter :: this_routine = "CheckAllowedTruncSpawn"
#endif
bAllowed = .true.
! Truncate space by excitation level
if (tTruncSpace) then
! If parent walker is one below excitation cutoff, could be
! disallowed if double. If higher, then all excits could
! be disallowed. If HPHF, excit could be single or double,
! and IC not returned --> Always test.
! for 3-body excits we want to make this test more stringent
if (tGUGA) then
! for now it only works with icilevel = 2
ASSERT(icilevel == 2)
ExcitLevel = find_guga_excit_lvl(ilutref(:,1), ilutnJ)
if (ExcitLevel > icilevel) bAllowed = .false.
else if (t_3_body_excits) then
ExcitLevel = FindBitExcitLevel(iLutHF, ilutnJ, ICILevel, .true.)
if (ExcitLevel > ICILevel) bAllowed = .false.
else if (tHPHF .or. WalkExcitLevel >= ICILevel .or. &
(WalkExcitLevel == (ICILevel - 1) .and. IC == 2)) then
ExcitLevel = FindBitExcitLevel(iLutHF, ilutnJ, ICILevel, .true.)
if (ExcitLevel > ICILevel) &
bAllowed = .false.
end if
end if
! Is the number of unpaired electrons too high?
if (tTruncNOpen .and. bAllowed) then
if (count_open_orbs(ilutnJ) > trunc_nopen_max) &
bAllowed = .false.
end if
if (t_trunc_nopen_diff .and. bAllowed) then
! for now only implement it for single runs!
if (abs(count_open_orbs(ilutnJ) - count_open_orbs(ilutRef(:, 1))) > trunc_nopen_diff) then
bAllowed = .false.
end if
end if
! If the FCI space is restricted by a predetermined CAS space
if (tTruncCAS .and. .not. tTruncInitiator .and. bAllowed) then
if (.not. TestIfdetinCASBit(ilutnJ(0:NIfD))) &
bAllowed = .false.
end if
! Does the spawned determinant have more than the restricted number
! of holes in the partially frozen core?
!
! --> Run through the e- in nJ, count the number in the partially
! frozen core (i.e. with energy, from BRR, less than the frozen
! core limit). If too few, then forbidden.
if (tPartFreezeCore .and. bAllowed) then
NoInFrozenCore = 0
bAllowed = .false.
do i = 1, nel
if (SpinInvBRR(nJ(i)) <= NPartFrozen) &
NoInFrozenCore = NoInFrozenCore + 1
if (NoInFrozenCore == (NPartFrozen - NHolesFrozen)) then
bAllowed = .true.
exit
end if
end do
end if
! Does the spawned determinant have more than the restricted number
! of e- in the partially frozen virtual orbitals?
!
! --> Run through the e- in nJ, count the number in the partially
! frozen orbitals (i.e. with energy, from BRR, greater than
! minumum unfrozen virtual). If too many, then forbidden
if (tPartFreezeVirt .and. bAllowed) then
NoInFrozenCore = 0
MinVirt = nBasis - NVirtPartFrozen
! BRR(i) = j: orbital i is the j-th lowest in energy
do i = 1, nel
if (SpinInvBRR(nJ(i)) > MinVirt) &
NoInFrozenCore = NoInFrozenCore + 1
if (NoInFrozenCore > NElVirtFrozen) then
! Too many e- in part-frozen orbs
bAllowed = .false.
exit
end if
end do
end if
! Check to see if UEG excitation is allowed, by summing kx, ky, kz
! over all the electrons
if (tUEG .and. .not. tLatticeGens .and. bAllowed) then
k = 0
do i = 1, nel
k = k + G1(nJ(i))%k
end do
if (.not. all(k == 0)) &
bAllowed = .false.
end if
end function CheckAllowedTruncSpawn