#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