subroutine write_fcimcstats2(iter_data, initial)
! Write output to our FCIMCStats file.
! This should be done in a nice general way, so that we make merges
! somewhat easier.
!
! --> The column numbers are no longer as well fixed (oh well...)
type(fcimc_iter_data), intent(in) :: iter_data
logical, intent(in), optional :: initial
! Use a state type to keep things compact and tidy below.
type(write_state_t), save :: state
type(write_state_t), save :: state_i
logical, save :: inited = .false.
character(5) :: tmpc, tmpc2, tmgf
integer :: p, q, iGf, run
logical :: init
real(dp) :: l1_norm
! Is in the interface to refactor the procedure lateron.
unused_var(iter_data)
call getProjEOffset()
! Provide default 'initial' option
if (present(initial)) then
state%init = initial
if (tTruncInitiator) state_i%init = initial
else
state%init = .false.
if (tTruncInitiator) state_i%init = .false.
end if
! If the output file hasn't been opened yet, then create it.
if (iProcIndex == Root .and. .not. inited) then
call open_state_file('fciqmc_stats',state)
! For the initiator stats file here:
if (tTruncInitiator) call open_state_file('initiator_stats',state_i)
inited = .true.
end if
! What is the current value of S2
if (tCalcInstantS2) then
if (mod(iter / StepsSft, instant_s2_multiplier) == 0) then
if (tSpatialOnlyhash) then
curr_S2 = calc_s_squared (.false.)
else
curr_S2 = calc_s_squared_star (.false.)
end if
end if
else
curr_S2 = -1
end if
! What is the current value of S2 considering only initiators
if (tCalcInstantS2Init) then
if (mod(iter / StepsSft, instant_s2_multiplier_init) == 0) then
if (tSpatialOnlyhash) then
curr_S2_init = calc_s_squared (.true.)
else
curr_S2_init = calc_s_squared_star (.true.)
end if
end if
else
curr_S2_init = -1
end if
! ------------------------------------------------
! This is where any calculation that needs multiple nodes should go
! ------------------------------------------------
! ------------------------------------------------
if (iProcIndex == root) then
! Only do the actual outputting on the head node.
call write_padding_init(state)
call write_padding_init(state_i)
! And output the actual data!
state%cols = 0
state%cols_mc = 0
state%mc_out = tMCOutput
if(t_real_time_fciqmc) then
l1_norm = 0.0
do run = 1, inum_runs
l1_norm = l1_norm + mag_of_run(AllTotParts, run)
end do
end if
call stats_out(state,.true., iter + PreviousCycles, 'Iter.')
if (.not. tOrthogonaliseReplicas) then
! note that due to the averaging, the printed value is not necessarily
! an integer
call stats_out(state,.true., sum(abs(AllTotParts))/inum_runs, &
'Tot. parts real')
if(t_real_time_fciqmc) then
call stats_out(state,.true., real_time_info%time_angle,'Time rot. angle')
call stats_out(state,.false., l1_norm/inum_runs ,'L1 Norm')
else
call stats_out(state,.true., sum(abs(AllNoatHF))/inum_runs, 'Tot. ref')
end if
end if
if(.not. t_real_time_fciqmc) then
#ifdef CMPLX_
call stats_out(state,.true., real(proje_iter_tot), 'Re Proj. E')
call stats_out(state,.true., aimag(proje_iter_tot), 'Im Proj. E')
#else
call stats_out(state,.true., proje_iter_tot, 'Proj. E (cyc)')
#endif
end if
call stats_out(state,.true., sum(DiagSft)/inum_runs, 'Shift. (cyc)')
if(t_real_time_fciqmc) &
call stats_out(state, .true., real(sum(dyn_norm_psi))/normsize, '|psi|^2')
call stats_out(state,.false., sum(AllNoBorn), 'No. born')
call stats_out(state,.false., sum(AllNoInitDets), 'No. Inits')
if(t_real_time_fciqmc) then
call stats_out(state,.false., TotImagTime, 'Elapsed complex time')
call stats_out(state,.false., real_time_info%damping, 'eta')
call stats_out(state,.false., IterTime, 'Iter. time')
else
call stats_out(state,.false., sum(AllAnnihilated), 'No. annihil')
end if
call stats_out(state,.false., sum(AllSumWalkersCyc), 'SumWalkersCyc')
call stats_out(state,.false., sum(AllNoAborted), 'No aborted')
#ifdef CMPLX_
call stats_out(state,.true., real(proje_iter_tot) + OutputHii, &
'Tot. Proj. E')
call stats_out(state,.false.,allDoubleSpawns,'Double spawns')
#else
call stats_out(state,.true., proje_iter_tot + OutputHii, &
'Tot. Proj. E')
#endif
call stats_out(state,.true., AllTotWalkers, 'Dets occ.')
call stats_out(state,.true., nspawned_tot, 'Dets spawned')
call stats_out(state,.false., Hii, 'reference energy')
if(t_real_time_fciqmc) then
call stats_out(state,.false., real(sum(dyn_norm_red(:,1))/normsize),'GF normalization')
else
call stats_out(state,.true., IterTime, 'Iter. time')
end if
if(t_real_time_fciqmc) then
call stats_out(state, .true., elapsedRealTime, 'Re. time')
call stats_out(state, .true., elapsedImagTime, 'Im. time')
else
call stats_out(state,.false., TotImagTime, 'Im. time')
end if
! Put the conditional columns at the end, so that the column
! numbers of the data are as stable as reasonably possible (for
! people who want to use gnuplot/not analyse column headers too
! frequently).
! This also makes column contiguity on resumes as likely as
! possible.
if(t_real_time_fciqmc .or. tLogGreensfunction) then
! also output the overlaps and norm..
do iGf = 1, gf_count
write(tmgf, '(i5)') iGf
call stats_out(state,.true., overlap_real(iGf), 'Re. <y_i(0)|y(t)> (i=' // &
trim(adjustl(tmgf)) // ')' )
call stats_out(state,.true., overlap_imag(iGf), 'Im. <y_i(0)|y(t)> (i=' // &
trim(adjustl(tmgf)) // ')' )
end do
do iGf = 1, gf_count
write(tmgf, '(i5)') iGf
do p = 1, normsize
write(tmpc, '(i5)') p
call stats_out(state,.false.,real(current_overlap(p,iGf)), 'Re. <y(0)|y(t)>(rep ' // &
trim(adjustl(tmpc)) // ' i=' // trim(adjustl(tmgf)) // ')')
call stats_out(state,.false.,aimag(current_overlap(p,iGf)), 'Im. <y(0)|y(t)>(rep ' // &
trim(adjustl(tmpc)) // ' i=' // trim(adjustl(tmgf)) //')')
end do
end do
if(t_real_time_fciqmc) then
do p = 1, numSnapshotOrbs
! if any orbitals are monitored, output their population
write(tmpc, '(i5)') snapShotOrbs(p)
call stats_out(state,.false.,allPopSnapshot(p),'Population of ' &
// trim(adjustl(tmpc)))
end do
end if
end if
! if we truncate walkers, print out the total truncated weight here
if(t_truncate_spawns) call stats_out(state, .false., AllTruncatedWeight, &
'trunc. Weight')
! If we are running multiple (replica) simulations, then we
! want to record the details of each of these
#ifdef PROG_NUMRUNS_
if(.not. t_real_time_fciqmc) then
do p = 1, inum_runs
write(tmpc, '(i5)') p
call stats_out (state, .false., AllTotParts(p), &
'Parts (' // trim(adjustl(tmpc)) // ')')
call stats_out (state, .false., AllNoatHF(p), &
'Ref (' // trim(adjustl(tmpc)) // ')')
call stats_out(state, .false., proje_ref_energy_offsets(p), &
'ref. energy offset('//trim(adjustl(tmpc))// ')')
call stats_out (state, .false., DiagSft(p) + Hii, &
'Shift (' // trim(adjustl(tmpc)) // ')')
#ifdef CMPLX_
call stats_out (state, .false., real(proje_iter(p) + OutputHii), &
'Tot ProjE real (' // trim(adjustl(tmpc)) // ')')
call stats_out (state, .false., aimag(proje_iter(p) + OutputHii), &
'Tot ProjE imag (' // trim(adjustl(tmpc)) // ')')
call stats_out (state, .false., real(AllHFOut(p) / StepsPrint), &
'ProjE Denom real (' // trim(adjustl(tmpc)) // ")")
call stats_out (state, .false., aimag(AllHFOut(p) / StepsPrint), &
'ProjE Denom imag (' // trim(adjustl(tmpc)) // ")")
call stats_out (state, .false., &
real((AllENumOut(p) + OutputHii*AllHFOut(p))) / StepsPrint,&
'ProjE Num real (' // trim(adjustl(tmpc)) // ")")
call stats_out (state, .false., &
aimag((AllENumOut(p) + OutputHii*AllHFOut(p))) / StepsPrint,&
'ProjE Num imag (' // trim(adjustl(tmpc)) // ")")
if (tTrialWavefunction .or. tStartTrialLater) then
call stats_out (state, .false., &
real(tot_trial_numerator(p) / StepsPrint), &
'TrialE Num real (' // trim(adjustl(tmpc)) // ")")
call stats_out (state, .false., &
aimag(tot_trial_numerator(p) / StepsPrint), &
'TrialE Num imag (' // trim(adjustl(tmpc)) // ")")
call stats_out (state, .false., &
real(tot_trial_denom(p) / StepsPrint), &
'TrialE Denom real (' // trim(adjustl(tmpc)) // ")")
call stats_out (state, .false., &
aimag(tot_trial_denom(p) / StepsPrint), &
'TrialE Denom imag (' // trim(adjustl(tmpc)) // ")")
end if
#else
call stats_out (state, .false., proje_iter(p) + OutputHii, &
'Tot ProjE (' // trim(adjustl(tmpc)) // ")")
call stats_out (state, .false., AllHFOut(p) / StepsPrint, &
'ProjE Denom (' // trim(adjustl(tmpc)) // ")")
call stats_out (state, .false., &
(AllENumOut(p) + OutputHii*AllHFOut(p)) / StepsPrint,&
'ProjE Num (' // trim(adjustl(tmpc)) // ")")
if (tTrialWavefunction .or. tStartTrialLater) then
call stats_out (state, .false., &
tot_trial_numerator(p) / StepsPrint, &
'TrialE Num (' // trim(adjustl(tmpc)) // ")")
call stats_out (state, .false., &
tot_trial_denom(p) / StepsPrint, &
'TrialE Denom (' // trim(adjustl(tmpc)) // ")")
end if
#endif
call stats_out (state, .false., &
AllNoBorn(p), &
'Born (' // trim(adjustl(tmpc)) // ')')
call stats_out (state, .false., &
AllNoDied(p), &
'Died (' // trim(adjustl(tmpc)) // ')')
call stats_out (state, .false., &
AllAnnihilated(p), &
'Annihil (' // trim(adjustl(tmpc)) // ')')
call stats_out (state, .false., &
AllNoAtDoubs(p), &
'Doubs (' // trim(adjustl(tmpc)) // ')')
end do
call stats_out(state,.false.,all_max_cyc_spawn, &
'MaxCycSpawn')
! Print overlaps between replicas at the end.
do p = 1, inum_runs
write(tmpc, '(i5)') p
if (tPrintReplicaOverlaps) then
do q = p+1, inum_runs
write(tmpc2, '(i5)') q
#ifdef CMPLX_
call stats_out(state, .false., replica_overlaps_real(p, q),&
'<psi_' // trim(adjustl(tmpc)) // '|' &
// 'psi_' // trim(adjustl(tmpc2)) &
// '> (real)')
call stats_out(state, .false., replica_overlaps_imag(p, q),&
'<psi_' // trim(adjustl(tmpc)) // '|' &
// 'psi_' // trim(adjustl(tmpc2)) &
// '> (imag)')
#else
call stats_out(state, .false., replica_overlaps_real(p, q),&
'<psi_' // trim(adjustl(tmpc)) // '|' &
// 'psi_' // trim(adjustl(tmpc2)) &
// '>')
#endif
end do
end if
end do
end if
#endif
if (tEN2) call stats_out(state,.true., en_pert_main%ndets_all, 'EN2 Dets.')
if (tTruncInitiator) then
call stats_out(state_i, .false., Iter + PreviousCycles, 'Iter.')
call stats_out(state_i, .false., AllTotWalkers, 'TotDets.')
do p = 1, inum_runs
write(tmpc, '(i5)') p
call stats_out(state_i, .false., AllTotParts(p), 'TotWalk. (' // trim(adjustl(tmpc)) // ")")
call stats_out(state_i, .false., AllAnnihilated(p), 'Annihil. (' // trim(adjustl(tmpc)) // ")")
call stats_out(state_i, .false., AllNoBorn(p), 'Born (' // trim(adjustl(tmpc)) // ")")
call stats_out(state_i, .false., AllNoDied(p), 'Died (' // trim(adjustl(tmpc)) // ")")
call stats_out(state_i, .false., AllNoRemoved(p), 'Removed Dets (' // trim(adjustl(tmpc)) // ")")
call stats_out(state_i, .false., AllNoAborted(p), 'AbortedWalks (' // trim(adjustl(tmpc)) // ")")
call stats_out(state_i, .false., AllNoInitDets(p), 'InitDets (' // trim(adjustl(tmpc)) // ")")
call stats_out(state_i, .false., AllNoNonInitDets(p), 'NonInitDets (' // trim(adjustl(tmpc)) // ")")
call stats_out(state_i, .false., AllNoInitWalk(p), 'InitWalks (' // trim(adjustl(tmpc)) // ")")
call stats_out(state_i, .false., AllNoNonInitWalk(p), 'NonInitWalks (' // trim(adjustl(tmpc)) // ")")
end do
end if
! And we are done
write(state%funit, *)
if (tTruncInitiator) write(state_i%funit, *)
if (tMCOutput) write(stdout, *)
call neci_flush(state%funit)
if (tTruncInitiator) call neci_flush(state_i%funit)
call neci_flush(stdout)
end if
end subroutine write_fcimcstats2