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 NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE – NEMO

Context Navigation

source: NEMO/branches/UKMO/dev_r12866_HPC-02_Daley_Tiling_trial_extra_halo/src/OCE/timing.F90 @ 12942

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

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

Download in other formats: