SUBROUTINE CreateRandomExcitLevDet(iExcitLevTest, FDet, FDetiLut, iLut, ExcitLev, Attempts)
use SystemData, only: nEl, G1, nBasis
use SystemData, only: tUEG, tHPHF, tHub
use SystemData, only: tFixLz
use dSFMT_interface
use bit_rep_data, only: NIfTot
use DetBitOps, only: IsAllowedHPHF
integer, intent(in) :: iExcitLevTest, FDet(NEl)
integer, intent(out) :: ExcitLev, Attempts
integer(n_int), intent(out) :: iLut(0:NIfTot)
integer(n_int), intent(in) :: FDetiLut(0:NIfTot)
logical :: tSymAllowedDet, tNotAllowed
integer :: TotalSym, TotalMom, TotalMs, Momx, Momy, Momz, j, Elec, Orb, Hole
real(dp) :: r
Attempts = 0 !Count the number of attempts needed to generate the sym-allowed determinant.
tSymAllowedDet = .false.
do while (.not. tSymAllowedDet)
TotalSym = 0
TotalMom = 0
TotalMs = 0
Momx = 0
Momy = 0
Momz = 0
ExcitLev = 0
iLut(:) = FDetiLut(:)
!Create random determinant
!Loop over holes in occupied space
do j = 1, iExcitLevTest
tNotAllowed = .true.
do while (tNotAllowed) !Loop until we have created an allowed hole.
r = genrand_real2_dSFMT()
Elec = int(NEl * r) + 1
Orb = FDet(Elec)
!Electron picked must not be one which has been picked before
!i.e. it must be occupied in iLut
if (IsOcc(iLut, Orb)) then
!Clear orbital to indicate it is gone.
clr_orb(iLut, Orb)
tNotAllowed = .false.
!Deal with totting up the symmetry for the now unocc orbital
TotalSym = IEOR(TotalSym, int((G1(Orb)%Sym%S)))
TotalMom = TotalMom + G1(Orb)%Ml
TotalMs = TotalMs + G1(Orb)%Ms
IF (tUEG .or. tHub) THEN
Momx = Momx + G1(Orb)%k(1)
Momy = Momy + G1(Orb)%k(2)
Momz = Momz + G1(Orb)%k(3)
end if
end if
end do
end do
!Loop over electrons in the unoccupied space
do j = 1, iExcitLevTest
tNotAllowed = .true.
do while (tNotAllowed) !Loop until we have created an allowed electron
r = genrand_real2_dSFMT()
Hole = int(nBasis * r) + 1
if (IsNotOcc(iLut, Hole)) then
!Set orbital to indicate it is now occupied
set_orb(iLut, Hole)
tNotAllowed = .false.
!Increase excitation level
if (IsNotOcc(FDetiLut, Hole)) ExcitLev = ExcitLev + 1
!Deal with totting up the symmetry for the now occ orbital
TotalSym = IEOR(TotalSym, int((G1(Hole)%Sym%S)))
TotalMom = TotalMom - G1(Hole)%Ml
TotalMs = TotalMs - G1(Hole)%Ms
if (tUEG .or. tHub) then
Momx = Momx - G1(Hole)%k(1)
Momy = Momy - G1(Hole)%k(2)
Momz = Momz - G1(Hole)%k(3)
end if
end if
end do
end do
if ((TotalSym == 0) .and. (TotalMom == 0) .and. (Momx == 0) .and. (Momy == 0) .and. (Momz == 0) .and. (TotalMs == 0)) then
!Created determinant is symmetry allowed.
if (tHPHF) then
if (IsAllowedHPHF(iLut)) tSymAllowedDet = .true.
else
tSymAllowedDet = .true.
end if
end if
Attempts = Attempts + 1
end do
END SUBROUTINE CreateRandomExcitLevDet