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