other/s_timer.F90
| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | submodule(m_timer) s_timer | ||
| 2 | #include "petsc.fi" | ||
| 3 | use, intrinsic :: iso_fortran_env, only: stdout_unit => output_unit | ||
| 4 | implicit none | ||
| 5 | contains | ||
| 6 | |||
| 7 | ✗ | module function MACRO_USE_ONLY_get_timer(name) result(timer_id) | |
| 8 | character(len=*), intent(in) :: name | ||
| 9 | integer :: timer_id | ||
| 10 | |||
| 11 | integer :: cdx | ||
| 12 | type(SmartTimer), pointer :: parent | ||
| 13 | |||
| 14 | ! Check if there is a running timer | ||
| 15 | ✗ | parent => find_latest_running_timer() | |
| 16 | |||
| 17 | ! Check if this timer has a child with the given name | ||
| 18 | ✗ | if (.not. associated(parent)) then | |
| 19 | ! Without any parent there is no point to do macro-based timing | ||
| 20 | timer_id = -1 | ||
| 21 | return | ||
| 22 | endif | ||
| 23 | |||
| 24 | ! Try to find an existing child timer with the given name | ||
| 25 | ✗ | do cdx = 1, parent%nr_children | |
| 26 | ✗ | if (.not. associated(parent%children(cdx)%p)) cycle | |
| 27 | ✗ | if (trim(parent%children(cdx)%p%name) == trim(name)) then | |
| 28 | ✗ | timer_id = parent%children(cdx)%p%our_timer_id | |
| 29 | ✗ | return | |
| 30 | end if | ||
| 31 | end do | ||
| 32 | |||
| 33 | ! A new child is born (the init method will update the parent's children list) | ||
| 34 | ✗ | timer_id = get_new_our_timer_id(name) | |
| 35 | ✗ | end function | |
| 36 | |||
| 37 | ✗ | module subroutine MACRO_USE_ONLY_start_timer(our_timer_id) | |
| 38 | integer, intent(in) :: our_timer_id | ||
| 39 | |||
| 40 | ✗ | if (our_timer_id > 0 .and. our_timer_id <= nr_our_timers) then | |
| 41 | ✗ | call our_timers(our_timer_id)%start() | |
| 42 | end if | ||
| 43 | ✗ | end subroutine MACRO_USE_ONLY_start_timer | |
| 44 | |||
| 45 | ✗ | module subroutine MACRO_USE_ONLY_stop_timer(our_timer_id) | |
| 46 | integer, intent(in) :: our_timer_id | ||
| 47 | |||
| 48 | ✗ | if (our_timer_id > 0 .and. our_timer_id <= nr_our_timers) then | |
| 49 | ✗ | call our_timers(our_timer_id)%stop() | |
| 50 | end if | ||
| 51 | ✗ | end subroutine MACRO_USE_ONLY_stop_timer | |
| 52 | |||
| 53 | ✗ | function get_new_our_timer_id(name) result(timer_id) | |
| 54 | character(len=*), intent(in) :: name | ||
| 55 | integer :: timer_id | ||
| 56 | |||
| 57 | ✗ | type(SmartTimer), allocatable :: our_timers_backup(:) | |
| 58 | |||
| 59 | ✗ | if (.not. allocated(our_timers)) then | |
| 60 | ✗ | allocate (our_timers(1000)) | |
| 61 | ✗ | nr_our_timers = 0 | |
| 62 | ✗ | else if (nr_our_timers == size(our_timers)) then | |
| 63 | ✗ | allocate (our_timers_backup, source=our_timers) | |
| 64 | ✗ | deallocate (our_timers) | |
| 65 | |||
| 66 | ! NOTE: this stage is the reason we return the ID rather than a pointer: IDs are invariant under re-allocation | ||
| 67 | ✗ | allocate (our_timers(size(our_timers_backup)*2)) | |
| 68 | ✗ | our_timers(1:nr_our_timers) = our_timers_backup(1:nr_our_timers) | |
| 69 | ✗ | deallocate (our_timers_backup) | |
| 70 | end if | ||
| 71 | |||
| 72 | ✗ | nr_our_timers = nr_our_timers + 1 | |
| 73 | ✗ | timer_id = nr_our_timers | |
| 74 | ✗ | call our_timers(timer_id)%init(name, our_id=timer_id) | |
| 75 | ✗ | end function get_new_our_timer_id | |
| 76 | |||
| 77 | 1 | module subroutine timer_init(this, name, comm, our_id) | |
| 78 | class(SmartTimer), intent(inout), target :: this | ||
| 79 | character(len=*), intent(in) :: name | ||
| 80 | integer, intent(in), optional :: comm | ||
| 81 | integer, intent(in), optional :: our_id | ||
| 82 | |||
| 83 | type(SmartTimer), pointer :: parent | ||
| 84 | integer :: ierr, nr_ranks | ||
| 85 | |||
| 86 |
1/2✗ Branch 2 → 3 not taken.
✓ Branch 2 → 4 taken 1 time.
|
1 | if (allocated(this%elapsed_times)) deallocate (this%elapsed_times) |
| 87 |
1/2✗ Branch 4 → 5 not taken.
✓ Branch 4 → 6 taken 1 time.
|
1 | if (allocated(this%children)) deallocate (this%children) |
| 88 |
1/2✗ Branch 6 → 7 not taken.
✓ Branch 6 → 8 taken 1 time.
|
1 | if (allocated(this%name)) deallocate (this%name) |
| 89 | |||
| 90 |
1/2✗ Branch 8 → 9 not taken.
✓ Branch 8 → 10 taken 1 time.
|
1 | if (present(comm)) then |
| 91 | ✗ | this%comm = comm | |
| 92 | else | ||
| 93 | 1 | this%comm = PETSC_COMM_WORLD | |
| 94 | end if | ||
| 95 | |||
| 96 |
1/2✗ Branch 12 → 13 not taken.
✓ Branch 12 → 14 taken 1 time.
|
1 | PetscCallMPI(MPI_Comm_size(this%comm, nr_ranks, ierr)) |
| 97 |
1/2✗ Branch 15 → 16 not taken.
✓ Branch 15 → 17 taken 1 time.
|
1 | PetscCallMPI(MPI_Comm_rank(this%comm, this%my_rank, ierr)) |
| 98 | |||
| 99 | 1 | this%start_time = 0.0_wp | |
| 100 | 1 | this%end_time = 0.0_wp | |
| 101 | 1 | this%elapsed_time = 0.0_wp | |
| 102 | 1 | this%start_count = 0 | |
| 103 |
7/14✗ Branch 17 → 18 not taken.
✓ Branch 17 → 19 taken 1 time.
✓ Branch 19 → 18 taken 1 time.
✗ Branch 19 → 20 not taken.
✓ Branch 20 → 21 taken 1 time.
✗ Branch 20 → 22 not taken.
✓ Branch 22 → 23 taken 1 time.
✗ Branch 22 → 24 not taken.
✗ Branch 24 → 25 not taken.
✓ Branch 24 → 26 taken 1 time.
✗ Branch 26 → 27 not taken.
✓ Branch 26 → 28 taken 1 time.
✗ Branch 28 → 29 not taken.
✓ Branch 28 → 30 taken 1 time.
|
3 | allocate (this%elapsed_times(nr_ranks)) |
| 104 |
2/2✓ Branch 31 → 32 taken 1 time.
✓ Branch 31 → 33 taken 1 time.
|
2 | this%elapsed_times = 0.0_wp |
| 105 |
2/4✗ Branch 33 → 34 not taken.
✓ Branch 33 → 35 taken 1 time.
✗ Branch 35 → 36 not taken.
✓ Branch 35 → 37 taken 1 time.
|
1 | allocate (character(len=len_trim(name)) :: this%name) |
| 106 |
3/6✗ Branch 37 → 38 not taken.
✓ Branch 37 → 39 taken 1 time.
✗ Branch 39 → 40 not taken.
✓ Branch 39 → 41 taken 1 time.
✓ Branch 41 → 42 taken 1 time.
✗ Branch 41 → 43 not taken.
|
1 | this%name = trim(name) |
| 107 | 1 | this%is_initialized = .true. | |
| 108 | 1 | this%is_running = .false. | |
| 109 | 1 | this%is_synced = .false. | |
| 110 | 1 | this%timer_id = register_timer(this) | |
| 111 | 1 | this%our_timer_id = -1 | |
| 112 |
1/2✗ Branch 44 → 45 not taken.
✓ Branch 44 → 46 taken 1 time.
|
1 | if (present(our_id)) this%our_timer_id = our_id |
| 113 | 1 | this%nr_children = 0 | |
| 114 | 1 | this%depth = 0 | |
| 115 |
2/4✗ Branch 46 → 47 not taken.
✓ Branch 46 → 48 taken 1 time.
✗ Branch 48 → 49 not taken.
✓ Branch 48 → 50 taken 1 time.
|
1 | allocate (this%children(0)) |
| 116 | |||
| 117 | 1 | parent => find_latest_running_timer() | |
| 118 |
1/2✗ Branch 50 → 51 not taken.
✓ Branch 50 → 53 taken 1 time.
|
1 | if (associated(parent)) then |
| 119 | ✗ | call append_child(parent, this) | |
| 120 | ✗ | this%depth = parent%depth + 1 | |
| 121 | end if | ||
| 122 | 2 | end subroutine timer_init | |
| 123 | |||
| 124 | 1 | module subroutine timer_destroy(this) | |
| 125 | type(SmartTimer), intent(inout) :: this | ||
| 126 | |||
| 127 |
1/4✗ Branch 2 → 3 not taken.
✓ Branch 2 → 4 taken 1 time.
✗ Branch 3 → 4 not taken.
✗ Branch 3 → 13 not taken.
|
1 | if (.not. this%is_initialized .and. this%timer_id <= 0) return |
| 128 | |||
| 129 | 1 | call detach_from_all_parents(this%timer_id) | |
| 130 | 1 | call unregister_timer(this%timer_id) | |
| 131 | |||
| 132 |
1/2✓ Branch 6 → 7 taken 1 time.
✗ Branch 6 → 8 not taken.
|
1 | if (allocated(this%elapsed_times)) then |
| 133 | 1 | deallocate (this%elapsed_times) | |
| 134 | end if | ||
| 135 | |||
| 136 |
1/2✓ Branch 8 → 9 taken 1 time.
✗ Branch 8 → 10 not taken.
|
1 | if (allocated(this%children)) then |
| 137 | 1 | deallocate (this%children) | |
| 138 | end if | ||
| 139 | |||
| 140 |
1/2✓ Branch 10 → 11 taken 1 time.
✗ Branch 10 → 12 not taken.
|
1 | if (allocated(this%name)) then |
| 141 | 1 | deallocate (this%name) | |
| 142 | end if | ||
| 143 | |||
| 144 | 1 | this%comm = 0 | |
| 145 | 1 | this%my_rank = 0 | |
| 146 | 1 | this%start_time = 0.0_wp | |
| 147 | 1 | this%end_time = 0.0_wp | |
| 148 | 1 | this%elapsed_time = 0.0_wp | |
| 149 | 1 | this%start_count = 0 | |
| 150 | 1 | this%timer_id = 0 | |
| 151 | 1 | this%nr_children = 0 | |
| 152 | 1 | this%depth = 0 | |
| 153 | 1 | this%is_initialized = .false. | |
| 154 | 1 | this%is_running = .false. | |
| 155 | 1 | this%is_synced = .false. | |
| 156 | end subroutine timer_destroy | ||
| 157 | |||
| 158 | 1 | module subroutine timer_start(this, reset) | |
| 159 | class(SmartTimer), intent(inout), target :: this | ||
| 160 | logical, intent(in), optional :: reset | ||
| 161 | |||
| 162 | logical :: reset_ | ||
| 163 | |||
| 164 |
1/2✗ Branch 2 → 3 not taken.
✓ Branch 2 → 4 taken 1 time.
|
1 | if (.not. this%is_initialized) then |
| 165 | ✗ | error stop 'SmartTimer must be initialized with init(name=...) before start().' | |
| 166 | end if | ||
| 167 | |||
| 168 | reset_ = .false. | ||
| 169 |
1/2✗ Branch 4 → 5 not taken.
✓ Branch 4 → 7 taken 1 time.
|
1 | if (present(reset)) reset_ = reset |
| 170 | |||
| 171 | ✗ | if (reset_) then | |
| 172 | ✗ | this%elapsed_time = 0.0_wp | |
| 173 | ✗ | this%start_count = 0 | |
| 174 | ✗ | this%is_synced = .false. | |
| 175 | end if | ||
| 176 | |||
| 177 | 1 | call cpu_time(this%start_time) | |
| 178 | 1 | this%start_count = this%start_count + 1 | |
| 179 | 1 | this%is_running = .true. | |
| 180 | 1 | this%is_synced = .false. | |
| 181 | 1 | end subroutine timer_start | |
| 182 | |||
| 183 | 1 | module subroutine timer_stop(this) | |
| 184 | class(SmartTimer), intent(inout) :: this | ||
| 185 | |||
| 186 |
1/2✓ Branch 2 → 3 taken 1 time.
✗ Branch 2 → 6 not taken.
|
1 | if (.not. this%is_initialized) return |
| 187 |
1/2✓ Branch 3 → 4 taken 1 time.
✗ Branch 3 → 6 not taken.
|
1 | if (.not. this%is_running) return |
| 188 | |||
| 189 | 1 | call cpu_time(this%end_time) | |
| 190 | 1 | this%elapsed_time = this%elapsed_time + this%end_time - this%start_time | |
| 191 | 1 | this%is_running = .false. | |
| 192 | 1 | this%is_synced = .false. | |
| 193 | end subroutine timer_stop | ||
| 194 | |||
| 195 | 1 | module subroutine timer_sync(this) | |
| 196 | class(SmartTimer), intent(inout), target :: this | ||
| 197 | |||
| 198 | integer :: ierr | ||
| 199 | |||
| 200 |
1/2✓ Branch 2 → 3 taken 1 time.
✗ Branch 2 → 8 not taken.
|
1 | if (.not. this%is_initialized) return |
| 201 |
1/2✓ Branch 3 → 4 taken 1 time.
✗ Branch 3 → 8 not taken.
|
1 | if (this%is_synced) return |
| 202 | |||
| 203 |
1/2✗ Branch 5 → 6 not taken.
✓ Branch 5 → 7 taken 1 time.
|
1 | PetscCallMPI(MPI_Allgather(this%elapsed_time, 1, MPI_WP, this%elapsed_times, 1, MPI_WP, this%comm, ierr)) |
| 204 | 1 | this%is_synced = .true. | |
| 205 | end subroutine timer_sync | ||
| 206 | |||
| 207 | ✗ | module function timer_nr_ranks(this) result(nr) | |
| 208 | class(SmartTimer), intent(in) :: this | ||
| 209 | integer :: nr | ||
| 210 | |||
| 211 | ✗ | if (.not. this%is_initialized) then | |
| 212 | nr = 0 | ||
| 213 | return | ||
| 214 | end if | ||
| 215 | |||
| 216 | ✗ | if (allocated(this%elapsed_times)) then | |
| 217 | ✗ | nr = size(this%elapsed_times) | |
| 218 | else | ||
| 219 | nr = 0 | ||
| 220 | end if | ||
| 221 | end function timer_nr_ranks | ||
| 222 | |||
| 223 | ✗ | module function timer_total(this) result(total_time) | |
| 224 | class(SmartTimer), intent(inout) :: this | ||
| 225 | real(wp) :: total_time | ||
| 226 | |||
| 227 | ✗ | if (.not. this%is_initialized) then | |
| 228 | total_time = -1.0_wp | ||
| 229 | return | ||
| 230 | end if | ||
| 231 | |||
| 232 | ✗ | call this%sync() | |
| 233 | ✗ | total_time = sum(this%elapsed_times) | |
| 234 | end function timer_total | ||
| 235 | |||
| 236 | ✗ | module function timer_minval(this) result(min_time) | |
| 237 | class(SmartTimer), intent(inout) :: this | ||
| 238 | real(wp) :: min_time | ||
| 239 | |||
| 240 | ✗ | if (.not. this%is_initialized) then | |
| 241 | min_time = -1.0_wp | ||
| 242 | return | ||
| 243 | end if | ||
| 244 | |||
| 245 | ✗ | call this%sync() | |
| 246 | ✗ | min_time = minval(this%elapsed_times) | |
| 247 | end function timer_minval | ||
| 248 | |||
| 249 | ✗ | module function timer_maxval(this) result(max_time) | |
| 250 | class(SmartTimer), intent(inout) :: this | ||
| 251 | real(wp) :: max_time | ||
| 252 | |||
| 253 | ✗ | if (.not. this%is_initialized) then | |
| 254 | max_time = -1.0_wp | ||
| 255 | return | ||
| 256 | end if | ||
| 257 | |||
| 258 | ✗ | call this%sync() | |
| 259 | ✗ | max_time = maxval(this%elapsed_times) | |
| 260 | end function timer_maxval | ||
| 261 | |||
| 262 | ✗ | module function timer_avgval(this) result(avg_time) | |
| 263 | class(SmartTimer), intent(inout) :: this | ||
| 264 | real(wp) :: avg_time | ||
| 265 | |||
| 266 | ✗ | if (.not. this%is_initialized) then | |
| 267 | avg_time = -1.0_wp | ||
| 268 | return | ||
| 269 | end if | ||
| 270 | |||
| 271 | ✗ | call this%sync() | |
| 272 | ✗ | avg_time = sum(this%elapsed_times) / size(this%elapsed_times) | |
| 273 | ✗ | end function timer_avgval | |
| 274 | |||
| 275 | 1 | module subroutine timer_print(this, metric, file_id, transform, show_percentage, sort, max_depth) | |
| 276 | use m_common, only: to_lower | ||
| 277 | |||
| 278 | class(SmartTimer), intent(inout), target :: this | ||
| 279 | character(len=*), intent(in), optional :: metric | ||
| 280 | integer, intent(in), optional :: file_id | ||
| 281 | procedure(user_function_1d_interface), optional :: transform | ||
| 282 | logical, intent(in), optional :: show_percentage | ||
| 283 | logical, intent(in), optional :: sort | ||
| 284 | integer, intent(in), optional :: max_depth | ||
| 285 | |||
| 286 | character(len=:), allocatable :: metric_ | ||
| 287 | character(len=:), allocatable :: header | ||
| 288 | integer :: out_unit, label_width, calls_width | ||
| 289 | logical :: show_percentage_, sort_ | ||
| 290 | integer :: max_depth_ | ||
| 291 | |||
| 292 | ✗ | if (.not. this%is_initialized) return | |
| 293 | |||
| 294 | 1 | metric_ = TIMER_METRIC_AVG | |
| 295 |
1/10✗ Branch 3 → 4 not taken.
✓ Branch 3 → 16 taken 1 time.
✗ Branch 7 → 8 not taken.
✗ Branch 7 → 9 not taken.
✗ Branch 9 → 10 not taken.
✗ Branch 9 → 11 not taken.
✗ Branch 11 → 12 not taken.
✗ Branch 11 → 13 not taken.
✗ Branch 13 → 14 not taken.
✗ Branch 13 → 15 not taken.
|
1 | if (present(metric)) metric_ = to_lower(trim(adjustl(metric))) |
| 296 | 1 | show_percentage_ = .false. | |
| 297 |
1/2✓ Branch 16 → 17 taken 1 time.
✗ Branch 16 → 18 not taken.
|
1 | if (present(show_percentage)) show_percentage_ = show_percentage |
| 298 | 1 | sort_ = .false. | |
| 299 |
1/2✓ Branch 18 → 19 taken 1 time.
✗ Branch 18 → 20 not taken.
|
1 | if (present(sort)) sort_ = sort |
| 300 | 1 | max_depth_ = -1 | |
| 301 |
1/2✓ Branch 20 → 21 taken 1 time.
✗ Branch 20 → 22 not taken.
|
1 | if (present(max_depth)) max_depth_ = max_depth |
| 302 | |||
| 303 | 1 | out_unit = stdout_unit | |
| 304 |
1/2✓ Branch 22 → 23 taken 1 time.
✗ Branch 22 → 24 not taken.
|
1 | if (present(file_id)) out_unit = file_id |
| 305 | |||
| 306 | 1 | call sync_tree(this) | |
| 307 | |||
| 308 |
1/2✗ Branch 25 → 26 not taken.
✓ Branch 25 → 28 taken 1 time.
|
1 | if (this%my_rank /= 0) return |
| 309 | |||
| 310 | 1 | label_width = 0 | |
| 311 | 1 | calls_width = len('calls') | |
| 312 | 1 | call collect_widths(this, 0, label_width, calls_width, max_depth_) | |
| 313 | |||
| 314 | ✗ | select case (metric_) | |
| 315 | case (TIMER_METRIC_MIN) | ||
| 316 | ✗ | header = pad_right('', label_width)//' | '//pad_left('calls', calls_width)//' | '//pad_left('min [s]', 12) | |
| 317 | case (TIMER_METRIC_MAX) | ||
| 318 | ✗ | header = pad_right('', label_width)//' | '//pad_left('calls', calls_width)//' | '//pad_left('max [s]', 12) | |
| 319 | case (TIMER_METRIC_TOTAL) | ||
| 320 | ✗ | header = pad_right('', label_width)//' | '//pad_left('calls', calls_width)//' | '//pad_left('total [s]', 12) | |
| 321 | case (TIMER_METRIC_ALL) | ||
| 322 | header = pad_right('', label_width)//' | '//pad_left('calls', calls_width)//' | '// & | ||
| 323 | ✗ | pad_left('min [s]', 12)//' | '//pad_left('avg [s]', 12)//' | '//pad_left('max [s]', 12) | |
| 324 | case default | ||
| 325 |
2/7✗ Branch 29 → 30 not taken.
✗ Branch 29 → 40 not taken.
✗ Branch 29 → 50 not taken.
✗ Branch 29 → 60 not taken.
✓ Branch 29 → 76 taken 1 time.
✓ Branch 83 → 84 taken 1 time.
✗ Branch 83 → 85 not taken.
|
1 | header = pad_right('', label_width)//' | '//pad_left('calls', calls_width)//' | '//pad_left('avg [s]', 12) |
| 326 | end select | ||
| 327 | |||
| 328 |
7/14✓ Branch 86 → 87 taken 1 time.
✗ Branch 86 → 104 not taken.
✓ Branch 89 → 90 taken 1 time.
✗ Branch 89 → 91 not taken.
✓ Branch 93 → 94 taken 1 time.
✗ Branch 93 → 95 not taken.
✗ Branch 95 → 96 not taken.
✓ Branch 95 → 97 taken 1 time.
✓ Branch 97 → 98 taken 1 time.
✗ Branch 97 → 99 not taken.
✓ Branch 99 → 100 taken 1 time.
✗ Branch 99 → 101 not taken.
✓ Branch 101 → 102 taken 1 time.
✗ Branch 101 → 103 not taken.
|
1 | if (show_percentage_) header = trim(header)//' | '//pad_left('pct_parent [%]', 14) |
| 329 | |||
| 330 | 1 | write (out_unit, '(A)') header | |
| 331 | 1 | call print_tree(this, 0, metric_, out_unit, label_width, calls_width, transform, show_percentage_, 0.0_wp, sort_, max_depth_) | |
| 332 |
3/8✓ Branch 2 → 3 taken 1 time.
✗ Branch 2 → 114 not taken.
✗ Branch 26 → 27 not taken.
✗ Branch 26 → 112 not taken.
✓ Branch 108 → 109 taken 1 time.
✗ Branch 108 → 110 not taken.
✓ Branch 110 → 111 taken 1 time.
✗ Branch 110 → 115 not taken.
|
2 | end subroutine timer_print |
| 333 | |||
| 334 | 1 | recursive subroutine sync_tree(node) | |
| 335 | class(SmartTimer), intent(inout), target :: node | ||
| 336 | integer :: i | ||
| 337 | |||
| 338 |
1/2✓ Branch 2 → 3 taken 1 time.
✗ Branch 2 → 11 not taken.
|
1 | if (.not. node%is_initialized) return |
| 339 | 1 | call node%sync() | |
| 340 | |||
| 341 |
1/2✗ Branch 5 → 6 not taken.
✓ Branch 5 → 10 taken 1 time.
|
1 | do i = 1, node%nr_children |
| 342 |
0/2✗ Branch 6 → 7 not taken.
✗ Branch 6 → 9 not taken.
|
1 | if (associated(node%children(i)%p)) call sync_tree(node%children(i)%p) |
| 343 | end do | ||
| 344 | end subroutine sync_tree | ||
| 345 | |||
| 346 | 1 | recursive subroutine collect_widths(node, level, max_label_width, max_calls_width, max_depth) | |
| 347 | class(SmartTimer), intent(in), target :: node | ||
| 348 | integer, intent(in) :: level | ||
| 349 | integer, intent(inout) :: max_label_width, max_calls_width | ||
| 350 | integer, intent(in) :: max_depth | ||
| 351 | |||
| 352 | integer :: i | ||
| 353 | character(len=32) :: calls_buf | ||
| 354 | character(len=:), allocatable :: label | ||
| 355 | |||
| 356 |
1/2✓ Branch 2 → 3 taken 1 time.
✗ Branch 2 → 21 not taken.
|
1 | if (.not. node%is_initialized) return |
| 357 |
2/4✓ Branch 3 → 4 taken 1 time.
✗ Branch 3 → 5 not taken.
✓ Branch 4 → 5 taken 1 time.
✗ Branch 4 → 21 not taken.
|
1 | if (max_depth >= 0 .and. level > max_depth) return |
| 358 | |||
| 359 |
1/2✓ Branch 6 → 7 taken 1 time.
✗ Branch 6 → 8 not taken.
|
1 | label = build_label(node%name, level) |
| 360 | 1 | max_label_width = max(max_label_width, len(label)) | |
| 361 | |||
| 362 | 1 | write (calls_buf, '(I0)') node%start_count | |
| 363 | 1 | max_calls_width = max(max_calls_width, len_trim(calls_buf)) | |
| 364 | |||
| 365 |
1/2✗ Branch 12 → 13 not taken.
✓ Branch 12 → 17 taken 1 time.
|
1 | do i = 1, node%nr_children |
| 366 |
0/2✗ Branch 13 → 14 not taken.
✗ Branch 13 → 16 not taken.
|
1 | if (associated(node%children(i)%p)) call collect_widths(node%children(i)%p, level + 1, max_label_width, max_calls_width, max_depth) |
| 367 | end do | ||
| 368 |
1/2✓ Branch 18 → 19 taken 1 time.
✗ Branch 18 → 20 not taken.
|
1 | end subroutine collect_widths |
| 369 | |||
| 370 | 1 | recursive subroutine print_tree(node, level, metric, out_unit, label_width, calls_width, transform, show_percentage, parent_value, sort, max_depth) | |
| 371 | use m_common, only: to_lower, sort_perm | ||
| 372 | |||
| 373 | class(SmartTimer), intent(inout), target :: node | ||
| 374 | integer, intent(in) :: level | ||
| 375 | character(len=*), intent(in) :: metric | ||
| 376 | integer, intent(in) :: out_unit | ||
| 377 | integer, intent(in) :: label_width, calls_width | ||
| 378 | procedure(user_function_1d_interface), optional :: transform | ||
| 379 | logical, intent(in) :: show_percentage | ||
| 380 | real(wp), intent(in) :: parent_value | ||
| 381 | logical, intent(in) :: sort | ||
| 382 | integer, intent(in) :: max_depth | ||
| 383 | |||
| 384 | integer :: i | ||
| 385 | 1 | integer, allocatable :: sorted_idx(:) | |
| 386 | 1 | real(wp), allocatable :: sort_vals(:) | |
| 387 | real(wp) :: c_min, c_avg, c_max, c_total | ||
| 388 | character(len=32) :: calls_buf | ||
| 389 | character(len=16) :: min_buf, avg_buf, max_buf, total_buf, pct_buf | ||
| 390 | character(len=:), allocatable :: label, row | ||
| 391 | real(wp) :: min_t, avg_t, max_t, total_t, current_value, pct | ||
| 392 | |||
| 393 |
1/2✓ Branch 2 → 3 taken 1 time.
✗ Branch 2 → 212 not taken.
|
1 | if (.not. node%is_initialized) return |
| 394 |
2/4✓ Branch 3 → 4 taken 1 time.
✗ Branch 3 → 5 not taken.
✓ Branch 4 → 5 taken 1 time.
✗ Branch 4 → 212 not taken.
|
1 | if (max_depth >= 0 .and. level > max_depth) return |
| 395 | |||
| 396 |
1/2✓ Branch 6 → 7 taken 1 time.
✗ Branch 6 → 8 not taken.
|
1 | label = build_label(node%name, level) |
| 397 | 1 | write (calls_buf, '(I0)') node%start_count | |
| 398 | |||
| 399 |
4/8✓ Branch 12 → 13 taken 1 time.
✗ Branch 12 → 15 not taken.
✗ Branch 13 → 14 not taken.
✓ Branch 13 → 17 taken 1 time.
✗ Branch 15 → 16 not taken.
✗ Branch 15 → 17 not taken.
✓ Branch 18 → 19 taken 1 time.
✓ Branch 18 → 20 taken 1 time.
|
3 | min_t = minval(node%elapsed_times) |
| 400 |
2/2✓ Branch 21 → 22 taken 1 time.
✓ Branch 21 → 23 taken 1 time.
|
2 | total_t = sum(node%elapsed_times) |
| 401 | 1 | avg_t = total_t / size(node%elapsed_times) | |
| 402 |
4/8✓ Branch 24 → 25 taken 1 time.
✗ Branch 24 → 27 not taken.
✗ Branch 25 → 26 not taken.
✓ Branch 25 → 29 taken 1 time.
✗ Branch 27 → 28 not taken.
✗ Branch 27 → 29 not taken.
✓ Branch 30 → 31 taken 1 time.
✓ Branch 30 → 32 taken 1 time.
|
3 | max_t = maxval(node%elapsed_times) |
| 403 | |||
| 404 |
1/2✗ Branch 32 → 33 not taken.
✓ Branch 32 → 38 taken 1 time.
|
1 | if (present(transform)) then |
| 405 | ✗ | min_t = transform(min_t) | |
| 406 | ✗ | avg_t = transform(avg_t) | |
| 407 | ✗ | max_t = transform(max_t) | |
| 408 | ✗ | total_t = transform(total_t) | |
| 409 | end if | ||
| 410 | |||
| 411 | 1 | write (min_buf, '(ES12.4)') min_t | |
| 412 | 1 | write (avg_buf, '(ES12.4)') avg_t | |
| 413 | 1 | write (max_buf, '(ES12.4)') max_t | |
| 414 | 1 | write (total_buf, '(ES12.4)') total_t | |
| 415 | 1 | current_value = selected_metric_value(metric, min_t, avg_t, max_t, total_t) | |
| 416 | |||
| 417 |
1/2✓ Branch 50 → 51 taken 1 time.
✗ Branch 50 → 52 not taken.
|
1 | if (level == 0) then |
| 418 | 1 | pct = 100.0_wp | |
| 419 | ✗ | else if (parent_value > 0.0_wp) then | |
| 420 | ✗ | pct = 100.0_wp*current_value/parent_value | |
| 421 | else | ||
| 422 | ✗ | pct = 0.0_wp | |
| 423 | end if | ||
| 424 | |||
| 425 | 1 | write (pct_buf, '(F14.2)') pct | |
| 426 | |||
| 427 | 2 | select case (to_lower(trim(metric))) | |
| 428 | case (TIMER_METRIC_MIN) | ||
| 429 | ✗ | row = pad_right(label, label_width)//' | '//pad_left(trim(calls_buf), calls_width)//' | '//trim(min_buf) | |
| 430 | case (TIMER_METRIC_MAX) | ||
| 431 | ✗ | row = pad_right(label, label_width)//' | '//pad_left(trim(calls_buf), calls_width)//' | '//trim(max_buf) | |
| 432 | case (TIMER_METRIC_TOTAL) | ||
| 433 | ✗ | row = pad_right(label, label_width)//' | '//pad_left(trim(calls_buf), calls_width)//' | '//trim(total_buf) | |
| 434 | case (TIMER_METRIC_ALL) | ||
| 435 | ✗ | row = pad_right(label, label_width)//' | '//pad_left(trim(calls_buf), calls_width)//' | '//trim(min_buf)//' | '//trim(avg_buf)//' | '//trim(max_buf) | |
| 436 | case default | ||
| 437 |
2/7✗ Branch 59 → 60 not taken.
✗ Branch 59 → 69 not taken.
✗ Branch 59 → 78 not taken.
✗ Branch 59 → 87 not taken.
✓ Branch 59 → 100 taken 1 time.
✓ Branch 106 → 107 taken 1 time.
✗ Branch 106 → 108 not taken.
|
1 | row = pad_right(label, label_width)//' | '//pad_left(trim(calls_buf), calls_width)//' | '//trim(avg_buf) |
| 438 | end select | ||
| 439 | |||
| 440 |
7/14✓ Branch 109 → 110 taken 1 time.
✗ Branch 109 → 126 not taken.
✓ Branch 112 → 113 taken 1 time.
✗ Branch 112 → 114 not taken.
✓ Branch 115 → 116 taken 1 time.
✗ Branch 115 → 117 not taken.
✗ Branch 117 → 118 not taken.
✓ Branch 117 → 119 taken 1 time.
✓ Branch 119 → 120 taken 1 time.
✗ Branch 119 → 121 not taken.
✓ Branch 121 → 122 taken 1 time.
✗ Branch 121 → 123 not taken.
✓ Branch 123 → 124 taken 1 time.
✗ Branch 123 → 125 not taken.
|
1 | if (show_percentage) row = trim(row)//' | '//trim(pct_buf) |
| 441 | |||
| 442 | 1 | write (out_unit, '(A)') row | |
| 443 | |||
| 444 |
2/4✓ Branch 129 → 130 taken 1 time.
✗ Branch 129 → 197 not taken.
✗ Branch 130 → 131 not taken.
✓ Branch 130 → 197 taken 1 time.
|
1 | if (sort .and. node%nr_children > 1) then |
| 445 | ✗ | allocate (sorted_idx(node%nr_children), sort_vals(node%nr_children)) | |
| 446 | ✗ | do i = 1, node%nr_children | |
| 447 | ✗ | if (associated(node%children(i)%p) .and. node%children(i)%p%is_initialized) then | |
| 448 | ✗ | c_min = minval(node%children(i)%p%elapsed_times) | |
| 449 | ✗ | c_total = sum(node%children(i)%p%elapsed_times) | |
| 450 | ✗ | c_avg = c_total / size(node%children(i)%p%elapsed_times) | |
| 451 | ✗ | c_max = maxval(node%children(i)%p%elapsed_times) | |
| 452 | ✗ | if (present(transform)) then | |
| 453 | ✗ | c_min = transform(c_min); c_avg = transform(c_avg) | |
| 454 | ✗ | c_max = transform(c_max); c_total = transform(c_total) | |
| 455 | end if | ||
| 456 | ✗ | sort_vals(i) = selected_metric_value(metric, c_min, c_avg, c_max, c_total) | |
| 457 | else | ||
| 458 | ✗ | sort_vals(i) = -huge(1.0_wp) | |
| 459 | end if | ||
| 460 | end do | ||
| 461 | ✗ | call sort_perm(sort_vals, sorted_idx) | |
| 462 | ✗ | do i = 1, node%nr_children | |
| 463 | ✗ | if (associated(node%children(sorted_idx(i))%p)) then | |
| 464 | call print_tree(node%children(sorted_idx(i))%p, level + 1, metric, out_unit, & | ||
| 465 | ✗ | label_width, calls_width, transform, show_percentage, current_value, sort, max_depth) | |
| 466 | end if | ||
| 467 | end do | ||
| 468 | ✗ | deallocate (sorted_idx, sort_vals) | |
| 469 | else | ||
| 470 |
1/2✗ Branch 198 → 199 not taken.
✓ Branch 198 → 203 taken 1 time.
|
1 | do i = 1, node%nr_children |
| 471 |
0/2✗ Branch 199 → 200 not taken.
✗ Branch 199 → 202 not taken.
|
1 | if (associated(node%children(i)%p)) then |
| 472 | ✗ | call print_tree(node%children(i)%p, level + 1, metric, out_unit, label_width, calls_width, transform, show_percentage, current_value, sort, max_depth) | |
| 473 | end if | ||
| 474 | end do | ||
| 475 | end if | ||
| 476 |
4/8✗ Branch 204 → 205 not taken.
✓ Branch 204 → 206 taken 1 time.
✗ Branch 206 → 207 not taken.
✓ Branch 206 → 208 taken 1 time.
✓ Branch 208 → 209 taken 1 time.
✗ Branch 208 → 210 not taken.
✓ Branch 210 → 211 taken 1 time.
✗ Branch 210 → 213 not taken.
|
1 | end subroutine print_tree |
| 477 | |||
| 478 | 1 | pure function selected_metric_value(metric, min_t, avg_t, max_t, total_t) result(value) | |
| 479 | use m_common, only: to_lower | ||
| 480 | character(len=*), intent(in) :: metric | ||
| 481 | real(wp), intent(in) :: min_t, avg_t, max_t, total_t | ||
| 482 | real(wp) :: value | ||
| 483 | |||
| 484 | 2 | select case (to_lower(trim(metric))) | |
| 485 | case (TIMER_METRIC_MIN) | ||
| 486 | ✗ | value = min_t | |
| 487 | case (TIMER_METRIC_MAX) | ||
| 488 | ✗ | value = max_t | |
| 489 | case (TIMER_METRIC_TOTAL) | ||
| 490 | ✗ | value = total_t | |
| 491 | case (TIMER_METRIC_ALL) | ||
| 492 | ✗ | value = avg_t | |
| 493 | case default | ||
| 494 |
1/5✗ Branch 3 → 4 not taken.
✗ Branch 3 → 5 not taken.
✗ Branch 3 → 6 not taken.
✗ Branch 3 → 7 not taken.
✓ Branch 3 → 8 taken 1 time.
|
1 | value = avg_t |
| 495 | end select | ||
| 496 | 1 | end function selected_metric_value | |
| 497 | |||
| 498 | 2 | pure function build_label(name, level) result(label) | |
| 499 | character(len=*), intent(in) :: name | ||
| 500 | integer, intent(in) :: level | ||
| 501 | character(len=:), allocatable :: label | ||
| 502 | |||
| 503 |
1/2✓ Branch 2 → 3 taken 2 times.
✗ Branch 2 → 5 not taken.
|
2 | if (level <= 0) then |
| 504 |
1/2✓ Branch 3 → 4 taken 2 times.
✗ Branch 3 → 14 not taken.
|
2 | label = trim(name) |
| 505 | else | ||
| 506 | ✗ | label = repeat(' ', level - 1)//'|- '//trim(name) | |
| 507 | end if | ||
| 508 | 2 | end function build_label | |
| 509 | |||
| 510 | 4 | pure function pad_left(text, width) result(out) | |
| 511 | character(len=*), intent(in) :: text | ||
| 512 | integer, intent(in) :: width | ||
| 513 | character(len=:), allocatable :: out | ||
| 514 | |||
| 515 | integer :: n | ||
| 516 | |||
| 517 | 4 | n = max(width, len_trim(text)) | |
| 518 |
5/10✗ Branch 2 → 3 not taken.
✓ Branch 2 → 4 taken 4 times.
✓ Branch 5 → 6 taken 9 times.
✓ Branch 5 → 7 taken 4 times.
✓ Branch 8 → 9 taken 4 times.
✗ Branch 8 → 10 not taken.
✗ Branch 10 → 11 not taken.
✗ Branch 10 → 12 not taken.
✓ Branch 12 → 13 taken 4 times.
✗ Branch 12 → 14 not taken.
|
13 | out = repeat(' ', n - len_trim(text))//trim(text) |
| 519 | 4 | end function pad_left | |
| 520 | |||
| 521 | 2 | pure function pad_right(text, width) result(out) | |
| 522 | character(len=*), intent(in) :: text | ||
| 523 | integer, intent(in) :: width | ||
| 524 | character(len=:), allocatable :: out | ||
| 525 | |||
| 526 | integer :: n | ||
| 527 | |||
| 528 | 2 | n = max(width, len_trim(text)) | |
| 529 |
5/10✗ Branch 2 → 3 not taken.
✓ Branch 2 → 4 taken 2 times.
✓ Branch 5 → 6 taken 21 times.
✓ Branch 5 → 7 taken 2 times.
✓ Branch 8 → 9 taken 2 times.
✗ Branch 8 → 10 not taken.
✗ Branch 10 → 11 not taken.
✗ Branch 10 → 12 not taken.
✓ Branch 12 → 13 taken 2 times.
✗ Branch 12 → 14 not taken.
|
23 | out = trim(text)//repeat(' ', n - len_trim(text)) |
| 530 | 2 | end function pad_right | |
| 531 | |||
| 532 | 1 | integer function register_timer(timer) result(id) | |
| 533 | class(SmartTimer), intent(inout), target :: timer | ||
| 534 | |||
| 535 | 1 | call ensure_registry_capacity(nr_timers + 1) | |
| 536 | 1 | nr_timers = nr_timers + 1 | |
| 537 | 1 | id = next_timer_id | |
| 538 | 1 | next_timer_id = next_timer_id + 1 | |
| 539 | 1 | timer_registry(nr_timers)%p => timer | |
| 540 | 1 | end function register_timer | |
| 541 | |||
| 542 | 1 | subroutine unregister_timer(id) | |
| 543 | integer, intent(in) :: id | ||
| 544 | |||
| 545 | integer :: i | ||
| 546 | |||
| 547 |
1/2✓ Branch 2 → 3 taken 1 time.
✗ Branch 2 → 10 not taken.
|
1 | if (.not. allocated(timer_registry)) return |
| 548 | |||
| 549 |
1/2✓ Branch 4 → 5 taken 1 time.
✗ Branch 4 → 9 not taken.
|
1 | do i = 1, nr_timers |
| 550 |
1/2✓ Branch 5 → 6 taken 1 time.
✗ Branch 5 → 8 not taken.
|
1 | if (.not. associated(timer_registry(i)%p)) cycle |
| 551 |
1/2✓ Branch 6 → 7 taken 1 time.
✗ Branch 6 → 8 not taken.
|
1 | if (timer_registry(i)%p%timer_id == id) then |
| 552 | 1 | nullify(timer_registry(i)%p) | |
| 553 | 1 | exit | |
| 554 | end if | ||
| 555 | end do | ||
| 556 | end subroutine unregister_timer | ||
| 557 | |||
| 558 | ✗ | function find_timer(id) result(timer) | |
| 559 | integer, intent(in) :: id | ||
| 560 | type(SmartTimer), pointer :: timer | ||
| 561 | |||
| 562 | integer :: i | ||
| 563 | |||
| 564 | timer => null() | ||
| 565 | ✗ | if (.not. allocated(timer_registry)) return | |
| 566 | |||
| 567 | ✗ | do i = 1, nr_timers | |
| 568 | ✗ | if (.not. associated(timer_registry(i)%p)) cycle | |
| 569 | ✗ | if (timer_registry(i)%p%timer_id == id) then | |
| 570 | timer => timer_registry(i)%p | ||
| 571 | return | ||
| 572 | end if | ||
| 573 | end do | ||
| 574 | end function find_timer | ||
| 575 | |||
| 576 | 1 | function find_latest_running_timer() result(timer) | |
| 577 | type(SmartTimer), pointer :: timer | ||
| 578 | |||
| 579 | integer :: i | ||
| 580 | integer :: best_depth, best_id | ||
| 581 | |||
| 582 | timer => null() | ||
| 583 | best_depth = -huge(1) | ||
| 584 | best_id = -huge(1) | ||
| 585 |
1/2✓ Branch 2 → 3 taken 1 time.
✗ Branch 2 → 13 not taken.
|
1 | if (.not. allocated(timer_registry)) return |
| 586 | |||
| 587 |
2/2✓ Branch 4 → 5 taken 1 time.
✓ Branch 4 → 12 taken 1 time.
|
2 | do i = 1, nr_timers |
| 588 |
1/2✓ Branch 5 → 6 taken 1 time.
✗ Branch 5 → 11 not taken.
|
1 | if (.not. associated(timer_registry(i)%p)) cycle |
| 589 |
1/2✗ Branch 6 → 7 not taken.
✓ Branch 6 → 11 taken 1 time.
|
1 | if (.not. timer_registry(i)%p%is_running) cycle |
| 590 | ✗ | if (timer_registry(i)%p%depth > best_depth .or. & | |
| 591 | 1 | (timer_registry(i)%p%depth == best_depth .and. timer_registry(i)%p%timer_id > best_id)) then | |
| 592 | best_depth = timer_registry(i)%p%depth | ||
| 593 | ✗ | best_id = timer_registry(i)%p%timer_id | |
| 594 | timer => timer_registry(i)%p | ||
| 595 | end if | ||
| 596 | end do | ||
| 597 | end function find_latest_running_timer | ||
| 598 | |||
| 599 | ✗ | subroutine append_child(parent, child) | |
| 600 | class(SmartTimer), intent(inout), target :: parent | ||
| 601 | class(SmartTimer), intent(inout), target :: child | ||
| 602 | |||
| 603 | integer :: i | ||
| 604 | |||
| 605 | ✗ | if (parent%timer_id == child%timer_id) return | |
| 606 | |||
| 607 | ✗ | do i = 1, parent%nr_children | |
| 608 | ✗ | if (.not. associated(parent%children(i)%p)) cycle | |
| 609 | ✗ | if (parent%children(i)%p%timer_id == child%timer_id) return | |
| 610 | end do | ||
| 611 | |||
| 612 | ✗ | call ensure_children_capacity(parent, parent%nr_children + 1) | |
| 613 | ✗ | parent%nr_children = parent%nr_children + 1 | |
| 614 | ✗ | parent%children(parent%nr_children)%p => child | |
| 615 | end subroutine append_child | ||
| 616 | |||
| 617 | 1 | subroutine remove_child(parent, child_id) | |
| 618 | class(SmartTimer), intent(inout), target :: parent | ||
| 619 | integer, intent(in) :: child_id | ||
| 620 | |||
| 621 | integer :: i | ||
| 622 | |||
| 623 |
1/2✗ Branch 3 → 4 not taken.
✓ Branch 3 → 12 taken 1 time.
|
1 | do i = 1, parent%nr_children |
| 624 | ✗ | if (.not. associated(parent%children(i)%p)) cycle | |
| 625 |
0/2✗ Branch 5 → 6 not taken.
✗ Branch 5 → 11 not taken.
|
1 | if (parent%children(i)%p%timer_id == child_id) then |
| 626 | ✗ | if (i < parent%nr_children) parent%children(i:parent%nr_children - 1) = parent%children(i + 1:parent%nr_children) | |
| 627 | ✗ | nullify(parent%children(parent%nr_children)%p) | |
| 628 | ✗ | parent%nr_children = parent%nr_children - 1 | |
| 629 | ✗ | return | |
| 630 | end if | ||
| 631 | end do | ||
| 632 | end subroutine remove_child | ||
| 633 | |||
| 634 | 1 | subroutine detach_from_all_parents(child_id) | |
| 635 | integer, intent(in) :: child_id | ||
| 636 | |||
| 637 | integer :: i | ||
| 638 | |||
| 639 |
1/2✓ Branch 2 → 3 taken 1 time.
✗ Branch 2 → 11 not taken.
|
1 | if (.not. allocated(timer_registry)) return |
| 640 | |||
| 641 |
2/2✓ Branch 4 → 5 taken 1 time.
✓ Branch 4 → 10 taken 1 time.
|
2 | do i = 1, nr_timers |
| 642 |
1/2✗ Branch 5 → 6 not taken.
✓ Branch 5 → 7 taken 1 time.
|
1 | if (.not. associated(timer_registry(i)%p)) cycle |
| 643 | 2 | call remove_child(timer_registry(i)%p, child_id) | |
| 644 | end do | ||
| 645 | end subroutine detach_from_all_parents | ||
| 646 | |||
| 647 | 1 | subroutine ensure_registry_capacity(required) | |
| 648 | integer, intent(in) :: required | ||
| 649 | |||
| 650 | type(TimerPointer), allocatable :: tmp(:) | ||
| 651 | integer :: new_size | ||
| 652 | |||
| 653 |
1/2✓ Branch 2 → 3 taken 1 time.
✗ Branch 2 → 17 not taken.
|
1 | if (.not. allocated(timer_registry)) then |
| 654 |
8/14✗ Branch 3 → 4 not taken.
✓ Branch 3 → 5 taken 1 time.
✓ Branch 5 → 4 taken 1 time.
✗ Branch 5 → 6 not taken.
✓ Branch 6 → 7 taken 1 time.
✗ Branch 6 → 8 not taken.
✗ Branch 8 → 9 not taken.
✓ Branch 8 → 10 taken 1 time.
✗ Branch 10 → 11 not taken.
✓ Branch 10 → 12 taken 1 time.
✗ Branch 12 → 13 not taken.
✓ Branch 12 → 14 taken 1 time.
✓ Branch 15 → 16 taken 8 times.
✓ Branch 15 → 39 taken 1 time.
|
11 | allocate (timer_registry(max(8, required))) |
| 655 | return | ||
| 656 | end if | ||
| 657 | |||
| 658 | ✗ | if (size(timer_registry) >= required) return | |
| 659 | |||
| 660 | new_size = size(timer_registry) | ||
| 661 | ✗ | do while (new_size < required) | |
| 662 | ✗ | new_size = 2*new_size | |
| 663 | end do | ||
| 664 | |||
| 665 | ✗ | allocate (tmp(new_size)) | |
| 666 | ✗ | tmp(1:nr_timers) = timer_registry(1:nr_timers) | |
| 667 | ✗ | call move_alloc(tmp, timer_registry) | |
| 668 | end subroutine ensure_registry_capacity | ||
| 669 | |||
| 670 | ✗ | subroutine ensure_children_capacity(parent, required) | |
| 671 | class(SmartTimer), intent(inout), target :: parent | ||
| 672 | integer, intent(in) :: required | ||
| 673 | |||
| 674 | type(TimerPointer), allocatable :: tmp(:) | ||
| 675 | integer :: new_size, old_size | ||
| 676 | |||
| 677 | ✗ | if (.not. allocated(parent%children)) then | |
| 678 | ✗ | allocate (parent%children(max(4, required))) | |
| 679 | return | ||
| 680 | end if | ||
| 681 | |||
| 682 | ✗ | old_size = size(parent%children) | |
| 683 | ✗ | if (old_size >= required) return | |
| 684 | |||
| 685 | new_size = old_size | ||
| 686 | ✗ | if (new_size == 0) new_size = 1 | |
| 687 | ✗ | do while (new_size < required) | |
| 688 | ✗ | new_size = 2*new_size | |
| 689 | end do | ||
| 690 | |||
| 691 | ✗ | allocate (tmp(new_size)) | |
| 692 | ✗ | if (parent%nr_children > 0) tmp(1:parent%nr_children) = parent%children(1:parent%nr_children) | |
| 693 | ✗ | call move_alloc(tmp, parent%children) | |
| 694 | end subroutine ensure_children_capacity | ||
| 695 | |||
| 696 | end submodule s_timer | ||
| 697 |