gstats.F90

Go to the documentation of this file.

SUBROUTINE gstats(KNUM,KSWITCH)

!**** *GSTATS*  - Gather timing statistics

!     PURPOSE.
!     --------
!       To gather timings for subsequent output by routine STATS_OUTPUT 


!**   INTERFACE.
!     ----------
!       *CALL* *GSTATS(KNUM,KSWITCH)

!        EXPLICIT ARGUMENTS
!        --------------------
!        KNUM - timing event number (for list of already defined events
!               see routine STATS_OUTPUT)
!        KSWITCH  - KSWITCH=0 - switch on timer
!                   KSWITCH=1 - switch off timer
!                   KSWITCH=2 - suspend timer
!                   KSWITCH=3 - resume  timer

!        IMPLICIT ARGUMENTS
!        --------------------
!        Module YOMSTATS

!     METHOD.
!     -------


!     EXTERNALS.   USER_CLOCK - timing routine
!     ----------   MPL_BARRIER - syncronization of processors

!     REFERENCE.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     AUTHOR.
!     -------
!        Mats Hamrud ECMWF

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 98-11-15
!        D.Salmond: 02-02-25  Return if not master thread when called from a 
!                             parallel region. 
!        J.Hague:   03-06-11  Memory tracing (for NSTATS_MEM MPI tasks)
!        G.Mozdzynski: 18 Apr 2008 Many corrections to gstats,
!                             see LLFINDSUMB - when set is used detect gstat counter problems.
!        G.Mozdzynski: 20 Jan 2010 Further corrections to gstats to get timed sections and
!                             SUMB to 100 percent of the total time.
!      F. Vana  05-Mar-2015  Support for single precision
!     ------------------------------------------------------------------

USE parkind1  ,ONLY : jprd, jpim     ,jprb     ,jpib
USE yomhook   ,ONLY : lhook, dr_hook

USE yomgstats 
#ifdef SFX_MPI
USE mpl_module
USE mpl_stats_mod
#endif
USE oml_mod

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN) :: KNUM
INTEGER(KIND=JPIM),INTENT(IN) :: KSWITCH

INTEGER(KIND=JPIM) :: IMOD,ICALL
INTEGER(KIND=JPIM) :: IIMEM, IIPAG, IIMEMC
INTEGER(KIND=JPIB) :: IMEM, IMEMH, IMEMS, IMEMC, IPAG, INUM
INTEGER(KIND=JPIB) :: GETMAXRSS, GETHWM, GETSTK, GETCURHEAP, GETPAG
EXTERNAL getmaxrss, gethwm, getstk, getcurheap, getpag
REAL(KIND=JPRD) :: ZTIMED,ZCLOCK,ZCLOCK1,ZTIME,ZTCPU,ZVCPU
LOGICAL :: LLFIRST=.true.
LOGICAL :: LLMFIRST=.true.
  CHARACTER(LEN=32), SAVE :: CCDESC_DRHOOK(jpmaxstat)
  CHARACTER(LEN=32), SAVE :: CCDESC_BARR(jpmaxstat)
SAVE iimem, iipag, iimemc

INTEGER(KIND=JPIM),SAVE :: NUM_THREADS
REAL(KIND=JPRB),ALLOCATABLE,SAVE :: ZHOOK_HANDLE(:)
REAL(KIND=JPRB),SAVE :: ZHOOK_HANDLE_COMMS, ZHOOK_HANDLE_COMMS1
REAL(KIND=JPRB),SAVE :: ZHOOK_HANDLE_TRANS
REAL(KIND=JPRB),SAVE :: ZHOOK_HANDLE_BARR
CHARACTER*4 CC

CHARACTER (LEN = 10) ::  CLDATEOD,CLZONEOD
INTEGER(KIND=JPIM) :: IVALUES(8)

INTEGER(KIND=JPIM) :: NMAX_STATS, KULNAM

! Change LLFINDSUMB to TRUE to add diagnostics to help find SUMB times
! Note that a similar setting exists in dr_hook_util for the same objective
LOGICAL :: LLFINDSUMB=.false.
INTEGER(KIND=JPIM),SAVE :: ISUMBSTACK(10)
INTEGER(KIND=JPIM) :: J
REAL(KIND=JPRB) :: ZSUM,ZSUMB,ZTOT
REAL(KIND=JPRD)    :: SBYTES,RBYTES
INTEGER(KIND=JPIM) :: NSEND,NRECV

