DISPATCH
trace_mod.f90
1 !===============================================================================
2 !> $Id: b5a42ce0c5ab4489d22764f563b40c9b417af098 $
3 !===============================================================================
4 MODULE trace_mod
5  USE omp_mod
6  USE omp_timer_mod
7  USE io_mod
8  USE io_unit_mod
9  !USE mpi_mod
10  USE timer_mod
11  implicit none
12  private
13  !-----------------------------------------------------------------------------
14  ! The public instance of the trace data type allows trace_begin calls to be
15  ! replaced by trace%begin calls, for consistency
16  !-----------------------------------------------------------------------------
17  type trace_t
18  contains
19  procedure, nopass:: begin => trace_begin
20  procedure, nopass:: tag => trace_tag
21  procedure, nopass:: end => trace_end
22  procedure, nopass:: print_id
23  !procedure, nopass:: print_hl
24  procedure, nopass:: back
25  end type
26  type(trace_t), public:: trace
27  !-----------------------------------------------------------------------------
28  ! The data manipulated by the trace routines are thread private, and do not
29  ! need to be visible from the calling code.
30  !-----------------------------------------------------------------------------
31  integer, parameter:: maxlev=30 ! max number of levels
32  character(len=80), dimension(maxlev), save:: tracing ! active routine
33  integer, save:: verbosity(maxlev) ! verbosity level
34  integer, private, save:: indent=4 ! trace indent
35  integer, private, save:: level=1 ! trace level
36  !$omp threadprivate(indent,level,tracing,verbosity)
37 PUBLIC trace_begin, trace_tag, trace_end
38 CONTAINS
39 
40 !===============================================================================
41 !> Start a new trace level, and a new timer epoch. A call that has a
42 !> detailed_timer logical present will call the timer level only if that
43 !> logical is true, while call that doesn't have that optional argument
44 !> will call the timer if and only if the itimer argument is present.
45 !===============================================================================
46 SUBROUTINE trace_begin (id, set_verbose, itimer, detailed_timer)
47  implicit none
48  integer, optional:: set_verbose, itimer
49  logical, optional:: detailed_timer
50  character(len=*) id
51  character(len=mch):: fmt
52  integer:: verbose
53  real(8):: wc
54  !-----------------------------------------------------------------------------
55  if (present(itimer)) then
56  if (present(detailed_timer)) then
57  if (detailed_timer) then
58  call timer%begin (id, itimer)
59  end if
60  else
61  call timer%begin (id, itimer)
62  end if
63  end if
64  if (.not.io%do_trace) return
65  tracing(level) = trim(id)
66  if (present(set_verbose)) then
67  verbosity(level) = set_verbose
68  else
69  verbosity(level) = -1
70  end if
71  verbose = verbosity(level)
72  if (level<maxlev) then
73  level = level+1
74  indent = indent + 3
75  end if
76  write(fmt,'(a,i3.3,a)') '("trace:",i3,f12.6,',indent,'x,a,i5)'
77  if (io%verbose>=verbose) then
78  wc = wallclock()
79  if (io_unit%do_validate) wc = 0d0
80  if (io%omp_trace) then
81  call print_out (io_unit%log)
82  else
83  !$omp critical (trace_cr)
84  call print_out (io_unit%output)
85  !$omp end critical (trace_cr)
86  end if
87  end if
88 contains
89 !===============================================================================
90 subroutine print_out (unit)
91  integer:: unit
92  if (present(itimer)) then
93  write(unit,fmt) &
94  omp_mythread, wc, trim(id)//' begin, itimer =', itimer
95  else
96  write(unit,fmt) &
97  omp_mythread, wc, trim(id)//' begin'
98  end if
99  flush(unit)
100 end subroutine
101 END SUBROUTINE trace_begin
102 
103 !===============================================================================
104 !===============================================================================
105 SUBROUTINE trace_tag (id)
106  implicit none
107  character(len=*) id
108  character(len=mch):: fmt
109  integer:: verbose
110  real(8):: wc
111  !.............................................................................
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)'
116  wc = wallclock()
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)
120  flush(io_unit%log)
121  else
122  !$omp critical (trace_cr)
123  write(io%output,fmt) omp_mythread, wc, trim(tracing(level))//' '//trim(id)
124  flush(io%output)
125  !$omp end critical (trace_cr)
126  end if
127  level = min(level+1,maxlev)
128  end if
129 END SUBROUTINE trace_tag
130 
131 !===============================================================================
132 !> End a trace level.
133 !===============================================================================
134 SUBROUTINE trace_end (itimer, detailed_timer)
135  implicit none
136  integer, optional:: itimer
137  logical, optional:: detailed_timer
138  integer i
139  character(len=mch):: fmt
140  integer:: verbose
141  real(8):: wc
142  !-----------------------------------------------------------------------------
143  if (present(itimer)) then
144  if (present(detailed_timer)) then
145  if (detailed_timer) then
146  call timer%end(itimer)
147  end if
148  else
149  call timer%end(itimer)
150  end if
151  end if
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)'
158  wc = wallclock()
159  if (io_unit%do_validate) wc = 0d0
160  if (io%omp_trace) then
161  call print_out (io_unit%log)
162  else
163  !$omp critical (trace_cr)
164  call print_out (io_unit%output)
165  !$omp end critical (trace_cr)
166  end if
167  end if
168  indent = max(indent-3,4)
169 contains
170 !===============================================================================
171 subroutine print_out (unit)
172  integer:: unit
173  if (present(itimer)) then
174  write (unit,fmt) &
175  omp_mythread, wc, trim(tracing(level))//' end, itimer =', itimer
176  else
177  write (unit,fmt) &
178  omp_mythread, wc, trim(tracing(level))//' end'
179  end if
180  flush (unit)
181 end subroutine
182 END SUBROUTINE trace_end
183 
184 !===============================================================================
185 !> Write a trace-back to io%output
186 !===============================================================================
187 SUBROUTINE back
188  integer:: l
189  do l=level,1,-1
190  write (io%output,*) 'called from', tracing(l)
191  end do
192 END SUBROUTINE back
193 
194 !===============================================================================
195 SUBROUTINE print_hl
196  character(len=120), save:: hl= &
197  '--------------------------------------------------------------------------------'
198  !..............................................................................
199  if (io%master) then
200  write (io_unit%output,'(a)') trim(hl)
201  end if
202 END SUBROUTINE print_hl
203 
204 !===============================================================================
205 SUBROUTINE print_id (id)
206  character(len=120) id
207  character(len=120), save:: hl= &
208  '--------------------------------------------------------------------------------'
209  !..............................................................................
210  if (io_unit%do_validate) return
211  if (id .ne. '') then
212  !$omp critical (print_id_cr)
213  if (id .ne. '') then
214  write (io_unit%output,'(a)') hl
215  write (io_unit%output,'(a)') id
216  write (io_unit%hash,'(a)') id
217  flush (io_unit%hash)
218  id = ''
219  end if
220  !$omp end critical (print_id_cr)
221  end if
222 END SUBROUTINE print_id
223 
224 END MODULE trace_mod
Each thread uses a private timer data type, with arrays for start time and total time for each regist...
Definition: timer_mod.f90:11
Support tic/toc timing, as in MATLAB, and accurate wallclock() function. The timing is generally much...
Definition: io_mod.f90:4