Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

mod_oasis_timer.F90 @ 6331

Last change on this file since 6331 was 6331, checked in by aclsce, 17 months ago
Moved oasis-mct_5.0 in oasis3-mct/branches directory.
File size: 28.6 KB

Line
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
39	module mod_oasis_timer
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
61	type timer_details
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(file=__FILE__,line=__LINE__)
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(f11.4,i8,i13,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(f11.4,i8,i13,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	#if (1 == 0)
365	allocate(carr(ntimermax))
366	do n = 1,ntimermax
367	carr(n) = timer(n)%label
368	enddo
369	call MPI_BARRIER(mpi_comm_local, ierror)
370	call MPI_Gather(carr(1), ntimermax, MPI_CHARACTER, label_global_tmp(1,1), &
371	ntimermax, MPI_CHARACTER, root, mpi_comm_local, ierror)
372	call MPI_BARRIER(mpi_comm_local, ierror)
373	call MPI_Gather(sum_ctime(1), ntimermax, MPI_DOUBLE_PRECISION, sum_ctime_global_tmp(1,1), &
374	ntimermax, MPI_DOUBLE_PRECISION, root, mpi_comm_local, ierror)
375	call MPI_BARRIER(mpi_comm_local, ierror)
376	call MPI_Gather(sum_wtime(1), ntimermax, MPI_DOUBLE_PRECISION, sum_wtime_global_tmp(1,1), &
377	ntimermax, MPI_DOUBLE_PRECISION, root, mpi_comm_local, ierror)
378	call MPI_BARRIER(mpi_comm_local, ierror)
379	call MPI_Gather(timer_count(1), ntimermax, MPI_INTEGER, count_global_tmp(1,1), &
380	ntimermax, MPI_INTEGER, root, mpi_comm_local, ierror)
381	deallocate(carr)
382	#endif
383
384	! tcraig, this doesn't work either
385	#if (1 == 0)
386	! allocate(rarr(ntimermax),stat=ierror)
387	! if ( ierror /= 0 ) write(nulprt,*) subname,wstr,'allocate error rarr'
388	! rarr(1:ntimermax) = sum_ctime(1:ntimermax)
389	! call MPI_Gather(rarr,ntimermax,MPI_DOUBLE_PRECISION,sum_ctime_global_tmp,ntimermax,MPI_DOUBLE_PRECISION,root,mpi_comm_local,ierror)
390	! rarr(1:ntimermax) = sum_wtime(1:ntimermax)
391	! call MPI_Gather(rarr,ntimermax,MPI_DOUBLE_PRECISION,sum_wtime_global_tmp,ntimermax,MPI_DOUBLE_PRECISION,root,mpi_comm_local,ierror)
392	! deallocate(rarr,stat=ierror)
393	! if ( ierror /= 0 ) write(nulprt,*) subname,wstr,'deallocate error rarr'
394	!
395	! allocate(iarr(ntimermax),stat=ierror)
396	! if ( ierror /= 0 ) write(nulprt,*) subname,wstr,'allocate error iarr'
397	! iarr(1:ntimermax) = count(1:ntimermax)
398	! call MPI_Gather(iarr,ntimermax,MPI_INTEGER,count_global_tmp,ntimermax,MPI_INTEGER,root,mpi_comm_local,ierror)
399	! deallocate(iarr,stat=ierror)
400	! if ( ierror /= 0 ) write(nulprt,*) subname,wstr,'deallocate error iarr'
401	#endif
402
403	! tcraig this works but requires lots of gather calls, could be better
404	#if (1 == 1)
405	allocate(rarr(mpi_size_local),iarr(mpi_size_local),carr(mpi_size_local),stat=ierror)
406	if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
407	mpi_rank_local,':',wstr,'allocate error rarr'
408
409	do n = 1,ntimermax
410	cval = timer(n)%label
411	carr(:) = ' '
412	call MPI_BARRIER(mpi_comm_local, ierror)
413	call MPI_Gather(cval,len(cval),MPI_CHARACTER,carr(1),len(cval),&
414	MPI_CHARACTER,root,mpi_comm_local,ierror)
415	if (mpi_rank_local == root) then
416	do m = 1,mpi_size_local
417	label_global_tmp(n,m) = trim(carr(m))
418	enddo
419	endif
420
421	rval = sum_ctime(n)
422	call MPI_BARRIER(mpi_comm_local, ierror)
423	call MPI_Gather(rval,1,MPI_DOUBLE_PRECISION,rarr(1),1,MPI_DOUBLE_PRECISION,&
424	root,mpi_comm_local,ierror)
425	if (mpi_rank_local == root) then
426	sum_ctime_global_tmp(n,1:mpi_size_local) = rarr(1:mpi_size_local)
427	endif
428
429	rval = sum_wtime(n)
430	call MPI_BARRIER(mpi_comm_local, ierror)
431	call MPI_Gather(rval,1,MPI_DOUBLE_PRECISION,rarr(1),1,MPI_DOUBLE_PRECISION,&
432	root,mpi_comm_local,ierror)
433	if (mpi_rank_local == root) then
434	sum_wtime_global_tmp(n,1:mpi_size_local) = rarr(1:mpi_size_local)
435	endif
436
437	ival = timer_count(n)
438	call MPI_BARRIER(mpi_comm_local, ierror)
439	call MPI_Gather(ival,1,MPI_INTEGER,iarr(1),1,MPI_INTEGER,root,&
440	mpi_comm_local,ierror)
441	if (mpi_rank_local == root) then
442	count_global_tmp(n,1:mpi_size_local) = iarr(1:mpi_size_local)
443	endif
444	enddo
445	deallocate(rarr,iarr,carr,stat=ierror)
446	if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
447	mpi_rank_local,':',wstr,'deallocate error rarr'
448	#endif
449
450	! now sort all the timers out by names
451
452	allocate(carr(ntimermax*mpi_size_local),stat=ierror)
453	if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
454	mpi_rank_local,':',wstr,'allocate error carr'
455	nlabels = 0
456	do n = 1,ntimermax
457	do m = 1,mpi_size_local
458	found = .false.
459	if (trim(label_global_tmp(n,m)) == '') then
460	found = .true.
461	else
462	do k = 1,nlabels
463	if (trim(label_global_tmp(n,m)) == trim(carr(k))) found = .true.
464	enddo
465	endif
466	if (.not.found) then
467	nlabels = nlabels + 1
468	carr(nlabels) = trim(label_global_tmp(n,m))
469	endif
470	enddo
471	enddo
472
473	allocate(label_list(nlabels),stat=ierror)
474	if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
475	mpi_rank_local,':',wstr,'allocate error label_list'
476	do k = 1,nlabels
477	label_list(k) = trim(carr(k))
478	enddo
479	deallocate(carr,stat=ierror)
480	if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
481	mpi_rank_local,':',wstr,'deallocate error carr'
482	allocate(sum_ctime_global(nlabels,mpi_size_local),stat=ierror)
483	if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
484	mpi_rank_local,':',wstr,'allocate error sum_ctime_global'
485	allocate(sum_wtime_global(nlabels,mpi_size_local),stat=ierror)
486	if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
487	mpi_rank_local,':',wstr,'allocate error sum_wtime_global'
488	allocate(count_global(nlabels,mpi_size_local),stat=ierror)
489	if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
490	mpi_rank_local,':',wstr,'allocate error count_global'
491
492	sum_ctime_global = 0
493	sum_wtime_global = 0
494	count_global = 0
495
496	do k = 1,nlabels
497	do m = 1,ntimermax
498	do n = 1,mpi_size_local
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)
503	endif
504	enddo
505	enddo
506	enddo
507
508	deallocate(label_global_tmp,stat=ierror)
509	if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
510	mpi_rank_local,':',wstr,'deallocate error label_global_tmp'
511	deallocate(sum_ctime_global_tmp,stat=ierror)
512	if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
513	mpi_rank_local,':',wstr,'deallocate error sum_ctime_global_tmp'
514	deallocate(sum_wtime_global_tmp,stat=ierror)
515	if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
516	mpi_rank_local,':',wstr,'deallocate error sum_wtime_global_tmp'
517	deallocate(count_global_tmp,stat=ierror)
518	if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
519	mpi_rank_local,':',wstr,'deallocate error count_global'
520
521	endif ! (mpi_size_local > 1)
522
523	!-----------------------------------------------------
524	! write global output on root of mpi_comm_local
525	!-----------------------------------------------------
526	if (TIMER_Debug >= 2 .and. mpi_rank_local == root) then
527	OPEN(output_unit, file=TRIM(file_name), form="FORMATTED", &
528	status="UNKNOWN", position="APPEND")
529
530	if (onetimer) then
531	IF (.NOT.single_timer_header) THEN
532	WRITE(output_unit,'(32x,2(2x,a,5x,a,6x,a,4x))') &
533	'mintime','on pe','count','maxtime','on pe','count'
534	single_timer_header = .TRUE.
535	ENDIF
536	n = 0
537	do k = 1,nlabels
538	if (trim(timer_label) == trim(label_list(k))) n = k
539	enddo
540	if (n < 1) then
541	write(nulprt,*) subname,' model :',compid,' proc :',&
542	mpi_rank_local,':',wstr,'invalid timer_label',trim(timer_label)
543	CALL oasis_flush(nulprt)
544	return
545	endif
546	mintime = sum_ctime_global(n,1)
547	minpe = 1
548	maxtime = sum_ctime_global(n,1)
549	maxpe = 1
550	do k = 1,mpi_size_local
551	if (sum_ctime_global(n,k) < mintime) then
552	mintime = sum_ctime_global(n,k)
553	minpe = k
554	endif
555	if (sum_ctime_global(n,k) > maxtime) then
556	maxtime = sum_ctime_global(n,k)
557	maxpe = k
558	endif
559	enddo
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)
564
565	else
566	single_timer_header = .FALSE.
567
568	WRITE(output_unit,*)''
569	WRITE(output_unit,*)' =================================='
570	WRITE(output_unit,*)' ', TRIM(app_name)
571	WRITE(output_unit,*)' Overall Elapsed Min/Max statistics'
572	WRITE(output_unit,*)' =================================='
573	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'
576
577	DO n = 1,nlabels
578	mintime = 1.0e36
579	minpe = -1
580	maxtime = -1.0e36
581	maxpe = -1
582	meantime = 0.0
583	mcnt = 0
584	do k = 1,mpi_size_local
585	if (count_global(n,k) > 0) then
586	meantime = meantime + sum_wtime_global(n,k)
587	mcnt = mcnt + 1
588	if (sum_wtime_global(n,k) < mintime) then
589	mintime = sum_wtime_global(n,k)
590	minpe = k
591	endif
592	if (sum_wtime_global(n,k) > maxtime) then
593	maxtime = sum_wtime_global(n,k)
594	maxpe = k
595	endif
596	endif
597	enddo
598	if (mcnt > 0) then
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), &
604	meantime
605	endif
606	ENDDO
607
608	IF (TIMER_Debug >= 3) THEN
609	WRITE(output_unit,*)''
610	WRITE(output_unit,*)' =================================='
611	WRITE(output_unit,*)' ', TRIM(app_name)
612	WRITE(output_unit,*)' Overall Count statistics'
613	WRITE(output_unit,*)' =================================='
614	WRITE(output_unit,*)''
615	DO k=1,mpi_size_local
616	WRITE(output_unit,'(a)',advance="NO") " P r o c e s s o r ----------> "
617	WRITE(output_unit,'(3x,i8,5x)')(k-1)
618	DO n = 1, nlabels
619	WRITE(output_unit,'(1x,i8,2x,a24,a1,1x,(i10))') n, label_list(n), &
620	timer(n)%runflag, (count_global(n,k))
621	ENDDO
622	ENDDO
623	WRITE(output_unit,*)''
624	WRITE(output_unit,*)' =================================='
625	WRITE(output_unit,*)' ', TRIM(app_name)
626	WRITE(output_unit,*)' Overall CPU time statistics'
627	WRITE(output_unit,*)' =================================='
628	WRITE(output_unit,*)''
629	DO k=1,mpi_size_local
630	WRITE(output_unit,'(a)',advance="NO") " P r o c e s s o r ----------> "
631	WRITE(output_unit,'(3x,i8,5x)')(k-1)
632	DO n = 1, nlabels
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))
635	ENDDO
636	ENDDO
637	WRITE(output_unit,*)''
638	WRITE(output_unit,*)' ======================================'
639	WRITE(output_unit,*)' ', TRIM(app_name)
640	WRITE(output_unit,*)' Overall Elapsed time statistics'
641	WRITE(output_unit,*)' ======================================'
642	WRITE(output_unit,*)''
643	DO k=1,mpi_size_local
644	WRITE(output_unit,'(a)',advance="NO") " P r o c e s s o r ----------> "
645	WRITE(output_unit,'(3x,i8,5x)')(k-1)
646	DO n = 1, nlabels
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))
649	ENDDO
650	ENDDO
651	WRITE(output_unit,*)''
652	WRITE(output_unit,*)' ======================================'
653	ENDIF
654
655	endif ! (onetimer)
656
657	CLOSE(output_unit)
658
659	deallocate (sum_ctime_global, stat=ierror)
660	if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
661	mpi_rank_local,':',wstr,'deallocate error sum_ctime_global'
662	deallocate (sum_wtime_global, stat=ierror)
663	if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
664	mpi_rank_local,':',wstr,'deallocate error sum_wtime_global'
665	deallocate (count_global,stat=ierror)
666	if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
667	mpi_rank_local,':',wstr,'deallocate error count_global'
668	deallocate (label_list,stat=ierror)
669	if ( ierror /= 0 ) write(nulprt,*) subname,' model :',compid,' proc :',&
670	mpi_rank_local,':',wstr,'deallocate error label_list'
671
672	endif ! (mpi_rank_local == root)
673
674	end subroutine oasis_timer_print
675
676	! --------------------------------------------------------------------------------
677
678	!> Convert a timer name to the timer id number
679
680	subroutine oasis_timer_c2i(tname,tid)
681
682	character(len=*),intent(in) :: tname !< timer name
683	integer ,intent(out) :: tid !< timer id
684
685	integer :: n
686
687	tid = -1
688	do n = 1,ntimer
689	if (trim(tname) == trim(timer(n)%label)) tid = n
690	enddo
691
692	end subroutine oasis_timer_c2i
693
694	! --------------------------------------------------------------------------------
695	end module mod_oasis_timer

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: CPL/oasis3-mct/branches/OASIS3-MCT_5.0_branch/lib/psmile/src/mod_oasis_timer.F90 @ 6331

Download in other formats: