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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
timing.F90 in branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC – NEMO

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/timing.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 4 years ago

The Dr Hook changes from my perl code.

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