subroutine checkCompatibility(csf_i, excitInfo, flag, posSwitches, negSwitches, opt_weight)
! depending on the type of excitation determined in the
! excitationIdentifier check if the provided ilut and excitation and
! the probabilistic weight function allow an excitation
! dont do probabilistic weight for now. just check stepvector
type(CSF_Info_t), intent(in) :: csf_i
type(ExcitationInformation_t), intent(in) :: excitInfo
logical, intent(out) :: flag
real(dp), intent(out), optional :: posSwitches(nSpatOrbs), &
negSwitches(nSpatOrbs)
type(WeightObj_t), intent(out), optional :: opt_weight
real(dp) :: pw, mw, zw
integer :: we, st, ss, fe, en, i, j, k, lO
type(WeightObj_t) :: weights
! also include probabilistic weights
call calcRemainingSwitches_excitInfo_double( &
csf_i, excitInfo, posSwitches, negSwitches)
! todo include probabilistic weights too.
! and check all if conditions todo! definetly mistakes there!
! i definetly have the occ, b and stepvector info here..
we = excitInfo%weight
st = excitInfo%fullStart
ss = excitInfo%secondStart
fe = excitInfo%firstEnd
en = excitInfo%fullEnd
flag = .true.
select case (excitInfo%typ)
! weight + raising generator:
case (excit_type%raising)
if (csf_i%stepvector(we) == 0 .or. csf_i%stepvector(st) == &
3 .or. csf_i%stepvector(en) == 0 .or. &
(we == en .and. csf_i%stepvector(en) /= 3)) then
flag = .false.
return
end if
weights = init_singleWeight(csf_i, en)
mw = weights%proc%minus(negSwitches(st), csf_i%B_real(st), weights%dat)
pw = weights%proc%plus(posSwitches(st), csf_i%B_real(st), weights%dat)
if (near_zero(pw) .and. near_zero(mw) &
.or. csf_i%stepvector(st) == 1 .and. near_zero(pw) &
.or. csf_i%stepvector(st) == 2 .and. near_zero(mw)) then
flag = .false.
return
end if
! weight + lowering generator:
case (excit_type%lowering)
if (csf_i%stepvector(we) == 0 &
.or. csf_i%stepvector(en) == 3 &
.or. csf_i%stepvector(st) == 0 &
.or. (we == st .and. csf_i%stepvector(st) /= 3)) then
flag = .false.
return
end if
weights = init_singleWeight(csf_i, en)
mw = weights%proc%minus(negSwitches(st), csf_i%B_real(st), weights%dat)
pw = weights%proc%plus(posSwitches(st), csf_i%B_real(st), weights%dat)
if ((csf_i%stepvector(st) == 1 .and. near_zero(pw)) .or. &
(csf_i%stepvector(st) == 2 .and. near_zero(mw)) .or. &
(near_zero(pw + mw))) then
flag = .false.
return
end if
! no overlap:
case (excit_type%non_overlap)
i = excitInfo%i
j = excitInfo%j
k = excitInfo%k
lO = excitInfo%l
if (csf_i%stepvector(i) == 3 .or. csf_i%stepvector(j) == 0 .or. &
csf_i%stepvector(k) == 3 .or. csf_i%stepvector(lO) == 0) then
flag = .false.
return
end if
weights = init_singleWeight(csf_i, fe)
mw = weights%proc%minus(negSwitches(st), csf_i%B_real(st), weights%dat)
pw = weights%proc%plus(posSwitches(st), csf_i%B_real(st), weights%dat)
! first check lower range
if (near_zero(pw + mw) .or. &
(csf_i%stepvector(st) == 1 .and. near_zero(pw)) .or. &
(csf_i%stepvector(st) == 2 .and. near_zero(mw))) then
flag = .false.
return
end if
! then second
weights = init_singleWeight(csf_i, en)
mw = weights%proc%minus(negSwitches(ss), csf_i%B_real(ss), weights%dat)
pw = weights%proc%plus(posSwitches(ss), csf_i%B_real(ss), weights%dat)
if (near_zero(pw + mw) .or. &
(csf_i%stepvector(ss) == 1 .and. near_zero(pw)) .or. &
(csf_i%stepvector(ss) == 2 .and. near_zero(mw))) then
flag = .false.
return
end if
! single overlap lowering
case (excit_type%single_overlap_lowering)
if (csf_i%stepvector(fe) == 0 .or. csf_i%stepvector(en) == &
3 .or. csf_i%stepvector(st) == 0) then
flag = .false.
return
end if
! todo: change single overlap probWeight to correctly include
! bvalue restrictions to the calc.!!!
! todo
weights = init_singleOverlapLowering(csf_i, fe, en, negSwitches(fe), &
posSwitches(fe), csf_i%B_real(fe))
pw = weights%proc%plus(posSwitches(st), csf_i%B_real(st), weights%dat)
mw = weights%proc%minus(negSwitches(st), csf_i%B_real(st), weights%dat)
if (near_zero(pw + mw) .or. &
(csf_i%stepvector(st) == 1 .and. near_zero(pw)) .or. &
(csf_i%stepvector(st) == 2 .and. near_zero(mw))) then
flag = .false.
return
end if
! todo: one of the two alike gens single overlap excits has
! additional constraints i believe
! single overlap raising
case (excit_type%single_overlap_raising)
if (csf_i%stepvector(fe) == 0 .or. csf_i%stepvector(st) == &
3 .or. csf_i%stepvector(en) == 0) then
flag = .false.
return
end if
weights = init_singleOverlapRaising(csf_i, fe, en, negSwitches(fe), &
posSwitches(fe), csf_i%B_real(fe))
pw = weights%proc%plus(posSwitches(st), csf_i%B_real(st), weights%dat)
mw = weights%proc%minus(negSwitches(st), csf_i%B_real(st), weights%dat)
if (near_zero(pw + mw) .or. &
(csf_i%stepvector(st) == 1 .and. near_zero(pw)) .or. &
(csf_i%stepvector(st) == 2 .and. near_zero(mw))) then
flag = .false.
return
end if
! single overlap lowering into raising
case (excit_type%single_overlap_L_to_R)
if (csf_i%stepvector(st) == 0 .or. csf_i%stepvector(fe) /= &
0 .or. csf_i%stepvector(en) == 0) then
flag = .false.
return
end if
weights = init_singleWeight(csf_i, en)
mw = weights%proc%minus(negSwitches(st), csf_i%B_real(st), weights%dat)
pw = weights%proc%plus(posSwitches(st), csf_i%B_real(st), weights%dat)
if (near_zero(pw + mw) .or. &
(csf_i%stepvector(st) == 1 .and. near_zero(pw)) .or. &
(csf_i%stepvector(st) == 2 .and. near_zero(mw))) then
flag = .false.
return
end if
! single overlap raising into lowering
case (excit_type%single_overlap_R_to_L)
if (csf_i%stepvector(fe) /= 3 .or. csf_i%stepvector(st) == &
3 .or. csf_i%stepvector(en) == 3) then
flag = .false.
return
end if
weights = init_singleWeight(csf_i, en)
mw = weights%proc%minus(negSwitches(st), csf_i%B_real(st), weights%dat)
pw = weights%proc%plus(posSwitches(st), csf_i%B_real(st), weights%dat)
if (near_zero(pw + mw) .or. &
(csf_i%stepvector(st) == 1 .and. near_zero(pw)) .or. &
(csf_i%stepvector(st) == 2 .and. near_zero(mw))) then
flag = .false.
return
end if
! normal double two lowering
case (excit_type%double_lowering)
if (csf_i%stepvector(st) == 0 .or. csf_i%stepvector(fe) == &
3 .or. csf_i%stepvector(en) == 3 .or. &
csf_i%stepvector(ss) == 0) then
flag = .false.
return
end if
weights = init_fullDoubleWeight(csf_i, ss, fe, en, negSwitches(ss), &
negSwitches(fe), posSwitches(ss), posSwitches(fe), csf_i%B_real(ss), &
csf_i%B_real(fe))
pw = weights%proc%plus(posSwitches(st), csf_i%B_real(st), weights%dat)
mw = weights%proc%minus(negSwitches(st), csf_i%B_real(st), weights%dat)
if (near_zero(mw + pw) .or. &
(csf_i%stepvector(st) == 1 .and. near_zero(pw)) .or. &
(csf_i%stepvector(st) == 2 .and. near_zero(mw))) then
flag = .false.
return
end if
! normal double two raising
case (excit_type%double_raising)
if (csf_i%stepvector(en) == 0 .or. csf_i%stepvector(ss) == &
3 .or. csf_i%stepvector(st) == 3 .or. &
csf_i%stepvector(fe) == 0) then
flag = .false.
return
end if
weights = init_fullDoubleWeight(csf_i, ss, fe, en, negSwitches(ss), &
negSwitches(fe), posSwitches(ss), posSwitches(fe), csf_i%B_real(ss), &
csf_i%B_real(fe))
pw = weights%proc%plus(posSwitches(st), csf_i%B_real(st), weights%dat)
mw = weights%proc%minus(negSwitches(st), csf_i%B_real(st), weights%dat)
if (near_zero(mw + pw) .or. &
(csf_i%stepvector(st) == 1 .and. near_zero(pw)) .or. &
(csf_i%stepvector(st) == 2 .and. near_zero(mw))) then
flag = .false.
return
end if
! lowering into raising into lowering
case (excit_type%double_L_to_R_to_L)
if (csf_i%stepvector(st) == 0 .or. csf_i%stepvector(ss) == &
3 .or. csf_i%stepvector(en) == 3 .or. &
csf_i%stepvector(fe) == 0) then
flag = .false.
return
end if
weights = init_fullDoubleWeight(csf_i, ss, fe, en, negSwitches(ss), &
negSwitches(fe), posSwitches(ss), posSwitches(fe), csf_i%B_real(ss), &
csf_i%B_real(fe))
pw = weights%proc%plus(posSwitches(st), csf_i%B_real(st), weights%dat)
mw = weights%proc%minus(negSwitches(st), csf_i%B_real(st), weights%dat)
if (near_zero(mw + pw) .or. &
(csf_i%stepvector(st) == 1 .and. near_zero(pw)) .or. &
(csf_i%stepvector(st) == 2 .and. near_zero(mw))) then
flag = .false.
return
end if
! raising into lowering into raising
case (excit_type%double_R_to_L_to_R)
if (csf_i%stepvector(en) == 0 .or. csf_i%stepvector(fe) == &
3 .or. csf_i%stepvector(st) == 3 .or. &
csf_i%stepvector(ss) == 0) then
flag = .false.
return
end if
weights = init_fullDoubleWeight(csf_i, ss, fe, en, negSwitches(ss), &
negSwitches(fe), posSwitches(ss), posSwitches(fe), csf_i%B_real(ss), &
csf_i%B_real(fe))
pw = weights%proc%plus(posSwitches(st), csf_i%B_real(st), weights%dat)
mw = weights%proc%minus(negSwitches(st), csf_i%B_real(st), weights%dat)
if (near_zero(mw + pw) .or. &
(csf_i%stepvector(st) == 1 .and. near_zero(pw)) .or. &
(csf_i%stepvector(st) == 2 .and. near_zero(mw))) then
flag = .false.
return
end if
! lowering into raising double
case (excit_type%double_L_to_R)
if (csf_i%stepvector(st) == 0 .or. csf_i%stepvector(ss) == 3 &
.or. csf_i%stepvector(en) == 0 .or. &
csf_i%stepvector(fe) == 3) then
flag = .false.
return
end if
weights = init_fullDoubleWeight(csf_i, ss, fe, en, negSwitches(ss), &
negSwitches(fe), posSwitches(ss), posSwitches(fe), csf_i%B_real(ss), &
csf_i%B_real(fe))
pw = weights%proc%plus(posSwitches(st), csf_i%B_real(st), weights%dat)
mw = weights%proc%minus(negSwitches(st), csf_i%B_real(st), weights%dat)
if (near_zero(mw + pw) .or. &
(csf_i%stepvector(st) == 1 .and. near_zero(pw)) .or. &
(csf_i%stepvector(st) == 2 .and. near_zero(mw))) then
flag = .false.
return
end if
! raising into lowering double
case (excit_type%double_R_to_L)
if (csf_i%stepvector(ss) == 0 .or. csf_i%stepvector(st) == 3 &
.or. csf_i%stepvector(en) == 3 .or. &
csf_i%stepvector(fe) == 0) then
flag = .false.
return
end if
weights = init_fullDoubleWeight(csf_i, ss, fe, en, negSwitches(ss), &
negSwitches(fe), posSwitches(ss), posSwitches(fe), csf_i%B_real(ss), &
csf_i%B_real(fe))
pw = weights%proc%plus(posSwitches(st), csf_i%B_real(st), weights%dat)
mw = weights%proc%minus(negSwitches(st), csf_i%B_real(st), weights%dat)
if (near_zero(mw + pw) .or. &
(csf_i%stepvector(st) == 1 .and. near_zero(pw)) .or. &
(csf_i%stepvector(st) == 2 .and. near_zero(mw))) then
flag = .false.
return
end if
! full stop two lowering
case (excit_type%fullstop_lowering)
if (csf_i%stepvector(st) == 0 .or. csf_i%stepvector(en) /= 0 &
.or. csf_i%stepvector(ss) == 0) then
flag = .false.
return
end if
weights = init_singleWeight(csf_i, ss)
pw = weights%proc%plus(posSwitches(st), csf_i%B_real(st), weights%dat)
mw = weights%proc%minus(negSwitches(st), csf_i%B_real(st), weights%dat)
if (near_zero(mw + pw) .or. &
(csf_i%stepvector(st) == 1 .and. near_zero(pw)) .or. &
(csf_i%stepvector(st) == 2 .and. near_zero(mw))) then
flag = .false.
return
end if
! full stop two raising
case (excit_type%fullstop_raising)
if (csf_i%stepvector(st) == 3 .or. csf_i%stepvector(en) /= 3 .or. &
csf_i%stepvector(ss) == 3) then
flag = .false.
return
end if
weights = init_singleWeight(csf_i, ss)
pw = weights%proc%plus(posSwitches(st), csf_i%B_real(st), weights%dat)
mw = weights%proc%minus(negSwitches(st), csf_i%B_real(st), weights%dat)
if (near_zero(mw + pw) .or. &
(csf_i%stepvector(st) == 1 .and. near_zero(pw)) .or. &
(csf_i%stepvector(st) == 2 .and. near_zero(mw))) then
flag = .false.
return
end if
! full stop lowering into raising
case (excit_type%fullstop_L_to_R)
if (csf_i%stepvector(st) == 0 .or. csf_i%stepvector(ss) == 3 &
.or. csf_i%stepvector(en) == 0) then
flag = .false.
return
end if
if (t_approx_exchange .or. (t_approx_exchange_noninits .and. (.not. is_init_guga))) then
! the approximate exchange forces a switch of the
! spin-couplings at open-shell orbitals of the
! the exchange index. this is esp. problematic for the
! full-stop part, where we now have to enforce
! a delta-b = +-2 at the end index to ensure a
! flip is happening there..
! we need new weighting functions for that and also
! need to check the compatibility differently as
! the flips at the indices are enforced
weights = init_forced_end_semistart_weight(csf_i, ss, en, &
negSwitches(ss), posSwitches(ss), csf_i%B_real(ss))
else
weights = init_semiStartWeight(csf_i, ss, en, negSwitches(ss), &
posSwitches(ss), csf_i%B_real(ss))
end if
pw = weights%proc%plus(posSwitches(st), csf_i%B_real(st), weights%dat)
mw = weights%proc%minus(negSwitches(st), csf_i%B_real(st), weights%dat)
if (near_zero(mw + pw) .or. &
(csf_i%stepvector(st) == 1 .and. near_zero(pw)) .or. &
(csf_i%stepvector(st) == 2 .and. near_zero(mw))) then
flag = .false.
return
end if
! full stop raising into lowering
case (excit_type%fullstop_R_to_L)
if (csf_i%stepvector(ss) == 0 .or. csf_i%stepvector(st) == 3 &
.or. csf_i%stepvector(en) == 0) then
flag = .false.
return
end if
if (t_approx_exchange .or. (t_approx_exchange_noninits .and. (.not. is_init_guga))) then
! todo: the logic
weights = init_forced_end_semistart_weight(csf_i, ss, en, &
negSwitches(ss), posSwitches(ss), csf_i%B_real(ss))
else
weights = init_semiStartWeight(csf_i, ss, en, negSwitches(ss), &
posSwitches(ss), csf_i%B_real(ss))
end if
pw = weights%proc%plus(posSwitches(st), csf_i%B_real(st), weights%dat)
mw = weights%proc%minus(negSwitches(st), csf_i%B_real(st), weights%dat)
if (near_zero(mw + pw) .or. &
(csf_i%stepvector(st) == 1 .and. near_zero(pw)) .or. &
(csf_i%stepvector(st) == 2 .and. near_zero(mw))) then
flag = .false.
return
end if
! full start two lowering
case (excit_type%fullstart_lowering)
if (csf_i%stepvector(st) /= 3 .or. csf_i%stepvector(fe) == 3 &
.or. csf_i%stepvector(en) == 3) then
flag = .false.
return
end if
! in the actual excitation generation i use the the
! single weights here.. and this make more sense i must
! admit.
weights = init_singleWeight(csf_i, en)
! update! here i shouldnt use the real available switches for
! the double overlap region since switches are not allowed in
! this kind of excitation! -> just put in 0
! doesnt this mean i could just use the singles weight for
! the non-overlap region?
! and no.. i should check the weights of the single excitation
! region..
pw = weights%proc%plus(posSwitches(fe), csf_i%B_real(fe), weights%dat)
mw = weights%proc%minus(negSwitches(fe), csf_i%B_real(fe), weights%dat)
! only 0 deltab branch valid
if (near_zero(mw + pw) .or. &
(csf_i%stepvector(fe) == 1 .and. near_zero(pw)) .or. &
(csf_i%stepvector(fe) == 2 .and. near_zero(mw))) then
flag = .false.
return
end if
! full start two raising
case (excit_type%fullstart_raising)
if (csf_i%stepvector(st) /= 0 .or. csf_i%stepvector(fe) == 0 &
.or. csf_i%stepvector(en) == 0) then
flag = .false.
return
end if
! i can actually use just the singles weight..
weights = init_singleWeight(csf_i, en)
pw = weights%proc%plus(posSwitches(fe), csf_i%B_real(fe), weights%dat)
mw = weights%proc%minus(negSwitches(fe), csf_i%B_real(fe), weights%dat)
! only 0 deltab branch valid
if (near_zero(mw + pw) .or. &
(csf_i%stepvector(fe) == 1 .and. near_zero(pw)) .or. &
(csf_i%stepvector(fe) == 2 .and. near_zero(mw))) then
flag = .false.
return
end if
! full start lowering into raising
case (excit_type%fullStart_L_to_R)
if (csf_i%stepvector(st) == 0 .or. csf_i%stepvector(fe) == 3 &
.or. csf_i%stepvector(en) == 0) then
flag = .false.
return
end if
weights = init_fullStartWeight(csf_i, fe, en, negSwitches(fe), posSwitches(fe), &
csf_i%B_real(fe))
! then it is actually not a proper double excitation..
! and should not be considered here, as it is already
! contained in the single excitations
if (csf_i%stepvector(st) == 3) then
! but i need them for the exact excitation
! generation
zw = weights%proc%zero(0.0_dp, 0.0_dp, csf_i%B_real(st), weights%dat)
pw = 0.0_dp
mw = 0.0_dp
else
zw = weights%proc%zero(negSwitches(st), posSwitches(st), csf_i%B_real(st), &
weights%dat)
pw = weights%proc%plus(posSwitches(st), csf_i%B_real(st), weights%dat)
mw = weights%proc%minus(negSwitches(st), csf_i%B_real(st), weights%dat)
end if
if (near_zero(mw + pw + zw) .or. &
(csf_i%stepvector(st) == 1 .and. near_zero(zw + pw)) .or. &
(csf_i%stepvector(st) == 2 .and. near_zero(zw + mw)) .or. &
(csf_i%stepvector(st) == 3 .and. near_zero(zw))) then
flag = .false.
return
end if
! full start raising into lowering
case (excit_type%fullstart_R_to_L)
if (csf_i%stepvector(st) == 0 .or. csf_i%stepvector(en) == 3 &
.or. csf_i%stepvector(fe) == 0) then
flag = .false.
return
end if
weights = init_fullStartWeight(csf_i, fe, en, negSwitches(fe), posSwitches(fe), &
csf_i%B_real(fe))
! if its a 3 start no switches in overlap region are possible
if (csf_i%stepvector(st) == 3) then
zw = weights%proc%zero(0.0_dp, 0.0_dp, csf_i%B_real(st), weights%dat)
pw = 0.0_dp
mw = 0.0_dp
else
zw = weights%proc%zero(negSwitches(st), posSwitches(st), csf_i%B_real(st), &
weights%dat)
pw = weights%proc%plus(posSwitches(st), csf_i%B_real(st), weights%dat)
mw = weights%proc%minus(negSwitches(st), csf_i%B_real(st), weights%dat)
end if
if (near_zero(pw + mw + zw) .or. &
(csf_i%stepvector(st) == 1 .and. near_zero(zw + pw)) .or. &
(csf_i%stepvector(st) == 2 .and. near_zero(zw + mw)) .or. &
(csf_i%stepvector(st) == 3 .and. near_zero(zw))) then
flag = .false.
return
end if
! full start into full stop alike
case (excit_type%fullstart_stop_alike)
i = excitInfo%i
j = excitInfo%j
if (csf_i%stepvector(j) /= 3 .or. csf_i%stepvector(i) /= 0) then
flag = .false.
return
end if
! here i essentially do not need to check the weights..
! since no switch is possible anyway and there is only one
! connecting CSF..
weights = init_doubleWeight(csf_i, en)
zw = weights%proc%zero(negSwitches(st), posSwitches(st), csf_i%B_real(st), &
weights%dat)
! again only zero weight counts, as no others allowed.
if (near_zero(zw)) flag = .false.
! full start into full stop mixed
case (excit_type%fullstart_stop_mixed)
if (csf_i%stepvector(st) == 0 .or. csf_i%stepvector(en) == 0 &
.or. csf_i%stepvector(st) == 3 .or. &
csf_i%stepvector(en) == 3) then
flag = .false.
return
end if
if (t_approx_exchange .or. (t_approx_exchange_noninits .and. (.not. is_init_guga))) then
! the weights also change for fully-exchange type
weights = init_forced_end_exchange_weight(csf_i, en)
else
weights = init_doubleWeight(csf_i, en)
end if
zw = weights%proc%zero(negSwitches(st), posSwitches(st), csf_i%B_real(st), &
weights%dat)
pw = weights%proc%plus(posSwitches(st), csf_i%B_real(st), weights%dat)
mw = weights%proc%minus(negSwitches(st), csf_i%B_real(st), weights%dat)
! if only the 0 branch is non-zero, and both + and - branch are
! zero, we should abort too, since this means we would produce a
! diagonal contribution..
if (near_zero(mw + pw) .or. &
(csf_i%stepvector(st) == 1 .and. near_zero(zw + pw)) .or. &
(csf_i%stepvector(st) == 2 .and. near_zero(zw + mw)) .or. &
(csf_i%stepvector(st) == 3 .and. near_zero(zw))) then
flag = .false.
return
end if
end select
if (present(opt_weight)) opt_weight = weights
end subroutine checkCompatibility