TABLE OF CONTENTS


ABINIT/m_time [ Modules ]

[ Top ] [ Modules ]

NAME

 m_time

FUNCTION

 This module contains accumulators for the timer.
 and functions to get cpu and wall time.

COPYRIGHT

 Copyright (C) 2009-2022 ABINIT group (MG, XG, MT, TD)
 This file is distributed under the terms of the
 GNU General Public License, see ~abinit/COPYING
 or http://www.gnu.org/copyleft/gpl.txt .


m_time/abi_cpu_time [ Functions ]

[ Top ] [ m_time ] [ Functions ]

NAME

  abi_cpu_time

FUNCTION

  Timing routine. Returns cpu time in seconds since some arbitrary start.

INPUTS

  (no inputs)

OUTPUT

  cpu_time= cpu time in seconds

NOTES

  For CPU time, contains machine-dependent code (choice will be selected by c preprocessor).
  Note that all supported machines are listed explicitly below; there
  is no "else" which covers "other".  The C preprocessor will place
  a spurious line of code (see below) into the fortran source unless
  preprocessed with -Dflag where flag refers to one of the supported machines.

  WARNING: the following list is no more accurate (YP 20060530)

  Presently supported flags: "ibm", "hp", "P6", "dec_alpha", "sgi", "vpp", "sun", "mac", "nec", "sr8k"
  Previously supported flags:  "ultrix". Might still work !

  Calls machine-dependent "mclock" for "ibm" .
  Calls ANSI C subroutine "cclock" for "hp" and "sgi".
  Calls machine-dependent "etime" for "P6", "mac", "dec_alpha", "sun", "nec" .
  Calls machine-dependent "clock" for "vpp"
  Calls machine-dependent "xclock" for "sr8k"

SOURCE

303 function abi_cpu_time() result(cpu)
304 
305 !Arguments ------------------------------------
306  real(dp) :: cpu
307 
308 !Local variables-------------------------------
309 #ifdef HAVE_FC_CPUTIME
310  real :: cpu_sp
311 #elif defined FC_IBM
312  integer :: mclock
313 #elif defined HAVE_OS_MACOSX
314  real :: tmp(2) !real array only needed by etime
315  real(dp) :: etime
316 #else
317  integer :: count_now,count_max,count_rate
318 #endif
319 
320 ! *************************************************************************
321 
322 !Machine-dependent timers
323 #ifdef HAVE_CCLOCK
324  call clib_cclock(cpu)
325 
326 #elif defined HAVE_FC_CPUTIME
327 !This is the F95 standard subroutine.
328  call cpu_time(cpu_sp)
329  cpu = cpu_sp
330 
331 #elif defined FC_IBM
332  cpu = mclock()*0.01d0
333 
334 #elif defined HAVE_OS_MACOSX
335  cpu = clib_etime(tmp)
336 
337 #else
338 !This is the Fortran90 standard subroutine, might not always be sufficiently accurate
339  call system_clock(count_now,count_rate,count_max)
340  cpu=dble(count_now)/dble(count_rate)
341 #endif
342 
343 end function abi_cpu_time

m_time/abi_wtime [ Functions ]

[ Top ] [ m_time ] [ Functions ]

NAME

  abi_wtime

FUNCTION

  Return wall clock time in seconds since some arbitrary start.
  Call the F90 intrinsic date_and_time .

INPUTS

  (no inputs)

OUTPUT

  wall= wall clock time in seconds

SOURCE

