adjoint_sltcnd_2 Function

private function adjoint_sltcnd_2(nI, ex, tSign, assert_occupation) result(hel)

returns the adjoint sltcnd of the given rank: 2

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nI(nel)
type(Excite_2_t), intent(in) :: ex
logical, intent(in) :: tSign
logical, intent(in), optional :: assert_occupation

Return Value real(kind=dp)


Contents

Source Code


Source Code

    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