File: openmp_18.f90

package info (click to toggle)
lfortran 0.45.0-1
  • links: PTS, VCS
  • area: main
  • in suites: sid, trixie
  • size: 46,332 kB
  • sloc: cpp: 137,068; f90: 51,260; python: 6,444; ansic: 4,277; yacc: 2,285; fortran: 806; sh: 524; makefile: 30; javascript: 15
file content (320 lines) | stat: -rw-r--r-- 7,388 bytes parent folder | download
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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
program openmp_18

!*****************************************************************************80
!
!! MAIN is the main program for COMPUTE_PI.
!
!  Discussion:
!
!    COMPUTE_PI estimates the value of PI.
!
!    This program uses Open MP parallelization directives.  
!
!    It should run properly whether parallelization is used or not.
!
!    However, the parallel version computes the sum in a different
!    order than the serial version; some of the quantities added are
!    quite small, and so this will affect the accuracy of the results.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    18 April 2009
!
!  Author:
!
!    John Burkardt
!
  use omp_lib

  implicit none

  integer, parameter :: logn_max = 9 ! change to 10 for more accurate results

  print *, '\n'
  print *, 'COMPUTE_PI'
  print *, '  FORTRAN90/OpenMP version'
  print *, '\n'
  print *, '  Estimate the value of PI by summing a series.'
  call omp_set_num_threads(8)

  print *, '\n'
  print *, '  The number of processors available = ', omp_get_num_procs ( )
  print *, '  The number of threads available    = ', omp_get_max_threads ( )


  call r8_test ( logn_max )
!
!  Terminate.
!
  print *, '\n'
  print *, 'COMPUTE_PI'
  print *, '  Normal end of execution.'

  stop 0
end
subroutine r8_test ( logn_max )

!*****************************************************************************80
!
!! R8_TEST estimates the value of PI using double precision.
!
!  Discussion:
!
!    PI is estimated using N terms.  N is increased from 10^2 to 10^LOGN_MAX.
!    The calculation is repeated using both sequential and Open MP enabled code.
!    Wall clock time is measured by calling SYSTEM_CLOCK.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    18 April 2009
!
!  Author:
!
!    John Burkardt
!
  use omp_lib

  implicit none

  double precision error
  double precision estimate
  integer logn
  integer logn_max
  character ( len = 3 ) mode
  integer n
  double precision, parameter :: r8_pi = 3.141592653589793D+00
  double precision wtime

  print *, ' '
  print *, 'R8_TEST:'
  print *, '  Estimate the value of PI,'
  print *, '  using double precision arithmetic.'
  print *, ' '
  print *, '  N = number of terms computed and added;'
  print *, ' '
  print *, '  MODE = SEQ for sequential code;'
  print *, '  MODE = OMP for Open MP enabled code;'
  print *, '  (performance depends on whether Open MP is used,'
  print *, '  and how many processes are available!)'
  print *, ' '
  print *, '  ESTIMATE = the computed estimate of PI;'
  print *, ' '
  print *, '  ERROR = ( the computed estimate - PI );'
  print *, ' '
  print *, '  TIME = elapsed wall clock time;'
  print *, ' '
  print *, '  Note that you can''t increase N forever, because:'
  print *, '  A) ROUNDOFF starts to be a problem, and'
  print *, '  B) maximum integer size is a problem.'
  print *, ' '
  print *, '  The maximum integer:' , huge ( n )
  print *, ' '
  print *, ' '
  print *, '             N Mode    Estimate        Error           Time'
  print *, ' '

  n = 1

  do logn = 1, logn_max
! 
!  Sequential calculation.
!
    mode = 'SEQ'

    wtime = omp_get_wtime ( )

    call r8_pi_est_seq ( n, estimate )

    wtime = omp_get_wtime ( ) - wtime

    error = abs ( estimate - r8_pi )
    if (logn == logn_max .and. error > 1e-12) error stop

    print *, &
      n, mode, estimate, error, wtime
!
!  Open MP enabled calculation.
!
    mode = 'OMP'

    wtime = omp_get_wtime ( )

    call r8_pi_est_omp ( n, estimate )

    wtime = omp_get_wtime ( ) - wtime

    error = abs ( estimate - r8_pi )

    print *, &
      n, mode, estimate, error, wtime

    n = n * 10

  end do

  return
