#include "fpapi_test.h"

#define ITERS 100

#if defined(sun) && defined(sparc)

#define CACHE_LEVEL "PAPI_L2_TCM"

#define EVT1            PAPI_L2_TCM

#define EVT2            PAPI_L2_TCA

#define EVT3            PAPI_L2_TCH

#define EVT1_STR        "PAPI_L2_TCM"

#define EVT2_STR        "PAPI_L2_TCA"

#define EVT3_STR        "PAPI_L2_TCH"

#else

#if defined(__powerpc__)

#define CACHE_LEVEL "PAPI_L1_DCA"

#define EVT1            PAPI_L1_DCA

#define EVT2            PAPI_L1_DCW

#define EVT3            PAPI_L1_DCR

#define EVT1_STR        "PAPI_L1_DCA"

#define EVT2_STR        "PAPI_L1_DCW"

#define EVT3_STR        "PAPI_L1_DCR"

#else

#define CACHE_LEVEL "PAPI_L1_TCM"

#define EVT1            PAPI_L1_TCM

#define EVT2            PAPI_L1_ICM

#define EVT3            PAPI_L1_DCM

#define EVT1_STR        "PAPI_L1_TCM"

#define EVT2_STR        "PAPI_L1_ICM"

#define EVT3_STR        "PAPI_L1_DCM"

#endif

#endif

      program tenth

      implicit integer (p)

      integer*8 values(10)

      integer es1, es2, es3

      integer*4 mask1, mask2, mask3

      integer domain, granularity

      character*(PAPI_MAX_STR_LEN) domainstr, grnstr

      integer retval

      Integer last_char

      External last_char

      integer tests_quiet, get_quiet

      external get_quiet

      tests_quiet = get_quiet()

      es1 = PAPI_NULL

      es2 = PAPI_NULL

      es3 = PAPI_NULL

      mask1 = EVT1

      mask2 = EVT2

      mask3 = EVT3

      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_query_event(mask1, retval)

      if ( retval.NE.PAPI_OK) then

        call ftest_skip(__FILE__, __LINE__,

     .'PAPIf_query_event', retval)

      end if

      call PAPIf_query_event(mask2, retval)

      if ( retval.NE.PAPI_OK) then

        call ftest_skip(__FILE__, __LINE__,

     .'PAPIf_query_event', retval)

      end if

      call PAPIf_query_event(mask3, retval)

      if ( retval.NE.PAPI_OK) then

        call ftest_skip(__FILE__, __LINE__,

     .'PAPIf_query_event', retval)

      end if

      call PAPIf_create_eventset(es1, retval)

      if ( retval.NE.PAPI_OK) then

        call ftest_fail(__FILE__, __LINE__,

     . 'PAPIf_create_eventset',

     *retval)

      end if

      call PAPIf_add_event( es1, mask1, retval )

      if ( retval .NE. PAPI_OK ) then

        call ftest_fail(__FILE__, __LINE__,

     . 'PAPIf_add_event', retval)

      end if

      call PAPIf_create_eventset(es2, retval)

      if ( retval.NE.PAPI_OK) then

        call ftest_fail(__FILE__, __LINE__,

     . 'PAPIf_create_eventset',

     *retval)

      end if

      call PAPIf_add_event( es2, mask2, retval )

      if ( retval .NE. PAPI_OK ) then

        call ftest_fail(__FILE__, __LINE__,

     . 'PAPIf_add_event', retval)

      end if

      call PAPIf_create_eventset(es3, retval)

      if ( retval.NE.PAPI_OK) then

        call ftest_fail(__FILE__, __LINE__,

     . 'PAPIf_create_eventset',

     *   retval)

      end if

      call PAPIf_add_event( es3, mask3, retval )

      if ( retval .NE. PAPI_OK ) then

        call ftest_fail(__FILE__, __LINE__,

     . 'PAPIf_add_event', retval)

      end if

      call fdo_l1misses(ITERS)

      call PAPIf_start(es1, retval)

      if ( retval .NE. PAPI_OK ) then

        call ftest_fail(__FILE__, __LINE__,

     . 'PAPIf_start', retval)

      end if

      call fdo_l1misses(ITERS)

      call PAPIf_stop(es1, values(1), retval)

      if ( retval .NE. PAPI_OK ) then

        call ftest_fail(__FILE__, __LINE__,

     . 'PAPIf_stop', retval)

      end if

      call PAPIf_start(es2, retval)

      if ( retval .NE. PAPI_OK ) then

        call ftest_fail(__FILE__, __LINE__,

     . 'PAPIf_start', retval)

      end if

      call fdo_l1misses(ITERS)

      call PAPIf_stop(es2, values(3), retval)

      if ( retval .NE. PAPI_OK ) then

        call ftest_fail(__FILE__, __LINE__,

     . 'PAPIf_stop', retval)

      end if

      call PAPIf_start(es3, retval)

      if ( retval .NE. PAPI_OK ) then

        call ftest_fail(__FILE__, __LINE__,

     . 'PAPIf_start', retval)

      end if

      call fdo_l1misses(ITERS)

      call PAPIf_stop(es3, values(5), retval)

      if ( retval .NE. PAPI_OK ) then

        call ftest_fail(__FILE__, __LINE__,

     . 'PAPIf_stop', retval)

      end if

      call PAPIf_remove_event( es1, mask1, retval )

      if ( retval .NE. PAPI_OK ) then

        call ftest_fail(__FILE__, __LINE__,

     . 'PAPIf_remove_event', retval)

      end if

      call PAPIf_remove_event( es2, mask2, retval )

      if ( retval .NE. PAPI_OK ) then

        call ftest_fail(__FILE__, __LINE__,

     . 'PAPIf_remove_event', retval)

      end if

      call PAPIf_remove_event( es3, mask3, retval )

      if ( retval .NE. PAPI_OK ) then

        call ftest_fail(__FILE__, __LINE__,

     . 'PAPIf_remove_event', retval)

      end if

      if (tests_quiet .EQ. 0) then