364 function abi_wtime() result(wall)
365 
366 !Arguments ------------------------------------
367 !scalars
368  real(dp) :: wall
369 
370 !Local variables-------------------------------
371 !scalars
372 #ifndef HAVE_MPI
373  integer,parameter :: nday(24)=(/31,28,31,30,31,30,31,31,30,31,30,31,&
374 &                                31,28,31,30,31,30,31,31,30,31,30,31/)
375  integer,save :: month_init,month_now,start=1,year_init
376  integer :: months
377  character(len=8)   :: date
378  character(len=10)  :: time
379  character(len=5)   :: zone
380  character(len=500) :: msg
381 !arrays
382  integer :: values(8)
383 #endif
384 
385 ! *************************************************************************
386 
387 #ifndef HAVE_MPI
388 
389 !The following section of code is standard F90, but it is useful only if the intrinsics
390 !date_and_time is accurate at the 0.01 sec level, which is not the case for a P6 with the pghpf compiler ...
391 !Year and month initialisation
392  if(start==1)then
393    start=0
394    call date_and_time(date,time,zone,values)
395    year_init=values(1)
396    month_init=values(2)
397  end if
398 
399 !Uses intrinsic F90 subroutine Date_and_time for
400 !wall clock (not correct when a change of year happen)
401  call date_and_time(date,time,zone,values)
402 
403 !Compute first the number of seconds from the beginning of the month
404  wall=(values(3)*24.0d0+values(5))*3600.0d0+values(6)*60.0d0+values(7)+values(8)*0.001d0
405 
406 !If the month has changed, compute the number of seconds
407 !to be added. This fails if the program ran one year !!
408  month_now=values(2)
409  if(month_now/=month_init)then
410    if(year_init+1==values(1))then
411      month_now=month_now+12
412    end if
413    if(month_now<=month_init)then
414      msg = 'Problem with month and year numbers.'
415      ABI_BUG(msg)
416    end if
417    do months=month_init,month_now-1
418      wall=wall+86400.0d0*nday(months)
419    end do
420  end if
421 
422 !Now take into account bissextile years (I think 2000 is bissextile, but I am not sure ...)
423  if(mod(year_init,4)==0 .and. month_init<=2 .and. month_now>2)   wall=wall+3600.0d0
424  if(mod(values(1),4)==0 .and. month_init<=14 .and. month_now>14) wall=wall+3600.0d0
425 
426 #else
427 !Use the timer provided by MPI1.
428  wall = MPI_WTIME()
429 #endif
430 
431 end function abi_wtime

m_time/asctime [ Functions ]

[ Top ] [ m_time ] [ Functions ]

NAME

  asctime

FUNCTION

   Build a 24-character string of the following form: 'Sun Jun 20 23:21:05 1993'.

SOURCE

105 function asctime()
106 
107 !Arguments ------------------------------------
108  character(len=24) :: asctime
109 
110 !Local variables-------------------------------
111  integer :: day,dd,ja,jy,jm,jdn,mm,year
112  integer :: values(8)
113  character(len=5) :: strzone
114  character(len=8) :: strdat
115  character(len=10) :: strtime
116  character(len=3),parameter :: day_names(7)=(/'Mon','Tue','Wed','Thu','Fri','Sat','Sun'/)
117  character(len=3),parameter :: month_names(12)=(/'Jan','Feb','Mar','Apr','May','Jun',&
118 &                                                'Jul','Aug','Sep','Oct','Nov','Dec'/)
119 
120 ! *************************************************************************
121 
122 !Get year, month and day
123  call date_and_time(strdat,strtime,strzone,values)
124 
125  year=values(1)
126  mm=values(2)
127  dd=values(3)
128 
129 !Get day of the week
130  if (mm > 2) then
131    jy=year
132    jm=mm+1
133  else
134    jy=year-1
135    jm=mm+13
136  end if
137 
138  jdn=int(365.25d0*jy)+int(30.6001d0*jm)+dd+1720995
139  ja=int(0.01d0*jy)
140  jdn=jdn+2-ja+int(quarter*ja)
141  day=mod(jdn,7)+1
142 
143  ! Build a 24-character string of the following form: 'Sun Jun 20 23:21:05 1993'.
144  write(asctime, '(a,1x,a,1x,i0.2,1x,2(i0.2,a),i0.2,1x,i4)')&
145    day_names(day),month_names(mm),dd,values(5),":",values(6),":",values(7),year
146 
147 end function asctime

m_time/cwtime [ Functions ]

[ Top ] [ m_time ] [ Functions ]

NAME

  cwtime

FUNCTION

  Timing routine. Returns cpu and wall clock time in seconds.

INPUTS

  start_or_stop=
    "start" to start the timers
    "stop" to stop the timers and return the final cpu_time and wall_time
  [msg]: Optional message printed to std_out
  [comm]: MPI communicator. If values averaged inside comm are wanted. Only for "stop"

OUTPUT

  cpu= cpu time in seconds
  wall= wall clock time in seconds
  gflops = Gigaflops

NOTES

  Example:
  ! Init cpu and wall
  call cwtime(cpu,wall,gflops,"start")

  do_stuff()

  ! stop the counters, return cpu- and wall-time spent in do_stuff()
  call cwtime(cpu,wall,gflops,"stop")

SOURCE

