#include "fpapi_test.h"

      program multiplex1
      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 ("multiplex1: Using ", I3, " iterations")
         write (*,*) "case1: Does PAPI_multiplex_init() not break",
     *" regular operation?"
      end if   
      call case1(retval, tests_quiet)
      if (tests_quiet .EQ. 0) then
         write (*,*) "case2: Does setmpx/add work?"
      end if
      call case2(retval, tests_quiet)
      if (tests_quiet .EQ. 0) then
         write (*,*) "case3: Does add/setmpx work?"
      end if
      call case3(retval, tests_quiet)
      if (tests_quiet .EQ. 0) then
         write (*,*) "case4: Does add/setmpx/add work?"
      end if
      call case4(retval, tests_quiet)

      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 ftests_pass(__FILE__)

      end

      subroutine init_papi(event)
      IMPLICIT integer (p)
      integer retval
      integer event

      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_TOT_INS, retval)
        if (retval .NE. PAPI_OK) then
        event = PAPI_TOT_CYC 
        else
        event = PAPI_TOT_INS 
        end if
      end

C     Tests that PAPI_multiplex_init does not mess with normal operation. 
      subroutine case1(ret, tests_quiet)
      IMPLICIT integer (p)
      integer ret, tests_quiet, event
      integer retval, EventSet
      INTEGER*8 values(4)
      integer fd

      EventSet = PAPI_NULL
      call init_papi(event)
      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_add_event( EventSet, event, retval )
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__,
     &      'PAPIf_add_event', retval)
      end if

      call PAPIf_add_event( EventSet, PAPI_TOT_CYC, retval )
      if ( retval .NE. PAPI_OK ) then
        call PAPIf_add_event( EventSet, PAPI_TOT_IIS, retval )
        if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__,
     &        'PAPIf_add_event', retval)
        end if
      end if

      if(tests_quiet .EQ. 0) then
        write(*,*) 'Event set list'
        call PrintEventSet(EventSet)
      end if

      call do_stuff()
      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

      if (tests_quiet .EQ. 0) then
      print *, "case1: ", values(1), values(2)
      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_shutdown()
      ret = SUCCESS
      end

C     Tests that PAPI_set_multiplex() works before adding events
      subroutine case2(ret, tests_quiet)
      IMPLICIT integer (p)
      integer ret, tests_quiet, event
      integer retval, EventSet
      INTEGER*8 values(4)
      integer fd

      EventSet = PAPI_NULL
      call init_papi(event)
      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', 1)
      end if
      if ( retval.NE.PAPI_OK) then
        call ftest_fail(__FILE__, __LINE__,
     &      'papif_set_multiplex', retval)
      end if

      call PAPIf_add_event( EventSet, event, retval )
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__,
     &      'PAPIf_add_event', retval)
      end if

      call PAPIf_add_event( EventSet, PAPI_TOT_CYC, retval )
      if ( retval .NE. PAPI_OK ) then
        call PAPIf_add_event( EventSet, PAPI_TOT_IIS, retval)
        if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__,
     &        'PAPIf_add_event', retval)
        end if
      end if

C  This print-out is disabled until PAPIf_list_event is working
C  for multiplexed event sets (change -4711 to 0 when it is working)
      if(tests_quiet .EQ. 0) then
        write(*,*) 'Event set list'
        call PrintEventSet(EventSet)
      endif

      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

      if (tests_quiet .EQ. 0) then
      print *, "case2: ", values(1), values(2)
      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_shutdown()
      ret = SUCCESS
      end

C     Tests that PAPI_set_multiplex() works after adding events
      subroutine case3(ret, tests_quiet)
      IMPLICIT integer (p)
      integer ret, tests_quiet, event
      integer retval, EventSet
      INTEGER*8 values(4)
      integer fd

      EventSet = PAPI_NULL
      call init_papi(event)
      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_add_event( EventSet, event, retval )
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__,
     &      'PAPIf_add_event', retval)
      end if

      call PAPIf_add_event( EventSet, PAPI_TOT_CYC, retval )
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__,
     &      'PAPIf_add_event', retval)
      end if

      if(tests_quiet .EQ. 0) then
        write(*,*) 'Event set before call to PAPIf_set_multiplex:'
        call PrintEventSet(EventSet)
      endif

      call PAPIf_set_multiplex(EventSet, retval)
      if ( retval.NE.PAPI_OK) then
        call ftest_fail(__FILE__, __LINE__,
     &      'papif_set_multiplex', retval)
      end if

      if(tests_quiet .EQ. 0) then
        write(*,*) 'Event set after call to PAPIf_set_multiplex:'
        call PrintEventSet(EventSet)
      endif

      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

      if (tests_quiet .EQ. 0) then
      print *, "case3: ", values(1), values(2)
      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_shutdown()
      ret = SUCCESS
      end

