da_trace.inc
References to this file elsewhere.
1 subroutine da_trace(&
2 Name, & ! in
3 Message, & ! in, optional
4 Messages, & ! in, optional
5 MaxNoCalls) ! in, optional
6
7 implicit none
8
9 !--------------------------------------------------------------------
10 ! Purpose: General trace within a subroutine
11 !--------------------------------------------------------------------
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 :: TotalSpace
21 integer :: LocalMaxNoCalls
22 character(len=25) :: Change
23
24 !-----------------------------------------------------------------------
25 ! Check whether trace active and depth of trace
26 !-----------------------------------------------------------------------
27
28 if (.NOT. TraceActive) then
29 return
30 end if
31
32 if (TraceDepth >= trace_max_depth) then
33 ! already at maximum depth, so return
34 return
35 end if
36
37 !-----------------------------------------------------------------------
38 ! Note memory usage
39 !-----------------------------------------------------------------------
40
41 Change = ""
42
43 if (trace_memory) then
44 call da_memory(&
45 TotalSpace)
46 if (LastSpace < TotalSpace) then
47 write(Change,"(A9,I12)")", bigger", TotalSpace - LastSpace
48 else if (LastSpace > TotalSpace) then
49 write(Change,"(A9,I12)")", smaller", TotalSpace - LastSpace
50 end if
51 if (MaxHeap(Pointer) < TotalSpace) then
52 MaxHeap(Pointer) = TotalSpace
53 end if
54 LastSpace = TotalSpace
55 else
56 TotalSpace = 0
57 end if
58
59 !-----------------------------------------------------------------------
60 ! Perform the trace if not done too many times before. only on PE 0
61 !-----------------------------------------------------------------------
62
63 if (trace_write) then
64
65 if (present(MaxNoCalls)) then
66 LocalMaxNoCalls = MaxNoCalls
67 else
68 LocalMaxNoCalls = trace_repeat_body
69 end if
70
71 NoCallsBody(Pointer) = NoCallsBody(Pointer)+1
72
73 if (NoCallsBody(Pointer) <= LocalMaxNoCalls) then
74 if (trace_memory) then
75 if (use_html) then
76 write (unit=trace_unit, &
77 fmt='(A, "| <a href=",A,"/",A,".html>",A,"</a>",I11,A)', &
78 iostat=IOStatus) &
79 pad(1:TraceDepth*TraceIndentAmount),trim(Documentation_url), &
80 trim(Name), trim(Name), TotalSpace, Change
81 else
82 write (unit=trace_unit, &
83 fmt='(A, "| ",A,I11,A)', &
84 iostat=IOStatus) &
85 pad(1:TraceDepth*TraceIndentAmount),trim(Name), TotalSpace, Change
86 end if
87 else
88 if (use_html) then
89 write (unit=trace_unit, &
90 fmt='(A, "| <a href=",A,"/",A,".html>",A,"</a>")', &
91 iostat=IOStatus) &
92 pad(1:TraceDepth*TraceIndentAmount),trim(Documentation_url), &
93 trim(Name), trim(Name)
94 else
95 write (unit=trace_unit, &
96 fmt='(A, "| ",A)', &
97 iostat=IOStatus) &
98 pad(1:TraceDepth*TraceIndentAmount),trim(Name)
99 end if
100 end if
101 if (IOStatus /= 0) then
102 call da_error(__FILE__,__LINE__, &
103 (/"Cannot write to trace file for "//trim(Name)/))
104 end if
105
106 if (present(Message)) then
107 write (unit=trace_unit, fmt='(A," ",A)', iostat=IOStatus) &
108 pad(1:TraceDepth*TraceIndentAmount),trim(Message)
109 if (IOStatus .NE. 0) then
110 call da_error(__FILE__,__LINE__, &
111 (/"Cannot write to trace file for "//trim(Name)/))
112 end if
113 end if
114
115 if (present(Messages)) then
116 do Loop = 1, size(Messages)
117 write (unit=trace_unit, fmt='(A," ",A)', iostat=IOStatus) &
118 pad(1:TraceDepth*TraceIndentAmount),trim(Messages(Loop))
119 if (IOStatus .NE. 0) then
120 call da_error(__FILE__,__LINE__, &
121 (/"Cannot write to trace file for "//trim(Name)/))
122 end if
123 end do ! Loop
124 end if
125 end if
126
127 if (NoCallsBody(Pointer) == trace_repeat_body) then
128 write (unit=trace_unit, fmt='(A," Called enough, going quiet")', iostat=IOStatus) &
129 pad(1:TraceDepth*TraceIndentAmount)
130 if (IOStatus .NE. 0) then
131 call da_error(__FILE__,__LINE__, &
132 (/"Cannot write to trace file for "//trim(Name)/))
133 end if
134 end if
135 end if ! trace_write
136
137 end subroutine da_trace
138
139