UMatConj Function

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


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)


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
            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
            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.
            UMatConj = val
        end if

        integer :: tmp
        UMatConj = val

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