calc_orbital_pgen_contr_heisenberg Subroutine

public subroutine calc_orbital_pgen_contr_heisenberg(csf_i, occ_orbs, above_cpt, below_cpt)

Arguments

Type IntentOptional Attributes Name
type(CSF_Info_t), intent(in) :: csf_i
integer, intent(in) :: occ_orbs(2)
real(kind=dp), intent(out) :: above_cpt
real(kind=dp), intent(out) :: below_cpt

Contents


Source Code

    subroutine calc_orbital_pgen_contr_heisenberg(csf_i, occ_orbs, above_cpt, below_cpt)
        ! and I also need an orbital pgen recalculator for the
        ! exchange type excitations
        type(CSF_Info_t), intent(in) :: csf_i
        integer, intent(in) :: occ_orbs(2)
        real(dp), intent(out) :: above_cpt, below_cpt
        character(*), parameter :: this_routine = "calc_orbital_pgen_contr_heisenberg"

        real(dp) :: p_elec
        real(dp), allocatable :: cum_arr(:)
        integer :: sp_orbs(2)

        ! here I have to somehow recalculate the probability of
        ! picking a pair (i,j)
        p_elec = 1.0_dp / real(nel, dp)

        ! i could have taken both of the orbitals in any order.. so I have
        ! to take this into account

        ASSERT(all(occ_orbs > 0))
        ASSERT(all(occ_orbs <= nBasis))
        ! the occ_orbs are spin-orbitals!  so convert!
        sp_orbs = gtID(occ_orbs)

        call gen_guga_heisenberg_cum_list(csf_i, minval(sp_orbs), cum_arr, &
                                          maxval(sp_orbs), below_cpt)

        call gen_guga_heisenberg_cum_list(csf_i, maxval(sp_orbs), cum_arr, &
                                          minval(sp_orbs), above_cpt)

        above_cpt = above_cpt * p_elec
        below_cpt = below_cpt * p_elec

    end subroutine calc_orbital_pgen_contr_heisenberg