ftimings.F90 72.3 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
! Copyright 2014 Lorenz Hüdepohl
!
! This file is part of ftimings.
!
! ftimings is free software: you can redistribute it and/or modify
! it under the terms of the GNU Lesser General Public License as published by
! the Free Software Foundation, either version 3 of the License, or
! (at your option) any later version.
!
! ftimings is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU Lesser General Public License for more details.
!
! You should have received a copy of the GNU Lesser General Public License
! along with ftimings.  If not, see <http://www.gnu.org/licenses/>.

18
19
20
21
#ifdef HAVE_CONFIG_H
#include "config-f90.h"
#endif

22
!> \mainpage Ftimings
23
!>
24
25
26
27
!> An almost pure-fortran attempt to play with tree structures, which evolved
!> into the timing library used e.g. by the VERTEX supernova code.
!>
!> All you need to know is contained in the \ref ftimings::timer_t derived type.
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
28
module ftimings
29
  use ftimings_type
30
  use ftimings_value
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
31
32
  use, intrinsic :: iso_c_binding, only : c_size_t, c_ptr, c_char, &
      c_associated, c_loc, c_f_pointer, c_funptr, c_f_procpointer, c_null_ptr, c_null_funptr, c_null_char
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
33
34
35
  implicit none
  save

36
  private
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
37

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
38
39
40
41
42
43
44
45
  ! do not clutter public namespace with value_t
  private :: &
    value_t, &
    null_value, &
    value_add, &
    value_minus, &
    value_inverse

46
47
48
49
  ! this is mainly needed for Doxygen, they are
  ! by implicitly reachable as type-bound procedures
  ! of timer_t, however Doxygen does not document them
  ! if they are not also public
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
50
51
  public timer_start, timer_stop, &
         timer_free, &
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
52
         timer_print, timer_print_node, &
53
         timer_enable, timer_disable, timer_is_enabled, &
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
54
55
56
57
         timer_in_entries, timer_in_entries_node, &
         timer_get, timer_get_node, &
         timer_since, timer_since_node, &
         timer_sort, &
58
59
60
         timer_set_print_options, &
         timer_measure_flops, &
         timer_measure_allocated_memory, &
61
         timer_measure_virtual_memory,   &
62
         timer_measure_max_allocated_memory,   &
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
63
64
65
         timer_measure_memory_bandwidth, &
         timer_register_error_handler, &
         node_get_child
66

67
68
69
  character(len=name_length), private, parameter :: own = "(own)"
  character(len=name_length), private, parameter :: below = "(below threshold)"

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
70
71
72
73
74
75
76
77
78
79
80
81
82
83
  !> An opaque handle that is provided for custom error callbacks
  type, abstract, public :: timer_error_handle_t
    contains
      procedure(timer_error_handle_free), pass, public, deferred :: free
  end type

  ! Used to provide C-API error handlers
  type, extends(timer_error_handle_t), private :: timer_c_error_handle_t
    type(c_funptr) :: c_handler = c_null_funptr
    type(c_ptr)    :: c_handle  = c_null_ptr
    contains
      procedure, pass, public :: free => c_error_handle_free
  end type

84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
  !> Type for a timer instance.
  !>
  !> Typical usage:
  !> \code{.f90}
  !>   type(timer_t) :: timer
  !>
  !>   call timer%enable()
  !>
  !>   call timer%start("section")
  !>     ...
  !>   call timer%start("subsection")
  !>     ...
  !>   call timer%stop("subsection")
  !>     ...
  !>   call timer%stop("section")
  !>
  !>   call timer%print()
  !> \endcode
  !>
  !> Every first call to timer%start() at a certain point in the graph
  !> allocates a small amount of memory. If the timer is no longer needed,
  !> all that memory can be freed again with
  !>
  !> \code{.f90}
  !>   call timer%free()
  !> \endcode
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
110
111
112
113
114
115
  !>
  !c>
  !c> /* Define timer_t as an opaque type */
  !c> struct ftimer_struct;
  !c> typedef struct ftimer_struct ftimer_t;
  !c>
116
  type, public :: timer_t
117
118
    logical, private :: active = .false.                         !< If set to .false., most operations return immediately without any action
    logical, private :: record_allocated_memory = .false.        !< IF set to .true., record also the current resident set size
119
    logical, private :: record_virtual_memory = .false.          !< IF set to .true., record also the virtual memory
120
    logical, private :: record_max_allocated_memory = .false.    !< IF set to .true., record also the max resident set size ("high water mark")
121
    logical, private :: record_flop_counts = .false.             !< If set to .true., record also FLOP counts via PAPI calls
122
    logical, private :: record_memory_bandwidth = .false.        !< If set to .true., record also memory bandwidth via PAPI calls
123
124

    logical, private :: print_allocated_memory = .false.
125
    logical, private :: print_max_allocated_memory = .false.
126
    logical, private :: print_virtual_memory = .false.
127
128
    logical, private :: print_flop_count = .false.
    logical, private :: print_flop_rate = .false.
129
    logical, private :: print_memory_transferred = .false.
130
131
132
    logical, private :: print_memory_bandwidth = .false.
    logical, private :: print_ai = .false.

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
133
134
    logical, private :: is_sorted = .false.

