timers.F

Go to the documentation of this file.

#include "cppdefs.h"
      RECURSIVE SUBROUTINE wclock_on (ng, model, region, line, routine)
!
 
!git $Id$
!================================================== Hernan G. Arango ===
!  Copyright (c) 2002-2025 The ROMS Group                              !
!    Licensed under a MIT/X style license                              !
!    See License_ROMS.md                                               !
!=======================================================================
!                                                                      !
!  This routine turns on wall clock to meassure the elapsed time in    !
!  seconds spend by each parallel thread in requested model region.    !
!                                                                      !
!  On Input:                                                           !
!                                                                      !
!     ng         Nested grid number (integer)                          !
!     model      Calling model identifier (integer)                    !
!     region     Profiling reagion number (integer)                    !
!     line       Calling model routine line (integer)                  !
!     routine    Calling model routine (string)                        !
!                                                                      !
!=======================================================================
!
      USE mod_param
      USE mod_parallel
      USE mod_iounits
      USE mod_strings
 
#ifdef DISTRIBUTE
!
      USE distribute_mod, ONLY : mp_barrier
# ifdef ROMS_STDOUT
      USE distribute_mod, ONLY : mp_collect
# endif
#endif
!
      implicit none
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, model, region, line
 
      character (len=*), intent(in) :: routine
!
!  Local variable declarations.
!
      integer :: iregion, mymodel, nsub
 
      integer :: my_getpid
#ifndef DISTRIBUTE
      integer :: my_threadnum
#else
      integer :: mycomm, npets, petrank
# ifdef ROMS_STDOUT
      integer :: node
      integer, parameter :: pspv = 0
      integer, allocatable :: pids(:)
# endif
#endif
      real(r8), dimension(2) :: wtime
      real(r8) :: my_wtime
!
!-----------------------------------------------------------------------
!  Initialize timing for all threads.
!-----------------------------------------------------------------------
#ifdef TRACING
!
      IF (master) THEN
        WRITE (stdout,'(a,a)') '==> Entering ', trim(routine)
        FLUSH (stdout)
      END IF
#endif
!
!  Set number of subdivisions, same as for global reductions.
!
#ifdef DISTRIBUTE
# ifdef DISJOINTED
      mycomm=full_comm_world
      npets=fullsize
      petrank=fullrank
# else
      mycomm=ocn_comm_world
      npets=numthreads
      petrank=myrank
# endif
      nsub=1
#else
      nsub=numthreads
#endif
!
!  Insure that MyModel is not zero.
!
      mymodel=max(1,model)
!
!  Start the wall CPU clock for specified region, model, and grid.
!
      cstr(region,mymodel,ng)=my_wtime(wtime)
!
!  If region zero, indicating first call from main driver, initialize
!  time profiling arrays and set process ID.
!
      IF ((region.eq.0).and.(proc(1,mymodel,ng).eq.0)) THEN
        DO iregion=1,nregion
          cend(iregion,mymodel,ng)=0.0_r8
          csum(iregion,mymodel,ng)=0.0_r8
        END DO
        proc(1,mymodel,ng)=1
        proc(0,mymodel,ng)=my_getpid()
 
!$OMP CRITICAL (START_WCLOCK)
        IF (ng.eq.1) THEN
#ifdef DISTRIBUTE
          CALL mp_barrier (ng, model, mycomm)
# ifdef ROMS_STDOUT
          IF (.not.allocated(pids)) THEN
            allocate ( pids(npets) )
            pids=0
          END IF
          pids(petrank+1)=proc(0,mymodel,ng)
          CALL mp_collect (ng, model, npets, pspv, pids, mycomm)
          IF (master) THEN
            DO node=1,npets
              WRITE (stdout,10) ' Node #', node-1,                      &
     &                      ' (pid=',pids(node),') is active.'
            END DO
          END IF
          IF (allocated(pids)) deallocate (pids)
# else
          WRITE (stdout,10) ' Node #', petrank,                         &
     &                      ' (pid=',proc(0,mymodel,ng),') is active.'
# endif
          FLUSH (stdout)
#else
          WRITE (stdout,10) ' Thread #', mythread,                      &
     &                      ' (pid=',proc(0,mymodel,ng),') is active.'
#endif
        END IF
 10     FORMAT (a,i5,a,i8,a)
        thread_count=thread_count+1
        IF (thread_count.eq.nsub) thread_count=0
!$OMP END CRITICAL (START_WCLOCK)
      END IF
      RETURN
      END SUBROUTINE wclock_on
!
      RECURSIVE SUBROUTINE wclock_off (ng, model, region, line, routine)
