Blob Blame History Raw
#include "fpapi_test.h"

#define MAX_TO_ADD 5

      program multiplex2
      IMPLICIT integer (p)

      integer retval
      integer tests_quiet, get_quiet
      external get_quiet

      tests_quiet = get_quiet()

      if (tests_quiet .EQ. 0) then
        write (*, 100) NUM_ITERS
 100    FORMAT ("multiplex2: Using ", I3, " iterations")
        write (*,*) "case1: Does PAPI_multiplex_init() handle", 
     *       " lots of events?"
      end if
      call case1(tests_quiet, retval)
      call ftests_pass(__FILE__)
      end

      subroutine init_papi()
      IMPLICIT integer (p)
      integer retval

      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
      end

      subroutine case1(tests_quiet, ret)
      IMPLICIT integer (p)
      integer tests_quiet
      integer retval
      integer i, ret, fd
      integer EventCode
      character*(PAPI_MAX_STR_LEN) event_name, event_descr,
     *     event_label, event_note
      integer avail_flag, flags, check
      integer EventSet,mask1
      integer*8 values(MAX_TO_ADD*2)

      EventSet = PAPI_NULL
      call init_papi()

      call init_multiplex()

      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_assign_eventset_component(EventSet, 0, retval)
      if ( retval.NE.PAPI_OK) then
        call ftest_fail(__FILE__, __LINE__,
     &      'PAPIf_assign_eventset_component', retval)
      end if

      call PAPIf_set_multiplex(EventSet, retval)
      if ( retval.EQ.PAPI_ENOSUPP) then
        call ftest_skip(__FILE__, __LINE__,
     .       'Multiplex not implemented', retval)
      end if
      if ( retval.NE.PAPI_OK) then
        call ftest_fail(__FILE__, __LINE__,
     .       'papif_set_multiplex', retval)
      end if

      if (tests_quiet .EQ. 0) then
        print *, "Checking for available events..."
      end if

      EventCode = 0
      i = 1
      do while (i .LE. MAX_TO_ADD)
         avail_flag=0
         do while ((avail_flag.EQ.0).AND.
     *        (EventCode.LT.PAPI_MAX_PRESET_EVENTS))
              mask1 = ((PAPI_L1_DCM)+EventCode) 
          if (mask1.NE.PAPI_TOT_CYC) then
              call papif_get_event_info(mask1, 
     *          event_name, event_descr, event_label, avail_flag, 
     *          event_note, flags, check)
          end if
          EventCode = EventCode + 1
         end do

         if ( EventCode.EQ.PAPI_MAX_PRESET_EVENTS .AND.
     *        i .LT. MAX_TO_ADD ) then
            call ftest_fail(__FILE__, __LINE__,
     *           'PAPIf_add_event', retval)
         end if

         if (tests_quiet .EQ. 0) then
            write (*, 200) "  Adding Event ", event_name 
 200        FORMAT(A22, A12)
         end if

         mask1 = ((PAPI_L1_DCM)+EventCode) 
         mask1 = mask1 - 1
         call PAPIf_add_event( EventSet, mask1, retval )
         if ( retval .NE. PAPI_OK .AND. retval .NE. PAPI_ECNFLCT) then
            call ftest_fail(__FILE__, __LINE__,
     *           'PAPIf_add_event', retval)
            stop
         end if

         if (tests_quiet .EQ. 0) then
         if (retval .EQ. PAPI_OK) then
             write (*, 200) "  Added Event ", event_name
         else
             write (*, 200) "  Could not add Event ", event_name
           end if
         end if
      
       if (retval .EQ. PAPI_OK) then
         i = i + 1
       end if
      end do
      
      call PAPIf_start(EventSet, retval)
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__,
     .       'PAPIf_start', retval)
      end if

      fd = 1
      call do_stuff()

      call PAPIf_stop(EventSet, values(1), retval)
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__,
     .       'PAPIf_stop', retval)
      end if

      call PAPIf_cleanup_eventset(EventSet, retval)
      if (retval .NE. PAPI_OK) then
        call ftest_fail(__FILE__, __LINE__,
     .       'PAPIf_cleanup_eventset',
     *       retval)
      end if

      call PAPIf_destroy_eventset(EventSet, retval)
      if (retval .NE. PAPI_OK) then
        call ftest_fail(__FILE__, __LINE__,
     .       'PAPIf_destroy_eventset',
     *       retval)
      end if

      ret = SUCCESS

      end