Timing_Utility.f90

Go to the documentation of this file.

! Utility to define a timing structure and
! timing utility routines.
!
MODULE timing_utility

  ! Module usage
  USE type_kinds      , ONLY: fp
  USE message_handler , ONLY: success, information, failure, display_message
  USE file_utility    , ONLY: get_lun, file_exists
  USE datetime_utility, ONLY: datetime_type    , &
                              datetime_now     , &
                              datetime_tostring
  ! Disable all implicit typing
  IMPLICIT NONE


  ! Visibilities
  PRIVATE
  ! ...Datatypes
  PUBLIC :: timing_type
  ! ...Procedures
  PUBLIC :: timing_begin
  PUBLIC :: timing_end
  PUBLIC :: timing_display
  PUBLIC :: timing_inspect
  PUBLIC :: timing_set
  PUBLIC :: timing_get
  PUBLIC :: timing_writefile
  ! ...Old named procedures
  PUBLIC :: begin_timing
  PUBLIC :: end_timing
  PUBLIC :: display_timing


  ! Parameters
  CHARACTER(*), PARAMETER :: module_version_id = &
  '$Id: Timing_Utility.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
  INTEGER, PARAMETER :: ml = 256


  ! Overloads
  INTERFACE begin_timing
    MODULE PROCEDURE timing_begin
  END INTERFACE begin_timing

  INTERFACE end_timing
    MODULE PROCEDURE timing_end
  END INTERFACE end_timing

  INTERFACE display_timing
    MODULE PROCEDURE timing_display
  END INTERFACE display_timing


  ! Derived type definitions
  !:tdoc+:
  TYPE :: timing_type
    PRIVATE
    LOGICAL :: is_valid = .false.
    INTEGER :: hertz       = 0
    INTEGER :: begin_clock = 0
    INTEGER :: end_clock   = 0
  END TYPE timing_type
  !:tdoc-:


CONTAINS


