63 character (len=ic_med) :: label
65 double precision :: start_wtime, end_wtime
67 double precision :: start_ctime, end_ctime
69 character(len=1) :: runflag
95 character (len=*),
intent (in) :: app
96 character (len=*),
intent (in) :: file
97 integer ,
intent (in) :: nt
100 character(len=*),
parameter :: subname =
'(oasis_timer_init)' 114 timer(n)%start_wtime = 0
115 timer(n)%end_wtime = 0
116 timer(n)%start_ctime = 0
117 timer(n)%end_ctime = 0
137 character(len=*),
intent (in) :: timer_label
138 logical,
intent (in),
optional :: barrier
143 character(len=*),
parameter :: subname =
'(oasis_timer_start)' 147 if (timer_id < 0)
then 150 timer(timer_id)%label = trim(timer_label)
152 WRITE(
nulprt,*) subname,
estr,
'Timer number exceeded' 153 WRITE(
nulprt,*) subname,
estr,
'Increase nt oasis_timer_init interface' 158 if (
present(barrier))
then 164 timer(timer_id)%start_wtime = mpi_wtime()
165 call cpu_time(cpu_time_arg)
166 timer(timer_id)%start_ctime = cpu_time_arg
179 character(len=*),
intent (in) :: timer_label
183 character(len=*),
parameter :: subname =
'(oasis_timer_stop)' 187 if (timer_id < 0)
then 189 WRITE(
nulprt,*) subname,
wstr,
'timer_label does not exist ',&
197 WRITE(
nulprt,*) subname,
wstr,
'timer_id: ',trim(timer_label),
' : not started' 202 timer(timer_id)%end_wtime = mpi_wtime()
203 call cpu_time(cpu_time_arg)
204 timer(timer_id)%end_ctime = cpu_time_arg
207 timer(timer_id)%end_wtime - &
208 timer(timer_id)%start_wtime
210 timer(timer_id)%end_ctime - &
211 timer(timer_id)%start_ctime
225 character(len=*),
optional,
intent(in) :: timer_label
228 real,
allocatable :: sum_ctime_global_tmp(:,:)
229 double precision,
allocatable :: sum_wtime_global_tmp(:,:)
230 integer,
allocatable :: count_global_tmp(:,:)
231 character(len=ic_med),
allocatable :: label_global_tmp(:,:)
232 real,
allocatable :: sum_ctime_global(:,:)
233 double precision,
allocatable :: sum_wtime_global(:,:)
234 integer,
allocatable :: count_global(:,:)
235 double precision,
allocatable :: rarr(:)
236 integer,
allocatable :: iarr(:)
237 character(len=ic_med),
allocatable :: carr(:)
238 character(len=ic_med),
allocatable :: label_list(:)
239 double precision :: rval
241 character(len=ic_med) :: cval
244 integer,
parameter :: root = 0
250 integer :: minpe,maxpe,mcnt
251 double precision :: mintime,maxtime,meantime
252 character(len=*),
parameter :: subname =
'(oasis_timer_print)' 273 if (
present(timer_label))
then 276 if (timer_id < 1)
then 279 WRITE(
nulprt,*) subname,
wstr,
'invalid timer_label',&
292 status=
"UNKNOWN", position=
"APPEND")
295 ' wtime ',
'on pe',
'count',
' ctime ',
'on pe',
'count' 299 WRITE(
output_unit,
'(1x,i4,2x,a24,a1,1x,2(f11.4,i8,i13,4x))') &
314 status=
"UNKNOWN", position=
"APPEND")
317 WRITE(
output_unit,*)
' ==================================' 320 WRITE(
output_unit,*)
' ==================================' 326 ' wtime ',
'on pe',
'count',
' ctime ',
'on pe',
'count' 329 WRITE(
output_unit,
'(1x,i4,2x,a24,a1,1x,2(f11.4,i8,i13,4x))') &
347 IF ( ierror /= 0 )
WRITE(
nulprt,*) subname,
' model :',
compid,
' proc :',&
349 allocate (count_global_tmp(ntimermax,
mpi_size_local), stat=ierror)
350 if ( ierror /= 0 )
write(
nulprt,*) subname,
' model :',
compid,
' proc :',&
352 allocate (label_global_tmp(ntimermax,
mpi_size_local), stat=ierror)
353 if ( ierror /= 0 )
write(
nulprt,*) subname,
' model :',
compid,
' proc :',&
356 sum_ctime_global_tmp = 0.0
357 sum_wtime_global_tmp = 0.0
359 label_global_tmp =
' ' 365 allocate(carr(ntimermax))
367 carr(n) =
timer(n)%label
370 call mpi_gather(carr(1), ntimermax, mpi_character, label_global_tmp(1,1), &
373 call mpi_gather(
sum_ctime(1), ntimermax, mpi_double_precision, sum_ctime_global_tmp(1,1), &
376 call mpi_gather(
sum_wtime(1), ntimermax, mpi_double_precision, sum_wtime_global_tmp(1,1), &
379 call mpi_gather(
timer_count(1), ntimermax, mpi_integer, count_global_tmp(1,1), &
406 if ( ierror /= 0 )
write(
nulprt,*) subname,
' model :',
compid,
' proc :',&
410 cval =
timer(n)%label
413 call mpi_gather(cval,len(cval),mpi_character,carr(1),len(cval),&
417 label_global_tmp(n,m) = trim(carr(m))
423 call mpi_gather(rval,1,mpi_double_precision,rarr(1),1,mpi_double_precision,&
431 call mpi_gather(rval,1,mpi_double_precision,rarr(1),1,mpi_double_precision,&
439 call mpi_gather(ival,1,mpi_integer,iarr(1),1,mpi_integer,root,&
445 deallocate(rarr,iarr,carr,stat=ierror)
446 if ( ierror /= 0 )
write(
nulprt,*) subname,
' model :',
compid,
' proc :',&
453 if ( ierror /= 0 )
write(
nulprt,*) subname,
' model :',
compid,
' proc :',&
459 if (trim(label_global_tmp(n,m)) ==
'')
then 463 if (trim(label_global_tmp(n,m)) == trim(carr(k))) found = .true.
467 nlabels = nlabels + 1
468 carr(nlabels) = trim(label_global_tmp(n,m))
473 allocate(label_list(nlabels),stat=ierror)
474 if ( ierror /= 0 )
write(
nulprt,*) subname,
' model :',
compid,
' proc :',&
477 label_list(k) = trim(carr(k))
479 deallocate(carr,stat=ierror)
480 if ( ierror /= 0 )
write(
nulprt,*) subname,
' model :',
compid,
' proc :',&
483 if ( ierror /= 0 )
write(
nulprt,*) subname,
' model :',
compid,
' proc :',&
486 if ( ierror /= 0 )
write(
nulprt,*) subname,
' model :',
compid,
' proc :',&
489 if ( ierror /= 0 )
write(
nulprt,*) subname,
' model :',
compid,
' proc :',&
499 if (trim(label_list(k)) == trim(label_global_tmp(m,n)))
then 500 sum_ctime_global(k,n) = sum_ctime_global_tmp(m,n)
501 sum_wtime_global(k,n) = sum_wtime_global_tmp(m,n)
502 count_global(k,n) = count_global_tmp(m,n)
508 deallocate(label_global_tmp,stat=ierror)
509 if ( ierror /= 0 )
write(
nulprt,*) subname,
' model :',
compid,
' proc :',&
511 deallocate(sum_ctime_global_tmp,stat=ierror)
512 if ( ierror /= 0 )
write(
nulprt,*) subname,
' model :',
compid,
' proc :',&
514 deallocate(sum_wtime_global_tmp,stat=ierror)
515 if ( ierror /= 0 )
write(
nulprt,*) subname,
' model :',
compid,
' proc :',&
517 deallocate(count_global_tmp,stat=ierror)
518 if ( ierror /= 0 )
write(
nulprt,*) subname,
' model :',
compid,
' proc :',&
528 status=
"UNKNOWN", position=
"APPEND")
533 'mintime',
'on pe',
'count',
'maxtime',
'on pe',
'count' 538 if (trim(timer_label) == trim(label_list(k))) n = k
546 mintime = sum_ctime_global(n,1)
548 maxtime = sum_ctime_global(n,1)
551 if (sum_ctime_global(n,k) < mintime)
then 552 mintime = sum_ctime_global(n,k)
555 if (sum_ctime_global(n,k) > maxtime)
then 556 maxtime = sum_ctime_global(n,k)
560 WRITE(
output_unit,
'(1x,i4,2x,a24,a1,1x,2(f11.4,i8,i13,4x))') &
561 n, label_list(n),
timer(n)%runflag, &
562 sum_ctime_global(n,minpe), minpe, count_global(n,minpe), &
563 sum_ctime_global(n,maxpe), maxpe, count_global(n,maxpe)
569 WRITE(
output_unit,*)
' ==================================' 571 WRITE(
output_unit,*)
' Overall Elapsed Min/Max statistics' 572 WRITE(
output_unit,*)
' ==================================' 574 WRITE(
output_unit,
'(32x,2(2x,a,5x,a,6x,a,4x),a,3x)') &
575 'mintime',
'on pe',
'count',
'maxtime',
'on pe',
'count',
'meantime' 585 if (count_global(n,k) > 0)
then 586 meantime = meantime + sum_wtime_global(n,k)
588 if (sum_wtime_global(n,k) < mintime)
then 589 mintime = sum_wtime_global(n,k)
592 if (sum_wtime_global(n,k) > maxtime)
then 593 maxtime = sum_wtime_global(n,k)
599 meantime = meantime / float(mcnt)
600 WRITE(
output_unit,
'(1x,i4,2x,a24,a1,1x,2(f11.4,i8,i13,4x),f11.4)') &
601 n, label_list(n),
timer(n)%runflag, &
602 sum_wtime_global(n,minpe), minpe-1, count_global(n,minpe), &
603 sum_wtime_global(n,maxpe), maxpe-1, count_global(n,maxpe), &
610 WRITE(
output_unit,*)
' ==================================' 613 WRITE(
output_unit,*)
' ==================================' 616 WRITE(
output_unit,
'(a)',advance=
"NO")
" P r o c e s s o r ----------> " 619 WRITE(
output_unit,
'(1x,i8,2x,a24,a1,1x,(i10))') n, label_list(n), &
620 timer(n)%runflag, (count_global(n,k))
624 WRITE(
output_unit,*)
' ==================================' 627 WRITE(
output_unit,*)
' ==================================' 630 WRITE(
output_unit,
'(a)',advance=
"NO")
" P r o c e s s o r ----------> " 633 WRITE(
output_unit,
'(1x,i8,2x,a24,a1,1x,(f11.4))') n, label_list(n),
timer(n)%runflag, &
634 (sum_ctime_global(n,k))
638 WRITE(
output_unit,*)
' ======================================' 640 WRITE(
output_unit,*)
' Overall Elapsed time statistics' 641 WRITE(
output_unit,*)
' ======================================' 644 WRITE(
output_unit,
'(a)',advance=
"NO")
" P r o c e s s o r ----------> " 647 WRITE(
output_unit,
'(1x,i8,2x,a24,a1,1x,(f11.4))') n, label_list(n),
timer(n)%runflag, &
648 (sum_wtime_global(n,k))
652 WRITE(
output_unit,*)
' ======================================' 659 deallocate (sum_ctime_global, stat=ierror)
660 if ( ierror /= 0 )
write(
nulprt,*) subname,
' model :',
compid,
' proc :',&
662 deallocate (sum_wtime_global, stat=ierror)
663 if ( ierror /= 0 )
write(
nulprt,*) subname,
' model :',
compid,
' proc :',&
665 deallocate (count_global,stat=ierror)
666 if ( ierror /= 0 )
write(
nulprt,*) subname,
' model :',
compid,
' proc :',&
668 deallocate (label_list,stat=ierror)
669 if ( ierror /= 0 )
write(
nulprt,*) subname,
' model :',
compid,
' proc :',&
682 character(len=*),
intent(in) :: tname
683 integer ,
intent(out) :: tid
689 if (trim(tname) == trim(
timer(n)%label)) tid = n
type(timer_details), dimension(:), pointer timer
Provides a common location for several OASIS variables.
character(len=1), parameter t_stopped
integer(kind=ip_i4_p) mpi_size_local
integer(kind=ip_intwp_p) nulprt
subroutine, public oasis_abort(id_compid, cd_routine, cd_message, file, line, rcode)
OASIS abort method, publically available to users.
integer(kind=ip_i4_p) compid
subroutine, public oasis_timer_init(app, file, nt)
Initializes the timer methods, called once in an application.
integer(kind=ip_i4_p) mpi_rank_local
character(len=ic_med) file_hold
logical, save single_timer_header
subroutine oasis_timer_c2i(tname, tid)
Convert a timer name to the timer id number.
subroutine, public oasis_timer_print(timer_label)
Print timers.
double precision, dimension(:), pointer sum_ctime
subroutine, public oasis_timer_start(timer_label, barrier)
Start a timer.
subroutine, public oasis_timer_stop(timer_label)
Stop a timer.
character(len= *), parameter, public estr
integer(kind=ip_i4_p) mpi_comm_local
subroutine, public oasis_unitget(uio)
Get a free unit number.
double precision, dimension(:), pointer sum_wtime
integer, dimension(:), pointer timer_count
character(len=1), parameter t_running
subroutine, public oasis_flush(nu)
Flushes output to file.
character(len=ic_med) file_name
character(len=ic_med) app_name
Performance timer methods.
integer(kind=ip_i4_p) timer_debug
character(len= *), parameter, public wstr