Commit 10f677a0 authored by Lorenz Huedepohl's avatar Lorenz Huedepohl
Browse files

Ability to sort and/or suppress small entries

parent 800ede4e
......@@ -20,22 +20,26 @@ module ftimings
character(len=name_length) :: name
integer(kind=C_INT64_T) :: micros
integer :: count
type(node_t), pointer :: firstChild
type(node_t), pointer :: lastChild
type(node_t), pointer :: parent
type(node_t), pointer :: nextSibling
type(node_t), pointer :: firstChild => NULL()
type(node_t), pointer :: lastChild => NULL()
type(node_t), pointer :: parent => NULL()
type(node_t), pointer :: nextSibling => NULL()
contains
procedure, pass :: new_child => node_new_child
procedure, pass :: get_child => node_get_child
procedure, pass :: print_graph => node_print_graph
procedure, pass :: get_micros => node_get_micros
procedure, pass :: is_running => node_is_running
procedure, pass :: sum_of_children => node_sum_of_children
procedure, pass :: sum_of_children_with_name => node_sum_of_children_with_name
procedure, pass :: sum_of_children_below => node_sum_of_children_below
procedure, pass :: print_graph => node_print_graph
procedure, pass :: sort_children => node_sort_children
end type
type timer_t
logical :: active = .false.
type(node_t), pointer :: root
type(node_t), pointer :: current_node
type(node_t), pointer :: root => NULL()
type(node_t), pointer :: current_node => NULL()
contains
procedure, pass :: start => timer_start
procedure, pass :: stop => timer_stop
......@@ -47,9 +51,11 @@ module ftimings
procedure, pass :: in_entries => timer_in_entries
procedure, pass :: get => timer_get
procedure, pass :: since => timer_since
procedure, pass :: sort => timer_sort
end type
character(len=name_length), parameter :: own = "(own)"
character(len=name_length), parameter :: below = "(below threshold)"
contains
......@@ -107,6 +113,22 @@ module ftimings
nullify(child)
end function
function node_get_micros(self) result(micros)
class(node_t), intent(in) :: self
integer(kind=C_INT64_T) :: micros
micros = self%micros
if (micros < 0) then
! we have not finished, give time up to NOW
micros = micros + microseconds_since_epoch()
endif
end function
function node_is_running(self) result(is_running)
class(node_t), intent(in) :: self
logical :: is_running
is_running = self%micros < 0
end function
recursive subroutine deallocate_node(entry)
type(node_t), intent(inout), pointer :: entry
type(node_t), pointer :: nextSibling
......@@ -130,11 +152,7 @@ module ftimings
sum_time = 0
cur_entry => self%firstChild
do while (associated(cur_entry))
sum_time = sum_time + cur_entry%micros
if (cur_entry%micros < 0) then
! child has not finished, give time up to NOW
sum_time = sum_time + microseconds_since_epoch()
endif
sum_time = sum_time + cur_entry%get_micros()
cur_entry => cur_entry%nextSibling
enddo
end function
......@@ -157,48 +175,142 @@ module ftimings
enddo
end function
recursive subroutine node_print_graph(self, indent_level)
function node_sum_of_children_below(self, threshold) result(sum_time)
class(node_t), intent(in) :: self
real(kind=rk), intent(in), optional :: threshold
type(node_t), pointer :: cur_entry
integer(kind=C_INT64_T) :: sum_time
sum_time = 0
if (.not. present(threshold)) then
return
endif
cur_entry => self%firstChild
do while (associated(cur_entry))
if (cur_entry%get_micros() * 1e-6_rk < threshold) then
sum_time = sum_time + cur_entry%get_micros()
endif
cur_entry => cur_entry%nextSibling
enddo
end function
subroutine node_print_line(indent_level, label, number, total)
integer, intent(in) :: indent_level
character(len=name_length), intent(in) :: label
integer(kind=C_INT64_T), intent(in) :: number, total
character(len=64) :: format_spec
write(format_spec,'("(",i0,"x,""|_ "",a",i0,",2x,f10.6,10x,f5.3)")') (indent_level + 1) * 2 + 2, name_length
write(*,format_spec) label, real(number, kind=rk) * 1e-6_rk, real(number, kind=rk) / real(total, kind=rk)
end subroutine
recursive subroutine node_print_graph(self, indent_level, threshold, is_sorted, total)
class(node_t), intent(in) :: self
integer, intent(in) :: indent_level
real(kind=rk), intent(in), optional :: threshold
logical, intent(in), optional :: is_sorted
integer(kind=C_INT64_T), intent(in), optional :: total
type(node_t), pointer :: node
character(len=64) :: format_spec
character(len=name_length) :: name, suffix
integer :: i
integer(kind=C_INT64_T) :: current_ms
integer(kind=C_INT64_T) :: current_us, own_us, below_threshold_us, total_act
real(kind=rk) :: threshold_act
logical :: is_sorted_act, print_own, print_threshold
if (self%micros < 0) then
! still running, give time up to NOW
current_ms = self%micros + microseconds_since_epoch()
write(format_spec,'("(",i0,"x,""|_ "",a",i0,",2x,f10.6,"" (running)"")")') indent_level * 2 + 2, len(self%name)
if (present(threshold)) then
threshold_act = threshold
else
current_ms = self%micros
write(format_spec,'("(",i0,"x,""|_ "",a",i0,",2x,f10.6)")') indent_level * 2 + 2, len(self%name)
threshold_act = 0
endif
if (self%count > 1) then
write(suffix, '(" (",i0,"x)")') self%count
write(name, '(a,a)') self%name(1:min(name_length - len(trim(suffix)), len(trim(self%name)))), trim(suffix)
if (present(is_sorted)) then
is_sorted_act = is_sorted
else
name = self%name
is_sorted_act = .false.
endif
current_us = self%get_micros()
if (present(total)) then
total_act = total
else
total_act = current_us
endif
own_us = current_us - self%sum_of_children()
below_threshold_us = self%sum_of_children_below(threshold)
print_own = associated(self%firstChild)
print_threshold = below_threshold_us > 0
if (self%is_running()) then
write(format_spec,'("(",i0,"x,""|_ "",a",i0,",2x,f10.6,10x,f5.3,"" (running)"")")') indent_level * 2 + 2, len(self%name)
else
write(format_spec,'("(",i0,"x,""|_ "",a",i0,",2x,f10.6,10x,f5.3)")') indent_level * 2 + 2, len(self%name)
endif
if (current_us * 1e-6_rk > threshold_act) then
if (self%count > 1) then
write(suffix, '(" (",i0,"x)")') self%count
write(name, '(a,a)') self%name(1:min(name_length - len(trim(suffix)), len(trim(self%name)))), trim(suffix)
else
name = self%name
endif
do i = len(trim(name)) + 2, name_length
name(i:i) = "."
end do
write(*,format_spec) name, real(current_us, kind=rk) * 1e-6_rk, real(current_us, kind=rk) / real(total_act, kind=rk)
else
return
endif
do i = len(trim(name)) + 2, name_length
name(i:i) = "."
end do
write(*,format_spec) name, real(current_ms) / 1e6
if (associated(self%firstChild)) then
write(format_spec,'("(",i0,"x,""|_ "",a",i0,",2x,f10.6)")') (indent_level + 1) * 2 + 2, len(self%name)
write(*,format_spec) own, real(current_ms - self%sum_of_children()) / 1e6
if ((.not. is_sorted_act) .and. print_own) then
call node_print_line(indent_level, own, own_us, current_us)
print_own = .false.
endif
if (associated(self%firstChild)) then
call self%firstChild%print_graph(indent_level + 1)
if ((.not. is_sorted_act) .and. print_threshold) then
call node_print_line(indent_level, below, below_threshold_us, current_us)
print_threshold = .false.
endif
if (associated(self%nextSibling)) then
call self%nextSibling%print_graph(indent_level)
node => self%firstChild
do while (associated(node))
if (print_own) then
if (node%get_micros() <= own_us) then
call node_print_line(indent_level, own, own_us, current_us)
print_own = .false.
endif
endif
if (print_threshold) then
if (node%get_micros() <= below_threshold_us) then
call node_print_line(indent_level, below, below_threshold_us, current_us)
print_threshold = .false.
endif
endif
call node%print_graph(indent_level + 1, threshold, is_sorted, current_us)
node => node%nextSibling
end do
if (print_own) then
call node_print_line(indent_level, own, own_us, current_us)
endif
if (print_threshold) then
call node_print_line(indent_level, below, below_threshold_us, current_us)
endif
end subroutine
! Public module interface:
subroutine timer_enable(self)
class(timer_t), intent(inout), target :: self
self%active = .true.
......@@ -215,8 +327,6 @@ module ftimings
is = self%active
end function
! Public module interface:
subroutine timer_start(self, name, replace)
class(timer_t), intent(inout), target :: self
character(len=*), intent(in) :: name
......@@ -240,49 +350,47 @@ module ftimings
if (.not. associated(self%current_node)) then
! First call to timer_start()
allocate(self%current_node)
self%root => self%current_node
node => self%current_node
nullify(node%parent)
nullify(node%firstChild)
nullify(node%lastChild)
nullify(node%nextSibling)
node%name = name
node%micros = - microseconds_since_epoch()
node%count = 1
else
! existing tree
if (string_eq(self%current_node%name, name)) then
!$omp critical
write(0,*) "Recursion error! Printing tree so far.."
write(0,*) "Got %start(""" // trim(name) // """), while %start(""" // trim(name) // """) was still active"
!$ 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
call self%root%print_graph(0)
!$omp end critical
stop "timer_start() while same timer was active"
endif
node => self%current_node%get_child(name)
if (.not. associated(node)) then
node => self%current_node%new_child(name)
else if (present(replace)) then
if (replace) then
node%micros = 0
node%count = 0
if (associated(node%firstChild)) then
call deallocate_node(node%firstChild)
nullify(node%firstChild)
nullify(node%lastChild)
endif
allocate(self%root)
self%root%name = "[Timings]"
self%root%micros = -microseconds_since_epoch()
self%root%count = 1
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
!$omp critical
write(0,*) "Recursion error! Printing tree so far.."
write(0,*) "Got %start(""" // trim(name) // """), while %start(""" // trim(name) // """) was still active"
!$ 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
call self%root%print_graph(0)
!$omp end critical
stop "timer_start() while same timer was active"
endif
node => self%current_node%get_child(name)
if (.not. associated(node)) then
node => self%current_node%new_child(name)
else if (present(replace)) then
if (replace) then
node%micros = 0
node%count = 0
if (associated(node%firstChild)) then
call deallocate_node(node%firstChild)
nullify(node%firstChild)
nullify(node%lastChild)
endif
endif
node%micros = node%micros - microseconds_since_epoch()
node%count = node%count + 1
endif
node%micros = node%micros - microseconds_since_epoch()
node%count = node%count + 1
self%current_node => node
......@@ -317,9 +425,11 @@ module ftimings
call self%free()
self%active = .false.
error = .true.
else if (len(trim(name)) == 0) then
write(0,'(a)') "Warning: Expected %stop(""" // trim(self%current_node%name) // """), but got %stop("""")"
else if (.not. string_eq(self%current_node%name, name)) then
write(0,'(a)') "Expected %stop(""" // trim(self%current_node%name) // """), but got %stop(""" // trim(name) // &
& """, disabling timings)"
& """), disabling timings"
call self%free()
self%active = .false.
error = .true.
......@@ -330,11 +440,12 @@ module ftimings
self%current_node%micros = self%current_node%micros + microseconds_since_epoch()
! climb up to parent
if (associated(self%current_node%parent)) then
self%current_node => self%current_node%parent
else
nullify(self%current_node)
if (.not. associated(self%current_node%parent)) then
write(0,'(a)') "Error: No valid parent node found for node '" // trim(name) // "'"
call self%free()
self%active = .false.
endif
self%current_node => self%current_node%parent
endif
!$omp end master
......@@ -350,9 +461,11 @@ module ftimings
nullify(self%current_node)
end subroutine
subroutine timer_print(self, name1, name2, name3, name4)
subroutine timer_print(self, name1, name2, name3, name4, threshold, is_sorted)
class(timer_t), intent(in), target :: self
character(len=*), intent(in), optional :: name1, name2, name3, name4
real(kind=rk), intent(in), optional :: threshold
logical, intent(in), optional :: is_sorted
type(node_t), pointer :: node
if (.not. self%active) then
......@@ -388,7 +501,7 @@ module ftimings
return
endif
end if
call node%print_graph(0)
call node%print_graph(0, threshold, is_sorted)
end subroutine
!> Return the sum of all entries with a certain name below
......@@ -443,12 +556,13 @@ module ftimings
name = name4
end if
s = real(node%sum_of_children_with_name(name), kind=rk) / 1e6_rk
s = real(node%sum_of_children_with_name(name), kind=rk) * 1e-6_rk
end function
function timer_get(self, name1, name2, name3, name4) result(s)
function timer_get(self, name1, name2, name3, name4, name5) result(s)
class(timer_t), intent(in), target :: self
character(len=*), intent(in), optional :: name1, name2, name3, name4
! this is clunky, but what can you do..
character(len=*), intent(in), optional :: name1, name2, name3, name4, name5
real(kind=rk) :: s
type(node_t), pointer :: node
......@@ -487,11 +601,18 @@ module ftimings
return
endif
end if
if (node%micros < 0) then
if (present(name5)) then
node => node%get_child(name5)
if (.not. associated(node)) then
write(0,'(a)') "Could not descend to """ // trim(name5) // """"
return
endif
end if
if (node%is_running()) then
write(0,'(a)') "Timer """ // trim(node%name) // """ not yet stopped"
return
endif
s = real(node%micros, kind=rk) / 1e6_rk
s = real(node%micros, kind=rk) * 1e-6_rk
end function
function timer_since(self, name1, name2, name3, name4) result(s)
......@@ -535,7 +656,114 @@ module ftimings
write(0,'(a)') "Timer """ // trim(node%name) // """ already stopped"
return
endif
s = real(node%micros + microseconds_since_epoch(), kind=rk) / 1e6_rk
s = real(node%micros + microseconds_since_epoch(), kind=rk) * 1e-6_rk
end function
! sort a node_t linked list and return the first and last element
subroutine sort_nodes(head, tail)
type(node_t), pointer, intent(inout) :: head, tail
type(node_t), pointer :: p, q, e
integer :: insize, nmerges, psize, qsize, i
if (.not. associated(head)) then
nullify(tail)
return
endif
insize = 1
do while (.true.)
p => head
nullify(head)
nullify(tail)
nmerges = 0
do while(associated(p))
nmerges = nmerges + 1
q => p
psize = 0
do i = 1, insize
psize = psize + 1
q => q%nextSibling
if (.not. associated(q)) then
exit
endif
end do
qsize = insize
do while (psize > 0 .or. (qsize > 0 .and. associated(q)))
if (psize == 0) then
e => q
q => q%nextSibling
qsize = qsize - 1
else if (qsize == 0 .or. (.not. associated(q))) then
e => p;
p => p%nextSibling
psize = psize - 1
else if (p%get_micros() >= q%get_micros()) then
e => p
p => p%nextSibling
psize = psize - 1
else
e => q
q => q%nextSibling
qsize = qsize - 1
end if
if (associated(tail)) then
tail%nextSibling => e
else
head => e
endif
tail => e
end do
p => q
end do
nullify(tail%nextSibling)
if (nmerges <= 1) then
return
endif
insize = insize * 2
end do
end subroutine
subroutine timer_sort(self)
class(timer_t), intent(inout), target :: self
type(node_t), pointer :: node
call sort_nodes(self%root, node)
node => self%root
do while (associated(node))
call node%sort_children()
node => node%nextSibling
enddo
end subroutine
recursive subroutine node_sort_children(self)
class(node_t), intent(inout) :: self
type(node_t), pointer :: node
call sort_nodes(self%firstChild, self%lastChild)
node => self%firstChild
do while (associated(node))
call node%sort_children()
node => node%nextSibling
enddo
end subroutine
end module
......@@ -5,17 +5,28 @@ program test_timings
!make ENABLE=EXPORT_DYNAMIC
!make DISABLE=OPENMP
use ftimings
use, intrinsic :: iso_c_binding, only : C_DOUBLE
use, intrinsic :: iso_c_binding, only : C_DOUBLE, C_INT
implicit none
type(timer_t) :: timer
integer, parameter :: rk = C_DOUBLE
integer :: i, j
integer :: i, j, dummy
interface
function sleep(seconds) bind(C, name="sleep")
import C_INT
integer(C_INT) :: sleep
integer(C_INT), intent(in), value :: seconds
end function
end interface
call timer%enable()
call timer%start("pre-program")
dummy = sleep(1)
call timer%stop("pre-program")
call timer%start("program")
do i = 1,100
do i = 1,20
! Test a bit more complex enable/disable decisions
if (i < 5 .or. mod(i,10) == 0) then
if (i < 5 .or. mod(i,4) == 0) then
call timer%enable()
else
call timer%disable()
......@@ -32,19 +43,19 @@ program test_timings
call timer%stop("cycle")
if (timer%is_enabled()) then
if (i == 90) then