C ****************************************************************************
C
C matrixpapi.f
C An example of matrix-matrix multiplication and using PAPI low level to 
C look at the performance. written by Kevin London
C March 2000
C ****************************************************************************

#include "fpapi_test.h"

      program fmatrixlowpapi
      implicit integer (p)

      INTEGER ncols1,nrows1,ncols2,nrows2
      PARAMETER(nrows1=175,ncols1=225,nrows2=ncols1,ncols2=150)
      INTEGER i,j,k,retval,nchr,numevents,EventSet
      CHARACTER*(PAPI_MAX_STR_LEN)  vstring,mstring
C   PAPI values of the counters
      INTEGER event
      INTEGER*8 values(2)
      INTEGER*8 starttime,stoptime
      REAL*8 finaltime
      INTEGER ncpu,nnodes,totalcpus,vendor,model
      REAL revision, mhz
      REAL*8 p(nrows1,ncols1),q(nrows2,ncols2),
     &                 r(nrows1,ncols2)
      integer tests_quiet, get_quiet
      external get_quiet

      tests_quiet = get_quiet()
      EventSet = PAPI_NULL

C   Setup default values
      numevents=0
      starttime=0
      stoptime=0

      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     Create the eventset
      call PAPIf_create_eventset(EventSet,retval)
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__, 
     *'PAPIf_create_eventset', retval)
      end if

C   Total cycles
      call PAPIf_add_event(EventSet,PAPI_TOT_CYC,retval)
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__, 
     *'PAPIf_add_event PAPI_TOT_CYC', retval)
      end if

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

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

C   Grab the hardware info
      call PAPIf_get_hardware_info( ncpu, nnodes, totalcpus, vendor,
     .   vstring, model, mstring, revision, mhz )
      do i=len(mstring),1,-1
        if(mstring(i:i).NE.' ') goto 10
      end do
 10   if(i.LT.1)then 
        nchr=1
      else
        nchr=i
      end if

      if (tests_quiet .EQ. 0) then
      print *
      print 100, totalcpus,mstring(1:nchr), mhz
      print *
      print 101,'ncpu',ncpu, 'nnodes',nnodes, 'totalcpus',totalcpus
      print 102,'mhz',mhz,'revision',revision
      print 103,'vendor',vendor,'vstring',vstring
      print 104,'model',model,'mstring',mstring
      print *
      end if
 100  format(i5,' CPU(s) ',a,' at ',f7.2,' MHz')
 101  format(a9,' =',i6,7x,a9,' =',i5,5x,a9,'=',i5)
 102  format(a9,' =',f7.2,6x,a9,' =',f15.5)
 103  format(a9,' =',i6,7x,a9,' =',a40)
 104  format(a9,' =',i6,7x,a9,' =',a40)
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')

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  Grab the beginning time
      call PAPIf_get_real_usec( starttime )
 
C  Start the event counters
      call PAPIf_start( EventSet, retval )
      if ( retval .NE. PAPI_OK ) then
        call ftest_fail(__FILE__, __LINE__,
     . 'PAPIf_start', retval)
      end if

C  Compute the matrix-matrix multiplication
      do i=1,nrows1 
       do j=1,ncols2 
         do k=1,ncols1 
          r(i,j)=r(i,j) + p(i,k)*q(k,j)
         end do
       end do
      end do

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

      call PAPIf_get_real_usec( stoptime )
      finaltime=(REAL(stoptime)/1000000.0)-(REAL(starttime)/1000000.0)

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

      if (tests_quiet .EQ. 0) then
        print *, 'Time: ', finaltime, 'seconds'
        print *, 'Cycles: ', values(1)

          if (event .EQ. PAPI_TOT_INS) then
          print *, 'Total Instructions: ', values(2)
          else
          print *, 'FP Instructions: ', values(2)
          write(*,'(a,f9.6)') ' Efficiency (fp/cycle):',
     &                         real(values(2))/real(values(1))
          end if
      end if

      call ftests_pass(__FILE__)
      end