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