nvtx.f90 1.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172
  1. module nvtx
  2. use iso_c_binding
  3. implicit none
  4. integer,private :: col(7) = [ Z'0000ff00', Z'000000ff', Z'00ffff00', Z'00ff00ff', Z'0000ffff', Z'00ff0000', Z'00ffffff']
  5. character,private,target :: tempName(256)
  6. type, bind(C):: nvtxEventAttributes
  7. integer(C_INT16_T):: version=1
  8. integer(C_INT16_T):: size=48 !
  9. integer(C_INT):: category=0
  10. integer(C_INT):: colorType=1 ! NVTX_COLOR_ARGB = 1
  11. integer(C_INT):: color
  12. integer(C_INT):: payloadType=0 ! NVTX_PAYLOAD_UNKNOWN = 0
  13. integer(C_INT):: reserved0
  14. integer(C_INT64_T):: payload ! union uint,int,double
  15. integer(C_INT):: messageType=1 ! NVTX_MESSAGE_TYPE_ASCII = 1
  16. type(C_PTR):: message ! ascii char
  17. end type
  18. interface nvtxRangePush
  19. ! push range with custom label and standard color
  20. subroutine nvtxRangePushA(name) bind(C, name='nvtxRangePushA')
  21. use iso_c_binding
  22. character(kind=C_CHAR) :: name(256)
  23. end subroutine
  24. ! push range with custom label and custom color
  25. subroutine nvtxRangePushEx(event) bind(C, name='nvtxRangePushEx')
  26. use iso_c_binding
  27. import:: nvtxEventAttributes
  28. type(nvtxEventAttributes):: event
  29. end subroutine
  30. end interface
  31. interface nvtxRangePop
  32. subroutine nvtxRangePop() bind(C, name='nvtxRangePop')
  33. end subroutine
  34. end interface
  35. contains
  36. subroutine nvtxStartRange(name,id)
  37. character(kind=c_char,len=*) :: name
  38. integer, optional:: id
  39. type(nvtxEventAttributes):: event
  40. character(kind=c_char,len=256) :: trimmed_name
  41. integer:: i
  42. trimmed_name=trim(name)//c_null_char
  43. ! move scalar trimmed_name into character array tempName
  44. do i=1,LEN(trim(name)) + 1
  45. tempName(i) = trimmed_name(i:i)
  46. enddo
  47. if ( .not. present(id)) then
  48. call nvtxRangePush(tempName)
  49. else
  50. event%color=col(mod(id,7)+1)
  51. event%message=c_loc(tempName)
  52. call nvtxRangePushEx(event)
  53. end if
  54. end subroutine
  55. subroutine nvtxEndRange
  56. call nvtxRangePop
  57. end subroutine
  58. end module nvtx