135
136
    type(node_t), private, pointer :: root => NULL()             !< Start of graph
    type(node_t), private, pointer :: current_node => NULL()     !< Current position in the graph
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
137
138
139
140

    procedure(timer_error_handler_t), private, pass, pointer:: error_handler => default_error_handler
    class(timer_error_handle_t), private, pointer :: error_handle => NULL()

Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
141
142
143
144
145
    contains
      procedure, pass :: start => timer_start
      procedure, pass :: stop => timer_stop
      procedure, pass :: free => timer_free
      procedure, pass :: print => timer_print
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
146
      procedure, pass :: print_node => timer_print_node
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
147
148
149
      procedure, pass :: enable => timer_enable
      procedure, pass :: disable => timer_disable
      procedure, pass :: is_enabled => timer_is_enabled
150
151
      procedure, pass :: measure_flops => timer_measure_flops
      procedure, pass :: measure_allocated_memory => timer_measure_allocated_memory
152
      procedure, pass :: measure_virtual_memory => timer_measure_virtual_memory
153
      procedure, pass :: measure_max_allocated_memory => timer_measure_max_allocated_memory
154
155
      procedure, pass :: measure_memory_bandwidth => timer_measure_memory_bandwidth
      procedure, pass :: set_print_options => timer_set_print_options
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
156
      procedure, pass :: in_entries => timer_in_entries
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
157
      procedure, pass :: in_entries_node => timer_in_entries_node
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
158
      procedure, pass :: get => timer_get
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
159
      procedure, pass :: get_node => timer_get_node
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
160
      procedure, pass :: since => timer_since
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
161
      procedure, pass :: since_node => timer_since_node
162
      procedure, pass :: sort => timer_sort
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
163
164
      procedure, pass :: register_error_handler => timer_register_error_handler
      procedure, private, pass :: error => timer_error
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
165
166
  end type

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
167
168
  !> Opaque type node_t, representing a graph node
  !>
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
169
170
171
172
173
174
175
176
177
178
179
180
  !c> struct ftimer_node_struct;
  !c> typedef struct ftimer_node_struct ftimer_node_t;
  type, public :: node_t
    character(len=name_length), private :: name = ""                    ! Descriptive name, used when printing the timings
    integer, private                    :: count = 0                    ! Number of node_stop calls
    type(value_t), private              :: value                        ! The actual counter data, see ftimings_values.F90
    logical, private                    :: is_running = .false.         ! .true. if still running
    type(node_t), private, pointer      :: firstChild => NULL()
    type(node_t), private, pointer      :: lastChild => NULL()
    type(node_t), private, pointer      :: parent => NULL()
    type(node_t), private, pointer      :: nextSibling => NULL()
    class(timer_t), private, pointer    :: timer => NULL()
181
    contains
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
182
183
184
185
186
187
188
189
190
191
192
193
      procedure, private, pass :: now => node_now
      procedure, private, pass :: start => node_start
      procedure, private, pass :: stop => node_stop
      procedure, private, pass :: get_value => node_get_value
      procedure, private, pass :: new_child => node_new_child
      procedure, public,  pass :: get_child => node_get_child
      procedure, private, pass :: sum_of_children => node_sum_of_children
      procedure, private, pass :: sum_of_descendants_with_name => node_sum_of_descendants_with_name
      procedure, private, pass :: sum_of_children_below => node_sum_of_children_below
      procedure, private, pass :: print => node_print
      procedure, private, pass :: print_graph => node_print_graph
      procedure, private, pass :: sort_children => node_sort_children
194
195
  end type

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
  !> Interface for error callback routine
  abstract interface
    subroutine timer_error_handler_t(timer, handle, message)
      import timer_t, timer_error_handle_t
      class(timer_t), intent(inout), target :: timer
      class(timer_error_handle_t), intent(in) :: handle
      character(len=*), intent(in) :: message
    end subroutine
  end interface

  abstract interface
    subroutine timer_error_handle_free(handle, timer)
      import timer_t, timer_error_handle_t
      class(timer_error_handle_t), intent(inout) :: handle
      class(timer_t), intent(inout) :: timer
    end subroutine
  end interface

214
  interface
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
215
    pure function microseconds_since_epoch() result(us) bind(C, name="ftimings_microseconds_since_epoch")
216
217
      use, intrinsic :: iso_c_binding
      implicit none
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
218
      integer(kind=c_int64_t) :: us
219
220
221
    end function
  end interface

222
223
#ifdef HAVE_LIBPAPI
  interface
224
    function flop_init() result(ret) bind(C, name="ftimings_flop_init")
225
226
      use, intrinsic :: iso_c_binding
      implicit none
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
227
      integer(kind=c_int) :: ret
228
229
    end function
  end interface
230
231

  interface
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
232
    pure subroutine flop_counter(flop) bind(C, name="ftimings_flop_counter")
233
234
      use, intrinsic :: iso_c_binding
      implicit none
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
235
      integer(kind=c_long_long), intent(out) :: flop
236
237
238
239
240
241
242
    end subroutine
  end interface
#endif

#ifdef HAVE_PERF
  interface
    function perf_memory_counters_init() result(ret) bind(C, name="ftimings_perf_memory_counters_init")
243
244
      use, intrinsic :: iso_c_binding
      implicit none
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
245
      integer(kind=c_int) :: ret
246
247
    end function
  end interface
248
249

  interface
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
250
    pure subroutine perf_memory_counters(mem_reads, mem_writes) bind(C, name="ftimings_perf_memory_counters")
251
252
      use, intrinsic :: iso_c_binding
      implicit none
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
253
      integer(kind=c_int64_t), intent(out) :: mem_reads, mem_writes
254
255
    end subroutine
  end interface
256
#endif
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
257

258
  interface
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
259
    pure function resident_set_size() result(rsssize) bind(C, name="ftimings_resident_set_size")
