54 character (len=ic_med) :: app_name
57 character (len=ic_med) :: file_name
58 character (len=ic_med) :: file_hold
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
74 DOUBLE PRECISION,
POINTER :: sum_ctime(:)
75 DOUBLE PRECISION,
POINTER :: sum_wtime(:)
76 INTEGER,
POINTER :: timer_count(:)
80 integer :: output_unit = 901
81 logical,
save :: single_timer_header
82 character(len=1),
parameter :: t_stopped =
' '
83 character(len=1),
parameter :: t_running =
'*'
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)'
103 file_hold = trim(file)
106 ALLOCATE(timer(mtimer))
107 ALLOCATE(sum_ctime(mtimer))
108 ALLOCATE(sum_wtime(mtimer))
109 ALLOCATE(timer_count(mtimer))
114 timer(n)%start_wtime = 0
115 timer(n)%end_wtime = 0
116 timer(n)%start_ctime = 0
117 timer(n)%end_ctime = 0
118 timer(n)%runflag = t_stopped
125 single_timer_header = .false.
137 character(len=*),
intent (in) :: timer_label
138 logical,
intent (in),
optional :: barrier
143 character(len=*),
parameter :: subname =
'(oasis_timer_start)'
145 IF (timer_debug >=1)
THEN
147 if (timer_id < 0)
then
150 timer(timer_id)%label = trim(timer_label)
151 IF (ntimer+1 > mtimer)
THEN
152 WRITE(nulprt,*) subname,estr,
'Timer number exceeded'
153 WRITE(nulprt,*) subname,estr,
'Increase nt oasis_timer_init interface'
158 if (
present(barrier))
then
159 if (barrier .and. mpi_comm_local /= mpi_comm_null)
then
160 call mpi_barrier(mpi_comm_local, ierr)
164 timer(timer_id)%start_wtime = mpi_wtime()
165 call cpu_time(cpu_time_arg)
166 timer(timer_id)%start_ctime = cpu_time_arg
167 timer_count(timer_id) = timer_count(timer_id) + 1
168 timer(timer_id)%runflag = t_running
179 character(len=*),
intent (in) :: timer_label
183 character(len=*),
parameter :: subname =
'(oasis_timer_stop)'
185 IF (timer_debug >=1)
THEN
187 if (timer_id < 0)
then
188 WRITE(nulprt,*) subname,
' model :',compid,
' proc :',mpi_rank_local
189 WRITE(nulprt,*) subname,wstr,
'timer_label does not exist ',&
195 if (timer(timer_id)%runflag == t_stopped)
then
196 WRITE(nulprt,*) subname,
' model :',compid,
' proc :',mpi_rank_local
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
206 sum_wtime(timer_id) = sum_wtime(timer_id) + &
207 timer(timer_id)%end_wtime - &
208 timer(timer_id)%start_wtime
209 sum_ctime(timer_id) = sum_ctime(timer_id) + &
210 timer(timer_id)%end_ctime - &
211 timer(timer_id)%start_ctime
212 timer(timer_id)%runflag = t_stopped
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)'
254 IF (timer_debug < 1)
then
258 IF ((timer_debug == 1) .AND. (mpi_rank_local == 0)) timer_debug=2
260 IF (timer_debug >= 2)
THEN
263 WRITE(file_name,
'(a,i4.4)') trim(file_hold)//
'_',mpi_rank_local
265 OPEN(output_unit, file=trim(file_name), form=
"FORMATTED", &
267 WRITE(output_unit,*)
''
273 if (
present(timer_label))
then
276 if (timer_id < 1)
then
277 WRITE(nulprt,*) subname,
' model :',compid,&
278 ' proc :',mpi_rank_local
279 WRITE(nulprt,*) subname,wstr,
'invalid timer_label',&
289 if (timer_debug >= 2 .and. onetimer)
then
291 OPEN(output_unit, file=trim(file_name), form=
"FORMATTED", &
292 status=
"UNKNOWN", position=
"APPEND")
293 IF (.NOT.single_timer_header)
THEN
294 WRITE(output_unit,
'(32x,2(2x,a,5x,a,6x,a,4x))') &
295 ' wtime ',
'on pe',
'count',
' ctime ',
'on pe',
'count'
296 single_timer_header = .true.
299 WRITE(output_unit,
'(1x,i4,2x,a24,a1,1x,2(f10.4,i8,i12,4x))') &
300 n, timer(n)%label, timer(n)%runflag, &
301 sum_wtime(n), mpi_rank_local, timer_count(n), &
302 sum_ctime(n), mpi_rank_local, timer_count(n)
312 IF (timer_debug >= 2)
THEN
313 OPEN(output_unit, file=trim(file_name), form=
"FORMATTED", &
314 status=
"UNKNOWN", position=
"APPEND")
316 WRITE(output_unit,*)
''
317 WRITE(output_unit,*)
' =================================='
318 WRITE(output_unit,*)
' ', trim(app_name)
319 WRITE(output_unit,*)
' Local processor times '
320 WRITE(output_unit,*)
' =================================='
321 WRITE(output_unit,*)
''
324 IF (.NOT.single_timer_header)
THEN
325 WRITE(output_unit,
'(32x,2(2x,a,5x,a,6x,a,4x))') &
326 ' wtime ',
'on pe',
'count',
' ctime ',
'on pe',
'count'
327 single_timer_header = .true.
329 WRITE(output_unit,
'(1x,i4,2x,a24,a1,1x,2(f10.4,i8,i12,4x))') &
330 n, timer(n)%label, timer(n)%runflag, &
331 sum_wtime(n), mpi_rank_local, timer_count(n), &
332 sum_ctime(n), mpi_rank_local, timer_count(n)
341 if (mpi_size_local > 0)
then
343 call mpi_allreduce(ntimer,ntimermax,1,mpi_integer,mpi_max,mpi_comm_local,ierror)
345 allocate (sum_ctime_global_tmp(ntimermax, mpi_size_local), &
346 sum_wtime_global_tmp(ntimermax, mpi_size_local), stat=ierror)
347 IF ( ierror /= 0 )
WRITE(nulprt,*) subname,
' model :',compid,
' proc :',&
348 mpi_rank_local,
':',wstr,
'allocate error sum_global_tmp'
349 allocate (count_global_tmp(ntimermax, mpi_size_local), stat=ierror)
350 if ( ierror /= 0 )
write(nulprt,*) subname,
' model :',compid,
' proc :',&
351 mpi_rank_local,
':',wstr,
'allocate error count_global_tmp'
352 allocate (label_global_tmp(ntimermax, mpi_size_local), stat=ierror)
353 if ( ierror /= 0 )
write(nulprt,*) subname,
' model :',compid,
' proc :',&
354 mpi_rank_local,
':',wstr,
'allocate error label_global_tmp'
356 sum_ctime_global_tmp = 0.0
357 sum_wtime_global_tmp = 0.0
359 label_global_tmp =
' '
389 allocate(rarr(mpi_size_local),iarr(mpi_size_local),carr(mpi_size_local),stat=ierror)
390 if ( ierror /= 0 )
write(nulprt,*) subname,
' model :',compid,
' proc :',&
391 mpi_rank_local,
':',wstr,
'allocate error rarr'
394 cval = timer(n)%label
396 call mpi_gather(cval,len(cval),mpi_character,carr(1),len(cval),&
397 mpi_character,root,mpi_comm_local,ierror)
398 if (mpi_rank_local == root)
then
399 do m = 1,mpi_size_local
400 label_global_tmp(n,m) = trim(carr(m))
405 call mpi_gather(rval,1,mpi_double_precision,rarr(1),1,mpi_double_precision,&
406 root,mpi_comm_local,ierror)
407 if (mpi_rank_local == root)
then
408 sum_ctime_global_tmp(n,1:mpi_size_local) = rarr(1:mpi_size_local)
412 call mpi_gather(rval,1,mpi_double_precision,rarr(1),1,mpi_double_precision,&
413 root,mpi_comm_local,ierror)
414 if (mpi_rank_local == root)
then
415 sum_wtime_global_tmp(n,1:mpi_size_local) = rarr(1:mpi_size_local)
418 ival = timer_count(n)
419 call mpi_gather(ival,1,mpi_integer,iarr(1),1,mpi_integer,root,&
420 mpi_comm_local,ierror)
421 if (mpi_rank_local == root)
then
422 count_global_tmp(n,1:mpi_size_local) = iarr(1:mpi_size_local)
425 deallocate(rarr,iarr,carr,stat=ierror)
426 if ( ierror /= 0 )
write(nulprt,*) subname,
' model :',compid,
' proc :',&
427 mpi_rank_local,
':',wstr,
'deallocate error rarr'
431 allocate(carr(ntimermax*mpi_size_local),stat=ierror)
432 if ( ierror /= 0 )
write(nulprt,*) subname,
' model :',compid,
' proc :',&
433 mpi_rank_local,
':',wstr,
'allocate error carr'
436 do m = 1,mpi_size_local
438 if (trim(label_global_tmp(n,m)) ==
'')
then
442 if (trim(label_global_tmp(n,m)) == trim(carr(k))) found = .true.
446 nlabels = nlabels + 1
447 carr(nlabels) = trim(label_global_tmp(n,m))
452 allocate(label_list(nlabels),stat=ierror)
453 if ( ierror /= 0 )
write(nulprt,*) subname,
' model :',compid,
' proc :',&
454 mpi_rank_local,
':',wstr,
'allocate error label_list'
456 label_list(k) = trim(carr(k))
458 deallocate(carr,stat=ierror)
459 if ( ierror /= 0 )
write(nulprt,*) subname,
' model :',compid,
' proc :',&
460 mpi_rank_local,
':',wstr,
'deallocate error carr'
461 allocate(sum_ctime_global(nlabels,mpi_size_local),stat=ierror)
462 if ( ierror /= 0 )
write(nulprt,*) subname,
' model :',compid,
' proc :',&
463 mpi_rank_local,
':',wstr,
'allocate error sum_ctime_global'
464 allocate(sum_wtime_global(nlabels,mpi_size_local),stat=ierror)
465 if ( ierror /= 0 )
write(nulprt,*) subname,
' model :',compid,
' proc :',&
466 mpi_rank_local,
':',wstr,
'allocate error sum_wtime_global'
467 allocate(count_global(nlabels,mpi_size_local),stat=ierror)
468 if ( ierror /= 0 )
write(nulprt,*) subname,
' model :',compid,
' proc :',&
469 mpi_rank_local,
':',wstr,
'allocate error count_global'
477 do n = 1,mpi_size_local
478 if (trim(label_list(k)) == trim(label_global_tmp(m,n)))
then
479 sum_ctime_global(k,n) = sum_ctime_global_tmp(m,n)
480 sum_wtime_global(k,n) = sum_wtime_global_tmp(m,n)
481 count_global(k,n) = count_global_tmp(m,n)
487 deallocate(label_global_tmp,stat=ierror)
488 if ( ierror /= 0 )
write(nulprt,*) subname,
' model :',compid,
' proc :',&
489 mpi_rank_local,
':',wstr,
'deallocate error label_global_tmp'
490 deallocate(sum_ctime_global_tmp,stat=ierror)
491 if ( ierror /= 0 )
write(nulprt,*) subname,
' model :',compid,
' proc :',&
492 mpi_rank_local,
':',wstr,
'deallocate error sum_ctime_global_tmp'
493 deallocate(sum_wtime_global_tmp,stat=ierror)
494 if ( ierror /= 0 )
write(nulprt,*) subname,
' model :',compid,
' proc :',&
495 mpi_rank_local,
':',wstr,
'deallocate error sum_wtime_global_tmp'
496 deallocate(count_global_tmp,stat=ierror)
497 if ( ierror /= 0 )
write(nulprt,*) subname,
' model :',compid,
' proc :',&
498 mpi_rank_local,
':',wstr,
'deallocate error count_global'
505 if (timer_debug >= 2 .and. mpi_rank_local == root)
then
506 OPEN(output_unit, file=trim(file_name), form=
"FORMATTED", &
507 status=
"UNKNOWN", position=
"APPEND")
510 IF (.NOT.single_timer_header)
THEN
511 WRITE(output_unit,
'(32x,2(2x,a,5x,a,6x,a,4x))') &
512 'mintime',
'on pe',
'count',
'maxtime',
'on pe',
'count'
513 single_timer_header = .true.
517 if (trim(timer_label) == trim(label_list(k))) n = k
520 write(nulprt,*) subname,
' model :',compid,
' proc :',&
521 mpi_rank_local,
':',wstr,
'invalid timer_label',trim(timer_label)
525 mintime = sum_ctime_global(n,1)
527 maxtime = sum_ctime_global(n,1)
529 do k = 1,mpi_size_local
530 if (sum_ctime_global(n,k) < mintime)
then
531 mintime = sum_ctime_global(n,k)
534 if (sum_ctime_global(n,k) > maxtime)
then
535 maxtime = sum_ctime_global(n,k)
539 WRITE(output_unit,
'(1x,i4,2x,a24,a1,1x,2(f10.4,i8,i12,4x))') &
540 n, label_list(n), timer(n)%runflag, &
541 sum_ctime_global(n,minpe), minpe, count_global(n,minpe), &
542 sum_ctime_global(n,maxpe), maxpe, count_global(n,maxpe)
545 single_timer_header = .false.
547 WRITE(output_unit,*)
''
548 WRITE(output_unit,*)
' =================================='
549 WRITE(output_unit,*)
' ', trim(app_name)
550 WRITE(output_unit,*)
' Overall Elapsed Min/Max statistics'
551 WRITE(output_unit,*)
' =================================='
552 WRITE(output_unit,*)
''
553 WRITE(output_unit,
'(32x,2(2x,a,5x,a,6x,a,4x),a,3x)') &
554 'mintime',
'on pe',
'count',
'maxtime',
'on pe',
'count',
'meantime'
563 do k = 1,mpi_size_local
564 if (count_global(n,k) > 0)
then
565 meantime = meantime + sum_wtime_global(n,k)
567 if (sum_wtime_global(n,k) < mintime)
then
568 mintime = sum_wtime_global(n,k)
571 if (sum_wtime_global(n,k) > maxtime)
then
572 maxtime = sum_wtime_global(n,k)
578 meantime = meantime / float(mcnt)
579 WRITE(output_unit,
'(1x,i4,2x,a24,a1,1x,2(f10.4,i8,i12,4x),f10.4)') &
580 n, label_list(n), timer(n)%runflag, &
581 sum_wtime_global(n,minpe), minpe-1, count_global(n,minpe), &
582 sum_wtime_global(n,maxpe), maxpe-1, count_global(n,maxpe), &
587 IF (timer_debug >= 3)
THEN
588 WRITE(output_unit,*)
''
589 WRITE(output_unit,*)
' =================================='
590 WRITE(output_unit,*)
' ', trim(app_name)
591 WRITE(output_unit,*)
' Overall Count statistics'
592 WRITE(output_unit,*)
' =================================='
593 WRITE(output_unit,*)
''
594 DO k=1,mpi_size_local
595 WRITE(output_unit,
'(a)',advance=
"NO")
" P r o c e s s o r ----------> "
596 WRITE(output_unit,
'(3x,i8,5x)')(k-1)
598 WRITE(output_unit,
'(1x,i8,2x,a24,a1,1x,(i10))') n, label_list(n), &
599 timer(n)%runflag, (count_global(n,k))
602 WRITE(output_unit,*)
''
603 WRITE(output_unit,*)
' =================================='
604 WRITE(output_unit,*)
' ', trim(app_name)
605 WRITE(output_unit,*)
' Overall CPU time statistics'
606 WRITE(output_unit,*)
' =================================='
607 WRITE(output_unit,*)
''
608 DO k=1,mpi_size_local
609 WRITE(output_unit,
'(a)',advance=
"NO")
" P r o c e s s o r ----------> "
610 WRITE(output_unit,
'(3x,i8,5x)')(k-1)
612 WRITE(output_unit,
'(1x,i8,2x,a24,a1,1x,(f10.4))') n, label_list(n), timer(n)%runflag, &
613 (sum_ctime_global(n,k))
616 WRITE(output_unit,*)
''
617 WRITE(output_unit,*)
' ======================================'
618 WRITE(output_unit,*)
' ', trim(app_name)
619 WRITE(output_unit,*)
' Overall Elapsed time statistics'
620 WRITE(output_unit,*)
' ======================================'
621 WRITE(output_unit,*)
''
622 DO k=1,mpi_size_local
623 WRITE(output_unit,
'(a)',advance=
"NO")
" P r o c e s s o r ----------> "
624 WRITE(output_unit,
'(3x,i8,5x)')(k-1)
626 WRITE(output_unit,
'(1x,i8,2x,a24,a1,1x,(f10.4))') n, label_list(n), timer(n)%runflag, &
627 (sum_wtime_global(n,k))
630 WRITE(output_unit,*)
''
631 WRITE(output_unit,*)
' ======================================'
638 deallocate (sum_ctime_global, stat=ierror)
639 if ( ierror /= 0 )
write(nulprt,*) subname,
' model :',compid,
' proc :',&
640 mpi_rank_local,
':',wstr,
'deallocate error sum_ctime_global'
641 deallocate (sum_wtime_global, stat=ierror)
642 if ( ierror /= 0 )
write(nulprt,*) subname,
' model :',compid,
' proc :',&
643 mpi_rank_local,
':',wstr,
'deallocate error sum_wtime_global'
644 deallocate (count_global,stat=ierror)
645 if ( ierror /= 0 )
write(nulprt,*) subname,
' model :',compid,
' proc :',&
646 mpi_rank_local,
':',wstr,
'deallocate error count_global'
647 deallocate (label_list,stat=ierror)
648 if ( ierror /= 0 )
write(nulprt,*) subname,
' model :',compid,
' proc :',&
649 mpi_rank_local,
':',wstr,
'deallocate error label_list'
662 character(len=*),
intent(in) :: tname
663 integer ,
intent(out) :: tid
669 if (trim(tname) == trim(timer(n)%label)) tid = n
subroutine, public oasis_timer_start(timer_label, barrier)
Start a timer.
subroutine, public oasis_timer_stop(timer_label)
Stop a timer.
Provides a common location for several OASIS variables.
subroutine, public oasis_flush(nu)
Flushes output to file.
Performance timer methods.
subroutine, public oasis_unitget(uio)
Get a free unit number.
subroutine, public oasis_abort(id_compid, cd_routine, cd_message)
OASIS abort method, publically available to users.
subroutine, public oasis_timer_init(app, file, nt)
Initializes the timer methods, called once in an application.
subroutine oasis_timer_c2i(tname, tid)
Convert a timer name to the timer id number.
subroutine, public oasis_timer_print(timer_label)
Print timers.