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_clock*100.*jpnij/tot_etime, & |
---|
585 | & sl_timer_ave%tsum_cpu ,sl_timer_ave%tsum_cpu*100.*jpnij/tot_ctime , & |
---|
586 | & sl_timer_ave%tsum_cpu/sl_timer_ave%tsum_clock, & |
---|
587 | & sl_timer_ave%tmax_clock*100.*jpnij/tot_etime, & |
---|
588 | & sl_timer_ave%tmin_clock*100.*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 |
---|