#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