calc_remaining_excit_info Function

private function calc_remaining_excit_info(typ, a, i, b, j) result(excitInfo)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: typ
integer, intent(in) :: a
integer, intent(in) :: i
integer, intent(in) :: b
integer, intent(in) :: j

Return Value type(ExcitationInformation_t)


Contents


Source Code

    function calc_remaining_excit_info(typ, a, i, b, j) result(excitInfo)
        debug_function_name("calc_remaining_excit_info")
        integer, intent(in) :: typ, a, i, b, j
        type(ExcitationInformation_t) :: excitInfo

        integer :: gen1, gen2, currentGen, firstGen, lastGen, fullstart, &
                   secondStart, firstEnd, fullEnd, weight, excitLvl, overlap
        real(dp) :: order, order1

#ifdef DEBUG_
        select case(typ)
        case( excit_type%single_overlap_L_to_R)
        case( excit_type%single_overlap_R_to_L )
        case( excit_type%double_lowering )
        case( excit_type%double_raising )
        case( excit_type%double_L_to_R_to_L)
        case( excit_type%double_R_to_L_to_R )
        case( excit_type%double_L_to_R )
        case( excit_type%double_R_to_L )
        case( excit_type%fullstop_lowering )
        case( excit_type%fullstop_raising )
        case( excit_type%fullstop_L_to_R )
        case( excit_type%fullstop_R_to_L )
        case( excit_type%fullstart_lowering)
        case( excit_type%fullstart_raising)
        case( excit_type%fullstart_L_to_R)
        case( excit_type%fullstart_R_to_L)
        case( excit_type%fullstart_stop_alike)
        case( excit_type%fullstart_stop_mixed)
        case default
            print *, "incorrect typ: ", excit_names(typ)
            call stop_all(this_routine, "see above")
        end select
