Transform2ElIntsMemSave Subroutine

public subroutine Transform2ElIntsMemSave()

Arguments

None

Contents


Source Code

    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