ReTruncROFciDump Subroutine

    subroutine ReTruncROFciDump()

        use NatOrbsMod, only: FillCoeffT1

        integer :: i, j, ierr
        character(len=*), parameter :: this_routine = 'ReTruncROFciDump'

        do i = 2, NoDumpTruncs

            deallocate(ArrDiagNew)
            call LogMemDeAlloc(this_routine, ArrDiagNewTag)
            deallocate(CoeffT1)
            call LogMemDeAlloc(this_routine, CoeffT1Tag)
            deallocate(FourIndInts)
            call LogMemDeAlloc(this_routine, FourIndIntsTag)
            deallocate(SymOrbs_rot)
            call LogMemDeAlloc(this_routine, SymOrbs_rotTag)
            deallocate(TMAT2DNew)
            call LogMemDeAlloc(this_routine, TMAT2DNewTag)
            deallocate(EvaluesTrunc)
            call LogMemDeAlloc(this_routine, EvaluesTruncTag)

            if (tTruncDumpbyVal) then
                NoFrozenVirt = 0
                TruncEval = TruncEvalues(i)
            else
                if (tStoreSpinOrbs) then
                    NoFrozenVirt = NoTruncOrbs(i)
                else
                    NoFrozenVirt = NoTruncOrbs(i) / 2
                end if
            end if
            NoRotOrbs = NoOrbs - NoFrozenVirt

            if (MOD(NoFrozenVirt, 2) /= 0) call Stop_All(this_routine, "Must freeze virtual spin orbitals in pairs of 2.")

            allocate(CoeffT1(NoOrbs, NoRotOrbs), stat=ierr)
            call LogMemAlloc(this_routine, NoRotOrbs * NoOrbs, 8, this_routine, CoeffT1Tag, ierr)
            CoeffT1(:, :) = 0.0_dp
            if (tSeparateOccVirt) then
                do j = 1, NoRotOrbs
                    CoeffT1(i, i) = 1.0_dp
                end do
            end if

            call FillCoeffT1()

            allocate(FourIndInts(NoOrbs, NoOrbs, NoOrbs, NoOrbs), stat=ierr)
            call LogMemAlloc('FourIndInts', (NoOrbs**4), 8, this_routine, FourIndIntsTag, ierr)

            ! Then, transform2ElInts.
            write(stdout, *) 'Transforming the four index integrals.'
            call Transform2ElIntsMemSave()

            write(stdout, *) 'Re-calculating the fock matrix.'
            call CalcFOCKMatrix()

            write(stdout, *) 'Refilling the UMAT and TMAT2D.'
            ! The ROFCIDUMP is also printed out in here.
            call RefillUMATandTMAT2D()

            call neci_flush(stdout)

        end do

    end subroutine ReTruncROFciDump