#endif

        ASSERT(a > 0 .and. a <= nSpatOrbs)
        ASSERT(i > 0 .and. i <= nSpatOrbs)
        ASSERT(b > 0 .and. b <= nSpatOrbs)
        ASSERT(j > 0 .and. j <= nSpatOrbs)

        ! do the necessary recomputation of excitInfo entries
        ! in Debug mode also check if the indices are correct!
        ! and for now assume that this function gets only called in the
        ! pchb list creation, which quite restricts the indices.
        ! this might need to be changed in the future, but for now it is
        ! good to also ensure the PCHB lists are created correctly!

        ! set up some defaults which are only changed if necessary:

        weight = 0
        ! fuck this excitLvl info is so stupid... i need to change that :(
        excitLvl = 2
        order = 1.0_dp
        order1 = 1.0_dp

        select case (typ)

        case ( excit_type%single_overlap_L_to_R )

            ASSERT(a == b)
            ASSERT(i < j)
            ASSERT(a > i .and. a < j)

            gen1        = gen_type%L
            gen2        = gen_type%R
            currentGen  = gen_type%L
            firstGen    = gen_type%L
            lastGen     = gen_type%R
            fullstart   = i
            secondStart = a
            firstEnd    = a
            fullEnd     = j
            overlap     = 1



        case ( excit_type%single_overlap_R_to_L )

            ASSERT(i == j)
            ASSERT(a < b)
            ASSERT( i > a .and. i < b)

            gen1        = gen_type%R
            gen2        = gen_type%L
            currentGen  = gen_type%R
            firstGen    = gen_type%R
            lastGen     = gen_type%L
            fullstart   = a
            secondStart = i
            firstEnd    = i
            fullEnd     = b
            overlap     = 1

        case ( excit_type%double_lowering )

            ASSERT(i < j)
            ASSERT(j < a)
            ASSERT(a < b)

            gen1        = gen_type%L
            gen2        = gen_type%L
            currentGen  = gen_type%L
            firstGen    = gen_type%L
            lastGen     = gen_type%L
            fullstart   = i
            secondStart = j
            firstEnd    = a
            fullEnd     = b
            overlap     = firstEnd - secondStart + 1


        case ( excit_type%double_raising )

            ! in this assignment i switch to E_{bj}E_{ai} assignement to
            ! ensure 'correct' sign convention of the x1 coupling coeffs!
            ASSERT(b < a)
            ASSERT(a < j)
            ASSERT(j < i)

            gen1        = gen_type%R
            gen2        = gen_type%R
            currentGen  = gen_type%R
            firstGen    = gen_type%R
            lastGen     = gen_type%R
            fullstart   = b
            secondStart = a
            firstEnd    = j
            fullEnd     = i

            overlap     = firstEnd - secondStart + 1

        case ( excit_type%double_L_to_R_to_L )
            ! here we switch to E_{aj}E_{bi}

            ASSERT( j < a )
            ASSERT( a < i )
            ASSERT( i < b )

            gen1        = gen_type%R
            gen2        = gen_type%L
            currentGen  = gen_type%L
            firstGen    = gen_type%L
            lastGen     = gen_type%L
            fullstart   = j
            secondStart = a
            firstEnd    = i
            fullEnd     = b

            overlap     = firstEnd - secondStart + 1


        case ( excit_type%double_R_to_L_to_R )

            ! switch to E_{aj}E_{bi}
            ASSERT( a < j )
            ASSERT( j < b )
            ASSERT( b < i )

            gen1        = gen_type%R
            gen2        = gen_type%L
            currentGen  = gen_type%R
            firstGen    = gen_type%R
            lastGen     = gen_type%R
            fullstart   = a
            secondStart = j
            firstEnd    = b
            fullEnd     = i

            overlap = firstEnd - secondStart + 1

        case ( excit_type%double_L_to_R )

            ! switch to E_{aj}E_{bi}
            ASSERT( j < a )
            ASSERT( a < b )
            ASSERT( b < i )

            gen1        = gen_type%R
            gen2        = gen_type%L
            currentGen  = gen_type%L
            firstGen    = gen_type%L
            lastGen     = gen_type%R
            fullstart   = j
            secondStart = a
            firstEnd    = b
            fullEnd     = i

            overlap = firstEnd - secondStart + 1


        case ( excit_type%double_R_to_L )

            ! switch to E_{aj}E_{bi}
            ASSERT( a < j )
            ASSERT( j < i )
            ASSERT( i < b )

            gen1        = gen_type%R
            gen2        = gen_type%L
            currentGen  = gen_type%R
            firstGen    = gen_type%R
            lastGen     = gen_type%L
            fullstart   = a
            secondStart = j
            firstEnd    = i
            fullEnd     = b

            overlap = firstEnd - secondStart + 1


        case ( excit_type%fullstop_lowering )

            ASSERT( i < j )
            ASSERT( j < a )
            ASSERT( a == b )

            gen1        = gen_type%L
            gen2        = gen_type%L
            currentGen  = gen_type%L
            firstGen    = gen_type%L
            lastGen     = gen_type%L
            fullstart   = i
            secondStart = j
            firstEnd    = a
            fullEnd     = a

            overlap = firstEnd - secondStart + 1


        case ( excit_type%fullstop_raising )

            ASSERT(a < b )
            ASSERT(b < i )
            ASSERT(i == j)

            gen1        = gen_type%R
            gen2        = gen_type%R
            currentGen  = gen_type%R
            firstGen    = gen_type%R
            lastGen     = gen_type%R
            fullstart   = a
            secondStart = b
            firstEnd    = i
            fullEnd     = i

            overlap = firstEnd - secondStart + 1


        case ( excit_type%fullstop_R_to_L )

            ! switch to E_{aj}E_{bi}
            ASSERT(a < j )
            ASSERT(j < b )
            ASSERT(b == i )

            gen1        = gen_type%R
            gen2        = gen_type%L
            currentGen  = gen_type%R
            firstGen    = gen_type%R
            lastGen     = gen_type%L
            fullstart   = a
            secondStart = j
            firstEnd    = b
            fullEnd     = b

            overlap = firstEnd - secondStart + 1


        case ( excit_type%fullstop_L_to_R )

            ! switch to E_{aj}E_{bi}
            ASSERT( j < a )
            ASSERT( a < b )
            ASSERT( b == i )

            gen1        = gen_type%R
            gen2        = gen_type%L
            currentGen  = gen_type%L
            firstGen    = gen_type%L
            lastGen     = gen_type%R
            fullstart   = j
            secondStart = a
            firstEnd    = b
            fullEnd     = b

            overlap = firstEnd - secondStart + 1


        case ( excit_type%fullstart_lowering )

            ASSERT( i == j)
            ASSERT( j < a )
            ASSERT( a < b )

            gen1        = gen_type%L
            gen2        = gen_type%L
            currentGen  = gen_type%L
            firstGen    = gen_type%L
            lastGen     = gen_type%L
            fullstart   = i
            secondStart = i
            firstEnd    = a
            fullEnd     = b

            overlap = firstEnd - secondStart + 1


        case ( excit_type%fullstart_raising )

            ASSERT( a == b )
            ASSERT( b < i )
            ASSERT( i < j )

            gen1        = gen_type%R
            gen2        = gen_type%R
            currentGen  = gen_type%R
            firstGen    = gen_type%R
            lastGen     = gen_type%R
            fullstart   = a
            secondStart = a
            firstEnd    = i
            fullEnd     = j

            overlap = firstEnd - secondStart + 1


        case ( excit_type%fullstart_L_to_R )

            ! switch to E_{aj} E_{bi}
            ASSERT( a == j )
            ASSERT( j < b )
            ASSERT( b < i )

            gen1        = gen_type%R
            gen2        = gen_type%L
            currentGen  = gen_type%R
            firstGen    = gen_type%L
            lastGen     = gen_type%R
            fullstart   = a
            secondStart = a
            firstEnd    = b
            fullEnd     = i

            overlap = firstEnd - secondStart + 1


        case ( excit_type%fullstart_R_to_L )

            ! switch to E_{aj}E_{bi}
            ASSERT( a == j )
            ASSERT( j < i )
            ASSERT( i < b )

            gen1        = gen_type%R
            gen2        = gen_type%L
            currentGen  = gen_type%L
            firstGen    = gen_type%R
            lastGen     = gen_type%L
            fullstart   = a
            secondStart = a
            firstEnd    = i
            fullEnd     = b

            overlap = firstEnd - secondStart + 1


        case ( excit_type%fullstart_stop_alike )

            ! here i need if statement..

            ASSERT( i == j )
            ASSERT( a == b )
            ASSERT( a /= i )

            if (a < i) then
                gen1 = gen_type%R
            else if (a > i) then
                gen1 = gen_type%L
            end if

            gen2        = gen1
            currentGen  = gen1
            firstGen    = gen1
            lastGen     = gen1
            fullstart   = min(i,a)
            secondStart = min(i,a)
            firstEnd    = max(i,a)
            fullEnd     = max(i,a)

            overlap = firstEnd - secondStart + 1

        case ( excit_type%fullstart_stop_mixed )

            ! switch to E_{aj}E_{bi}
            ASSERT(a == j)
            ASSERT(b == i)
            ASSERT(a /= b)

            gen1        = gen_type%R
            gen2        = gen_type%L
            currentGen  = gen_type%R
            firstGen    = gen_type%R
            lastGen     = gen_type%R
            fullstart   = min(a,i)
            secondStart = min(a,i)
            firstEnd    = max(a,i)
            fullEnd     = max(a,i)

            overlap = firstEnd - secondStart + 1

        end select

        excitInfo = assign_excitInfo_values_exact(typ, gen1, gen2, currentGen, &
            firstGen, lastGen, a, i, b, j, fullstart, secondStart, firstEnd, &
            fullEnd, weight, excitLvl, order, order1, overlap)

    end function calc_remaining_excit_info