-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathtest.f90
151 lines (118 loc) · 3.39 KB
/
test.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
!==============================================================================
program energytest
!==============================================================================
use omp_lib
implicit none
integer :: n, i, num_runs, ierr, run
real (kind=8), allocatable :: a(:), b(:), c(:)
real (kind=8) :: ssum, timespent
real (kind=8) :: energy_init, energy_final
real (kind=8) :: device_energy_init, device_energy_final
n=4000000
num_runs=2500
! allocate working memory
allocate(a(n), b(n), c(n), stat=ierr)
write (*,*) omp_get_max_threads(), ' threads'
! compute cumulative energy
call error(ierr /= 0, 'Problem allocating memory')
! initialize
do i=1,n
a(i) = exp(i/(2.0*n));
b(i) = i/2.0;
c(i) = 1.;
enddo
! get energy counter at startup
call energy(energy_init)
call device_energy(0, device_energy_init)
timespent = -omp_get_wtime()
!$omp parallel
do run=1,num_runs
!$omp do
do i=1,n
a(i) = a(i) + b(i)*c(i)
enddo
!$omp end do
enddo
!$omp end parallel
ssum=0.
!$omp parallel do reduction(+:ssum)
do i=1,n
ssum = ssum+a(i)
enddo
!$omp end parallel do
timespent = timespent + omp_get_wtime()
! get energy counter at end
call energy(energy_final)
call device_energy(0, device_energy_final)
write (*,*) 'that took ', energy_final-energy_init, ' Joules'
write (*,*) 'at rate ', (energy_final-energy_init)/timespent, ' Watts'
write (*,*) 'that took ', timespent, ' seconds'
write (*,*) ssum
deallocate(a, b, c)
!==============================================================================
contains
!==============================================================================
subroutine device_energy(i, e)
implicit none
integer, intent(in) :: i
real (kind=8), intent(out) :: e
character (120) :: filename
write(filename,'(A,I0,A)') '/sys/cray/pm_counters/accel', i, '_energy'
write(*,*) 'OPENING ', filename
open(unit=50, file=trim(filename), action='READ')
read(50,*) e
close(50)
end
subroutine energy(e)
implicit none
real (kind=8), intent(out) :: e
open(unit=50, file='/sys/cray/pm_counters/energy' ,action='READ')
read(50,*) e
close(50)
end
subroutine cpu_energy(e)
implicit none
real (kind=8), intent(out) :: e
open(unit=50, file='/sys/cray/pm_counters/cpu_energy' ,action='READ')
read(50,*) e
close(50)
end
subroutine memory_energy(e)
implicit none
real (kind=8), intent(out) :: e
open(unit=50, file='/sys/cray/pm_counters/cpu_energy' ,action='READ')
read(50,*) e
close(50)
end
subroutine device_power(p)
implicit none
real (kind=8), intent(out) :: p
open(unit=50, file='/sys/cray/pm_counters/accel_power' ,action='READ')
read(50,*) p
close(50)
end
subroutine power(p)
implicit none
real (kind=8), intent(out) :: p
open(unit=50, file='/sys/cray/pm_counters/power' ,action='READ')
read(50,*) p
close(50)
end
! write error message and terminate
subroutine error(yes, msg)
implicit none
! arguments
logical, intent(in) :: yes
character(len=*), intent(in) :: msg
! local
integer, external :: lnblnk
if (yes) then
write(0,*) 'FATAL PROGRAM ERROR!'
write(0,*) msg
write(0,*) 'Execution aborted...'
stop
end if
end
!==============================================================================
end program energytest
!==============================================================================