!===============================================================================
! SVN $Id: shr_timer_mod.F90 6752 2007-10-04 21:02:15Z jwolfe $
! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/branch_tags/cesm1_0_rel_tags/cesm1_0_rel01_share3_100616/shr/shr_timer_mod.F90 $
!===============================================================================
module shr_timer_mod 2,3
!----------------------------------------------------------------------------
!
! routines that support multiple CPU timers via F90 intrinsics
!
! 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
!
! * cpp if-defs were introduced in 2005 to work-around a bug in the ORNL Cray
! X1 F90 intrinsic system_clock() function -- ideally this Cray bug would be
! fixed and cpp if-defs would be unnecessary and removed.
!
! !REVISION HISTORY:
! 2005-??-?? - added workaround for Cray F90 bug, mods by Cray/ORNL
! 2000-??-?? - 1st version by B. Kauffman
!----------------------------------------------------------------------------
use shr_kind_mod
use shr_log_mod, only: s_loglev => shr_log_Level
use shr_log_mod, only: s_logunit => shr_log_Unit
implicit none
private ! restricted access
public :: shr_timer_init
public :: shr_timer_get
public :: shr_timer_start
public :: shr_timer_stop
public :: shr_timer_print
public :: shr_timer_print_all
public :: shr_timer_check
public :: shr_timer_check_all
public :: shr_timer_zero
public :: shr_timer_zero_all
public :: shr_timer_free
public :: shr_timer_free_all
public :: 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
!----------------------------------------------------------------------------
! the following ifdef circumvents a bug in the X1 system_clock function
!----------------------------------------------------------------------------
#if (defined UNICOSMP)
integer(kind=8) :: cycles1(max_timers) ! cycle number at timer start
integer(kind=8) :: cycles2(max_timers) ! cycle number at timer stop
#else
integer(SHR_KIND_IN) :: cycles1(max_timers) ! cycle number at timer start
integer(SHR_KIND_IN) :: cycles2(max_timers) ! cycle number at timer stop
#endif
integer(SHR_KIND_IN) :: cycles_max = -1 ! max cycles before wrapping
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
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
#if (defined UNICOSMP)
integer(kind=8) :: irtc_rate
#endif
!----- 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
#if (defined UNICOSMP)
cycles = irtc_rate()
#else
call system_clock(count_rate=cycles, count_max=cycles_max)
#endif
if (cycles /= 0) then
clock_rate = 1.0_SHR_KIND_R8/real(cycles,SHR_KIND_R8)
else
clock_rate = 0._SHR_KIND_R8
if (s_loglev > 0) write(s_logunit,F00) 'ERROR: no system clock available'
endif
end subroutine shr_timer_init
!===============================================================================
subroutine shr_timer_get(n, str) 31
!----- 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>"
if (s_loglev > 0) write(s_logunit,F00) 'ERROR: exceeded maximum number of timers'
end subroutine shr_timer_get
!===============================================================================
subroutine shr_timer_start(n) 34,1
!----- arguments -----
integer(SHR_KIND_IN), intent(in) :: n ! timer number
!----- local -----
#if (defined UNICOSMP)
integer(kind=8) :: irtc
#endif
!----- 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
#if (defined UNICOSMP)
cycles1(n) = irtc()
#else
call system_clock(count=cycles1(n))
#endif
else
if (s_loglev > 0) write(s_logunit,F00) 'ERROR: invalid timer number: ',n
end if
end subroutine shr_timer_start
!===============================================================================
subroutine shr_timer_stop(n) 36
!----- arguments -----
integer(SHR_KIND_IN), intent(in) :: n ! timer number
!----- local -----
real (SHR_KIND_R8) :: elapse ! elapsed time returned by system counter
#if (defined UNICOSMP)
integer(kind=8) :: irtc
#endif
!----- i/o formats -----
character(len=*),parameter :: F00 = "('(shr_timer_stop) ',a,i5)"
!-------------------------------------------------------------------------------
! This routine stops a given timer, checks for cycle wrapping, computes the
! elapsed time, and accumulates the elapsed time in the dt(n) array
!-------------------------------------------------------------------------------
if ( n>0 .and. n<=max_timers) then
if ( status(n) == stat_started) then
#if (defined UNICOSMP)
cycles2(n) = irtc()
#else
call system_clock(count=cycles2(n))
#endif
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
if (s_loglev > 0) write(s_logunit,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)
if (s_loglev > 0) write(s_logunit,F01) n,calls(n),dt(n),trim(name(n))
call shr_timer_start(n)
else
if (s_loglev > 0) write(s_logunit,F01) n,calls(n),dt(n),trim(name(n))
endif
else
if (s_loglev > 0) write(s_logunit,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
!-------------------------------------------------------------------------------
if (s_loglev > 0) write(s_logunit,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_SHR_KIND_R8
calls(n) = 0
else
if (s_loglev > 0) write(s_logunit,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_SHR_KIND_R8
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
if (s_loglev > 0) write(s_logunit,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_SHR_KIND_R8
cycles1(n) = 0
cycles2(n) = 0
else
if (s_loglev > 0) write(s_logunit,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
!===============================================================================