Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Timing routines for accounting
10 : !> \par History
11 : !> 02.2004 made a stacked version (of stacks...) [Joost VandeVondele]
12 : !> 11.2004 storable timer_envs (for f77 interface) [fawzi]
13 : !> 10.2005 binary search to speed up lookup in timeset [fawzi]
14 : !> 12.2012 Complete rewrite based on dictionaries. [ole]
15 : !> 01.2014 Collect statistics from all MPI ranks. [ole]
16 : !> \author JGH
17 : ! **************************************************************************************************
18 : MODULE timings_report
19 : USE callgraph, ONLY: callgraph_item_type,&
20 : callgraph_items
21 : USE cp_files, ONLY: close_file,&
22 : open_file
23 : USE kinds, ONLY: default_string_length,&
24 : dp,&
25 : int_8
26 : USE list, ONLY: list_destroy,&
27 : list_get,&
28 : list_init,&
29 : list_isready,&
30 : list_pop,&
31 : list_push,&
32 : list_size
33 : USE list_routinereport, ONLY: list_routinereport_type
34 : USE message_passing, ONLY: mp_para_env_type
35 : USE routine_map, ONLY: routine_map_get,&
36 : routine_map_haskey
37 : USE timings, ONLY: get_timer_env
38 : USE timings_base_type, ONLY: call_stat_type,&
39 : routine_report_type,&
40 : routine_stat_type
41 : USE timings_types, ONLY: timer_env_type
42 : USE util, ONLY: sort
43 : #include "../base/base_uses.f90"
44 :
45 : IMPLICIT NONE
46 : PRIVATE
47 :
48 : INTEGER, PUBLIC, PARAMETER :: cost_type_time = 17, cost_type_energy = 18
49 :
50 : PUBLIC :: timings_report_print, timings_report_callgraph
51 :
52 : CONTAINS
53 :
54 : ! **************************************************************************************************
55 : !> \brief Print accumulated information on timers
56 : !> \param iw ...
57 : !> \param r_timings ...
58 : !> \param sort_by_self_time ...
59 : !> \param cost_type ...
60 : !> \param report_maxloc ...
61 : !> \param para_env is needed to collect statistics from other nodes.
62 : !> \par History
63 : !> none
64 : !> \author JGH
65 : ! **************************************************************************************************
66 11087 : SUBROUTINE timings_report_print(iw, r_timings, sort_by_self_time, cost_type, report_maxloc, para_env)
67 : INTEGER, INTENT(IN) :: iw
68 : REAL(KIND=dp), INTENT(IN) :: r_timings
69 : LOGICAL, INTENT(IN) :: sort_by_self_time
70 : INTEGER, INTENT(IN) :: cost_type
71 : LOGICAL, INTENT(IN) :: report_maxloc
72 : TYPE(mp_para_env_type), INTENT(IN) :: para_env
73 :
74 : TYPE(list_routinereport_type) :: reports
75 : TYPE(routine_report_type), POINTER :: r_report
76 :
77 11087 : CALL list_init(reports)
78 11087 : CALL collect_reports_from_ranks(reports, cost_type, para_env)
79 :
80 11087 : IF (list_size(reports) > 0 .AND. iw > 0) THEN
81 5649 : CALL print_reports(reports, iw, r_timings, sort_by_self_time, cost_type, report_maxloc, para_env)
82 : END IF
83 :
84 : ! deallocate reports
85 4577487 : DO WHILE (list_size(reports) > 0)
86 4566400 : r_report => list_pop(reports)
87 4566400 : DEALLOCATE (r_report)
88 : END DO
89 11087 : CALL list_destroy(reports)
90 :
91 11087 : END SUBROUTINE timings_report_print
92 :
93 : ! **************************************************************************************************
94 : !> \brief Collects the timing or energy reports from all MPI ranks.
95 : !> \param reports ...
96 : !> \param cost_type ...
97 : !> \param para_env ...
98 : !> \author Ole Schuett
99 : ! **************************************************************************************************
100 11087 : SUBROUTINE collect_reports_from_ranks(reports, cost_type, para_env)
101 : TYPE(list_routinereport_type), INTENT(INOUT) :: reports
102 : INTEGER, INTENT(IN) :: cost_type
103 : TYPE(mp_para_env_type), INTENT(IN) :: para_env
104 :
105 : CHARACTER(LEN=default_string_length) :: routineN
106 : INTEGER :: local_routine_id, sending_rank
107 11087 : INTEGER, ALLOCATABLE, DIMENSION(:) :: collected
108 : REAL(KIND=dp) :: foobar
109 : REAL(KIND=dp), DIMENSION(2) :: dbuf
110 : TYPE(routine_report_type), POINTER :: r_report
111 : TYPE(routine_stat_type), POINTER :: r_stat
112 : TYPE(timer_env_type), POINTER :: timer_env
113 :
114 11087 : NULLIFY (r_stat, r_report, timer_env)
115 11087 : IF (.NOT. list_isready(reports)) THEN
116 0 : CPABORT("BUG")
117 : END IF
118 :
119 11087 : timer_env => get_timer_env()
120 :
121 : ! make sure all functions have been called so that list_size(timer_env%routine_stats)
122 : ! and the actual dictionary are consistent in the loop below, preventing out of bounds.
123 : ! this hack makes sure they are called before
124 11087 : routineN = ""
125 11087 : CALL para_env%bcast(routineN, 0)
126 11087 : sending_rank = 0
127 11087 : CALL para_env%max(sending_rank)
128 11087 : CALL para_env%sum(sending_rank)
129 11087 : foobar = 0.0_dp
130 11087 : CALL para_env%max(foobar)
131 11087 : dbuf = 0.0_dp
132 11087 : CALL para_env%maxloc(dbuf)
133 11087 : CALL para_env%sum(foobar)
134 : ! end hack
135 :
136 : ! Array collected is used as a bit field.
137 : ! It's of type integer in order to use the convenient MINLOC routine.
138 33261 : ALLOCATE (collected(list_size(timer_env%routine_stats)), SOURCE=0)
139 :
140 4566400 : DO
141 : ! does any rank have uncollected stats?
142 4577487 : sending_rank = -1
143 949376392 : IF (.NOT. ALL(collected == 1)) sending_rank = para_env%mepos
144 4577487 : CALL para_env%max(sending_rank)
145 4577487 : IF (sending_rank < 0) EXIT ! every rank got all routines collected
146 4566400 : IF (sending_rank == para_env%mepos) THEN
147 1123046665 : local_routine_id = MINLOC(collected, dim=1)
148 2306600 : r_stat => list_get(timer_env%routine_stats, local_routine_id)
149 2306600 : routineN = r_stat%routineN
150 : END IF
151 4566400 : CALL para_env%bcast(routineN, sending_rank)
152 :
153 : ! Create new report for routineN
154 4566400 : ALLOCATE (r_report)
155 4566400 : CALL list_push(reports, r_report)
156 4566400 : r_report%routineN = routineN
157 :
158 : ! If routineN was called on local node, add local stats
159 4566400 : IF (routine_map_haskey(timer_env%routine_names, routineN)) THEN
160 4549595 : local_routine_id = routine_map_get(timer_env%routine_names, routineN)
161 4549595 : collected(local_routine_id) = 1
162 4549595 : r_stat => list_get(timer_env%routine_stats, local_routine_id)
163 4549595 : r_report%max_total_calls = r_stat%total_calls
164 4549595 : r_report%sum_total_calls = r_stat%total_calls
165 4549595 : r_report%sum_stackdepth = r_stat%stackdepth_accu
166 4549595 : SELECT CASE (cost_type)
167 : CASE (cost_type_energy)
168 0 : r_report%max_icost = r_stat%incl_energy_accu
169 0 : r_report%sum_icost = r_stat%incl_energy_accu
170 0 : r_report%max_ecost = r_stat%excl_energy_accu
171 0 : r_report%sum_ecost = r_stat%excl_energy_accu
172 : CASE (cost_type_time)
173 4549595 : r_report%max_icost = r_stat%incl_walltime_accu
174 4549595 : r_report%sum_icost = r_stat%incl_walltime_accu
175 4549595 : r_report%max_ecost = r_stat%excl_walltime_accu
176 4549595 : r_report%sum_ecost = r_stat%excl_walltime_accu
177 : CASE DEFAULT
178 4549595 : CPABORT("BUG")
179 : END SELECT
180 : END IF
181 :
182 : ! collect stats of routineN via MPI
183 4566400 : CALL para_env%max(r_report%max_total_calls)
184 4566400 : CALL para_env%sum(r_report%sum_total_calls)
185 4566400 : CALL para_env%sum(r_report%sum_stackdepth)
186 :
187 : ! get value and rank of the maximum inclusive cost
188 13699200 : dbuf = [r_report%max_icost, REAL(para_env%mepos, KIND=dp)]
189 4566400 : CALL para_env%maxloc(dbuf)
190 4566400 : r_report%max_icost = dbuf(1)
191 4566400 : r_report%max_irank = INT(dbuf(2))
192 :
193 4566400 : CALL para_env%sum(r_report%sum_icost)
194 :
195 : ! get value and rank of the maximum exclusive cost
196 13699200 : dbuf = [r_report%max_ecost, REAL(para_env%mepos, KIND=dp)]
197 4566400 : CALL para_env%maxloc(dbuf)
198 4566400 : r_report%max_ecost = dbuf(1)
199 4566400 : r_report%max_erank = INT(dbuf(2))
200 :
201 4577487 : CALL para_env%sum(r_report%sum_ecost)
202 : END DO
203 :
204 11087 : END SUBROUTINE collect_reports_from_ranks
205 :
206 : ! **************************************************************************************************
207 : !> \brief Print the collected reports
208 : !> \param reports ...
209 : !> \param iw ...
210 : !> \param threshold ...
211 : !> \param sort_by_exclusiv_cost ...
212 : !> \param cost_type ...
213 : !> \param report_maxloc ...
214 : !> \param para_env ...
215 : !> \par History
216 : !> 01.2014 Refactored (Ole Schuett)
217 : !> \author JGH
218 : ! **************************************************************************************************
219 5649 : SUBROUTINE print_reports(reports, iw, threshold, sort_by_exclusiv_cost, cost_type, report_maxloc, para_env)
220 : TYPE(list_routinereport_type), INTENT(IN) :: reports
221 : INTEGER, INTENT(IN) :: iw
222 : REAL(KIND=dp), INTENT(IN) :: threshold
223 : LOGICAL, INTENT(IN) :: sort_by_exclusiv_cost
224 : INTEGER, INTENT(IN) :: cost_type
225 : LOGICAL, INTENT(IN) :: report_maxloc
226 : TYPE(mp_para_env_type), INTENT(IN) :: para_env
227 :
228 : CHARACTER(LEN=4) :: label
229 : CHARACTER(LEN=default_string_length) :: fmt, title
230 : INTEGER :: decimals, i, j, num_routines
231 5649 : INTEGER, ALLOCATABLE, DIMENSION(:) :: indices
232 : REAL(KIND=dp) :: asd, maxcost, mincost
233 5649 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: max_costs
234 : TYPE(routine_report_type), POINTER :: r_report_i, r_report_j
235 :
236 5649 : NULLIFY (r_report_i, r_report_j)
237 5649 : IF (.NOT. list_isready(reports)) THEN
238 0 : CPABORT("BUG")
239 : END IF
240 :
241 : ! are we printing timing or energy ?
242 5649 : SELECT CASE (cost_type)
243 : CASE (cost_type_energy)
244 0 : title = "E N E R G Y"
245 0 : label = "ENER"
246 : CASE (cost_type_time)
247 5649 : title = "T I M I N G"
248 5649 : label = "TIME"
249 : CASE DEFAULT
250 5649 : CPABORT("BUG")
251 : END SELECT
252 :
253 : ! write banner
254 5649 : WRITE (UNIT=iw, FMT="(/,T2,A)") REPEAT("-", 79)
255 5649 : WRITE (UNIT=iw, FMT="(T2,A,T80,A)") "-", "-"
256 5649 : WRITE (UNIT=iw, FMT="(T2,A,T35,A,T80,A)") "-", TRIM(title), "-"
257 5649 : WRITE (UNIT=iw, FMT="(T2,A,T80,A)") "-", "-"
258 5649 : WRITE (UNIT=iw, FMT="(T2,A)") REPEAT("-", 79)
259 5649 : IF (report_maxloc) THEN
260 : WRITE (UNIT=iw, FMT="(T2,A,T35,A,T41,A,T45,2A18,A8)") &
261 0 : "SUBROUTINE", "CALLS", " ASD", "SELF "//label, "TOTAL "//label, "MAXRANK"
262 : ELSE
263 : WRITE (UNIT=iw, FMT="(T2,A,T35,A,T41,A,T45,2A18)") &
264 5649 : "SUBROUTINE", "CALLS", " ASD", "SELF "//label, "TOTAL "//label
265 : END IF
266 :
267 : WRITE (UNIT=iw, FMT="(T33,A)") &
268 5649 : "MAXIMUM AVERAGE MAXIMUM AVERAGE MAXIMUM"
269 :
270 : ! sort statistics
271 5649 : num_routines = list_size(reports)
272 16947 : ALLOCATE (max_costs(num_routines))
273 2312249 : DO i = 1, num_routines
274 2306600 : r_report_i => list_get(reports, i)
275 2312249 : IF (sort_by_exclusiv_cost) THEN
276 1440 : max_costs(i) = r_report_i%max_ecost
277 : ELSE
278 2305160 : max_costs(i) = r_report_i%max_icost
279 : END IF
280 : END DO
281 16947 : ALLOCATE (indices(num_routines))
282 5649 : CALL sort(max_costs, num_routines, indices)
283 :
284 2312249 : maxcost = MAXVAL(max_costs)
285 5649 : mincost = maxcost*threshold
286 :
287 : ! adjust fmt dynamically based on the max walltime.
288 : ! few clocks have more than 3 digits resolution, so stop there
289 5649 : decimals = 3
290 5649 : IF (maxcost >= 10000) decimals = 2
291 0 : IF (maxcost >= 100000) decimals = 1
292 5649 : IF (maxcost >= 1000000) decimals = 0
293 5649 : IF (report_maxloc) THEN
294 : WRITE (UNIT=fmt, FMT="(A,I0,A)") &
295 0 : "(T2,A30,1X,I7,1X,F4.1,4(1X,F8.", decimals, "),I8)"
296 : ELSE
297 : WRITE (UNIT=fmt, FMT="(A,I0,A)") &
298 5649 : "(T2,A30,1X,I7,1X,F4.1,4(1X,F8.", decimals, "))"
299 : END IF
300 :
301 : !write output
302 2312249 : DO i = num_routines, 1, -1
303 2312249 : IF (max_costs(i) >= mincost) THEN
304 294408 : j = indices(i)
305 294408 : r_report_j => list_get(reports, j)
306 : ! average stack depth
307 : asd = REAL(r_report_j%sum_stackdepth, KIND=dp)/ &
308 294408 : REAL(MAX(1_int_8, r_report_j%sum_total_calls), KIND=dp)
309 294408 : IF (report_maxloc) THEN
310 : WRITE (UNIT=iw, FMT=fmt) &
311 0 : ADJUSTL(r_report_j%routineN(1:31)), &
312 0 : r_report_j%max_total_calls, &
313 0 : asd, &
314 0 : r_report_j%sum_ecost/para_env%num_pe, &
315 0 : r_report_j%max_ecost, &
316 0 : r_report_j%sum_icost/para_env%num_pe, &
317 0 : r_report_j%max_icost, &
318 0 : r_report_j%max_erank
319 : ELSE
320 : WRITE (UNIT=iw, FMT=fmt) &
321 294408 : ADJUSTL(r_report_j%routineN(1:31)), &
322 294408 : r_report_j%max_total_calls, &
323 294408 : asd, &
324 294408 : r_report_j%sum_ecost/para_env%num_pe, &
325 294408 : r_report_j%max_ecost, &
326 294408 : r_report_j%sum_icost/para_env%num_pe, &
327 588816 : r_report_j%max_icost
328 : END IF
329 : END IF
330 : END DO
331 5649 : WRITE (UNIT=iw, FMT="(T2,A,/)") REPEAT("-", 79)
332 :
333 5649 : END SUBROUTINE print_reports
334 :
335 : ! **************************************************************************************************
336 : !> \brief Write accumulated callgraph information as cachegrind-file.
337 : !> http://kcachegrind.sourceforge.net/cgi-bin/show.cgi/KcacheGrindCalltreeFormat
338 : !> \param filename ...
339 : !> \par History
340 : !> 12.2012 initial version[ole]
341 : !> \author Ole Schuett
342 : ! **************************************************************************************************
343 1 : SUBROUTINE timings_report_callgraph(filename)
344 : CHARACTER(len=*), INTENT(in) :: filename
345 :
346 : INTEGER, PARAMETER :: E = 1000, T = 100000
347 :
348 : INTEGER :: i, unit
349 : TYPE(call_stat_type), POINTER :: c_stat
350 1 : TYPE(callgraph_item_type), DIMENSION(:), POINTER :: ct_items
351 : TYPE(routine_stat_type), POINTER :: r_stat
352 : TYPE(timer_env_type), POINTER :: timer_env
353 :
354 : CALL open_file(file_name=filename, file_status="REPLACE", file_action="WRITE", &
355 1 : file_form="FORMATTED", unit_number=unit)
356 1 : timer_env => get_timer_env()
357 :
358 : ! use outermost routine as total runtime
359 1 : r_stat => list_get(timer_env%routine_stats, 1)
360 1 : WRITE (UNIT=unit, FMT="(A)") "events: Walltime Energy"
361 1 : WRITE (UNIT=unit, FMT="(A,I0,1X,I0)") "summary: ", &
362 1 : INT(T*r_stat%incl_walltime_accu, KIND=int_8), &
363 2 : INT(E*r_stat%incl_energy_accu, KIND=int_8)
364 :
365 455 : DO i = 1, list_size(timer_env%routine_stats)
366 454 : r_stat => list_get(timer_env%routine_stats, i)
367 454 : WRITE (UNIT=unit, FMT="(A,I0,A,A)") "fn=(", r_stat%routine_id, ") ", r_stat%routineN
368 454 : WRITE (UNIT=unit, FMT="(A,I0,1X,I0)") "1 ", &
369 454 : INT(T*r_stat%excl_walltime_accu, KIND=int_8), &
370 909 : INT(E*r_stat%excl_energy_accu, KIND=int_8)
371 : END DO
372 :
373 1 : ct_items => callgraph_items(timer_env%callgraph)
374 793 : DO i = 1, SIZE(ct_items)
375 792 : c_stat => ct_items(i)%value
376 792 : WRITE (UNIT=unit, FMT="(A,I0,A)") "fn=(", ct_items(i)%key(1), ")"
377 792 : WRITE (UNIT=unit, FMT="(A,I0,A)") "cfn=(", ct_items(i)%key(2), ")"
378 792 : WRITE (UNIT=unit, FMT="(A,I0,A)") "calls=", c_stat%total_calls, " 1"
379 792 : WRITE (UNIT=unit, FMT="(A,I0,1X,I0)") "1 ", &
380 792 : INT(T*c_stat%incl_walltime_accu, KIND=int_8), &
381 1585 : INT(E*c_stat%incl_energy_accu, KIND=int_8)
382 : END DO
383 1 : DEALLOCATE (ct_items)
384 :
385 1 : CALL close_file(unit_number=unit, file_status="KEEP")
386 :
387 1 : END SUBROUTINE timings_report_callgraph
388 : END MODULE timings_report
389 :
|
