gen_excit_k_space_hub_transcorr_test Subroutine

public subroutine gen_excit_k_space_hub_transcorr_test(nI, ilutI, nJ, ilutJ, exFlag, ic, ex, tParity, pGen, hel, store, run)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nI(nel)
integer(kind=n_int), intent(in) :: ilutI(0:NIfTot)
integer, intent(out) :: nJ(nel)
integer(kind=n_int), intent(out) :: ilutJ(0:NifTot)
integer, intent(in) :: exFlag
integer, intent(out) :: ic
integer, intent(out) :: ex(2,maxExcit)
logical, intent(out) :: tParity
real(kind=dp), intent(out) :: pGen
real(kind=dp), intent(out) :: hel
type(excit_gen_store_type), intent(inout), target :: store
integer, intent(in), optional :: run

Contents


Source Code

    subroutine gen_excit_k_space_hub_transcorr_test(nI, ilutI, nJ, ilutJ, exFlag, ic, &
                                                    ex, tParity, pGen, hel, store, run)

        integer, intent(in) :: nI(nel), exFlag
        integer(n_int), intent(in) :: ilutI(0:NIfTot)
        integer, intent(out) :: nJ(nel), ic
        integer, intent(out) :: ex(2, maxExcit)
        integer(n_int), intent(out) :: ilutJ(0:NifTot)
        real(dp), intent(out) :: pGen
        logical, intent(out) :: tParity
        HElement_t(dp), intent(out) :: hel
        type(excit_gen_store_type), intent(inout), target :: store
        integer, intent(in), optional :: run
        integer :: temp_ex(2, 3)

        if (genrand_real2_dsfmt() < pDoubles) then
            if (genrand_real2_dsfmt() < pParallel) then
                ! do a parallel triple excitation, coming from the triples..
                call gen_parallel_double_hubbard(nI, ilutI, nJ, ilutJ, ex, tParity, pgen)
                ic = 2
                pgen = pgen * pDoubles * pParallel
            else
                ! do a "normal" hubbard k-space excitation
                call gen_excit_k_space_hub(nI, ilutI, nJ, ilutJ, exFlag, ic, &
                                           ex, tParity, pGen, hel, store, run)

                pgen = pgen * pDoubles * (1.0_dp - pParallel)
            end if
        else
            ! otherwise to a triple..
            call gen_triple_hubbard(nI, ilutI, nJ, ilutJ, temp_ex, tParity, pgen)
            ic = 3
            pgen = pgen * (1.0_dp - pDoubles)

        end if

    end subroutine gen_excit_k_space_hub_transcorr_test