C ****************************************************************************
C
C fmatrixpapi2.f
C An example of matrix-matrix multiplication and using PAPI high level to 
C look at the performance. The example illustrates how PAPIF_read_counters
C and PAPIF_accum_counters can be used to selectively measure parts of a
C code without having to use the low-level interface.
C
C Derived from an example written by Kevin London March 2000
C ****************************************************************************

#include "fpapi_test.h"

      program fmatrixpapi
      IMPLICIT integer (p)

      INTEGER ncols1,nrows1,ncols2,nrows2
      PARAMETER(nrows1=175,ncols1=225,nrows2=ncols1,ncols2=150)
      INTEGER i,j,num_events,retval
C   PAPI standardized event to be monitored
      INTEGER event(2)
C   PAPI values of the counters
      INTEGER*8 values(2), dummies(2)
      REAL*8 p(nrows1,ncols1),q(nrows2,ncols2),
     &                 r(nrows1,ncols2)
      integer tests_quiet, get_quiet
      external get_quiet

      tests_quiet = get_quiet()

C   Setup default values
      num_events=0

C   Open matrix file number 1 for reading
C      OPEN(UNIT=1,FILE='fmt1',STATUS='OLD')
C   Open matrix file number 2 for reading
C      OPEN(UNIT=2,FILE='fmt2',STATUS='OLD')

      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

C   Total floating point operations
        call PAPIf_query_event(PAPI_FP_INS, retval)
        if (retval .NE. PAPI_OK) then
        event(1) = PAPI_TOT_INS
        else
C   Total floating point operations
        event(1) = PAPI_FP_INS
        end if

C  Time used
      event(2) = PAPI_TOT_CYC

C   See how many hardware events at one time are supported
      call PAPIf_num_counters( num_events )
      if ( num_events .LT. 2 ) then
          print *,'This example program requries the architecture ',
     .    'to support 2 simultaneous hardware events...shutting down.'
      stop
      end if

      if (tests_quiet .EQ. 0) then
      print *, 'Number of hardware counters supported: ', num_events
      end if

C   matrix 1: read in the matrix values
      do i=1, nrows1
         do j=1,ncols1
            p(i,j) = i*j*1.0
         end do
      end do

C   matrix 2: read in the matrix values
      do i=1, nrows2
         do j=1,ncols2
            q(i,j) = i*j*1.0
         end do
      end do

C  Initialize the result matrix 
      do i=1,nrows1
         do j=1, ncols2
            r(i,j) = i*j*1.0
         end do
      end do
      
C  Set up the counters
      num_events = 2
      call PAPIf_start_counters( event, num_events, retval)
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__, 
     *'PAPIf_start_counters', retval)
      end if

C  We wish to count the events for this call
      call Adding_MatMult(p,q,r,nrows1,ncols1,ncols2)

C  Read and clear the counter values
      call PAPIf_read_counters(values, num_events,retval)
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__, 
     *'PAPIf_read_counters', retval)
      end if

      if (tests_quiet .EQ. 0) then
        print *
         if (event(1) .EQ. PAPI_TOT_INS) then
          print *, 'TOT Instructions:  ',values(1)
         else
            print *, 'FP Instructions:  ',values(1)
         end if

        print *, 'Cycles: ',values(2)

           if (event(1) .EQ. PAPI_FP_INS) then
             write(*,'(a,f9.6)') ' Efficiency (flops/cycles):',
     &                         real(values(1))/real(values(2))
           end if
      end if

C  We don't wish to count the events for this call
      call Adding_MatMult(p,q,r,nrows1,ncols1,ncols2)

C  Clear the counter values
      call PAPIf_read_counters(dummies, num_events,retval)
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__, 
     *'PAPIf_read_counters', retval)
      end if

C  We wish to count the events for this call
      call Adding_MatMult(p,q,r,nrows1,ncols1,ncols2)

C  Read the counter values
      call PAPIf_accum_counters(values, num_events,retval)
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__, 
     *'PAPIf_accum_counters', retval)
      end if

C  Stop the counters and put the results in the array values 
      call PAPIf_stop_counters(dummies,num_events,retval)
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__, 
     *'PAPIf_stop_counters', retval)
      end if

      if (tests_quiet .EQ. 0) then
        print *
          if (event(1) .EQ. PAPI_TOT_INS) then
                print *, 'TOT Instructions:  ',values(1)
          else
                print *, 'FP Instructions:  ',values(1)
          end if

        print *, 'Cycles: ',values(2)

          if (event(1) .EQ. PAPI_FP_INS) then
               write(*,'(a,f9.6)') ' Efficiency (flops/cycles):',
     &                         real(values(1))/real(values(2))
          end if

        print *
        print *,'----------------------------------------------------'
        print *,'The second instruction and cycle counts should be'
        print *,'approximately twice the first ones. The efficiency'
        print *,'metric should be fairly equal between the cases.'
      end if

      call ftests_pass(__FILE__)
      end

      subroutine Adding_MatMult(p,q,r,ni,nk,nj)
      implicit integer (p)
      integer ni,nk,nj
      real*8 p(ni,*),q(nk,*),r(ni,nj)

      integer i,j,k
C  Compute the matrix-matrix multiplication
      do i=1,ni
       do j=1,nj
         do k=1,nk
           r(i,j)=r(i,j) + p(i,k)*q(k,j)
         end do
       end do
      end do

C  Make sure the compiler does not optimize away the multiplication
      call dummy(r)

      end