19 USE callgraph,
ONLY: callgraph_item_type,&
26 USE list,
ONLY: list_destroy,&
43 #include "../base/base_uses.f90"
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
74 TYPE(list_routinereport_type) :: reports
75 TYPE(routine_report_type),
POINTER :: r_report
77 CALL list_init(reports)
78 CALL collect_reports_from_ranks(reports, cost_type, para_env)
80 IF (list_size(reports) > 0 .AND. iw > 0) &
81 CALL print_reports(reports, iw, r_timings, sort_by_self_time, cost_type, report_maxloc, para_env)
84 DO WHILE (list_size(reports) > 0)
85 r_report => list_pop(reports)
88 CALL list_destroy(reports)
99 SUBROUTINE collect_reports_from_ranks(reports, cost_type, para_env)
100 TYPE(list_routinereport_type),
INTENT(INOUT) :: reports
101 INTEGER,
INTENT(IN) :: cost_type
102 TYPE(mp_para_env_type),
INTENT(IN) :: para_env
104 CHARACTER(LEN=default_string_length) :: routinen
105 INTEGER :: local_routine_id, sending_rank
106 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: collected
107 REAL(kind=
dp) :: foobar
108 REAL(kind=
dp),
DIMENSION(2) :: dbuf
109 TYPE(routine_report_type),
POINTER :: r_report
110 TYPE(routine_stat_type),
POINTER :: r_stat
111 TYPE(timer_env_type),
POINTER :: timer_env
113 NULLIFY (r_stat, r_report, timer_env)
114 IF (.NOT. list_isready(reports)) &
123 CALL para_env%bcast(routinen, 0)
125 CALL para_env%max(sending_rank)
126 CALL para_env%sum(sending_rank)
128 CALL para_env%max(foobar)
130 CALL para_env%maxloc(dbuf)
131 CALL para_env%sum(foobar)
136 ALLOCATE (collected(list_size(timer_env%routine_stats)))
142 IF (.NOT. all(collected == 1)) sending_rank = para_env%mepos
143 CALL para_env%max(sending_rank)
144 IF (sending_rank < 0)
EXIT
145 IF (sending_rank == para_env%mepos)
THEN
146 local_routine_id = minloc(collected, dim=1)
147 r_stat => list_get(timer_env%routine_stats, local_routine_id)
148 routinen = r_stat%routineN
150 CALL para_env%bcast(routinen, sending_rank)
154 CALL list_push(reports, r_report)
155 r_report%routineN = routinen
160 collected(local_routine_id) = 1
161 r_stat => list_get(timer_env%routine_stats, local_routine_id)
162 r_report%max_total_calls = r_stat%total_calls
163 r_report%sum_total_calls = r_stat%total_calls
164 r_report%sum_stackdepth = r_stat%stackdepth_accu
165 SELECT CASE (cost_type)
167 r_report%max_icost = r_stat%incl_energy_accu
168 r_report%sum_icost = r_stat%incl_energy_accu
169 r_report%max_ecost = r_stat%excl_energy_accu
170 r_report%sum_ecost = r_stat%excl_energy_accu
172 r_report%max_icost = r_stat%incl_walltime_accu
173 r_report%sum_icost = r_stat%incl_walltime_accu
174 r_report%max_ecost = r_stat%excl_walltime_accu
175 r_report%sum_ecost = r_stat%excl_walltime_accu
182 CALL para_env%max(r_report%max_total_calls)
183 CALL para_env%sum(r_report%sum_total_calls)
184 CALL para_env%sum(r_report%sum_stackdepth)
187 dbuf = (/r_report%max_icost, real(para_env%mepos, kind=
dp)/)
188 CALL para_env%maxloc(dbuf)
189 r_report%max_icost = dbuf(1)
190 r_report%max_irank = int(dbuf(2))
192 CALL para_env%sum(r_report%sum_icost)
195 dbuf = (/r_report%max_ecost, real(para_env%mepos, kind=
dp)/)
196 CALL para_env%maxloc(dbuf)
197 r_report%max_ecost = dbuf(1)
198 r_report%max_erank = int(dbuf(2))
200 CALL para_env%sum(r_report%sum_ecost)
203 END SUBROUTINE collect_reports_from_ranks
218 SUBROUTINE print_reports(reports, iw, threshold, sort_by_exclusiv_cost, cost_type, report_maxloc, para_env)
219 TYPE(list_routinereport_type),
INTENT(IN) :: reports
220 INTEGER,
INTENT(IN) :: iw
221 REAL(kind=
dp),
INTENT(IN) :: threshold
222 LOGICAL,
INTENT(IN) :: sort_by_exclusiv_cost
223 INTEGER,
INTENT(IN) :: cost_type
224 LOGICAL,
INTENT(IN) :: report_maxloc
225 TYPE(mp_para_env_type),
INTENT(IN) :: para_env
227 CHARACTER(LEN=4) :: label
228 CHARACTER(LEN=default_string_length) :: fmt, title
229 INTEGER :: decimals, i, j, num_routines
230 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: indices
231 REAL(kind=
dp) :: asd, maxcost, mincost
232 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: max_costs
233 TYPE(routine_report_type),
POINTER :: r_report_i, r_report_j
235 NULLIFY (r_report_i, r_report_j)
236 IF (.NOT. list_isready(reports)) &
240 SELECT CASE (cost_type)
242 title =
"E N E R G Y"
245 title =
"T I M I N G"
252 WRITE (unit=iw, fmt=
"(/,T2,A)") repeat(
"-", 79)
253 WRITE (unit=iw, fmt=
"(T2,A,T80,A)")
"-",
"-"
254 WRITE (unit=iw, fmt=
"(T2,A,T35,A,T80,A)")
"-", trim(title),
"-"
255 WRITE (unit=iw, fmt=
"(T2,A,T80,A)")
"-",
"-"
256 WRITE (unit=iw, fmt=
"(T2,A)") repeat(
"-", 79)
257 IF (report_maxloc)
THEN
258 WRITE (unit=iw, fmt=
"(T2,A,T35,A,T41,A,T45,2A18,A8)") &
259 "SUBROUTINE",
"CALLS",
" ASD",
"SELF "//label,
"TOTAL "//label,
"MAXRANK"
261 WRITE (unit=iw, fmt=
"(T2,A,T35,A,T41,A,T45,2A18)") &
262 "SUBROUTINE",
"CALLS",
" ASD",
"SELF "//label,
"TOTAL "//label
265 WRITE (unit=iw, fmt=
"(T33,A)") &
266 "MAXIMUM AVERAGE MAXIMUM AVERAGE MAXIMUM"
269 num_routines = list_size(reports)
270 ALLOCATE (max_costs(num_routines))
271 DO i = 1, num_routines
272 r_report_i => list_get(reports, i)
273 IF (sort_by_exclusiv_cost)
THEN
274 max_costs(i) = r_report_i%max_ecost
276 max_costs(i) = r_report_i%max_icost
279 ALLOCATE (indices(num_routines))
280 CALL sort(max_costs, num_routines, indices)
282 maxcost = maxval(max_costs)
283 mincost = maxcost*threshold
288 IF (maxcost >= 10000) decimals = 2
289 IF (maxcost >= 100000) decimals = 1
290 IF (maxcost >= 1000000) decimals = 0
291 IF (report_maxloc)
THEN
292 WRITE (unit=fmt, fmt=
"(A,I0,A)") &
293 "(T2,A30,1X,I7,1X,F4.1,4(1X,F8.", decimals,
"),I8)"
295 WRITE (unit=fmt, fmt=
"(A,I0,A)") &
296 "(T2,A30,1X,I7,1X,F4.1,4(1X,F8.", decimals,
"))"
300 DO i = num_routines, 1, -1
301 IF (max_costs(i) >= mincost)
THEN
303 r_report_j => list_get(reports, j)
305 asd = real(r_report_j%sum_stackdepth, kind=
dp)/ &
306 REAL(max(1_int_8, r_report_j%sum_total_calls), kind=
dp)
307 IF (report_maxloc)
THEN
308 WRITE (unit=iw, fmt=fmt) &
309 adjustl(r_report_j%routineN(1:31)), &
310 r_report_j%max_total_calls, &
312 r_report_j%sum_ecost/para_env%num_pe, &
313 r_report_j%max_ecost, &
314 r_report_j%sum_icost/para_env%num_pe, &
315 r_report_j%max_icost, &
318 WRITE (unit=iw, fmt=fmt) &
319 adjustl(r_report_j%routineN(1:31)), &
320 r_report_j%max_total_calls, &
322 r_report_j%sum_ecost/para_env%num_pe, &
323 r_report_j%max_ecost, &
324 r_report_j%sum_icost/para_env%num_pe, &
329 WRITE (unit=iw, fmt=
"(T2,A,/)") repeat(
"-", 79)
331 END SUBROUTINE print_reports
342 CHARACTER(len=*),
INTENT(in) :: filename
344 INTEGER,
PARAMETER :: e = 1000, t = 100000
347 TYPE(call_stat_type),
POINTER :: c_stat
348 TYPE(callgraph_item_type),
DIMENSION(:),
POINTER :: ct_items
349 TYPE(routine_stat_type),
POINTER :: r_stat
350 TYPE(timer_env_type),
POINTER :: timer_env
352 CALL open_file(file_name=filename, file_status=
"REPLACE", file_action=
"WRITE", &
353 file_form=
"FORMATTED", unit_number=unit)
357 r_stat => list_get(timer_env%routine_stats, 1)
358 WRITE (unit=unit, fmt=
"(A)")
"events: Walltime Energy"
359 WRITE (unit=unit, fmt=
"(A,I0,1X,I0)")
"summary: ", &
360 int(t*r_stat%incl_walltime_accu, kind=
int_8), &
361 int(e*r_stat%incl_energy_accu, kind=
int_8)
363 DO i = 1, list_size(timer_env%routine_stats)
364 r_stat => list_get(timer_env%routine_stats, i)
365 WRITE (unit=unit, fmt=
"(A,I0,A,A)")
"fn=(", r_stat%routine_id,
") ", r_stat%routineN
366 WRITE (unit=unit, fmt=
"(A,I0,1X,I0)")
"1 ", &
367 int(t*r_stat%excl_walltime_accu, kind=
int_8), &
368 int(e*r_stat%excl_energy_accu, kind=
int_8)
372 DO i = 1,
SIZE(ct_items)
373 c_stat => ct_items(i)%value
374 WRITE (unit=unit, fmt=
"(A,I0,A)")
"fn=(", ct_items(i)%key(1),
")"
375 WRITE (unit=unit, fmt=
"(A,I0,A)")
"cfn=(", ct_items(i)%key(2),
")"
376 WRITE (unit=unit, fmt=
"(A,I0,A)")
"calls=", c_stat%total_calls,
" 1"
377 WRITE (unit=unit, fmt=
"(A,I0,1X,I0)")
"1 ", &
378 int(t*c_stat%incl_walltime_accu, kind=
int_8), &
379 int(e*c_stat%incl_energy_accu, kind=
int_8)
381 DEALLOCATE (ct_items)
383 CALL close_file(unit_number=unit, file_status=
"KEEP")
type(callgraph_item_type) function, dimension(:), pointer, public callgraph_items(hash_map)
Returns a pointer to an array of all key/value-items stored in the hash map. Caution: The caller is r...
Utility routines to open and close files. Tracking of preconnections.
subroutine, public open_file(file_name, file_status, file_form, file_action, file_position, file_pad, unit_number, debug, skip_get_unit_number, file_access)
Opens the requested file using a free unit number.
subroutine, public close_file(unit_number, file_status, keep_preconnection)
Close an open file given by its logical unit number. Optionally, keep the file and unit preconnected.
Defines the basic variable types.
integer, parameter, public int_8
integer, parameter, public dp
integer, parameter, public default_string_length
An array-based list which grows on demand. When the internal array is full, a new array of twice the ...
An array-based list which grows on demand. When the internal array is full, a new array of twice the ...
Interface to the message passing library MPI.
integer(kind=int_4) function, public routine_map_get(hash_map, key, default_value)
Gets a value for a given key from the hash map. If the key is not found the default_value will be ret...
logical function, public routine_map_haskey(hash_map, key)
Checks whether a given key is currently stored in the hash_map.
Types used by timings.F and timings_report.F The types in this module are used within dict or list,...
Timing routines for accounting.
integer, parameter, public cost_type_energy
subroutine, public timings_report_callgraph(filename)
Write accumulated callgraph information as cachegrind-file. http://kcachegrind.sourceforge....
integer, parameter, public cost_type_time
subroutine, public timings_report_print(iw, r_timings, sort_by_self_time, cost_type, report_maxloc, para_env)
Print accumulated information on timers.
Types used by timings.F and timings_report.F Due to the fortran restriction on cicular module-depende...
Timing routines for accounting.
type(timer_env_type) function, pointer, public get_timer_env()
returns the current timer env from the stack
All kind of helpful little routines.