19 procedure,
nopass:: begin => trace_begin
20 procedure,
nopass:: tag => trace_tag
21 procedure,
nopass:: end => trace_end
22 procedure,
nopass:: print_id
24 procedure,
nopass:: back
26 type(trace_t),
public:: trace
31 integer,
parameter:: maxlev=30
32 character(len=80),
dimension(maxlev),
save:: tracing
33 integer,
save:: verbosity(maxlev)
34 integer,
private,
save:: indent=4
35 integer,
private,
save:: level=1
37 PUBLIC trace_begin, trace_tag, trace_end
46 SUBROUTINE trace_begin (id, set_verbose, itimer, detailed_timer)
48 integer,
optional:: set_verbose, itimer
49 logical,
optional:: detailed_timer
51 character(len=mch):: fmt
55 if (
present(itimer))
then 56 if (
present(detailed_timer))
then 57 if (detailed_timer)
then 58 call timer%begin (id, itimer)
61 call timer%begin (id, itimer)
64 if (.not.io%do_trace)
return 65 tracing(level) = trim(id)
66 if (
present(set_verbose))
then 67 verbosity(level) = set_verbose
71 verbose = verbosity(level)
72 if (level<maxlev)
then 76 write(fmt,
'(a,i3.3,a)')
'("trace:",i3,f12.6,',indent,
'x,a,i5)' 77 if (io%verbose>=verbose)
then 79 if (io_unit%do_validate) wc = 0d0
80 if (io%omp_trace)
then 81 call print_out (io_unit%log)
84 call print_out (io_unit%output)
90 subroutine print_out (unit)
92 if (
present(itimer))
then 94 omp_mythread, wc, trim(id)//
' begin, itimer =', itimer
97 omp_mythread, wc, trim(id)//
' begin' 101 END SUBROUTINE trace_begin
105 SUBROUTINE trace_tag (id)
108 character(len=mch):: fmt
112 if (.not.io%do_trace)
return 113 verbose = verbosity(level)
114 if (io%verbose>=verbose)
then 115 write(fmt,
'(a,i3.3,a)')
'("trace:",i3,f12.6,',indent,
'x,a)' 117 level = max(level-1,1)
118 if (io%omp_trace)
then 119 write(io_unit%log,fmt) omp_mythread, wc, trim(tracing(level))//
' '//trim(id)
123 write(io%output,fmt) omp_mythread, wc, trim(tracing(level))//
' '//trim(id)
127 level = min(level+1,maxlev)
129 END SUBROUTINE trace_tag
134 SUBROUTINE trace_end (itimer, detailed_timer)
136 integer,
optional:: itimer
137 logical,
optional:: detailed_timer
139 character(len=mch):: fmt
143 if (
present(itimer))
then 144 if (
present(detailed_timer))
then 145 if (detailed_timer)
then 146 call timer%end(itimer)
149 call timer%end(itimer)
152 if (.not.io%do_trace)
return 153 level = max(level-1,1)
154 indent = max(indent,4)
155 verbose = verbosity(level)
156 if (io%verbose>=verbose)
then 157 write(fmt,
'(a,i3.3,a)')
'("trace:",i3,f12.6,',indent,
'x,a,i5)' 159 if (io_unit%do_validate) wc = 0d0
160 if (io%omp_trace)
then 161 call print_out (io_unit%log)
164 call print_out (io_unit%output)
168 indent = max(indent-3,4)
171 subroutine print_out (unit)
173 if (
present(itimer))
then 175 omp_mythread, wc, trim(tracing(level))//
' end, itimer =', itimer
178 omp_mythread, wc, trim(tracing(level))//
' end' 182 END SUBROUTINE trace_end
190 write (io%output,*)
'called from', tracing(l)
196 character(len=120),
save:: hl= &
197 '--------------------------------------------------------------------------------' 200 write (io_unit%output,
'(a)') trim(hl)
202 END SUBROUTINE print_hl
205 SUBROUTINE print_id (id)
206 character(len=120) id
207 character(len=120),
save:: hl= &
208 '--------------------------------------------------------------------------------' 210 if (io_unit%do_validate)
return 214 write (io_unit%output,
'(a)') hl
215 write (io_unit%output,
'(a)') id
216 write (io_unit%hash,
'(a)') id
222 END SUBROUTINE print_id
Each thread uses a private timer data type, with arrays for start time and total time for each regist...
Support tic/toc timing, as in MATLAB, and accurate wallclock() function. The timing is generally much...