dr_hook_util.F90

Go to the documentation of this file.

SUBROUTINE dr_hook_util(LDHOOK,CDNAME,KCASE,PKEY,CDFILENAME,KSIZEINFO)
USE parkind1  ,ONLY : jpim     ,jprb    ,jprd
USE oml_mod,ONLY : oml_max_threads,oml_my_thread,oml_init
#ifdef SFX_MPI
USE mpl_init_mod, ONLY : mpl_init
USE mpl_arg_mod, ONLY : mpl_getarg
#endif
USE yomgstats, ONLY : last_knum,last_kswitch,ldetailed_stats,myproc_stats, &
                      nhook_messages,time_last_call
USE yomhookstack, ONLY : ll_thread_first,isave,imaxstack,cstack   ! For monitoring thread stack usage
#ifdef NAG
USE f90_unix_env, ONLY: getarg
#endif

IMPLICIT NONE
LOGICAL,INTENT(INOUT)       :: LDHOOK
CHARACTER(LEN=*),INTENT(IN) :: CDNAME,CDFILENAME
INTEGER(KIND=JPIM),INTENT(IN) :: KCASE,KSIZEINFO
REAL(KIND=JPRB),INTENT(INOUT) :: PKEY
#ifdef RS6K
INTEGER(KIND=JPIM) :: INEWMASK, IOLDMASK, UMASK
#endif
#ifdef CRAYXT
INTEGER(KIND=JPIM) :: IRET, SETVBUF3F
#endif
LOGICAL,SAVE :: LL_FIRST_TIME = .true.
CHARACTER(LEN=512) :: CLENV
INTEGER(KIND=JPIM) INUMTIDS, IMYTID
LOGICAL :: LLMPI
INTEGER*8 :: MAXMEM=0
INTEGER*8 :: GETMAXMEM
INTEGER*8 GETMAXLOC
LOGICAL :: LLFINDSUMB=.false.
REAL(KIND=JPRD) :: ZCLOCK
REAL(KIND=JPRB) :: ZDIFF
CHARACTER(LEN=7) CLSTR

INTEGER*8 ILOC         ! For monitoring thread stack usage
CHARACTER(LEN=3) CHEAP ! For monitoring heap usage
INTEGER          JHEAP ! For monitoring heap usage
DATA jheap/0/

#include "user_clock.h"


! -----------------------------------------------------------------

IF (.NOT.ldhook) RETURN

imytid = oml_my_thread()
inumtids = oml_max_threads()
IF (ll_first_time) THEN
  ll_first_time = .false.
#ifdef CRAYXT
  iret = setvbuf3f(0, 1, 0) ! Set unit#0 into line-buffering mode to avoid messy output
#endif
  CALL oml_init()
  CALL get_environment_variable('DR_HOOK_NOT_MPI',clenv)
  IF (clenv == ' ' .OR. clenv == '0' .OR. &
    & clenv == 'false' .OR. clenv == 'FALSE') THEN
    llmpi=.true.
#ifdef SFX_MPI
    CALL mpl_init(ldinfo=.false.) ! Do not produce any output
#endif
  ELSE
    llmpi=.false.
  ENDIF
  CALL get_environment_variable('DR_HOOK',clenv)
  IF (clenv == ' ' .OR. clenv == '0' .OR. &
    & clenv == 'false' .OR. clenv == 'FALSE') THEN
    ldhook = .false.
    CALL c_drhook_set_lhook(0)
  ENDIF
  IF (llmpi) THEN
#ifdef SFX_MPI
    CALL mpl_getarg(0, clenv)  ! Get executable name & also propagate args
#endif
  ELSE
    CALL getarg(0, clenv)
  ENDIF
  IF (.NOT.ldhook) RETURN
  
  CALL c_drhook_init(clenv, inumtids)

!JFH---Initialisation to monitor stack usage by threads-------------
  CALL get_environment_variable('DR_HOOK_STACKCHECK',cstack)
  IF (cstack == 'yes' .OR. cstack == 'YES' ) THEN
    IF(imytid == 1 ) THEN
      ALLOCATE(ll_thread_first(inumtids))
      ALLOCATE(isave(inumtids))
      ALLOCATE(imaxstack(inumtids))
      ll_thread_first=.true.
      isave=0
      imaxstack=0
    ENDIF
  ENDIF
