CACHEUMATEL Subroutine

private subroutine CACHEUMATEL(B, UMATEL, ICACHE, ICACHEI, iType)

Uses

Arguments

Type IntentOptional Attributes Name
integer :: B
real(kind=dp) :: UMATEL(0:NTYPES-1)
integer :: ICACHE
integer :: ICACHEI
integer :: iType

Contents

Source Code


Source Code

    SUBROUTINE CACHEUMATEL(B, UMATEL, ICACHE, ICACHEI, iType)
        ! In:
        !    A,B: cache indices of the element.
        !    UMatEl: element being stored.  For calculations involving real
        !            orbitals, this is a array of size 1 containing the
        !            <ij|u|kl> integral (nTypes=1).  For calculations involving
        !            complex orbtials, this is an array of size 2 containing
        !            the <ij|u|kl> and <il|u|jk> integrals (nTypes=2).
        !    ICache: Segment index of the cache for storing integrals involving
        !            index A (often equal to A).
        !    ICacheI: Slot within ICache segment for storing UMatEl involving
        !             B.
        !    iType: See notes below.
        use constants, only: dp
        INTEGER B, ICACHE, ICACHEI
        HElement_t(dp) UMATEL(0:NTYPES - 1), TMP(0:NTYPES - 1)
        INTEGER OLAB, IC1, ITOTAL
        INTEGER iType
        INTEGER iIntPos
        SAVE ITOTAL
        DATA ITOTAL/0/
        if (nSlots == 0) return
!         write(stdout,*) "CU",A,B,UMATEL,iType
!         write(stdout,*) A,ICache,B,ICacheI
        if (nTypes > 1) then
! A number of different cases to deal with depending on the order the integral came in (see GetCachedUMatEl for details)
!  First get which pos in the slot will be the new first pos
            iIntPos = iand(iType, 1)
!  If bit 1 is set we must conjg the (to-be-)first integral
#ifdef CMPLX_
            if (btest(iType, 1)) then
                Tmp(0) = conjg(UMatEl(iIntPos))
            else
                Tmp(0) = UMatEl(iIntPos)
            end if
#else
            Tmp(0) = UMatEl(iIntPos)
#endif
!  If bit 2 is set we must conjg the (to-be-)second integral
#ifdef CMPLX_
            if (btest(iType, 2)) then
                Tmp(1) = conjg(UMatEl(1 - iIntPos))
            else
                Tmp(1) = UMatEl(1 - iIntPos)
            end if
#else
            Tmp(1) = UMatEl(1 - iIntPos)
#endif
            UMatEl = Tmp
        end if
!         write(stdout,*) "CU",A,B,UMATEL,iType
!         write(stdout9,*) NSLOTS,A,B,UMATEL,ICACHE,ICACHEI
        IF (NSLOTS == NPAIRS .OR. UMATCACHEFLAG == 1 .OR. tSmallUMat) THEN
!   small system.  only store a single element
            UMATLABELS(ICACHEI, ICACHE) = B
            UMatCacheData(:, ICACHEI, ICACHE) = UMATEL
            ITOTAL = ITOTAL + 1
            RETURN
        end if
        IC1 = ICACHEI
!         write(stdout,*) "ICI",ICACHEI,ICACHE
        OLAB = UMATLABELS(ICACHEI, ICACHE)
!   If we're in a block of prior, fill after
        DO WHILE (OLAB < B .AND. ICACHEI <= NSLOTS)
            UMatCacheData(:, ICACHEI, ICACHE) = UMATEL
            UMATLABELS(ICACHEI, ICACHE) = B
!            IF(ICACHEI.LT.1.OR.ICACHE.LT.1.OR.ICACHEI.GT.NSLOTS.OR.ICACHE.GT.NPAIRS) THEN
!               write(stdout,*) ICACHEI,ICACHE
!               STOP "a"
!            end if
            ICACHEI = ICACHEI + 1
            IF (ICACHEI <= NSLOTS) THEN
                OLAB = UMATLABELS(ICACHEI, ICACHE)
            ELSE
                OLAB = 0
            end if
        end do
        IF (OLAB == 0) ICACHEI = IC1
!        write(stdout,*) "ICI2",ICACHEI,ICACHE
        DO WHILE ((OLAB > B .OR. OLAB == 0) .AND. ICACHEI > 0)
            UMatCacheData(:, ICACHEI, ICACHE) = UMATEL
            UMATLABELS(ICACHEI, ICACHE) = B
!            IF(ICACHEI.LT.1.OR.ICACHE.LT.1.OR.ICACHEI.GT.NSLOTS.OR.ICACHE.GT.NPAIRS) THEN
!               write(stdout,*) ICACHEI,ICACHE
!               STOP "b"
!            end if
            ICACHEI = ICACHEI - 1
            if (icachei > 0) OLAB = UMATLABELS(ICACHEI, ICACHE)
        end do
    END SUBROUTINE CacheUMatEl