C     Tests that PAPI_set_multiplex() works before adding events
C     Tests that PAPI_add_event() works after
C     PAPI_add_event()/PAPI_set_multiplex()
      subroutine case4(ret, tests_quiet)
      IMPLICIT integer (p)
      integer ret, tests_quiet, event
      integer retval, EventSet
      INTEGER*8 values(4)
      integer fd

      EventSet = PAPI_NULL
      call init_papi(event)
      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_add_event( EventSet, event, retval )
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__,
     &      'PAPIf_add_event', retval)
      end if

      call PAPIf_add_event( EventSet, PAPI_TOT_CYC, retval )
      if ( retval .NE. PAPI_OK ) then
        call PAPIf_add_event( EventSet, PAPI_TOT_IIS, retval )
        if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__,
     &        'PAPIf_add_event', retval)
        end if
      end if

      if(tests_quiet .EQ. 0) then
        write(*,*) 'Event set before call to PAPIf_set_multiplex:'
        call PrintEventSet(EventSet)
      endif

      call PAPIf_set_multiplex(EventSet, retval)
      if ( retval.NE.PAPI_OK) then
        call ftest_fail(__FILE__, __LINE__,
     &      'papif_set_multiplex', retval)
      end if

      if(tests_quiet .EQ. 0) then
        write(*,*) 'Event set after call to PAPIf_set_multiplex:'
        call PrintEventSet(EventSet)
      endif

#if (defined(i386)&&defined(linux))||defined(mips) || (defined(__ia64__) && defined(linux)) || (SUBSTR==aix-power)

      call PAPIf_add_event( EventSet, PAPI_L1_DCM, retval )
C Try alternative event if the above is not possible to use...
      if ( retval .EQ. PAPI_ECNFLCT .OR. retval .EQ. PAPI_ENOEVNT ) then
        call PAPIf_add_event( EventSet, PAPI_L2_DCM, retval )
      end if
      if ( retval .EQ. PAPI_ECNFLCT .OR. retval .EQ. PAPI_ENOEVNT ) then
        call PAPIf_add_event( EventSet, PAPI_L2_TCM, retval )
      end if
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__,
     &      'PAPIf_add_event', retval)
      end if

      call PAPIf_add_event( EventSet, PAPI_L1_ICM, retval )
C Try alternative event if the above is not possible to use...
      if ( retval .EQ. PAPI_ECNFLCT .OR. retval .EQ. PAPI_ENOEVNT ) then
        call PAPIf_add_event( EventSet, PAPI_L1_LDM, retval )
      end if
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__,
     &      'PAPIf_add_event', retval)
      end if

#elif (defined(sparc) && defined(sun))
      call PAPIf_add_event( EventSet, PAPI_LD_INS, retval )
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__,
     &      'PAPIf_add_event', retval)
      end if
      call PAPIf_add_event( EventSet, PAPI_SR_INS, retval )
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__,
     &      'PAPIf_add_event', retval)
      end if

#elif (defined(__alpha)&&defined(__osf__))
      call PAPIf_add_event( EventSet, PAPI_TLB_DM, retval )
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__,
     &      'PAPIf_add_event', retval)
      end if

#else
      print *,'*** Did not match in event selection ***'
#endif

      if(tests_quiet .EQ. 0) then
        write(*,*) 'Updated event set list:'
        call PrintEventSet(EventSet)
      endif

      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

      if (tests_quiet .EQ. 0) then
      write (*, *) "case4: ", values(1), values(2), values(3), 
     *    values(4)
      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_shutdown()
      ret = SUCCESS
      end