!
!=======================================================================
!                                                                      !
!  This routine turns off wall clock to meassure the elapsed time in   !
!  seconds spend by each parallel thread in requested model region.    !
!                                                                      !
!  On Input:                                                           !
!                                                                      !
!     ng         Nested grid number (integer)                          !
!     model      Calling model identifier (integer)                    !
!     region     Profiling region number (integer)                     !
!     line       Calling model routine line (integer)                  !
!     routine    Calling model routine (string)                        !
!                                                                      !
!=======================================================================
!
      USE mod_param
      USE mod_parallel
      USE mod_iounits
      USE mod_strings
 
#ifdef DISTRIBUTE
!
      USE distribute_mod, ONLY : mp_barrier, mp_reduce
      USE distribute_mod, ONLY : mp_collect
      USE strings_mod,    ONLY : uppercase
#endif
!
      implicit none
!
!  Imported variable declarations.
!
      integer, intent(in) ::  ng, model, region, line
 
      character (len=*), intent(in) :: routine
!
!  Local variable declarations.
!
      integer :: ig, imodel, iregion, mymodel, nsub
#ifdef DISTRIBUTE
      integer :: mycomm, npets, petrank
# ifdef ROMS_STDOUT
      integer :: node
# endif
#endif
      integer :: my_threadnum
 
      real(r8) :: percent, sumcpu, sumper, sumsum, total
 
      real(r8), dimension(2) :: wtime
 
      real(r8) :: my_wtime
 
#ifdef DISTRIBUTE
      real(r8) :: tendmin, tendmax
 
      real(r8), parameter :: tspv = 0.0_r8
      real(r8), allocatable :: tend(:)
      real(r8), dimension(0:Nregion) :: rbuffer
 
      character (len= 3), dimension(0:Nregion) :: op_handle
#endif
      character (len=14), dimension(4) :: label
!
!-----------------------------------------------------------------------
!  Compute elapsed wall time for all threads.
!-----------------------------------------------------------------------
#ifdef TRACING
!
      IF (master) THEN
        WRITE (stdout,'(a,a)') '<== Exiting  ', trim(routine)
        FLUSH (stdout)
      END IF
#endif
!
!  Set number of subdivisions, same as for global reductions.
!
#ifdef DISTRIBUTE
# ifdef DISJOINTED
      mycomm=full_comm_world
      npets=fullsize
      petrank=fullrank
# else
      mycomm=ocn_comm_world
      npets=numthreads
      petrank=myrank
# endif
      nsub=1
#else
      nsub=numthreads
#endif
!
!  Insure that MyModel is not zero.
!
      mymodel=max(1,model)
!
!  Compute elapsed CPU time (seconds) for each profile region, except
!  for region zero which is called by the main driver before the
!  simulatiom is stopped.
!
      IF (region.ne.0) THEN
        cend(region,mymodel,ng)=cend(region,mymodel,ng)+                &
     &                          (my_wtime(wtime)-                       &
     &                           cstr(region,mymodel,ng))
      END IF
!
!-----------------------------------------------------------------------
!  If simulation is compleated, compute and report elapsed CPU time for
!  all regions.
!-----------------------------------------------------------------------
!
      IF ((region.eq.0).and.(proc(1,mymodel,ng).eq.1)) THEN
!
!  Computed elapsed wall time for the driver, region=0.  Since it is
!  called only once, "MyModel" will have a value and the other models
!  will be zero.
!
        cend(region,mymodel,ng)=cend(region,mymodel,ng)+                &
     &                          (my_wtime(wtime)-                       &
     &                           cstr(region,mymodel,ng))
        DO imodel=1,4
          proc(1,imodel,ng)=0
        END DO
 
!$OMP CRITICAL (FINALIZE_WCLOCK)
!
!  Report elapsed time (seconds) for each CPU.  We get the same time
!  time for all nested grids.
!
        IF (ng.eq.1) THEN
#ifdef DISTRIBUTE
          CALL mp_barrier (ng, model, mycomm)
          IF (.not.allocated(tend)) THEN
            allocate ( tend(npets) )
            tend=0.0_r8
          END IF
          tend(petrank+1)=cend(region,mymodel,ng)
          CALL mp_collect (ng, model, npets, tspv, tend, mycomm)
          tendmin=minval(tend)
          tendmax=maxval(tend)
# ifdef ROMS_STDOUT
          IF (master) THEN
            DO node=1,npets
               WRITE (stdout,10) ' Node   #', node-1,                   &
     &                           ' CPU:', tend(node)
            END DO
          END IF
# else
          WRITE (stdout,10) ' Node   #', petrank,                       &
     &                      ' CPU:', tend(petrank+1)
# endif
          FLUSH (stdout)
#else
          WRITE (stdout,10) ' Thread #', mythread, ' CPU:',             &
     &                      cend(region,mymodel,ng)
#endif
 10       FORMAT (a,i5,a,f12.3)
        END IF