#include "user_clock.h"

! write(0,*) "GSTATS:LSTATS,JPMAXSTAT,LGSTATS_LABEL,KNUM=",LSTATS,JPMAXSTAT,LGSTATS_LABEL,KNUM

IF(lstats) THEN

! only process gstats calls for master thread

  IF(oml_my_thread() > 1)GOTO 99999

  IF(.NOT.ALLOCATED(zhook_handle))THEN
    num_threads=oml_max_threads()
    ALLOCATE(zhook_handle(num_threads))
  ENDIF

  IF(lgstats_label)THEN
    DO inum=1,jpmaxstat
      WRITE(cc,'(I4)')inum
      ccdesc_barr(inum)='>BAR-'//ccdesc(inum)(1:21)//'('//cc//')'
    ENDDO
    DO inum=1,jpmaxstat
      WRITE(cc,'(I4)')inum
!     write(6,*) inum,cctype(inum)
      IF(cctype(inum).EQ."TRS".OR.cctype(inum).EQ.'MP-'.OR.cctype(inum).EQ.'MPL'&
                            & .OR.cctype(inum).EQ.'BAR'.OR.cctype(inum).EQ.'OMP') THEN
        ccdesc_drhook(inum)='>'//cctype(inum)//'-'//ccdesc(inum)(1:21)//'('//cc//')'
      ENDIF
    ENDDO
    lgstats_label=.false.
  ENDIF
!     ------------------------------------------------------------------

!J  IF(KNUM/=0) THEN
!J    IF(LSYNCSTATS .AND.(KSWITCH==0.OR. KSWITCH==2)) THEN
!J      IF(.NOT.OML_IN_PARALLEL().AND. KNUM < 500 )THEN
!J        IF(LHOOK)CALL DR_HOOK(CCDESC_BARR(KNUM),0,ZHOOK_HANDLE_BARR)
!J        CALL MPL_BARRIER(CDSTRING='GSTATS:')
!J        IF(LHOOK)CALL DR_HOOK(CCDESC_BARR(KNUM),1,ZHOOK_HANDLE_BARR)
!J      ENDIF
!J    ENDIF
!J  ENDIF

  CALL user_clock(pelapsed_time=zclock)
  IF (lstatscpu.OR.knum==0) THEN
    CALL user_clock(ptotal_cp=ztcpu,pvector_cp=zvcpu)
  ELSE
    ztcpu = 0.0_jprd
    zvcpu = 0.0_jprd
  ENDIF

  IF (llfirst) THEN
    timesum(:) = 0.0_jprd
    ncalls(:) = 0
  ENDIF

  IF (lhook .AND. (kswitch == 0 .OR. kswitch == 1)) THEN
!   write(0,*) "KNUM,SWITCH=",KNUM,KSWITCH
!   write(0,*) "CCTYPE=",CCTYPE(KNUM)
!   write(0,*) "CCDESC_DRHOOK=",CCDESC_DRHOOK(KNUM)
    IF(cctype(knum).EQ."TRS")THEN
      CALL dr_hook(ccdesc_drhook(knum),kswitch,zhook_handle_trans)
    ELSEIF(cctype(knum).EQ.'MP-')THEN
      CALL dr_hook(ccdesc_drhook(knum),kswitch,zhook_handle_comms)
    ELSEIF(cctype(knum).EQ.'MPL'.AND.knum.NE.682)THEN
      CALL dr_hook(ccdesc_drhook(knum),kswitch,zhook_handle_comms1)
    ELSEIF(cctype(knum).EQ.'OMP')THEN
      CALL dr_hook(ccdesc_drhook(knum),kswitch,zhook_handle)
    ELSEIF(cctype(knum).EQ.'BAR')THEN
      CALL dr_hook(ccdesc_drhook(knum),kswitch,zhook_handle_barr)
    ENDIF
! measure GSTATS HOOK overhead
    CALL user_clock(pelapsed_time=zclock1)
    timesum(401) = timesum(401)+zclock1-zclock
    ncalls(401) = ncalls(401)+1
    zclock=zclock1
  ENDIF

  IF (llfirst) THEN

!   write(0,*) "JPMAXSTAT:2=",JPMAXSTAT

    nswitchval(:) = -1
    timesqsum(:) = 0.0_jprd
    timemax(:) = 0.0_jprd
    timesumb(:) = 0.0_jprd
    IF( llfindsumb )THEN
      isumbstack(:)=0
    ENDIF
    ttcpusum(:) = 0.0_jprd
    tvcpusum(:) = 0.0_jprd
    timelcall(:) = zclock
    ccdesc=""
    cctype=""
    ntmem      = 0
    ntmem(:,5) = 99999999
    iimem=0
    iipag=0
    iimemc=0
    time_last_call = zclock
    llfirst = .false.
  ENDIF

  IF(knum < 0.OR. knum > jpmaxstat) CALL abor1('GSTATS')
  IF(kswitch == 0.OR. kswitch == 1) THEN
    ncalls(knum) = ncalls(knum)+1
  ENDIF
  imod = mod(ncalls(knum),2)
  IF(.NOT.((kswitch == 0.AND. imod == 1) .OR.&
   &(kswitch == 2.AND. imod == 1) .OR.&
   &(kswitch == 3.AND. imod == 1) .OR.&
   &(kswitch == 1.AND. imod == 0))) THEN
    WRITE(jperr,*) 'KNUM,KSWITCH,IMOD,NCALLS(KNUM)',&
     &knum,kswitch,imod,ncalls(knum)
    CALL abor1('GSTATS')
  ENDIF

! WRITE(0,'("GSTATS(SUMB): ",I4,2X,I1,2X,A40)') KNUM,KSWITCH,CCDESC(KNUM)

  nswitchval(knum)=kswitch

  IF( kswitch == 0 ) THEN
! Start timing event
    IF(knum>=500)THEN
      ztimed = zclock-time_last_call
      timesumb(knum) = timesumb(knum)+ztimed
    ELSE
      ztimed = 0.0_jprd
    ENDIF

    IF( llfindsumb .AND. myproc_stats <= 2 )THEN
!     diagnostic code to find source of sumb (this should only be activated temporarily)
      DO j=9,1,-1
        isumbstack(j+1)=isumbstack(j)
      ENDDO
      isumbstack(1)=knum
      IF( ztimed > 0.1_jprd .AND. (timesumb(knum) > 1.0_jprd) )THEN
        WRITE(0,'("GSTATS(SUMB): KNUM=",I4," ZTIMED=",F10.6," TIMESUMB=",F10.6)')&
        & knum,ztimed,timesumb(knum)
        DO j=1,10
          IF( isumbstack(j) > 0 )THEN
            WRITE(0,'("GSTATS(SUMB): ",I4,2X,I8,2X,A40)')isumbstack(j),&
             & ncalls(isumbstack(j)),ccdesc(isumbstack(j))
          ENDIF
        ENDDO
      ENDIF
