prg_nvtx_mod.F90

Go to the documentation of this file.

module prg_nvtx_mod
  use iso_c_binding
  implicit none
 
 
  integer(4),private :: col(7) = [ int(z'0000ff00',4), int(z'000000ff',4), &
  & int(z'00ffff00',4), int(z'00ff00ff',4), int(z'0000ffff',4), &
  & int(z'00ff0000',4), int(z'00ffffff',4)]
  character(kind=c_char,len=256),private,target :: tempname
 
  type, bind(C):: nvtxEventAttributes
     integer(C_INT16_T):: version=1
     integer(C_INT16_T):: size=48 !
     integer(C_INT):: category=0
     integer(C_INT):: colortype=1 ! NVTX_COLOR_ARGB = 1
     integer(C_INT):: color
     integer(C_INT):: payloadtype=0 ! NVTX_PAYLOAD_UNKNOWN = 0
     integer(C_INT):: reserved0
     integer(C_INT64_T):: payload   ! union uint,int,double
     integer(C_INT):: messagetype=1  ! NVTX_MESSAGE_TYPE_ASCII     = 1
     type(c_ptr):: message  ! ascii char
  end type nvtxeventattributes
 
#if defined(USE_NVTX)
  interface gpmdrangepush
     ! push range with custom label and standard color
     subroutine gpmdrangepusha(name) bind(C, name='nvtxRangePushA')
       use iso_c_binding
       character(kind=C_CHAR,len=*) :: name
     end subroutine gpmdrangepusha
 
     ! push range with custom label and custom color
     subroutine gpmdrangepushex(event) bind(C, name='nvtxRangePushEx')
       use iso_c_binding
       import:: nvtxeventattributes
       type(nvtxeventattributes):: event
     end subroutine gpmdrangepushex
  end interface gpmdrangepush
 
  interface gpmdrangepop
     subroutine gpmdrangepop() bind(C, name='nvtxRangePop')
     end subroutine gpmdrangepop
  end interface gpmdrangepop
 
  public :: gpmdstartrange, gpmdendrange
 
contains
 
  subroutine gpmdstartrange(name,id)
    character(kind=c_char,len=*) :: name
    integer, optional:: id
    type(nvtxeventattributes):: event
 
    tempname=trim(name)//c_null_char
!    write(*,*)"gpmdcov_nvtx"," Tag = "//name
    if ( .not. present(id)) then
       call gpmdrangepush(tempname)
    else
       event%color=col(mod(id,7)+1)
       event%message=c_loc(tempname)
       call gpmdrangepushex(event)
    end if
  end subroutine gpmdstartrange
 
  subroutine gpmdendrange
    call gpmdrangepop
  end subroutine gpmdendrange
#endif 
!END if defined USE_NVTX
  
end module prg_nvtx_mod