Oasis3-MCT
 All Classes Files Functions Variables Macros Pages
mod_oasis_timer.F90
Go to the documentation of this file.
1 !-----------------------------------------------------------------------
2 ! Copyright 2010, CERFACS, Toulouse, France.
3 ! Copyright 2010, DKRZ, Hamburg, Germany.
4 ! All rights reserved. Use is subject to OASIS4 license terms.
5 !-----------------------------------------------------------------------
6 !
7 ! !DESCRIPTION:
8 !
9 !> Performance timer methods
10 !
11 !> This is used to measure the time consumed in specific parts of the code.
12 !> Timers are defined by character strings that are stored in an internal datatype.
13 !
14 ! Available routines:
15 ! oasis_timer_init allocates timers
16 ! oasis_timer_start starts specific timer
17 ! oasis_timer_stop stops specific timer and sums up measured time intervals
18 ! oasis_timer_print root process prints all timers of all processes sharing
19 ! the same mpi communicator provided to oasis_timer_init
20 ! in addition it frees all memory allocated by timers
21 !
22 !
23 ! !REVISION HISTORY:
24 !
25 ! Date Programmer Description
26 ! ---------- ---------- -----------
27 ! 03.01.11 M. Hanke created (based on psmile_timer.F90 and
28 ! prismdrv_timer.F90 from SV and JL)
29 ! 20.09.11 T. Craig extended
30 ! 16.04.13 T. Craig use mpi comm from mod_oasis_data
31 !
32 !----------------------------------------------------------------------
33 !
34 ! $Id: oasis_timer.F90 2849 2011-01-05 08:14:13Z hanke $
35 ! $Author: hanke $
36 !
37 !----------------------------------------------------------------------
38 
40 
41  use mod_oasis_kinds
42  use mod_oasis_data
43  use mod_oasis_sys
44 
45  implicit none
46  private
47 
48  public oasis_timer_init
49  public oasis_timer_start
50  public oasis_timer_stop
51  public oasis_timer_print
52 
53  ! name of the application
54  character (len=ic_med) :: app_name
55 
56  ! name of the time statistics file
57  character (len=ic_med) :: file_name
58  character (len=ic_med) :: file_hold
59 
60  !> Storage for timer data
62  ! label of timer
63  character (len=ic_med) :: label
64  ! wall time values
65  double precision :: start_wtime, end_wtime
66  ! cpu time values
67  double precision :: start_ctime, end_ctime
68  ! is the timer running now
69  character(len=1) :: runflag
70  end type timer_details
71 
72  INTEGER :: mtimer
73  type(timer_details), POINTER :: timer(:)
74  DOUBLE PRECISION, POINTER :: sum_ctime(:) ! these values are not part of timer details
75  DOUBLE PRECISION, POINTER :: sum_wtime(:) ! because they are later used in an mpi call
76  INTEGER, POINTER :: timer_count(:) ! number of calls
77 
78  integer :: ntimer
79 
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 = '*'
84 
85  contains
86 
87 ! --------------------------------------------------------------------------------
88 
89 !> Initializes the timer methods, called once in an application
90 
91  subroutine oasis_timer_init (app, file, nt)
92 
93  implicit none
94 
95  character (len=*), intent (in) :: app !< name of application
96  character (len=*), intent (in) :: file !< output filename
97  integer , intent (in) :: nt !< number of timers
98 
99  integer :: ierror,n
100  character(len=*),parameter :: subname = '(oasis_timer_init)'
101 
102  app_name = trim(app)
103  file_hold = trim(file)
104 
105  mtimer = nt
106  ALLOCATE(timer(mtimer))
107  ALLOCATE(sum_ctime(mtimer))
108  ALLOCATE(sum_wtime(mtimer))
109  ALLOCATE(timer_count(mtimer))
110 
111  ntimer = 0
112  do n = 1,mtimer
113  timer(n)%label = ' '
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
119 
120  sum_wtime(n) = 0
121  sum_ctime(n) = 0
122  timer_count(n) = 0
123  enddo
124 
125  single_timer_header = .false.
126 
127  end subroutine oasis_timer_init
128 
129 ! --------------------------------------------------------------------------------
130 
131 !> Start a timer
132 
133  subroutine oasis_timer_start (timer_label, barrier)
134 
135  implicit none
136 
137  character(len=*), intent (in) :: timer_label !< timer name
138  logical, intent (in), optional :: barrier !< flag to barrier this timer
139 
140  integer :: ierr
141  integer :: timer_id
142  real :: cpu_time_arg
143  character(len=*),parameter :: subname = '(oasis_timer_start)'
144 
145  IF (timer_debug >=1) THEN
146  call oasis_timer_c2i(timer_label,timer_id)
147  if (timer_id < 0) then
148  ntimer = ntimer + 1
149  timer_id = ntimer
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'
154  CALL oasis_abort()
155  ENDIF
156  endif
157 
158  if (present(barrier)) then
159  if (barrier .and. mpi_comm_local /= mpi_comm_null) then
160  call mpi_barrier(mpi_comm_local, ierr)
161  endif
162  endif
163 
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
169  ENDIF
170 
171  end subroutine oasis_timer_start
172 
173 ! --------------------------------------------------------------------------------
174 
175 !> Stop a timer
176 
177  subroutine oasis_timer_stop (timer_label)
178 
179  character(len=*), intent (in) :: timer_label !< timer name
180 
181  real :: cpu_time_arg
182  integer :: timer_id
183  character(len=*),parameter :: subname = '(oasis_timer_stop)'
184 
185  IF (timer_debug >=1) THEN
186  call oasis_timer_c2i(timer_label,timer_id)
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 ',&
190  trim(timer_label)
191  CALL oasis_flush(nulprt)
192  RETURN
193  endif
194 
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'
198  CALL oasis_flush(nulprt)
199  RETURN
200  endif
201 
202  timer(timer_id)%end_wtime = mpi_wtime()
203  call cpu_time(cpu_time_arg)
204  timer(timer_id)%end_ctime = cpu_time_arg
205 
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
213  ENDIF
214 
215  end subroutine oasis_timer_stop
216 
217 ! --------------------------------------------------------------------------------
218 
219 !> Print timers
220 
221  subroutine oasis_timer_print(timer_label)
222 
223  implicit none
224 
225  character(len=*), optional, intent(in) :: timer_label !< if unset, print all timers
226 
227  integer :: timer_id
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
240  integer :: ival
241  character(len=ic_med) :: cval
242  logical :: onetimer
243  logical :: found
244  integer, parameter :: root = 0
245  integer :: k, n, m
246  integer :: nlabels
247  integer :: ierror
248  integer :: ntimermax
249  integer :: pe1,pe2
250  integer :: minpe,maxpe,mcnt
251  double precision :: mintime,maxtime,meantime
252  character(len=*),parameter :: subname = '(oasis_timer_print)'
253 
254  IF (timer_debug < 1) then
255  return
256  ENDIF
257 
258  IF ((timer_debug == 1) .AND. (mpi_rank_local == 0)) timer_debug=2
259 
260  IF (timer_debug >= 2) THEN
261 
262  CALL oasis_unitget(output_unit)
263  WRITE(file_name,'(a,i4.4)') trim(file_hold)//'_',mpi_rank_local
264 
265  OPEN(output_unit, file=trim(file_name), form="FORMATTED", &
266  status="UNKNOWN")
267  WRITE(output_unit,*) ''
268  CLOSE(output_unit)
269 
270  ENDIF
271 
272  onetimer = .false.
273  if (present(timer_label)) then
274  onetimer = .true.
275  call oasis_timer_c2i(timer_label,timer_id)
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',&
280  trim(timer_label)
281  CALL oasis_flush(nulprt)
282  RETURN
283  endif
284  endif
285 
286 !-----------------------------------------------------
287 ! one timer output
288 !-----------------------------------------------------
289  if (timer_debug >= 2 .and. onetimer) then
290 
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.
297  ENDIF
298  n = timer_id
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)
303  CLOSE(output_unit)
304 !----------
305  return
306 !----------
307  endif
308 
309 !-----------------------------------------------------
310 ! local output
311 !-----------------------------------------------------
312  IF (timer_debug >= 2) THEN
313  OPEN(output_unit, file=trim(file_name), form="FORMATTED", &
314  status="UNKNOWN", position="APPEND")
315 
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,*)''
322 
323  do n = 1,ntimer
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.
328  ENDIF
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)
333  enddo
334 
335  CLOSE(output_unit)
336  ENDIF
337 
338 !-----------------------------------------------------
339 ! gather global output on mpi_comm_local pes
340 !-----------------------------------------------------
341  if (mpi_size_local > 0) then
342 
343  call mpi_allreduce(ntimer,ntimermax,1,mpi_integer,mpi_max,mpi_comm_local,ierror)
344 
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'
355 
356  sum_ctime_global_tmp = 0.0
357  sum_wtime_global_tmp = 0.0
358  count_global_tmp = 0
359  label_global_tmp = ' '
360 
361  ! gathering of timer values on root process
362 
363 ! tcraig, causes memory failure on corail for some reason
364 ! call MPI_Gather(sum_ctime(1), ntimermax, MPI_DOUBLE_PRECISION, sum_ctime_global_tmp(1,1), &
365 ! ntimermax, MPI_DOUBLE_PRECISION, root, mpi_comm_local, ierror)
366 ! call MPI_Gather(sum_wtime(1), ntimermax, MPI_DOUBLE_PRECISION, sum_wtime_global_tmp(1,1), &
367 ! ntimermax, MPI_DOUBLE_PRECISION, root, mpi_comm_local, ierror)
368 ! call MPI_Gather(count(1), ntimermax, MPI_INTEGER, count_global_tmp(1,1), &
369 ! ntimermax, MPI_INTEGER, root, mpi_comm_local, ierror)
370 
371 ! tcraig, this doesn't work either
372 ! allocate(rarr(ntimermax),stat=ierror)
373 ! if ( ierror /= 0 ) write(nulprt,*) subname,wstr,'allocate error rarr'
374 ! rarr(1:ntimermax) = sum_ctime(1:ntimermax)
375 ! call MPI_Gather(rarr,ntimermax,MPI_DOUBLE_PRECISION,sum_ctime_global_tmp,ntimermax,MPI_DOUBLE_PRECISION,root,mpi_comm_local,ierror)
376 ! rarr(1:ntimermax) = sum_wtime(1:ntimermax)
377 ! call MPI_Gather(rarr,ntimermax,MPI_DOUBLE_PRECISION,sum_wtime_global_tmp,ntimermax,MPI_DOUBLE_PRECISION,root,mpi_comm_local,ierror)
378 ! deallocate(rarr,stat=ierror)
379 ! if ( ierror /= 0 ) write(nulprt,*) subname,wstr,'deallocate error rarr'
380 !
381 ! allocate(iarr(ntimermax),stat=ierror)
382 ! if ( ierror /= 0 ) write(nulprt,*) subname,wstr,'allocate error iarr'
383 ! iarr(1:ntimermax) = count(1:ntimermax)
384 ! call MPI_Gather(iarr,ntimermax,MPI_INTEGER,count_global_tmp,ntimermax,MPI_INTEGER,root,mpi_comm_local,ierror)
385 ! deallocate(iarr,stat=ierror)
386 ! if ( ierror /= 0 ) write(nulprt,*) subname,wstr,'deallocate error iarr'
387 
388 ! tcraig this works but requires lots of gather calls, could be better
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'
392 
393  do n = 1,ntimermax
394  cval = timer(n)%label
395  carr(:) = ' '
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))
401  enddo
402  endif
403 
404  rval = sum_ctime(n)
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)
409  endif
410 
411  rval = sum_wtime(n)
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)
416  endif
417 
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)
423  endif
424  enddo
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'
428 
429  ! now sort all the timers out by names
430 
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'
434  nlabels = 0
435  do n = 1,ntimermax
436  do m = 1,mpi_size_local
437  found = .false.
438  if (trim(label_global_tmp(n,m)) == '') then
439  found = .true.
440  else
441  do k = 1,nlabels
442  if (trim(label_global_tmp(n,m)) == trim(carr(k))) found = .true.
443  enddo
444  endif
445  if (.not.found) then
446  nlabels = nlabels + 1
447  carr(nlabels) = trim(label_global_tmp(n,m))
448  endif
449  enddo
450  enddo
451 
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'
455  do k = 1,nlabels
456  label_list(k) = trim(carr(k))
457  enddo
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'
470 
471  sum_ctime_global = 0
472  sum_wtime_global = 0
473  count_global = 0
474 
475  do k = 1,nlabels
476  do m = 1,ntimermax
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)
482  endif
483  enddo
484  enddo
485  enddo
486 
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'
499 
500  endif ! (mpi_size_local > 1)
501 
502 !-----------------------------------------------------
503 ! write global output on root of mpi_comm_local
504 !-----------------------------------------------------
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")
508 
509  if (onetimer) then
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.
514  ENDIF
515  n = 0
516  do k = 1,nlabels
517  if (trim(timer_label) == trim(label_list(k))) n = k
518  enddo
519  if (n < 1) then
520  write(nulprt,*) subname,' model :',compid,' proc :',&
521  mpi_rank_local,':',wstr,'invalid timer_label',trim(timer_label)
522  CALL oasis_flush(nulprt)
523  return
524  endif
525  mintime = sum_ctime_global(n,1)
526  minpe = 1
527  maxtime = sum_ctime_global(n,1)
528  maxpe = 1
529  do k = 1,mpi_size_local
530  if (sum_ctime_global(n,k) < mintime) then
531  mintime = sum_ctime_global(n,k)
532  minpe = k
533  endif
534  if (sum_ctime_global(n,k) > maxtime) then
535  maxtime = sum_ctime_global(n,k)
536  maxpe = k
537  endif
538  enddo
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)
543 
544  else
545  single_timer_header = .false.
546 
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'
555 
556  DO n = 1,nlabels
557  mintime = 1.0e36
558  minpe = -1
559  maxtime = -1.0e36
560  maxpe = -1
561  meantime = 0.0
562  mcnt = 0
563  do k = 1,mpi_size_local
564  if (count_global(n,k) > 0) then
565  meantime = meantime + sum_wtime_global(n,k)
566  mcnt = mcnt + 1
567  if (sum_wtime_global(n,k) < mintime) then
568  mintime = sum_wtime_global(n,k)
569  minpe = k
570  endif
571  if (sum_wtime_global(n,k) > maxtime) then
572  maxtime = sum_wtime_global(n,k)
573  maxpe = k
574  endif
575  endif
576  enddo
577  if (mcnt > 0) then
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), &
583  meantime
584  endif
585  ENDDO
586 
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)
597  DO n = 1, nlabels
598  WRITE(output_unit,'(1x,i8,2x,a24,a1,1x,(i10))') n, label_list(n), &
599  timer(n)%runflag, (count_global(n,k))
600  ENDDO
601  ENDDO
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)
611  DO n = 1, nlabels
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))
614  ENDDO
615  ENDDO
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)
625  DO n = 1, nlabels
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))
628  ENDDO
629  ENDDO
630  WRITE(output_unit,*)''
631  WRITE(output_unit,*)' ======================================'
632  ENDIF
633 
634  endif ! (onetimer)
635 
636  CLOSE(output_unit)
637 
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'
650 
651  endif ! (mpi_rank_local == root)
652 
653 
654  end subroutine oasis_timer_print
655 
656 ! --------------------------------------------------------------------------------
657 
658 !> Convert a timer name to the timer id number
659 
660  subroutine oasis_timer_c2i(tname,tid)
661 
662  character(len=*),intent(in) :: tname !< timer name
663  integer ,intent(out) :: tid !< timer id
664 
665  integer :: n
666 
667  tid = -1
668  do n = 1,ntimer
669  if (trim(tname) == trim(timer(n)%label)) tid = n
670  enddo
671 
672  end subroutine oasis_timer_c2i
673 
674 ! --------------------------------------------------------------------------------
675 end module mod_oasis_timer
System type methods.
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.
Storage for timer data.
Defines kinds for OASIS.
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.