467 subroutine cwtime(cpu, wall, gflops, start_or_stop, msg, comm)
468 
469 !Arguments ------------------------------------
470 !scalars
471  real(dp),intent(inout) :: cpu,wall
472  real(dp),intent(out) :: gflops
473  character(len=*),intent(in) :: start_or_stop
474  character(len=*),intent(in),optional :: msg
475  integer,intent(in),optional :: comm
476 
477 !Local variables-------------------------------
478 #ifndef HAVE_PAPI
479  logical,parameter :: use_papi=.FALSE.
480 #else
481  logical,parameter :: use_papi=.TRUE.
482 #endif
483  integer :: ierr
484  integer(C_INT)  :: check
485  integer(C_LONG_LONG) :: flops
486  real(C_FLOAT) :: real_time,proc_time,mflops
487  real(dp) :: vals(3)
488 
489 ! *************************************************************************
490 
491  if (present(msg)) call wrtout(std_out, msg)
492 
493  select case (start_or_stop)
494  case ("start")
495    if (use_papi) then
496      call xpapi_flops(real_time,proc_time,flops,mflops,check)
497      cpu = proc_time; wall = real_time; gflops = mflops / 1000
498    else
499      cpu = abi_cpu_time(); wall = abi_wtime(); gflops = -one
500    end if
501 
502  case ("stop")
503    if (use_papi) then
504      call xpapi_flops(real_time,proc_time,flops,mflops,check)
505      cpu = proc_time - cpu; wall = real_time - wall; gflops = mflops / 1000
506    else
507      cpu = abi_cpu_time() - cpu; wall = abi_wtime() - wall; gflops = -one
508    end if
509    if (present(comm)) then
510      vals = [cpu, wall, gflops]
511      call xmpi_sum(vals, comm, ierr)
512      vals = vals / xmpi_comm_size(comm)
513      cpu = vals(1); wall = vals(2); gflops = vals(3)
514    end if
515 
516  case default
517    ABI_ERROR("Wrong option for start_or_stop: "//trim(start_or_stop))
518  end select
519 
520 end subroutine cwtime

m_time/cwtime_report [ Functions ]

[ Top ] [ m_time ] [ Functions ]

NAME

  cwtime_report

FUNCTION

 Stop timers, write message, reinit counters.

 INPUT
  [pre_str], [end_str]: String to print before and after the timing section
  [comm]: MPI communicator. If values averaged inside comm is wanted. Only for "stop"

SIDE EFFECTS

  cpu= cpu time in seconds
  wall= wall clock time in seconds
  gflops = Gigaflops

OUTPUT

  [out_wall]= Output wall-time.

SOURCE

546 subroutine cwtime_report(tag, cpu, wall, gflops, pre_str, end_str, out_wall, comm)
547 
548 !Arguments ------------------------------------
549 !scalars
550  real(dp),intent(inout) :: cpu,wall
551  real(dp),intent(out) :: gflops
552  integer,intent(in),optional :: comm
553  character(len=*),intent(in) :: tag
554  character(len=*),optional,intent(in) :: pre_str, end_str
555  real(dp),optional,intent(out) :: out_wall
556 
557 !Local variables-------------------------------
558 !scalars
559  character(len=500) :: avg_type
560 
561 ! *************************************************************************
562 
563  if (present(comm)) then
564    call cwtime(cpu, wall, gflops, "stop", comm=comm)
565    avg_type = "(MPI average) <<< TIME"
566  else
567    call cwtime(cpu, wall, gflops, "stop")
568    avg_type = "<<< TIME"
569  end if
570  if (present(pre_str)) call wrtout(std_out, pre_str)
571 
572  call wrtout(std_out, sjoin(tag, ", wall:", sec2str(wall), ", cpu:", sec2str(cpu), avg_type), do_flush=.True.)
573 
574  !if (present(end_str)) call wrtout(std_out, " ...")
575  if (present(end_str)) call wrtout(std_out, end_str)
576  if (present(out_wall)) out_wall = wall
577 
578  call cwtime(cpu, wall, gflops, "start")
579 
580  ! Activate this line to get mallinfo section for each checkpoint
581  !call clib_print_mallinfo(std_out)
582 
583 end subroutine cwtime_report

m_time/sec2str [ Functions ]

[ Top ] [ m_time ] [ Functions ]

NAME

  sec2str

FUNCTION

  Convert time data in seconds to string

INPUTS

   time_s=Time in seconds

OUTPUT

   string with time displayed in the form: [days-][hours:][minutes:]seconds

SOURCE

167 pure function sec2str(time_s) result(str)
168 
169 !Arguments ------------------------------------
170 !scalars
171  real(dp),intent(in) :: time_s
172  character(len=500) :: str
173 
174 !Local variables-------------------------------
175  integer :: days,hours,minutes,seconds
176 
177 ! *************************************************************************
178 
179  days    = time_s / 86400
180  hours   = MOD(time_s,86400._dp) / 3600
181  minutes = MOD(time_s,3600._dp) / 60
182  seconds = MOD(time_s,60._dp)
183 
184  if (days > 0) then
185    write(str,'(i0,3(a,i0.2),a)')days,"-",hours,":",minutes,":",seconds, " [days]"
186  else if (hours > 0) then
187    write(str,'(i0.2,2(a,i0.2),a)')hours,":",minutes,":",seconds, " [hours]"
188  else if (minutes > 0) then
189    write(str,'(i0.2,a,i0.2,a)')minutes,":",seconds, " [minutes]"
190  else
191    write(str,'(f5.2,a)')time_s," [s]"
192  end if
193 
194 end function sec2str

m_time/str2sec [ Functions ]

[ Top ] [ m_time ] [ Functions ]

NAME

  str2sec

FUNCTION

  Convert a string to time data in seconds. Return negative value if not valid string
  Accepts a string in one the following (SLURM) forms:

     # "days-hours",
     # "days-hours:minutes",
     # "days-hours:minutes:seconds".
     # "minutes",
     # "minutes:seconds",
     # "hours:minutes:seconds",

SOURCE

216 real(dp) pure function str2sec(str) result(time)
217 
218 !Arguments ------------------------------------
219 !scalars
220  character(len=*),intent(in) :: str
221 
222 !Local variables-------------------------------
223  integer :: days,hours,minutes,seconds,dash,i,j
224 
225 ! *************************************************************************
226 
227  days = 0; hours = 0; minutes = 0; seconds = 0
228  dash = index(str, "-")
229  if (dash /= 0) read(str(:dash-1),*,err=1) days
230 
231  select case (char_count(str, ":"))
232  case (0)
233    if (dash /= 0) then
234      read(str(dash+1:),*,err=1)hours
235    else
236      read(str(dash+1:),*,err=1)minutes
237    end if
238 
239  case (1)
240    i = index(str, ":")
241    if (dash /= 0) then
242      read(str(dash+1:i-1),*,err=1)hours
243      read(str(i+1:),*,err=1)minutes
244    else
245      read(str(:i-1),*,err=1)minutes
246      read(str(i+1:),*,err=1)seconds
247    end if
248 
249  case(2)
250    i = index(str, ":")
251    read(str(dash+1:i-1),*,err=1)hours
252    j = index(str(i+1:), ":") + i
253    read(str(i+1:j-1),*,err=1)minutes
254    read(str(j+1:),*,err=1)seconds
255 
256  case default
257    time = -one; return
258  end select
259 
260  time = 24 * 3600 * days + hours * 3600 + minutes * 60 + seconds
261  return
262 
263 1 time = -one
264 
265 end function str2sec

m_time/timab [ Functions ]

[ Top ] [ m_time ] [ Functions ]

NAME

  timab

FUNCTION

  Timing subroutine. Calls machine-dependent "timein" which returns elapsed cpu and wall clock times in sec.
  Depending on value of "option" routine will:

  (0) Zero all accumulators
  (1 or -1) Start with new incremental time slice for accumulator n using explicit call to timein (or PAPI)
  (2 or -2) Stop time slice; add time to accumulator n also increase by one the counter for this accumulator
  (3) DEPRECATED Start with new incremental time slice for accumulator n
        using stored values for cpu, wall, and PAPI infos ( ! do not use for stop )
        Typically used immediately after a call to timab for another counter with option=2. This saves one call to timein.
  (4) Report time slice for accumlator n (not full time accumlated)
  (5) Option to suppress timing (nn should be 0) or reenable it (nn /=0)
  For negative options : same action than positive values, except for -1 and -2, 
    use stored values for cpu, wall, and PAPI infos ( ! do not use for stop ), instead of calling "timein".
    Typically used immediately after a call to timab for another counter with option=2 or 1. This saves one call to timein.


  If, on first entry, subroutine is not being initialized, it
  will automatically initialize as well as rezero accumulator n.
  However, initialization SHOULD be done explicitly by the user
  so that it can be done near the top of his/her main routine.

INPUTS

  nn=index of accumulator (distinguish what is being timed); NOT used if option=0
  option=see comment above

OUTPUT

  on option=4:
    tottim(2,nn)=accumulated time for accumulator nn; otherwise
     tottim is a dummy variable.
    option gives the number of times that the
     accumulator has been incremented

SOURCE

767 subroutine timab(nn, option, tottim)
768 
769 #ifdef HAVE_PAPI
770 #include "f90papi.h"
771 #endif
772 
773 !Arguments ------------------------------------
774 !scalars
775  integer,intent(in) :: nn,option
776 !arrays
777  real(dp),intent(out) :: tottim(2)
778 
779 !Local variables-------------------------------
780 !scalars
781  real(dp),save :: cpu,wall
782  character(len=500) :: msg
783 #ifdef HAVE_PAPI
784  integer(C_INT) :: check
785  integer(C_LONG_LONG),save :: flops1
786  real(C_FLOAT),save :: real_time,proc_time
787  real(C_FLOAT) :: mflops1
788  character(len=PAPI_MAX_STR_LEN) :: papi_errstr
789 #endif
790 ! *************************************************************************
791 
792  if (option==5) timopt=mod(nn,10)
793 
794  ! If timopt was set to zero by a call with option=5, suppress
795  ! all action of this routine (might as well return at this point !)
796  if(timopt/=0 .and. option/=5)then
797    ! Check that nn lies in sensible bounds
798    if (nn<1.or.nn>TIMER_SIZE) then
799      write(msg,'(2(a,i0))')'  TIMER_SIZE = ',TIMER_SIZE,' but input nn = ',nn
800      ABI_BUG(msg)
801    end if
802 
803 #ifdef HAVE_PAPI
804    ! for all active options for time if papi analysis has been selected.
805    if (option/=3.and.time_get_papiopt()==1) then
806      call PAPIf_flops(real_time, proc_time, flops1, mflops1, check)
807      if (check /= PAPI_OK) then
808        call papif_perror(check,papi_errstr,check)
809        write(std_out,*) 'Problem to initialize papi high level inteface'
810        write(std_out,*) 'Error code', papi_errstr
811      end if
812      if (flops1 < 0) then
813        ABI_WARNING("Number of floating point instruction Overflow")
814        papi_flops(:)=-1
815      end if
816    end if
817 #endif
818 
819    select case (abs(option))
820    case (0)
821      ! Zero out all accumulators of time and init timers
822      acctim(:,:)      = 0.0d0
823      tzero(:,:)       = 0.0d0
824      ncount(:)        = 0
825      papi_flops(:)    = 0
826      papi_acctim(:,:) = 0.
827      papi_accflops(:) = 0.
828      papi_tzero(:,:)  = 0.
829 
830    case (1)
831      ! Initialize timab for nn
832      if(option>0) call timein(cpu,wall)
833      tzero(1,nn)=cpu
834      tzero(2,nn)=wall
835 #ifdef HAVE_PAPI
836      papi_flops(nn)   = flops1       ! Initialize megaflops for nn
837      papi_tzero(1,nn) = proc_time
838      papi_tzero(2,nn) = real_time
839 #endif
840 
841    case (2)
842      ! Accumulate time for nn (also keep the values of cpu, wall, proc_time, real_time, flops1)
843      if(option>0)call timein(cpu,wall)
844      acctim(1,nn)=acctim(1,nn)+cpu -tzero(1,nn)
845      acctim(2,nn)=acctim(2,nn)+wall-tzero(2,nn)
846      ncount(nn)=ncount(nn)+1
847 #ifdef HAVE_PAPI
848      ! accumulate time and flops for nn Difference between 2 calls to Papif_flops
849      papi_acctim(1,nn)=papi_acctim(1,nn)+ proc_time - papi_tzero(1,nn)
850      papi_acctim(2,nn)=papi_acctim(2,nn)+ real_time - papi_tzero(2,nn)
851      papi_accflops(nn)=papi_accflops(nn)+ flops1- papi_flops(nn)
852 #endif
853 
854 !Should be suppressed, equivalent to -1
855    case (3)
856      ! Use previously obtained values to initialize timab for nn
857      ! Typically used immediately after a call to timab for another counter with option=2 . This saves one call to timein.
858      tzero(1,nn)=cpu
859      tzero(2,nn)=wall
860 #ifdef HAVE_PAPI
861      papi_flops(nn)=flops1
862      papi_tzero(1,nn) = proc_time
863      papi_tzero(2,nn) = real_time
864 #endif
865 
866    case (4)
867      ! Return elapsed time for nn (do not accumulate)
868      call timein(cpu,wall)
869      tottim(1)=cpu-tzero(1,nn)
870      tottim(2)=wall-tzero(2,nn)
871 #ifdef HAVE_PAPI
872      ! return elapsed floating point operationfor nn (do not accumulate)
873      papi_tottim(1,nn)= proc_time - papi_tzero(1,nn)
874      papi_tottim(2,nn)= real_time - papi_tzero(2,nn)
875      papi_totflops(nn)= flops1 - papi_flops(nn)
876 #endif
877 
878    case default
879      write(msg,'(a,i10,a)')'  Input option not valid, =',option,'.'
880      ABI_BUG(msg)
881    end select
882  end if
883 
884 end subroutine timab

m_time/time_accu [ Functions ]

[ Top ] [ m_time ] [ Functions ]

NAME

  time_accu

FUNCTION

  Return the number of times the counter has been called
  and corresponding data for given index

INPUTS

  nn=index of accumulator (distinguish what is being timed);

OUTPUT

  tottim(2)=accumulated time for accumulator nn
  totftimes(2)=accumulated time for accumulator nn evaluated by papi
  totffops =accumulated number of flops for accumulator nn evaluated by papi
  return_ncount gives the number of times that the accumulator has been incremented

SOURCE

644 subroutine time_accu(nn,return_ncount,tottim,totflops,totftimes)
645 
646 !Arguments ------------------------------------
647 !scalars
648  integer,intent(in) :: nn
649  integer,intent(out) :: return_ncount
650  real(dp),intent(out) :: totflops
651 !arrays
652  real(dp),intent(out) :: totftimes(2),tottim(2)
653 
654 !Local variables-------------------------------
655 !scalars
656  character(len=500) :: msg
657 
658 ! *************************************************************************
659 
660 !Check that nn lies in sensible bounds
661  if (nn<0.or.nn>TIMER_SIZE) then
662    write(msg,'(a,i6,a,i8,a)')' dim TIMER_SIZE=',TIMER_SIZE,' but input nn=',nn,'.'
663    ABI_BUG(msg)
664  end if
665 
666 !return accumulated time for nn
667  tottim(1)=acctim(1,nn)
668  tottim(2)=acctim(2,nn)
669 
670 !return accumulated number flops for nn
671  totflops = papi_accflops(nn)
672 
673 !return accumulated time for nn evaluated by papi
674  totftimes(1) = papi_acctim(1,nn)
675  totftimes(2) = papi_acctim(2,nn)
676  return_ncount=ncount(nn)
677 
678 end subroutine time_accu

m_time/time_get_papiopt [ Functions ]

[ Top ] [ m_time ] [ Functions ]

NAME

  time_get_papiopt

FUNCTION

  Return the value of papiopt

SOURCE

714 function time_get_papiopt()
715 
716 !Arguments ------------------------------------
717 !scalars
718  integer :: time_get_papiopt
719 
720 ! *************************************************************************
721 
722  time_get_papiopt = papiopt
723 
724 end function time_get_papiopt

m_time/time_set_papiopt [ Functions ]

[ Top ] [ m_time ] [ Functions ]

NAME

  time_set_papiopt

FUNCTION

  Set the value of papiopt

SOURCE

690 subroutine time_set_papiopt(opt)
691 
692 !Arguments ------------------------------------
693 !scalars
694  integer,intent(in) :: opt
695 
696 ! *************************************************************************
697 
698  papiopt = opt
699 
700 end subroutine time_set_papiopt

m_time/timein [ Functions ]

[ Top ] [ m_time ] [ Functions ]

NAME

  timein

FUNCTION

  Timing routine. Returns cpu and wall clock time in seconds since some arbitrary start.
  For wall clock time, call the F90 intrinsic date_and_time.

INPUTS

  (no inputs)

OUTPUT

  cpu= cpu time in seconds
  wall= wall clock time in seconds

NOTES

  For CPU time, contains machine-dependent code (choice will be selected
  by C preprocessor, see abi_cpu_time).

TODO

  Should be replaced by cwtime

SOURCE

610 subroutine timein(cpu,wall)
611 
612 !Arguments ------------------------------------
613 !scalars
614  real(dp),intent(out) :: cpu,wall
615 ! *************************************************************************
616 
617  ! CPU time
618  cpu = abi_cpu_time()
619  ! Wall time
620  wall = abi_wtime()
621 
622 end subroutine timein