source-git / papi

Clone
Source Code
GIT

Blame src/ftests/fmultiplex1.F

c8 c8s master
  1.   57771707c5d17696fd3660ed6f10428b3c234e9a
  2.   src
  3.   ftests
  4.   fmultiplex1.F
Blob History Raw
Packit 577717 
#include "fpapi_test.h"
Packit 577717
Packit 577717 
      program multiplex1
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 ("multiplex1: Using ", I3, " iterations")
Packit 577717 
         write (*,*) "case1: Does PAPI_multiplex_init() not break",
Packit 577717 
     *" regular operation?"
Packit 577717 
      end if
Packit 577717 
      call case1(retval, tests_quiet)
Packit 577717 
      if (tests_quiet .EQ. 0) then
Packit 577717 
         write (*,*) "case2: Does setmpx/add work?"
Packit 577717 
      end if
Packit 577717 
      call case2(retval, tests_quiet)
Packit 577717 
      if (tests_quiet .EQ. 0) then
Packit 577717 
         write (*,*) "case3: Does add/setmpx work?"
Packit 577717 
      end if
Packit 577717 
      call case3(retval, tests_quiet)
Packit 577717 
      if (tests_quiet .EQ. 0) then
Packit 577717 
         write (*,*) "case4: Does add/setmpx/add work?"
Packit 577717 
      end if
Packit 577717 
      call case4(retval, tests_quiet)
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 
      call ftests_pass(__FILE__)
Packit 577717
Packit 577717 
      end
Packit 577717
Packit 577717 
      subroutine init_papi(event)
Packit 577717 
      IMPLICIT integer (p)
Packit 577717 
      integer retval
Packit 577717 
      integer event
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 
        call PAPIf_query_event(PAPI_TOT_INS, retval)
Packit 577717 
        if (retval .NE. PAPI_OK) then
Packit 577717 
        event = PAPI_TOT_CYC
Packit 577717 
        else
Packit 577717 
        event = PAPI_TOT_INS
Packit 577717 
        end if
Packit 577717 
      end
Packit 577717
Packit 577717 
C     Tests that PAPI_multiplex_init does not mess with normal operation.
Packit 577717 
      subroutine case1(ret, tests_quiet)
Packit 577717 
      IMPLICIT integer (p)
Packit 577717 
      integer ret, tests_quiet, event
Packit 577717 
      integer retval, EventSet
Packit 577717 
      INTEGER*8 values(4)
Packit 577717 
      integer fd
Packit 577717
Packit 577717 
      EventSet = PAPI_NULL
Packit 577717 
      call init_papi(event)
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 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     &      'PAPIf_create_eventset', retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
      call PAPIf_add_event( EventSet, event, retval )
Packit 577717 
      if ( retval .NE. PAPI_OK ) then
Packit 577717 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     &      'PAPIf_add_event', retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
      call PAPIf_add_event( EventSet, PAPI_TOT_CYC, retval )
Packit 577717 
      if ( retval .NE. PAPI_OK ) then
Packit 577717 
        call PAPIf_add_event( EventSet, PAPI_TOT_IIS, retval )
Packit 577717 
        if ( retval .NE. PAPI_OK ) then
Packit 577717 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     &        'PAPIf_add_event', retval)
Packit 577717 
        end if
Packit 577717 
      end if
Packit 577717
Packit 577717 
      if(tests_quiet .EQ. 0) then
Packit 577717 
        write(*,*) 'Event set list'
Packit 577717 
        call PrintEventSet(EventSet)
Packit 577717 
      end if
Packit 577717
Packit 577717 
      call do_stuff()
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 
      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 
      if (tests_quiet .EQ. 0) then
Packit 577717 
      print *, "case1: ", values(1), values(2)
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', retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
      call PAPIF_shutdown()
Packit 577717 
      ret = SUCCESS
Packit 577717 
      end
Packit 577717
Packit 577717 
C     Tests that PAPI_set_multiplex() works before adding events
Packit 577717 
      subroutine case2(ret, tests_quiet)
Packit 577717 
      IMPLICIT integer (p)
Packit 577717 
      integer ret, tests_quiet, event
Packit 577717 
      integer retval, EventSet
Packit 577717 
      INTEGER*8 values(4)
Packit 577717 
      integer fd
Packit 577717
Packit 577717 
      EventSet = PAPI_NULL
Packit 577717 
      call init_papi(event)
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 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     &      'PAPIf_create_eventset', 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', 1)
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 
      call PAPIf_add_event( EventSet, event, retval )
Packit 577717 
      if ( retval .NE. PAPI_OK ) then
Packit 577717 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     &      'PAPIf_add_event', retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
      call PAPIf_add_event( EventSet, PAPI_TOT_CYC, retval )
Packit 577717 
      if ( retval .NE. PAPI_OK ) then
Packit 577717 
        call PAPIf_add_event( EventSet, PAPI_TOT_IIS, retval)
Packit 577717 
        if ( retval .NE. PAPI_OK ) then
Packit 577717 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     &        'PAPIf_add_event', retval)
Packit 577717 
        end if
Packit 577717 
      end if
Packit 577717
Packit 577717 
C  This print-out is disabled until PAPIf_list_event is working
Packit 577717 
C  for multiplexed event sets (change -4711 to 0 when it is working)
Packit 577717 
      if(tests_quiet .EQ. 0) then
Packit 577717 
        write(*,*) 'Event set list'
Packit 577717 
        call PrintEventSet(EventSet)
Packit 577717 
      endif
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 
      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 
      if (tests_quiet .EQ. 0) then
Packit 577717 
      print *, "case2: ", values(1), values(2)
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', retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
      call PAPIF_shutdown()
Packit 577717 
      ret = SUCCESS
Packit 577717 
      end
Packit 577717
Packit 577717 
C     Tests that PAPI_set_multiplex() works after adding events
Packit 577717 
      subroutine case3(ret, tests_quiet)
Packit 577717 
      IMPLICIT integer (p)
Packit 577717 
      integer ret, tests_quiet, event
Packit 577717 
      integer retval, EventSet
Packit 577717 
      INTEGER*8 values(4)
Packit 577717 
      integer fd
Packit 577717
Packit 577717 
      EventSet = PAPI_NULL
Packit 577717 
      call init_papi(event)
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 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     &      'PAPIf_create_eventset', retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
      call PAPIf_add_event( EventSet, event, retval )
Packit 577717 
      if ( retval .NE. PAPI_OK ) then
Packit 577717 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     &      'PAPIf_add_event', retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
      call PAPIf_add_event( EventSet, PAPI_TOT_CYC, retval )
Packit 577717 
      if ( retval .NE. PAPI_OK ) 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(*,*) 'Event set before call to PAPIf_set_multiplex:'
Packit 577717 
        call PrintEventSet(EventSet)
Packit 577717 
      endif
Packit 577717
Packit 577717 
      call PAPIf_set_multiplex(EventSet, retval)
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 
        write(*,*) 'Event set after call to PAPIf_set_multiplex:'
Packit 577717 
        call PrintEventSet(EventSet)
Packit 577717 
      endif
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 
      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 
      if (tests_quiet .EQ. 0) then
Packit 577717 
      print *, "case3: ", values(1), values(2)
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', retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
      call PAPIF_shutdown()
Packit 577717 
      ret = SUCCESS
Packit 577717 
      end
Packit 577717
Packit 577717 
C     Tests that PAPI_set_multiplex() works before adding events
Packit 577717 
C     Tests that PAPI_add_event() works after
Packit 577717 
C     PAPI_add_event()/PAPI_set_multiplex()
Packit 577717 
      subroutine case4(ret, tests_quiet)
Packit 577717 
      IMPLICIT integer (p)
Packit 577717 
      integer ret, tests_quiet, event
Packit 577717 
      integer retval, EventSet
Packit 577717 
      INTEGER*8 values(4)
Packit 577717 
      integer fd
Packit 577717
Packit 577717 
      EventSet = PAPI_NULL
Packit 577717 
      call init_papi(event)
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 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     &      'PAPIf_create_eventset', retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
      call PAPIf_add_event( EventSet, event, retval )
Packit 577717 
      if ( retval .NE. PAPI_OK ) then
Packit 577717 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     &      'PAPIf_add_event', retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
      call PAPIf_add_event( EventSet, PAPI_TOT_CYC, retval )
Packit 577717 
      if ( retval .NE. PAPI_OK ) then