260
261
      use, intrinsic :: iso_c_binding
      implicit none
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
262
      integer(kind=c_long) :: rsssize
263
264
    end function
  end interface
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
265

266
  interface
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
267
    pure function virtual_memory() result(virtualmem) bind(C, name="ftimings_virtual_memory")
268
269
      use, intrinsic :: iso_c_binding
      implicit none
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
270
      integer(kind=c_long) :: virtualmem
271
272
273
    end function
  end interface

274
  interface
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
275
    pure function max_resident_set_size() result(maxrsssize) bind(C, name="ftimings_highwater_mark")
276
277
      use, intrinsic :: iso_c_binding
      implicit none
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
      integer(kind=c_long) :: maxrsssize
    end function
  end interface

  interface strnlen
    pure function strnlen(ptr, maxlen) result(size) bind(c, name="strnlen")
      use, intrinsic :: iso_c_binding
      type(c_ptr), intent(in), value :: ptr
      integer(kind=c_size_t), intent(in), value :: maxlen
      integer(kind=c_size_t) :: size
    end function
  end interface

  interface strlen
    pure function strlen(ptr) result(size) bind(c, name="strlen")
      use, intrinsic :: iso_c_binding
      type(c_ptr), intent(in), value :: ptr
      integer(kind=c_size_t) :: size
296
297
298
    end function
  end interface

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
299

300
  contains
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
301

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
302

303
  !> Activate the timer, without this, most methods are non-ops.
304
  !>
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
305
306
  subroutine timer_enable(self)
    class(timer_t), intent(inout), target :: self
307

Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
308
309
310
    self%active = .true.
  end subroutine

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346

  !> Register an error handler callback
  subroutine timer_register_error_handler(self, error_handler, handle)
    class(timer_t), intent(inout) :: self
    procedure(timer_error_handler_t), pointer, intent(in) :: error_handler
    class(timer_error_handle_t), pointer, intent(in) :: handle

    self%error_handler => error_handler
    self%error_handle => handle
  end subroutine


  !> Default error handler, print the message and deactivate and free the timer
  subroutine default_error_handler(timer, handle, message)
    use, intrinsic :: iso_fortran_env, only : error_unit
    class(timer_t), intent(inout), target :: timer
    class(timer_error_handle_t), intent(in), pointer :: handle
    character(len=*), intent(in) :: message

    write(error_unit,'(a,a)') "ftimings encountered an error, disabling this timer: ", message
    if (associated(handle)) then
      write(error_unit, '(a,a)') "  additionally: An error handle was provided without an error handler"
    endif
    stop 1
    call timer%disable()
    call timer%free()
  end subroutine


  subroutine timer_error(self, message)
    class(timer_t), intent(inout) :: self
    character(len=*), intent(in) :: message
    call self%error_handler(self%error_handle, message)
  end subroutine


347
348
349
  !> Call with enabled = .true. to also record amount of newly allocated memory.
  !> By default, memory usage is not recored. Call with .false. to deactivate again.
  !>
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
350
  !> This opens /proc/self/statm, parses it, and closes it again and is thus
351
352
353
354
355
356
357
358
359
  !> quite costly, use when appropriate.
  !>
  subroutine timer_measure_allocated_memory(self, enabled)
    class(timer_t), intent(inout) :: self
    logical, intent(in) :: enabled

    self%record_allocated_memory = enabled
  end subroutine

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
360

361
362
363
  !> Call with enabled = .true. to also record amount of newly created virtual memory.
  !> By default, memory usage is not recored. Call with .false. to deactivate again.
  !>
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
364
  !> This opens /proc/self/statm, parses it, and closes it again and is thus
365
366
367
368
369
370
371
372
373
  !> quite costly, use when appropriate.
  !>
  subroutine timer_measure_virtual_memory(self, enabled)
    class(timer_t), intent(inout) :: self
    logical, intent(in) :: enabled

    self%record_virtual_memory = enabled
  end subroutine

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
374

375
376
377
378
  !> Call with enabled = .true. to also record amount of newly increase of max.
  !> resident memory
  !> By default, memory usage is not recored. Call with .false. to deactivate again.
  !>
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
379
  !> This opens /proc/self/status, parses it, and closes it again and is thus
380
381
382
383
384
385
386
387
388
  !> quite costly, use when appropriate.
  !>
  subroutine timer_measure_max_allocated_memory(self, enabled)
    class(timer_t), intent(inout) :: self
    logical, intent(in) :: enabled

    self%record_max_allocated_memory = enabled
  end subroutine

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
389

390
391
392
393
  !> Call with enabled = .true. to also record the memory bandwidth with PAPI
  !> By default, this is not recorded. Call with .false. to deactivate again.
  !>
  subroutine timer_measure_memory_bandwidth(self, enabled)
394
395
396
    class(timer_t), intent(inout) :: self
    logical, intent(in) :: enabled

397
    if (enabled) then
398
399
#ifdef HAVE_PERF
      if (perf_memory_counters_init() == 1) then
400
401
        self%record_memory_bandwidth = .true.
      else
402
        write(0,'(a)') "ftimings: Could not initialize Linux perf, disabling memory counters"
403
404
405
        self%record_memory_bandwidth = .false.
      endif
#else
406
      write(0,'(a)') "ftimings: not compiled with Linux perf support, disabling memory counters"
407
408
409
410
411
412
      self%record_memory_bandwidth = .false.