!################################################################################
!################################################################################
!##                                                                            ##
!##                         ## PUBLIC MODULE ROUTINES ##                       ##
!##                                                                            ##
!################################################################################
!################################################################################

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!   Timing_Begin
!
! PURPOSE:
!   Subroutine to set the begin time count in a timing object
!
! CALLING SEQUENCE:
!   CALL Timing_Begin( timing )
!
! INPUTS:
!   timing:  Timing object.
!            UNITS:      N/A
!            TYPE:       Timing_type
!            DIMENSION:  Scalar
!            ATTRIBUTES: INTENT(OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE timing_begin( self )  ! In/Output
    TYPE(timing_type), INTENT(OUT) :: self
    CALL system_clock( count_rate=self%Hertz, &
                       count     =self%Begin_Clock )
    IF ( self%Hertz == 0 ) RETURN
    self%Is_Valid = .true.
  END SUBROUTINE timing_begin


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!   Timing_End
!
! PURPOSE:
!   Subroutine to set the end time count in a timing object
!
! CALLING SEQUENCE:
!   CALL Timing_End( timing )
!
! INPUTS:
!   timing:  Timing object.
!            UNITS:      N/A
!            TYPE:       Timing_type
!            DIMENSION:  Scalar
!            ATTRIBUTES: INTENT(IN OUT)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE timing_end( self )  ! In/Output
    TYPE(timing_type), INTENT(IN OUT) :: self
    CALL system_clock( count=self%End_Clock )
  END SUBROUTINE timing_end


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!   Timing_Display
!
! PURPOSE:
!   Subroutine to display the elapsed time defined by the begin and end time
!   counts in the timing object.
!
! CALLING SEQUENCE:
!   CALL Timing_Display( timing, Caller = caller )
!
! INPUTS:
!   timing:  Timing object.
!            UNITS:      N/A
!            TYPE:       Timing_type
!            DIMENSION:  Scalar
!            ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
!   caller:  String containing the name of the calling routine.
!            If not specified, the name of this procedure is used.
!            UNITS:      N/A
!            TYPE:       CHARACTER(*)
!            DIMENSION:  Scalar
!            ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE timing_display( &
    self  , &  ! Input
    Caller  )  ! Optional input
    ! Arguments
    TYPE(timing_type),      INTENT(IN) :: self
    CHARACTER(*), OPTIONAL, INTENT(IN) :: caller
    ! Local variables
    CHARACTER(ML) :: msg
    CHARACTER(ML) :: routine_name

    ! Set up
    routine_name = 'Timing_Display'
    IF ( PRESENT(caller) ) routine_name = trim(adjustl(caller))
    ! ...Check if timing structure valid for display
    IF ( .NOT. self%Is_Valid ) THEN
      msg = 'Invalid timing structure!'
      CALL display_message( routine_name, msg, failure ); RETURN
    END IF

    ! Construct the character string
    WRITE( msg, '("Elapsed time-- ",a)' ) trim(timing_tostring(self))
    CALL display_message( routine_name, msg, information )

  END SUBROUTINE timing_display


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!   Timing_Inspect
!
! PURPOSE:
!   Subroutine to print the contents of a Timing object to stdout.
!
! CALLING SEQUENCE:
!   CALL Timing_Inspect( timing )
!
! OBJECTS:
!   Timing:  Timing object to display.
!            UNITS:      N/A
!            TYPE:       Timing_type
!            DIMENSION:  Scalar
!            ATTRIBUTES: INTENT(IN)
!
!:sdoc-:
!--------------------------------------------------------------------------------

  SUBROUTINE timing_inspect( self )
    TYPE(timing_type), INTENT(IN) :: self
    WRITE(*,'(1x,"Timing OBJECT")')
    WRITE(*,'(3x,"Hertz       : ",i0)') self%Hertz
    WRITE(*,'(3x,"Begin_Clock : ",i0)') self%Begin_Clock
    WRITE(*,'(3x,"End_Clock   : ",i0)') self%End_Clock
    WRITE(*,'(3x,"Is_Valid    : ",l1)') self%Is_Valid
  END SUBROUTINE timing_inspect


!------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       Timing_ToString
!
! PURPOSE:
!       Elemental function to return the equivalent string representation
!       of the Timing object.
!
! CALLING SEQUENCE:
!       string = Timing_ToString( Timing, Seconds=seconds, Fmt_String=fmt_string )
!
! OBJECTS:
!   Timing:        Timing structure containing the timed data.
!                  UNITS:      N/A
!                  TYPE:       Timing_type
!                  DIMENSION:  Scalar or any rank
!                  ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
!   Seconds:       Set this logical argument to create a string that is
!                  simply the number of seconds of elpased time.
!                  If == .FALSE., the output string format is HH:MM:SS.sss [DEFAULT].
!                     == .TRUE.,  the output string format is XX.XXXXXXe+EE (es13.6).
!                  If not specified, default is .FALSE.
!                  UNITS:      N/A
!                  TYPE:       LOGICAL
!                  DIMENSION:  Conformable with the Timing input
!                  ATTRIBUTES: INTENT(IN), OPTIONAL
!
!   Fmt_String:    Character string holding the format string to use for
!                  seconds of elasped time output. If not supplied, the
!                  default is '(es13.6)'.
!                  This argument is ignored if the "Seconds" argument is
!                  not specified, or not set.
!                  UNITS:      N/A
!                  TYPE:       CHARACTER(*)
!                  DIMENSION:  Conformable with the Timing input.
!                  ATTRIBUTES: INTENT(IN), OPTIONAL
!
! FUNCTION RESULT:
!   string:        String containing the time elapsed in seconds.
!                  UNITS:      N/A
!                  TYPE:       CHARACTER(80)
!                  DIMENSION:  Conformable with input Timing argument.
!
!:sdoc-:
!------------------------------------------------------------------------------

  ELEMENTAL FUNCTION timing_tostring( &
    self      , &  ! Input
    Seconds   , &  ! Optional input
    Fmt_String) &  ! Optional input
  result( string )
    ! Arguments
    TYPE(timing_type),           INTENT(IN) :: self
    LOGICAL          , OPTIONAL, INTENT(IN) :: seconds
    CHARACTER(*)     , OPTIONAL, INTENT(IN) :: fmt_string
    ! Function result
    CHARACTER(80) :: string
    ! Local parameters
    REAL(fp), PARAMETER :: n_seconds_in_hour        = 3600.0_fp
    REAL(fp), PARAMETER :: n_seconds_in_minute      =   60.0_fp
    REAL(fp), PARAMETER :: n_milliseconds_in_second = 1000.0_fp
    ! Local variables
    CHARACTER(80) :: fmt
    LOGICAL  :: hhmmss
    REAL(fp) :: total_time
    INTEGER  :: n_hours
    INTEGER  :: n_minutes
    INTEGER  :: n_seconds
    INTEGER  :: n_milliseconds

    ! Setup
    ! ...Process keyword arguments
    hhmmss = .true.
    IF ( PRESENT(seconds) ) hhmmss = .NOT. seconds
    fmt = '(es13.6)'
    IF ( PRESENT(fmt_string) ) fmt = adjustl(fmt_string)


    ! Compute the total time in seconds
    total_time = timing_elapsedtime( self )


    ! Create the string
    IF ( hhmmss ) THEN
      ! ...Split the total time into hours, minutes, seconds, and millseconds
      n_hours        = int(total_time / n_seconds_in_hour)
      n_minutes      = int(mod(total_time,n_seconds_in_hour) / n_seconds_in_minute)
      n_seconds      = int(mod(mod(total_time,n_seconds_in_hour), n_seconds_in_minute))
      n_milliseconds = int((total_time - aint(total_time,fp)) * n_milliseconds_in_second)
      ! ...Construct the HH:MM:SS.sss string
      WRITE( string,'(i2.2,":",i2.2,":",i2.2,".",i3.3 )' ) &
                    n_hours, n_minutes, n_seconds, n_milliseconds
    ELSE
      ! ...Construct the number of seconds string
      WRITE( string,fmt=fmt ) total_time
    END IF

  END FUNCTION timing_tostring


  ! Subroutine to set the components of a timing object
  ! Public, but only for testing so it's undocumented.
  SUBROUTINE timing_set( &
    self       , &
    Hertz      , &
    Begin_Clock, &
    End_Clock  , &
    Is_Valid     )
    ! Arguments
    TYPE(timing_type), INTENT(IN OUT) :: self
    INTEGER, OPTIONAL, INTENT(IN)     :: hertz
    INTEGER, OPTIONAL, INTENT(IN)     :: begin_clock
    INTEGER, OPTIONAL, INTENT(IN)     :: end_clock
    LOGICAL, OPTIONAL, INTENT(IN)     :: is_valid
    ! Set object components
    IF ( PRESENT(hertz      ) ) self%Hertz       = hertz
    IF ( PRESENT(begin_clock) ) self%Begin_Clock = begin_clock
    IF ( PRESENT(end_clock  ) ) self%End_Clock   = end_clock
    IF ( PRESENT(is_valid   ) ) self%Is_Valid    = is_valid
  END SUBROUTINE timing_set


  ! Subroutine to get the components of a timing object
  ! Public, but only for testing so it's undocumented.
  SUBROUTINE timing_get( &
    self       , &
    Hertz      , &
    Begin_Clock, &
    End_Clock  , &
    Is_Valid     )
    ! Arguments
    TYPE(timing_type), INTENT(IN)  :: self
    INTEGER, OPTIONAL, INTENT(OUT) :: hertz
    INTEGER, OPTIONAL, INTENT(OUT) :: begin_clock
    INTEGER, OPTIONAL, INTENT(OUT) :: end_clock
    LOGICAL, OPTIONAL, INTENT(OUT) :: is_valid
    ! Set object components
    IF ( PRESENT(hertz      ) ) hertz       = self%Hertz
    IF ( PRESENT(begin_clock) ) begin_clock = self%Begin_Clock
    IF ( PRESENT(end_clock  ) ) end_clock   = self%End_Clock
    IF ( PRESENT(is_valid   ) ) is_valid    = self%Is_Valid
  END SUBROUTINE timing_get

!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!   Timing_WriteFile
!
! PURPOSE:
!   Function to write timing object information to an ASCII file.
!
! CALLING SEQUENCE:
!   Error_Status = Timing_WriteFile( &
!                    Timing_Array, &
!                    Filename    , &
!                    Clobber = clobber, &
!                    Heading = heading  )
!
! OBJECTS:
!   Timing_Array:  Array of Timing objects to write to file. All elements
!                  must be valid.
!                  UNITS:      N/A
!                  TYPE:       Timing_type
!                  DIMENSION:  Rank-1
!                  ATTRIBUTES: INTENT(IN)
!
! INPUTS:
!   Filename:      Name of the file to write.
!                  - If file does not exist, it is created.
!                  - If file does exist, it is opened for appending data.
!                  UNITS:      N/A
!                  TYPE:       Timing_type
!                  DIMENSION:  Rank-1
!                  ATTRIBUTES: INTENT(IN)
!
! OPTIONAL INPUTS:
!   Clobber:       Set this logical argument to overwrite an existing filename.
!                  If == .FALSE., an existing file is opened with OLD status and
!                                 positioned at end-of-file for appending data [DEFAULT].
!                     == .TRUE.,  an existing file is opened with REPLACE status.
!                  If not specified, default is .FALSE.
!                  UNITS:      N/A
!                  TYPE:       LOGICAL
!                  DIMENSION:  Scalar
!                  ATTRIBUTES: INTENT(IN), OPTIONAL
!
!   Heading:       Array of character strings to use as heading labels for each
!                  timing object element.
!                  - If not specified, default is "Time 1", "Time 2", etc..
!                  - If specified, size must be same as Timing_Array.
!                  UNITS:      N/A
!                  TYPE:       CHARACTER
!                  DIMENSION:  Rank-1
!                  ATTRIBUTES: INTENT(IN), OPTIONAL
!
! FUNCTION RESULT:
!   Error_Status:  The return value is an integer defining the error status.
!                  The error codes are defined in the Message_Handler module.
!                  If == SUCCESS the data write was successful
!                     == FAILURE an unrecoverable error occurred.
!                  UNITS:      N/A
!                  TYPE:       INTEGER
!                  DIMENSION:  Scalar
!
!:sdoc-:
!--------------------------------------------------------------------------------

  FUNCTION timing_writefile( &
    Timing_Array, &
    Filename    , &
    Clobber     , &
    Heading     ) &
  result( err_stat )
    ! Arguments
    TYPE(timing_type),           INTENT(IN) :: timing_array(:)
    CHARACTER(*)     ,           INTENT(IN) :: filename
    LOGICAL          , OPTIONAL, INTENT(IN) :: clobber
    CHARACTER(*)     , OPTIONAL, INTENT(IN) :: heading(:)
    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: routine_name = 'Timing_WriteFile'
    ! Local variables
    CHARACTER(ML) :: msg, io_msg
    CHARACTER(ML) :: current_time
    CHARACTER(ML) :: title(size(timing_array))
    CHARACTER(ML) :: elapsed_time(size(timing_array))
    CHARACTER(ML) :: output_fmt
    CHARACTER(8) :: status, position
    LOGICAL :: append
    INTEGER :: fid
    INTEGER :: io_stat
    INTEGER :: i, n_times
    INTEGER :: sl_current_time
    INTEGER :: sl_elapsed_time

    ! Set up
    err_stat = success
    ! ...Check structures
    IF ( .NOT. all(timing_array%Is_Valid) ) THEN
      err_stat = failure
      msg = 'Input timing array contains invalid elements'
      CALL display_message(routine_name, msg, err_stat); RETURN
    END IF
    n_times = SIZE(timing_array)
    ! ...Check clobber argument
    append = .true.
    IF ( PRESENT(clobber) ) append = .NOT. clobber
    ! ...Check header argument
    IF ( PRESENT(heading) ) THEN
      IF ( SIZE(heading) /= n_times ) THEN
        err_stat = failure
        msg = 'Input heading array different size from timing array'
        CALL display_message(routine_name, msg, err_stat); RETURN
      END IF
      DO i = 1, n_times
        title(i) = '| '//trim(heading(i))
      END DO
    ELSE
      DO i = 1, n_times
        WRITE(title(i),'("| Time ",i0)') i
      END DO
    END IF


    ! Open the file
    ! ...Set specifiers for write
    IF ( append ) THEN
      status   = 'OLD'
      position = 'APPEND'
    ELSE
      status   = 'REPLACE'
      position = 'REWIND'
    END IF
    ! ...Special case for a file that doesn't exist yet
    IF ( .NOT. file_exists(filename) ) status = 'NEW'
    ! ...Get a free unit number
    fid = get_lun()
    IF ( fid < 0 ) THEN
      err_stat = failure
      msg = 'Error obtaining free logical unit number'
      CALL display_message(routine_name, msg, err_stat); RETURN
    END IF
    ! ...Open the file for output
    OPEN( fid, file     = filename   , &
               form     = 'FORMATTED', &
               status   = status     , &
               position = position   , &
               iostat   = io_stat    , &
               iomsg    = io_msg       )
    IF ( io_stat /= 0 ) THEN
      err_stat = failure
      msg = 'Error opening file '//trim(filename)//' - '//trim(io_msg)
      CALL display_message(routine_name, msg, err_stat); RETURN
    END IF


    ! Get the current date/time string, and its length, for output
    current_time    = datetime_tostring(datetime_now(),format='s')
    sl_current_time = len_trim(current_time)


    ! Transform the timing info to strings, and get their length
    elapsed_time    = timing_tostring(timing_array,seconds=.true.)
    sl_elapsed_time = max(maxval(len_trim(elapsed_time)), maxval(len_trim(title)))


    ! Construct the output write format
    WRITE(output_fmt,'("(a",i0,",",i0,"(2x,a",i0,"))")') &
                     sl_current_time, n_times, sl_elapsed_time


    ! Write the header line if necessary
    IF ( trim(status) == 'NEW' ) THEN
      WRITE(fid,fmt = output_fmt, iostat = io_stat, iomsg = io_msg) &
        'Current time', (trim(title(i)), i = 1, n_times)
      IF ( io_stat /= 0 ) THEN
        err_stat = failure
        msg = 'Error writing header to '//trim(filename)//' - '//trim(io_msg)
        CALL display_message(routine_name, msg, err_stat); RETURN
      END IF
    END IF


    ! Write the current set of times to file
    WRITE(fid,fmt = output_fmt, iostat = io_stat, iomsg = io_msg) &
      trim(current_time), &
      (trim(elapsed_time(i)), i = 1, n_times)
    IF ( io_stat /= 0 ) THEN
      err_stat = failure
      msg = 'Error writing timing data to '//trim(filename)//' - '//trim(io_msg)
      CALL display_message(routine_name, msg, err_stat); RETURN
    END IF


    ! Done
    CLOSE(fid, iostat = io_stat, &
               iomsg  = io_msg   )
    IF ( io_stat /= 0 ) THEN
      err_stat = failure
      msg = 'Error closing file '//trim(filename)//' - '//trim(io_msg)
      CALL display_message(routine_name, msg, err_stat); RETURN
    END IF

  END FUNCTION timing_writefile



!##############################################################################
!##############################################################################
!##                                                                          ##
!##                      ## PRIVATE MODULE ROUTINES ##                       ##
!##                                                                          ##
!##############################################################################
!##############################################################################

  ! Private elemental function to compute the elapsed time in seconds
  ELEMENTAL FUNCTION timing_elapsedtime( self ) RESULT( Elapsed_Time )
    TYPE(timing_type), INTENT(IN) :: self
    REAL(fp) :: elapsed_time
    elapsed_time = 0.0_fp
    IF ( .NOT. self%Is_Valid ) RETURN
    elapsed_time = REAL(self%End_Clock - self%Begin_Clock, fp) / REAL(self%hertz, fp)
  END FUNCTION timing_elapsedtime

END MODULE timing_utility