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