#endif
    else
      ! explicitly set to .false. by caller
      self%record_memory_bandwidth = .false.
    endif
413
414
  end subroutine

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
415

416
417
418
419
420
421
422
423
424
  !> Call with enabled = .true. to also record FLOP counts via PAPI calls.
  !> By default no FLOPS are recored. Call with .false. to deactivate again.
  !>
  subroutine timer_measure_flops(self, enabled)
    class(timer_t), intent(inout) :: self
    logical, intent(in) :: enabled

    if (enabled) then
#ifdef HAVE_LIBPAPI
425
      if (flop_init() == 1) then
426
        self%record_flop_counts = .true.
427
428
429
      else
        write(0,'(a)') "ftimings: Could not initialize PAPI, disabling FLOP counter"
        self%record_flop_counts = .false.
430
431
432
433
434
435
      endif
#else
      write(0,'(a)') "ftimings: not compiled with PAPI support, disabling FLOP counter"
      self%record_flop_counts = .false.
#endif
    else
436
      ! Explicitly set to .false. by caller
437
438
439
440
      self%record_flop_counts = .false.
    endif
  end subroutine

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
441

442
  !> Deactivate the timer
443
  !>
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
444
445
446
447
448
  subroutine timer_disable(self)
    class(timer_t), intent(inout), target :: self
    self%active = .false.
  end subroutine

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
449

450
451
  !> Return whether the timer is currently running
  !>
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
452
453
454
455
456
457
  function timer_is_enabled(self) result(is)
    class(timer_t), intent(inout), target :: self
    logical :: is
    is = self%active
  end function

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
458

459
460
  !> Control what to print on following %print calls
  !>
461
  !> \param     print_allocated_memory       Amount of newly allocated,
462
  !>                                         resident memory
463
  !> \param     print_virtual_memory         Amount of newly created virtual
464
  !>                                         memory
465
  !> \param     print_max_allocated_memory   Amount of new increase of max.
466
467
468
  !>                                         resident memory ("high water mark")
  !> \param     print_flop_count             Number of floating point operations
  !> \param     print_flop_rate              Rate of floating point operations per second
469
470
  !> \param     print_memory_transferred        Memory transferred from RAM to CPU
  !> \param     print_memory_bandwidth       Memory bandwidth from RAM to CPU
471
  !> \param     print_ai                     Arithmetic intensity, that is number of
472
  !>                                         floating point operations per
473
  !>                                         number of bytes transferred
474
  !>                                         operations (currently untested)
475
  subroutine timer_set_print_options(self, &
476
477
478
479
480
481
        print_allocated_memory, &
        print_virtual_memory, &
        print_max_allocated_memory, &
        print_flop_count, &
        print_flop_rate, &
        print_memory_transferred, &
482
        print_memory_bandwidth, &
483
        print_ai)
484
485
486
    class(timer_t), intent(inout) :: self
    logical, intent(in), optional :: &
        print_allocated_memory, &
487
        print_virtual_memory, &
488
        print_max_allocated_memory, &
489
490
        print_flop_count, &
        print_flop_rate, &
491
        print_memory_transferred, &
492
493
494
495
496
497
498
499
500
501
        print_memory_bandwidth, &
        print_ai

    if (present(print_allocated_memory)) then
      self%print_allocated_memory = print_allocated_memory
      if ((.not. self%record_allocated_memory) .and. self%print_allocated_memory) then
         write(0,'(a)') "ftimings: Warning: RSS size recording was disabled, expect zeros!"
      endif
    endif

502
503
504
505
506
507
508
    if (present(print_virtual_memory)) then
      self%print_virtual_memory = print_virtual_memory
      if ((.not. self%record_virtual_memory) .and. self%print_virtual_memory) then
         write(0,'(a)') "ftimings: Warning: Virtual memory recording was disabled, expect zeros!"
      endif
    endif

509
510
511
512
513
514
515
    if (present(print_max_allocated_memory)) then
      self%print_max_allocated_memory = print_max_allocated_memory
      if ((.not. self%record_max_allocated_memory) .and. self%print_max_allocated_memory) then
         write(0,'(a)') "ftimings: Warning: HWM recording was disabled, expect zeros!"
      endif
    endif

516
517
518
519
520
521
522
523
524
525
526
527
528
529
    if (present(print_flop_count)) then
      self%print_flop_count = print_flop_count
      if ((.not. self%record_flop_counts) .and. self%print_flop_count) then
         write(0,'(a)') "ftimings: Warning: FLOP counter was disabled, expect zeros!"
      endif
    endif

    if (present(print_flop_rate)) then
      self%print_flop_rate = print_flop_rate
      if ((.not. self%record_flop_counts) .and. self%print_flop_rate) then
         write(0,'(a)') "ftimings: Warning: FLOP counter was disabled, expect zeros!"
      endif
    endif

530
531
532
533
    if (present(print_memory_transferred)) then
      self%print_memory_transferred = print_memory_transferred
      if ((.not. self%record_memory_bandwidth) .and. self%print_memory_transferred) then
         write(0,'(a)') "ftimings: Warning: Memory counters were disabled, expect zeros!"
534
535
536
537
538
      endif
    endif
    if (present(print_memory_bandwidth)) then
      self%print_memory_bandwidth = print_memory_bandwidth
      if ((.not. self%record_memory_bandwidth) .and. self%print_memory_bandwidth) then
539
         write(0,'(a)') "ftimings: Warning: Memory counters were disabled, expect zeros for memory bandwidth!"
