fill_sings_1rdm Subroutine

public subroutine fill_sings_1rdm(one_rdms, Ex, tParity, contrib_sign_i, contrib_sign_j, fill_symmetric)

Arguments

Type IntentOptional Attributes Name
type(one_rdm_t), intent(inout) :: one_rdms(:)
integer, intent(in) :: Ex(2,maxExcit)
logical, intent(in) :: tParity
real(kind=dp), intent(in) :: contrib_sign_i(:)
real(kind=dp), intent(in) :: contrib_sign_j(:)
logical, intent(in) :: fill_symmetric

Contents

Source Code


Source Code

    subroutine fill_sings_1rdm(one_rdms, Ex, tParity, contrib_sign_i, contrib_sign_j, fill_symmetric)

        use rdm_data, only: one_rdm_t, tOpenShell
        use RotateOrbsData, only: SymLabelListInv_rot
        use UMatCache, only: gtID

        type(one_rdm_t), intent(inout) :: one_rdms(:)
        integer, intent(in) :: Ex(2, maxExcit)
        logical, intent(in) :: tParity
        real(dp), intent(in) :: contrib_sign_i(:), contrib_sign_j(:)
        logical, intent(in) :: fill_symmetric

        integer :: i, a, ind_i, ind_a, irdm
        real(dp) :: ParityFactor

        ParityFactor = 1.0_dp
        if (tParity) ParityFactor = -1.0_dp

        ! Get the orbital labels involved in the excitation.
        if (tOpenShell) then
            i = Ex(1, 1)
            a = Ex(2, 1)
        else
            i = gtID(Ex(1, 1))
            a = gtID(Ex(2, 1))
        end if

        ! The SymLabelListInv_rot array is used to index the 1-RDM so that it
        ! will be filled in block diagonal order, where each block holds one
        ! symmetry sector of the 1-RDM (i.e., orbitals are ordered first by
        ! symmetry, then by the standard order).
        ind_i = SymLabelListInv_rot(i)
        ind_a = SymLabelListInv_rot(a)

        do irdm = 1, size(one_rdms)
            one_rdms(irdm)%matrix(ind_a, ind_i) = one_rdms(irdm)%matrix(ind_a, ind_i) + &
                                                  (ParityFactor * contrib_sign_i(irdm) * contrib_sign_j(irdm))

            if (fill_symmetric) then
                one_rdms(irdm)%matrix(ind_i, ind_a) = one_rdms(irdm)%matrix(ind_i, ind_a) + &
                                                      (ParityFactor * contrib_sign_i(irdm) * contrib_sign_j(irdm))
            end if
        end do

    end subroutine fill_sings_1rdm