ftimings_value.F90 4.55 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
#ifdef HAVE_CONFIG_H
#include "config-f90.h"
#endif

module ftimings_value
  use ftimings_type
  implicit none
  public

  interface
    function microseconds_since_epoch() result(us) bind(C, name="ftimings_microseconds_since_epoch")
      use, intrinsic :: iso_c_binding
      implicit none
      integer(kind=C_INT64_T) :: us
    end function
  end interface

#ifdef HAVE_LIBPAPI
  logical :: papi_supported = .false.

  interface
    function current_flop_count() result(cnt) bind(C, name="ftimings_current_flop_count")
      use, intrinsic :: iso_c_binding
      implicit none
      integer(kind=C_LONG_LONG) :: cnt
    end function
  end interface
#endif

30
31
32
33
34
35
36
37
  interface
    function resident_set_size() result(rsssize) bind(C, name="ftimings_resident_set_size")
      use, intrinsic :: iso_c_binding
      implicit none
      integer(kind=C_LONG) :: rsssize
    end function
  end interface

38
39
  type value_t
    integer(kind=C_INT64_T) :: micros = 0          ! Cumulative microseconds spent in this node
40
    integer(kind=C_LONG) :: rsssize = 0
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
#ifdef HAVE_LIBPAPI
    integer(kind=C_LONG_LONG) :: flop_count = 0    ! Cumulative floating point operations done in this node
#endif
    contains
      procedure, pass :: print => print_value
  end type

  interface operator(+)
    module procedure value_add
  end interface

  interface operator(-)
    module procedure value_minus
    module procedure value_inverse
  end interface

  type(value_t), parameter :: null_value = value_t( &
58
                                 micros = 0, rsssize = 0 &
59
60
61
62
63
64
65
66
67
#ifdef HAVE_LIBPAPI
                                ,flop_count = 0 &
#endif
                              )

  contains

  ! This is the function that actually returns the current timestamp and all other counters
  function now() result(val)
68
    use, intrinsic :: iso_c_binding
69
70
71
72
73
    type(value_t) :: val

    ! current time
    val%micros = microseconds_since_epoch()

74
75
76
    ! current memory
    val%rsssize = resident_set_size()

77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
#ifdef HAVE_LIBPAPI
    if (papi_supported) then
      ! flop counter
      val%flop_count = current_flop_count()
    else
      val%flop_count = 0
    endif
#endif
  end function


  pure elemental function value_add(a,b) result(c)
    class(value_t), intent(in) :: a, b
    type(value_t) :: c
    c%micros = a%micros + b%micros
92
    c%rsssize = a%rsssize + b%rsssize
93
94
95
96
97
98
99
100
101
#ifdef HAVE_LIBPAPI
    c%flop_count = a%flop_count + b%flop_count
#endif
  end function

  pure elemental function value_minus(a,b) result(c)
    class(value_t), intent(in) :: a, b
    type(value_t) :: c
    c%micros = a%micros - b%micros
102
    c%rsssize = a%rsssize - b%rsssize
103
104
105
106
107
108
109
110
111
#ifdef HAVE_LIBPAPI
    c%flop_count = a%flop_count - b%flop_count
#endif
  end function

  pure elemental function value_inverse(a) result(neg_a)
    class(value_t), intent(in) :: a
    type(value_t) :: neg_a
    neg_a%micros = - a%micros
112
    neg_a%rsssize = - a%rsssize
113
114
115
116
117
118
119
120
121
122
123
124
125
#ifdef HAVE_LIBPAPI
    neg_a%flop_count = - a%flop_count
#endif
  end function

  subroutine print_value(self, indent_level, label, total, unit)
    class(value_t), intent(in) :: self
    integer, intent(in) :: indent_level
    character(len=name_length), intent(in) :: label
    type(value_t), intent(in) :: total
    character(len=64) :: format_spec
    integer :: unit

126
    write(format_spec,'("(",i0,"x,""|_ "",a",i0,",2x,f12.6,5x,f8.3,5x,a8)")') indent_level * 2 + 1, name_length
127
    write(unit,format_spec,advance='no') &
128
129
130
131
132
      label, &
      real(self%micros, kind=rk) * 1e-6_rk, &
      real(self%micros, kind=rk) / real(total%micros, kind=rk), &
      nice_format(real(self%rsssize, kind=C_DOUBLE))

133
134
#ifdef HAVE_LIBPAPI
    if (papi_supported) then
135
      write(unit,'(5x,f8.2)',advance='no') real(self%flop_count, kind=C_DOUBLE) / self%micros
136
137
    endif
#endif
138
    write(unit,'(a)') ""
139
140
  end subroutine

141
  pure elemental function nice_format(flops) result(string)
142
    real(kind=C_DOUBLE), intent(in) :: flops
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
    character(len=8) :: string
    real(kind=C_DOUBLE), parameter :: &
        kibi = 2.0_C_DOUBLE**10, &
        mebi = 2.0_C_DOUBLE**20, &
        gibi = 2.0_C_DOUBLE**30, &
        tebi = 2.0_C_DOUBLE**40, &
        pebi = 2.0_C_DOUBLE**50

    if (abs(flops) >= pebi) then
      write(string,'(es8.1)') flops
    else if (abs(flops) >= tebi) then
      write(string,'(f5.1,'' Ti'')') flops / tebi
    else if (abs(flops) >= gibi) then
      write(string,'(f5.1,'' Gi'')') flops / gibi
    else if (abs(flops) >= mebi) then
      write(string,'(f5.1,'' Mi'')') flops / mebi
    else if (abs(flops) >= kibi) then
      write(string,'(f5.1,'' ki'')') flops / kibi
161
    else
162
      write(string,'(f5.1,''  '')') flops
163
164
165
166
    endif
  end function

end module