| 1 | PROGRAM TESTPAPIEVENTS | 
| 2 | #include <fpapi.h> | 
| 3 | CHARACTER*13 EventName | 
| 4 | INTEGER nmaxevents | 
| 5 | PARAMETER (nmaxevents = 18) | 
| 6 | INTEGER EventCode(nmaxevents) | 
| 7 | LOGICAL use_counter(nmaxevents) | 
| 8 | INTEGER*8 values(nmaxevents), values1(nmaxevents), | 
| 9 | $     values2(nmaxevents) | 
| 10 | COMMON /papivalues/ values, values1, values2 | 
| 11 | INTEGER neventsmax, nevents, Check, EventSet | 
| 12 | INTEGER papiunit | 
| 13 | SAVE EventCode, neventsmax, nevents, EventSet | 
| 14 | REAL*4 f, df, arg, PI | 
| 15 | INTEGER i, j, valid_counters | 
| 16 |  | 
| 17 | PI=4.0E0*ATAN(1.0) | 
| 18 | f=0.0 | 
| 19 |  | 
| 20 | Check = PAPI_VER_CURRENT | 
| 21 | call PAPIF_library_init(Check) | 
| 22 | if (Check .NE. PAPI_VER_CURRENT) then | 
| 23 | WRITE(*,*) "PAPI Library Version is out of Date" | 
| 24 | CALL ABORT | 
| 25 | endif | 
| 26 | call PAPIF_num_counters(neventsmax) | 
| 27 | if (neventsmax .GT. nmaxevents) then | 
| 28 | WRITE(*,*) "Fix the nmaxevents in the code to ", neventsmax | 
| 29 | CALL ABORT | 
| 30 | endif | 
| 31 | papiunit=99 | 
| 32 | OPEN(UNIT=papiunit,FILE='data.papi',STATUS='OLD') | 
| 33 | read(papiunit,*) nevents | 
| 34 | C     reset to reasonable values | 
| 35 | if (nevents .gt. neventsmax) then | 
| 36 | nevents = neventsmax | 
| 37 | WRITE(*,*) "resetting the number of PAPI events to the maximum" | 
| 38 | endif | 
| 39 | do i = 1,nevents | 
| 40 | read(papiunit,*) EventName | 
| 41 | call PAPIF_event_name_to_code(EventName, EventCode(i), Check) | 
| 42 | end do | 
| 43 | close(papiunit) | 
| 44 | EventSet = PAPI_NULL | 
| 45 | call PAPIF_create_eventset(EventSet, Check) | 
| 46 | valid_counters = 0 | 
| 47 | do i = 1,nevents | 
| 48 | call PAPIF_add_event(EventSet, EventCode(i), Check) | 
| 49 | if (Check .NE. PAPI_OK) then | 
| 50 | call PAPIF_event_code_to_name(EventCode(i),EventName,Check) | 
| 51 | WRITE(*,*) "Error after PAPIF_add_event: ", EventName | 
| 52 | use_counter(i) = .false. | 
| 53 | else | 
| 54 | valid_counters = valid_counters + 1 | 
| 55 | use_counter(i) = .true. | 
| 56 | endif | 
| 57 | enddo | 
| 58 | CCE107 - Start counting events | 
| 59 | call PAPIF_start(EventSet, Check) | 
| 60 | CCE107 - Read event counts | 
| 61 | call PAPIF_read(EventSet, values1, Check) | 
| 62 |  | 
| 63 | do i=1,100000 | 
| 64 | arg = PI/1000.0*i*nevents | 
| 65 | df = tan(arg) | 
| 66 | f = f + df | 
| 67 | WRITE (10,*) f, df, arg | 
| 68 | enddo | 
| 69 |  | 
| 70 | CCE107 - Read event counts | 
| 71 | call PAPIF_read(EventSet, values2, Check) | 
| 72 |  | 
| 73 | do i=1,valid_counters | 
| 74 | values(i) = values2(i) - values1(i) | 
| 75 | enddo | 
| 76 |  | 
| 77 | WRITE (*,*) "f = ", f | 
| 78 | j = 1 | 
| 79 | do i = 1,nevents | 
| 80 | if (use_counter(i)) then | 
| 81 | call PAPIF_event_code_to_name(EventCode(i),EventName,Check) | 
| 82 | WRITE(*,*) Eventname, values(j), values1(j), values2(j) | 
| 83 | j = j + 1 | 
| 84 | endif | 
| 85 | enddo | 
| 86 |  | 
| 87 | end | 
| 88 |  | 
| 89 |  | 
| 90 | BLOCK DATA setpapivalues | 
| 91 | INTEGER nmaxevents | 
| 92 | PARAMETER (nmaxevents = 18) | 
| 93 | INTEGER size | 
| 94 | PARAMETER (size = 3*nmaxevents) | 
| 95 | INTEGER*8 values(nmaxevents), values1(nmaxevents), | 
| 96 | $     values2(nmaxevents) | 
| 97 | COMMON /papivalues/ values, values1, values2 | 
| 98 | DATA values, values1, values2 /size*0/ | 
| 99 | END |