source-git / papi

Clone
Source Code
GIT

Blame src/ftests/fmultiplex2.F

c8 c8s master
  1.   57771707c5d17696fd3660ed6f10428b3c234e9a
  2.   src
  3.   ftests
  4.   fmultiplex2.F
Blob History Raw
Packit 577717 
#include "fpapi_test.h"
Packit 577717
Packit 577717 
#define MAX_TO_ADD 5
Packit 577717
Packit 577717 
      program multiplex2
Packit 577717 
      IMPLICIT integer (p)
Packit 577717
Packit 577717 
      integer retval
Packit 577717 
      integer tests_quiet, get_quiet
Packit 577717 
      external get_quiet
Packit 577717
Packit 577717 
      tests_quiet = get_quiet()
Packit 577717
Packit 577717 
      if (tests_quiet .EQ. 0) then
Packit 577717 
        write (*, 100) NUM_ITERS
Packit 577717 
 100    FORMAT ("multiplex2: Using ", I3, " iterations")
Packit 577717 
        write (*,*) "case1: Does PAPI_multiplex_init() handle",
Packit 577717 
     *       " lots of events?"
Packit 577717 
      end if
Packit 577717 
      call case1(tests_quiet, retval)
Packit 577717 
      call ftests_pass(__FILE__)
Packit 577717 
      end
Packit 577717
Packit 577717 
      subroutine init_papi()
Packit 577717 
      IMPLICIT integer (p)
Packit 577717 
      integer retval
Packit 577717
Packit 577717 
      retval = PAPI_VER_CURRENT
Packit 577717 
      call PAPIf_library_init(retval)
Packit 577717 
      if ( retval.NE.PAPI_VER_CURRENT) then
Packit 577717 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     .       'PAPI_library_init', retval)
Packit 577717 
      end if
Packit 577717 
      end
Packit 577717
Packit 577717 
      subroutine case1(tests_quiet, ret)
Packit 577717 
      IMPLICIT integer (p)
Packit 577717 
      integer tests_quiet
Packit 577717 
      integer retval
Packit 577717 
      integer i, ret, fd
Packit 577717 
      integer EventCode
Packit 577717 
      character*(PAPI_MAX_STR_LEN) event_name, event_descr,
Packit 577717 
     *     event_label, event_note
Packit 577717 
      integer avail_flag, flags, check
Packit 577717 
      integer EventSet,mask1
Packit 577717 
      integer*8 values(MAX_TO_ADD*2)
Packit 577717
Packit 577717 
      EventSet = PAPI_NULL
Packit 577717 
      call init_papi()
Packit 577717
Packit 577717 
      call init_multiplex()
Packit 577717
Packit 577717 
      call PAPIf_create_eventset(EventSet, retval)
Packit 577717 
      if ( retval.NE.PAPI_OK) then
Packit 577717
Packit 577717 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     .       'PAPIf_create_eventset',
Packit 577717 
     *       retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
      call PAPIf_assign_eventset_component(EventSet, 0, retval)
Packit 577717 
      if ( retval.NE.PAPI_OK) then
Packit 577717 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     &      'PAPIf_assign_eventset_component', retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
      call PAPIf_set_multiplex(EventSet, retval)
Packit 577717 
      if ( retval.EQ.PAPI_ENOSUPP) then
Packit 577717 
        call ftest_skip(__FILE__, __LINE__,
Packit 577717 
     .       'Multiplex not implemented', retval)
Packit 577717 
      end if
Packit 577717 
      if ( retval.NE.PAPI_OK) then
Packit 577717 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     .       'papif_set_multiplex', retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
      if (tests_quiet .EQ. 0) then
Packit 577717 
        print *, "Checking for available events..."
Packit 577717 
      end if
Packit 577717
Packit 577717 
      EventCode = 0
Packit 577717 
      i = 1
Packit 577717 
      do while (i .LE. MAX_TO_ADD)
Packit 577717 
         avail_flag=0
Packit 577717 
         do while ((avail_flag.EQ.0).AND.
Packit 577717 
     *        (EventCode.LT.PAPI_MAX_PRESET_EVENTS))
Packit 577717 
              mask1 = ((PAPI_L1_DCM)+EventCode)
Packit 577717 
          if (mask1.NE.PAPI_TOT_CYC) then
Packit 577717 
              call papif_get_event_info(mask1,
Packit 577717 
     *          event_name, event_descr, event_label, avail_flag,
Packit 577717 
     *          event_note, flags, check)
Packit 577717 
          end if
Packit 577717 
          EventCode = EventCode + 1
Packit 577717 
         end do
Packit 577717
Packit 577717 
         if ( EventCode.EQ.PAPI_MAX_PRESET_EVENTS .AND.
Packit 577717 
     *        i .LT. MAX_TO_ADD ) then
Packit 577717 
            call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     *           'PAPIf_add_event', retval)
Packit 577717 
         end if
Packit 577717
Packit 577717 
         if (tests_quiet .EQ. 0) then
Packit 577717 
            write (*, 200) "  Adding Event ", event_name
Packit 577717 
 200        FORMAT(A22, A12)
Packit 577717 
         end if
Packit 577717
Packit 577717 
         mask1 = ((PAPI_L1_DCM)+EventCode)
Packit 577717 
         mask1 = mask1 - 1
Packit 577717 
         call PAPIf_add_event( EventSet, mask1, retval )
Packit 577717 
         if ( retval .NE. PAPI_OK .AND. retval .NE. PAPI_ECNFLCT) then
Packit 577717 
            call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     *           'PAPIf_add_event', retval)
Packit 577717 
            stop
Packit 577717 
         end if
Packit 577717
Packit 577717 
         if (tests_quiet .EQ. 0) then
Packit 577717 
         if (retval .EQ. PAPI_OK) then
Packit 577717 
             write (*, 200) "  Added Event ", event_name
Packit 577717 
         else
Packit 577717 
             write (*, 200) "  Could not add Event ", event_name
Packit 577717 
           end if
Packit 577717 
         end if
Packit 577717
Packit 577717 
       if (retval .EQ. PAPI_OK) then
Packit 577717 
         i = i + 1
Packit 577717 
       end if
Packit 577717 
      end do
Packit 577717
Packit 577717 
      call PAPIf_start(EventSet, retval)
Packit 577717 
      if ( retval .NE. PAPI_OK ) then
Packit 577717 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     .       'PAPIf_start', retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
      fd = 1
Packit 577717 
      call do_stuff()
Packit 577717
Packit 577717 
      call PAPIf_stop(EventSet, values(1), retval)
Packit 577717 
      if ( retval .NE. PAPI_OK ) then
Packit 577717 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     .       'PAPIf_stop', retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
      call PAPIf_cleanup_eventset(EventSet, retval)
Packit 577717 
      if (retval .NE. PAPI_OK) then
Packit 577717 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     .       'PAPIf_cleanup_eventset',
Packit 577717 
     *       retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
      call PAPIf_destroy_eventset(EventSet, retval)
Packit 577717 
      if (retval .NE. PAPI_OK) then
Packit 577717 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     .       'PAPIf_destroy_eventset',
Packit 577717 
     *       retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
      ret = SUCCESS
Packit 577717
Packit 577717 
      end
Packit 577717

Powered by Pagure 5.13.3

SSH Hostkey/Fingerprint | Documentation