da_trace_entry.inc
References to this file elsewhere.
1 subroutine da_trace_entry(&
2 Name, & ! in
3 Message, & ! in, optional
4 Messages, & ! in, optional
5 MaxNoCalls) ! in, optional
6
7 !-----------------------------------------------------------------------
8 ! Purpose: Trace entry point to subroutine
9 !-----------------------------------------------------------------------
10
11 implicit none
12
13 character (len=*), intent(in) :: Name ! Routine name
14 character (len=*), optional, intent(in) :: Message ! message
15 character (len=*), optional, intent(in) :: Messages(:) ! message array
16 integer, optional, intent(in) :: MaxNoCalls ! max no calls to show
17
18
19 integer :: IOStatus ! I-O return code
20 integer :: Loop ! General loop counter
21 integer :: Count
22 integer :: OldPointer
23 integer :: TotalSpace
24 integer :: LocalMaxNoCalls
25 real :: CPUTime1
26 real :: temp1
27 real :: temp2
28 logical :: NewRoutine
29
30 call cpu_time(CPUTime1)
31
32 call system_clock(&
33 COUNT=Count)
34
35 !-----------------------------------------------------------------------
36 ! check if tracing active. If not check whether to switch it on
37 !-----------------------------------------------------------------------
38
39 if (.NOT. TraceActive) then
40 if (trace_start_points == 0) then
41 ! start with first call
42 TraceActive = .true.
43 else
44 do Loop=1,trace_start_points
45 if (Name == TraceNames(Loop)(1:LEN(Name))) then
46 TraceActive = .true.
47 TraceDepth = 0
48 TraceStartedBy = Name
49 exit
50 end if
51 end do
52 end if
53 if (.NOT. TraceActive) then
54 ! did not want to start trace, so leave
55 return
56 end if
57 end if
58
59 !-----------------------------------------------------------------------
60 ! timing and maximum heap usage
61 !-----------------------------------------------------------------------
62
63 ! Increment the local elapsed time and local CPU time since the
64 ! last trace entry, if any
65
66 if (Pointer /= 0) then
67 temp1 = real(Count - BaseElapsedTime) - ElapsedTimeLocalStart
68 temp2 = CPUTime1 - CPUTimeLocalStart
69 ElapsedTimeLocal(Pointer) = ElapsedTimeLocal(Pointer) + temp1
70 ElapsedTimeThisCall(Pointer) = ElapsedTimeThisCall(Pointer) + temp1
71 CPUTimeLocal(Pointer) = CPUTimeLocal(Pointer) + temp2
72 CPUTimeThisCall(Pointer) = CPUTimeThisCall(Pointer) + temp2
73 end if
74
75 OldPointer=Pointer
76
77 ! Check subroutine name
78
79 NewRoutine = .true.
80 do Pointer=1,NoRoutines
81 if (TimerNames(Pointer) == Name) then
82 NewRoutine=.false.
83 exit
84 end if
85 end do
86
87 if (NewRoutine) then
88 ! New subroutine entered
89 if (NoRoutines >= MaxNoRoutines)then ! too many to trace
90 call da_error(__FILE__,__LINE__, &
91 (/"Too many routines. Not timing " // Name/))
92
93 !All the timings etc are put instead to the calling routine,
94 ! which therefore may have incorrect summaries.
95 !The best solution is to increase MaxNoRoutines.
96 Pointer = OldPointer
97 ! Fix to get the correct NoCalls(OldPointer) despite the +1 later
98 NoCalls(Pointer)=NoCalls(Pointer)-1
99
100 else ! Pointer=NoRoutines+1 (from the end of earlier do loop)
101 NoRoutines=NoRoutines+1
102 TimerNames(NoRoutines)=Name
103 end if
104 end if
105
106 NoCalls(Pointer)=NoCalls(Pointer)+1
107
108 CPUTimeThisCall(Pointer) = 0.0
109 ElapsedTimeThisCall(Pointer) = 0.0
110
111 CalledBy(Pointer)=OldPointer
112
113 if (trace_memory) then
114 call da_memory(&
115 TotalSpace)
116 EntryHeap(Pointer) = TotalSpace
117 LastSpace = TotalSpace
118 if (MaxHeap(Pointer) < TotalSpace) then
119 MaxHeap(Pointer) = TotalSpace
120 end if
121 else
122 TotalSpace = 0
123 end if
124
125 if (trace_write .AND. TraceDepth <= trace_max_depth) then
126
127 if (present(MaxNoCalls)) then
128 LocalMaxNoCalls = MaxNoCalls
129 else
130 LocalMaxNoCalls = trace_repeat_head
131 end if
132
133 if (NoCalls(Pointer) <= LocalMaxNoCalls) then
134 if (trace_memory) then
135 if (use_html) then
136 write (unit=trace_unit, &
137 fmt='(A,"> <a href=",A,"/",A,".html>",A,"</a>",I11)', &
138 iostat=IOStatus) &
139 pad(1:TraceDepth*TraceIndentAmount),trim(Documentation_url), &
140 trim(Name),trim(Name), TotalSpace
141 else
142 write (unit=trace_unit, &
143 fmt='(A,"> ",A,I11)', &
144 iostat=IOStatus) &
145 pad(1:TraceDepth*TraceIndentAmount),trim(Name), TotalSpace
146 end if
147 else
148 if (use_html) then
149 write (unit=trace_unit, &
150 fmt='(A,"> <a href=",A,"/",A,".html>",A,"</a>")', &
151 iostat=IOStatus) &
152 pad(1:TraceDepth*TraceIndentAmount),trim(Documentation_url), &
153 trim(Name),trim(Name)
154 else
155 write (unit=trace_unit, fmt='(A,"> ",A)', iostat=IOStatus) &
156 pad(1:TraceDepth*TraceIndentAmount),trim(Name)
157 end if
158 end if
159 if (IOStatus /= 0) then
160 call da_error(__FILE__,__LINE__, &
161 (/"Cannot write to trace file for "//trim(Name)/))
162 end if
163
164 if (present(Message)) then
165 write (unit=trace_unit, fmt='(A," ",A)', iostat=IOStatus) &
166 pad(1:TraceDepth*TraceIndentAmount),trim(Message)
167 if (IOStatus .NE. 0) then
168 call da_error(__FILE__,__LINE__, &
169 (/"Cannot write to trace file for "//trim(Name)/))
170 end if
171 end if
172
173 if (present(Messages)) then
174 do Loop = 1, size(Messages)
175 write (unit=trace_unit, fmt='(A," ",A)', iostat=IOStatus) &
176 pad(1:TraceDepth*TraceIndentAmount),trim(Messages(Loop))
177 if (IOStatus .NE. 0) then
178 call da_error(__FILE__,__LINE__, &
179 (/"Cannot write to trace file for "//trim(Name)/))
180 end if
181 end do ! Loop
182 end if
183 end if
184
185 end if ! trace_write
186
187 TraceDepth=TraceDepth+1
188
189 call system_clock(&
190 COUNT=Count)
191
192 call cpu_time(CPUTime1)
193
194 ! set the start elapsed and CPU time both locally and generally
195
196 ElapsedTimeStart(Pointer) = real(Count-BaseElapsedTime)
197 ElapsedTimeLocalStart = real(Count-BaseElapsedTime)
198
199 CPUTimeStart(Pointer) = CPUTime1
200 CPUTimeLocalStart = CPUTime1
201
202 ! call flush(trace_unit)
203
204 return
205 end subroutine da_trace_entry
206
207