I have frequently complained about the poor precision of many timers available, such as SYSTEM_CLOCK, CPU_TIME and omp_get_wtime, even when their claimed rate, or “ticks” imply much greater accuracy.
To demonstrate, I have a (generic) timer tester which cycles through calls to the timing routine and records how ofter the reported time varies. I have used this for:
SYSTEM_CLOCK (I4 and I8),
CPU_TIME,
GetTickCount,
QueryPerformanceCounter,
rdtsc (with difficulty) and
omp_get_wtime
omp_get_wtime is interesting, as for the windows gfortran implementation I have, it achieves a precision of 0.016 seconds, while claiming a precisoin of omp_get_wtick 3.665E-07 second, similar to SYSTEM_CLOCK (I8).
This poor achieved precision of 0.016 seconds is similar to CPU_TIME, GetTickCount and SYSTEM_CLOCK (I4) using gfortran.
The test program I use is a template for other timer tests:
Program test_wtime
!
! This approach records 4 updates to the elapsed time returned from "omp_get_wtime"
real*8 timer_precision, last_seconds, next_seconds, ticks(0:4)
integer*4 k,n, nn(4)
real*8 dt
!
real*8, external :: omp_get_wtick
real*8, external :: omp_get_wtime
!
! test precision of omp_get_wtime, by recording 4 time changes
timer_precision = omp_get_wtick () ! timer_precision as reported
next_seconds = omp_get_wtime ()
ticks(0) = next_seconds
do k = 1,4
n = 0
last_seconds = next_seconds
do
n = n+1
next_seconds = omp_get_wtime () ! call to timer
if ( next_seconds /= last_seconds ) exit
end do
nn(k) = n
ticks(k) = next_seconds
end do
! report any variability of time updates
do k = 1,4
dt = (ticks(k)-ticks(k-1))
write (*,*) k, nn(k), ticks(k)-ticks(k-1), dt
end do
dt = next_seconds-last_seconds ! minimum time between ticks
! report the timer precision "dt" in comparison to the claimed precisoin "omp_get_wtick"
write ( *,11) 'omp_get_wtime rate = ', timer_precision,' second ???'
write ( *,11) 'omp_get_wtime acc = ', dt,' seconds : ', n,' cycles ####'
11 format ( 1x,a,es12.3,a,i0,a)
!
end Program test_wtime
The .bat file I use is:
set options=-O2 -march=native -fopenmp
gfortran %1.f90 %options% -o %1.exe
dir %1.* /od
echo ================================================================ >> %1.log
now >> %1.log
set g >> %1.log
set options >> %1.log
get_processor >> %1.log
audit -start >> %1.log
%1 %2 >> %1.log
audit -end >> %1.log
notepad %1.log
The outcome of the test is:
================================================================
It is now Monday, 18 April 2022 at 12:51:54.335
gcc.ver=11.1.0
gcc_dir=C:\Program Files (x86)\gcc_eq\gcc_11.1.0
gcc_path=C:\Program Files (x86)\gcc_eq\gcc_11.1.0\bin;C:\Program Files (x86)\gcc_eq\gcc_11.1.0\libexec\gcc\x86_64-w64-mingw32\11.1.0
options=-O2 -march=native -fopenmp
Intel(R) Core(TM) i5-2300 CPU @ 2.80GHz
[AUDIT Ver 1.21] Monday, 18 April 2022 at 12:51:54.444
1 52755 1.5999972820281982E-002 1.5999972820281982E-002
2 115126 1.4999985694885254E-002 1.4999985694885254E-002
3 144383 1.6000032424926758E-002 1.6000032424926758E-002
4 145260 1.5999972820281982E-002 1.5999972820281982E-002
omp_get_wtime rate = 3.665E-07 second ???
omp_get_wtime acc = 1.600E-02 seconds : 145260 cycles ####
[AUDIT Ver 1.21] elapse 0.154 seconds: Monday, 18 April 2022 at 12:51:54.600 1.015
(get_processor and audit are utilities for reporting)
I would be interested if this could be used by others and show what OS and compilers achieve.
A tick based test with better results is:
Program test_system_clock
!
! This approach records 4 updates to the elapsed time returned from "SYSTEM_CLOCK"
integer*8 clock_precision, last_tick, next_tick, ticks(0:4)
integer*4 k,n, nn(4)
real*8 dt
!
! test precision of SYSTEM_CLOCK, by recording 4 time changes
call SYSTEM_CLOCK (next_tick, clock_precision)
ticks(0) = next_tick
do k = 1,4
n = 0
last_tick = next_tick
do
n = n+1
call SYSTEM_CLOCK (next_tick)
if ( next_tick /= last_tick ) exit
end do
nn(k) = n
ticks(k) = next_tick
end do
! report any variability of time updates
do k = 1,4
dt = dble(ticks(k)-ticks(k-1)) / dble(clock_precision)
write (*,*) k, nn(k), ticks(k)-ticks(k-1), dt
end do
dt = dble(next_tick-last_tick)/dble(clock_precision) ! minimum time between ticks
! report the timer precision "dt" in comparison to the claimed precision "SYSTEM_CLOCK (rate)"
write ( *,12) 'system_clock_rate = ', clock_precision,' ticks per second'
write ( *,11) 'system_clock_tick acc = ', dt,' seconds : ', n,' cycles ####'
11 format ( 1x,a,es12.3,a,i0,a)
12 format ( 1x,a,i12,a,i0,a)
!
end Program test_system_clock