calc_fullstart_fullstop_alike_ex Subroutine

private pure subroutine calc_fullstart_fullstop_alike_ex(csf_i, excitInfo, mat_ele, t_hamil, rdm_ind, rdm_mat)

Arguments

Type IntentOptional Attributes Name
type(CSF_Info_t), intent(in) :: csf_i
type(ExcitationInformation_t), intent(in) :: excitInfo
real(kind=dp), intent(out) :: mat_ele
logical, intent(in), optional :: t_hamil
integer(kind=int_rdm), intent(out), optional, allocatable :: rdm_ind(:)
real(kind=dp), intent(out), optional, allocatable :: rdm_mat(:)

Contents


Source Code

    pure subroutine calc_fullstart_fullstop_alike_ex(csf_i, excitInfo, &
                                                mat_ele, t_hamil, rdm_ind, rdm_mat)
        type(CSF_Info_t), intent(in) :: csf_i
        type(ExcitationInformation_t), intent(in) :: excitInfo
        HElement_t(dp), intent(out) :: mat_ele
        logical, intent(in), optional :: t_hamil
        integer(int_rdm), intent(out), allocatable, optional :: rdm_ind(:)
        real(dp), intent(out), allocatable, optional :: rdm_mat(:)
        character(*), parameter :: this_routine = "calc_fullstart_fullstop_alike_ex"

        real(dp) :: nOpen, guga_mat
        HElement_t(dp) :: umat
        logical :: t_hamil_

        def_default(t_hamil_, t_hamil, .true.)
        ASSERT(present(rdm_ind) .eqv. present(rdm_mat))

        ! set defaults for early exit
        mat_ele = h_cast(0.0_dp)

        associate (ii => excitInfo%i, jj => excitInfo%j, kk => excitInfo%k, &
                   ll => excitInfo%l, start => excitInfo%fullStart, &
                   ende => excitInfo%fullEnd)

            if (present(rdm_ind) .and. present(rdm_mat)) then
                allocate(rdm_ind(1), source=0_int_rdm)
                allocate(rdm_mat(1), source=0.0_dp)
                ! only one element here, since indices are the same
                rdm_ind(1) = contract_2_rdm_ind(ii, jj, kk, ll)
            end if

            if (t_hamil_) then
                umat = get_umat_el(ii, ii, jj, jj) / 2.0_dp
            else
                umat = h_cast(1.0_dp)
            end if

            if (t_hamil_ .and. near_zero(umat)) return

            nOpen = real(count_open_orbs_ij(csf_i, start, ende), dp)

            guga_mat = 2.0_dp * (-1.0_dp)**nOpen
            mat_ele = guga_mat * umat

            if (present(rdm_mat)) rdm_mat = guga_mat

        end associate

    end subroutine calc_fullstart_fullstop_alike_ex