C From Dave McNamara at PSRV. Thanks!
C Ported to Fortran by Kevin London
C If you try to add an event that doesn't exist, you get the correct error
C message, yet you get subsequent Seg. Faults when you try to do PAPI_start
C and PAPI_stop. I would expect some bizarre behavior if I had no events
C added to the event set and then tried to PAPI_start but if I had
C successfully added one event, then the 2nd one get an error when I
C tried to add it, is it possible for PAPI_start to work but just
C count the first event?
#include "fpapi_test.h"
program case1
IMPLICIT integer (p)
INTEGER EventSet
INTEGER retval
INTEGER i,j
INTEGER*8 gl(2)
INTEGER n
REAL c,a,b
INTEGER last_char
EXTERNAL last_char
integer tests_quiet, get_quiet
external get_quiet
tests_quiet = get_quiet()
n = 1000
a = 0.999
b = 1.001
j = 0
i = 0
EventSet = PAPI_NULL
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
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_query_event(PAPI_L2_TCM, retval)
if (retval .EQ. PAPI_OK) then
j = j + 1
end if
if (j .NE. 0) then
call PAPIf_add_event( EventSet, PAPI_L2_TCM, retval )
if (retval .NE. PAPI_OK) then
if (retval .NE. PAPI_ECNFLCT) then
call ftest_fail(__FILE__, __LINE__,
. 'PAPIf_add_event',
*retval)
else
j = j - 1
end if
end if
end if
i = j
call PAPIf_query_event(PAPI_L2_DCM, retval)
if (retval .EQ. PAPI_OK) then
j = j + 1
end if
if (j .EQ. i+1) then
call PAPIf_add_event( EventSet, PAPI_L2_DCM, retval )
if (retval .NE. PAPI_OK) then
if (retval .NE. PAPI_ECNFLCT) then
call ftest_fail(__FILE__, __LINE__,
. 'PAPIf_add_event',
*retval)
else
j = j - 1
end if
end if
end if
if (J .GT. 0) then
call PAPIf_start( EventSet, retval )
if ( retval .NE. PAPI_OK ) then
call ftest_fail(__FILE__, __LINE__,
. 'PAPIf_start', retval)
end if
end if
do i=1, n
c = a * b
end do
if (j .GT. 0) then
call PAPIf_stop( EventSet, gl, retval )
if ( retval .NE. PAPI_OK ) then
call ftest_fail(__FILE__, __LINE__,
. 'PAPIf_stop', retval)
end if
end if
call ftests_pass(__FILE__)
end