!     check if grouped counters are overlapping
      DO j=0,jpmaxstat
        IF( j /= knum )THEN
          IF( cctype(j   )/='   '.AND.cctype(j   )/='TRS'.AND.cctype(j   )/='MP-' .AND.&
           &  cctype(knum)/='   '.AND.cctype(knum)/='TRS'.AND.cctype(knum)/='MP-' )THEN
            IF( nswitchval(j)==0.OR.nswitchval(j)==3 )THEN
              WRITE(0,'("GSTATS(SUMB): OVERLAPPING COUNTERS ",I4,2X,I4)')knum,j
            ENDIF
          ENDIF
        ENDIF
      ENDDO
    ENDIF

    thistime(knum) = 0.0_jprd
    timelcall(knum) = zclock
    ttcpulcall(knum) = ztcpu
    tvcpulcall(knum) = zvcpu
    thistcpu(knum) = 0.0_jprd
    thisvcpu(knum) = 0.0_jprd
    IF(myproc_stats.LE.nstats_mem.AND.myproc_stats.NE.0) THEN
      imem = getmaxrss()/1024
      ipag = getpag()
      imemh = gethwm()/1024
      imems = getstk()/1024
      imemc = 0
      IF(lstats_alloc) imemc = getcurheap()/1024
      IF(imem > iimem.OR.ipag > iipag.OR.(lstats_alloc.AND.(imemc.NE.iimemc))) THEN
        IF(llmfirst) THEN
          WRITE(0,*) ".---------------------------------------------------------"
          WRITE(0,*) "| Memory trace details"
          WRITE(0,*) "| --------------------"
          WRITE(0,*) "| Memory examined at each GSTATS call if NSTATS_MEM>0."
          WRITE(0,*) "| Header for each trace line is:"    
          WRITE(0,*) "|"
          WRITE(0,*) "|   RSS_INC: Increase in RSS_MAX (KB)"
          WRITE(0,*) "|   RSS_MAX: Maximum real working set so far (KB)"
          WRITE(0,*) "|   HEAP_MX: High Water Mark for heap so far (KB)"
          WRITE(0,*) "|   STK:     Current Stack usage (KB)"
          WRITE(0,*) "|   PGS:     Page faults w I/O since last trace line"
          WRITE(0,*) "|   CALL:    Number of gstats call"
          WRITE(0,*) "|   HEAP:    Current malloc'd total (KB)"
          WRITE(0,*) "|" 
          WRITE(0,*) "| Trace line written for NSTATS_MEM MPI tasks if RSS_MAX"
          WRITE(0,*) "| RSS_MAX increases, PGS>0, or HEAP changed"
          WRITE(0,*) "| (if LTATS_ALLOC=.TRUE.)"
          WRITE(0,*) "`---------------------------------------------------------"
          WRITE(0,*) ""
          WRITE(0,'(A10,A5,21X,A7,2A8,A7,A5,A5,A8)') &
           & "MEMORY    "," KNUM","RSS_INC"," RSS_MAX"," HEAP_MX","    STK", &
           & "  PGS"," CALL","    HEAP"
          llmfirst=.false.
        ENDIF
        WRITE(0,'(A10,I5,1X,A20,1X,I6,2(1X,I7),1X,I6,1X,I4,1X,I4,1X,I7)') &
             & "MEMORY bfr",knum,ccdesc(knum),imem-iimem,imem,imemh,imems, &
             & ipag-iipag,(ncalls(knum)+1)/2,imemc
      ENDIF
      ntmem(knum,2)=imem
      iimem=imem
      iipag=ipag
      iimemc=imemc
    ENDIF
#ifdef SFX_MPI
    IF(lstats_mpl.AND.cctype(knum) .EQ. 'MPL') THEN
      CALL mpl_statson(nsend,sbytes,nrecv,rbytes)
      unknown_numsend(knum)=unknown_numsend(knum)+nsend
      unknown_numrecv(knum)=unknown_numrecv(knum)+nrecv
      unknown_sendbytes(knum)=unknown_sendbytes(knum)+sbytes
      unknown_recvbytes(knum)=unknown_recvbytes(knum)+rbytes
    ENDIF
#endif
  ELSEIF( kswitch == 1 ) THEN
! Finish timing event
    ztime = thistime(knum)+(zclock-timelcall(knum))
#ifdef SFX_MPI
    IF(lstats_mpl.AND.cctype(knum) .EQ. 'MPL') THEN
      CALL mpl_statsread(nsend,sbytes,nrecv,rbytes)
      numsend(knum)=numsend(knum)+nsend
      numrecv(knum)=numrecv(knum)+nrecv
      sendbytes(knum)=sendbytes(knum)+sbytes
      recvbytes(knum)=recvbytes(knum)+rbytes
    ENDIF
#endif
    timesum(knum) = timesum(knum)+ztime
    timesqsum(knum) = timesqsum(knum)+ztime**2
    timemax(knum) = max(timemax(knum),ztime)
    ttcpusum(knum) = ttcpusum(knum)+thistcpu(knum)+ztcpu-ttcpulcall(knum)
    tvcpusum(knum) = tvcpusum(knum)+thisvcpu(knum)+zvcpu-tvcpulcall(knum)
    IF(myproc_stats.LE.nstats_mem.AND.myproc_stats.NE.0) THEN
      imem = getmaxrss()/1024
      ipag = getpag()
      imemh = gethwm()/1024
      imems = getstk()/1024
      imemc = 0
      IF(lstats_alloc) imemc = getcurheap()/1024
      IF(imem > iimem.OR.ipag > iipag.OR.(lstats_alloc.AND.(imemc.NE.iimemc))) THEN
        WRITE(0,'(A10,I5,1X,A20,1X,I6,2(1X,I7),1X,I6,1X,I4,1X,I4,1X,I7)') &
             & "MEMORY aft ",knum,ccdesc(knum),imem-iimem,imem,imemh,imems, &
             & ipag-iipag,ncalls(knum)/2,imemc
      ENDIF
      iimem=imem
      iipag=ipag
      iimemc=imemc 
      imem=imem-ntmem(knum,2)
      ntmem(knum,4)=ntmem(knum,4)+imem
      IF(imem > ntmem(knum,1)) THEN
        ntmem(knum,1)=imem
        ntmem(knum,3)=ncalls(knum)
      ENDIF
      IF(imem < ntmem(knum,5)) ntmem(knum,5)=imem
    ENDIF
