source: NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/timing.F90 @ 10178

Last change on this file since 10178 was 10178, checked in by smasson, 2 years ago

dev_r10164_HPC09_ESIWACE_PREP_MERGE: action 2b-bis: print cleaning in timing, see #2133

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