1 // This code has been mechanically translated from the original FORTRAN
2 // code at http://netlib.org/quadpack.
3 
4 /** Authors:    Lars Tandle Kyllingstad
5     Copyright:  Copyright (c) 2009, Lars T. Kyllingstad. All rights reserved.
6     License:    Boost License 1.0
7 */
8 module scid.ports.quadpack.qags;
9 
10 
11 import std.conv;
12 import scid.ports.quadpack.qagse;
13 
14 version(unittest)
15 {
16     import std.math;
17     import scid.core.testing;
18 }
19 
20 
21 
22 
23 ///
24 void qags(Real, Func)(Func f, Real a, Real b, Real epsabs,Real epsrel,
25     out Real result, out Real abserr, out int neval, out int ier,
26     int limit, int lenw, out int last, int* iwork, Real* work)
27 {
28 //***begin prologue  dqags
29 //***date written   800101   (yymmdd)
30 //***revision date  830518   (yymmdd)
31 //***category no.  h2a1a1
32 //***keywords  automatic integrator, general-purpose,
33 //             (end-point) singularities, extrapolation,
34 //             globally adaptive
35 //***author  piessens,robert,appl. math. & progr. div. - k.u.leuven
36 //           de doncker,elise,appl. math. & prog. div. - k.u.leuven
37 //***purpose  the routine calculates an approximation result to a given
38 //            definite integral  i = integral of f over (a,b),
39 //            hopefully satisfying following claim for accuracy
40 //            abs(i-result).le.max(epsabs,epsrel*abs(i)).
41 //***description
42 //
43 //        computation of a definite integral
44 //        standard fortran subroutine
45 //        double precision version
46 //
47 //
48 //        parameters
49 //         on entry
50 //            f      - double precision
51 //                     function subprogram defining the integrand
52 //                     function f(x). the actual name for f needs to be
53 //                     declared e x t e r n a l in the driver program.
54 //
55 //            a      - double precision
56 //                     lower limit of integration
57 //
58 //            b      - double precision
59 //                     upper limit of integration
60 //
61 //            epsabs - double precision
62 //                     absolute accuracy requested
63 //            epsrel - double precision
64 //                     relative accuracy requested
65 //                     if  epsabs.le.0
66 //                     and epsrel.lt.max(50*rel.mach.acc.,0.5d-28),
67 //                     the routine will end with ier = 6.
68 //
69 //         on return
70 //            result - double precision
71 //                     approximation to the integral
72 //
73 //            abserr - double precision
74 //                     estimate of the modulus of the absolute error,
75 //                     which should equal or exceed abs(i-result)
76 //
77 //            neval  - integer
78 //                     number of integrand evaluations
79 //
80 //            ier    - integer
81 //                     ier = 0 normal and reliable termination of the
82 //                             routine. it is assumed that the requested
83 //                             accuracy has been achieved.
84 //                     ier.gt.0 abnormal termination of the routine
85 //                             the estimates for integral and error are
86 //                             less reliable. it is assumed that the
87 //                             requested accuracy has not been achieved.
88 //            error messages
89 //                     ier = 1 maximum number of subdivisions allowed
90 //                             has been achieved. one can allow more sub-
91 //                             divisions by increasing the value of limit
92 //                             (and taking the according dimension
93 //                             adjustments into account. however, if
94 //                             this yields no improvement it is advised
95 //                             to analyze the integrand in order to
96 //                             determine the integration difficulties. if
97 //                             the position of a local difficulty can be
98 //                             determined (e.g. singularity,
99 //                             discontinuity within the interval) one
100 //                             will probably gain from splitting up the
101 //                             interval at this point and calling the
102 //                             integrator on the subranges. if possible,
103 //                             an appropriate special-purpose integrator
104 //                             should be used, which is designed for
105 //                             handling the type of difficulty involved.
106 //                         = 2 the occurrence of roundoff error is detec-
107 //                             ted, which prevents the requested
108 //                             tolerance from being achieved.
109 //                             the error may be under-estimated.
110 //                         = 3 extremely bad integrand behaviour
111 //                             occurs at some points of the integration
112 //                             interval.
113 //                         = 4 the algorithm does not converge.
114 //                             roundoff error is detected in the
115 //                             extrapolation table. it is presumed that
116 //                             the requested tolerance cannot be
117 //                             achieved, and that the returned result is
118 //                             the best which can be obtained.
119 //                         = 5 the integral is probably divergent, or
120 //                             slowly convergent. it must be noted that
121 //                             divergence can occur with any other value
122 //                             of ier.
123 //                         = 6 the input is invalid, because
124 //                             (epsabs.le.0 and
125 //                              epsrel.lt.max(50*rel.mach.acc.,0.5d-28)
126 //                             or limit.lt.1 or lenw.lt.limit*4.
127 //                             result, abserr, neval, last are set to
128 //                             zero.except when limit or lenw is invalid,
129 //                             iwork(1), work(limit*2+1) and
130 //                             work(limit*3+1) are set to zero, work(1)
131 //                             is set to a and work(limit+1) to b.
132 //
133 //         dimensioning parameters
134 //            limit - integer
135 //                    dimensioning parameter for iwork
136 //                    limit determines the maximum number of subintervals
137 //                    in the partition of the given integration interval
138 //                    (a,b), limit.ge.1.
139 //                    if limit.lt.1, the routine will end with ier = 6.
140 //
141 //            lenw  - integer
142 //                    dimensioning parameter for work
143 //                    lenw must be at least limit*4.
144 //                    if lenw.lt.limit*4, the routine will end
145 //                    with ier = 6.
146 //
147 //            last  - integer
148 //                    on return, last equals the number of subintervals
149 //                    produced in the subdivision process, detemines the
150 //                    number of significant elements actually in the work
151 //                    arrays.
152 //
153 //         work arrays
154 //            iwork - integer
155 //                    vector of dimension at least limit, the first k
156 //                    elements of which contain pointers
157 //                    to the error estimates over the subintervals
158 //                    such that work(limit*3+iwork(1)),... ,
159 //                    work(limit*3+iwork(k)) form a decreasing
160 //                    sequence, with k = last if last.le.(limit/2+2),
161 //                    and k = limit+1-last otherwise
162 //
163 //            work  - double precision
164 //                    vector of dimension at least lenw
165 //                    on return
166 //                    work(1), ..., work(last) contain the left
167 //                     end-points of the subintervals in the
168 //                     partition of (a,b),
169 //                    work(limit+1), ..., work(limit+last) contain
170 //                     the right end-points,
171 //                    work(limit*2+1), ..., work(limit*2+last) contain
172 //                     the integral approximations over the subintervals,
173 //                    work(limit*3+1), ..., work(limit*3+last)
174 //                     contain the error estimates.
175 //
176 //***references  (none)
177 //***routines called  dqagse,xerror
178 //***end prologue  dqags
179 //
180 //
181       int lvl=1,l1=1,l2=1,l3=1;
182 //
183 //         check validity of limit and lenw.
184 //
185 //***first executable statement  dqags
186       ier = 6;
187       neval = 0;
188       last = 0;
189       result = 0.0;
190       abserr = 0.0;
191       if(limit < 1 || lenw < limit*4) goto l10;
192 //
193 //         prepare call for dqagse.
194 //
195       l1 = limit;
196       l2 = limit+l1;
197       l3 = limit+l2;
198 //
199       qagse!(Real,Func)(f,a,b,epsabs,epsrel,limit,result,abserr,neval,
200         ier,work,work+l1,work+l2,work+l3,iwork,last);
201 //
202 //         call error handler if necessary.
203 //
204       lvl = 0;
205 l10:  if(ier == 6) lvl = 1;
206       if(ier != 0)
207         throw new Exception("abnormal return from  qags: "~to!string(ier));
208       return;
209 }
210 
211 unittest
212 {
213     alias qags!(float, float delegate(float)) fqags;
214     alias qags!(double, double delegate(double)) dqags;
215     alias qags!(double, double function(double)) dfqags;
216     alias qags!(real, real delegate(real)) rqags;
217 }
218 
219 unittest
220 {
221     double f(double x) { return x<=0.0 ? 0.0 : log(x)/sqrt(x); }
222 
223     enum : double
224     {
225         a = 0.0,
226         b = 1.0,
227         epsabs = 0.0,
228         epsrel = 1e-10
229     }
230     double result, abserr;
231     int neval, ier;
232     enum
233     {
234         limit = 500,
235         lenw = 4*limit
236     }
237     int last;
238 
239     int[limit] iwork;
240     double[lenw] work;
241 
242     qags(&f, a, b, epsabs, epsrel, result, abserr, neval, ier,
243         limit, lenw, last, iwork.ptr, work.ptr);
244 
245     assert (isAccurate(result, abserr, -4.0, epsrel, epsabs));
246 }