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 }