setup_weight_funcs Subroutine

private subroutine setup_weight_funcs(t, csf_i, st, se, weight_funcs)

Arguments

Type IntentOptional Attributes Name
integer(kind=n_int), intent(in) :: t(0:nifguga)
type(CSF_Info_t), intent(in) :: csf_i
integer, intent(in) :: st
integer, intent(in) :: se
type(BranchWeightArr_t), intent(out) :: weight_funcs(nSpatOrbs)

Contents

Source Code


Source Code

    subroutine setup_weight_funcs(t, csf_i, st, se, weight_funcs)
        integer(n_int), intent(in) :: t(0:nifguga)
        type(CSF_Info_t), intent(in) :: csf_i
        integer, intent(in) :: st, se
        type(BranchWeightArr_t), intent(out) :: weight_funcs(nSpatOrbs)

        integer :: i, step, delta_b(nSpatOrbs)

        delta_b = int(csf_i%B_real - calcB_vector_ilut(t(0:nifd)))

        ! i know that a start was possible -> only check what the excitation
        ! stepvalue is
        ! damn.. where are my notes? im not sure about that..
        if (isOne(t, st)) then
            weight_funcs(st)%ptr => minus_start_single
        else if (isTwo(t, st)) then
            weight_funcs(st)%ptr => plus_start_single
            ! i also need to consider an non-choosing start or deal with
            ! that in the routines above..
        end if

        do i = st + 1, se - 1
            if (csf_i%Occ_int(i) /= 1) cycle

            step = csf_i%stepvector(i)

            if (step == 1 .and. delta_b(i - 1) == -1) then
                if (isOne(t, i)) then
                    weight_funcs(i)%ptr => minus_staying_single
                else
                    weight_funcs(i)%ptr => minus_switching_single
                end if
            else if (step == 2 .and. delta_b(i - 1) == 1) then
                if (isTwo(t, i)) then
                    weight_funcs(i)%ptr => plus_staying_single
                else
                    weight_funcs(i)%ptr => plus_switching_single
                end if
                ! here i need a one-prob. if no switch was possible.. damn..
            else
                weight_funcs(i)%ptr => probability_one
            end if

        end do

        ! similar to the start, only need to check  the stepvalue of the
        ! excitaiton, since we know something must have worked
        if (isOne(t, se)) then
            if (delta_b(se - 1) == -1) then
                weight_funcs(se)%ptr => minus_start_double
            else
                weight_funcs(se)%ptr => zero_plus_start_double
            end if
        else if (isTwo(t, se)) then
            if (delta_b(se - 1) == -1) then
                weight_funcs(se)%ptr => zero_minus_start_double
            else
                weight_funcs(se)%ptr => plus_start_double
            end if
        end if

        do i = se + 1, nSpatOrbs
            if (csf_i%Occ_int(i) /= 1) cycle

            step = csf_i%stepvector(i)

            ! also combine step and deltab value in a select case statement
            select case (delta_b(i - 1) + step)
            case (1)
                ! d=1 + b=0 : 1
                if (isOne(t, i)) then
                    weight_funcs(i)%ptr => zero_plus_staying_double
                else
                    weight_funcs(i)%ptr => zero_plus_switching_double
                end if
            case (2)
                ! d=2 + b=0 :2
                if (isTwo(t, i)) then
                    weight_funcs(i)%ptr => zero_minus_staying_double
                else
                    weight_funcs(i)%ptr => zero_minus_switching_double
                end if

            case (-1)
                if (isOne(t, i)) then
                    weight_funcs(i)%ptr => minus_staying_double
                else
                    weight_funcs(i)%ptr => minus_switching_double
                end if

            case (4)
                if (isTwo(t, i)) then
                    weight_funcs(i)%ptr => plus_staying_double
                else
                    weight_funcs(i)%ptr => plus_switching_double
                end if

                ! i also need a case default to prob 1. for a no-choice..
            case default
                weight_funcs(i)%ptr => probability_one

            end select
        end do

    end subroutine setup_weight_funcs