write_double_occ_stats Subroutine

    subroutine write_double_occ_stats(initial)
        ! routine to write out the double occupancy data
        logical, intent(in), optional :: initial
        character(*), parameter :: this_routine = "write_double_occ_stats"

        type(write_state_t), save :: state
        logical, save :: inited = .false.

        ! Provide default 'initial' option
        if (present(initial)) then
            state%init = initial
        else
            state%init = .false.
        end if

        ! If the output file hasn't been opened yet, then create it.
        if (iProcIndex == Root .and. .not. inited) then
            state%funit = get_free_unit()
            call init_double_occ_output(state%funit)
            inited = .true.
        end if

        if (iProcIndex == root) then
            if (state%init .or. state%prepend) then
                write(state%funit, '("#")', advance='no')
                state%prepend = state%init

            else if (.not. state%prepend) then
                write(state%funit, '(" ")', advance='no')

            end if

            state%cols = 0
            state%cols_mc = 0
            state%mc_out = tMCOutput

            call stats_out(state, .false., iter + PreviousCycles, 'Iter.')
            call stats_out(state, .false., all_inst_double_occ / &
                           (real(StepsSft, dp) * sum(all_norm_psi_squared) / real(inum_runs, dp)), 'Double Occ.')
            if (t_calc_double_occ_av) then
                if (.not. near_zero(sum_norm_psi_squared)) then
                    call stats_out(state, .false., sum_double_occ / &
                                   (real(StepsSft, dp) * sum_norm_psi_squared), 'DoubOcc Av')
                else
                    call stats_out(state, .false., 0.0_dp, 'DoubOcc Av')
                end if
            else
                call stats_out(state, .false., 0.0_dp, 'DoubOcc Av')
            end if

            ! And we are done
            write(state%funit, *)
            call neci_flush(state%funit)

        end if

    end subroutine write_double_occ_stats