pgen_select_orb_guga_mol Subroutine

private subroutine pgen_select_orb_guga_mol(csf_i, occ_orbs, orb_b, orb_a, cpt, cum_sum, orb_res, range_flag)

Arguments

Type IntentOptional Attributes Name
type(CSF_Info_t), intent(in) :: csf_i
integer, intent(in) :: occ_orbs(2)
integer, intent(in) :: orb_b
integer, intent(in) :: orb_a
real(kind=dp), intent(out) :: cpt
real(kind=dp), intent(out) :: cum_sum
integer, intent(in), optional :: orb_res
logical, intent(in), optional :: range_flag

Contents


Source Code

    subroutine pgen_select_orb_guga_mol(csf_i, occ_orbs, orb_b, orb_a, cpt, &
                                        cum_sum, orb_res, range_flag)
        ! routine to recalculate the pgen contribution if orbital (a) and (b)
        ! could have been picked in the opposite order
        ! additional GUGA-restrictions on orbitals are again dealt with
        ! optional input paramters
        type(CSF_Info_t), intent(in) :: csf_i
        integer, intent(in) :: occ_orbs(2), orb_b, orb_a
        real(dp), intent(out) :: cpt, cum_sum
        integer, intent(in), optional :: orb_res
        logical, intent(in), optional :: range_flag
        character(*), parameter :: this_routine = "pgen_select_orb_guga_mol"

        integer :: cc_a, label_index, nOrbs, i, orb
        real(dp) :: tmp
        logical :: tSingle

        ! first get the orbitals from the correct symmetry
        ! again have to settle on a certain spin -> if beta spin was occupied
        ! originally for a -> take alpha spin component
        ! otherwise choose beta
        ! UPDATE: change to only pick spatial orbitals -> only check if orbital
        ! was singly occupied
        if (csf_i%Occ_int(orb_b) == 1) then
            ! then i have to exclude orb_a in the recalculation of p(a|b) prob
            tSingle = .true.
        else
            tSingle = .false.
        end if

        ! need all allowed orbitals independent of actual "spin" of
        ! target orbita
        cc_a = ClassCountInd(2 * orb_a)

        label_index = SymLabelCounts2(1, cc_a)

        nOrbs = OrbClassCount(cc_a)

        cum_sum = 0.0_dp

        if (present(range_flag)) then
            ! if range flag is present, orb_b is already off-limits so no
            ! need to take tSingle into account
            ASSERT(present(orb_res))
            ASSERT(orb_res /= 0)

            if (orb_res < 0) then
                ! only orbitals below restriction
                do i = 1, nOrbs

                    orb = sym_label_list_spat(label_index + i - 1)

                    if (csf_i%stepvector(orb) /= 3 .and. orb < -orb_res) then

                        tmp = get_guga_integral_contrib(occ_orbs, orb_b, orb)

                        cum_sum = cum_sum + tmp
                        if (orb == orb_a) cpt = tmp
                    end if
                end do

            else
                ! only orbitals above restriction
                do i = 1, nOrbs
                    orb = sym_label_list_spat(label_index + i - 1)
                    if (csf_i%stepvector(orb) /= 3 .and. orb > orb_res) then
                        tmp = get_guga_integral_contrib(occ_orbs, orb_b, orb)

                        cum_sum = cum_sum + tmp
                        if (orb == orb_a) cpt = tmp
                    end if
                end do
            end if
        else
            if (present(orb_res)) then
                ASSERT(orb_res /= 0)
                ASSERT(orb_res > 0)
                ! the orbital associated with orb_res is off-limits

                ! also consider if orb b is singly occupied
                if (tSingle) then
                    do i = 1, nOrbs
                        orb = sym_label_list_spat(label_index + i - 1)

                        if (csf_i%stepvector(orb) /= 3 .and. orb /= orb_res &
                            .and. orb /= orb_b) then

                            tmp = get_guga_integral_contrib(occ_orbs, orb_b, orb)

                            cum_sum = cum_sum + tmp
                            if (orb == orb_a) cpt = tmp
                        end if
                    end do
                else
                    ! orb b is also allowed!
                    do i = 1, nOrbs
                        orb = sym_label_list_spat(label_index + i - 1)

                        if (csf_i%stepvector(orb) /= 3 .and. orb /= orb_res) then

                            tmp = get_guga_integral_contrib(occ_orbs, orb_b, orb)

                            cum_sum = cum_sum + tmp
                            if (orb == orb_a) cpt = tmp
                        end if
                    end do
                end if
            else
                ! no restrictions execpt single occupancy maybe
                if (tSingle) then
                    do i = 1, nOrbs
                        orb = sym_label_list_spat(label_index + i - 1)

                        if (csf_i%stepvector(orb) /= 3 .and. orb /= orb_b) then

                            tmp = get_guga_integral_contrib(occ_orbs, orb_b, orb)

                            cum_sum = cum_sum + tmp
                            if (orb == orb_a) cpt = tmp
                        end if
                    end do
                else
                    do i = 1, nOrbs
                        orb = sym_label_list_spat(label_index + i - 1)

                        if (csf_i%stepvector(orb) /= 3) then
                            tmp = get_guga_integral_contrib(occ_orbs, orb_b, orb)

                            cum_sum = cum_sum + tmp

                            if (orb == orb_a) cpt = tmp
                        end if
                    end do
                end if
            end if
        end if

    end subroutine pgen_select_orb_guga_mol