Mercurial > octave-nkf
annotate liboctave/cruft/quadpack/qagi.f @ 20595:c1a6c31ac29a
eliminate more simple uses of error_state
* ov-classdef.cc: Eliminate simple uses of error_state.
author | John W. Eaton <jwe@octave.org> |
---|---|
date | Tue, 06 Oct 2015 00:20:02 -0400 |
parents | 648dabbb4c6b |
children |
rev | line source |
---|---|
7793
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
1 subroutine qagi(f,bound,inf,epsabs,epsrel,result,abserr,neval, |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
2 * ier,limit,lenw,last,iwork,work) |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
3 c***begin prologue qagi |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
4 c***date written 800101 (yymmdd) |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
5 c***revision date 830518 (yymmdd) |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
6 c***category no. h2a3a1,h2a4a1 |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
7 c***keywords automatic integrator, infinite intervals, |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
8 c general-purpose, transformation, extrapolation, |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
9 c globally adaptive |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
10 c***author piessens,robert,appl. math. & progr. div. - k.u.leuven |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
11 c de doncker,elise,appl. math. & progr. div. -k.u.leuven |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
12 c***purpose the routine calculates an approximation result to a given |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
13 c integral i = integral of f over (bound,+infinity) |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
14 c or i = integral of f over (-infinity,bound) |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
15 c or i = integral of f over (-infinity,+infinity) |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
16 c hopefully satisfying following claim for accuracy |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
17 c abs(i-result).le.max(epsabs,epsrel*abs(i)). |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
18 c***description |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
19 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
20 c integration over infinite intervals |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
21 c standard fortran subroutine |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
22 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
23 c parameters |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
24 c on entry |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
25 c f - subroutine f(x,result) defining the integrand |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
26 c function f(x). the actual name for f needs to be |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
27 c declared e x t e r n a l in the driver program. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
28 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
29 c bound - real |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
30 c finite bound of integration range |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
31 c (has no meaning if interval is doubly-infinite) |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
32 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
33 c inf - integer |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
34 c indicating the kind of integration range involved |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
35 c inf = 1 corresponds to (bound,+infinity), |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
36 c inf = -1 to (-infinity,bound), |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
37 c inf = 2 to (-infinity,+infinity). |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
38 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
39 c epsabs - real |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
40 c absolute accuracy requested |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
41 c epsrel - real |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
42 c relative accuracy requested |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
43 c if epsabs.le.0 |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
44 c and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
45 c the routine will end with ier = 6. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
46 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
47 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
48 c on return |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
49 c result - real |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
50 c approximation to the integral |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
51 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
52 c abserr - real |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
53 c estimate of the modulus of the absolute error, |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
54 c which should equal or exceed abs(i-result) |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
55 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
56 c neval - integer |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
57 c number of integrand evaluations |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
58 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
59 c ier - integer |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
60 c ier = 0 normal and reliable termination of the |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
61 c routine. it is assumed that the requested |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
62 c accuracy has been achieved. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
63 c - ier.gt.0 abnormal termination of the routine. the |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
64 c estimates for result and error are less |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
65 c reliable. it is assumed that the requested |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
66 c accuracy has not been achieved. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
67 c error messages |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
68 c ier = 1 maximum number of subdivisions allowed |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
69 c has been achieved. one can allow more |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
70 c subdivisions by increasing the value of |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
71 c limit (and taking the according dimension |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
72 c adjustments into account). however, if |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
73 c this yields no improvement it is advised |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
74 c to analyze the integrand in order to |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
75 c determine the integration difficulties. if |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
76 c the position of a local difficulty can be |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
77 c determined (e.g. singularity, |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
78 c discontinuity within the interval) one |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
79 c will probably gain from splitting up the |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
80 c interval at this point and calling the |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
81 c integrator on the subranges. if possible, |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
82 c an appropriate special-purpose integrator |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
83 c should be used, which is designed for |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
84 c handling the type of difficulty involved. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
85 c = 2 the occurrence of roundoff error is |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
86 c detected, which prevents the requested |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
87 c tolerance from being achieved. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
88 c the error may be under-estimated. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
89 c = 3 extremely bad integrand behaviour occurs |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
90 c at some points of the integration |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
91 c interval. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
92 c = 4 the algorithm does not converge. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
93 c roundoff error is detected in the |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
94 c extrapolation table. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
95 c it is assumed that the requested tolerance |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
96 c cannot be achieved, and that the returned |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
97 c result is the best which can be obtained. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
98 c = 5 the integral is probably divergent, or |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
99 c slowly convergent. it must be noted that |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
100 c divergence can occur with any other value |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
101 c of ier. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
102 c = 6 the input is invalid, because |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
103 c (epsabs.le.0 and |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
104 c epsrel.lt.max(50*rel.mach.acc.,0.5d-28)) |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
105 c or limit.lt.1 or leniw.lt.limit*4. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
106 c result, abserr, neval, last are set to |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
107 c zero. exept when limit or leniw is |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
108 c invalid, iwork(1), work(limit*2+1) and |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
109 c work(limit*3+1) are set to zero, work(1) |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
110 c is set to a and work(limit+1) to b. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
111 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
112 c dimensioning parameters |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
113 c limit - integer |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
114 c dimensioning parameter for iwork |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
115 c limit determines the maximum number of subintervals |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
116 c in the partition of the given integration interval |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
117 c (a,b), limit.ge.1. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
118 c if limit.lt.1, the routine will end with ier = 6. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
119 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
120 c lenw - integer |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
121 c dimensioning parameter for work |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
122 c lenw must be at least limit*4. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
123 c if lenw.lt.limit*4, the routine will end |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
124 c with ier = 6. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
125 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
126 c last - integer |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
127 c on return, last equals the number of subintervals |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
128 c produced in the subdivision process, which |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
129 c determines the number of significant elements |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
130 c actually in the work arrays. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
131 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
132 c work arrays |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
133 c iwork - integer |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
134 c vector of dimension at least limit, the first |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
135 c k elements of which contain pointers |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
136 c to the error estimates over the subintervals, |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
137 c such that work(limit*3+iwork(1)),... , |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
138 c work(limit*3+iwork(k)) form a decreasing |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
139 c sequence, with k = last if last.le.(limit/2+2), and |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
140 c k = limit+1-last otherwise |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
141 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
142 c work - real |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
143 c vector of dimension at least lenw |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
144 c on return |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
145 c work(1), ..., work(last) contain the left |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
146 c end points of the subintervals in the |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
147 c partition of (a,b), |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
148 c work(limit+1), ..., work(limit+last) contain |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
149 c the right end points, |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
150 c work(limit*2+1), ...,work(limit*2+last) contain the |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
151 c integral approximations over the subintervals, |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
152 c work(limit*3+1), ..., work(limit*3) |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
153 c contain the error estimates. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
154 c***references (none) |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
155 c***routines called qagie,xerror |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
156 c***end prologue qagi |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
157 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
158 real abserr, epsabs,epsrel,result,work |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
159 integer ier,iwork, lenw,limit,lvl,l1,l2,l3,neval |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
160 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
161 dimension iwork(limit),work(lenw) |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
162 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
163 external f |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
164 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
165 c check validity of limit and lenw. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
166 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
167 c***first executable statement qagi |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
168 ier = 6 |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
169 neval = 0 |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
170 last = 0 |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
171 result = 0.0e+00 |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
172 abserr = 0.0e+00 |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
173 if(limit.lt.1.or.lenw.lt.limit*4) go to 10 |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
174 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
175 c prepare call for qagie. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
176 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
177 l1 = limit+1 |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
178 l2 = limit+l1 |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
179 l3 = limit+l2 |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
180 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
181 call qagie(f,bound,inf,epsabs,epsrel,limit,result,abserr, |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
182 * neval,ier,work(1),work(l1),work(l2),work(l3),iwork,last) |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
183 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
184 c call error handler if necessary. |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
185 c |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
186 lvl = 0 |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
187 10 if(ier.eq.6) lvl = 1 |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
188 if(ier.ne.0) call xerror('abnormal return from qagi',26,ier,lvl) |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
189 return |
96ba591be50f
Add some more support for single precision to libcruft functions
David Bateman <dbateman@free.fr>
parents:
diff
changeset
|
190 end |