Blob Blame History Raw
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