PrintROFCIDUMP Subroutine

    subroutine PrintROFCIDUMP()

        ! This prints out a new FCIDUMP file in the same format as the old one.

        integer :: i, j, k, l, iunit
        character(len=5) :: Label
        character(len=20) :: LabelFull

        PrintROFCIDUMP_Time%timer_name = 'PrintROFCIDUMP'
        call set_timer(PrintROFCIDUMP_Time, 30)

        Label = ''
        LabelFull = ''
        write(Label, '(I5)') NoFrozenVirt
        LabelFull = 'ROFCIDUMP-'//adjustl(Label)

        iunit = get_free_unit()
        open(iunit, file=LabelFull, status='unknown')

        write(iunit, '(2A6, I3, A7, I3, A5, I2, A)') '&FCI ', 'NORB = ', (NoOrbs - (NoFrozenVirt)), ', NELEC = ', NEl, ', MS2 = ', LMS, ','
        write(iunit, '(A9)', advance='no') 'ORBSYM = '
        do i = 1, (NoOrbs - (NoFrozenVirt))
            if ((tUseMP2VarDenMat .or. tFindCINatOrbs) .and. (.not. lNoSymmetry) .and. tTruncRODump) then
                write(iunit, '(I1, A1)', advance='no') (SymOrbs_rot(i) + 1), ','
            else
                if (tStoreSpinOrbs) then
                    write(iunit, '(I1, A1)', advance='no') (int(G1(i)%sym%S) + 1), ','
                else
                    write(iunit, '(I1, A1)', advance='no') (int(G1(i * 2)%sym%S) + 1), ','
                end if
            end if
        end do
        write(iunit, *) ''
        if (tStoreSpinOrbs) then
            write(iunit, '(A7, I1, A11)') 'ISYM = ', 1, ' UHF = .TRUE.'
        else
            write(iunit, '(A7, I1)') 'ISYM = ', 1
        end if
        write(iunit, '(A5)') '&end'

        do i = 1, (NoOrbs - (NoFrozenVirt))
            do k = 1, i
                do j = 1, (NoOrbs - (NoFrozenVirt))
                    ! Potential to put symmetry in here, have currently taken
                    ! it out, because when we're only printing non-zero values,
                    ! it is kind of unnecessary - although it may be used to
                    ! speed things up.
                    do l = 1, j
                        if (.not. near_zero(real(UMat(UMatInd(i, j, k, l)), dp))) then
                            write(iunit, '(F21.12, 4I3)') real(UMat(UMatInd(i, j, k, l)), dp), i, k, j, l
                        end if
                    end do
                end do
            end do
        end do

        ! TMAT2D stored as spin orbitals.
        do k = 1, (NoOrbs - (NoFrozenVirt))
            ! Symmetry?
            do i = k, (NoOrbs - (NoFrozenVirt))
                if (tStoreSpinOrbs) then
                    if (.not. near_zero(real(TMAT2D(i, k), dp))) write(iunit, '(F21.12, 4I3)') real(TMAT2D(i, k), dp), i, k, 0, 0
                else
              if (.not. near_zero(real(TMAT2D(2 * i, 2 * k), dp))) write(iunit, '(F21.12, 4I3)') real(TMAT2D(2 * i, 2 * k), dp), i, k, 0, 0
                end if
            end do
        end do

! ARR has the energies of the orbitals (eigenvalues).  ARR(:,2) has ordering we want.
! ARR is stored as spin orbitals.

        do k = 1, (NoOrbs - (NoFrozenVirt))
            if (tStoreSpinOrbs) then
                write(iunit, '(F21.12, 4I3)') Arr(k, 2), k, 0, 0, 0
            else
                write(iunit, '(F21.12, 4I3)') Arr(2 * k, 2), k, 0, 0, 0
            end if
        end do

        write(iunit, '(F21.12, 4I3)') ECore, 0, 0, 0, 0

        call neci_flush(iunit)

        close(iunit)

        call halt_timer(PrintROFCIDUMP_Time)

    end subroutine PrintROFCIDUMP