Packit 577717 
        call PAPIf_add_event( EventSet, PAPI_TOT_IIS, retval )
Packit 577717 
        if ( retval .NE. PAPI_OK ) then
Packit 577717 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     &        'PAPIf_add_event', retval)
Packit 577717 
        end if
Packit 577717 
      end if
Packit 577717
Packit 577717 
      if(tests_quiet .EQ. 0) then
Packit 577717 
        write(*,*) 'Event set before call to PAPIf_set_multiplex:'
Packit 577717 
        call PrintEventSet(EventSet)
Packit 577717 
      endif
Packit 577717
Packit 577717 
      call PAPIf_set_multiplex(EventSet, retval)
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 
        write(*,*) 'Event set after call to PAPIf_set_multiplex:'
Packit 577717 
        call PrintEventSet(EventSet)
Packit 577717 
      endif
Packit 577717
Packit 577717 
#if (defined(i386)&&defined(linux))||defined(mips) || (defined(__ia64__) && defined(linux)) || (SUBSTR==aix-power)
Packit 577717
Packit 577717 
      call PAPIf_add_event( EventSet, PAPI_L1_DCM, retval )
Packit 577717 
C Try alternative event if the above is not possible to use...
Packit 577717 
      if ( retval .EQ. PAPI_ECNFLCT .OR. retval .EQ. PAPI_ENOEVNT ) then
Packit 577717 
        call PAPIf_add_event( EventSet, PAPI_L2_DCM, retval )
Packit 577717 
      end if
Packit 577717 
      if ( retval .EQ. PAPI_ECNFLCT .OR. retval .EQ. PAPI_ENOEVNT ) then
Packit 577717 
        call PAPIf_add_event( EventSet, PAPI_L2_TCM, retval )
Packit 577717 
      end if
Packit 577717 
      if ( retval .NE. PAPI_OK ) then
Packit 577717 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     &      'PAPIf_add_event', retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
      call PAPIf_add_event( EventSet, PAPI_L1_ICM, retval )
Packit 577717 
C Try alternative event if the above is not possible to use...
Packit 577717 
      if ( retval .EQ. PAPI_ECNFLCT .OR. retval .EQ. PAPI_ENOEVNT ) then
Packit 577717 
        call PAPIf_add_event( EventSet, PAPI_L1_LDM, retval )
Packit 577717 
      end if
Packit 577717 
      if ( retval .NE. PAPI_OK ) then
Packit 577717 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     &      'PAPIf_add_event', retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
#elif (defined(sparc) && defined(sun))
Packit 577717 
      call PAPIf_add_event( EventSet, PAPI_LD_INS, retval )
Packit 577717 
      if ( retval .NE. PAPI_OK ) then
Packit 577717 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     &      'PAPIf_add_event', retval)
Packit 577717 
      end if
Packit 577717 
      call PAPIf_add_event( EventSet, PAPI_SR_INS, retval )
Packit 577717 
      if ( retval .NE. PAPI_OK ) then
Packit 577717 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     &      'PAPIf_add_event', retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
#elif (defined(__alpha)&&defined(__osf__))
Packit 577717 
      call PAPIf_add_event( EventSet, PAPI_TLB_DM, retval )
Packit 577717 
      if ( retval .NE. PAPI_OK ) then
Packit 577717 
        call ftest_fail(__FILE__, __LINE__,
Packit 577717 
     &      'PAPIf_add_event', retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
#else
Packit 577717 
      print *,'*** Did not match in event selection ***'
Packit 577717 
#endif
Packit 577717
Packit 577717 
      if(tests_quiet .EQ. 0) then
Packit 577717 
        write(*,*) 'Updated event set list:'
Packit 577717 
        call PrintEventSet(EventSet)
Packit 577717 
      endif
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 
      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 
      if (tests_quiet .EQ. 0) then
Packit 577717 
      write (*, *) "case4: ", values(1), values(2), values(3),
Packit 577717 
     *    values(4)
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', retval)
Packit 577717 
      end if
Packit 577717
Packit 577717 
      call PAPIF_shutdown()
Packit 577717 
      ret = SUCCESS
Packit 577717 
      end
Packit 577717

Powered by Pagure 5.13.3

SSH Hostkey/Fingerprint | Documentation