PrintOccTable Subroutine

public subroutine PrintOccTable()

Arguments

None

Contents

Source Code


Source Code

    subroutine PrintOccTable()

        use LoggingData, only: tTruncRODump
        use RotateOrbsData, only: CoeffT1, EvaluesTrunc
        use SystemData, only: tUseHFOrbs

        integer :: x, i, a, b, io2

        io2 = get_free_unit()
        open(io2, file='OccupationTable', status='unknown')
        x = 1
        do while (x <= NoOrbs)
            write(io2, '(A16,A5)', advance='no') 'HF Orb En    ', 'Sym'
            if (.not. tUseHFOrbs) then
                do i = x, x + 9
                    if (i > NoOrbs) then
                        write(io2, *) ''
                        exit
                    end if
                    if (tTruncRODump) then
                        write(io2, '(ES16.6)', advance='no') EvaluesTrunc(i)
                    else
                        write(io2, '(ES16.6)', advance='no') Evalues(i)
                    end if
                end do
            end if
            write(io2, *) ''

            do a = 1, NoOrbs
                b = SymLabelListInv_rot(a)
                if (tStoreSpinOrbs) then
                    write(io2, '(F16.10,I5)', advance='no') ARR(a, 1), int(G1(a)%sym%S, 4)
                else
                    write(io2, '(F16.10,I5)', advance='no') ARR(2 * a, 1), int(G1(2 * a)%sym%S, 4)
                end if
                do i = x, x + 9
                    if (i > NoOrbs) then
                        write(io2, *) ''
                        exit
                    end if
                    write(io2, '(F16.10)', advance='no') CoeffT1(b, i)
                end do
                write(io2, *) ''
            end do
            write(io2, *) ''
            x = x + 10
        end do
        call neci_flush(io2)
        close(io2)
        call neci_flush(stdout)

    end subroutine PrintOccTable