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.
Changeset 10172 for NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src – NEMO

Ignore:
Timestamp:
2018-10-04T17:32:54+02:00 (5 years ago)
Author:
smasson
Message:

dev_r10164_HPC09_ESIWACE_PREP_MERGE: action 2b: improve of timing, add computing and waiting time, see #2133

Location:
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/lib_mpp.F90

    r10170 r10172  
    170170   INTEGER, PUBLIC                               ::   n_sequence = 0               !: # of communicated arrays 
    171171   LOGICAL                                       ::   l_comm_report_done = .false. !: print report only once 
    172  
     172    
     173   ! timing summary report 
     174   REAL(wp), PUBLIC ::  waiting_time = 0._wp, compute_time = 0._wp, elapsed_time = 0._wp 
     175    
    173176   REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   tampon   ! buffer in case of bsend 
    174177 
     
    16091612      ! 
    16101613   END SUBROUTINE mpp_lnk_2d_icb 
     1614 
     1615    
     1616   SUBROUTINE tic_tac (l_tic) 
     1617 
     1618    LOGICAL, INTENT(IN) :: l_tic 
     1619    REAL(wp), SAVE :: tic_wt, tic_ct = 0._wp 
     1620 
     1621    IF( ncom_stp <= nit000 ) RETURN 
     1622    IF( ncom_stp == nitend ) RETURN 
     1623     
     1624#if defined key_mpp_mpi 
     1625    IF ( l_tic ) THEN 
     1626       tic_wt = MPI_Wtime()                                                        ! start count tic->tac (waiting time) 
     1627       IF ( tic_ct > 0.0_wp ) compute_time = compute_time + MPI_Wtime() - tic_ct   ! cumulate count tac->tic 
     1628    ELSE 
     1629       waiting_time = waiting_time + MPI_Wtime() - tic_wt                          ! cumulate count tic->tac 
     1630       tic_ct = MPI_Wtime()                                                        ! start count tac->tic (waiting time) 
     1631    ENDIF 
     1632#endif 
     1633     
     1634   END SUBROUTINE tic_tac 
     1635 
    16111636    
    16121637#else 
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/mpp_lnk_generic.h90

    r10170 r10172  
    205205      ENDIF 
    206206      ! 
     207      IF( ln_timing ) CALL tic_tac(.TRUE.) 
     208      ! 
    207209      SELECT CASE ( nbondi ) 
    208210      CASE ( -1 ) 
     
    223225      END SELECT 
    224226      ! 
     227      IF( ln_timing ) CALL tic_tac(.FALSE.) 
     228      ! 
     229      ! 
    225230      !                           ! Write Dirichlet lateral conditions 
    226231      iihom = nlci-nn_hls 
     
    281286      imigr = nn_hls * jpi * ipk * ipl * ipf 
    282287      ! 
     288      IF( ln_timing ) CALL tic_tac(.TRUE.) 
     289      !  
    283290      SELECT CASE ( nbondj ) 
    284291      CASE ( -1 ) 
     
    299306      END SELECT 
    300307      ! 
     308      IF( ln_timing ) CALL tic_tac(.FALSE.) 
    301309      !                           ! Write Dirichlet lateral conditions 
    302310      ijhom = nlcj-nn_hls 
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/mpp_nfd_generic.h90

    r10068 r10172  
    116116            END DO 
    117117         END DO 
     118         ! 
     119         IF( ln_timing ) CALL tic_tac(.TRUE.) 
    118120         ! 
    119121         DO jr = 1, nsndto 
     
    167169            END DO 
    168170         ENDIF 
     171         ! 
     172         IF( ln_timing ) CALL tic_tac(.FALSE.) 
     173         ! 
    169174         DO jf = 1, ipf 
    170175            CALL lbc_nfd_nogather( ztabl(:,:,:,:,jf), ztabr(:,:,:,:,jf), cd_nat LBC_ARG, psgn LBC_ARG )   ! North fold boundary condition 
     
    195200         IF ( jpni*jpnj /= jpnij ) ztab(:,:,:,:,:)=0._wp 
    196201         ! 
     202         IF( ln_timing ) CALL tic_tac(.TRUE.) 
     203         ! 
    197204         CALL MPI_ALLGATHER( znorthloc  , itaille, MPI_DOUBLE_PRECISION,                & 
    198205            &                znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
     206         ! 
     207         IF( ln_timing ) CALL tic_tac(.FALSE.) 
    199208         ! 
    200209         DO jr = 1, ndim_rank_north         ! recover the global north array 
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/nemogcm.F90

    r10170 r10172  
    102102   CHARACTER(lc) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing 
    103103 
     104#if defined key_mpp_mpi 
     105   INCLUDE 'mpif.h' 
     106#endif 
     107 
    104108   !!---------------------------------------------------------------------- 
    105109   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    184188         ! 
    185189         DO WHILE( istp <= nitend .AND. nstop == 0 ) 
    186 #if   defined key_mpp_mpi 
     190#if defined key_mpp_mpi 
    187191            ncom_stp = istp 
     192            IF ( istp == ( nit000 + 1 ) ) elapsed_time = MPI_Wtime() 
     193            IF ( istp ==         nitend ) elapsed_time = MPI_Wtime() - elapsed_time 
    188194#endif 
    189195            CALL stp        ( istp )  
  • NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/timing.F90

    r10068 r10172  
    3838   TYPE timer 
    3939      CHARACTER(LEN=20)  :: cname 
    40         REAL(wp)  :: t_cpu, t_clock, tsum_cpu, tsum_clock, tmax_cpu, tmax_clock, tmin_cpu, tmin_clock, tsub_cpu, tsub_clock 
     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 
    4143      INTEGER :: ncount, ncount_max, ncount_rate   
    4244      INTEGER :: niter 
     
    4951   TYPE alltimer 
    5052      CHARACTER(LEN=20), DIMENSION(:), POINTER :: cname => NULL() 
    51         REAL(wp), DIMENSION(:), POINTER :: tsum_cpu   => NULL() 
    52         REAL(wp), DIMENSION(:), POINTER :: tsum_clock => NULL() 
    53         INTEGER, DIMENSION(:), POINTER :: niter => NULL() 
     53      REAL(wp), DIMENSION(:), POINTER :: tsum_cpu   => NULL() 
     54      REAL(wp), DIMENSION(:), POINTER :: tsum_clock => NULL() 
     55      INTEGER, DIMENSION(:), POINTER :: niter => NULL() 
    5456      TYPE(alltimer), POINTER :: next => NULL() 
    5557      TYPE(alltimer), POINTER :: prev => NULL() 
     
    5860   TYPE(timer), POINTER :: s_timer_root => NULL() 
    5961   TYPE(timer), POINTER :: s_timer      => NULL() 
     62   TYPE(timer), POINTER :: s_timer_old      => NULL() 
     63 
    6064   TYPE(timer), POINTER :: s_wrk        => NULL() 
    6165   REAL(wp) :: t_overclock, t_overcpu 
     
    9094      CHARACTER(len=*), INTENT(in) :: cdinfo 
    9195      ! 
    92         
    93       ! Create timing structure at first call 
    94       IF( .NOT. l_initdone ) THEN 
    95          CALL timing_ini_var(cdinfo) 
     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 
    96106      ELSE 
    97          s_timer => s_timer_root 
    98          DO WHILE( TRIM(s_timer%cname) /= TRIM(cdinfo) )  
    99             IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next 
    100          END DO 
    101       ENDIF          
     107         s_timer%parent_section => NULL() 
     108      ENDIF     
     109 
    102110      s_timer%l_tdone = .FALSE. 
    103111      s_timer%niter = s_timer%niter + 1 
     
    114122      CALL SYSTEM_CLOCK(COUNT = s_timer%ncount) 
    115123#endif 
     124!      write(*,*) 'end of start ', s_timer%cname 
     125 
    116126      ! 
    117127   END SUBROUTINE timing_start 
     
    127137      ! 
    128138      INTEGER  :: ifinal_count, iperiods     
    129       REAL(wp) :: zcpu_end, zmpitime 
     139      REAL(wp) :: zcpu_end, zmpitime,zcpu_raw,zclock_raw 
    130140      ! 
    131141      s_wrk => NULL() 
     
    140150      CALL CPU_TIME( zcpu_end ) 
    141151 
    142       s_timer => s_timer_root 
    143       DO WHILE( TRIM(s_timer%cname) /= TRIM(cdinfo) )  
    144          IF( ASSOCIATED(s_timer%next) ) s_timer => s_timer%next 
    145       END DO 
     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 
    146161  
    147162      ! CPU time correction 
    148       s_timer%t_cpu  = zcpu_end - s_timer%t_cpu - t_overcpu - s_timer%tsub_cpu 
    149    
     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 
    150167      ! clock time correction 
    151168#if defined key_mpp_mpi 
    152       s_timer%t_clock = zmpitime - s_timer%t_clock - t_overclock - s_timer%tsub_clock 
     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 
    153171#else 
    154172      iperiods = ifinal_count - s_timer%ncount 
    155173      IF( ifinal_count < s_timer%ncount )  & 
    156           iperiods = iperiods + s_timer%ncount_max  
    157       s_timer%t_clock  = REAL(iperiods) / s_timer%ncount_rate - t_overclock - s_timer%tsub_clock 
     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 
    158177#endif 
     178 !     IF(s_timer%cname==trim('lbc_lnk_2d')) write(*,*) zclock_raw , s_timer%tsub_clock 
    159179       
    160180      ! Correction of parent section 
    161181      IF( .NOT. PRESENT(csection) ) THEN 
    162          s_wrk => s_timer 
    163          DO WHILE ( ASSOCIATED(s_wrk%parent_section ) ) 
    164             s_wrk => s_wrk%parent_section 
    165             s_wrk%tsub_cpu   = s_wrk%tsub_cpu   + s_timer%t_cpu  
    166             s_wrk%tsub_clock = s_wrk%tsub_clock + s_timer%t_clock               
    167          END DO 
     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 
    168186      ENDIF 
    169187             
     
    186204      s_timer%l_tdone = .TRUE. 
    187205      ! 
     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 
    188212   END SUBROUTINE timing_stop 
    189213  
     
    211235         WRITE(numtime,*) '                             NEMO team' 
    212236         WRITE(numtime,*) '                  Ocean General Circulation Model' 
    213          WRITE(numtime,*) '                        version 4.0  (2018) ' 
     237         WRITE(numtime,*) '                        version 3.6  (2015) ' 
    214238         WRITE(numtime,*) 
    215239         WRITE(numtime,*) '                        Timing Informations ' 
     
    239263      t_overcpu = t_overcpu - zdum         
    240264      t_overclock = t_overcpu + t_overclock         
     265      WRITE(*,*) 't_overcpu ', t_overcpu 
     266      WRITE(*,*) 't_overclock ', t_overclock 
     267      t_overcpu = 0. 
     268      t_overclock = 0.     
    241269 
    242270      ! Timing on date and time 
     
    263291      TYPE(timer), POINTER :: s_temp 
    264292      INTEGER :: idum, iperiods, icode 
     293      INTEGER :: ji 
    265294      LOGICAL :: ll_ord, ll_averep 
    266295      CHARACTER(len=120) :: clfmt             
    267        
     296      REAL(wp), DIMENSION(:), ALLOCATABLE ::   timing_glob 
     297      REAL(wp) ::   zsypd   ! simulated years per day (Balaji 2017) 
     298      REAL(wp) ::   zperc 
     299 
    268300      ll_averep = .TRUE. 
    269301     
     
    272304      t_cpu(2)   = t_cpu(2)    - t_cpu(1)   - t_overcpu 
    273305#if defined key_mpp_mpi 
     306      WRITE(*,*) 't_overclock ', t_overclock 
     307      WRITE(*,*) 't_elaps(1) ', t_elaps(1) 
     308      WRITE(*,*) 'MPI_WTIME() ', MPI_WTIME() 
    274309      t_elaps(2) = MPI_WTIME() - t_elaps(1) - t_overclock 
     310      WRITE(*,*) 't_elaps(2) ', t_elaps(2) 
    275311#else 
    276312      CALL SYSTEM_CLOCK(COUNT = nfinal_count) 
     
    340376      &       ctime(2)(1:2), ctime(2)(3:4), ctime(2)(5:6),   & 
    341377      &       czone(1:3),    czone(4:5) 
     378 
     379#if defined key_mpp_mpi 
     380      ALLOCATE(timing_glob(3*jpnij), stat=icode) 
     381      CALL MPI_GATHER( (/compute_time, waiting_time, elapsed_time/), 3, MPI_DOUBLE_PRECISION,   & 
     382         &                                              timing_glob, 3, MPI_DOUBLE_PRECISION, 0, MPI_COMM_OCE, icode) 
     383      IF( narea == 1 ) THEN 
     384         WRITE(numtime,*) ' ' 
     385         WRITE(numtime,*) ' Report on time spent on waiting MPI messages ' 
     386         WRITE(numtime,*) '    total timing measured between nit000+1 and nitend-1 ' 
     387         WRITE(numtime,*) '    warning: includes restarts writing time if output before nitend... ' 
     388         WRITE(numtime,*) ' ' 
     389         DO ji = 1, jpnij 
     390            zperc = timing_glob(3*ji-1) + timing_glob(3*ji-2) 
     391            IF (zperc /= 0. ) zperc = timing_glob(3*ji-1) / zperc * 100. 
     392            WRITE(numtime,'(A20,F11.6,            A34,I8)') 'Computing time : ',timing_glob(3*ji-2), ' on MPI rank : ', ji 
     393            WRITE(numtime,'(A20,F11.6,A2, F4.1,A3,A25,I8)') 'Waiting   time : ',timing_glob(3*ji-1)   & 
     394               &                                                         , ' (',      zperc,' %)',   ' on MPI rank : ', ji 
     395            zsypd = rn_rdt * REAL(nitend-nit000-1, wp) / (timing_glob(3*ji) * 365.) 
     396            WRITE(numtime,'(A20,F11.6,A7,F10.3,A2,A15,I8)') 'Total     time : ',timing_glob(3*ji  )   & 
     397               &                                                         , ' (SYPD: ', zsypd, ')',   ' on MPI rank : ', ji 
     398         END DO 
     399      ENDIF 
     400      DEALLOCATE(timing_glob) 
     401#endif       
    342402 
    343403      IF( lwriter ) CLOSE(numtime)  
     
    459519         sl_timer_ave_root%next => NULL() 
    460520         sl_timer_ave_root%prev => NULL() 
     521         ALLOCATE(sl_timer_ave) 
    461522         sl_timer_ave => sl_timer_ave_root             
    462523      ENDIF  
     
    490551         s_timer => s_timer%next 
    491552      END DO       
    492  
    493          WRITE(*,*) 'ARPDBG: timing: done gathers' 
    494553       
    495554      IF( narea == 1 ) THEN     
     
    514573            sl_timer_glob => sl_timer_glob%next                                 
    515574         END DO 
    516  
    517          WRITE(*,*) 'ARPDBG: timing: done computing stats' 
    518575       
    519576         ! reorder the averaged list by CPU time       
     
    567624      ENDIF 
    568625      ! 
    569       DEALLOCATE(sl_timer_glob_root%cname     , & 
    570                  sl_timer_glob_root%tsum_cpu  , & 
    571                  sl_timer_glob_root%tsum_clock, & 
    572                  sl_timer_glob_root%niter) 
    573       ! 
    574626      DEALLOCATE(sl_timer_glob_root) 
    575627      !                   
     
    676728         s_timer => s_timer_root 
    677729         ! 
     730         ALLOCATE(s_wrk) 
    678731         s_wrk => NULL() 
    679           
     732         ! 
     733         ALLOCATE(s_timer_old) 
     734         s_timer_old%cname       = cdinfo 
     735         s_timer_old%t_cpu      = 0._wp 
     736         s_timer_old%t_clock    = 0._wp 
     737         s_timer_old%tsum_cpu   = 0._wp 
     738         s_timer_old%tsum_clock = 0._wp 
     739         s_timer_old%tmax_cpu   = 0._wp 
     740         s_timer_old%tmax_clock = 0._wp 
     741         s_timer_old%tmin_cpu   = 0._wp 
     742         s_timer_old%tmin_clock = 0._wp 
     743         s_timer_old%tsub_cpu   = 0._wp 
     744         s_timer_old%tsub_clock = 0._wp 
     745         s_timer_old%ncount      = 0 
     746         s_timer_old%ncount_rate = 0 
     747         s_timer_old%ncount_max  = 0 
     748         s_timer_old%niter       = 0 
     749         s_timer_old%l_tdone  = .TRUE. 
     750         s_timer_old%next => NULL() 
     751         s_timer_old%prev => NULL() 
     752 
    680753      ELSE 
    681754         s_timer => s_timer_root 
    682755         ! case of already existing area (typically inside a loop) 
     756   !         write(*,*) 'in ini_var for routine : ', cdinfo 
    683757         DO WHILE( ASSOCIATED(s_timer) )  
    684             IF( TRIM(s_timer%cname) .EQ. TRIM(cdinfo) ) RETURN 
     758            IF( TRIM(s_timer%cname) .EQ. TRIM(cdinfo) ) THEN 
     759 !             write(*,*) 'in ini_var for routine : ', cdinfo,' we return'            
     760               RETURN ! cdinfo is already in the chain 
     761            ENDIF 
    685762            s_timer => s_timer%next 
    686763         END DO 
    687           
     764 
    688765         ! end of the chain 
    689766         s_timer => s_timer_root 
     
    691768            s_timer => s_timer%next 
    692769         END DO 
    693            
    694          ALLOCATE(s_timer%next)       
     770 
     771    !     write(*,*) 'after search', s_timer%cname 
     772         ! cdinfo is not part of the chain so we add it with initialisation           
     773          ALLOCATE(s_timer%next) 
     774    !     write(*,*) 'after allocation of next' 
     775   
    695776         s_timer%next%cname       = cdinfo 
    696777         s_timer%next%t_cpu      = 0._wp 
     
    713794         s_timer%next%next => NULL() 
    714795         s_timer => s_timer%next 
    715  
    716          ! are we inside a section 
    717          s_wrk => s_timer%prev 
    718          ll_section = .FALSE. 
    719          DO WHILE( ASSOCIATED(s_wrk) .AND. .NOT. ll_section ) 
    720             IF( .NOT. s_wrk%l_tdone ) THEN 
    721                ll_section = .TRUE. 
    722                s_timer%parent_section => s_wrk  
    723             ENDIF 
    724             s_wrk => s_wrk%prev 
    725          END DO  
    726       ENDIF          
    727       ! 
     796      ENDIF  
     797      !    write(*,*) 'after allocation' 
     798     ! 
    728799   END SUBROUTINE timing_ini_var 
    729800 
     
    738809!      IF(lwp) WRITE(numout,*) 'timing_reset : instrumented routines for timing' 
    739810!      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    740 !      CALL timing_list(s_timer_root) 
     811      CALL timing_list(s_timer_root) 
    741812!      WRITE(numout,*) 
    742813      ! 
Note: See TracChangeset for help on using the changeset viewer.