Blob Blame History Raw
#include "fpapi_test.h"

      program highlevel
      implicit integer (p)

      integer*8 values(10)
      integer events(2)
      integer eventnum
      integer availcounters
      integer retval
      integer tests_quiet, get_quiet
      external get_quiet
      character*PAPI_MAX_STR_LEN name
      integer last_char, n
      external last_char

      tests_quiet = get_quiet()

      eventnum = 2
      call PAPIf_num_counters(availcounters)
      if (eventnum .GT. availcounters) then
         print *, "Not enough hardware counters!"
         stop
      end if

      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(PAPI_FP_INS, retval)
      if (retval .NE. PAPI_OK) then
        events(1)=PAPI_TOT_INS
      else
        events(1)=PAPI_FP_INS
      end if
      events(2)=PAPI_TOT_CYC

      call PAPIf_start_counters(events, eventnum, retval)
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__,
     . 'PAPIf_start_counters', 
     *retval)
      end if

      call fdo_flops(NUM_FLOPS)

      call PAPIf_read_counters(values(1), eventnum, retval)
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__,
     . 'PAPIf_read_counters', 
     *retval)
      end if

      call fdo_flops(NUM_FLOPS)

      call PAPIf_stop_counters(values(3), eventnum, retval)
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__,
     . 'PAPIf_stop_counters', 
     *retval)
      end if
      
      if (tests_quiet .EQ. 0) then
        call PAPIf_event_code_to_name (events(1), name, retval)
        if ( retval.NE.PAPI_OK) then
          call ftest_fail(__FILE__, __LINE__, 
     * 'PAPIf_event_code_to_name', retval)
        end if
        n=last_char(name)
        print *, "Test case highlevel: Test of high-level APIs."
        print *, "---------------------------------------------",
     *    "---------------------"
        write (*,100) "Test type", 1, 2
        write (*,100) name(1:n), values(1), values(3)
        write (*,100) "PAPI_TOT_CYC", values(2), values(4)
 100    format(a15, ":", i12, i12)
        print *, "---------------------------------------------",
     * "---------------------"
      end if

      call ftests_pass(__FILE__)
      End