gen_crude_guga_single_3 Subroutine

private subroutine gen_crude_guga_single_3(nI, csf_i, orb_i, cc_i, cum_arr)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nI(nel)
type(CSF_Info_t), intent(in) :: csf_i
integer, intent(in) :: orb_i
integer, intent(in) :: cc_i
real(kind=dp), intent(out) :: cum_arr(OrbClassCount(cc_i))

Contents


Source Code

    subroutine gen_crude_guga_single_3(nI, csf_i, orb_i, cc_i, cum_arr)
        integer, intent(in) :: nI(nel)
        type(CSF_Info_t), intent(in) :: csf_i
        integer, intent(in) :: orb_i, cc_i
        real(dp), intent(out) :: cum_arr(OrbClassCount(cc_i))

        integer :: nOrb, i, label_index, j, n_id(nEl), id_i, s_orb
        real(dp) :: cum_sum, hel

        nOrb = OrbClassCount(cc_i)
        label_index = SymLabelCounts2(1, cc_i)
        n_id = gtID(nI)
        id_i = gtID(orb_i)

        cum_sum = 0.0_dp

        do i = 1, nOrb
            s_orb = sym_label_list_spat(label_index + i - 1)

            if (s_orb == id_i) then
                cum_arr(i) = cum_sum
                cycle
            end if

            hel = 0.0_dp

            select case (csf_i%stepvector(s_orb))
            case (0)

                hel = hel + abs(GetTMatEl(orb_i, 2 * s_orb))

                hel = hel + abs(get_umat_el(id_i, id_i, s_orb, id_i))

                do j = 1, nEl

                    ! todo: finish all contributions later for now only do
                    ! those which are the same for all
                    ! exclude initial orbital, since this case gets
                    ! contributed already outside of loop over electrons!
                    ! but only spin-orbital or spatial??
                    if (n_id(j) == id_i) cycle
                    hel = hel + abs(get_umat_el(id_i, n_id(j), s_orb, n_id(j)))
                    hel = hel + abs(get_umat_el(id_i, n_id(j), n_id(j), s_orb))

                end do

            case (1)
                ! no restrictions for 2 -> 1 excitations
                hel = hel + abs(GetTMatEl(orb_i, 2 * s_orb))
                ! do the loop over all the other electrons

                hel = hel + abs(get_umat_el(id_i, s_orb, s_orb, s_orb))
                hel = hel + abs(get_umat_el(id_i, id_i, s_orb, id_i))

                do j = 1, nEl
                    ! todo: finish all contributions later for now only do
                    ! those which are the same for all
                    if (n_id(j) == id_i .or. n_id(j) == s_orb) cycle
                    hel = hel + abs(get_umat_el(id_i, n_id(j), s_orb, n_id(j)))
                    hel = hel + abs(get_umat_el(id_i, n_id(j), n_id(j), s_orb))

                end do

            case (2)

                hel = hel + abs(GetTMatEl(orb_i, 2 * s_orb))
                ! do the loop over all the other electrons
                ! (is this always symmetrie allowed?..)

                hel = hel + abs(get_umat_el(id_i, id_i, s_orb, id_i))
                hel = hel + abs(get_umat_el(id_i, s_orb, s_orb, s_orb))

                do j = 1, nEl

                    ! todo: finish all contributions later for now only do
                    ! those which are the same for all
                    if (n_id(j) == id_i .or. n_id(j) == s_orb) cycle

                    hel = hel + abs(get_umat_el(id_i, n_id(j), s_orb, n_id(j)))
                    hel = hel + abs(get_umat_el(id_i, n_id(j), n_id(j), s_orb))

                end do

            end select

            cum_sum = cum_sum + abs_l1(hel)
            cum_arr(i) = cum_sum

        end do

    end subroutine gen_crude_guga_single_3