Ticket #46626: quadpack_example.f90

File quadpack_example.f90, 2.5 KB (added by paul.whelan07@…, 9 years ago)
Line 
1program main
2
3!*****************************************************************************80
4!
5!! MAIN is the main program for QUADPACK_PRB.
6!
7!  Discussion:
8!
9!    QUADPACK_PRB tests the QUADPACK library.
10!
11!  Modified:
12!
13!    03 February 2007
14!
15!  Author:
16!
17!    John Burkardt
18!
19  implicit none
20
21 
22  write ( *, '(a)' ) ' '
23  write ( *, '(a)' ) 'QUADPACK_PRB'
24  write ( *, '(a)' ) '  FORTRAN90 version'
25  write ( *, '(a)' ) '  Test the QUADPACK library.'
26
27  call test01 ( )
28
29!
30!  Terminate.
31!
32  write ( *, '(a)' ) ' '
33  write ( *, '(a)' ) 'QUADPACK_PRB'
34  write ( *, '(a)' ) '  Normal end of execution.'
35  write ( *, '(a)' ) ' '
36 
37  stop
38end
39
40
41subroutine test01 ( )
42
43!*****************************************************************************80
44!
45!! TEST01 tests QAG.
46!
47!  Discussion:
48!
49!    QAG is an adaptive automatic integrator using a Gauss-Kronrod rule.
50!
51!    integrate cos(100*sin(x)) from 0 to pi.
52!
53!    The exact answer is pi * j0(100), or roughly 0.06278740.
54!
55!    KEY chooses the order of the integration rule, from 1 to 6.
56!
57  implicit none
58
59  real, parameter :: a = 0.0E+00
60  real abserr
61  real b
62  real, parameter :: epsabs = 0.0E+00
63  real, parameter :: epsrel = 0.001E+00
64  real, external :: f02
65  integer ier
66  integer, parameter :: key = 6
67  integer neval
68  real, parameter :: pi = 3.141592653589793E+00
69  real result
70  real, parameter :: true = 0.06278740E+00
71  real, parameter :: limit = 200
72 
73
74  b = pi
75
76 
77 
78
79  call qag ( f02, a, b, epsabs, epsrel, key, result, abserr, neval, ier)
80
81  write ( *, '(a)' ) ' '
82  write ( *, '(a)' ) 'TEST01'
83  write ( *, '(a)' ) '  Test QAG'
84  write ( *, '(a)' ) ' '
85  write ( *, '(a)' ) '  Integrand is COS(100*SIN(X))'
86  write ( *, '(a,g14.6)' ) '  Integral left endpoint A =    ', a
87  write ( *, '(a,g14.6)' ) '  Integral right endpoint B =   ', b
88  write ( *, '(a,g14.6)' ) '  Exact integral is             ', true
89  write ( *, '(a,g14.6)' ) '  Estimated integral is         ', result
90  write ( *, '(a,g14.6)' ) '  Estimated integral error =    ', abserr
91  write ( *, '(a,g14.6)' ) '  Exact integral error =        ', true - result
92  write ( *, '(a,i8)' ) '  Number of function evaluations, NEVAL = ', neval
93  write ( *, '(a,i8)' ) '  Error return code IER = ', ier
94
95  return
96end
97
98
99
100function f02 ( x )
101
102  !*****************************************************************************80
103  ! F02 is the integrand function COS(100*SIN(X)).
104  !*****************************************************************************80
105
106  implicit none
107  real f02
108  real x
109
110  f02 = cos ( 100.0E+00 * sin ( x ) )
111
112  return
113end function f02
114