subroutine circle_rule ( nt, w, t ) !*****************************************************************************80 ! !! CIRCLE_RULE computes a quadrature rule for the unit circle. ! ! Discussion: ! ! The unit circle is the region: ! ! x * x + y * y = 1. ! ! The integral I(f) is then approximated by ! ! Q(f) = 2 * pi * sum ( 1 <= i <= NT ) W(i) * F ( cos(T(i)), sin(T(i)) ). ! ! Licensing: ! ! This code is distributed under the GNU LGPL license. ! ! Modified: ! ! 05 April 2014 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Input, integer ( kind = 4 ) NT, the number of angles to use. ! ! Output, real ( kind = 8 ) W(NT), the weights for the rule. ! ! Output, real ( kind = 8 ) T(NT), the angles for the rule. ! implicit none integer ( kind = 4 ) nt integer ( kind = 4 ) it real ( kind = 8 ), parameter :: r8_pi = 3.141592653589793D+00 real ( kind = 8 ) t(nt) real ( kind = 8 ) w(nt) w(1:nt) = 1.0D+00 / real ( nt, kind = 8 ) do it = 1, nt t(it) = 2.0D+00 * r8_pi * real ( it - 1, kind = 8 ) / real ( nt, kind = 8 ) end do return end subroutine circle01_monomial_integral ( e, integral ) !*****************************************************************************80 ! !! CIRCLE01_MONOMIAL_INTEGRAL: integral on circumference of unit circle in 2D. ! ! Discussion: ! ! The integration region is ! ! X^2 + Y^2 = 1. ! ! The monomial is F(X,Y) = X^E(1) * Y^E(2). ! ! Licensing: ! ! This code is distributed under the GNU LGPL license. ! ! Modified: ! ! 11 January 2014 ! ! Author: ! ! John Burkardt ! ! Reference: ! ! Philip Davis, Philip Rabinowitz, ! Methods of Numerical Integration, ! Second Edition, ! Academic Press, 1984, page 263. ! ! Parameters: ! ! Input, integer ( kind = 4 ) E(2), the exponents of X and Y in the ! monomial. Each exponent must be nonnegative. ! ! Output, real ( kind = 8 ) INTEGRAL, the integral. ! implicit none integer ( kind = 4 ) e(2) integer ( kind = 4 ) i real ( kind = 8 ) integral real ( kind = 8 ) r8_gamma real ( kind = 8 ), parameter :: r8_pi = 3.141592653589793D+00 if ( any ( e(1:2) < 0 ) ) then write ( *, '(a)' ) ' ' write ( *, '(a)' ) 'CIRCLE01_MONOMIAL_INTEGRAL - Fatal error!' write ( *, '(a)' ) ' All exponents must be nonnegative.' stop 1 end if if ( any ( mod ( e(1:2), 2 ) == 1 ) ) then integral = 0.0D+00 else integral = 2.0D+00 do i = 1, 2 integral = integral * r8_gamma ( 0.5D+00 * real ( e(i) + 1, kind = 8 ) ) end do integral = integral & / r8_gamma ( 0.5D+00 * ( real ( sum ( e(1:2) + 1 ), kind = 8 ) ) ) end if return end function r8_epsilon ( ) !*****************************************************************************80 ! !! R8_EPSILON returns the R8 roundoff unit. ! ! Discussion: ! ! The roundoff unit is a number R which is a power of 2 with the ! property that, to the precision of the computer's arithmetic, ! 1 < 1 + R ! but ! 1 = ( 1 + R / 2 ) ! ! FORTRAN90 provides the superior library routine ! ! EPSILON ( X ) ! ! Licensing: ! ! This code is distributed under the GNU LGPL license. ! ! Modified: ! ! 01 September 2012 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! Output, real ( kind = 8 ) R8_EPSILON, the round-off unit. ! implicit none real ( kind = 8 ) r8_epsilon r8_epsilon = 2.220446049250313D-016 return end function r8_gamma ( x ) !*****************************************************************************80 ! !! R8_GAMMA evaluates Gamma(X) for a real argument. ! ! Discussion: ! ! This routine calculates the gamma function for a real argument X. ! ! Computation is based on an algorithm outlined in reference 1. ! The program uses rational functions that approximate the gamma ! function to at least 20 significant decimal digits. Coefficients ! for the approximation over the interval (1,2) are unpublished. ! Those for the approximation for 12 <= X are from reference 2. ! ! Licensing: ! ! This code is distributed under the GNU LGPL license. ! ! Modified: ! ! 15 April 2013 ! ! Author: ! ! Original FORTRAN77 version by William Cody, Laura Stoltz. ! FORTRAN90 version by John Burkardt. ! ! Reference: ! ! William Cody, ! An Overview of Software Development for Special Functions, ! in Numerical Analysis Dundee, 1975, ! edited by GA Watson, ! Lecture Notes in Mathematics 506, ! Springer, 1976. ! ! John Hart, Ward Cheney, Charles Lawson, Hans Maehly, ! Charles Mesztenyi, John Rice, Henry Thatcher, ! Christoph Witzgall, ! Computer Approximations, ! Wiley, 1968, ! LC: QA297.C64. ! ! Parameters: ! ! Input, real ( kind = 8 ) X, the argument of the function. ! ! Output, real ( kind = 8 ) R8_GAMMA, the value of the function. ! implicit none real ( kind = 8 ), dimension ( 7 ) :: c = (/ & -1.910444077728D-03, & 8.4171387781295D-04, & -5.952379913043012D-04, & 7.93650793500350248D-04, & -2.777777777777681622553D-03, & 8.333333333333333331554247D-02, & 5.7083835261D-03 /) real ( kind = 8 ) fact integer ( kind = 4 ) i integer ( kind = 4 ) n real ( kind = 8 ), dimension ( 8 ) :: p = (/ & -1.71618513886549492533811D+00, & 2.47656508055759199108314D+01, & -3.79804256470945635097577D+02, & 6.29331155312818442661052D+02, & 8.66966202790413211295064D+02, & -3.14512729688483675254357D+04, & -3.61444134186911729807069D+04, & 6.64561438202405440627855D+04 /) logical parity real ( kind = 8 ), parameter :: pi = 3.1415926535897932384626434D+00 real ( kind = 8 ), dimension ( 8 ) :: q = (/ & -3.08402300119738975254353D+01, & 3.15350626979604161529144D+02, & -1.01515636749021914166146D+03, & -3.10777167157231109440444D+03, & 2.25381184209801510330112D+04, & 4.75584627752788110767815D+03, & -1.34659959864969306392456D+05, & -1.15132259675553483497211D+05 /) real ( kind = 8 ) r8_epsilon real ( kind = 8 ) r8_gamma real ( kind = 8 ) res real ( kind = 8 ), parameter :: sqrtpi = 0.9189385332046727417803297D+00 real ( kind = 8 ) sum real ( kind = 8 ) x real ( kind = 8 ), parameter :: xbig = 171.624D+00 real ( kind = 8 ) xden real ( kind = 8 ), parameter :: xinf = 1.79D+308 real ( kind = 8 ), parameter :: xminin = 2.23D-308 real ( kind = 8 ) xnum real ( kind = 8 ) y real ( kind = 8 ) y1 real ( kind = 8 ) ysq real ( kind = 8 ) z parity = .false. fact = 1.0D+00 n = 0 y = x ! ! Argument is negative. ! if ( y <= 0.0D+00 ) then y = - x y1 = aint ( y ) res = y - y1 if ( res /= 0.0D+00 ) then if ( y1 /= aint ( y1 * 0.5D+00 ) * 2.0D+00 ) then parity = .true. end if fact = - pi / sin ( pi * res ) y = y + 1.0D+00 else res = xinf r8_gamma = res return end if end if ! ! Argument is positive. ! if ( y < r8_epsilon ( ) ) then ! ! Argument < EPS. ! if ( xminin <= y ) then res = 1.0D+00 / y else res = xinf r8_gamma = res return end if else if ( y < 12.0D+00 ) then y1 = y ! ! 0.0 < argument < 1.0. ! if ( y < 1.0D+00 ) then z = y y = y + 1.0D+00 ! ! 1.0 < argument < 12.0. ! Reduce argument if necessary. ! else n = int ( y ) - 1 y = y - real ( n, kind = 8 ) z = y - 1.0D+00 end if ! ! Evaluate approximation for 1.0 < argument < 2.0. ! xnum = 0.0D+00 xden = 1.0D+00 do i = 1, 8 xnum = ( xnum + p(i) ) * z xden = xden * z + q(i) end do res = xnum / xden + 1.0D+00 ! ! Adjust result for case 0.0 < argument < 1.0. ! if ( y1 < y ) then res = res / y1 ! ! Adjust result for case 2.0 < argument < 12.0. ! else if ( y < y1 ) then do i = 1, n res = res * y y = y + 1.0D+00 end do end if else ! ! Evaluate for 12.0 <= argument. ! if ( y <= xbig ) then ysq = y * y sum = c(7) do i = 1, 6 sum = sum / ysq + c(i) end do sum = sum / y - y + sqrtpi sum = sum + ( y - 0.5D+00 ) * log ( y ) res = exp ( sum ) else res = xinf r8_gamma = res return end if end if ! ! Final adjustments and return. ! if ( parity ) then res = - res end if if ( fact /= 1.0D+00 ) then res = fact / res end if r8_gamma = res return end subroutine timestamp ( ) !*****************************************************************************80 ! !! TIMESTAMP prints the current YMDHMS date as a time stamp. ! ! Example: ! ! 31 May 2001 9:45:54.872 AM ! ! Licensing: ! ! This code is distributed under the GNU LGPL license. ! ! Modified: ! ! 18 May 2013 ! ! Author: ! ! John Burkardt ! ! Parameters: ! ! None ! implicit none character ( len = 8 ) ampm integer ( kind = 4 ) d integer ( kind = 4 ) h integer ( kind = 4 ) m integer ( kind = 4 ) mm character ( len = 9 ), parameter, dimension(12) :: month = (/ & 'January ', 'February ', 'March ', 'April ', & 'May ', 'June ', 'July ', 'August ', & 'September', 'October ', 'November ', 'December ' /) integer ( kind = 4 ) n integer ( kind = 4 ) s integer ( kind = 4 ) values(8) integer ( kind = 4 ) y call date_and_time ( values = 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 ( *, '(i2,1x,a,1x,i4,2x,i2,a1,i2.2,a1,i2.2,a1,i3.3,1x,a)' ) & d, trim ( month(m) ), y, h, ':', n, ':', s, '.', mm, trim ( ampm ) return end