UMatConj Function

public elemental function UMatConj(I, J, K, L, val)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: I
integer, intent(in) :: J
integer, intent(in) :: K
integer, intent(in) :: L
real(kind=dp), intent(in) :: val

Return Value real(kind=dp)


Contents

Source Code


Source Code

    HElement_t(dp) elemental function UMatConj(I, J, K, L, val)
        integer, intent(in) :: I, J, K, L
        HElement_t(dp), intent(in) :: val
#ifdef CMPLX_
        INTEGER :: IDI, IDJ, IDK, IDL, NewA, A

        !Changing index ordering for the real ordering.
        IDI = I
        IDJ = J
        IDK = K
        IDL = L

        !First find rearranged indices.
        IF (idi < idk) then
            !swap idi and idk
            call swap(idi, idk)
        end if

        IF (idj < idl) then
            !swap idj and idl
            call swap(idj, idl)
        end if

        IF ((idl < idk) .or. ((idl == idk) .and. (idi < idj))) THEN
            !We would want to swap the (ik) and (jl) pair.
            call swap(idi, idj)
            call swap(idk, idl)
        end if

        !Indices now permuted to the real case ordering. Is this now the same integral?
        if (((I > K) .and. (J < L)) .or. ((I < K) .and. (J > L))) then
            !Type II integral - reducing to lowest ordering will give 'other'
            !integral, where one of (ik) and (jl) pairs have been swapped independantly.
            !If i = k, or j = l, we do not go through here.
            call swap(idi, idk)  !Revert back to the correct integral by swapping just i and k.
        end if

        !Want to see if the pairs of indices have swapped sides.
        !Make unique index from the ij and kl pairs
        IF (IDI > IDJ) THEN
            A = IDI * (IDI - 1) / 2 + IDJ
        ELSE
            A = IDJ * (IDJ - 1) / 2 + IDI
        end if

        !Create uniques indices from the original pairs of indices.
        !We only need to consider whether the (ij) pair has swapped sides, since
        !the <ij|ij> and <ij|ji> integrals are real by construction, and so we do not
        !need to consider what happens if the (ij) pair = (kl) pair.
        IF (I > J) THEN
            NewA = I * (I - 1) / 2 + J
        ELSE
            NewA = J * (J - 1) / 2 + I
        end if

        !Check whether pairs of indices have swapped sides.
        IF (NewA /= A) THEN
            UMatConj = CONJG(val) !Index pair i and j have swapped sides - take CC.
        ELSE
            UMatConj = val
        end if

#else
        integer :: tmp
        UMatConj = val

        ! Eliminate warnings
        tmp = i; tmp = j; tmp = k; tmp = l
#endif
    end function UMatConj