!
!  Sum the elapsed time for each profile region by model.
!
        thread_count=thread_count+1
        DO imodel=1,4
          DO iregion=0,nregion
            csum(iregion,imodel,ng)=csum(iregion,imodel,ng)+            &
     &                              cend(iregion,imodel,ng)
          END DO
        END DO
!
!  Compute total elapsed CPU wall time between all parallel processes.
!
        IF (thread_count.eq.nsub) THEN
          thread_count=0
#ifdef DISTRIBUTE
          op_handle(0:nregion)='SUM'      ! Gather all values using a
          DO imodel=1,4                   ! reduced sum between nodes
            DO iregion=0,nregion
              rbuffer(iregion)=csum(iregion,imodel,ng)
            END DO
            CALL mp_reduce (ng, mymodel, nregion+1, rbuffer(0:),        &
     &                      op_handle(0:), mycomm)
            DO iregion=0,nregion
              csum(iregion,imodel,ng)=rbuffer(iregion)
            END DO
          END DO
#endif
          IF (master) THEN
            IF (ng.eq.1) THEN             ! Same for all nested grids
              total_cpu=total_cpu+csum(region,model,ng)
            END IF
            DO imodel=1,4
              total_model(imodel)=0.0_r8
              DO iregion=1,nregion
                total_model(imodel)=total_model(imodel)+                &
     &                              csum(iregion,imodel,ng)
              END DO
            END DO
            IF (ng.eq.1) THEN
              WRITE (stdout,20) ' Total:', total_cpu
 20           FORMAT (a,t18,f14.3)
              IF (numthreads.gt.1) THEN
                WRITE (stdout,20) ' Average:', total_cpu/numthreads
#ifdef DISTRIBUTE
                WRITE (stdout,20) ' Minimum:', tendmin
                WRITE (stdout,20) ' Maximum:', tendmax
#endif
              END IF
            END IF
          END IF
 
#ifdef DISTRIBUTE
          IF (allocated(tend)) deallocate (tend)
#endif
 
#ifdef PROFILE
!
!  Report profiling times.
!
          label(inlm)='Nonlinear     '
          label(itlm)='Tangent linear'
          label(irpm)='Representer   '
          label(iadm)='Adjoint       '
          DO imodel=1,4
            IF (master.and.(total_model(imodel).gt.0.0_r8)) THEN
              WRITE (stdout,30) trim(label(imodel)),                    &
     &                          'model elapsed CPU time profile, Grid:',&
     &                          ng
 30           FORMAT (/,1x,a,1x,a,1x,i2.2/)
            END IF
            sumcpu=0.0_r8
            sumper=0.0_r8
            DO iregion=1,mregion-1
              IF (master.and.(csum(iregion,imodel,ng).gt.0.0_r8)) THEN
                percent=100.0_r8*csum(iregion, imodel,ng)/total_cpu
                WRITE (stdout,40) pregion(iregion),                     &
     &                            csum(iregion,imodel,ng), percent
                sumcpu=sumcpu+csum(iregion,imodel,ng)
                sumper=sumper+percent
              END IF
            END DO
            ctotal=ctotal+sumcpu
 40         FORMAT (2x,a,t53,f14.3,2x,'(',f7.4,' %)')
            IF (master.and.(total_model(imodel).gt.0.0_r8)) THEN
              WRITE (stdout,50) sumcpu, sumper
 50           FORMAT (t47,'Total:',f14.3,2x,f8.4,' %')
            END IF
          END DO
!
!  Sometimes the profiling does not fully accounts for all the CPU
!  spend outside of the ROMS kernels. In data assimilation algorithms,
!  there is a lot of CPU expend outside the kernels. A separated
!  profiling is reported bellow.
!
          IF (master.and.(ng.eq.ngrids)) THEN
            percent=100.0_r8*ctotal/total_cpu
            WRITE (stdout,60) ctotal, percent,                          &
     &                        total_cpu-ctotal, 100.0_r8-percent
 60         FORMAT (/,2x,                                               &
     &             'Unique kernel(s) regions profiled ................',&
     &               f14.3,2x,f8.4,' %'/,2x,                            &
     &             'Residual, non-profiled code ......................',&
     &               f14.3,2x,f8.4,' %'/)
            WRITE (stdout,70) total_cpu
 70         FORMAT (/,' All percentages are with respect to',           &
     &                ' total time =',5x,f12.3,/)
          END IF
 
