Fortran Wiki
timer

Timing – the simplest of measures

Perhaps the simplest performance metric is to just measure the wallclock time taken by a program. This could literally be measured using a conventional clock or stopwatch. This is difficult to automate! So typically a command like the GNU/Linux or Unix command time(1) is used.

Commands such as time(1) often provide more than wallclock times too. But lets construct a wallclock timing tool of our own using standard Fortran (not even the ISO_C_Binding interface will be called upon) that will measure the run time of a command.

Once passed a command to time on the command line, it will then run it and report the wallclock time used by the program in the form D-HH:MM:SS.SSS and echo the command.

Next we create a simple program that calls the routine(s) of interest enough times to get useful timing information and time it.

So lets say we compiled up the timer program and compiled our test program using two different sets of compiler options:

    f90 timer.f90 -o timer
    f90 little_test.f90 -O0 -o little_test0
    f90 little_test.f90 -O3 -o little_test3

Now to run the programs via our timing utility only takes a few commands:

    ./timer ./little_test0
    Wallclock: 0-00:00:25.461 :command: ./little_test0
    ./timer ./little_test3
    Wallclock: 0-00:00:10.274 :command: ./little_test3

A simple timer program in Fortran

program timer_exe
! @(#) given a command on the command line run the command and print wallclock time and echo command
use,intrinsic :: iso_fortran_env, only : int64
use, intrinsic :: iso_fortran_env, only : stderr=>ERROR_UNIT
implicit none
character(len=*),parameter   :: all='(*(g0,1x))'
integer                      :: ier
character(len=:),allocatable :: command
integer(kind=int64)          :: jtime(2)

   call get_cmd(command,ier) ! get the command including an attempt to requote quoted strings
   if(ier.eq.0)then
      jtime(1)=millijulian()
      if(command.ne.'')ier=run(command)
      jtime(2)=millijulian()
      write(*,all)'Wallclock:',millisec2days( jtime(2)-jtime(1) ),':command:',trim(adjustl(command))
   else
      write(*,all)'<ERROR>STATUS:',ier
   endif

contains

function run(command)
! @(#) M_system run(3f) call execute_command_line as a function
character(len=*),intent(in) :: command
integer                     :: exitstat
integer                     :: cmdstat
integer                     :: run
character(len=256)          :: cmdmsg

   cmdmsg=' '
   call execute_command_line(trim(command), wait=.true., exitstat=exitstat, cmdstat=cmdstat, cmdmsg=cmdmsg)
   if(cmdstat.ne.0)then
      write(stderr,*)trim(cmdmsg)
   endif
   run=cmdstat

end function run

function millisec2days(milliseconds) result(dhms)
! @(#) M_time millisec2days(3f) converts milliseconds to string showing days of form D-HH:MM:SS.SSS
integer(kind=int64),intent(in) :: milliseconds
integer(kind=int64)            :: days, hours, minutes, secsleft, left
integer(kind=int64),parameter  :: ONE_DAY=86400, ONE_HOUR=3600, ONE_MINUTE=60
character(len=:),allocatable   :: dhms
character(len=40)              :: scratch
   secsleft=milliseconds/1000
   left=mod(milliseconds,1000)
   days=secsleft/ONE_DAY                  ! get whole number of days
   secsleft=secsleft-days*ONE_DAY         ! calculate remainder
   hours=secsleft/ONE_HOUR                ! get whole number of hours
   secsleft=secsleft-hours*ONE_HOUR
   minutes=secsleft/ONE_MINUTE            ! get whole number of minutes
   secsleft=secsleft-minutes*ONE_MINUTE
   write(scratch,'(i0,"-",i2.2,":",i2.2,":",i2.2,".",i3.3)')days,hours,minutes,secsleft,left
   dhms=trim(scratch)
end function millisec2days

subroutine get_cmd(command,status)
! @(#) compose a command from all the arguments passed to the program
character(len=*),parameter               :: gen='(*(g0))'
character(len=:),allocatable,intent(out) :: command               ! string of all arguments to create
integer,intent(out)                      :: status                ! status (non-zero means error)
integer                                  :: i, j
character(len=:),allocatable             :: value,valueb          ! hold individual arguments one at a time
character(len=255)                       :: errmsg
integer                                  :: length                ! length of individual arguments
   command=""                                                     ! initialize returned output string
   errmsg=""
   status=0
   ERRORS: BLOCK
      do i=1,command_argument_count()
         !call get_command_argument(i,length=length,status=status,errmsg=errmsg)   ! get length of next argument
         call get_command_argument(i,length=length,status=status)                 ! get length of next argument
         if(status.ne.0)exit ERRORS
         value=repeat(' ',length)
         !call get_command_argument(i,value=value,status=status,errmsg=errmsg)     ! get next argument
         call get_command_argument(i,value=value,status=status)                   ! get next argument
         if(status /= 0)exit ERRORS
         if(length.gt.0)then ! SIMPLISTIC GUESS AT RE-QUOTING STRING
            ! assuming an operating system shell that strips the quotes from quoted strings on the command line.
            ! if argument contains a space and does not contain a double-quote
            ! assume this argument was quoted but that the shell stripped the quotes and add double quotes.
            if(index(value,' ').ne.0.and.index(value,'"').eq.0)then
               value='"'//value//'"'
            elseif(index(value,'"').ne.0)then
               ! assume you double doublequotes to escape them and short enough that reallocating a lot not an issue
               valueb=''
               do j=1,len(value)
                  if(value(j:j)=='"') valueb=valueb//'"'
                  valueb=valueb//value(j:j)
               enddo
               value='"'//valueb//'"'
            endif
            command=command//' '//value ! append strings together
         else
            command=command//'""'
         endif
      enddo
      return
   endblock ERRORS
   write(stderr,gen)'*get_cmd* error obtaining argument ',i,'errmsg=',trim(errmsg)
   stop
end subroutine get_cmd

function millijulian()
! @(#)millijulian(3f): Converts proleptic Gregorian DAT date-time array to Julian Date in milliseconds in Zulu timezone
integer                    ::  dat(8)
integer(kind=int64)        ::  a , y , m , jdn, utc, millijulian
call date_and_time(values=dat)
associate &
&(year=>dat(1),month=>dat(2),day=>dat(3),hour=>dat(5),minute=>dat(6),second=>dat(7),milli=>dat(8))
   !  You must first compute the number of years (Y) and months (M) since March 1st -4800 (March 1, 4801 BC)
      a = (14_int64-month)/12_int64 ! A will be 1 for January or February, and 0 for other months, with integer truncation
      y = year + 4800_int64 - a
      m = month + 12_int64*a - 3_int64 ! M will be 0 for March and 11 for February
   !  All years in the BC era must be converted to astronomical years, so that 1BC is year 0, 2 BC is year "-1", etc.
   !  Convert to a negative number, then increment towards zero
      ! intentionally computing with integer truncation
      jdn = day + (153_int64*m+2_int64)/5_int64 + 365_int64*y + y/4_int64 - y/100_int64 + y/400_int64 - 32045_int64
   !  Finding the Julian time in milliseconds given the JDN (Julian day number) and time of day
      millijulian = (jdn*86400_int64 + hour*3600_int64 + minute*60_int64 + second)*1000_int64 + milli
end associate
   utc=dat(4)*60*1000              ! Time difference with UTC in minutes converted to milliseconds
   millijulian = millijulian + utc ! set all values to Zulu time
end function millijulian

end program timer_exe

An uninstrumented test program for timing

program little_test
use,intrinsic :: iso_fortran_env, only : int8
implicit none
character(len=*),parameter             :: original = "abcdxyz ZXYDCBA _!@"
integer,parameter                      :: how_many_times = 100000000
character(len=:),volatile,allocatable  :: t
integer                                :: i
   do i=1,how_many_times
     t=upper(original)
     t=lower(original)
   enddo
contains
function upper(str) result(translated)
integer(kind=int8), parameter :: ascii_diff = abs(iachar('A',kind=int8) - iachar('a',kind=int8))
character(*), intent(in) :: str
integer :: i
character(len=len(str)) :: translated

   translated=str
   do i = 1, len(str)
     select case(str(i:i))
       case("a":"z")
         translated(i:i) = achar(iachar(str(i:i))-ascii_diff)
     end select
   enddo 
end function upper
   
function lower(str) result(translated)
integer(kind=int8), parameter :: ascii_diff = abs(iachar('A',kind=int8) - iachar('a',kind=int8))
character(*), intent(in) :: str
integer :: i
character(len=len(str)) :: translated

   translated=str
   do i = 1, len(str)
     select case(str(i:i))
       case("A":"Z")
         translated(i:i) = achar(iachar(str(i:i))+ascii_diff)
     end select
   enddo  
end function lower

end program little_test

Footnotes

Note that in many HPC environments programs are often run via a job scheduler like Slurm, LSF, PBS, Torque, … . In these environments there are usually account records of each job that provide resource usage statistics.