measure_double_occ_and_spin_diff Subroutine

public subroutine measure_double_occ_and_spin_diff(ilut, ni, real_sgn)

Uses

Arguments

Type IntentOptional Attributes Name
integer(kind=n_int), intent(in) :: ilut(0:niftot)
integer, intent(in) :: ni(nel)
real(kind=dp), intent(in) :: real_sgn(lenof_sign)

Contents


Source Code

    subroutine measure_double_occ_and_spin_diff(ilut, nI, real_sgn)
        ! routine to measure double occupancy and spin difference for each
        ! orbital
        use UMatCache, only: gtid
        integer(n_int), intent(in) :: ilut(0:niftot)
        integer, intent(in) :: ni(nel)
        real(dp), intent(in) :: real_sgn(lenof_sign)
        character(*), parameter :: this_routine = "measure_double_occ_and_spin_diff"

        integer :: i, spin_orb, spat_orb(nel)
        real(dp) :: contrib

        ASSERT(allocated(spin_diff))
        ASSERT(allocated(double_occ_vec))

        ! i can calculate the C_i^2 at the beginning already since it is
        ! always the same and i guess i have atleast on contribution atleast
        ! for each occupied orbital
#if defined PROG_NUMRUNS_ || defined DOUBLERUN_
        contrib = real_sgn(1) * real_sgn(2)
#else
        contrib = abs(real_sgn(1))**2
#endif

        spat_orb = gtid(nI)

        i = 1
        do while (i < nel + 1)
            spin_orb = nI(i)
            if (is_beta(spin_orb)) then
                ! check if it is a doubly occupied orb
                if (IsDoub(ilut, spin_orb)) then
                    ! then we want to add to the double_occ vector

                    inst_spatial_doub_occ(spat_orb(i)) = &
                        inst_spatial_doub_occ(spat_orb(i)) + contrib

                    ! and we can skip the even alpha orbital in nI
                    i = i + 2
                else
                    ! beta spin contributes negatively!
                    inst_spin_diff(spat_orb(i)) = inst_spin_diff(spat_orb(i)) &
                                                  - contrib

                    i = i + 1
                end if

            else
                ! the way i plan to set it up, we check beta spins in the
                ! same orbital first.. so it can't be doubly occupied at
                ! this point!
                inst_spin_diff(spat_orb(i)) = inst_spin_diff(spat_orb(i)) &
                                              + contrib

                i = i + 1
            end if
        end do

        ! this should be it or?
    end subroutine measure_double_occ_and_spin_diff