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

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

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

Last change on this file since 12942 was 12942, checked in by hadcv, 3 years ago

Correct/improve IF blocks for one tile code

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