<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='DA_TRACE_EXIT'><A href='../../html_code/tracing/da_trace_exit.inc.html#DA_TRACE_EXIT' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
subroutine da_trace_exit(& 936,4
Name, & ! in
Message, & ! in, optional
Messages, & ! in, optional
MaxNoCalls) ! in, optional
!-----------------------------------------------------------------------
! Purpose: Trace exit from subroutine
!-----------------------------------------------------------------------
implicit none
character (len=*), intent(in) :: Name ! subroutine name
character (len=*), optional, intent(in) :: Message ! text to trace
character (len=*), optional, intent(in) :: Messages(:) ! text to trace
integer, optional, intent(in) :: MaxNoCalls ! max no calls to show
integer :: IOStatus ! I-O return code
integer :: Loop ! General loop counter
integer :: Count
integer :: TotalSpace
integer :: LocalMaxNoCalls
integer :: Caller
real :: temp_CPUTime
real :: temp1
real :: temp2
character(len=25) :: Change
call cpu_time(temp_CPUTime)
call system_clock(&
COUNT=Count)
!======================================================================
! check whether trace active and whether depth exceeded
!======================================================================
if (.NOT. TraceActive) then
return
end if
if (TraceActive) then
! was tracing enabled by this routine? If it was, disable it, to
! take affect after the trace line has been written
if (Name == TraceStartedBy(1:LEN(Name))) then
TraceActive = .false.
end if
end if
temp1 = real(Count - BaseElapsedTime) - ElapsedTimeLocalStart
temp2 = temp_CPUTime - CPUTimeLocalStart
TraceDepth=TraceDepth-1
if (TraceDepth < 0) then
TraceDepth = 0
end if
!=======================================================================
! Check timing and maximum heap memory usage
!=======================================================================
ElapsedTimeLocal(Pointer) = ElapsedTimeLocal(Pointer) + temp1
ElapsedTimeThisCall(Pointer) = ElapsedTimeThisCall(Pointer) + temp1
ElapsedTime(Pointer) = ElapsedTime(Pointer) + &
ElapsedTimeThisCall(Pointer)
CPUTimeLocal(Pointer) = CPUTimeLocal(Pointer) + temp2
CPUTimeThisCall(Pointer) = CPUTimeThisCall(Pointer) + temp2
CPUTime(Pointer) = CPUTime(Pointer) + CPUTimeThisCall(Pointer)
Caller=CalledBy(Pointer)
if (Caller /= 0) then
ElapsedTimeThisCall(Caller) = ElapsedTimeThisCall(Caller) + &
ElapsedTimeThisCall(Pointer)
CPUTimeThisCall(Caller) = CPUTimeThisCall(Caller) + CPUTimeThisCall(Pointer)
end if
Change = ""
if (trace_memory) then
call da_memory(&
TotalSpace)
if (EntryHeap(Pointer) < TotalSpace) then
write(Change,"(A9,I12)")", BIGGER", TotalSpace - EntryHeap(Pointer)
else if (EntryHeap(Pointer) > TotalSpace) then
write(Change,"(A9,I12)")", SMALLER", TotalSpace - EntryHeap(Pointer)
end if
if (MaxHeap(Pointer) < TotalSpace) then
MaxHeap(Pointer) = TotalSpace
end if
else
TotalSpace = 0
end if
if (trace_write .AND. TraceDepth <= trace_max_depth) then
if (present(MaxNoCalls)) then
LocalMaxNoCalls = MaxNoCalls
else
LocalMaxNoCalls = trace_repeat_head
end if
IOStatus=0
if (NoCalls(Pointer) <= LocalMaxNoCalls) then
if (trace_memory) then
if (use_html) then
write (unit=trace_unit, &
fmt='(A, "&lt; <a href=",A,"/",A,".html>",A,"</a>",I11,A)', &
iostat=IOStatus) &
pad(1:TraceDepth*TraceIndentAmount),trim(Documentation_url), &
trim(Name),trim(Name), TotalSpace, Change
else
write (unit=trace_unit, &
fmt='(A, "< ",A,I11,A)', &
iostat=IOStatus) &
pad(1:TraceDepth*TraceIndentAmount),trim(Name), TotalSpace, Change
end if
else
if (use_html) then
write (unit=trace_unit, &
fmt='(A, "&lt; <a href=",A,"/",A,".html>",A,"</a>")', &
iostat=IOStatus) &
pad(1:TraceDepth*TraceIndentAmount),trim(Documentation_url), &
trim(Name),trim(Name)
else
write (unit=trace_unit, fmt='(A, "< ",A)', iostat=IOStatus) &
pad(1:TraceDepth*TraceIndentAmount),trim(Name)
end if
end if
if (IOStatus /= 0) then
call da_error
(__FILE__,__LINE__, &
(/"Cannot write to trace file for "//Name/))
end if
if (present(Message)) then
write (unit=trace_unit, fmt='(A," ",A)', iostat=IOStatus) &
pad(1:TraceDepth*TraceIndentAmount),trim(Message)
if (IOStatus .NE. 0) then
call da_error(__FILE__,__LINE__, &
(/"Cannot write to trace file for "//Name/))
end if
end if
if (present(Messages)) then
do Loop = 1, size(Messages)
write (unit=trace_unit, fmt='(A," ",A)', iostat=IOStatus) &
pad(1:TraceDepth*TraceIndentAmount),trim(Messages(Loop))
if (IOStatus .NE. 0) then
call da_error(__FILE__,__LINE__, &
(/"Cannot write to trace file for "//Name/))
end if
end do ! Loop
end if
end if
if (NoCalls(Pointer) == trace_repeat_head) then
write(unit=trace_unit,fmt='(A," Called enough, going quiet")', &
iostat=IOStatus)&
pad(1:TraceDepth*TraceIndentAmount)
if (IOStatus .NE. 0) then
call da_error(__FILE__,__LINE__, &
(/"Cannot write to trace file for "//Name/))
end if
end if
end if ! trace_write
! Restore pointer
Pointer = CalledBy(Pointer)
! note local time
call system_clock(&
count=count)
elapsedtimelocalstart = real(count-baseelapsedtime)
call cpu_time(cputimelocalstart)
! call flush(trace_unit)
end subroutine da_trace_exit