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)
!     ------------------------------------------------------------------

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

USE yomgstats  
!USE MPL_MODULE   ! MPL 28.11.08
USE yomoml

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) :: GETRSS, GETHWM, GETSTK, GETCURHEAP, GETPAG
EXTERNAL getrss, gethwm, getstk, getcurheap, getpag
REAL(KIND=JPRB) :: ZTIMED,ZCLOCK,ZTIME,ZTCPU,ZVCPU
REAL(KIND=JPRB) :: ZLAST_PAR_TIME
LOGICAL :: LLFIRST=.true.
LOGICAL :: LLMFIRST=.true.
  CHARACTER(LEN=32), SAVE :: CCDESC_DRHOOK(jpmaxstat)
  CHARACTER(LEN=32), SAVE :: CCDESC_BARR(jpmaxstat)
SAVE zlast_par_time
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

INTEGER(KIND=JPIM) :: NMAX_STATS, KULNAM

INTERFACE
#include "user_clock.h"
END INTERFACE

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

IF(lstats) THEN

  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 > 1000 .AND.KNUM < 2001).AND.(.NOT.LSTATS_OMP))GOTO 99999
!J  IF((KNUM > 500  .AND.KNUM < 1001).AND.(.NOT.LSTATS_COMMS))GOTO 99999
  IF(oml_my_thread() > 1)GOTO 99999

!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

  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)
! MPL 1.12.08 : erreur a la compilation car zhook_handle est un tableau et non un
! scalaire (PKEY)
      CALL dr_hook(ccdesc_drhook(knum),kswitch,ztime)
    ELSEIF(cctype(knum).EQ.'BAR')THEN
      CALL dr_hook(ccdesc_drhook(knum),kswitch,zhook_handle_barr)
    ENDIF
  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_jprb
    zvcpu = 0.0_jprb
  ENDIF

  IF (llfirst) THEN

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

    ncalls(:) = 0
    timesum(:) = 0.0_jprb
    timesqsum(:) = 0.0_jprb
    timemax(:) = 0.0_jprb
    timesumb(:) = 0.0_jprb
    ttcpusum(:) = 0.0_jprb
    tvcpusum(:) = 0.0_jprb
    timelcall(:) = zclock
    ccdesc=""
    cctype=""
    ntmem      = 0
    ntmem(:,5) = 99999999
    iimem=0
    iipag=0
    iimemc=0
    time_last_call = zclock
    zlast_par_time=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

  IF( kswitch == 0 ) THEN
! Start timing event
    IF(knum < 500) THEN
      ztimed = zclock-time_last_call
    ELSE
      ztimed = zclock - zlast_par_time
    ENDIF
    timesumb(knum) = timesumb(knum)+ztimed
    thistime(knum) = 0.0_jprb
    timelcall(knum) = zclock
    ttcpulcall(knum) = ztcpu
    tvcpulcall(knum) = zvcpu
    thistcpu(knum) = 0.0_jprb
    thisvcpu(knum) = 0.0_jprb
    IF(myproc_stats.LE.nstats_mem.AND.myproc_stats.NE.0) THEN
!     CALL getrss(IMEM)
!     IMEM = getrss()/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
  ELSEIF( kswitch == 1 ) THEN
! Finish timing event
    ztime = thistime(knum)+(zclock-timelcall(knum))
    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
!     CALL getrss(IMEM)
      imem = getrss()/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
  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)
  ELSEIF( kswitch == 3 ) THEN
! Resume timing event
    timelcall(knum) = zclock
    ttcpulcall(knum) = ztcpu
    tvcpulcall(knum) = zvcpu
  ENDIF
  time_last_call = zclock
  IF(knum > 500.OR.knum == 102.OR.knum == 103) zlast_par_time = zclock
!   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

ENDIF

99999 CONTINUE
END SUBROUTINE gstats