#if (defined(sun) && defined(sparc))

      print *, "Test case 10: start, stop for derived event ",

     *"PAPI_L2_TCM."

#else

      print *, "Test case 10: start, stop for derived event ",

     *"PAPI_L1_TCM."

#endif

      print *, "------------------------------------------------------"

      end if

      call PAPIf_get_domain(es1, domain, PAPI_DEFDOM, retval)

      if ( retval .NE. PAPI_OK ) then

        call ftest_fail(__FILE__, __LINE__,

     . 'PAPIf_get_domain', retval)

      end if

      call stringify_domain(domain, domainstr)

      if (tests_quiet .EQ. 0) then

      write (*,900) "Default domain is:", domain, domainstr

 900  format(a20, i3, " ", a70)

      end if

      call PAPIf_get_granularity(es1, granularity, PAPI_DEFGRN, 

     *retval)

      if ( retval .NE. PAPI_OK ) then

        call ftest_fail(__FILE__, __LINE__,

     . 'PAPIf_get_granularity', 

     *retval)

      end if

      call stringify_granularity(granularity, grnstr)

      if (tests_quiet .EQ. 0) then

      write (*,800) "Default granularity is:", granularity, grnstr

 800  format(a25, i3, " ", a20)

      print *, "Using", NUM_FLOPS, " iterations of c += b*c"

      print *, "------------------------------------------------------"

      write (*,500) "Test type", 1, 2, 3

#if (defined(sun) && defined(sparc))

      write (*,500) EVT1_STR, values(1), 0, 0

      write (*,500) EVT2_STR, 0, values(3), 0

      write (*,500) EVT3_STR, 0, 0, values(5)

      print *, "------------------------------------------------",

     *"------"

      print *, "Verification:"

      print *, "First number row 1 approximately equals (2,2) - (3,3) ", 

     *"or ",(values(3)-values(5))

#else

      write (*,500) EVT1_STR, values(1), 0, 0

      write (*,500) EVT2_STR, 0, values(3), 0 

      write (*,500) EVT3_STR, 0, 0, values(5) 

      print *, "------------------------------------------------",

     *"------"

      print *, "Verification:"

      print *, "First number row 1 approximately equals (2,2) + (3,3) ",

     *"or ", (values(3)+values(5))

#endif

      end if

 500  format(A13, ": ", I10, I10, I10)

      call ftests_pass(__FILE__)

      end