SUBROUTINE FreezeUMatCacheInt(OrbTrans, nOld, nNew, onSlots, onPairs)
INTEGER nOld, nNew, OrbTrans(nOld)
HElement_t(dp), Pointer :: NUMat2D(:, :) !(nNew/2,nNew/2)
integer(TagIntType) :: tagNUMat2D = 0
HElement_t(dp) El(0:nTypes - 1)
INTEGER i, j, k, l, m, n
INTEGER ni, nj, nk, nl, nm, nn, A, B, iType
HElement_t(dp), Pointer :: OUMatCacheData(:, :, :) !(0:nTypes-1,onSlots,onPairs)
INTEGER, Pointer :: OUMatLabels(:, :) !(onSlots,onPairs)
INTEGER onSlots, onPairs, ierr
LOGICAL toSmallUMat, tlog, toUMat2D, tmpl
character(len=*), parameter :: thisroutine = 'FreezeUMatCacheInt'
toUMat2D = tUMat2D
IF (tUMat2D) then
allocate(NUMat2D(nNew / 2, nNew / 2), STAT=ierr)
call LogMemAlloc('UMat2D',(nNew / 2)**2, 8 * HElement_t_size, thisroutine, tagNUMat2D, ierr)
! /2 because UMat2D works in states, not in orbitals
DO i = 1, nOld / 2
IF (OrbTrans(i * 2) /= 0) THEN
DO j = 1, nOld / 2
IF (OrbTrans(j * 2) /= 0) THEN
NUMat2D(OrbTrans(i * 2) / 2, OrbTrans(j * 2) / 2) = UMat2D(i, j)
end if
end do
end if
end do
CALL LogMemDealloc(thisroutine, tagUMat2D)
Deallocate(UMat2D)
UMat2D => NUMat2D
nullify(NUMat2D)
tagUMat2D = tagNUMat2D
end if
! Now go through the other cache.
! First save the memory used for it.
! onSlots=nSlots
! onPairs=nPairs
OUMatCacheData => UMatCacheData
tagOUMatCacheData = tagUMatCacheData
OUMatLabels => UMatLabels
tagOUMatLabels = tagUMatLabels
toSmallUMat = tSmallUMat
Nullify(UMatCacheData)
Nullify(UMatLabels)
!Now reinitialize the cache.
CALL SetupUMatCache(nNew / 2, .FALSE.)
TUMAT2D = toUMat2D
CALL SetUMatcacheFlag(1)
DO i = 1, nOld / 2
IF (OrbTrans(i * 2) /= 0) THEN
DO k = i, nOld / 2
IF (OrbTrans(k * 2) /= 0) THEN
CALL GetCacheIndex(i, k, m)
DO n = 1, onSlots
tmpl = .true.
if (n /= 1) then
if (OUMatLabels(n, m) /= OUMatLabels(n - 1, m)) tmpl = .false.
end if
if ((onSlots == onPairs .or. toSmallUMat) .or. &
(onSlots /= onPairs .and. tmpl)) then
IF (OUMatLabels(n, m) /= 0) THEN
ni = OrbTrans(i * 2) / 2
nk = OrbTrans(k * 2) / 2
!Now get the label of the slot and convert to orbitals
IF (onSlots == onPairs) THEN
CALL GetCacheIndexStates(n, j, l)
else if (toSmallUMat) THEN
j = n
l = n
ELSE
CALL GetCacheIndexStates(OUMatLabels(n, m), j, l)
end if
nj = OrbTrans(j * 2) / 2
nl = OrbTrans(l * 2) / 2
IF (nj /= 0 .AND. nl /= 0) THEN
! JSS: Alex, please check!
! GetCachedUMatEl called for cache indices: El(O) is
! a dummy argument.
Tlog = GetCachedUmatEl(ni, nj, nk, nl, El(0), nm, nn, A, B, iType)
CALL CacheUMatEl(B, OUMatCacheData(0, n:n + nTypes, m:m + nTypes), nm, nn, iType)
end if
end if
end if
end do
end if
end do
end if
end do
CALL LogMemDealloc(thisroutine, tagOUMatLabels)
Deallocate(OUMatLabels)
CALL LogMemDealloc(thisroutine, tagOUMatCacheData)
Deallocate(OUMatCacheData)
CALL SetUMatCacheFlag(0)
END SUBROUTINE FreezeUMatCacheInt