var/da/da_tracing/da_trace_entry.inc

   1 subroutine da_trace_entry(&
   2    Name, &                       ! in
   3    Message, &                    ! in, optional
   4    Messages, &                   ! in, optional
   5    MaxNoCalls)                   ! in, optional
   6
   7    !-----------------------------------------------------------------------
   8    ! Purpose: Trace entry point to subroutine
   9    !-----------------------------------------------------------------------
  10
  11    implicit none
  12
  13    character (len=*),           intent(in) :: Name         ! Routine name
  14    character (len=*), optional, intent(in) :: Message      ! message
  15    character (len=*), optional, intent(in) :: Messages(:)  ! message array
  16    integer, optional,           intent(in) :: MaxNoCalls   ! max no calls to show
  17
  18
  19    integer           :: IOStatus        ! I-O return code
  20    integer           :: Loop            ! General loop counter
  21    integer           :: Count
  22    integer           :: OldPointer
  23    integer           :: TotalSpace
  24    integer           :: LocalMaxNoCalls
  25    real              :: CPUTime1
  26    real              :: temp1
  27    real              :: temp2
  28    logical           :: NewRoutine
  29
  30    call cpu_time(CPUTime1)
  31
  32    call system_clock(&
  33       COUNT=Count)
  34
  35    !-----------------------------------------------------------------------
  36    ! check if tracing active. If not check whether to switch it on
  37    !-----------------------------------------------------------------------
  38
  39    if (.NOT. TraceActive) then
  40       if (trace_start_points == 0) then
  41          ! start with first call
  42          TraceActive = .true.
  43       else
  44          do Loop=1,trace_start_points
  45             if (Name == TraceNames(Loop)(1:LEN(Name))) then
  46                TraceActive    = .true.
  47                TraceDepth     = 0
  48                TraceStartedBy = Name
  49                exit
  50             end if
  51          end do
  52       end if
  53       if (.NOT. TraceActive) then
  54          ! did not want to start trace, so leave
  55          return
  56       end if
  57    end if
  58
  59    !-----------------------------------------------------------------------
  60    ! timing and maximum heap usage
  61    !-----------------------------------------------------------------------
  62
  63    ! Increment the local elapsed time and local CPU time since the
  64    ! last trace entry, if any
  65
  66    if (Pointer /= 0) then
  67       temp1 = real(Count - BaseElapsedTime) - ElapsedTimeLocalStart
  68       temp2 = CPUTime1 - CPUTimeLocalStart
  69       ElapsedTimeLocal(Pointer)    = ElapsedTimeLocal(Pointer) + temp1
  70       ElapsedTimeThisCall(Pointer) = ElapsedTimeThisCall(Pointer) + temp1
  71       CPUTimeLocal(Pointer)        = CPUTimeLocal(Pointer) + temp2
  72       CPUTimeThisCall(Pointer)     = CPUTimeThisCall(Pointer) + temp2
  73    end if
  74
  75    OldPointer=Pointer
  76
  77    ! Check subroutine name
  78
  79    NewRoutine = .true.
  80    do Pointer=1,NoRoutines
  81       if (TimerNames(Pointer) == Name) then
  82          NewRoutine=.false.
  83          exit
  84       end if
  85    end do
  86
  87    if (NewRoutine) then
  88       ! New subroutine entered
  89       if (NoRoutines >= MaxNoRoutines)then ! too many to trace
  90           call da_error(__FILE__,__LINE__, &
  91              (/"Too many routines. Not timing " // Name/))
  92
  93          !All the timings etc are put instead to the calling routine,
  94          ! which therefore may have incorrect summaries.
  95          !The best solution is to increase MaxNoRoutines.
  96          Pointer = OldPointer
  97          ! Fix to get the correct NoCalls(OldPointer) despite the +1 later
  98          NoCalls(Pointer)=NoCalls(Pointer)-1
  99
 100       else ! Pointer=NoRoutines+1 (from the end of earlier do loop)
 101          NoRoutines=NoRoutines+1
 102          TimerNames(NoRoutines)=Name
 103       end if
 104    end if
 105
 106    NoCalls(Pointer)=NoCalls(Pointer)+1
 107
 108    CPUTimeThisCall(Pointer)     = 0.0
 109    ElapsedTimeThisCall(Pointer) = 0.0
 110
 111    CalledBy(Pointer)=OldPointer
 112
 113    if (trace_memory) then
 114       call da_memory(&
 115          TotalSpace)
 116       EntryHeap(Pointer) = TotalSpace
 117       LastSpace = TotalSpace
 118       if (MaxHeap(Pointer) < TotalSpace) then
 119          MaxHeap(Pointer) = TotalSpace
 120       end if
 121    else
 122       TotalSpace = 0
 123    end if
 124
 125    if (trace_write .AND. TraceDepth <= trace_max_depth) then
 126
 127       if (present(MaxNoCalls)) then
 128          LocalMaxNoCalls = MaxNoCalls
 129       else
 130          LocalMaxNoCalls = trace_repeat_head
 131       end if
 132
 133       if (NoCalls(Pointer) <= LocalMaxNoCalls) then
 134          if (trace_memory) then
 135             if (use_html) then
 136                write (unit=trace_unit, &
 137                   fmt='(A,"&gt; <a href=",A,"/",A,".html>",A,"</a>",I11)', &
 138                   iostat=IOStatus) &
 139                   pad(1:TraceDepth*TraceIndentAmount),trim(Documentation_url), &
 140                   trim(Name),trim(Name), TotalSpace
 141             else
 142                write (unit=trace_unit, &
 143                   fmt='(A,"> ",A,I11)', &
 144                   iostat=IOStatus) &
 145                   pad(1:TraceDepth*TraceIndentAmount),trim(Name), TotalSpace
 146            end if
 147          else
 148             if (use_html) then
 149                write (unit=trace_unit, &
 150                   fmt='(A,"&gt; <a href=",A,"/",A,".html>",A,"</a>")', &
 151                   iostat=IOStatus) &
 152                   pad(1:TraceDepth*TraceIndentAmount),trim(Documentation_url), &
 153                   trim(Name),trim(Name)
 154             else
 155                write (unit=trace_unit, fmt='(A,"> ",A)', iostat=IOStatus) &
 156                   pad(1:TraceDepth*TraceIndentAmount),trim(Name)
 157             end if
 158          end if
 159          if (IOStatus /= 0) then
 160             call da_error(__FILE__,__LINE__, &
 161                (/"Cannot write to trace file for "//Name/))
 162          end if
 163
 164          if (present(Message)) then
 165             write (unit=trace_unit, fmt='(A," ",A)', iostat=IOStatus) &
 166                pad(1:TraceDepth*TraceIndentAmount),trim(Message)
 167             if (IOStatus .NE. 0) then
 168                call da_error(__FILE__,__LINE__, &
 169                   (/"Cannot write to trace file for "//Name/))
 170             end if
 171          end if
 172
 173          if (present(Messages)) then
 174             do Loop = 1, size(Messages)
 175                write (unit=trace_unit, fmt='(A," ",A)', iostat=IOStatus) &
 176                   pad(1:TraceDepth*TraceIndentAmount),trim(Messages(Loop))
 177                if (IOStatus .NE. 0) then
 178                   call da_error(__FILE__,__LINE__, &
 179                      (/"Cannot write to trace file for "//Name/))
 180                end if
 181             end do ! Loop
 182          end if
 183       end if
 184
 185    end if ! trace_write
 186
 187    TraceDepth=TraceDepth+1
 188
 189    call system_clock(&
 190       COUNT=Count)
 191
 192    call cpu_time(CPUTime1)
 193
 194    ! set the start elapsed and CPU time both locally and generally
 195
 196    ElapsedTimeStart(Pointer) = real(Count-BaseElapsedTime)
 197    ElapsedTimeLocalStart     = real(Count-BaseElapsedTime)
 198
 199    CPUTimeStart(Pointer) = CPUTime1
 200    CPUTimeLocalStart     = CPUTime1
 201
 202    ! call flush(trace_unit)
 203
 204    return
 205 end subroutine da_trace_entry
 206
 207