# ifdef FOUR_DVAR
!
!  Report elapsed time for 4D-Var algorithms.
!
          total=0.0_r8
          DO iregion=fregion,nregion-3
            DO imodel=1,4
              total=total+csum(iregion,imodel,ng)
            END DO
          END DO
          IF (master.and.(total.gt.0.0_r8)) THEN
            WRITE (stdout,30) 'Variational',                            &
     &                        'data assimilation profile, Grid:', ng
          END IF
          IF (total.gt.0.0_r8) THEN
            sumper=0.0_r8
            sumsum=0.0_r8
            DO iregion=fregion,nregion-3
              sumcpu=0.0_r8
              DO imodel=1,4
                sumcpu=sumcpu+csum(iregion,imodel,ng)
              END DO
              IF (master.and.(sumcpu.gt.0.0_r8)) THEN
                percent=100.0_r8*sumcpu/total_cpu
                WRITE (stdout,40) pregion(iregion), sumcpu, percent
                sumsum=sumsum+sumcpu
                sumper=sumper+percent
              END IF
            END DO
            IF (master.and.(total.gt.0.0_r8)) THEN
              WRITE (stdout,80) sumsum
 80           FORMAT (t47,'Total:',f14.3)
            END IF
          END IF
!
!  The background, increment, and analysis should be close to 100
!  percent.  The are listed last in Pregion.
!
          total=0.0_r8
          DO iregion=nregion-2,nregion
            DO imodel=1,4
              total=total+csum(iregion,imodel,ng)
            END DO
          END DO
          IF (master.and.(total.gt.0.0_r8)) THEN
            WRITE (stdout,'(1x)')
          END IF
          IF (total.gt.0.0_r8) THEN
            sumper=0.0_r8
            sumsum=0.0_r8
            DO iregion=nregion-2,nregion
              sumcpu=0.0_r8
              DO imodel=1,4
                sumcpu=sumcpu+csum(iregion,imodel,ng)
              END DO
              IF (master.and.(sumcpu.gt.0.0_r8)) THEN
                percent=100.0_r8*sumcpu/total_cpu
                WRITE (stdout,40) pregion(iregion), sumcpu, percent
                sumsum=sumsum+sumcpu
                sumper=sumper+percent
              END IF
            END DO
            IF (master.and.(total.gt.0.0_r8)) THEN
              WRITE (stdout,50) sumsum, sumper
            END IF
          END IF
# endif
# ifdef DISTRIBUTE
!
!  Report elapsed time for message passage communications.
!
          total=0.0_r8
          DO iregion=mregion,fregion-1
            DO imodel=1,4
              total=total+csum(iregion,imodel,ng)
            END DO
          END DO
          IF (master.and.(total.gt.0.0_r8)) THEN
            WRITE (stdout,30) uppercase('mpi'),                         &
     &                        'communications profile, Grid:', ng
          END IF
          IF (total.gt.0.0_r8) THEN
            sumper=0.0_r8
            sumsum=0.0_r8
            DO iregion=mregion,fregion-1
              sumcpu=0.0_r8
              DO imodel=1,4
                sumcpu=sumcpu+csum(iregion,imodel,ng)
              END DO
              IF (master.and.(sumcpu.gt.0.0_r8)) THEN
                percent=100.0_r8*sumcpu/total_cpu
                WRITE (stdout,40) pregion(iregion), sumcpu, percent
                sumsum=sumsum+sumcpu
                sumper=sumper+percent
              END IF
            END DO
            IF (master.and.(total.gt.0.0_r8)) THEN
              WRITE (stdout,50) sumsum, sumper
            END IF
          END IF
 
#  ifdef NESTING
!
!  Report total elapsed time for message passage communications for
!  all nested grids.
!
          IF (ng.eq.ngrids) THEN
            total=0.0_r8
            DO ig=1,ngrids
              DO iregion=mregion,fregion-1
                DO imodel=1,4
                  total=total+csum(iregion,imodel,ig)
                END DO
              END DO
            END DO
            IF (master.and.(total.gt.0.0_r8)) THEN
               WRITE (stdout,90) uppercase('mpi'),                      &
     &                'communications profile over all nested grids:'
 90            FORMAT (/,1x,a,1x,a,/)
            END IF
            IF (total.gt.0.0_r8) THEN
              sumper=0.0_r8
              sumsum=0.0_r8
              DO iregion=mregion,fregion-1
                sumcpu=0.0_r8
                DO ig=1,ngrids
                  DO imodel=1,4
                    sumcpu=sumcpu+csum(iregion,imodel,ig)
                  END DO
                END DO
                IF (master.and.(sumcpu.gt.0.0_r8)) THEN
                  percent=100.0_r8*sumcpu/total_cpu
                  WRITE (stdout,40) pregion(iregion), sumcpu, percent
                  sumsum=sumsum+sumcpu
                  sumper=sumper+percent
                END IF
              END DO
              IF (master.and.(total.gt.0.0_r8)) THEN
                WRITE (stdout,50) sumsum, sumper
              END IF
            END IF
          END IF
#  endif
# endif
#endif
        END IF
!$OMP END CRITICAL (FINALIZE_WCLOCK)
      END IF
      RETURN
      END SUBROUTINE wclock_off