New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

timing.F90 in branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC – NEMO

Context Navigation

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/timing.F90 @ 4472

Last change on this file since 4472 was 4472, checked in by trackstand2, 10 years ago
Improvements in timing.F90 to try and avoid using dissociated ptrs
File size: 33.5 KB

Line
1	MODULE timing
2	!!========================================================================
3	!! * MODULE timing *
4	!!========================================================================
5	!! History : 4.0 ! 2001-05 (R. Benshila)
6	!!------------------------------------------------------------------------
7
8	!!------------------------------------------------------------------------
9	!! timming_init : initialize timing process
10	!! timing_start : start Timer
11	!! timing_stop : stop Timer
12	!! timing_reset : end timing variable creation
13	!! timing_finalize : compute stats and write output in calling w*_info
14	!! timing_ini_var : create timing variables
15	!! timing_listing : print instumented subroutines in ocean.output
16	!! wcurrent_info : compute and print detailed stats on the current CPU
17	!! wave_info : compute and print averaged statson all processors
18	!! wmpi_info : compute and write global stats
19	!! supress : suppress an element of the timing linked list
20	!! insert : insert an element of the timing linked list
21	!!------------------------------------------------------------------------
22	USE in_out_manager ! I/O manager
23	USE dom_oce ! ocean domain
24	USE lib_mpp
25
26	IMPLICIT NONE
27	PRIVATE
28
29	PUBLIC timing_init, timing_finalize ! called in nemogcm module
30	PUBLIC timing_reset ! called in step module
31	PUBLIC timing_start, timing_stop ! called in each routine to time
32	PUBLIC timing_enable, timing_disable ! called to enable or disable timing
33	! (timing enabled by default)
34	#if defined key_mpp_mpi
35	INCLUDE 'mpif.h'
36	#endif
37
38	! Variables for fine grain timing
39	TYPE timer
40	CHARACTER(LEN=20) :: cname
41	REAL(wp) :: t_cpu, t_clock, tsum_cpu, tsum_clock, tmax_cpu, tmax_clock, tmin_cpu, tmin_clock, tsub_cpu, tsub_clock
42	INTEGER :: ncount, ncount_max, ncount_rate
43	INTEGER :: niter
44	LOGICAL :: l_tdone
45	TYPE(timer), POINTER :: next => NULL()
46	TYPE(timer), POINTER :: prev => NULL()
47	TYPE(timer), POINTER :: parent_section => NULL()
48	END TYPE timer
49
50	TYPE alltimer
51	CHARACTER(LEN=20), DIMENSION(:), POINTER :: cname => NULL()
52	REAL(wp), DIMENSION(:), POINTER :: tsum_cpu => NULL()
53	REAL(wp), DIMENSION(:), POINTER :: tsum_clock => NULL()
54	INTEGER, DIMENSION(:), POINTER :: niter => NULL()
55	TYPE(alltimer), POINTER :: next => NULL()
56	TYPE(alltimer), POINTER :: prev => NULL()
57	END TYPE alltimer
58
59	TYPE(timer), POINTER :: s_timer_root => NULL()
60	TYPE(timer), POINTER :: s_timer => NULL()
61	TYPE(timer), POINTER :: s_wrk => NULL()
62	REAL(wp) :: t_overclock, t_overcpu
63	LOGICAL, SAVE :: l_initdone = .FALSE.
64	! Whether timing is enabled - controlled by timing_{en,dis}able()
65	LOGICAL, SAVE :: l_enabled = .TRUE.
66	INTEGER :: nsize
67
68	! Variables for coarse grain timing
69	REAL(wp) :: tot_etime, tot_ctime
70	REAL(kind=wp), DIMENSION(2) :: t_elaps, t_cpu
71	REAL(wp), ALLOCATABLE, DIMENSION(:) :: all_etime, all_ctime
72	INTEGER :: nfinal_count, ncount, ncount_rate, ncount_max
73	INTEGER, DIMENSION(8) :: nvalues
74	CHARACTER(LEN=8), DIMENSION(2) :: cdate
75	CHARACTER(LEN=10), DIMENSION(2) :: ctime
76	CHARACTER(LEN=5) :: czone
77
78	! From of ouput file (1/proc or one global) !RB to put in nammpp or namctl
79	LOGICAL :: ln_onefile = .TRUE.
80	LOGICAL :: lwriter
81	INTEGER :: numtime ! Unit no. for file output
82	!!----------------------------------------------------------------------
83	!! NEMO/OPA 4.0 , NEMO Consortium (2011)
84	!! $Id: timing.F90 3222 2011-12-14 20:29:40Z rblod $
85	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
86	!!----------------------------------------------------------------------
87	CONTAINS
88
89	SUBROUTINE timing_start(cdinfo)
90	!!----------------------------------------------------------------------
91	!! * ROUTINE timing_start *
92	!! ** Purpose : collect execution time
93	!!----------------------------------------------------------------------
94	CHARACTER(len=*), INTENT(in) :: cdinfo
95	!
96	IF(.NOT. l_enabled)RETURN
97
98	! Create timing structure at first call
99	IF( .NOT. l_initdone ) THEN
100	CALL timing_ini_var(cdinfo)
101	ELSE
102	s_timer => s_timer_root
103	DO WHILE( TRIM(s_timer%cname) /= TRIM(cdinfo) )
104	IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next
105	END DO
106	ENDIF
107	s_timer%l_tdone = .FALSE.
108	s_timer%niter = s_timer%niter + 1
109	s_timer%t_cpu = 0.
110	s_timer%t_clock = 0.
111
112	! CPU time collection
113	CALL CPU_TIME( s_timer%t_cpu )
114	! clock time collection
115	#if defined key_mpp_mpi
116	s_timer%t_clock= MPI_Wtime()
117	#else
118	CALL SYSTEM_CLOCK(COUNT_RATE=s_timer%ncount_rate, COUNT_MAX=s_timer%ncount_max)
119	CALL SYSTEM_CLOCK(COUNT = s_timer%ncount)
120	#endif
121	!
122	END SUBROUTINE timing_start
123
124
125	SUBROUTINE timing_stop(cdinfo, csection)
126	!!----------------------------------------------------------------------
127	!! * ROUTINE timing_stop *
128	!! ** Purpose : finalize timing and output
129	!!----------------------------------------------------------------------
130	CHARACTER(len=*), INTENT(in) :: cdinfo
131	CHARACTER(len=*), INTENT(in), OPTIONAL :: csection
132	!
133	INTEGER :: ifinal_count, iperiods
134	REAL(wp) :: zcpu_end, zmpitime
135	!
136	s_wrk => NULL()
137
138	! clock time collection
139	#if defined key_mpp_mpi
140	zmpitime = MPI_Wtime()
141	#else
142	CALL SYSTEM_CLOCK(COUNT = ifinal_count)
143	#endif
144	! CPU time collection
145	CALL CPU_TIME( zcpu_end )
146	!
147	IF(.NOT. l_enabled)RETURN
148	!
149	s_timer => s_timer_root
150	IF(.NOT. ASSOCIATED(s_timer))THEN
151	WRITE(,) 'Timing ERROR!'
152	WRITE(,) 'timing_stop called for ',TRIM(cdinfo),' but timing structures not initialised!'
153	RETURN
154	END IF
155
156	DO WHILE( TRIM(s_timer%cname) /= TRIM(cdinfo) )
157	IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next
158	END DO
159
160	! CPU time correction
161	s_timer%t_cpu = zcpu_end - s_timer%t_cpu - t_overcpu - s_timer%tsub_cpu
162
163	! clock time correction
164	#if defined key_mpp_mpi
165	s_timer%t_clock = zmpitime - s_timer%t_clock - t_overclock - s_timer%tsub_clock
166	#else
167	iperiods = ifinal_count - s_timer%ncount
168	IF( ifinal_count < s_timer%ncount ) &
169	iperiods = iperiods + s_timer%ncount_max
170	s_timer%t_clock = REAL(iperiods) / s_timer%ncount_rate - t_overclock - s_timer%tsub_clock
171	#endif
172
173	! Correction of parent section
174	IF( .NOT. PRESENT(csection) ) THEN
175	s_wrk => s_timer
176	DO WHILE ( ASSOCIATED(s_wrk%parent_section ) )
177	s_wrk => s_wrk%parent_section
178	s_wrk%tsub_cpu = s_wrk%tsub_cpu + s_timer%t_cpu
179	s_wrk%tsub_clock = s_wrk%tsub_clock + s_timer%t_clock
180	END DO
181	ENDIF
182
183	! time diagnostics
184	s_timer%tsum_clock = s_timer%tsum_clock + s_timer%t_clock
185	s_timer%tsum_cpu = s_timer%tsum_cpu + s_timer%t_cpu
186	!RB to use to get min/max during a time integration
187	! IF( .NOT. l_initdone ) THEN
188	! s_timer%tmin_clock = s_timer%t_clock
189	! s_timer%tmin_cpu = s_timer%t_cpu
190	! ELSE
191	! s_timer%tmin_clock = MIN( s_timer%tmin_clock, s_timer%t_clock )
192	! s_timer%tmin_cpu = MIN( s_timer%tmin_cpu , s_timer%t_cpu )
193	! ENDIF
194	! s_timer%tmax_clock = MAX( s_timer%tmax_clock, s_timer%t_clock )
195	! s_timer%tmax_cpu = MAX( s_timer%tmax_cpu , s_timer%t_cpu )
196	!
197	s_timer%tsub_clock = 0.
198	s_timer%tsub_cpu = 0.
199	s_timer%l_tdone = .TRUE.
200	!
201	END SUBROUTINE timing_stop
202
203
204	SUBROUTINE timing_init
205	!!----------------------------------------------------------------------
206	!! * ROUTINE timing_init *
207	!! ** Purpose : open timing output file
208	!!----------------------------------------------------------------------
209	INTEGER :: iperiods, istart_count, ifinal_count
210	REAL(wp) :: zdum
211	LOGICAL :: ll_f
212
213	IF( ln_onefile ) THEN
214	IF( lwp) CALL ctl_opn( numtime, 'timing.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout,.TRUE., narea )
215	lwriter = lwp
216	ELSE
217	CALL ctl_opn( numtime, 'timing.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout,.FALSE., narea )
218	lwriter = .TRUE.
219	ENDIF
220
221	IF( lwriter) THEN
222	WRITE(numtime,*)
223	WRITE(numtime,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC - INGV'
224	WRITE(numtime,*) ' NEMO team'
225	WRITE(numtime,*) ' Ocean General Circulation Model'
226	WRITE(numtime,*) ' version 3.3 (2010) '
227	WRITE(numtime,*)
228	WRITE(numtime,*) ' Timing Informations '
229	WRITE(numtime,*)
230	WRITE(numtime,*)
231	ENDIF
232
233	! Compute clock function overhead
234	#if defined key_mpp_mpi
235	t_overclock = MPI_WTIME()
236	t_overclock = MPI_WTIME() - t_overclock
237	#else
238	CALL SYSTEM_CLOCK(COUNT_RATE=ncount_rate, COUNT_MAX=ncount_max)
239	CALL SYSTEM_CLOCK(COUNT = istart_count)
240	CALL SYSTEM_CLOCK(COUNT = ifinal_count)
241	iperiods = ifinal_count - istart_count
242	IF( ifinal_count < istart_count ) &
243	iperiods = iperiods + ncount_max
244	t_overclock = REAL(iperiods) / ncount_rate
245	#endif
246
247	! Compute cpu_time function overhead
248	CALL CPU_TIME(zdum)
249	CALL CPU_TIME(t_overcpu)
250
251	! End overhead omputation
252	t_overcpu = t_overcpu - zdum
253	t_overclock = t_overcpu + t_overclock
254
255	! Timing on date and time
256	CALL DATE_AND_TIME(cdate(1),ctime(1),czone,nvalues)
257
258	CALL CPU_TIME(t_cpu(1))
259	#if defined key_mpp_mpi
260	! Start elapsed and CPU time counters
261	t_elaps(1) = MPI_WTIME()
262	#else
263	CALL SYSTEM_CLOCK(COUNT_RATE=ncount_rate, COUNT_MAX=ncount_max)
264	CALL SYSTEM_CLOCK(COUNT = ncount)
265	#endif
266	!
267	END SUBROUTINE timing_init
268
269
270	SUBROUTINE timing_finalize
271	!!----------------------------------------------------------------------
272	!! * ROUTINE timing_finalize *
273	!! ** Purpose : compute average time
274	!! write timing output file
275	!!----------------------------------------------------------------------
276	TYPE(timer), POINTER :: s_temp
277	INTEGER :: idum, iperiods, icode
278	LOGICAL :: ll_ord, ll_averep
279	CHARACTER(len=120) :: clfmt
280
281	!!$ IF(.NOT. l_enabled)THEN
282	!!$ IF(lwp)WRITE(,) 'Timing disabled so no report generated.'
283	!!$ IF( lwriter ) CLOSE(numtime)
284	!!$ RETURN
285	!!$ END IF
286	! If timing was never initialised then there's nothing to finalise.
287	IF( .NOT. l_initdone ) RETURN
288
289	ll_averep = .TRUE.
290
291	! total CPU and elapse
292	CALL CPU_TIME(t_cpu(2))
293	t_cpu(2) = t_cpu(2) - t_cpu(1) - t_overcpu
294	#if defined key_mpp_mpi
295	t_elaps(2) = MPI_WTIME() - t_elaps(1) - t_overclock
296	#else
297	CALL SYSTEM_CLOCK(COUNT = nfinal_count)
298	iperiods = nfinal_count - ncount
299	IF( nfinal_count < ncount ) &
300	iperiods = iperiods + ncount_max
301	t_elaps(2) = REAL(iperiods) / ncount_rate - t_overclock
302	#endif
303
304	! End of timings on date & time
305	CALL DATE_AND_TIME(cdate(2),ctime(2),czone,nvalues)
306
307	! Compute the numer of routines
308	nsize = 0
309	s_timer => s_timer_root
310	DO WHILE( ASSOCIATED(s_timer) )
311	nsize = nsize + 1
312	s_timer => s_timer%next
313	END DO
314	idum = nsize
315	IF(lk_mpp) CALL mpp_sum(idum)
316	IF( idum/jpnij /= nsize ) THEN
317	IF( lwriter ) WRITE(numtime,*) ' ===> W A R N I N G: '
318	IF( lwriter ) WRITE(numtime,*) ' Some CPU have different number of routines instrumented for timing'
319	IF( lwriter ) WRITE(numtime,*) ' No detailed report on averaged timing can be provided'
320	IF( lwriter ) WRITE(numtime,*) ' The following detailed report only deals with the current processor'
321	IF( lwriter ) WRITE(numtime,*)
322	ll_averep = .FALSE.
323	ENDIF
324
325	#if defined key_mpp_mpi
326	! in MPI gather some info
327	ALLOCATE( all_etime(jpnij), all_ctime(jpnij) )
328	CALL MPI_ALLGATHER(t_elaps(2), 1, MPI_DOUBLE_PRECISION, &
329	all_etime , 1, MPI_DOUBLE_PRECISION, &
330	MPI_COMM_OPA, icode)
331	CALL MPI_ALLGATHER(t_cpu(2) , 1, MPI_DOUBLE_PRECISION, &
332	all_ctime, 1, MPI_DOUBLE_PRECISION, &
333	MPI_COMM_OPA, icode)
334	tot_etime = SUM(all_etime(:))
335	tot_ctime = SUM(all_ctime(:))
336	#else
337	tot_etime = t_elaps(2)
338	tot_ctime = t_cpu (2)
339	#endif
340
341	! write output file
342	IF( lwriter ) WRITE(numtime,*) 'Total timing (sum) :'
343	IF( lwriter ) WRITE(numtime,*) '--------------------'
344	IF( lwriter ) WRITE(numtime,"('Elapsed Time (s) CPU Time (s)')")
345	IF( lwriter ) WRITE(numtime,'(5x,f12.3,1x,f12.3)') tot_etime, tot_ctime
346	IF( lwriter ) WRITE(numtime,*)
347	#if defined key_mpp_mpi
348	IF( ll_averep ) CALL waver_info
349	CALL wmpi_info
350	#endif
351	IF( lwriter ) CALL wcurrent_info
352
353	clfmt='(1X,"Timing started on ",2(A2,"/"),A4," at ",2(A2,":"),A2," MET ",A3,":",A2," from GMT")'
354	IF( lwriter ) WRITE(numtime, TRIM(clfmt)) &
355	& cdate(1)(7:8), cdate(1)(5:6), cdate(1)(1:4), &
356	& ctime(1)(1:2), ctime(1)(3:4), ctime(1)(5:6), &
357	& czone(1:3), czone(4:5)
358	clfmt='(1X, "Timing ended on ",2(A2,"/"),A4," at ",2(A2,":"),A2," MET ",A3,":",A2," from GMT")'
359	IF( lwriter ) WRITE(numtime, TRIM(clfmt)) &
360	& cdate(2)(7:8), cdate(2)(5:6), cdate(2)(1:4), &
361	& ctime(2)(1:2), ctime(2)(3:4), ctime(2)(5:6), &
362	& czone(1:3), czone(4:5)
363
364	IF( lwriter ) CLOSE(numtime)
365	!
366	END SUBROUTINE timing_finalize
367
368
369	SUBROUTINE wcurrent_info
370	!!----------------------------------------------------------------------
371	!! * ROUTINE wcurrent_info *
372	!! ** Purpose : compute and write timing output file
373	!!----------------------------------------------------------------------
374	LOGICAL :: ll_ord
375	CHARACTER(len=2048) :: clfmt
376
377	! reorder the current list by elapse time
378	s_wrk => NULL()
379	s_timer => s_timer_root
380
381	IF(.NOT. ASSOCIATED(s_timer_root))THEN
382	WRITE(numtime,*) 'No timing information available!'
383	WRITE(numtime,*) '(Have any timed sections been executed?)'
384	RETURN
385	END IF
386
387	DO
388	ll_ord = .TRUE.
389	s_timer => s_timer_root
390	IF(.NOT. ASSOCIATED(s_timer)) EXIT
391	DO WHILE ( ASSOCIATED( s_timer%next ) )
392	IF (.NOT. ASSOCIATED(s_timer%next)) EXIT
393	IF ( s_timer%tsum_clock < s_timer%next%tsum_clock ) THEN
394	ALLOCATE(s_wrk)
395	s_wrk = s_timer%next
396	CALL insert (s_timer, s_timer_root, s_wrk)
397	CALL suppress(s_timer%next)
398	ll_ord = .FALSE.
399	CYCLE
400	ENDIF
401	IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next
402	END DO
403	IF( ll_ord ) EXIT
404	END DO
405
406	! write current info
407	WRITE(numtime,*) 'Detailed timing for proc :', narea-1
408	WRITE(numtime,*) '--------------------------'
409	WRITE(numtime,*) 'Section ', &
410	& 'Elapsed Time (s) ','Elapsed Time (%) ', &
411	& 'CPU Time(s) ','CPU Time (%) ','CPU/Elapsed ','Frequency'
412	s_timer => s_timer_root
413	clfmt = '(1x,a,4x,f12.3,6x,f12.3,x,f12.3,2x,f12.3,6x,f7.3,2x,i9)'
414	DO WHILE ( ASSOCIATED(s_timer) )
415	WRITE(numtime,TRIM(clfmt)) s_timer%cname, &
416	& s_timer%tsum_clock,s_timer%tsum_clock*100./t_elaps(2), &
417	& s_timer%tsum_cpu ,s_timer%tsum_cpu*100./t_cpu(2) , &
418	& s_timer%tsum_cpu/s_timer%tsum_clock, s_timer%niter
419	s_timer => s_timer%next
420	END DO
421	WRITE(numtime,*)
422	!
423	END SUBROUTINE wcurrent_info
424
425	#if defined key_mpp_mpi
426	SUBROUTINE waver_info
427	!!----------------------------------------------------------------------
428	!! * ROUTINE wcurrent_info *
429	!! ** Purpose : compute and write averaged timing informations
430	!!----------------------------------------------------------------------
431	TYPE(alltimer), POINTER :: sl_timer_glob_root => NULL()
432	TYPE(alltimer), POINTER :: sl_timer_glob => NULL()
433	TYPE(timer), POINTER :: sl_timer_ave_root => NULL()
434	TYPE(timer), POINTER :: sl_timer_ave => NULL()
435	INTEGER :: icode
436	INTEGER :: ierr
437	LOGICAL :: ll_ord
438	CHARACTER(len=200) :: clfmt
439
440	! Initialised the global strucutre
441	ALLOCATE(sl_timer_glob_root, Stat=ierr)
442	IF(ierr /= 0)THEN
443	WRITE(numtime,*) 'Failed to allocate global timing structure in waver_info'
444	RETURN
445	END IF
446
447	ALLOCATE(sl_timer_glob_root%cname (jpnij), &
448	sl_timer_glob_root%tsum_cpu (jpnij), &
449	sl_timer_glob_root%tsum_clock(jpnij), &
450	sl_timer_glob_root%niter (jpnij), Stat=ierr)
451	IF(ierr /= 0)THEN
452	WRITE(numtime,*) 'Failed to allocate global timing structure in waver_info'
453	RETURN
454	END IF
455	sl_timer_glob_root%cname(:) = ''
456	sl_timer_glob_root%tsum_cpu(:) = 0._wp
457	sl_timer_glob_root%tsum_clock(:) = 0._wp
458	sl_timer_glob_root%niter(:) = 0
459	sl_timer_glob_root%next => NULL()
460	sl_timer_glob_root%prev => NULL()
461	!ARPDBG - don't need to allocate a pointer that's immediately then
462	! set to point to some other object.
463	!ALLOCATE(sl_timer_glob)
464	!ALLOCATE(sl_timer_glob%cname (jpnij))
465	!ALLOCATE(sl_timer_glob%tsum_cpu (jpnij))
466	!ALLOCATE(sl_timer_glob%tsum_clock(jpnij))
467	!ALLOCATE(sl_timer_glob%niter (jpnij))
468	sl_timer_glob => sl_timer_glob_root
469	!
470	IF( narea .EQ. 1 ) THEN
471	ALLOCATE(sl_timer_ave_root)
472	sl_timer_ave_root%cname = ''
473	sl_timer_ave_root%t_cpu = 0._wp
474	sl_timer_ave_root%t_clock = 0._wp
475	sl_timer_ave_root%tsum_cpu = 0._wp
476	sl_timer_ave_root%tsum_clock = 0._wp
477	sl_timer_ave_root%tmax_cpu = 0._wp
478	sl_timer_ave_root%tmax_clock = 0._wp
479	sl_timer_ave_root%tmin_cpu = 0._wp
480	sl_timer_ave_root%tmin_clock = 0._wp
481	sl_timer_ave_root%tsub_cpu = 0._wp
482	sl_timer_ave_root%tsub_clock = 0._wp
483	sl_timer_ave_root%ncount = 0
484	sl_timer_ave_root%ncount_rate = 0
485	sl_timer_ave_root%ncount_max = 0
486	sl_timer_ave_root%niter = 0
487	sl_timer_ave_root%l_tdone = .FALSE.
488	sl_timer_ave_root%next => NULL()
489	sl_timer_ave_root%prev => NULL()
490	sl_timer_ave_root%parent_section => NULL()
491	!ALLOCATE(sl_timer_ave)
492	sl_timer_ave => sl_timer_ave_root
493	ENDIF
494
495	! Gather info from all processors
496	s_timer => s_timer_root
497	DO WHILE ( ASSOCIATED(s_timer) )
498	CALL MPI_GATHER(s_timer%cname , 20, MPI_CHARACTER, &
499	sl_timer_glob%cname, 20, MPI_CHARACTER, &
500	0, MPI_COMM_OPA, icode)
501	CALL MPI_GATHER(s_timer%tsum_clock , 1, MPI_DOUBLE_PRECISION, &
502	sl_timer_glob%tsum_clock, 1, MPI_DOUBLE_PRECISION, &
503	0, MPI_COMM_OPA, icode)
504	CALL MPI_GATHER(s_timer%tsum_cpu , 1, MPI_DOUBLE_PRECISION, &
505	sl_timer_glob%tsum_cpu, 1, MPI_DOUBLE_PRECISION, &
506	0, MPI_COMM_OPA, icode)
507	CALL MPI_GATHER(s_timer%niter , 1, MPI_INTEGER, &
508	sl_timer_glob%niter, 1, MPI_INTEGER, &
509	0, MPI_COMM_OPA, icode)
510
511	IF( narea == 1 .AND. ASSOCIATED(s_timer%next) ) THEN
512	ALLOCATE(sl_timer_glob%next)
513	ALLOCATE(sl_timer_glob%next%cname (jpnij))
514	ALLOCATE(sl_timer_glob%next%tsum_cpu (jpnij))
515	ALLOCATE(sl_timer_glob%next%tsum_clock(jpnij))
516	ALLOCATE(sl_timer_glob%next%niter (jpnij))
517	sl_timer_glob%next%prev => sl_timer_glob
518	sl_timer_glob%next%next => NULL()
519	sl_timer_glob => sl_timer_glob%next
520	ENDIF
521	s_timer => s_timer%next
522	END DO
523
524	IF( narea == 1 ) THEN
525	! Compute some stats
526	sl_timer_glob => sl_timer_glob_root
527	DO WHILE( ASSOCIATED(sl_timer_glob) )
528	sl_timer_ave%cname = sl_timer_glob%cname(1)
529	sl_timer_ave%tsum_cpu = SUM (sl_timer_glob%tsum_cpu (:)) / jpnij
530	sl_timer_ave%tsum_clock = SUM (sl_timer_glob%tsum_clock(:)) / jpnij
531	sl_timer_ave%tmax_cpu = MAXVAL(sl_timer_glob%tsum_cpu (:))
532	sl_timer_ave%tmax_clock = MAXVAL(sl_timer_glob%tsum_clock(:))
533	sl_timer_ave%tmin_cpu = MINVAL(sl_timer_glob%tsum_cpu (:))
534	sl_timer_ave%tmin_clock = MINVAL(sl_timer_glob%tsum_clock(:))
535	sl_timer_ave%niter = SUM (sl_timer_glob%niter (:))
536	!
537	IF( ASSOCIATED(sl_timer_glob%next) ) THEN
538	ALLOCATE(sl_timer_ave%next)
539	sl_timer_ave%next%prev => sl_timer_ave
540	sl_timer_ave%next%next => NULL()
541	sl_timer_ave%next%parent_section => NULL()
542	sl_timer_ave => sl_timer_ave%next
543	ENDIF
544	sl_timer_glob => sl_timer_glob%next
545	END DO
546
547	! reorder the averaged list by CPU time
548	s_wrk => NULL()
549	sl_timer_ave => sl_timer_ave_root
550	DO
551	ll_ord = .TRUE.
552	sl_timer_ave => sl_timer_ave_root
553	DO WHILE( ASSOCIATED( sl_timer_ave%next ) )
554
555	IF( .NOT. ASSOCIATED(sl_timer_ave%next) ) EXIT
556
557	IF ( sl_timer_ave%tsum_clock < sl_timer_ave%next%tsum_clock ) THEN
558	ALLOCATE(s_wrk)
559	! Copy data into the new object pointed to by s_wrk
560	s_wrk = sl_timer_ave%next
561	! Insert this new timer object before our current position
562	CALL insert (sl_timer_ave, sl_timer_ave_root, s_wrk)
563	! Remove the old object from the list
564	CALL suppress(sl_timer_ave%next)
565	ll_ord = .FALSE.
566	CYCLE
567	ENDIF
568	IF( ASSOCIATED(sl_timer_ave%next) ) sl_timer_ave => sl_timer_ave%next
569	END DO
570	IF( ll_ord ) EXIT
571	END DO
572
573	! write averaged info
574	WRITE(numtime,"('Averaged timing on all processors :')")
575	WRITE(numtime,"('-----------------------------------')")
576	WRITE(numtime,"('Section',13x,'Elap. Time(s)',2x,'Elap. Time(%)',2x, &
577	& 'CPU Time(s)',2x,'CPU Time(%)',2x,'CPU/Elap',1x, &
578	& 'Max elap(%)',2x,'Min elap(%)',2x, &
579	& 'Freq')")
580	sl_timer_ave => sl_timer_ave_root
581	clfmt = '((A),E15.7,2x,f6.2,5x,f12.2,5x,f6.2,5x,f7.2,2x,f12.2,4x,f6.2,2x,f9.2)'
582	DO WHILE ( ASSOCIATED(sl_timer_ave) )
583	WRITE(numtime,TRIM(clfmt)) sl_timer_ave%cname(1:18), &
584	& sl_timer_ave%tsum_clock,sl_timer_ave%tsum_clock100.jpnij/tot_etime, &
585	& sl_timer_ave%tsum_cpu ,sl_timer_ave%tsum_cpu100.jpnij/tot_ctime , &
586	& sl_timer_ave%tsum_cpu/sl_timer_ave%tsum_clock, &
587	& sl_timer_ave%tmax_clock100.jpnij/tot_etime, &
588	& sl_timer_ave%tmin_clock100.jpnij/tot_etime, &
589	& sl_timer_ave%niter/REAL(jpnij)
590	sl_timer_ave => sl_timer_ave%next
591	END DO
592	WRITE(numtime,*)
593	!
594	DEALLOCATE(sl_timer_ave_root)
595	ENDIF
596	!
597	DEALLOCATE(sl_timer_glob_root)
598	!
599	END SUBROUTINE waver_info
600
601
602	SUBROUTINE wmpi_info
603	!!----------------------------------------------------------------------
604	!! * ROUTINE wmpi_time *
605	!! ** Purpose : compute and write a summary of MPI infos
606	!!----------------------------------------------------------------------
607	!
608	INTEGER :: idum, icode
609	INTEGER, ALLOCATABLE, DIMENSION(:) :: iall_rank
610	REAL(wp) :: ztot_ratio
611	REAL(wp) :: zmax_etime, zmax_ctime, zmax_ratio, zmin_etime, zmin_ctime, zmin_ratio
612	REAL(wp) :: zavg_etime, zavg_ctime, zavg_ratio
613	REAL(wp), ALLOCATABLE, DIMENSION(:) :: zall_ratio
614	CHARACTER(LEN=128), dimension(8) :: cllignes
615	CHARACTER(LEN=128) :: clhline, clstart_date, clfinal_date
616	CHARACTER(LEN=2048) :: clfmt
617
618	! Gather all times
619	ALLOCATE( zall_ratio(jpnij), iall_rank(jpnij) )
620	IF( narea == 1 ) THEN
621	iall_rank(:) = (/ (idum,idum=0,jpnij-1) /)
622
623	! Compute elapse user time
624	zavg_etime = tot_etime/REAL(jpnij,wp)
625	zmax_etime = MAXVAL(all_etime(:))
626	zmin_etime = MINVAL(all_etime(:))
627
628	! Compute CPU user time
629	zavg_ctime = tot_ctime/REAL(jpnij,wp)
630	zmax_ctime = MAXVAL(all_ctime(:))
631	zmin_ctime = MINVAL(all_ctime(:))
632
633	! Compute cpu/elapsed ratio
634	zall_ratio(:) = all_ctime(:) / all_etime(:)
635	ztot_ratio = SUM(zall_ratio(:))
636	zavg_ratio = ztot_ratio/REAL(jpnij,wp)
637	zmax_ratio = MAXVAL(zall_ratio(:))
638	zmin_ratio = MINVAL(zall_ratio(:))
639
640	! Output Format
641	clhline ='1x,13("-"),"\|",18("-"),"\|",14("-"),"\|",18("-"),/,'
642	cllignes(1)='(1x,"MPI summary report :",/,'
643	cllignes(2)='1x,"--------------------",//,'
644	cllignes(3)='1x,"Process Rank \|"," Elapsed Time (s) \|"," CPU Time (s) \|"," Ratio CPU/Elapsed",/,'
645	cllignes(4)=' (1x,i4,9x,"\|",f12.3,6x,"\|",f12.3,2x,"\|",4x,f7.3,/),'
646	WRITE(cllignes(4)(1:4),'(I4)') jpnij
647	cllignes(5)='1x,"Total \|",f12.3,6x,"\|",F12.3,2x,"\|",4x,f7.3,/,'
648	cllignes(6)='1x,"Minimum \|",f12.3,6x,"\|",F12.3,2x,"\|",4x,f7.3,/,'
649	cllignes(7)='1x,"Maximum \|",f12.3,6x,"\|",F12.3,2x,"\|",4x,f7.3,/,'
650	cllignes(8)='1x,"Average \|",f12.3,6x,"\|",F12.3,2x,"\|",4x,f7.3)'
651	clfmt=TRIM(cllignes(1))// TRIM(cllignes(2))//TRIM(cllignes(3))// &
652	& TRIM(clhline)//TRIM(cllignes(4))//TRIM(clhline)//TRIM(cllignes(5))// &
653	& TRIM(clhline)//TRIM(cllignes(6))//TRIM(clhline)//TRIM(cllignes(7))// &
654	& TRIM(clhline)//TRIM(cllignes(8))
655	WRITE(numtime, TRIM(clfmt)) &
656	(iall_rank(idum),all_etime(idum),all_ctime(idum),zall_ratio(idum),idum=1, jpnij), &
657	tot_etime, tot_ctime, ztot_ratio, &
658	zmin_etime, zmin_ctime, zmin_ratio, &
659	zmax_etime, zmax_ctime, zmax_ratio, &
660	zavg_etime, zavg_ctime, zavg_ratio
661	WRITE(numtime,*)
662	END IF
663	!
664	DEALLOCATE(zall_ratio, iall_rank)
665	!
666	END SUBROUTINE wmpi_info
667	#endif
668
669
670	SUBROUTINE timing_ini_var(cdinfo)
671	!!----------------------------------------------------------------------
672	!! * ROUTINE timing_ini_var *
673	!! ** Purpose : create timing structure
674	!!----------------------------------------------------------------------
675	CHARACTER(len=*), INTENT(in) :: cdinfo
676	LOGICAL :: ll_section
677
678	!
679	IF( .NOT. ASSOCIATED(s_timer_root) ) THEN
680	ALLOCATE(s_timer_root)
681	s_timer_root%cname = cdinfo
682	s_timer_root%t_cpu = 0._wp
683	s_timer_root%t_clock = 0._wp
684	s_timer_root%tsum_cpu = 0._wp
685	s_timer_root%tsum_clock = 0._wp
686	s_timer_root%tmax_cpu = 0._wp
687	s_timer_root%tmax_clock = 0._wp
688	s_timer_root%tmin_cpu = 0._wp
689	s_timer_root%tmin_clock = 0._wp
690	s_timer_root%tsub_cpu = 0._wp
691	s_timer_root%tsub_clock = 0._wp
692	s_timer_root%ncount = 0
693	s_timer_root%ncount_rate = 0
694	s_timer_root%ncount_max = 0
695	s_timer_root%niter = 0
696	s_timer_root%l_tdone = .FALSE.
697	s_timer_root%next => NULL()
698	s_timer_root%prev => NULL()
699	s_timer_root%parent_section => NULL()
700	s_timer => s_timer_root
701	!
702	!ALLOCATE(s_wrk)
703	s_wrk => NULL()
704
705	ELSE
706	s_timer => s_timer_root
707	! case of already existing area (typically inside a loop)
708	DO WHILE( ASSOCIATED(s_timer) )
709	IF( TRIM(s_timer%cname) .EQ. TRIM(cdinfo) ) RETURN
710	s_timer => s_timer%next
711	END DO
712
713	! end of the chain
714	s_timer => s_timer_root
715	DO WHILE( ASSOCIATED(s_timer%next) )
716	s_timer => s_timer%next
717	END DO
718
719	ALLOCATE(s_timer%next)
720	s_timer%next%cname = cdinfo
721	s_timer%next%t_cpu = 0._wp
722	s_timer%next%t_clock = 0._wp
723	s_timer%next%tsum_cpu = 0._wp
724	s_timer%next%tsum_clock = 0._wp
725	s_timer%next%tmax_cpu = 0._wp
726	s_timer%next%tmax_clock = 0._wp
727	s_timer%next%tmin_cpu = 0._wp
728	s_timer%next%tmin_clock = 0._wp
729	s_timer%next%tsub_cpu = 0._wp
730	s_timer%next%tsub_clock = 0._wp
731	s_timer%next%ncount = 0
732	s_timer%next%ncount_rate = 0
733	s_timer%next%ncount_max = 0
734	s_timer%next%niter = 0
735	s_timer%next%l_tdone = .FALSE.
736	s_timer%next%parent_section => NULL()
737	s_timer%next%prev => s_timer
738	s_timer%next%next => NULL()
739	s_timer => s_timer%next
740
741	! are we inside a section
742	s_wrk => s_timer%prev
743	ll_section = .FALSE.
744	DO WHILE( ASSOCIATED(s_wrk) .AND. .NOT. ll_section )
745	IF( .NOT. s_wrk%l_tdone ) THEN
746	ll_section = .TRUE.
747	s_timer%parent_section => s_wrk
748	ENDIF
749	s_wrk => s_wrk%prev
750	END DO
751	ENDIF
752	!
753	END SUBROUTINE timing_ini_var
754
755
756	SUBROUTINE timing_reset
757	!!----------------------------------------------------------------------
758	!! * ROUTINE timing_reset *
759	!! ** Purpose : go to root of timing tree
760	!!----------------------------------------------------------------------
761
762	l_initdone = .TRUE.
763	IF(ASSOCIATED(s_timer_root))THEN
764	IF(lwp) WRITE(numout,*)
765	IF(lwp) WRITE(numout,*) 'timing_reset : instrumented routines for timing'
766	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~'
767	CALL timing_list(s_timer_root)
768	WRITE(numout,*)
769	ELSE
770	IF(lwp) WRITE(numout,*) 'timing_reset : no routines instrumented for timing'
771	END IF
772	!
773	END SUBROUTINE timing_reset
774
775
776	SUBROUTINE timing_disable
777	IMPLICIT none
778	! Calls to timing_st{art,op} have no effect
779	l_enabled = .FALSE.
780	END SUBROUTINE timing_disable
781
782
783	SUBROUTINE timing_enable
784	IMPLICIT none
785	! Calls to timing_st{art,op} are effective
786	l_enabled = .TRUE.
787	END SUBROUTINE timing_enable
788
789
790	RECURSIVE SUBROUTINE timing_list(ptr)
791
792	TYPE(timer), POINTER, INTENT(inout) :: ptr
793	!
794	IF(.NOT. ASSOCIATED(ptr))RETURN
795
796	IF( ASSOCIATED(ptr%next) ) CALL timing_list(ptr%next)
797	IF(lwp) WRITE(numout,*)' ', ptr%cname
798	!
799	END SUBROUTINE timing_list
800
801
802	SUBROUTINE insert(sd_current, sd_root ,sd_ptr)
803	!!----------------------------------------------------------------------
804	!! * ROUTINE insert *
805	!! ** Purpose : insert an element in timer structure
806	!!----------------------------------------------------------------------
807	TYPE(timer), POINTER, INTENT(inout) :: sd_current, sd_root, sd_ptr
808	!
809
810	IF( ASSOCIATED( sd_current, sd_root ) ) THEN
811	! If our current element is the root element then
812	! replace it with the one being inserted
813	sd_root => sd_ptr
814	ELSE
815	sd_current%prev%next => sd_ptr
816	END IF
817	sd_ptr%next => sd_current
818	sd_ptr%prev => sd_current%prev
819	sd_current%prev => sd_ptr
820	! Nullify the pointer to the new element now that it is held
821	! within the list. If we don't do this then a subsequent call
822	! to ALLOCATE memory to this pointer will fail.
823	sd_ptr => NULL()
824	!
825	END SUBROUTINE insert
826
827
828	SUBROUTINE suppress(sd_ptr)
829	!!----------------------------------------------------------------------
830	!! * ROUTINE suppress *
831	!! ** Purpose : supress an element in timer structure
832	!!----------------------------------------------------------------------
833	TYPE(timer), POINTER, INTENT(inout) :: sd_ptr
834	!
835	TYPE(timer), POINTER :: sl_temp
836
837	IF(.NOT. ASSOCIATED(sd_ptr)) RETURN
838
839	sl_temp => sd_ptr
840	sd_ptr => sd_ptr%next
841	IF ( ASSOCIATED(sl_temp%next) ) sl_temp%next%prev => sl_temp%prev
842	DEALLOCATE(sl_temp)
843	sl_temp => NULL()
844	!
845	END SUBROUTINE suppress
846
847	!!=====================================================================
848	END MODULE timing

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

Download in other formats: