da_trace_exit.inc
References to this file elsewhere.
1 subroutine da_trace_exit(&
2 Name, & ! in
3 Message, & ! in, optional
4 Messages, & ! in, optional
5 MaxNoCalls) ! in, optional
6
7 !-----------------------------------------------------------------------
8 ! Purpose: Trace exit from subroutine
9 !-----------------------------------------------------------------------
10
11 implicit none
12
13 character (len=*), intent(in) :: Name ! subroutine name
14 character (len=*), optional, intent(in) :: Message ! text to trace
15 character (len=*), optional, intent(in) :: Messages(:) ! text to trace
16 integer, optional, intent(in) :: MaxNoCalls ! max no calls to show
17
18 integer :: IOStatus ! I-O return code
19 integer :: Loop ! General loop counter
20 integer :: Count
21 integer :: TotalSpace
22 integer :: LocalMaxNoCalls
23 integer :: Caller
24 real :: temp_CPUTime
25 real :: temp1
26 real :: temp2
27 character(len=25) :: Change
28
29 call cpu_time(temp_CPUTime)
30
31 call system_clock(&
32 COUNT=Count)
33
34 !======================================================================
35 ! check whether trace active and whether depth exceeded
36 !======================================================================
37
38 if (.NOT. TraceActive) then
39 return
40 end if
41
42 if (TraceActive) then
43 ! was tracing enabled by this routine? If it was, disable it, to
44 ! take affect after the trace line has been written
45 if (Name == TraceStartedBy(1:LEN(Name))) then
46 TraceActive = .false.
47 end if
48 end if
49
50 temp1 = real(Count - BaseElapsedTime) - ElapsedTimeLocalStart
51 temp2 = temp_CPUTime - CPUTimeLocalStart
52
53 TraceDepth=TraceDepth-1
54
55 if (TraceDepth < 0) then
56 TraceDepth = 0
57 end if
58
59 !=======================================================================
60 ! Check timing and maximum heap memory usage
61 !=======================================================================
62
63 ElapsedTimeLocal(Pointer) = ElapsedTimeLocal(Pointer) + temp1
64 ElapsedTimeThisCall(Pointer) = ElapsedTimeThisCall(Pointer) + temp1
65 ElapsedTime(Pointer) = ElapsedTime(Pointer) + &
66 ElapsedTimeThisCall(Pointer)
67
68 CPUTimeLocal(Pointer) = CPUTimeLocal(Pointer) + temp2
69 CPUTimeThisCall(Pointer) = CPUTimeThisCall(Pointer) + temp2
70 CPUTime(Pointer) = CPUTime(Pointer) + CPUTimeThisCall(Pointer)
71
72 Caller=CalledBy(Pointer)
73 if (Caller /= 0) then
74 ElapsedTimeThisCall(Caller) = ElapsedTimeThisCall(Caller) + &
75 ElapsedTimeThisCall(Pointer)
76 CPUTimeThisCall(Caller) = CPUTimeThisCall(Caller) + CPUTimeThisCall(Pointer)
77 end if
78
79 Change = ""
80
81 if (trace_memory) then
82 call da_memory(&
83 TotalSpace)
84 if (EntryHeap(Pointer) < TotalSpace) then
85 write(Change,"(A9,I12)")", BIGGER", TotalSpace - EntryHeap(Pointer)
86 else if (EntryHeap(Pointer) > TotalSpace) then
87 write(Change,"(A9,I12)")", SMALLER", TotalSpace - EntryHeap(Pointer)
88 end if
89 if (MaxHeap(Pointer) < TotalSpace) then
90 MaxHeap(Pointer) = TotalSpace
91 end if
92 else
93 TotalSpace = 0
94 end if
95
96 if (trace_write .AND. TraceDepth <= trace_max_depth) then
97
98 if (present(MaxNoCalls)) then
99 LocalMaxNoCalls = MaxNoCalls
100 else
101 LocalMaxNoCalls = trace_repeat_head
102 end if
103
104 IOStatus=0
105
106 if (NoCalls(Pointer) <= LocalMaxNoCalls) then
107 if (trace_memory) then
108 if (use_html) then
109 write (unit=trace_unit, &
110 fmt='(A, "< <a href=",A,"/",A,".html>",A,"</a>",I11,A)', &
111 iostat=IOStatus) &
112 pad(1:TraceDepth*TraceIndentAmount),trim(Documentation_url), &
113 trim(Name),trim(Name), TotalSpace, Change
114 else
115 write (unit=trace_unit, &
116 fmt='(A, "< ",A,I11,A)', &
117 iostat=IOStatus) &
118 pad(1:TraceDepth*TraceIndentAmount),trim(Name), TotalSpace, Change
119 end if
120 else
121 if (use_html) then
122 write (unit=trace_unit, &
123 fmt='(A, "< <a href=",A,"/",A,".html>",A,"</a>")', &
124 iostat=IOStatus) &
125 pad(1:TraceDepth*TraceIndentAmount),trim(Documentation_url), &
126 trim(Name),trim(Name)
127 else
128 write (unit=trace_unit, fmt='(A, "< ",A)', iostat=IOStatus) &
129 pad(1:TraceDepth*TraceIndentAmount),trim(Name)
130 end if
131 end if
132
133 if (IOStatus /= 0) then
134 call da_error(__FILE__,__LINE__, &
135 (/"Cannot write to trace file for "//trim(Name)/))
136 end if
137
138 if (present(Message)) then
139 write (unit=trace_unit, fmt='(A," ",A)', iostat=IOStatus) &
140 pad(1:TraceDepth*TraceIndentAmount),trim(Message)
141 if (IOStatus .NE. 0) then
142 call da_error(__FILE__,__LINE__, &
143 (/"Cannot write to trace file for "//trim(Name)/))
144 end if
145 end if
146
147 if (present(Messages)) then
148 do Loop = 1, size(Messages)
149 write (unit=trace_unit, fmt='(A," ",A)', iostat=IOStatus) &
150 pad(1:TraceDepth*TraceIndentAmount),trim(Messages(Loop))
151 if (IOStatus .NE. 0) then
152 call da_error(__FILE__,__LINE__, &
153 (/"Cannot write to trace file for "//trim(Name)/))
154 end if
155 end do ! Loop
156 end if
157 end if
158
159 if (NoCalls(Pointer) == trace_repeat_head) then
160 write(unit=trace_unit,fmt='(A," Called enough, going quiet")', &
161 iostat=IOStatus)&
162 pad(1:TraceDepth*TraceIndentAmount)
163 if (IOStatus .NE. 0) then
164 call da_error(__FILE__,__LINE__, &
165 (/"Cannot write to trace file for "//trim(Name)/))
166 end if
167 end if
168 end if ! trace_write
169
170 ! Restore pointer
171 Pointer = CalledBy(Pointer)
172
173 ! note local time
174
175 call system_clock(&
176 count=count)
177
178 elapsedtimelocalstart = real(count-baseelapsedtime)
179 call cpu_time(cputimelocalstart)
180
181 ! call flush(trace_unit)
182
183 end subroutine da_trace_exit
184
185