end
subroutine r8_pi_est_omp ( n, estimate )

!*****************************************************************************80
!
!! R8_PI_EST_OMP estimates the value of PI, using Open MP.
!
!  Discussion:
!
!    The calculation is based on the formula for the indefinite integral:
!
!      Integral 1 / ( 1 + X**2 ) dx = Arctan ( X ) 
!
!    Hence, the definite integral
!
!      Integral ( 0 <= X <= 1 ) 1 / ( 1 + X**2 ) dx 
!      = Arctan ( 1 ) - Arctan ( 0 )
!      = PI / 4.
!
!    A standard way to approximate an integral uses the midpoint rule.
!    If we create N equally spaced intervals of width 1/N, then the
!    midpoint of the I-th interval is 
!
!      X(I) = (2*I-1)/(2*N).  
!
!    The approximation for the integral is then:
!
!      Sum ( 1 <= I <= N ) (1/N) * 1 / ( 1 + X(I)**2 )
!
!    In order to compute PI, we multiply this by 4; we also can pull out
!    the factor of 1/N, so that the formula you see in the program looks like:
!
!      ( 4 / N ) * Sum ( 1 <= I <= N ) 1 / ( 1 + X(I)**2 )
!
!    Until roundoff becomes an issue, greater accuracy can be achieved by 
!    increasing the value of N.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    13 January 2003
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, integer N, the number of terms to add up.
!
!    Output, double precision ESTIMATE, the estimated value of pi.
!
  implicit none

  double precision h
  double precision estimate
  integer i
  integer n
  double precision sum2
  double precision x

  h = 1.0D+00 / dble ( 2 * n )

  sum2 = 0.0D+00

!$omp parallel shared(h, n) private(i, x) reduction(+:sum2)
!$omp do
  do i = 1, n
    x = h * dble ( 2 * i - 1 )
    sum2 = sum2 + 1.0D+00 / ( 1.0D+00 + x**2 )
  end do
!$omp end do
!$omp end parallel

  estimate = 4.0D+00 * sum2 / dble ( n )

  return
end
subroutine r8_pi_est_seq ( n, estimate )

!*****************************************************************************80
!
!! R8_PI_EST_SEQ estimates the value of PI, using sequential execution.
!
!  Discussion:
!
!    The calculation is based on the formula for the indefinite integral:
!
!      Integral 1 / ( 1 + X**2 ) dx = Arctan ( X ) 
!
!    Hence, the definite integral
!
!      Integral ( 0 <= X <= 1 ) 1 / ( 1 + X**2 ) dx 
!      = Arctan ( 1 ) - Arctan ( 0 )
!      = PI / 4.
!
!    A standard way to approximate an integral uses the midpoint rule.
!    If we create N equally spaced intervals of width 1/N, then the
!    midpoint of the I-th interval is 
!
!      X(I) = (2*I-1)/(2*N).  
!
!    The approximation for the integral is then:
!
!      Sum ( 1 <= I <= N ) (1/N) * 1 / ( 1 + X(I)**2 )
!
!    In order to compute PI, we multiply this by 4; we also can pull out
!    the factor of 1/N, so that the formula you see in the program looks like:
!
!      ( 4 / N ) * Sum ( 1 <= I <= N ) 1 / ( 1 + X(I)**2 )
!
!    Until roundoff becomes an issue, greater accuracy can be achieved by 
!    increasing the value of N.
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    06 January 2003
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, integer N, the number of terms to add up.
!
!    Output, double precision ESTIMATE, the estimated value of pi.
!
  implicit none

  double precision h
  double precision estimate
  integer i
  integer n
  double precision sum2
  double precision x

  h = 1.0D+00 / dble ( 2 * n )

  sum2 = 0.0D+00

  do i = 1, n
    x = h * dble ( 2 * i - 1 )
    sum2 = sum2 + 1.0D+00 / ( 1.0D+00 + x**2 )
  end do

  estimate = 4.0D+00 * sum2 / dble ( n )

  return
end