/usr/share/doc/papi-examples/ftests/fmultiplex2.F is in papi-examples 5.3.0-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 | #include "fpapi_test.h"
#define MAX_TO_ADD 5
program multiplex2
IMPLICIT integer (p)
integer retval
integer tests_quiet, get_quiet
external get_quiet
tests_quiet = get_quiet()
if (tests_quiet .EQ. 0) then
write (*, 100) NUM_ITERS
100 FORMAT ("multiplex2: Using ", I3, " iterations")
write (*,*) "case1: Does PAPI_multiplex_init() handle",
* " lots of events?"
end if
call case1(tests_quiet, retval)
call ftests_pass(__FILE__)
end
subroutine init_papi()
IMPLICIT integer (p)
integer retval
retval = PAPI_VER_CURRENT
call PAPIf_library_init(retval)
if ( retval.NE.PAPI_VER_CURRENT) then
call ftest_fail(__FILE__, __LINE__,
. 'PAPI_library_init', retval)
end if
end
subroutine case1(tests_quiet, ret)
IMPLICIT integer (p)
integer tests_quiet
integer retval
integer i, ret, fd
integer EventCode
character*(PAPI_MAX_STR_LEN) event_name, event_descr,
* event_label, event_note
integer avail_flag, flags, check
integer EventSet,mask1
integer*8 values(MAX_TO_ADD*2)
EventSet = PAPI_NULL
call init_papi()
call init_multiplex()
call PAPIf_create_eventset(EventSet, retval)
if ( retval.NE.PAPI_OK) then
call ftest_fail(__FILE__, __LINE__,
. 'PAPIf_create_eventset',
* retval)
end if
call PAPIf_assign_eventset_component(EventSet, 0, retval)
if ( retval.NE.PAPI_OK) then
call ftest_fail(__FILE__, __LINE__,
& 'PAPIf_assign_eventset_component', retval)
end if
call PAPIf_set_multiplex(EventSet, retval)
if ( retval.EQ.PAPI_ENOSUPP) then
call ftest_skip(__FILE__, __LINE__,
. 'Multiplex not implemented', retval)
end if
if ( retval.NE.PAPI_OK) then
call ftest_fail(__FILE__, __LINE__,
. 'papif_set_multiplex', retval)
end if
if (tests_quiet .EQ. 0) then
print *, "Checking for available events..."
end if
EventCode = 0
i = 1
do while (i .LE. MAX_TO_ADD)
avail_flag=0
do while ((avail_flag.EQ.0).AND.
* (EventCode.LT.PAPI_MAX_PRESET_EVENTS))
mask1 = ((PAPI_L1_DCM)+EventCode)
if (mask1.NE.PAPI_TOT_CYC) then
call papif_get_event_info(mask1,
* event_name, event_descr, event_label, avail_flag,
* event_note, flags, check)
end if
EventCode = EventCode + 1
end do
if ( EventCode.EQ.PAPI_MAX_PRESET_EVENTS .AND.
* i .LT. MAX_TO_ADD ) then
call ftest_fail(__FILE__, __LINE__,
* 'PAPIf_add_event', retval)
end if
if (tests_quiet .EQ. 0) then
write (*, 200) " Adding Event ", event_name
200 FORMAT(A22, A12)
end if
mask1 = ((PAPI_L1_DCM)+EventCode)
mask1 = mask1 - 1
call PAPIf_add_event( EventSet, mask1, retval )
if ( retval .NE. PAPI_OK .AND. retval .NE. PAPI_ECNFLCT) then
call ftest_fail(__FILE__, __LINE__,
* 'PAPIf_add_event', retval)
stop
end if
if (tests_quiet .EQ. 0) then
if (retval .EQ. PAPI_OK) then
write (*, 200) " Added Event ", event_name
else
write (*, 200) " Could not add Event ", event_name
end if
end if
if (retval .EQ. PAPI_OK) then
i = i + 1
end if
end do
call PAPIf_start(EventSet, retval)
if ( retval .NE. PAPI_OK ) then
call ftest_fail(__FILE__, __LINE__,
. 'PAPIf_start', retval)
end if
fd = 1
call do_stuff()
call PAPIf_stop(EventSet, values(1), retval)
if ( retval .NE. PAPI_OK ) then
call ftest_fail(__FILE__, __LINE__,
. 'PAPIf_stop', retval)
end if
call PAPIf_cleanup_eventset(EventSet, retval)
if (retval .NE. PAPI_OK) then
call ftest_fail(__FILE__, __LINE__,
. 'PAPIf_cleanup_eventset',
* retval)
end if
call PAPIf_destroy_eventset(EventSet, retval)
if (retval .NE. PAPI_OK) then
call ftest_fail(__FILE__, __LINE__,
. 'PAPIf_destroy_eventset',
* retval)
end if
ret = SUCCESS
end
|