subroutine Transform2ElIntsMemSave()
integer :: i, j, k, l, a, b, g, d, ierr, a2, b2, g2, d2
integer(TagIntType) Temp4indintsTag
real(dp), allocatable :: Temp4indints(:, :)
#ifdef CMPLX_
call stop_all('Transform2ElIntsMemSave', 'Rotating orbitals not implemented for complex orbitals.')
#endif
Transform2ElInts_Time%timer_name = 'Transform2ElIntsTime'
call set_timer(Transform2ElInts_time, 30)
! Zero arrays from previous transform.
allocate(Temp4indints(NoRotOrbs, NoOrbs), stat=ierr)
call LogMemAlloc('Temp4indints', NoRotOrbs * NoOrbs, 8, 'Transform2ElIntsMemSave', Temp4indintsTag, ierr)
if (ierr /= 0) call Stop_All('Transform2ElIntsMemSave', 'Problem allocating memory to Temp4indints.')
FourIndInts(:, :, :, :) = 0.0_dp
! **************
! Calculating the two-transformed, four index integrals.
! The untransformed <alpha beta | gamma delta> integrals are found from UMAT(UMatInd(i, j, k, l)
do b = 1, NoOrbs
if (tTurnStoreSpinOff) then
b2 = CEILING(real(SymLabelList2_rot(b), dp) / 2.0_dp)
else
b2 = SymLabelList2_rot(b)
end if
do d = 1, b
if (tTurnStoreSpinOff) then
d2 = CEILING(real(SymLabelList2_rot(d), dp) / 2.0_dp)
else
d2 = SymLabelList2_rot(d)
end if
do a = 1, NoOrbs
if (tTurnStoreSpinOff) then
a2 = CEILING(real(SymLabelList2_rot(a), dp) / 2.0_dp)
else
a2 = SymLabelList2_rot(a)
end if
do g = 1, a
if (tTurnStoreSpinOff) then
g2 = CEILING(real(SymLabelList2_rot(g), dp) / 2.0_dp)
else
g2 = SymLabelList2_rot(g)
end if
FourIndInts(a, g, b, d) = real(UMAT(UMatInd(a2, b2, g2, d2)), dp)
FourIndInts(g, a, b, d) = real(UMAT(UMatInd(a2, b2, g2, d2)), dp)
FourIndInts(a, g, d, b) = real(UMAT(UMatInd(a2, b2, g2, d2)), dp)
FourIndInts(g, a, d, b) = real(UMAT(UMatInd(a2, b2, g2, d2)), dp)
end do
end do
Temp4indints(:, :) = 0.0_dp
call dgemm('T', 'N', NoRotOrbs, NoOrbs, NoOrbs, 1.0_dp, CoeffT1(:, :), NoOrbs, FourIndInts(1:NoOrbs, 1:NoOrbs, b, d), &
NoOrbs, 0.0_dp, Temp4indints(1:NoRotOrbs, 1:NoOrbs), NoRotOrbs)
! Temp4indints(i,g) comes out of here, so to transform g to k, we need the transpose of this.
call dgemm('T', 'T', NoRotOrbs, NoRotOrbs, NoOrbs, 1.0_dp, CoeffT1(:, :), NoOrbs, Temp4indints(1:NoRotOrbs, 1:NoOrbs), &
NoRotOrbs, 0.0_dp, FourIndInts(1:NoRotOrbs, 1:NoRotOrbs, b, d), NoRotOrbs)
! Get Temp4indits02(i,k)
do i = 1, NoRotOrbs
do k = 1, i
FourIndInts(i, k, d, b) = FourIndInts(i, k, b, d)
FourIndInts(k, i, d, b) = FourIndInts(i, k, b, d)
FourIndInts(i, k, b, d) = FourIndInts(i, k, b, d)
FourIndInts(k, i, b, d) = FourIndInts(i, k, b, d)
end do
end do
end do
end do
! Calculating the 3 transformed, 4 index integrals. 01 = a untransformed, 02 = b, 03 = g, 04 = d
do i = 1, NoRotOrbs
do k = 1, i
Temp4indints(:, :) = 0.0_dp
call dgemm('T', 'N', NoRotOrbs, NoOrbs, NoOrbs, 1.0_dp, CoeffT1(:, :), NoOrbs, FourIndInts(i, k, 1:NoOrbs, 1:NoOrbs), &
NoOrbs, 0.0_dp, Temp4indints(1:NoRotOrbs, 1:NoOrbs), NoRotOrbs)
call dgemm('T', 'T', NoRotOrbs, NoRotOrbs, NoOrbs, 1.0_dp, CoeffT1(:, :), NoOrbs, Temp4indints(1:NoRotOrbs, 1:NoOrbs), &
NoRotOrbs, 0.0_dp, FourIndInts(i, k, 1:NoRotOrbs, 1:NoRotOrbs), NoRotOrbs)
do l = 1, NoRotOrbs
do j = 1, l
FourIndInts(k, i, j, l) = FourIndInts(i, k, j, l)
FourIndInts(k, i, l, j) = FourIndInts(i, k, j, l)
FourIndInts(i, k, j, l) = FourIndInts(i, k, j, l)
FourIndInts(i, k, l, j) = FourIndInts(i, k, j, l)
end do
end do
end do
end do
deallocate(Temp4indints)
call LogMemDeAlloc('Transform2ElIntsMemSave', Temp4indintsTag)
call halt_timer(Transform2ElInts_Time)
end subroutine Transform2ElIntsMemSave