!JFH------------ End ---------------------------------------------
!JFH---Initialisation to monitor heap usage-----------------------
  jheap=0
  CALL get_environment_variable('DR_HOOK_HEAPCHECK',cheap)
  IF (cheap == 'yes' .OR. cheap == 'YES' ) jheap=1
  IF (cheap == 'trb' .OR. cheap == 'TRB' ) jheap=2
  IF(imytid == 1) THEN
    IF(jheap>0) THEN
!     write(0,*) "HEAPCHECK=",CHEAP,JHEAP
      CALL setheapcheck()
    ENDIF
  ENDIF
!JFH------------ End ---------------------------------------------

ENDIF

!JFH---Code to monitor stack usage by threads---------------------
#ifndef NAG
IF (cstack == 'yes' .or. cstack == 'YES' ) THEN
  IF(imytid > 1) THEN
    IF(ll_thread_first(imytid))THEN 
      ll_thread_first(imytid)=.false.
      isave(imytid)=loc(llmpi)
    ENDIF
    iloc=loc(llmpi)
    IF(isave(imytid)-iloc > imaxstack(imytid)) THEN
      imaxstack(imytid)=isave(imytid)-iloc
      WRITE(0,'(A,I3,A,I12,2X,A)')"STACKCHECK Max stack usage by thread",imytid," =",imaxstack(imytid),cdname
    ENDIF
  ENDIF
ENDIF
#endif
!JFH------------ End ---------------------------------------------

IF (kcase == 0) THEN
  CALL c_drhook_start(cdname, imytid, pkey, cdfilename, ksizeinfo)
!JFH---Code to monitor heap usage -------------------------
  IF(imytid == 1 .AND. myproc_stats == 1 .AND. jheap>0) THEN
    getmaxmem=getmaxloc()
    IF(getmaxmem .GT. maxmem) THEN
      maxmem = getmaxmem
      WRITE(0,*) "HEAPCHECK Max heap at beg of routine =",maxmem," ",cdname
#ifdef RS6K
      IF(jheap == 2) CALL xl__trbk()
#endif
    ENDIF
  ENDIF
!JFH------------ End ---------------------------------------------
ELSE IF (kcase == 1) THEN
!JFH---Code to monitor heap usage -------------------------
  IF(imytid == 1 .AND. myproc_stats == 1 .AND. jheap>0) THEN
    getmaxmem=getmaxloc()
    IF(getmaxmem .GT. maxmem) THEN
      maxmem = getmaxmem
      WRITE(0,*) "HEAPCHECK Max heap at end of routine =",maxmem," ",cdname
#ifdef RS6K
      IF(jheap == 2) CALL xl__trbk()
#endif
    ENDIF
  ENDIF
!JFH------------ End ---------------------------------------------
  CALL c_drhook_end  (cdname, imytid, pkey, cdfilename, ksizeinfo)
ENDIF

!GM---Code to find gstats SUMB time-------------------------------
IF( ldetailed_stats .AND. llfindsumb )THEN
  IF( imytid==1 .AND. last_knum>=500 .AND. myproc_stats <= 2 )THEN
    IF( last_kswitch==1 .OR. last_kswitch==2 )THEN
      CALL user_clock(pelapsed_time=zclock)
      zdiff=zclock-time_last_call
      IF( zdiff > 0.1_jprb )THEN
        IF( kcase == 0 )THEN
          clstr='ENTERED'
        ELSE
          clstr='EXITED'
        ENDIF
        IF( nhook_messages < 100000 )THEN
          WRITE(0,'("DR_HOOK_UTIL: ",A,2X,A," TIMESUMB=",F10.6)')cdname,clstr,zdiff
          nhook_messages=nhook_messages+1
        ENDIF
      ENDIF
    ENDIF
  ENDIF
ENDIF
!GM------------ End ---------------------------------------------

END SUBROUTINE dr_hook_util