calcSingleOverlapMixedStochastic Subroutine

public subroutine calcSingleOverlapMixedStochastic(ilut, csf_i, excitInfo, t, branch_pgen, posSwitches, negSwitches, opt_weight)

Arguments

Type IntentOptional Attributes Name
integer(kind=n_int), intent(in) :: ilut(0:nifguga)
type(CSF_Info_t), intent(in) :: csf_i
type(ExcitationInformation_t), intent(inout) :: excitInfo
integer(kind=n_int), intent(out) :: t(0:nifguga)
real(kind=dp), intent(out) :: branch_pgen
real(kind=dp), intent(in) :: posSwitches(nSpatOrbs)
real(kind=dp), intent(in) :: negSwitches(nSpatOrbs)
type(WeightObj_t), intent(in), optional :: opt_weight

Contents


Source Code

    subroutine calcSingleOverlapMixedStochastic(ilut, csf_i, excitInfo, t, branch_pgen, &
                                                posSwitches, negSwitches, opt_weight)
        integer(n_int), intent(in) :: ilut(0:nifguga)
        type(CSF_Info_t), intent(in) :: csf_i
        type(ExcitationInformation_t), intent(inout) :: excitInfo
        integer(n_int), intent(out) :: t(0:nifguga)
        real(dp), intent(out) :: branch_pgen
        real(dp), intent(in) :: posSwitches(nSpatOrbs), negSwitches(nSpatOrbs)
        type(WeightObj_t), intent(in), optional :: opt_weight
        character(*), parameter :: this_routine = "calcSingleOverlapMixedStochastic"

        type(WeightObj_t) :: weights
        real(dp) :: tempWeight, bVal, temp_pgen
        HElement_t(dp) :: umat
        integer :: iOrb, deltaB

        ! first check the umat element, although if picked correctly it should
        ! be non-zero anyway, there are only 2 symmetric contributions to this
        ! so the 1/2 in the 2-electron part of the hamiltonian get cancelled
        ! and actually have to check type of excitation here...
        ! have to settle on what the multiple picked orbitals is... so
        ! i would not need an if statement here to determine the type of gens
        !todo: can make that without if statement here by using correct ijkl

        if (excitInfo%typ == excit_type%single_overlap_L_to_R) then

            umat = (get_umat_el(excitInfo%firstEnd, excitInfo%secondStart, &
                                excitInfo%fullStart, excitInfo%fullEnd) + &
                    get_umat_el(excitInfo%secondStart, excitInfo%firstEnd, &
                                excitInfo%fullEnd, excitInfo%fullStart)) / 2.0_dp

        else if (excitInfo%typ == excit_type%single_overlap_R_to_L) then

            umat = (get_umat_el(excitInfo%fullStart, excitInfo%fullEnd, &
                                excitInfo%firstEnd, excitInfo%secondStart) + &
                    get_umat_el(excitInfo%fullEnd, excitInfo%fullStart, &
                                excitInfo%secondStart, excitInfo%firstEnd)) / 2.0_dp
        else
            call stop_all(this_routine, "shouldnt be here!")
        end if

        ! todo : correct sum of contributing 2-body integrals and correct
        ! indexing!
        if (near_zero(umat)) then
            branch_pgen = 0.0_dp
            t = 0_n_int
            return
        end if

        ! in the mixed single overlap case its just like a regular single
        ! excitation except the special change in stepvector at the
        ! single overlap site!
        if (present(opt_weight)) then
            weights = opt_weight
        else
            weights = init_singleWeight(csf_i, excitInfo%fullEnd)
        end if

        call createStochasticStart_single(ilut, csf_i, excitInfo, weights, posSwitches, &
                                          negSwitches, t, branch_pgen)

        ! check if weights were 0
        check_abort_excit(branch_pgen, t)

        do iOrb = excitInfo%fullStart + 1, excitInfo%secondStart - 1
            call singleStochasticUpdate(ilut, csf_i, iOrb, excitInfo, weights, posSwitches, &
                                        negSwitches, t, temp_pgen)
            ! check and update weights
            branch_pgen = branch_pgen * temp_pgen

            check_abort_excit(branch_pgen, t)
        end do

        iOrb = excitInfo%secondStart
        bVal = csf_i%B_real(iOrb)

        deltaB = getDeltaB(t)

        if (excitInfo%firstGen == gen_type%L) then
            ! lowering gen ends here
            ASSERT(isZero(ilut, iOrb))

            ! have to get double excitation matrix elements in here..
            call getDoubleMatrixElement(3, 0, deltaB, excitInfo%firstGen, &
                                        excitInfo%lastGen, bVal, 1.0_dp, tempWeight)

            ! change 0 -> 3
            set_orb(t, 2 * iOrb)
            set_orb(t, 2 * iOrb - 1)

        else
            ! raising gen ends here
            ASSERT(isThree(ilut, iOrb))

            call getDoubleMatrixElement(0, 3, deltaB, excitInfo%firstGen, &
                                        excitInfo%lastGen, bVal, 1.0_dp, tempWeight)

            ! change 3 -> 0
            clr_orb(t, 2 * iOrb)
            clr_orb(t, 2 * iOrb - 1)

        end if
        excitInfo%currentGen = excitInfo%lastGen

        do iOrb = excitInfo%secondStart + 1, excitInfo%fullEnd - 1
            call singleStochasticUpdate(ilut, csf_i, iOrb, excitInfo, weights, posSwitches, &
                                        negSwitches, t, temp_pgen)
            ! check and update weights
            branch_pgen = branch_pgen * temp_pgen

            check_abort_excit(branch_pgen, t)
        end do

        call singleStochasticEnd(csf_i, excitInfo, t)

        if (tFillingStochRDMOnFly) then
            call encode_stochastic_rdm_info(GugaBits, t, rdm_ind= &
                                            contract_2_rdm_ind(excitInfo%i, excitInfo%j, excitInfo%k, excitInfo%l, &
                                                               excit_lvl=2, excit_typ=excitInfo%typ), x1=0.0_dp, &
                                            x0=extract_matrix_element(t, 1) * tempWeight)
        end if

        ! for efficiency only encode umat here
        call encode_matrix_element(t, 0.0_dp, 2)
        call update_matrix_element(t, tempWeight * umat, 1)

    end subroutine calcSingleOverlapMixedStochastic