program compute_pi
!
!*******************************************************************************
!
!! COMPUTE_PI estimates the value of PI.
!
!
!  Discussion:
!
!    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.
!
!    The program may be compiled with Fortran 77 or Fortran 90.
!
!    The single precision code is noticeably less accurate than the
!    double precision code.  Again, the amount of difference depends
!    on whether the computation is done in parallel or not.
!
!  Modified:
!
!    16 March 2002
!
!  Author:
!
!    John Burkardt
!
  integer, parameter :: logn_max = 8
!
  call timestamp ( )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'COMPUTE_PI'
  write ( *, '(a)' ) '  Estimate the value of PI by summing a series.'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  This program includes OpenMP directives, which'
  write ( *, '(a)' ) '  may be used to run the program in parallel.'
  write ( *, '(a)' ) ' '

  write ( *, '(a)' ) ' '
  write ( *, '(a,i6)' ) '  LOGN_MAX = ', logn_max

  write ( *, '(a)' ) ' '
  call timestamp ( )

  call r_test ( logn_max )

  write ( *, '(a)' ) ' '
  call timestamp ( )

  call d_test ( logn_max )

  write ( *, '(a)' ) ' '
  call timestamp ( )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'COMPUTE_PI'
  write ( *, '(a)' ) '  Normal end of execution.'

  stop
end
subroutine r_test ( logn_max )
!
!*******************************************************************************
!
!! R_TEST estimates the value of PI using single precision.
!
!
!  Modified:
!
!    02 February 2000
!
!  Author:
!
!    John Burkardt
!
  real error
  real estimate
  integer logn
  integer logn_max
  integer n
  real r_pi
  real r_pi_est
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'R_TEST:'
  write ( *, '(a)' ) '  Using single precision arithmetic.'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '          N      Estimate        Error'
  write ( *, '(a)' ) ' '

  do logn = 2, logn_max

    n = 10**logn
    estimate = r_pi_est ( n )
    error = abs ( estimate - r_pi ( ) )

    write ( *, '( i12, 2x, f14.10, 2x, g14.6 )' ) n, estimate, error

  end do

  return
end
function r_pi_est ( n )
!
!*******************************************************************************
!
!! R_PI_EST estimates the value of PI.
!
!
!  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.
!
!  Modified:
!
!    30 May 2001
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, integer N, the number of terms to add up.
!
!    Output, real R_PI_EST, the estimated value of pi.
!
  real h
  integer i
  integer n
  real r_pi_est
  real sum2
  real x
!
  h = 1.0E+00 / real ( 2 * n )

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

  r_pi_est = 4.0E+00 * sum2 / real ( n )

  return
end
function r_pi ( )
!
!*******************************************************************************
!
!! R_PI returns the value of pi.
!
!
!  Modified:
!
!    02 February 2000
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Output, real R_PI, the value of pi.
!
  real r_pi
!
  r_pi = 3.14159265358979323846264338327950288419716939937510E+00

  return
end
subroutine d_test ( logn_max )
!
!*******************************************************************************
!
!! D_TEST estimates the value of PI using double precision.
!
!
!  Modified:
!
!    02 February 2000
!
!  Author:
!
!    John Burkardt
!
  double precision d_pi
  double precision d_pi_est
  double precision error
  double precision estimate
  integer logn
  integer logn_max
  integer n
!
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'D_TEST:'
  write ( *, '(a)' ) '  Using double precision arithmetic.'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '          N      Estimate        Error'
  write ( *, '(a)' ) ' '

  do logn = 2, logn_max

    n = 10**logn
    estimate = d_pi_est ( n )
    error = abs ( estimate - d_pi ( ) )

    write ( *, '( i12, 2x, f14.10, 2x, g14.6 )' ) n, estimate, error

  end do

  return
end
function d_pi_est ( n )
!
!*******************************************************************************
!
!! D_PI_EST estimates the value of PI.
!
!
!  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.
!
!  Modified:
!
!    30 May 2001
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, integer N, the number of terms to add up.
!
!    Output, double precision D_PI_EST, the estimated value of pi.
!
  double precision d_pi_est
  double precision h
  integer i
  integer n
  double precision sum2
  double precision x
!
  h = 1.0D+00 / dble ( 2 * n )

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

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

  return
end
function d_pi ( )
!
!*******************************************************************************
!
!! D_PI returns the value of pi.
!
!
!  Modified:
!
!    02 February 2000
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Output, double precision D_PI, the value of pi.
!
  double precision d_pi
!
  d_pi = 3.14159265358979323846264338327950288419716939937510D+00

  return
end
subroutine timestamp ( )
!
!*******************************************************************************
!
!! TIMESTAMP prints the current YMDHMS date as a time stamp.
!
!
!  Example:
!
!    May 31 2001   9:45:54.872 AM
!
!  Modified:
!
!    31 May 2001
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    None
!
  character ( len = 8 ) ampm
  integer d
  character ( len = 8 ) date
  integer h
  integer m
  integer mm
  character ( len = 9 ), parameter, dimension(12) :: month = (/ &
    'January  ', 'February ', 'March    ', 'April    ', &
    'May      ', 'June     ', 'July     ', 'August   ', &
    'September', 'October  ', 'November ', 'December ' /)
  integer n
  integer s
  character ( len = 10 )  time
  integer values(8)
  integer y
  character ( len = 5 ) zone
!
  call date_and_time ( date, time, zone, values )

  y = values(1)
  m = values(2)
  d = values(3)
  h = values(5)
  n = values(6)
  s = values(7)
  mm = values(8)

  if ( h < 12 ) then
    ampm = 'AM'
  else if ( h == 12 ) then
    if ( n == 0 .and. s == 0 ) then
      ampm = 'Noon'
    else
      ampm = 'PM'
    end if
  else
    h = h - 12
    if ( h < 12 ) then
      ampm = 'PM'
    else if ( h == 12 ) then
      if ( n == 0 .and. s == 0 ) then
        ampm = 'Midnight'
      else
        ampm = 'AM'
      end if
    end if
  end if

  write ( *, '(a,1x,i2,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) &
    trim ( month(m) ), d, y, h, ':', n, ':', s, '.', mm, trim ( ampm )

  return
end