| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | module progress_monitor | ||
| 2 | !> Periodic progress reporting and team-safe final result output for the | ||
| 3 | !> particle tracing loop. | ||
| 4 | !> | ||
| 5 | !> Once per finished particle a thread calls progress_tick. The OpenMP path | ||
| 6 | !> is only one atomic increment: no lock, formatted I/O, file access, clock | ||
| 7 | !> query, or callback runs while particles are being traced. The joined | ||
| 8 | !> caller emits one final event summary; the owner then writes result files | ||
| 9 | !> serially. The legacy interval argument is retained for input/API | ||
| 10 | !> compatibility but no longer triggers mid-trace output. | ||
| 11 | use, intrinsic :: iso_fortran_env, only: dp => real64, int64, output_unit | ||
| 12 | use diag_counters, only: N_EVENT, diag_counters_total, event_name | ||
| 13 | implicit none | ||
| 14 | private | ||
| 15 | |||
| 16 | public :: progress_init, progress_tick, progress_finalize | ||
| 17 | real(dp) :: t_start = 0.0d0 | ||
| 18 | integer :: n_total = 0 | ||
| 19 | integer(int64) :: n_done_shared = 0_int64 | ||
| 20 | logical :: active = .false. | ||
| 21 | |||
| 22 | contains | ||
| 23 | |||
| 24 | 48 | subroutine progress_init(interval_seconds, n_particles) | |
| 25 | real(dp), intent(in) :: interval_seconds | ||
| 26 | integer, intent(in) :: n_particles | ||
| 27 | |||
| 28 | 48 | n_total = n_particles | |
| 29 | 48 | n_done_shared = 0_int64 | |
| 30 | 48 | active = n_particles > 0 | |
| 31 | 48 | t_start = wall_time() | |
| 32 | 48 | end subroutine progress_init | |
| 33 | |||
| 34 | 715 | subroutine progress_tick() | |
| 35 | !> Call once per finished particle from inside the parallel region. | ||
| 36 |
2/2✓ Branch 0 taken 707 times.
✓ Branch 1 taken 8 times.
|
715 | if (.not. active) return |
| 37 | |||
| 38 | 707 | !$omp atomic update | |
| 39 | n_done_shared = n_done_shared + 1_int64 | ||
| 40 | !$omp end atomic | ||
| 41 | end subroutine progress_tick | ||
| 42 | |||
| 43 | 48 | subroutine progress_finalize() | |
| 44 | !> Emit one final summary so the event totals (e.g. fo_loss / fo_fault) | ||
| 45 | !> are always reported, including for runs too short to cross a periodic | ||
| 46 | !> interval. A silent fo_fault count would hide inversion faults. | ||
| 47 |
1/2✓ Branch 0 taken 48 times.
✗ Branch 1 not taken.
|
48 | if (n_total > 0) call emit(int(n_done_shared), wall_time(), .true.) |
| 48 | 48 | active = .false. | |
| 49 | 48 | end subroutine progress_finalize | |
| 50 | |||
| 51 | 48 | subroutine emit(n_done, now, final) | |
| 52 | integer, intent(in) :: n_done | ||
| 53 | real(dp), intent(in) :: now | ||
| 54 | logical, intent(in) :: final | ||
| 55 | |||
| 56 | real(dp) :: elapsed, frac, eta | ||
| 57 | integer :: id | ||
| 58 | integer(int64) :: total | ||
| 59 | character(len=512) :: events | ||
| 60 | |||
| 61 | 48 | elapsed = now - t_start | |
| 62 | 48 | frac = real(n_done, dp)/real(max(n_total, 1), dp) | |
| 63 | 48 | eta = 0.0d0 | |
| 64 |
1/2✓ Branch 0 taken 48 times.
✗ Branch 1 not taken.
|
48 | if (frac > 0.0d0) eta = elapsed*(1.0d0 - frac)/frac |
| 65 | |||
| 66 | 48 | events = '' | |
| 67 |
1/2✓ Branch 0 taken 48 times.
✗ Branch 1 not taken.
|
48 | if (final) then |
| 68 |
2/2✓ Branch 0 taken 1104 times.
✓ Branch 1 taken 48 times.
|
1152 | do id = 1, N_EVENT |
| 69 | 1104 | total = diag_counters_total(id) | |
| 70 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1104 times.
|
1152 | if (total > 0_int64) then |
| 71 | events = trim(events)//' '//event_name(id)//'='// & | ||
| 72 | ✗ | trim(int_to_str(total)) | |
| 73 | end if | ||
| 74 | end do | ||
| 75 | end if | ||
| 76 | |||
| 77 | write (output_unit, '(A, F6.2, A, I0, A, I0, A, F0.1, A, F0.1, A, A)') & | ||
| 78 | 48 | ' [progress] ', 100.0d0*frac, '% ', n_done, '/', n_total, & | |
| 79 | 96 | ' t=', elapsed, 's eta=', eta, 's', trim(events) | |
| 80 | 48 | flush (output_unit) | |
| 81 | 48 | end subroutine emit | |
| 82 | |||
| 83 | 96 | function wall_time() result(t) | |
| 84 | !> Portable wall-clock seconds; works with or without OpenMP. | ||
| 85 | real(dp) :: t | ||
| 86 | integer(int64) :: c, rate | ||
| 87 | |||
| 88 | 96 | call system_clock(c, rate) | |
| 89 | 96 | t = 0.0d0 | |
| 90 |
1/2✓ Branch 0 taken 96 times.
✗ Branch 1 not taken.
|
96 | if (rate > 0_int64) t = real(c, dp)/real(rate, dp) |
| 91 | 96 | end function wall_time | |
| 92 | |||
| 93 | ✗ | function int_to_str(value) result(str) | |
| 94 | integer(int64), intent(in) :: value | ||
| 95 | character(:), allocatable :: str | ||
| 96 | character(len=32) :: buf | ||
| 97 | |||
| 98 | ✗ | write (buf, '(I0)') value | |
| 99 | ✗ | str = trim(buf) | |
| 100 | ✗ | end function int_to_str | |
| 101 | |||
| 102 | end module progress_monitor | ||
| 103 |