subroutine perform_crude_excitation(ilut, csf_i, excitInfo, excitation, compFlag)
integer(n_int), intent(in) :: ilut(0:nifguga)
type(CSF_Info_t), intent(in) :: csf_i
type(ExcitationInformation_t), intent(in) :: excitInfo
integer(n_int), intent(out) :: excitation(0:nifguga)
logical, intent(out) :: compFlag
integer(n_int) :: ilutI(0:niftot), ilutJ(0:niftot)
HElement_t(dp) :: mat_ele
type(ExcitationInformation_t) :: dummy
excitation = ilut
select case (excitInfo%typ)
case (excit_type%fullstart_stop_mixed)
! fully exchange is easy, just switch involved step-vectors
if (csf_i%stepvector(excitInfo%fullstart) == 1) then
if (csf_i%stepvector(excitInfo%fullEnd) == 1) then
! not valid if the same step-vectors
compFlag = .false.
return
end if
! 1 -> 2 at start
set_two(excitation, excitInfo%fullstart)
clr_one(excitation, excitInfo%fullstart)
! 2 -> 1 at end
set_one(excitation, excitInfo%fullEnd)
clr_two(excitation, excitInfo%fullEnd)
else
if (csf_i%stepvector(excitInfo%fullEnd) == 2) then
compFlag = .false.
return
end if
! 2 > 1 at start
set_one(excitation, excitInfo%fullStart)
clr_two(excitation, excitInfo%fullstart)
! 1 -> 2 at end
clr_one(excitation, excitInfo%fullEnd)
set_two(excitation, excitInfo%fullEnd)
end if
case (excit_type%fullstop_R_to_L)
! full stop raising into lowering
! the start and semi-start step-values have to be
! different than the full-stop, where a switch is enforced.
if (csf_i%stepvector(excitInfo%fullEnd) == 1) then
! the full-start and semi-start are not allowed to have
! the same step-vector as the full-stop
if (csf_i%stepvector(excitInfo%secondStart) == 1 &
.or. csf_i%stepvector(excitInfo%fullStart) == 1) then
compFlag = .false.
return
end if
! in the case that the end is d = 1:
set_one(excitation, excitInfo%fullStart)
clr_two(excitation, excitInfo%secondStart)
clr_one(excitation, excitInfo%fullEnd)
set_two(excitation, excitInfo%fullEnd)
else
if (csf_i%stepvector(excitInfo%secondStart) == 2 &
.or. csf_i%stepvector(excitInfo%fullStart) == 2) then
compFlag = .false.
return
end if
! in the case of d = 2 at end
! in the case that the end is d = 1:
set_two(excitation, excitInfo%fullStart)
clr_one(excitation, excitInfo%secondStart)
clr_two(excitation, excitInfo%fullEnd)
set_one(excitation, excitInfo%fullEnd)
end if
case (excit_type%fullstop_L_to_R)
! full-stop lowering into raising
if (csf_i%stepvector(excitInfo%fullEnd) == 1) then
! the full-start and semi-start are not allowed to have
! the same step-vector as the full-stop
if (csf_i%stepvector(excitInfo%secondStart) == 1 &
.or. csf_i%stepvector(excitInfo%fullStart) == 1) then
compFlag = .false.
return
end if
! in the case that the end is d = 1:
set_one(excitation, excitInfo%secondStart)
clr_two(excitation, excitInfo%fullStart)
clr_one(excitation, excitInfo%fullEnd)
set_two(excitation, excitInfo%fullEnd)
else
if (csf_i%stepvector(excitInfo%secondStart) == 2 &
.or. csf_i%stepvector(excitInfo%fullStart) == 2) then
compFlag = .false.
return
end if
! in the case of d = 2 at end
! in the case that the end is d = 1:
set_two(excitation, excitInfo%secondStart)
clr_one(excitation, excitInfo%fullStart)
clr_two(excitation, excitInfo%fullEnd)
set_one(excitation, excitInfo%fullEnd)
end if
case (excit_type%fullStart_L_to_R)
! full-start lowering into raising
if (csf_i%stepvector(excitInfo%fullStart) == 1) then
! the full-start and semi-start are not allowed to have
! the same step-vector as the full-stop
if (csf_i%stepvector(excitInfo%firstEnd) == 1 &
.or. csf_i%stepvector(excitInfo%fullEnd) == 1) then
compFlag = .false.
return
end if
! in the case that the end is d = 1:
set_one(excitation, excitInfo%firstEnd)
clr_two(excitation, excitInfo%fullEnd)
clr_one(excitation, excitInfo%fullStart)
set_two(excitation, excitInfo%fullStart)
else
if (csf_i%stepvector(excitInfo%firstEnd) == 2 &
.or. csf_i%stepvector(excitInfo%fullEnd) == 2) then
compFlag = .false.
return
end if
! in the case of d = 2 at end
! in the case that the end is d = 1:
set_two(excitation, excitInfo%firstEnd)
clr_one(excitation, excitInfo%fullEnd)
clr_two(excitation, excitInfo%fullStart)
set_one(excitation, excitInfo%fullStart)
end if
case (excit_type%fullstart_R_to_L)
! full-start raising into lowering
if (csf_i%stepvector(excitInfo%fullStart) == 1) then
! the full-start and semi-start are not allowed to have
! the same step-vector as the full-stop
if (csf_i%stepvector(excitInfo%firstEnd) == 1 &
.or. csf_i%stepvector(excitInfo%fullEnd) == 1) then
compFlag = .false.
return
end if
! in the case that the end is d = 1:
set_one(excitation, excitInfo%fullEnd)
clr_two(excitation, excitInfo%firstEnd)
clr_one(excitation, excitInfo%fullStart)
set_two(excitation, excitInfo%fullStart)
else
if (csf_i%stepvector(excitInfo%firstEnd) == 2 &
.or. csf_i%stepvector(excitInfo%fullEnd) == 2) then
compFlag = .false.
return
end if
! in the case of d = 2 at end
! in the case that the end is d = 1:
set_two(excitation, excitInfo%fullEnd)
clr_one(excitation, excitInfo%firstEnd)
clr_two(excitation, excitInfo%fullStart)
set_one(excitation, excitInfo%fullStart)
end if
end select
compFlag = isProperCSF_ilut(excitation, .true.)
if (.not. compFlag) then
return
end if
! and then recalculate the matrix element
call convert_ilut_toNECI(ilut, ilutI)
call convert_ilut_toNECI(excitation, ilutJ)
call calc_guga_matrix_element(ilutI, csf_i, ilutJ, CSF_Info_t(ilutJ), dummy, mat_ele, .true.)
if (near_zero(mat_ele)) then
compFlag = .false.
excitation = 0_n_int
return
end if
call encode_matrix_element(excitation, 0.0_dp, 2)
call encode_matrix_element(excitation, mat_ele, 1)
end subroutine perform_crude_excitation