var/da/da_tracing/da_trace_exit.inc

   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, "&lt; <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, "&lt; <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 "//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 "//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 "//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 "//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