iter_diagnostics Subroutine

    subroutine iter_diagnostics()

        character(*), parameter :: this_routine = 'iter_diagnostics'
        character(*), parameter :: t_r = this_routine
        integer :: run, part_type

#ifndef CMPLX_
        if (tPositiveHFSign) then
            do part_type = 1, lenof_sign
                if ((.not. tFillingStochRDMonFly) .or. (inum_runs == 1)) then
                    if (AllNoAtHF(part_type) < 0.0_dp) then
                        root_print 'No. at HF < 0 - flipping sign of entire ensemble ' &
                                   // 'of particles in simulation: ', part_type
                        root_print AllNoAtHF(part_type)

                        ! And do the flipping
                        call FlipSign(part_type)
                        AllNoatHF(part_type) = -AllNoatHF(part_type)
                        NoatHF(part_type) = -NoatHF(part_type)

                        if (tFillingStochRDMonFly) then
                            ! Want to flip all the averaged signs.
                            AvNoatHF = -AVNoatHF
                            InstNoatHF(part_type) = -InstNoatHF(part_type)
                        end if
                    end if
                end if
            end do
        end if
#endif
        if (iProcIndex == Root) then
            ! Have all of the particles died?
#ifdef CMPLX_
            tRestart = .false.
            do run = 1, inum_runs
                if (near_zero(sum(AllTotParts(min_part_type(run):max_part_type(run))))) then
                    call stop_all(t_r, "All particles have died. Aborting.")
                end if
            end do
#else
            if (near_zero(AllTotParts(1)) .or. near_zero(AllTotParts(inum_runs))) then
                call stop_all(t_r, "All particles have died. Aborting.")
            else
                tRestart = .false.
            end if
            !TODO CMO: Work out how to wipe the walkers on the second population if double run
#endif
        end if
        call MPIBCast(tRestart)
        if (tRestart) then
            ! a restart not wanted in the real-time fciqmc..
            !Initialise variables for calculation on each node
            CALL DeallocFCIMCMemPar()
            IF (iProcIndex == Root) THEN
                close(fcimcstats_unit)
                if (inum_runs == 2) close(fcimcstats_unit2)
                IF (tTruncInitiator) close(initiatorstats_unit)
                IF (tLogComplexPops) close(complexstats_unit)
                if (tLogEXLEVELStats) close(EXLEVELStats_unit)
            end if
            IF (TDebug) close(11)
            CALL SetupParameters()
            CALL InitFCIMCCalcPar()
            if (tFCIMCStats2) then
                call write_fcimcstats2(iter_data_fciqmc, initial=.true.)
                call write_fcimcstats2(iter_data_fciqmc)
            else
                call WriteFciMCStatsHeader()
                ! Prepend a # to the initial status line so analysis doesn't pick up
                ! repetitions in the FCIMCStats or INITIATORStats files from restarts.
                if (iProcIndex == root) then
                    write(fcimcstats_unit, '("#")', advance='no')
                    if (inum_runs == 2) &
                        write(fcimcstats_unit2, '("#")', advance='no')
                    write(initiatorstats_unit, '("#")', advance='no')
                end if
                call WriteFCIMCStats()
            end if
            Iter = 1
            if (iProcIndex == root .and. tLogEXLEVELStats) &
                write(EXLEVELStats_unit, '("#")', advance='no')
            return
        end if

        ! update the number of spawning attempts per walker
        if (tDynamicAvMCEx) then
            if (allNValidExcits /= 0) then
                ! we try to have approx. one valid excitation generated per walker
                AvMCExcits = (allNValidExcits + allNInvalidExcits) / (allNValidExcits)
                write(stdout, *) "Now spawning ", AvMCExcits, " times per walker"
            end if
        end if

    end subroutine iter_diagnostics