var/da/da_tracing/da_trace.inc

   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 "//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 "//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 "//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 "//Name/))
 133          end if
 134       end if
 135    end if ! trace_write
 136
 137 end subroutine da_trace
 138
 139