540
541
542
543
544
545
546
547
548
549
550
      endif
    endif

    if (present(print_ai)) then
      self%print_ai = print_ai
      if (.not. (self%record_memory_bandwidth .and. self%record_flop_counts)) then
         write(0,'(a)') "ftimings: Warning: Memory bandwidth or FLOP counters were disabled, expect invalid values for AI"
      endif
    endif
  end subroutine

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
551

552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
  !> Start a timing section
  !>
  !> \param name        A descriptive name
  !> \param replace     If .true. (default .false.), replace any entries at the
  !>                    current position with the same name. If .false., add the
  !>                    time to a possibly existing entry
  !>
  !> Care must be taken to balance any invocations of %start() and %stop(), e.g.
  !> the following is valid
  !>
  !> \code{.f90}
  !>   call timer%start("A")
  !>   call timer%start("B")
  !>   call timer%stop("B")
  !>   call timer%stop("A")
  !> \endcode
  !>
  !> while the following is not
  !>
  !> \code{.f90}
  !>   call timer%start("A")
  !>   call timer%start("B")
  !>   call timer%stop("A")
  !>   call timer%stop("B")
  !> \endcode
  !>
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
578
  subroutine timer_start(self, name, replace)
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
579
580
581
582
#ifdef FTIMINGS_DEBUG
    use, intrinsic :: iso_fortran_env, only : error_unit
#endif
    !$ use omp_lib
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
    class(timer_t), intent(inout), target :: self
    character(len=*), intent(in)  :: name
    logical, intent(in), optional  :: replace
    type(node_t), pointer :: node
    !$ integer :: i

    if (.not. self%active) then
      return
    endif

    ! Deal with nested parallelization
    !$ do i = 0, omp_get_level()
    !$   if (omp_get_ancestor_thread_num(i) > 0) then
    !$     return
    !$   endif
    !$ end do

    !$omp master

    if (.not. associated(self%current_node)) then
      ! First call to timer_start()
604
      allocate(self%root)
605
      self%root%name = "[Root]"
606
      self%root%timer => self
607
      call self%root%start()
