MFC/src/common/m_nvtx.f90 at 722e5f2dcceb4a76db723fa542958add70299ea8 · MFlowCode/MFC · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
module m_nvtx

    use iso_c_binding

    implicit none

    integer, private :: col(7) = [ &
                        int(Z'0000ff00'), int(Z'000000ff'), int(Z'00ffff00'), &
                        int(Z'00ff00ff'), int(Z'0000ffff'), int(Z'00ff0000'), &
                        int(Z'00ffffff') &
                        ]

    character(len=256), private :: 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(MFC_OpenACC) && defined(__PGI)

    interface nvtxRangePush
        ! push range with custom label and standard color
        subroutine nvtxRangePushA(name) bind(C, name='nvtxRangePushA')
            use iso_c_binding

            character(kind=c_char, len=*), intent(IN) :: name
        end subroutine nvtxRangePushA

        ! push range with custom label and custom color
        subroutine nvtxRangePushEx(event) bind(C, name='nvtxRangePushEx')
            use iso_c_binding

            import :: nvtxEventAttributes
            type(nvtxEventAttributes), intent(IN) :: event
        end subroutine nvtxRangePushEx
    end interface nvtxRangePush

    interface nvtxRangePop
        subroutine nvtxRangePop() bind(C, name='nvtxRangePop')
        end subroutine nvtxRangePop
    end interface nvtxRangePop

#endif

contains

    subroutine nvtxStartRange(name, id)
        character(kind=c_char, len=*), intent(IN) :: name
        integer, intent(in), optional :: id
        integer :: id_color
#if defined(MFC_OpenACC) && defined(__PGI)
        type(nvtxEventAttributes) :: event
#endif
        if (present(id)) then
            id_color = col(mod(id, 7) + 1)
        end if
        tempName = trim(name)//c_null_char

#if defined(MFC_OpenACC) && defined(__PGI)

        if (present(id)) then
            event%color = id_color
            event%message = c_loc(tempName)
            call nvtxRangePushEx(event)
        else
            call nvtxRangePushA(tempName)
        end if

#endif
    end subroutine nvtxStartRange

    subroutine nvtxEndRange
#if defined(MFC_OpenACC) && defined(__PGI)
        call nvtxRangePop
#endif
    end subroutine nvtxEndRange

end module m_nvtx