!===============================================================================
! CVS: $Id: shr_timer_mod.F90,v 1.2.4.1 2004/01/02 18:50:56 mvr Exp $
! CVS: $Source: /fs/cgd/csm/models/CVS.REPOS/shared/csm_share/shr/shr_timer_mod.F90,v $
! CVS: $Name: cam3_0_brnchT_release01 $
!===============================================================================
module shr_timer_mod,1
!----------------------------------------------------------------------------
!
! routines that support multiple CPU timers via F90 intrisics
!
! Note:
! o if an operation is requested on an invalid timer number n
! then nothing is done in a routine
! o if more than max_timers are requested,
! then timer n=max_timers is "overloaded" and becomes invalid/undefined
!----------------------------------------------------------------------------
use shr_kind_mod
implicit none
private ! resticted access
public :: shr_timer_init , shr_timer_get , &
& shr_timer_start, shr_timer_stop , &
& shr_timer_print, shr_timer_print_all, &
& shr_timer_check, shr_timer_check_all, &
& shr_timer_zero , shr_timer_zero_all , &
& shr_timer_free , shr_timer_free_all , &
& shr_timer_sleep
integer(SHR_KIND_IN),parameter :: stat_free = 0 ! timer status constants
integer(SHR_KIND_IN),parameter :: stat_inuse = 1
integer(SHR_KIND_IN),parameter :: stat_started = 2
integer(SHR_KIND_IN),parameter :: stat_stopped = 3
integer(SHR_KIND_IN),parameter :: max_timers = 200 ! max number of timers
integer(SHR_KIND_IN) :: status (max_timers) ! status of each timer
integer(SHR_KIND_IN) :: cycles1(max_timers) ! cycle number at timer start
integer(SHR_KIND_IN) :: cycles2(max_timers) ! cycle number at timer stop
character (len=80) :: name (max_timers) ! name assigned to each timer
real (SHR_KIND_R8) :: dt (max_timers) ! accumulated time
integer(SHR_KIND_IN) :: calls (max_timers) ! # of samples in accumulation
integer(SHR_KIND_IN) :: cycles_max = -1 ! max cycles before wrapping
real (SHR_KIND_R8) :: clock_rate ! clock_rate: seconds per cycle
save
!===============================================================================
contains
!===============================================================================
subroutine shr_timer_init,1
!----- local -----
integer(SHR_KIND_IN) :: cycles ! count rate return by system clock
!----- i/o formats -----
character(len=*),parameter :: F00 = "('(shr_timer_init) ',a,i5)"
!-------------------------------------------------------------------------------
!
! This routine initializes:
! 1) values in all timer array locations
! 2) machine parameters necessary for computing cpu time from F90 intrinsics.
! F90 intrinsic: system_clock(count_rate=cycles, count_max=cycles_max)
!-------------------------------------------------------------------------------
call shr_timer_free_all
call system_clock(count_rate=cycles, count_max=cycles_max)
if (cycles /= 0) then
clock_rate = 1.0/real(cycles)
else
clock_rate = 0
write(6,F00) 'ERROR: no system clock available'
endif
end subroutine shr_timer_init
!===============================================================================
subroutine shr_timer_get(n, str)
!----- arguments -----
integer(SHR_KIND_IN),intent(out) :: n ! timer number
character (*) ,intent( in) :: str ! text string with timer name
!----- i/o formats -----
character(len=*),parameter :: F00 = "('(shr_timer_get) ',a,i5)"
!-----------------------------------------------------------------------
!
! search for next free timer
!
!-----------------------------------------------------------------------
do n=1,max_timers
if (status(n) == stat_free) then
status(n) = stat_inuse
name (n) = str
calls (n) = 0
return
endif
end do
n=max_timers
name (n) = "<invalid - undefined - overloaded>"
write(6,F00) 'ERROR: exceeded maximum number of timers'
end subroutine shr_timer_get
!===============================================================================
subroutine shr_timer_start(n) 3,1
!----- arguments -----
integer(SHR_KIND_IN), intent(in) :: n ! timer number
!----- i/o formats -----
character(len=*),parameter :: F00 = "('(shr_timer_start) ',a,i5)"
!-----------------------------------------------------------------------
!
! This routine starts a given timer.
!
!-----------------------------------------------------------------------
if ( n>0 .and. n<=max_timers) then
if (status(n) == stat_started) call shr_timer_stop(n)
status(n) = stat_started
call system_clock(count=cycles1(n))
else
write(6,F00) 'ERROR: invalid timer number: ',n
end if
end subroutine shr_timer_start
!===============================================================================
subroutine shr_timer_stop(n) 4
!----- arguments -----
integer(SHR_KIND_IN), intent(in) :: n ! timer number
!----- local -----
real (SHR_KIND_R8) :: elapse ! elapsed time returned by system counter
!----- i/o formats -----
character(len=*),parameter :: F00 = "('(shr_timer_stop) ',a,i5)"
!-------------------------------------------------------------------------------
!
! This routine stops a given timer, checks for cycle wrapping, computes the
! elpased time, and accumulates the elpased time in the dt(n) array
!
!-------------------------------------------------------------------------------
if ( n>0 .and. n<=max_timers) then
if ( status(n) == stat_started) then
call system_clock(count=cycles2(n))
if (cycles2(n) >= cycles1(n)) then
dt(n) = dt(n) + clock_rate*(cycles2(n) - cycles1(n))
else
dt(n) = dt(n) + clock_rate*(cycles_max + cycles2(n) - cycles1(n))
endif
calls (n) = calls (n) + 1
status(n) = stat_stopped
end if
else
write(6,F00) 'ERROR: invalid timer number: ',n
end if
end subroutine shr_timer_stop
!===============================================================================
subroutine shr_timer_print(n) 1,2
!----- arguments -----
integer(SHR_KIND_IN), intent(in) :: n ! timer number
!----- i/o formats -----
character(len=*),parameter :: F00 = "('(shr_timer_print) ',a,i5)"
character(len=*),parameter :: F01 = "('(shr_timer_print) timer',i3,&
& ':',i8,' calls,',f10.3,'s, id: ',a)"
!-------------------------------------------------------------------------------
!
! prints the accumulated time for a given timer
!
!-------------------------------------------------------------------------------
if ( n>0 .and. n<=max_timers) then
if (status(n) == stat_started) then
call shr_timer_stop(n)
write (6,F01) n,calls(n),dt(n),trim(name(n))
call shr_timer_start(n)
else
write (6,F01) n,calls(n),dt(n),trim(name(n))
endif
else
write(6,F00) 'ERROR: invalid timer number: ',n
end if
end subroutine shr_timer_print
!===============================================================================
subroutine shr_timer_print_all,1
!----- local -----
integer(SHR_KIND_IN) :: n
!----- i/o formats -----
character(len=*),parameter :: F00 = "('(shr_timer_print_all) ',a,i5)"
!-------------------------------------------------------------------------------
!
! prints accumulated time for all timers in use
!
!-------------------------------------------------------------------------------
write(6,F00) 'print all timing info:'
do n=1,max_timers
if (status(n) /= stat_free) call shr_timer_print(n)
end do
end subroutine shr_timer_print_all
!===============================================================================
subroutine shr_timer_zero(n)
!----- arguments -----
integer(SHR_KIND_IN), intent(in) :: n ! timer number
!----- i/o formats -----
character(len=*),parameter :: F00 = "('(shr_timer_zero) ',a,i5)"
!-------------------------------------------------------------------------------
!
! This routine resets a given timer.
!
!-------------------------------------------------------------------------------
if ( n>0 .and. n<=max_timers) then
dt(n) = 0.0
calls(n) = 0
else
write(6,F00) 'ERROR: invalid timer number: ',n
end if
end subroutine shr_timer_zero
!===============================================================================
subroutine shr_timer_zero_all
!----- i/o formats -----
character(len=*),parameter :: F00 = "('(shr_timer_zero_all) ',a,i5)"
!-------------------------------------------------------------------------------
!
! This routine resets all timers.
!
!-------------------------------------------------------------------------------
dt = 0.0
calls = 0
end subroutine shr_timer_zero_all
!===============================================================================
subroutine shr_timer_check(n),2
!----- arguments -----
integer(SHR_KIND_IN), intent(in) :: n ! timer number
!----- i/o formats -----
character(len=*),parameter :: F00 = "('(shr_timer_check) ',a,i5)"
!-------------------------------------------------------------------------------
!
! This routine checks a given timer. This is primarily used to
! periodically accumulate time in the timer to prevent timer cycles
! from wrapping around max_cycles.
!
!-------------------------------------------------------------------------------
if ( n>0 .and. n<=max_timers) then
if (status(n) == stat_started) then
call shr_timer_stop (n)
call shr_timer_start(n)
endif
else
write(6,F00) 'ERROR: invalid timer number: ',n
end if
end subroutine shr_timer_check
!===============================================================================
subroutine shr_timer_check_all,2
!----- local -----
integer(SHR_KIND_IN) :: n
!----- i/o formats -----
character(len=*),parameter :: F00 = "('(shr_timer_check_all) ',a,i5)"
!-------------------------------------------------------------------------------
!
! Call shr_timer_check for all timers in use
!
!-------------------------------------------------------------------------------
do n=1,max_timers
if (status(n) == stat_started) then
call shr_timer_stop (n)
call shr_timer_start(n)
endif
end do
end subroutine shr_timer_check_all
!===============================================================================
subroutine shr_timer_free(n) 1
!----- arguments -----
integer(SHR_KIND_IN),intent(in) :: n ! timer number
!----- i/o formats -----
character(len=*),parameter :: F00 = "('(shr_timer_free) ',a,i5)"
!-----------------------------------------------------------------------
!
! initialize/free all timer array values
!
!-----------------------------------------------------------------------
if ( n>0 .and. n<=max_timers) then
status (n) = stat_free
name (n) = "<invalid - undefined>"
dt (n) = 0.0
cycles1(n) = 0
cycles2(n) = 0
else
write(6,F00) 'ERROR: invalid timer number: ',n
end if
end subroutine shr_timer_free
!===============================================================================
subroutine shr_timer_free_all 1,1
!----- local -----
integer(SHR_KIND_IN) :: n
!----- i/o formats -----
character(len=*),parameter :: F00 = "('(shr_timer_free_all) ',a,i5)"
!-------------------------------------------------------------------------------
!
! initialize/free all timer array values
!
!-------------------------------------------------------------------------------
do n=1,max_timers
call shr_timer_free(n)
end do
end subroutine shr_timer_free_all
!===============================================================================
subroutine shr_timer_sleep(sec),2
use shr_sys_mod ! share system calls (namely, shr_sys_sleep)
!----- local -----
real (SHR_KIND_R8),intent(in) :: sec ! number of seconds to sleep
!-------------------------------------------------------------------------------
! Sleep for approximately sec seconds
!
! Note: sleep is typically a system call, hence it is implemented in
! shr_sys_mod, although it probably would only be used in a timing
! context, which is why there is a shr_timer_* wrapper provided here.
!-------------------------------------------------------------------------------
call shr_sys_sleep(sec)
end subroutine shr_timer_sleep
!===============================================================================
end module shr_timer_mod
!===============================================================================