608
609
610
611
612
613
614
615
      nullify(self%root%firstChild)
      nullify(self%root%lastChild)
      nullify(self%root%parent)
      nullify(self%root%nextSibling)
      self%current_node => self%root
    endif

    if (string_eq(self%current_node%name, name)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
616
#ifdef FTIMINGS_DEBUG
617
      !$omp critical
618
619
      write(error_unit,*) "Recursion error! Printing tree so far.."
      write(error_unit,*) "Got %start(""" // trim(name) // """), while %start(""" // trim(name) // """) was still active"
620
621
622
623
624
625
      !$ write(*,*) "omp_get_thread_num() = ", omp_get_thread_num()
      !$ write(*,*) "omp_get_num_threads() = ", omp_get_num_threads()
      !$ write(*,*) "omp_get_level() = ", omp_get_level()
      !$ do i = 0, omp_get_level()
      !$   write(*,*) "omp_get_ancestor_thread_num(", i, ") = ", omp_get_ancestor_thread_num(i)
      !$ end do
626
      call self%root%print_graph(0)
627
      !$omp end critical
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
628
629
#endif
      call self%error("timer_start() while same timer was active")
630
631
632
633
    endif
    node => self%current_node%get_child(name)
    if (.not. associated(node)) then
      node => self%current_node%new_child(name)
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
634
      self%is_sorted = .false.
635
636
    else if (present(replace)) then
      if (replace) then
637
        node%value = null_value
638
639
640
641
642
        node%count = 0
        if (associated(node%firstChild)) then
          call deallocate_node(node%firstChild)
          nullify(node%firstChild)
          nullify(node%lastChild)
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
643
        endif
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
644
        self%is_sorted = .false.
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
645
646
      endif
    endif
647
648

    call node%start()
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
649
650
651
652
653
654
655

    self%current_node => node

    !$omp end master

  end subroutine

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
656

657
658
  !> End a timing segment, \sa timer_start
  !>
659
660
661
662
  !> \param name        The exact same name as was used for %start().
  !>                    If not provided, close the currently active region.
  !>                    If given, warns if it does not match the last %start()
  !>                    call on stderr and disables the current timer instance.
663
  !>
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
664
665
  subroutine timer_stop(self, name)
    class(timer_t), intent(inout), target :: self
666
    character(len=*), intent(in), optional :: name
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
667
    character(len=128) :: errormessage
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
    logical :: error
    !$ integer :: omp_get_level, omp_get_ancestor_thread_num
    !$ integer :: i

    if (.not. self%active) then
      return
    endif

    ! Deal with nested parallelization
    !$ do i = 0, omp_get_level()
    !$   if (omp_get_ancestor_thread_num(i) > 0) then
    !$     return
    !$   endif
    !$ end do

    !$omp master
    error = .false.

    if (.not. associated(self%current_node)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
687
      call self%error("Called timer_stop() without first calling any timer_start(), disabling timings")
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
688
      error = .true.
689
690
    else if (present(name)) then
      if (.not. string_eq(self%current_node%name, name)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
691
        write(errormessage,'(a)') "Expected %stop(""" // trim(self%current_node%name)  // """),&
692
                 & but got %stop(""" // trim(name) //  """), disabling timings"
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
693
        call self%error(trim(errormessage))
694
695
        error = .true.
      endif
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
696
697
698
    endif

    if (.not. error) then
699
      call self%current_node%stop()
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
700
701

      ! climb up to parent
702
      if (.not. associated(self%current_node%parent)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
703
704
        write(errormessage,'(a)') "Error: No valid parent node found for node '" // trim(self%current_node%name) // "'"
        call self%error(trim(errormessage))
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
705
      endif
706
      self%current_node => self%current_node%parent
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
707
708
709
710
711
712

    endif
    !$omp end master

  end subroutine

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
713

714
715
  !> Deallocate all objects associated with (but not including) self
  !>
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
716
717
718
719
720
721
722
  subroutine timer_free(self)
    class(timer_t), intent(inout), target :: self
    if (associated(self%root)) then
      call deallocate_node(self%root)
    endif
    nullify(self%root)
    nullify(self%current_node)
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
723
724
725
    if (associated(self%error_handle)) then
      call self%error_handle%free(self)
    endif
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
726
727
  end subroutine

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
728

729
730
731
732
733
734
  !> Print a timing graph
  !>
  !> \param name1       If given, first descend one level to the node with name name1
  !> \param name2       If given, also descend another level to the node with name2 there
  !> \param name3       etc.
  !> \param name4       etc.
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
735
736
  !> \param name5       etc.
  !> \param name6       etc.
737
738
  !> \param threshold   If given, subsume any entries with a value of threshold
  !>                    seconds in a single node "(below threshold)"
739
  !> \param unit        The unit number on which to print, default stdout
740
  !>
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
741
742
743
  subroutine timer_print(self, name1, name2, name3, name4, name5, name6, threshold, unit)
    class(timer_t), intent(inout), target :: self
    character(len=*), intent(in), optional :: name1, name2, name3, name4, name5, name6
744
    real(kind=rk), intent(in), optional :: threshold
745
    integer, intent(in), optional :: unit
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
746
    character(len=128) :: errormessage
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
747
748
749
750
751
752
753
754
755
756
    type(node_t), pointer :: node

    if (.not. self%active) then
      return
    endif

    node => self%root
    if (present(name1)) then
      node => node%get_child(name1)
      if (.not. associated(node)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
757
758
        write(errormessage,'(a)') "Could not descend to """ // trim(name1)  // """"
        call self%error(errormessage)
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
759
760
761
762
763
764
        return
      endif
    end if
    if (present(name2)) then
      node => node%get_child(name2)
      if (.not. associated(node)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
765
766
        write(errormessage,'(a)') "Could not descend to """ // trim(name2)  // """"
        call self%error(errormessage)
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
767
768
769
770
771
772
        return
      endif
    end if
    if (present(name3)) then
      node => node%get_child(name3)
      if (.not. associated(node)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
773
774
        write(errormessage,'(a)') "Could not descend to """ // trim(name3)  // """"
        call self%error(errormessage)
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
775
776
777
778
779
780
        return
      endif
    end if
    if (present(name4)) then
      node => node%get_child(name4)
      if (.not. associated(node)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
        write(errormessage,'(a)') "Could not descend to """ // trim(name4)  // """"
        call self%error(errormessage)
        return
      endif
    end if
    if (present(name5)) then
      node => node%get_child(name5)
      if (.not. associated(node)) then
        write(errormessage,'(a)') "Could not descend to """ // trim(name5)  // """"
        call self%error(errormessage)
        return
      endif
    end if
    if (present(name6)) then
      node => node%get_child(name6)
      if (.not. associated(node)) then
        write(errormessage,'(a)') "Could not descend to """ // trim(name6)  // """"
        call self%error(errormessage)
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
799
800
801
        return
      endif
    end if
802

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
    call timer_print_node(self, node, threshold, unit)

  end subroutine


  !> _node version of timer_print
  subroutine timer_print_node(self, node, threshold, unit)
    use, intrinsic :: iso_fortran_env, only : output_unit
    class(timer_t), intent(in), target :: self
    type(node_t), intent(in), pointer :: node
    real(kind=rk), intent(in), optional :: threshold
    integer, intent(in), optional :: unit

    integer :: unit_act

    character(len=64) :: format_spec

    ! I hate fortran's string handling
    character(len=name_length), parameter :: group = "Group"
    character(len=12), parameter :: seconds         = "         [s]"
    character(len=12), parameter :: fract           = "    fraction"
    character(len=12), parameter :: ram             = "  alloc. RAM"
    character(len=12), parameter :: vmem            = "   alloc. VM"
    character(len=12), parameter :: hwm             = "  alloc. HWM"
    character(len=12), parameter :: flop_rate       = "  float op/s"
    character(len=12), parameter :: flop_count      = "float op cnt"
    character(len=12), parameter :: mem_reads       = "    RAM read"
    character(len=12), parameter :: mem_writes      = " RAM written"
    character(len=12), parameter :: bandwidth_read  = "  RAM read/s"
    character(len=12), parameter :: bandwidth_write = " RAM write/s"
    character(len=12), parameter :: ai              = "arithm. Int."
    character(len=12), parameter :: dash            = "============"

    if (present(unit)) then
      unit_act = unit
    else
      unit_act = output_unit
    endif


843
844
845
846
847
848
    ! I really do hate it ..
    write(format_spec,'("("" /= "",a",i0,",2x,a12,1x,a12)")') name_length
    write(unit_act, format_spec, advance='no') adjustl(group), seconds, fract

    if (self%print_allocated_memory) then
      write(unit_act,'(1x,a12)',advance='no') ram
849
850
    endif

851
852
853
854
    if (self%print_virtual_memory) then
      write(unit_act,'(1x,a12)',advance='no') vmem
    endif

855
856
857
858
    if (self%print_max_allocated_memory) then
      write(unit_act,'(1x,a12)',advance='no') hwm
    endif

859
860
    if (self%print_flop_count) then
      write(unit_act,'(1x,a12)',advance='no') flop_count
861
    endif
862
863
    if (self%print_flop_rate) then
      write(unit_act,'(1x,a12)',advance='no') flop_rate
864
    endif
865
866
867
    if (self%print_memory_transferred) then
      write(unit_act,'(1x,a12)',advance='no') mem_reads
      write(unit_act,'(1x,a12)',advance='no') mem_writes
868
    endif
869
    if (self%print_memory_bandwidth) then
870
871
      write(unit_act,'(1x,a12)',advance='no') bandwidth_read
      write(unit_act,'(1x,a12)',advance='no') bandwidth_write
872
873
874
    endif
    if (self%print_ai) then
      write(unit_act,'(1x,a12)',advance='no') ai
875
876
    endif

877
    write(unit_act,'(a)') ""
878

879
880
881
882
883
    write(format_spec,'("("" |  "",a",i0,",1x,2(1x,a12))")') name_length
    write(unit_act, format_spec, advance='no') "", dash, dash

    if (self%print_allocated_memory) then
      write(unit_act,'(1x,a12)',advance='no') dash
884
    endif
885

886
887
888
889
    if (self%print_virtual_memory) then
      write(unit_act,'(1x,a12)',advance='no') dash
    endif

890
891
892
893
    if (self%print_max_allocated_memory) then
      write(unit_act,'(1x,a12)',advance='no') dash
    endif

894
895
    if (self%print_flop_count) then
      write(unit_act,'(1x,a12)',advance='no') dash
896
    endif
897
898
899
    if (self%print_flop_rate) then
      write(unit_act,'(1x,a12)',advance='no') dash
    endif
900
901
    if (self%print_memory_transferred) then
      write(unit_act,'(1x,a12)',advance='no') dash
902
903
904
905
      write(unit_act,'(1x,a12)',advance='no') dash
    endif
    if (self%print_memory_bandwidth) then
      write(unit_act,'(1x,a12)',advance='no') dash
906
      write(unit_act,'(1x,a12)',advance='no') dash
907
908
909
    endif
    if (self%print_ai) then
      write(unit_act,'(1x,a12)',advance='no') dash
910
911
    endif

912
    write(unit_act,'(a)') ""
913

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
914
    call node%print_graph(0, threshold, is_sorted=self%is_sorted, unit=unit)
915

Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
916
917
  end subroutine

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
918

Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
919
920
921
922
923
924
  !> Return the sum of all entries with a certain name below
  !> a given node. Specify the name with the last argument, the
  !> path to the starting point with the first few parameters
  !>
  !> \param name1, .., namei-1  The path to the starting node
  !> \param namei               The name of all sub-entries below this
925
  !>                            node which should be summed together
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
926
  !>
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
927
  !> For example, timer\%in_entries("foo", "bar", "parallel") returns
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
928
  !> the sum of all entries named "parallel" below the foo->bar node
929
  !>
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
930
931
  function timer_in_entries(self, name1, name2, name3, name4, name5, name6) result(s)
    class(timer_t), intent(inout), target :: self
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
932
    character(len=*), intent(in) :: name1
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
933
    character(len=*), intent(in), optional :: name2, name3, name4, name5, name6
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
934
935
936
    real(kind=rk) :: s
    type(node_t), pointer :: node ! the starting node
    character(len=name_length) :: name ! the name of the sections
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
937
    character(len=128) :: errormessage
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
938
939
940
941
942
943
944
945
946
947
948
949
950

    s = 0._rk

    if (.not. self%active) then
      return
    endif

    node => self%root
    name = name1

    if (present(name2)) then
      node => node%get_child(name1)
      if (.not. associated(node)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
951
952
        write(errormessage,'(a)') "Could not descend to """ // trim(name1)  // """"
        call self%error(errormessage)
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
953
954
955
956
957
958
959
        return
      endif
      name = name2
    end if
    if (present(name3)) then
      node => node%get_child(name2)
      if (.not. associated(node)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
960
961
        write(errormessage,'(a)') "Could not descend to """ // trim(name2)  // """"
        call self%error(errormessage)
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
962
963
964
965
966
967
968
        return
      endif
      name = name3
    end if
    if (present(name4)) then
      node => node%get_child(name3)
      if (.not. associated(node)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
969
970
        write(errormessage,'(a)') "Could not descend to """ // trim(name3)  // """"
        call self%error(errormessage)
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
971
972
973
974
        return
      endif
      name = name4
    end if
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
    if (present(name5)) then
      node => node%get_child(name4)
      if (.not. associated(node)) then
        write(errormessage,'(a)') "Could not descend to """ // trim(name4)  // """"
        call self%error(errormessage)
        return
      endif
      name = name5
    end if
    if (present(name6)) then
      node => node%get_child(name5)
      if (.not. associated(node)) then
        write(errormessage,'(a)') "Could not descend to """ // trim(name5)  // """"
        call self%error(errormessage)
        return
      endif
      name = name6
    end if

    s = self%in_entries_node(node, name)
  end function


  !> _node version of timer_in_entries
  pure function timer_in_entries_node(self, node, name) result(s)
    class(timer_t), intent(in), target :: self
    type(node_t), intent(in), pointer :: node ! the starting node
    character(len=name_length), intent(in) :: name ! the name of the sections
    real(kind=rk) :: s
    type(value_t) :: val

    s = 0._rk

    if (.not. self%active) then
      return
    endif
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
1011

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
1012
    val = node%sum_of_descendants_with_name(name)
1013
    s = real(val%micros, kind=rk) * 1e-6_rk
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
1014
1015
  end function

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
1016

1017
1018
1019
1020
1021
1022
1023
  !> Access a specific, already stopped entry of the graph by specifying the
  !> names of the nodes along the graph from the root node
  !>
  !> The result is only meaningfull if the entry was never appended by
  !> additional %start() calls.
  !>
  function timer_get(self, name1, name2, name3, name4, name5, name6) result(s)
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
1024
    class(timer_t), intent(inout), target :: self
1025
    ! this is clunky, but what can you do..
1026
    character(len=*), intent(in), optional :: name1, name2, name3, name4, name5, name6
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
1027
    character(len=128) :: errormessage
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
    real(kind=rk) :: s
    type(node_t), pointer :: node

    s = 0._rk

    if (.not. self%active) then
      return
    endif

    node => self%root
    if (present(name1)) then
      node => node%get_child(name1)
      if (.not. associated(node)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
1041
1042
        write(errormessage,'(a)') "Could not descend to """ // trim(name1)  // """"
        call self%error(trim(errormessage))
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
1043
1044
1045
1046
1047
1048
        return
      endif
    end if
    if (present(name2)) then
      node => node%get_child(name2)
      if (.not. associated(node)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
1049
1050
        write(errormessage,'(a)') "Could not descend to """ // trim(name2)  // """"
        call self%error(trim(errormessage))
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
1051
1052
1053
1054
1055
1056
        return
      endif
    end if
    if (present(name3)) then
      node => node%get_child(name3)
      if (.not. associated(node)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
1057
1058
        write(errormessage,'(a)') "Could not descend to """ // trim(name3)  // """"
        call self%error(trim(errormessage))
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
1059
1060
1061
1062
1063
1064
        return
      endif
    end if
    if (present(name4)) then
      node => node%get_child(name4)
      if (.not. associated(node)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
1065
1066
        write(errormessage,'(a)') "Could not descend to """ // trim(name4)  // """"
        call self%error(trim(errormessage))
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
1067
1068
1069
        return
      endif
    end if
1070
1071
1072
    if (present(name5)) then
      node => node%get_child(name5)
      if (.not. associated(node)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
1073
1074
        write(errormessage,'(a)') "Could not descend to """ // trim(name5)  // """"
        call self%error(trim(errormessage))
1075
1076
1077
        return
      endif
    end if
1078
1079
1080
    if (present(name6)) then
      node => node%get_child(name6)
      if (.not. associated(node)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
1081
1082
        write(errormessage,'(a)') "Could not descend to """ // trim(name6)  // """"
        call self%error(trim(errormessage))
1083
1084
1085
        return
      endif
    end if
1086
    if (node%is_running) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
      write(errormessage,'(a)') "Timer """ // trim(node%name) // """ not yet stopped"
      call self%error(trim(errormessage))
      return
    endif
    s = self%get_node(node)
  end function


  !> _node version of timer_get
  pure function timer_get_node(self, node) result(s)
    class(timer_t), intent(in) :: self
    type(node_t), pointer, intent(in) :: node
    real(kind=rk) :: s

    s = 0.0_rk

    if (.not. self%active) then
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
1104
1105
      return
    endif
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
1106

1107
    s = real(node%value%micros, kind=rk) * 1e-6_rk
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
1108
1109
  end function

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
1110

1111
1112
1113
1114
1115
1116
1117
  !> Access a specific, not yet stopped entry of the graph by specifying the
  !> names of the nodes along the graph from the root node and return the
  !> seconds that have passed since the entry was created.
  !>
  !> The result is only meaningfull if the entry was never appended by
  !> additional %start() calls.
  !>
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
1118
1119
1120
1121
  function timer_since(self, name1, name2, name3, name4, name5, name6) result(s)
    class(timer_t), intent(inout), target :: self
    character(len=*), intent(in), optional :: name1, name2, name3, name4, name5, name6
    character(len=128) :: errormessage
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
1122
1123
1124
1125
1126
    real(kind=rk) :: s
    type(node_t), pointer :: node

    s = 0._rk

Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
1127
1128
1129
1130
    if (.not. self%active) then
      return
    endif

Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
1131
1132
1133
1134
    node => self%root
    if (present(name1)) then
      node => node%get_child(name1)
      if (.not. associated(node)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
1135
1136
        write(errormessage,'(a)') "Could not descend to """ // trim(name1)  // """"
        call self%error(trim(errormessage))
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
1137
1138
1139
1140
1141
1142
        return
      endif
    end if
    if (present(name2)) then
      node => node%get_child(name2)
      if (.not. associated(node)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
1143
1144
        write(errormessage,'(a)') "Could not descend to """ // trim(name2)  // """"
        call self%error(trim(errormessage))
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
1145
1146
1147
1148
1149
1150
        return
      endif
    end if
    if (present(name3)) then
      node => node%get_child(name3)
      if (.not. associated(node)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
1151
1152
        write(errormessage,'(a)') "Could not descend to """ // trim(name3)  // """"
        call self%error(trim(errormessage))
Lorenz Hüdepohl's avatar
Lorenz Hüdepohl committed
1153
1154
1155
1156
1157
1158
        return
      endif
    end if
    if (present(name4)) then
      node => node%get_child(name4)
      if (.not. associated(node)) then
Lorenz Huedepohl's avatar
Lorenz Huedepohl committed
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176