nvtx.F90

Go to the documentation of this file.

 
module nvtx
  use, intrinsic :: iso_c_binding, only : c_int16_t, c_int32_t, c_int64_t, &
       c_int, c_ptr, c_char, c_loc, c_null_char
  implicit none
  private
 
  integer, parameter :: nvtx_max_len = 256
  integer, parameter :: color(24) = &
       [int(z'00A6CEE3'), int(z'001F78B4'), &
       int(z'00B2DF8A'), int(z'0033A02C'), &
       int(z'00FB9A99'), int(z'00E31A1C'), &
       int(z'00FDBF6F'), int(z'00FF7F00'), &
       int(z'00CAB2D6'), int(z'006A3D9A'), &
       int(z'00FFFF99'), int(z'00B15928'), &
       int(z'008DD3C7'), int(z'00FFFFB3'), &
       int(z'00BEBADA'), int(z'00FB8072'), &
       int(z'0080B1D3'), int(z'00FDB462'), &
       int(z'00B3DE69'), int(z'00FCCDE5'), &
       int(z'00D9D9D9'), int(z'00BC89BD'), &
       int(z'00CCEBC5'), int(z'00FFED6F')]
 
#ifdef HAVE_NVTX
 
  type, bind(c) :: nvtxeventattributes
     integer(c_int16_t) :: version = 1
     integer(c_int16_t) :: size = 48
     integer(c_int32_t) :: category = 0
     integer(c_int32_t) :: colortype = 1
     integer(c_int32_t) :: color
     integer(c_int32_t) :: payloadtype = 0
     integer(c_int32_t) :: reserved0
     integer(c_int64_t) :: payload
     integer(c_int) :: messagetype = 1
     type(c_ptr) :: message
  end type nvtxeventattributes
 
  interface nvtxrangepusha
     subroutine nvtxrangepusha(name) bind(C, name = 'nvtxRangePushA')
       use, intrinsic :: iso_c_binding
       character(kind=c_char) :: name(256)
     end subroutine nvtxrangepusha
  end interface nvtxrangepusha
 
  interface nvtxrangepushex
     subroutine nvtxrangepushex(event) bind(C, name = 'nvtxRangePushEx')
       use, intrinsic :: iso_c_binding
       import :: nvtxeventattributes
       type(nvtxeventattributes) :: event
     end subroutine nvtxrangepushex
  end interface nvtxrangepushex
 
  interface nvtxrangepop
     subroutine nvtxrangepop() bind(C, name = 'nvtxRangePop')
     end subroutine nvtxrangepop
  end interface nvtxrangepop
 
  public :: nvtxstartrange, nvtxrangepusha, nvtxrangepop
 
contains
 
  subroutine nvtxstartrange(name, region_id)
    character(kind=c_char, len=*) :: name
    integer, optional :: region_id
    type(nvtxeventattributes) :: event
    character, target :: c_name(nvtx_max_len)
    integer :: i, str_len
 
    str_len = len(trim(name))
    do i = 1, len(trim(name))
       c_name(i) = name(i:i)
    end do
    c_name(str_len+1) = c_null_char
 
    if (present(region_id)) then
       event%color = color(mod(region_id, 24) + 1)
       event%message = c_loc(c_name)
       call nvtxrangepushex(event)
    else
       call nvtxrangepusha(c_name)
    end if
 
  end subroutine nvtxstartrange
 
#endif
end module nvtx