! Save counters that result in large delays
    IF( knum >= 500 .AND. ncalls(knum)/2 > 10 )THEN
      IF( ztime > timesum(knum)/float(ncalls(knum)/2) + 0.2_jprd )THEN
        ! ignore counters 1007 and 1013 due to NFRLW frequency LW radiation calls 
        ! in ec_phys_tl and ec_phys_ad call trees
        ! also ignore 635 and 636 due to increasing sujbwavallo matrix sizes
        IF( knum /= 1007 .AND. knum /= 1013 .AND. knum /= 635 .AND. knum /= 636 )THEN
          IF( ndelay_index < jpmaxdelays )THEN
            ndelay_index=ndelay_index+1
            ndelay_counter(ndelay_index)=knum
            tdelay_value(ndelay_index)=ztime-timesum(knum)/float(ncalls(knum)/2)
            CALL date_and_time(cldateod,cdelay_time(ndelay_index),clzoneod,ivalues)
          ENDIF
        ENDIF
      ENDIF
    ENDIF
  ELSEIF( kswitch == 2 ) THEN
! Suspend timing event
    ztimed = zclock-timelcall(knum)
    thistime(knum) = thistime(knum)+ztimed
    thistcpu(knum) = thistcpu(knum)+ztcpu-ttcpulcall(knum)
    thisvcpu(knum) = thisvcpu(knum)+zvcpu-tvcpulcall(knum)
#ifdef SFX_MPI
    IF(lstats_mpl.AND.cctype(knum) .EQ. 'MPL') THEN
      CALL mpl_statsread(nsend,sbytes,nrecv,rbytes)
      numsend(knum)=numsend(knum)+nsend
      numrecv(knum)=numrecv(knum)+nrecv
      sendbytes(knum)=sendbytes(knum)+sbytes
      recvbytes(knum)=recvbytes(knum)+rbytes
    ENDIF
#endif
  ELSEIF( kswitch == 3 ) THEN
! Resume timing event
    timelcall(knum) = zclock
    ttcpulcall(knum) = ztcpu
    tvcpulcall(knum) = zvcpu
#ifdef SFX_MPI
    IF(lstats_mpl.AND.cctype(knum) .EQ. 'MPL') THEN
      CALL mpl_statson(nsend,sbytes,nrecv,rbytes)
      unknown_numsend(knum)=unknown_numsend(knum)+nsend
      unknown_numrecv(knum)=unknown_numrecv(knum)+nrecv
      unknown_sendbytes(knum)=unknown_sendbytes(knum)+sbytes
      unknown_recvbytes(knum)=unknown_recvbytes(knum)+rbytes
    ENDIF
#endif
    IF(knum>=500)THEN
      ztimed = zclock-time_last_call
      timesumb(knum) = timesumb(knum)+ztimed
    ENDIF
  ENDIF
  IF(knum >= 500)THEN
    time_last_call = zclock
  ENDIF

!   Trace stats
  ncalls_total = ncalls_total+1
  IF (ltrace_stats .AND. ncalls_total <= ntrace_stats) THEN
    icall = ncalls_total
    time_trace(icall) = zclock
    ncall_trace(icall) = (jpmaxstat+1)*kswitch+knum
  ENDIF

! measure gstats overhead
  CALL user_clock(pelapsed_time=zclock1)
  timesum(400) = timesum(400)+zclock1-zclock
  ncalls(400) = ncalls(400)+1
  last_kswitch=kswitch
  last_knum=knum

! ZSUM=SUM(TIMESUM(500:JPMAXSTAT))
! ZSUMB=SUM(TIMESUMB(500:JPMAXSTAT))
! ZTOT=ZCLOCK1-TIMELCALL(0)
! IF( (ZSUM+ZSUMB)/ZTOT >1.0_JPRB )THEN
!   write(0,'("GSTATS_DEBUG: KNUM=",I6," KSWITCH=",I1," (zsum+zsumb)/ztot=",F10.6)')&
!    &KNUM,KSWITCH,(zsum+zsumb)/ztot
! ENDIF
  
ENDIF

99999 CONTINUE
END SUBROUTINE gstats