function excitationIdentifier_double(i, j, k, l) result(excitInfo)
! function to identify all necessary information of an excitation
! provided with 4 indices of e_{ij,kl}.
! determines information on order of indices, involved generator
! types, overlap- and non overlap ranges and certain flags, needed for
! the correct matrix element calculation. All this information get
! stored in a custom type(excitationInformation) defined in the
! guga_data module
integer, intent(in) :: i, j, k, l
type(ExcitationInformation_t) :: excitInfo
character(*), parameter :: this_routine = "excitationIdentifier_double"
integer :: start1, end1, start2, end2
ASSERT(i > 0 .and. i <= nSpatOrbs)
ASSERT(j > 0 .and. j <= nSpatOrbs)
ASSERT(k <= nSpatOrbs)
ASSERT(l <= nSpatOrbs)
! if accessed with k = l = 0 redirect to single excitation identifier
! and exit
if (k == 0 .or. l == 0) then
excitInfo = excitationIdentifier(i, j)
return
end if
! now have to consider all possible i,j,k,l combinations
excitInfo%i = i
excitInfo%j = j
excitInfo%k = k
excitInfo%l = l
excitInfo%order = 1.0_dp
excitInfo%order1 = 1.0_dp
if (i == j) then
if (k == l) then
! double weight case:
excitInfo = assign_excitInfo_values_double( &
excit_type%weight, &
gen_type%W, gen_type%W, gen_type%W, gen_type%W, gen_type%W, i, i, k, k, &
0, 0, 0, 0, i, 0, 0.0_dp, 0.0_dp, 0)
else if (k < l) then
excitInfo = assign_excitInfo_values_double( &
excit_type%raising, &
gen_type%W, gen_type%R, gen_type%R, gen_type%R, gen_type%R, i, i, k, l, &
k, 0, 0, l, i, 2, 1.0_dp, 0.0_dp, 0)
else
excitInfo = assign_excitInfo_values_double( &
excit_type%lowering, &
gen_type%W, gen_type%L, gen_type%L, gen_type%L, gen_type%L, i, i, k, l, &
l, 0, 0, k, i, 2, 1.0_dp, 0.0_dp, 0)
end if
else if (k == l) then
! other weight combination
if (i == j) then
! double weight case
excitInfo = assign_excitInfo_values_double( &
excit_type%weight, &
gen_type%W, gen_type%W, gen_type%W, gen_type%W, gen_type%W, i, i, k, k, &
0, 0, 0, 0, k, 0, 0.0_dp, 0.0_dp, 0)
else if (i < j) then
excitInfo = assign_excitInfo_values_double( &
excit_type%raising, &
gen_type%R, gen_type%W, gen_type%R, gen_type%R, gen_type%R, i, j, k, k, &
i, 0, 0, j, k, 2, 1.0_dp, 0.0_dp, 0)
else
excitInfo = assign_excitInfo_values_double( &
excit_type%lowering, &
gen_type%L, gen_type%W, gen_type%L, gen_type%L, gen_type%L, i, j, k, l, &
j, 0, 0, i, k, 2, 1.0_dp, 0.0_dp, 0)
end if
else
! no weight generators involved
start1 = min(i, j)
end1 = max(i, j)
start2 = min(k, l)
end2 = max(k, l)
excitInfo%fullStart = min(start1, start2)
excitInfo%fullEnd = max(end1, end2)
excitInfo%firstEnd = min(end1, end2)
excitInfo%secondStart = max(start1, start2)
excitInfo%gen1 = sign(1, j - i)
excitInfo%gen2 = sign(1, l - k)
if (excitInfo%firstEnd < excitInfo%secondStart) then
! non overlap case
excitInfo%excitLvl = 4
excitInfo%typ = excit_type%non_overlap
excitInfo%overlap = 0
excitInfo%valid = .true.
! maybe need to specify which gen is first and last too
if (start1 < start2) then
excitInfo%firstGen = excitInfo%gen1
excitInfo%currentGen = excitInfo%gen1
excitInfo%lastGen = excitInfo%gen2
else
excitInfo%firstGen = excitInfo%gen2
excitInfo%currentGen = excitInfo%gen2
excitInfo%lastGen = excitInfo%gen1
end if
else if (excitInfo%firstEnd == excitInfo%secondStart) then
! single overlap case:
excitInfo%overlap = 1
! check if that alone is the IC=3 case:
excitInfo%excitLvl = 3
excitInfo%valid = .true.
! need first and last generators
if (start1 < start2) then
excitInfo%firstGen = excitInfo%gen1
excitInfo%currentGen = excitInfo%gen1
excitInfo%lastGen = excitInfo%gen2
else
excitInfo%firstGen = excitInfo%gen2
excitInfo%currentGen = excitInfo%gen2
excitInfo%lastGen = excitInfo%gen1
end if
if (excitInfo%firstGen == gen_type%L .and. &
excitInfo%lastGen == gen_type%L) then
excitInfo%typ = excit_type%single_overlap_lowering
else if (excitInfo%firstGen == gen_type%R .and. &
excitInfo%lastGen == gen_type%R) then
excitInfo%typ = excit_type%single_overlap_raising
else if (excitInfo%firstGen == gen_type%L .and. &
excitInfo%lastGen == gen_type%R) then
excitInfo%typ = excit_type%single_overlap_L_to_R
else
excitInfo%typ = excit_type%single_overlap_R_to_L
end if
else
! proper overlap case:
! more to determine here...
! overlap, and non overlap easiest propably
! num overlap entries:
excitInfo%overlap = excitInfo%firstEnd - excitInfo%secondStart + 1
excitInfo%valid = .true.
! for generator only have to specify which ones are acting in
! the non-overlap region, since naturally both of them are
! acting in the overlap region simultaniously
if (start1 < start2) then
excitInfo%firstGen = excitInfo%gen1
excitInfo%currentGen = excitInfo%gen1
if (end1 > end2) then
excitInfo%lastGen = excitInfo%gen1
if (excitInfo%gen1 == gen_type%L .and. &
excitInfo%gen2 == gen_type%L) then
excitInfo%typ = excit_type%double_lowering
! here only semi-stop has sign
excitInfo%order1 = -1.0_dp
else if (excitInfo%gen1 == gen_type%R .and. &
excitInfo%gen2 == gen_type%R) then
excitInfo%typ = excit_type%double_raising
! in this case there are sign changes only at the
! semi-start
excitInfo%order = -1.0_dp
else if (excitInfo%gen1 == gen_type%L .and. excitInfo%gen2 == gen_type%R) then
excitInfo%typ = excit_type%double_L_to_R_to_L
else
excitInfo%typ = excit_type%double_R_to_L_to_R
end if
else if (end1 < end2) then
excitInfo%lastGen = excitInfo%gen2
if (excitInfo%gen1 == gen_type%L .and. &
excitInfo%gen2 == gen_type%L) then
excitInfo%typ = excit_type%double_lowering
! here no semi has a sign
else if (excitInfo%gen1 == gen_type%R .and. &
excitInfo%gen2 == gen_type%R) then
excitInfo%typ = excit_type%double_raising
! here both semi-start and stop have a sign
excitInfo%order = -1.0_dp
excitInfo%order1 = -1.0_dp
else if (excitInfo%gen1 == gen_type%L .and. &
excitInfo%gen2 == gen_type%R) then
excitInfo%typ = excit_type%double_L_to_R
else
excitInfo%typ = excit_type%double_R_to_L
end if
else
! set lastGen to gen2 just to make same comparisons
excitInfo%lastGen = excitInfo%gen2
if (excitInfo%gen1 == gen_type%L .and. &
excitInfo%gen2 == gen_type%L) then
excitInfo%typ = excit_type%fullstop_lowering
else if (excitInfo%gen1 == gen_type%R .and. &
excitInfo%gen2 == gen_type%R) then
excitInfo%typ = excit_type%fullstop_raising
else if (excitInfo%gen1 == gen_type%L .and. &
excitInfo%gen2 == gen_type%R) then
excitInfo%typ = excit_type%fullstop_L_to_R
else
excitInfo%typ = excit_type%fullstop_R_to_L
end if
end if
else if (start1 > start2) then
excitInfo%firstGen = excitInfo%gen2
excitInfo%currentGen = excitInfo%gen2
if (end1 > end2) then
excitInfo%lastGen = excitInfo%gen1
if (excitInfo%gen1 == gen_type%L .and. &
excitInfo%gen2 == gen_type%L) then
excitInfo%typ = excit_type%double_lowering
! here both have a sign
excitInfo%order = -1.0_dp
excitInfo%order1 = -1.0_dp
else if (excitInfo%gen1 == gen_type%R .and. &
excitInfo%gen2 == gen_type%R) then
excitInfo%typ = excit_type%double_raising
! here both have "normal" sign
else if (excitInfo%gen1 == gen_type%L .and. &
excitInfo%gen2 == gen_type%R) then
excitInfo%typ = excit_type%double_R_to_L
else
excitInfo%typ = excit_type%double_L_to_R
end if
else if (end1 < end2) then
excitInfo%lastGen = excitInfo%gen2
if (excitInfo%gen1 == gen_type%L .and. &
excitInfo%gen2 == gen_type%L) then
excitInfo%typ = excit_type%double_lowering
! here only semi-start has a sign
excitInfo%order = -1.0_dp
else if (excitInfo%gen1 == gen_type%R .and. &
excitInfo%gen2 == gen_type%R) then
excitInfo%typ = excit_type%double_raising
! here only semi-stop has sign
excitInfo%order1 = -1.0_dp
else if (excitInfo%gen1 == gen_type%L .and. &
excitInfo%gen2 == gen_type%R) then
excitInfo%typ = excit_type%double_R_to_L_to_R
else
excitInfo%typ = excit_type%double_L_to_R_to_L
end if
else
! set lastGen to gen1 just to make same comparisons
excitInfo%lastGen = excitInfo%gen1
if (excitInfo%gen1 == gen_type%L .and. &
excitInfo%gen2 == gen_type%L) then
excitInfo%typ = excit_type%fullstop_lowering
else if (excitInfo%gen1 == gen_type%R .and. &
excitInfo%gen2 == gen_type%R) then
excitInfo%typ = excit_type%fullstop_raising
else if (excitInfo%gen1 == gen_type%L .and. &
excitInfo%gen2 == gen_type%R) then
excitInfo%typ = excit_type%fullstop_R_to_L
else
excitInfo%typ = excit_type%fullstop_L_to_R
end if
end if
else
if (end1 > end2) then
excitInfo%lastGen = excitInfo%gen1
! set first gen fake to other, to compare it in the
! same way
excitInfo%firstGen = excitInfo%gen2
if (excitInfo%gen1 == gen_type%L .and. &
excitInfo%gen2 == gen_type%L) then
excitInfo%typ = excit_type%fullstart_lowering
else if (excitInfo%gen1 == gen_type%R .and. &
excitInfo%gen2 == gen_type%R) then
excitInfo%typ = excit_type%fullstart_raising
else if (excitInfo%gen1 == gen_type%L .and. &
excitInfo%gen2 == gen_type%R) then
excitInfo%typ = excit_type%fullstart_R_to_L
else
excitInfo%typ = excit_type%fullStart_L_to_R
end if
else if (end1 < end2) then
excitInfo%lastGen = excitInfo%gen2
excitInfo%firstGen = excitInfo%gen1
excitInfo%currentGen = excitInfo%gen1
if (excitInfo%gen1 == gen_type%L .and. &
excitInfo%gen2 == gen_type%L) then
excitInfo%typ = excit_type%fullstart_lowering
else if (excitInfo%gen1 == gen_type%R .and. &
excitInfo%gen2 == gen_type%R) then
excitInfo%typ = excit_type%fullstart_raising
else if (excitInfo%gen1 == gen_type%L .and. &
excitInfo%gen2 == gen_type%R) then
excitInfo%typ = excit_type%fullStart_L_to_R
else
excitInfo%typ = excit_type%fullstart_R_to_L
end if
else
! check generator types here too.
if (excitInfo%gen1 == excitInfo%gen2) then
excitInfo%typ = excit_type%fullstart_stop_alike
else
excitInfo%typ = excit_type%fullstart_stop_mixed
end if
end if
end if
! TODO: concerning the order flag, there has to be a
! decision made. -> todo later
end if
end if
end function excitationIdentifier_double