returns the adjoint sltcnd of the given rank: 2
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | nI(nel) | |||
type(Excite_2_t), | intent(in) | :: | ex | |||
logical, | intent(in) | :: | tSign | |||
logical, | intent(in), | optional | :: | assert_occupation |
HElement_t(dp) function adjoint_sltcnd_2(nI, ex, tSign, assert_occupation) result(hel)
!! returns the adjoint sltcnd of the given rank: 2
integer, intent(in) :: nI(nel)
type(Excite_2_t), intent(in) :: ex
logical, intent(in) :: tSign
logical, intent(in), optional :: assert_occupation
integer :: nJ(nel)
type(Excite_2_t) :: adj_exc
routine_name("adjoint_sltcnd_2")
! reverse excitation matrix and pass it to a new excitation object
#ifdef DEBUG_
block
use constants, only: stderr
use util_mod, only: stop_all
logical :: test_occupation
if (present(assert_occupation)) then
test_occupation = assert_occupation
else
test_occupation = .true.
end if
if (test_occupation) then
if (.not. occupation_allowed(nI, ex)) then
write(stderr, *) 'src', ex%val(1, :)
write(stderr, *) 'tgt', ex%val(2, :)
write(stderr, *) 'nI', nI
call stop_all(this_routine, "Not allowed by occupation.")
end if
end if
end block
#endif
adj_exc%val(1, :) = ex%val(2, :)
adj_exc%val(2, :) = ex%val(1, :)
nJ = dyn_nI_excite(nI, ex)
hel = nonadjoint_sltcnd_2(nJ, adj_exc, tSign)
#ifdef CMPLX_
hel = conjg(hel)
#endif
end function adjoint_sltcnd_2