subroutine gen_excit_back_spawn_hubbard(nI, ilutI, nJ, ilutJ, exFlag, ic, &
ExcitMat, tParity, pgen, HelGen, store, part_type)
integer, intent(in) :: nI(nel), exFlag
integer(n_int), intent(in) :: ilutI(0:niftot)
integer, intent(out) :: nJ(nel), ic, ExcitMat(2, maxExcit)
integer(n_int), intent(out) :: ilutJ(0:niftot)
logical, intent(out) :: tParity
real(dp), intent(out) :: pgen
HElement_t(dp), intent(out) :: HElGen
type(excit_gen_store_type), intent(inout), target :: store
integer, intent(in), optional :: part_type
character(*), parameter :: this_routine = "gen_excit_back_spawn_hubbard"
integer :: iUnused
#ifdef DEBUG_
real(dp) :: pgen2
HElement_t(dp) :: temp_hel
#endif
! so now pack everything necessary for a ueg excitation generator.
! why is ilutJ not created here? do it!
HelGen = 0.0_dp
iUnused = exFlag
iUnused = store%nopen
ic = 2
! this function gets pointed to if tUEG, t_back_spawn_flex and tLatticeGens
! is set
! BUT: again: we also need to take care of the HPHF keyword..
! which is a mess
! implement it for now without this tNoFailAb flag
ASSERT(.not. tNoFailAb)
if ((t_back_spawn .or. t_back_spawn_flex) .and. .not. &
test_flag(ilutI, get_initiator_flag(part_type))) then
call gen_double_back_spawn_hubbard(nI, ilutI, nJ, ilutJ, tParity, ExcitMat, &
pgen)
#ifdef DEBUG_
if (.not. IsNullDet(nJ)) then
pgen2 = calc_pgen_back_spawn_hubbard(nI, ilutI, ExcitMat, ic, part_type)
if (abs(pgen - pgen2) > 1.0e-6_dp) then
if (tHPHF) then
print *, "due to circular dependence, no matrix element calc possible!"
! temp_hel = hphf_off_diag_helement(nI,nJ,ilutI,ilutJ)
temp_hel = 0.0_dp
else
temp_hel = get_helement(nI, nJ, ilutI, ilutJ)
end if
write(stdout, *) 'Calculated and actual pgens differ. for non-initiator'
write(stdout, *) 'This will break HPHF calculations'
call write_det(stdout, nI, .false.)
write(stdout, '(" --> ")', advance='no')
call write_det(stdout, nJ, .true.)
write(stdout, *) 'Excitation matrix: ', ExcitMat(1, 1:ic), '-->', &
ExcitMat(2, 1:ic)
write(stdout, *) 'Generated pGen: ', pgen
write(stdout, *) 'Calculated pGen: ', pgen2
write(stdout, *) 'matrix element: ', temp_hel
call stop_all(this_routine, "Invalid pGen")
end if
end if
#endif
else
! do i want to rewrite the old on or just reuse? for now reuse:
call CreateExcitLattice(nI, ilutI, nJ, tParity, ExcitMat, pgen, part_type)
if (.not. IsNullDet(nJ)) ilutJ = make_ilutJ(ilutI, ExcitMat, ic)
#ifdef DEBUG_
if (.not. IsNullDet(nJ)) then
call CalcPGenLattice(ExcitMat, pgen2)
if (abs(pgen - pgen2) > 1.0e-6_dp) then
if (tHPHF) then
print *, "due to circular dependence, no matrix element calc possible!"
! temp_hel = hphf_off_diag_helement(nI,nJ,ilutI,ilutJ)
temp_hel = 0.0_dp
else
temp_hel = get_helement(nI, nJ, ilutI, ilutJ)
end if
write(stdout, *) 'Calculated and actual pgens differ. for non-initiator'
write(stdout, *) 'This will break HPHF calculations'
call write_det(stdout, nI, .false.)
write(stdout, '(" --> ")', advance='no')
call write_det(stdout, nJ, .true.)
write(stdout, *) 'Excitation matrix: ', ExcitMat(1, 1:ic), '-->', &
ExcitMat(2, 1:ic)
write(stdout, *) 'Generated pGen: ', pgen
write(stdout, *) 'Calculated pGen: ', pgen2
write(stdout, *) 'matrix element: ', temp_hel
call stop_all(this_routine, "Invalid pGen")
end if
end if
#endif
end if
end subroutine gen_excit_back_spawn_hubbard