subroutine da_trace(& Name, & ! in Message, & ! in, optional Messages, & ! in, optional MaxNoCalls) ! in, optional implicit none !-------------------------------------------------------------------- ! Purpose: General trace within a subroutine !-------------------------------------------------------------------- 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 :: TotalSpace integer :: LocalMaxNoCalls character(len=25) :: Change !----------------------------------------------------------------------- ! Check whether trace active and depth of trace !----------------------------------------------------------------------- if (.NOT. TraceActive) then return end if if (TraceDepth >= trace_max_depth) then ! already at maximum depth, so return return end if !----------------------------------------------------------------------- ! Note memory usage !----------------------------------------------------------------------- Change = "" if (trace_memory) then call da_memory(& TotalSpace) if (LastSpace < TotalSpace) then write(Change,"(A9,I12)")", bigger", TotalSpace - LastSpace else if (LastSpace > TotalSpace) then write(Change,"(A9,I12)")", smaller", TotalSpace - LastSpace end if if (MaxHeap(Pointer) < TotalSpace) then MaxHeap(Pointer) = TotalSpace end if LastSpace = TotalSpace else TotalSpace = 0 end if !----------------------------------------------------------------------- ! Perform the trace if not done too many times before. only on PE 0 !----------------------------------------------------------------------- if (trace_write) then if (present(MaxNoCalls)) then LocalMaxNoCalls = MaxNoCalls else LocalMaxNoCalls = trace_repeat_body end if NoCallsBody(Pointer) = NoCallsBody(Pointer)+1 if (NoCallsBody(Pointer) <= LocalMaxNoCalls) then if (trace_memory) then if (use_html) then write (unit=trace_unit, & fmt='(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, "| ",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 (NoCallsBody(Pointer) == trace_repeat_body) 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 end subroutine da_trace