cloudy  trunk
 All Data Structures Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Pages
thirdparty_quadpack.cpp
Go to the documentation of this file.
1 #include "cddefines.h"
2 #include "thirdparty_quadpack.h"
3 
4 /* translated by f2c (version 20100827). */
5 
6 STATIC long xerror_(const char *mesg, const long *nmesg,
7  const long *nerr, const long *level, long)
8 {
9  DEBUG_ENTRY("xerror()");
10  if (*level > 0)
11  {
12  fprintf(ioQQQ,"Error [%ld]: %*s\n",*nerr,int(*nmesg),mesg);
13  cdEXIT(EXIT_FAILURE);
14  }
15  else
16  {
17  fprintf(ioQQQ,"Warning [%ld]: %*s\n",*nerr,int(*nmesg),mesg);
18  }
19  return 0;
20 }
21 static sys_float r1mach(long i)
22 {
23  DEBUG_ENTRY("r1mach()");
24  // DOUBLE-PRECISION MACHINE CONSTANTS
25  // D1MACH( 1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE.
26  // D1MACH( 2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE.
27  // D1MACH( 3) = B**(-T), THE SMALLEST RELATIVE SPACING.
28  // D1MACH( 4) = B**(1-T), THE LARGEST RELATIVE SPACING.
29  // D1MACH( 5) = LOG10(B)
30  switch (i)
31  {
32  case 1:
33  return FLT_MIN;
34  case 2:
35  return FLT_MAX;
36  case 3:
37  return FLT_EPSILON/FLT_RADIX;
38  case 4:
39  return FLT_EPSILON;
40  case 5:
41  return log10(double(FLT_RADIX));
42  default:
43  fprintf(stderr,"Error in input to r1mach");
44  cdEXIT(EXIT_FAILURE);
45  }
46 }
47 static double d1mach(long i)
48 {
49  DEBUG_ENTRY("d1mach()");
50  // DOUBLE-PRECISION MACHINE CONSTANTS
51  // D1MACH( 1) = B**(EMIN-1), THE SMALLEST POSITIVE MAGNITUDE.
52  // D1MACH( 2) = B**EMAX*(1 - B**(-T)), THE LARGEST MAGNITUDE.
53  // D1MACH( 3) = B**(-T), THE SMALLEST RELATIVE SPACING.
54  // D1MACH( 4) = B**(1-T), THE LARGEST RELATIVE SPACING.
55  // D1MACH( 5) = LOG10(B)
56  switch (i)
57  {
58  case 1:
59  return DBL_MIN;
60  case 2:
61  return DBL_MAX;
62  case 3:
63  return DBL_EPSILON/FLT_RADIX;
64  case 4:
65  return DBL_EPSILON;
66  case 5:
67  return log10(double(FLT_RADIX));
68  default:
69  cdEXIT(EXIT_FAILURE);
70  }
71 }
72 
73 /* Table of constant values */
74 
75 const static long c__4 = 4;
76 const static long c__1 = 1;
77 const static long c__26 = 26;
78 const static double c_b20 = 0.;
79 const static double c_b21 = 1.;
80 const static long c__2 = 2;
81 const static long c__0 = 0;
82 const static double c_b270 = 1.5;
83 const static double c_b320 = 2.;
84 const static sys_float c_b390 = 0.f;
85 const static sys_float c_b391 = 1.f;
86 
87 static void sgtsl_(const long *, sys_float*, sys_float*,
88  sys_float*, sys_float *, long *);
89 static void dgtsl_(const long *, double*, double*, double*,
90  double *, long *);
91 
92 void dqage_(const D_fp& f, const double *a, const double *b, const double *epsabs,
93  const double *epsrel, const long *key, const long *limit,
94  double *result, double *abserr, long *neval, long *ier, double *
95  alist__, double *blist, double *rlist, double *elist,
96  long *iord, long *last)
97 {
98  /* System generated locals */
99  long i__1;
100  double d__1, d__2;
101 
102  /* Local variables */
103  long k;
104  double a1, a2, b1, b2, area;
105  long keyf;
106  double area1, area2, area12, erro12, defab1, defab2;
107  long nrmax;
108  double uflow;
109  long iroff1, iroff2;
110  double error1, error2, defabs, epmach, errbnd, resabs, errmax;
111  long maxerr;
112  double errsum;
113 
114  /* ***begin prologue dqage */
115  /* ***date written 800101 (yymmdd) */
116  /* ***revision date 830518 (yymmdd) */
117  /* ***category no. h2a1a1 */
118  /* ***keywords automatic integrator, general-purpose, */
119  /* integrand examinator, globally adaptive, */
120  /* gauss-kronrod */
121  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
122  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
123  /* ***purpose the routine calculates an approximation result to a given */
124  /* definite integral i = integral of f over (a,b), */
125  /* hopefully satisfying following claim for accuracy */
126  /* abs(i-reslt).le.max(epsabs,epsrel*abs(i)). */
127  /* ***description */
128 
129  /* computation of a definite integral */
130  /* standard fortran subroutine */
131  /* double precision version */
132 
133  /* parameters */
134  /* on entry */
135  /* f - double precision */
136  /* function subprogram defining the integrand */
137  /* function f(x). the actual name for f needs to be */
138  /* declared e x t e r n a l in the driver program. */
139 
140  /* a - double precision */
141  /* lower limit of integration */
142 
143  /* b - double precision */
144  /* upper limit of integration */
145 
146  /* epsabs - double precision */
147  /* absolute accuracy requested */
148  /* epsrel - double precision */
149  /* relative accuracy requested */
150  /* if epsabs.le.0 */
151  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
152  /* the routine will end with ier = 6. */
153 
154  /* key - long */
155  /* key for choice of local integration rule */
156  /* a gauss-kronrod pair is used with */
157  /* 7 - 15 points if key.lt.2, */
158  /* 10 - 21 points if key = 2, */
159  /* 15 - 31 points if key = 3, */
160  /* 20 - 41 points if key = 4, */
161  /* 25 - 51 points if key = 5, */
162  /* 30 - 61 points if key.gt.5. */
163 
164  /* limit - long */
165  /* gives an upperbound on the number of subintervals */
166  /* in the partition of (a,b), limit.ge.1. */
167 
168  /* on return */
169  /* result - double precision */
170  /* approximation to the integral */
171 
172  /* abserr - double precision */
173  /* estimate of the modulus of the absolute error, */
174  /* which should equal or exceed abs(i-result) */
175 
176  /* neval - long */
177  /* number of integrand evaluations */
178 
179  /* ier - long */
180  /* ier = 0 normal and reliable termination of the */
181  /* routine. it is assumed that the requested */
182  /* accuracy has been achieved. */
183  /* ier.gt.0 abnormal termination of the routine */
184  /* the estimates for result and error are */
185  /* less reliable. it is assumed that the */
186  /* requested accuracy has not been achieved. */
187  /* error messages */
188  /* ier = 1 maximum number of subdivisions allowed */
189  /* has been achieved. one can allow more */
190  /* subdivisions by increasing the value */
191  /* of limit. */
192  /* however, if this yields no improvement it */
193  /* is rather advised to analyze the integrand */
194  /* in order to determine the integration */
195  /* difficulties. if the position of a local */
196  /* difficulty can be determined(e.g. */
197  /* singularity, discontinuity within the */
198  /* interval) one will probably gain from */
199  /* splitting up the interval at this point */
200  /* and calling the integrator on the */
201  /* subranges. if possible, an appropriate */
202  /* special-purpose integrator should be used */
203  /* which is designed for handling the type of */
204  /* difficulty involved. */
205  /* = 2 the occurrence of roundoff error is */
206  /* detected, which prevents the requested */
207  /* tolerance from being achieved. */
208  /* = 3 extremely bad integrand behaviour occurs */
209  /* at some points of the integration */
210  /* interval. */
211  /* = 6 the input is invalid, because */
212  /* (epsabs.le.0 and */
213  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
214  /* result, abserr, neval, last, rlist(1) , */
215  /* elist(1) and iord(1) are set to zero. */
216  /* alist(1) and blist(1) are set to a and b */
217  /* respectively. */
218 
219  /* alist - double precision */
220  /* vector of dimension at least limit, the first */
221  /* last elements of which are the left */
222  /* end points of the subintervals in the partition */
223  /* of the given integration range (a,b) */
224 
225  /* blist - double precision */
226  /* vector of dimension at least limit, the first */
227  /* last elements of which are the right */
228  /* end points of the subintervals in the partition */
229  /* of the given integration range (a,b) */
230 
231  /* rlist - double precision */
232  /* vector of dimension at least limit, the first */
233  /* last elements of which are the */
234  /* integral approximations on the subintervals */
235 
236  /* elist - double precision */
237  /* vector of dimension at least limit, the first */
238  /* last elements of which are the moduli of the */
239  /* absolute error estimates on the subintervals */
240 
241  /* iord - int */
242  /* vector of dimension at least limit, the first k */
243  /* elements of which are pointers to the */
244  /* error estimates over the subintervals, */
245  /* such that elist(iord(1)), ..., */
246  /* elist(iord(k)) form a decreasing sequence, */
247  /* with k = last if last.le.(limit/2+2), and */
248  /* k = limit+1-last otherwise */
249 
250  /* last - int */
251  /* number of subintervals actually produced in the */
252  /* subdivision process */
253 
254  /* ***references (none) */
255  /* ***routines called d1mach,dqk15,dqk21,dqk31, */
256  /* dqk41,dqk51,dqk61,dqpsrt */
257  /* ***end prologue dqage */
258 
259 
260 
261 
262  /* list of major variables */
263  /* ----------------------- */
264 
265  /* alist - list of left end points of all subintervals */
266  /* considered up to now */
267  /* blist - list of right end points of all subintervals */
268  /* considered up to now */
269  /* rlist(i) - approximation to the integral over */
270  /* (alist(i),blist(i)) */
271  /* elist(i) - error estimate applying to rlist(i) */
272  /* maxerr - pointer to the interval with largest */
273  /* error estimate */
274  /* errmax - elist(maxerr) */
275  /* area - sum of the integrals over the subintervals */
276  /* errsum - sum of the errors over the subintervals */
277  /* errbnd - requested accuracy max(epsabs,epsrel* */
278  /* abs(result)) */
279  /* *****1 - variable for the left subinterval */
280  /* *****2 - variable for the right subinterval */
281  /* last - index for subdivision */
282 
283 
284  /* machine dependent constants */
285  /* --------------------------- */
286 
287  /* epmach is the largest relative spacing. */
288  /* uflow is the smallest positive magnitude. */
289 
290  /* ***first executable statement dqage */
291  /* Parameter adjustments */
292  --iord;
293  --elist;
294  --rlist;
295  --blist;
296  --alist__;
297 
298  /* Function Body */
299  epmach = d1mach(c__4);
300  uflow = d1mach(c__1);
301 
302  /* test on validity of parameters */
303  /* ------------------------------ */
304 
305  *ier = 0;
306  *neval = 0;
307  *last = 0;
308  *result = 0.;
309  *abserr = 0.;
310  alist__[1] = *a;
311  blist[1] = *b;
312  rlist[1] = 0.;
313  elist[1] = 0.;
314  iord[1] = 0;
315  /* Computing MAX */
316  d__1 = epmach * 50.;
317  if (*epsabs <= 0. && *epsrel < max(d__1,5e-29)) {
318  *ier = 6;
319  }
320  if (*ier == 6) {
321  goto L999;
322  }
323 
324  /* first approximation to the integral */
325  /* ----------------------------------- */
326 
327  keyf = *key;
328  if (*key <= 0) {
329  keyf = 1;
330  }
331  if (*key >= 7) {
332  keyf = 6;
333  }
334  *neval = 0;
335  if (keyf == 1) {
336  dqk15_(f, a, b, result, abserr, &defabs, &resabs);
337  }
338  if (keyf == 2) {
339  dqk21_(f, a, b, result, abserr, &defabs, &resabs);
340  }
341  if (keyf == 3) {
342  dqk31_(f, a, b, result, abserr, &defabs, &resabs);
343  }
344  if (keyf == 4) {
345  dqk41_(f, a, b, result, abserr, &defabs, &resabs);
346  }
347  if (keyf == 5) {
348  dqk51_(f, a, b, result, abserr, &defabs, &resabs);
349  }
350  if (keyf == 6) {
351  dqk61_(f, a, b, result, abserr, &defabs, &resabs);
352  }
353  *last = 1;
354  rlist[1] = *result;
355  elist[1] = *abserr;
356  iord[1] = 1;
357 
358  /* test on accuracy. */
359 
360  /* Computing MAX */
361  d__1 = *epsabs, d__2 = *epsrel * fabs(*result);
362  errbnd = max(d__1,d__2);
363  if (*abserr <= epmach * 50. * defabs && *abserr > errbnd) {
364  *ier = 2;
365  }
366  if (*limit == 1) {
367  *ier = 1;
368  }
369  if (*ier != 0 || ( *abserr <= errbnd && *abserr != resabs ) || *abserr == 0.)
370  {
371  goto L60;
372  }
373 
374  /* initialization */
375  /* -------------- */
376 
377 
378  errmax = *abserr;
379  maxerr = 1;
380  area = *result;
381  errsum = *abserr;
382  nrmax = 1;
383  iroff1 = 0;
384  iroff2 = 0;
385 
386  /* main do-loop */
387  /* ------------ */
388 
389  i__1 = *limit;
390  for (*last = 2; *last <= i__1; ++(*last)) {
391 
392  /* bisect the subinterval with the largest error estimate. */
393 
394  a1 = alist__[maxerr];
395  b1 = (alist__[maxerr] + blist[maxerr]) * .5;
396  a2 = b1;
397  b2 = blist[maxerr];
398  if (keyf == 1) {
399  dqk15_(f, &a1, &b1, &area1, &error1, &resabs, &defab1);
400  }
401  if (keyf == 2) {
402  dqk21_(f, &a1, &b1, &area1, &error1, &resabs, &defab1);
403  }
404  if (keyf == 3) {
405  dqk31_(f, &a1, &b1, &area1, &error1, &resabs, &defab1);
406  }
407  if (keyf == 4) {
408  dqk41_(f, &a1, &b1, &area1, &error1, &resabs, &defab1);
409  }
410  if (keyf == 5) {
411  dqk51_(f, &a1, &b1, &area1, &error1, &resabs, &defab1);
412  }
413  if (keyf == 6) {
414  dqk61_(f, &a1, &b1, &area1, &error1, &resabs, &defab1);
415  }
416  if (keyf == 1) {
417  dqk15_(f, &a2, &b2, &area2, &error2, &resabs, &defab2);
418  }
419  if (keyf == 2) {
420  dqk21_(f, &a2, &b2, &area2, &error2, &resabs, &defab2);
421  }
422  if (keyf == 3) {
423  dqk31_(f, &a2, &b2, &area2, &error2, &resabs, &defab2);
424  }
425  if (keyf == 4) {
426  dqk41_(f, &a2, &b2, &area2, &error2, &resabs, &defab2);
427  }
428  if (keyf == 5) {
429  dqk51_(f, &a2, &b2, &area2, &error2, &resabs, &defab2);
430  }
431  if (keyf == 6) {
432  dqk61_(f, &a2, &b2, &area2, &error2, &resabs, &defab2);
433  }
434 
435  /* improve previous approximations to integral */
436  /* and error and test for accuracy. */
437 
438  ++(*neval);
439  area12 = area1 + area2;
440  erro12 = error1 + error2;
441  errsum = errsum + erro12 - errmax;
442  area = area + area12 - rlist[maxerr];
443  if (defab1 == error1 || defab2 == error2) {
444  goto L5;
445  }
446  if ((d__1 = rlist[maxerr] - area12, fabs(d__1)) <= fabs(area12) * 1e-5
447  && erro12 >= errmax * .99) {
448  ++iroff1;
449  }
450  if (*last > 10 && erro12 > errmax) {
451  ++iroff2;
452  }
453  L5:
454  rlist[maxerr] = area1;
455  rlist[*last] = area2;
456  /* Computing MAX */
457  d__1 = *epsabs, d__2 = *epsrel * fabs(area);
458  errbnd = max(d__1,d__2);
459  if (errsum <= errbnd) {
460  goto L8;
461  }
462 
463  /* test for roundoff error and eventually set error flag. */
464 
465  if (iroff1 >= 6 || iroff2 >= 20) {
466  *ier = 2;
467  }
468 
469  /* set error flag in the case that the number of subintervals */
470  /* equals limit. */
471 
472  if (*last == *limit) {
473  *ier = 1;
474  }
475 
476  /* set error flag in the case of bad integrand behaviour */
477  /* at a point of the integration range. */
478 
479  /* Computing MAX */
480  d__1 = fabs(a1), d__2 = fabs(b2);
481  if (max(d__1,d__2) <= (epmach * 100. + 1.) * (fabs(a2) + uflow * 1e3))
482  {
483  *ier = 3;
484  }
485 
486  /* append the newly-created intervals to the list. */
487 
488  L8:
489  if (error2 > error1) {
490  goto L10;
491  }
492  alist__[*last] = a2;
493  blist[maxerr] = b1;
494  blist[*last] = b2;
495  elist[maxerr] = error1;
496  elist[*last] = error2;
497  goto L20;
498  L10:
499  alist__[maxerr] = a2;
500  alist__[*last] = a1;
501  blist[*last] = b1;
502  rlist[maxerr] = area2;
503  rlist[*last] = area1;
504  elist[maxerr] = error2;
505  elist[*last] = error1;
506 
507  /* call subroutine dqpsrt to maintain the descending ordering */
508  /* in the list of error estimates and select the subinterval */
509  /* with the largest error estimate (to be bisected next). */
510 
511  L20:
512  dqpsrt_(limit, last, &maxerr, &errmax, &elist[1], &iord[1], &nrmax);
513  /* ***jump out of do-loop */
514  if (*ier != 0 || errsum <= errbnd) {
515  goto L40;
516  }
517  /* L30: */
518  }
519 
520  /* compute final result. */
521  /* --------------------- */
522 
523 L40:
524  *result = 0.;
525  i__1 = *last;
526  for (k = 1; k <= i__1; ++k) {
527  *result += rlist[k];
528  /* L50: */
529  }
530  *abserr = errsum;
531 L60:
532  if (keyf != 1) {
533  *neval = (keyf * 10 + 1) * ((*neval << 1) + 1);
534  }
535  if (keyf == 1) {
536  *neval = *neval * 30 + 15;
537  }
538 L999:
539  return;
540 } /* dqage_ */
541 
542 void dqag_(const D_fp& f, const double *a, const double *b, const double *epsabs,
543  const double *epsrel, const long *key, double *result,
544  double *abserr, long *neval, long *ier, long *limit,
545  const long *lenw, long *last, long *iwork, double *work)
546 {
547  long l1, l2, l3, lvl;
548 
549  /* ***begin prologue dqag */
550  /* ***date written 800101 (yymmdd) */
551  /* ***revision date 830518 (yymmdd) */
552  /* ***category no. h2a1a1 */
553  /* ***keywords automatic integrator, general-purpose, */
554  /* integrand examinator, globally adaptive, */
555  /* gauss-kronrod */
556  /* ***author piessens,robert,appl. math. & progr. div - k.u.leuven */
557  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
558  /* ***purpose the routine calculates an approximation result to a given */
559  /* definite integral i = integral of f over (a,b), */
560  /* hopefully satisfying following claim for accuracy */
561  /* abs(i-result)le.max(epsabs,epsrel*abs(i)). */
562  /* ***description */
563 
564  /* computation of a definite integral */
565  /* standard fortran subroutine */
566  /* double precision version */
567 
568  /* f - double precision */
569  /* function subprogam defining the integrand */
570  /* function f(x). the actual name for f needs to be */
571  /* declared e x t e r n a l in the driver program. */
572 
573  /* a - double precision */
574  /* lower limit of integration */
575 
576  /* b - double precision */
577  /* upper limit of integration */
578 
579  /* epsabs - double precision */
580  /* absolute accoracy requested */
581  /* epsrel - double precision */
582  /* relative accuracy requested */
583  /* if epsabs.le.0 */
584  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
585  /* the routine will end with ier = 6. */
586 
587  /* key - int */
588  /* key for choice of local integration rule */
589  /* a gauss-kronrod pair is used with */
590  /* 7 - 15 points if key.lt.2, */
591  /* 10 - 21 points if key = 2, */
592  /* 15 - 31 points if key = 3, */
593  /* 20 - 41 points if key = 4, */
594  /* 25 - 51 points if key = 5, */
595  /* 30 - 61 points if key.gt.5. */
596 
597  /* on return */
598  /* result - double precision */
599  /* approximation to the integral */
600 
601  /* abserr - double precision */
602  /* estimate of the modulus of the absolute error, */
603  /* which should equal or exceed abs(i-result) */
604 
605  /* neval - int */
606  /* number of integrand evaluations */
607 
608  /* ier - long */
609  /* ier = 0 normal and reliable termination of the */
610  /* routine. it is assumed that the requested */
611  /* accuracy has been achieved. */
612  /* ier.gt.0 abnormal termination of the routine */
613  /* the estimates for result and error are */
614  /* less reliable. it is assumed that the */
615  /* requested accuracy has not been achieved. */
616  /* error messages */
617  /* ier = 1 maximum number of subdivisions allowed */
618  /* has been achieved. one can allow more */
619  /* subdivisions by increasing the value of */
620  /* limit (and taking the according dimension */
621  /* adjustments into account). however, if */
622  /* this yield no improvement it is advised */
623  /* to analyze the integrand in order to */
624  /* determine the integration difficulaties. */
625  /* if the position of a local difficulty can */
626  /* be determined (i.e.singularity, */
627  /* discontinuity within the interval) one */
628  /* will probably gain from splitting up the */
629  /* interval at this point and calling the */
630  /* integrator on the subranges. if possible, */
631  /* an appropriate special-purpose integrator */
632  /* should be used which is designed for */
633  /* handling the type of difficulty involved. */
634  /* = 2 the occurrence of roundoff error is */
635  /* detected, which prevents the requested */
636  /* tolerance from being achieved. */
637  /* = 3 extremely bad integrand behaviour occurs */
638  /* at some points of the integration */
639  /* interval. */
640  /* = 6 the input is invalid, because */
641  /* (epsabs.le.0 and */
642  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28)) */
643  /* or limit.lt.1 or lenw.lt.limit*4. */
644  /* result, abserr, neval, last are set */
645  /* to zero. */
646  /* except when lenw is invalid, iwork(1), */
647  /* work(limit*2+1) and work(limit*3+1) are */
648  /* set to zero, work(1) is set to a and */
649  /* work(limit+1) to b. */
650 
651  /* dimensioning parameters */
652  /* limit - int */
653  /* dimensioning parameter for iwork */
654  /* limit determines the maximum number of subintervals */
655  /* in the partition of the given integration interval */
656  /* (a,b), limit.ge.1. */
657  /* if limit.lt.1, the routine will end with ier = 6. */
658 
659  /* lenw - long */
660  /* dimensioning parameter for work */
661  /* lenw must be at least limit*4. */
662  /* if lenw.lt.limit*4, the routine will end with */
663  /* ier = 6. */
664 
665  /* last - int */
666  /* on return, last equals the number of subintervals */
667  /* produced in the subdiviosion process, which */
668  /* determines the number of significant elements */
669  /* actually in the work arrays. */
670 
671  /* work arrays */
672  /* iwork - int */
673  /* vector of dimension at least limit, the first k */
674  /* elements of which contain pointers to the error */
675  /* estimates over the subintervals, such that */
676  /* work(limit*3+iwork(1)),... , work(limit*3+iwork(k)) */
677  /* form a decreasing sequence with k = last if */
678  /* last.le.(limit/2+2), and k = limit+1-last otherwise */
679 
680  /* work - double precision */
681  /* vector of dimension at least lenw */
682  /* on return */
683  /* work(1), ..., work(last) contain the left end */
684  /* points of the subintervals in the partition of */
685  /* (a,b), */
686  /* work(limit+1), ..., work(limit+last) contain the */
687  /* right end points, */
688  /* work(limit*2+1), ..., work(limit*2+last) contain */
689  /* the integral approximations over the subintervals, */
690  /* work(limit*3+1), ..., work(limit*3+last) contain */
691  /* the error estimates. */
692 
693  /* ***references (none) */
694  /* ***routines called dqage,xerror */
695  /* ***end prologue dqag */
696 
697 
698 
699  /* check validity of lenw. */
700 
701  /* ***first executable statement dqag */
702  /* Parameter adjustments */
703  --iwork;
704  --work;
705 
706  /* Function Body */
707  *ier = 6;
708  *neval = 0;
709  *last = 0;
710  *result = 0.;
711  *abserr = 0.;
712  if (*limit < 1 || *lenw < *limit << 2) {
713  goto L10;
714  }
715 
716  /* prepare call for dqage. */
717 
718  l1 = *limit + 1;
719  l2 = *limit + l1;
720  l3 = *limit + l2;
721 
722  dqage_(f, a, b, epsabs, epsrel, key, limit, result, abserr, neval,
723  ier, &work[1], &work[l1], &work[l2], &work[l3], &iwork[1], last);
724 
725  /* call error handler if necessary. */
726 
727  lvl = 0;
728 L10:
729  if (*ier == 6) {
730  lvl = 1;
731  }
732  if (*ier != 0) {
733  xerror_("abnormal return from dqag ", &c__26, ier, &lvl, 26);
734  }
735  return;
736 } /* dqag_ */
737 
738 void dqagie_(const D_fp& f, const double *bound, const long *inf,
739  const double *epsabs, const double *epsrel, const long *limit,
740  double *result, double *abserr, long *neval, long *ier,
741  double *alist__, double *blist, double *rlist, double *elist,
742  long *iord, long *last)
743 {
744  /* System generated locals */
745  long i__1, i__2;
746  double d__1, d__2;
747 
748  /* Local variables */
749  long k;
750  double a1, a2, b1, b2;
751  long id;
752  double area, dres;
753  long ksgn;
754  double boun;
755  long nres;
756  double area1, area2, area12;
757  double small=0., erro12;
758  long ierro;
759  double defab1, defab2;
760  long ktmin, nrmax;
761  double oflow, uflow;
762  bool noext;
763  long iroff1, iroff2, iroff3;
764  double res3la[3], error1, error2, rlist2[52];
765  long numrl2;
766  double defabs, epmach, erlarg=0., abseps, correc=0., errbnd, resabs;
767  long jupbnd;
768  double erlast, errmax;
769  long maxerr;
770  double reseps;
771  bool extrap;
772  double ertest=0., errsum;
773 
774  /* ***begin prologue dqagie */
775  /* ***date written 800101 (yymmdd) */
776  /* ***revision date 830518 (yymmdd) */
777  /* ***category no. h2a3a1,h2a4a1 */
778  /* ***keywords automatic integrator, infinite intervals, */
779  /* general-purpose, transformation, extrapolation, */
780  /* globally adaptive */
781  /* ***author piessens,robert,appl. math & progr. div - k.u.leuven */
782  /* de doncker,elise,appl. math & progr. div - k.u.leuven */
783  /* ***purpose the routine calculates an approximation result to a given */
784  /* integral i = integral of f over (bound,+infinity) */
785  /* or i = integral of f over (-infinity,bound) */
786  /* or i = integral of f over (-infinity,+infinity), */
787  /* hopefully satisfying following claim for accuracy */
788  /* abs(i-result).le.max(epsabs,epsrel*abs(i)) */
789  /* ***description */
790 
791  /* integration over infinite intervals */
792  /* standard fortran subroutine */
793 
794  /* f - double precision */
795  /* function subprogram defining the integrand */
796  /* function f(x). the actual name for f needs to be */
797  /* declared e x t e r n a l in the driver program. */
798 
799  /* bound - double precision */
800  /* finite bound of integration range */
801  /* (has no meaning if interval is doubly-infinite) */
802 
803  /* inf - double precision */
804  /* indicating the kind of integration range involved */
805  /* inf = 1 corresponds to (bound,+infinity), */
806  /* inf = -1 to (-infinity,bound), */
807  /* inf = 2 to (-infinity,+infinity). */
808 
809  /* epsabs - double precision */
810  /* absolute accuracy requested */
811  /* epsrel - double precision */
812  /* relative accuracy requested */
813  /* if epsabs.le.0 */
814  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
815  /* the routine will end with ier = 6. */
816 
817  /* limit - long */
818  /* gives an upper bound on the number of subintervals */
819  /* in the partition of (a,b), limit.ge.1 */
820 
821  /* on return */
822  /* result - double precision */
823  /* approximation to the integral */
824 
825  /* abserr - double precision */
826  /* estimate of the modulus of the absolute error, */
827  /* which should equal or exceed abs(i-result) */
828 
829  /* neval - long */
830  /* number of integrand evaluations */
831 
832  /* ier - long */
833  /* ier = 0 normal and reliable termination of the */
834  /* routine. it is assumed that the requested */
835  /* accuracy has been achieved. */
836  /* - ier.gt.0 abnormal termination of the routine. the */
837  /* estimates for result and error are less */
838  /* reliable. it is assumed that the requested */
839  /* accuracy has not been achieved. */
840  /* error messages */
841  /* ier = 1 maximum number of subdivisions allowed */
842  /* has been achieved. one can allow more */
843  /* subdivisions by increasing the value of */
844  /* limit (and taking the according dimension */
845  /* adjustments into account). however,if */
846  /* this yields no improvement it is advised */
847  /* to analyze the integrand in order to */
848  /* determine the integration difficulties. */
849  /* if the position of a local difficulty can */
850  /* be determined (e.g. singularity, */
851  /* discontinuity within the interval) one */
852  /* will probably gain from splitting up the */
853  /* interval at this point and calling the */
854  /* integrator on the subranges. if possible, */
855  /* an appropriate special-purpose integrator */
856  /* should be used, which is designed for */
857  /* handling the type of difficulty involved. */
858  /* = 2 the occurrence of roundoff error is */
859  /* detected, which prevents the requested */
860  /* tolerance from being achieved. */
861  /* the error may be under-estimated. */
862  /* = 3 extremely bad integrand behaviour occurs */
863  /* at some points of the integration */
864  /* interval. */
865  /* = 4 the algorithm does not converge. */
866  /* roundoff error is detected in the */
867  /* extrapolation table. */
868  /* it is assumed that the requested tolerance */
869  /* cannot be achieved, and that the returned */
870  /* result is the best which can be obtained. */
871  /* = 5 the integral is probably divergent, or */
872  /* slowly convergent. it must be noted that */
873  /* divergence can occur with any other value */
874  /* of ier. */
875  /* = 6 the input is invalid, because */
876  /* (epsabs.le.0 and */
877  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
878  /* result, abserr, neval, last, rlist(1), */
879  /* elist(1) and iord(1) are set to zero. */
880  /* alist(1) and blist(1) are set to 0 */
881  /* and 1 respectively. */
882 
883  /* alist - double precision */
884  /* vector of dimension at least limit, the first */
885  /* last elements of which are the left */
886  /* end points of the subintervals in the partition */
887  /* of the transformed integration range (0,1). */
888 
889  /* blist - double precision */
890  /* vector of dimension at least limit, the first */
891  /* last elements of which are the right */
892  /* end points of the subintervals in the partition */
893  /* of the transformed integration range (0,1). */
894 
895  /* rlist - double precision */
896  /* vector of dimension at least limit, the first */
897  /* last elements of which are the integral */
898  /* approximations on the subintervals */
899 
900  /* elist - double precision */
901  /* vector of dimension at least limit, the first */
902  /* last elements of which are the moduli of the */
903  /* absolute error estimates on the subintervals */
904 
905  /* iord - long */
906  /* vector of dimension limit, the first k */
907  /* elements of which are pointers to the */
908  /* error estimates over the subintervals, */
909  /* such that elist(iord(1)), ..., elist(iord(k)) */
910  /* form a decreasing sequence, with k = last */
911  /* if last.le.(limit/2+2), and k = limit+1-last */
912  /* otherwise */
913 
914  /* last - long */
915  /* number of subintervals actually produced */
916  /* in the subdivision process */
917 
918  /* ***references (none) */
919  /* ***routines called d1mach,dqelg,dqk15i,dqpsrt */
920  /* ***end prologue dqagie */
921 
922 
923 
924  /* the dimension of rlist2 is determined by the value of */
925  /* limexp in subroutine dqelg. */
926 
927 
928  /* list of major variables */
929  /* ----------------------- */
930 
931  /* alist - list of left end points of all subintervals */
932  /* considered up to now */
933  /* blist - list of right end points of all subintervals */
934  /* considered up to now */
935  /* rlist(i) - approximation to the integral over */
936  /* (alist(i),blist(i)) */
937  /* rlist2 - array of dimension at least (limexp+2), */
938  /* containing the part of the epsilon table */
939  /* wich is still needed for further computations */
940  /* elist(i) - error estimate applying to rlist(i) */
941  /* maxerr - pointer to the interval with largest error */
942  /* estimate */
943  /* errmax - elist(maxerr) */
944  /* erlast - error on the interval currently subdivided */
945  /* (before that subdivision has taken place) */
946  /* area - sum of the integrals over the subintervals */
947  /* errsum - sum of the errors over the subintervals */
948  /* errbnd - requested accuracy max(epsabs,epsrel* */
949  /* abs(result)) */
950  /* *****1 - variable for the left subinterval */
951  /* *****2 - variable for the right subinterval */
952  /* last - index for subdivision */
953  /* nres - number of calls to the extrapolation routine */
954  /* numrl2 - number of elements currently in rlist2. if an */
955  /* appropriate approximation to the compounded */
956  /* integral has been obtained, it is put in */
957  /* rlist2(numrl2) after numrl2 has been increased */
958  /* by one. */
959  /* small - length of the smallest interval considered up */
960  /* to now, multiplied by 1.5 */
961  /* erlarg - sum of the errors over the intervals larger */
962  /* than the smallest interval considered up to now */
963  /* extrap - bool variable denoting that the routine */
964  /* is attempting to perform extrapolation. i.e. */
965  /* before subdividing the smallest interval we */
966  /* try to decrease the value of erlarg. */
967  /* noext - bool variable denoting that extrapolation */
968  /* is no longer allowed (true-value) */
969 
970  /* machine dependent constants */
971  /* --------------------------- */
972 
973  /* epmach is the largest relative spacing. */
974  /* uflow is the smallest positive magnitude. */
975  /* oflow is the largest positive magnitude. */
976 
977  /* ***first executable statement dqagie */
978  /* Parameter adjustments */
979  --iord;
980  --elist;
981  --rlist;
982  --blist;
983  --alist__;
984 
985  /* Function Body */
986  epmach = d1mach(c__4);
987 
988  /* test on validity of parameters */
989  /* ----------------------------- */
990 
991  *ier = 0;
992  *neval = 0;
993  *last = 0;
994  *result = 0.;
995  *abserr = 0.;
996  alist__[1] = 0.;
997  blist[1] = 1.;
998  rlist[1] = 0.;
999  elist[1] = 0.;
1000  iord[1] = 0;
1001  /* Computing MAX */
1002  d__1 = epmach * 50.;
1003  if (*epsabs <= 0. && *epsrel < max(d__1,5e-29)) {
1004  *ier = 6;
1005  }
1006  if (*ier == 6) {
1007  goto L999;
1008  }
1009 
1010 
1011  /* first approximation to the integral */
1012  /* ----------------------------------- */
1013 
1014  /* determine the interval to be mapped onto (0,1). */
1015  /* if inf = 2 the integral is computed as i = i1+i2, where */
1016  /* i1 = integral of f over (-infinity,0), */
1017  /* i2 = integral of f over (0,+infinity). */
1018 
1019  boun = *bound;
1020  if (*inf == 2) {
1021  boun = 0.;
1022  }
1023  dqk15i_(f, &boun, inf, &c_b20, &c_b21, result, abserr, &defabs, &
1024  resabs);
1025 
1026  /* test on accuracy */
1027 
1028  *last = 1;
1029  rlist[1] = *result;
1030  elist[1] = *abserr;
1031  iord[1] = 1;
1032  dres = fabs(*result);
1033  /* Computing MAX */
1034  d__1 = *epsabs, d__2 = *epsrel * dres;
1035  errbnd = max(d__1,d__2);
1036  if (*abserr <= epmach * 100. * defabs && *abserr > errbnd) {
1037  *ier = 2;
1038  }
1039  if (*limit == 1) {
1040  *ier = 1;
1041  }
1042  if (*ier != 0 || ( *abserr <= errbnd && *abserr != resabs ) || *abserr == 0.)
1043  {
1044  goto L130;
1045  }
1046 
1047  /* initialization */
1048  /* -------------- */
1049 
1050  uflow = d1mach(c__1);
1051  oflow = d1mach(c__2);
1052  rlist2[0] = *result;
1053  errmax = *abserr;
1054  maxerr = 1;
1055  area = *result;
1056  errsum = *abserr;
1057  *abserr = oflow;
1058  nrmax = 1;
1059  nres = 0;
1060  ktmin = 0;
1061  numrl2 = 2;
1062  extrap = false;
1063  noext = false;
1064  ierro = 0;
1065  iroff1 = 0;
1066  iroff2 = 0;
1067  iroff3 = 0;
1068  ksgn = -1;
1069  if (dres >= (1. - epmach * 50.) * defabs) {
1070  ksgn = 1;
1071  }
1072 
1073  /* main do-loop */
1074  /* ------------ */
1075 
1076  i__1 = *limit;
1077  for (*last = 2; *last <= i__1; ++(*last)) {
1078 
1079  /* bisect the subinterval with nrmax-th largest error estimate. */
1080 
1081  a1 = alist__[maxerr];
1082  b1 = (alist__[maxerr] + blist[maxerr]) * .5;
1083  a2 = b1;
1084  b2 = blist[maxerr];
1085  erlast = errmax;
1086  dqk15i_(f, &boun, inf, &a1, &b1, &area1, &error1, &resabs, &
1087  defab1);
1088  dqk15i_(f, &boun, inf, &a2, &b2, &area2, &error2, &resabs, &
1089  defab2);
1090 
1091  /* improve previous approximations to integral */
1092  /* and error and test for accuracy. */
1093 
1094  area12 = area1 + area2;
1095  erro12 = error1 + error2;
1096  errsum = errsum + erro12 - errmax;
1097  area = area + area12 - rlist[maxerr];
1098  if (defab1 == error1 || defab2 == error2) {
1099  goto L15;
1100  }
1101  if ((d__1 = rlist[maxerr] - area12, fabs(d__1)) > fabs(area12) * 1e-5 ||
1102  erro12 < errmax * .99) {
1103  goto L10;
1104  }
1105  if (extrap) {
1106  ++iroff2;
1107  }
1108  if (! extrap) {
1109  ++iroff1;
1110  }
1111  L10:
1112  if (*last > 10 && erro12 > errmax) {
1113  ++iroff3;
1114  }
1115  L15:
1116  rlist[maxerr] = area1;
1117  rlist[*last] = area2;
1118  /* Computing MAX */
1119  d__1 = *epsabs, d__2 = *epsrel * fabs(area);
1120  errbnd = max(d__1,d__2);
1121 
1122  /* test for roundoff error and eventually set error flag. */
1123 
1124  if (iroff1 + iroff2 >= 10 || iroff3 >= 20) {
1125  *ier = 2;
1126  }
1127  if (iroff2 >= 5) {
1128  ierro = 3;
1129  }
1130 
1131  /* set error flag in the case that the number of */
1132  /* subintervals equals limit. */
1133 
1134  if (*last == *limit) {
1135  *ier = 1;
1136  }
1137 
1138  /* set error flag in the case of bad integrand behaviour */
1139  /* at some points of the integration range. */
1140 
1141  /* Computing MAX */
1142  d__1 = fabs(a1), d__2 = fabs(b2);
1143  if (max(d__1,d__2) <= (epmach * 100. + 1.) * (fabs(a2) + uflow * 1e3))
1144  {
1145  *ier = 4;
1146  }
1147 
1148  /* append the newly-created intervals to the list. */
1149 
1150  if (error2 > error1) {
1151  goto L20;
1152  }
1153  alist__[*last] = a2;
1154  blist[maxerr] = b1;
1155  blist[*last] = b2;
1156  elist[maxerr] = error1;
1157  elist[*last] = error2;
1158  goto L30;
1159  L20:
1160  alist__[maxerr] = a2;
1161  alist__[*last] = a1;
1162  blist[*last] = b1;
1163  rlist[maxerr] = area2;
1164  rlist[*last] = area1;
1165  elist[maxerr] = error2;
1166  elist[*last] = error1;
1167 
1168  /* call subroutine dqpsrt to maintain the descending ordering */
1169  /* in the list of error estimates and select the subinterval */
1170  /* with nrmax-th largest error estimate (to be bisected next). */
1171 
1172  L30:
1173  dqpsrt_(limit, last, &maxerr, &errmax, &elist[1], &iord[1], &nrmax);
1174  if (errsum <= errbnd) {
1175  goto L115;
1176  }
1177  if (*ier != 0) {
1178  goto L100;
1179  }
1180  if (*last == 2) {
1181  goto L80;
1182  }
1183  if (noext) {
1184  goto L90;
1185  }
1186  erlarg -= erlast;
1187  if ((d__1 = b1 - a1, fabs(d__1)) > small) {
1188  erlarg += erro12;
1189  }
1190  if (extrap) {
1191  goto L40;
1192  }
1193 
1194  /* test whether the interval to be bisected next is the */
1195  /* smallest interval. */
1196 
1197  if ((d__1 = blist[maxerr] - alist__[maxerr], fabs(d__1)) > small) {
1198  goto L90;
1199  }
1200  extrap = true;
1201  nrmax = 2;
1202  L40:
1203  if (ierro == 3 || erlarg <= ertest) {
1204  goto L60;
1205  }
1206 
1207  /* the smallest interval has the largest error. */
1208  /* before bisecting decrease the sum of the errors over the */
1209  /* larger intervals (erlarg) and perform extrapolation. */
1210 
1211  id = nrmax;
1212  jupbnd = *last;
1213  if (*last > *limit / 2 + 2) {
1214  jupbnd = *limit + 3 - *last;
1215  }
1216  i__2 = jupbnd;
1217  for (k = id; k <= i__2; ++k) {
1218  maxerr = iord[nrmax];
1219  errmax = elist[maxerr];
1220  if ((d__1 = blist[maxerr] - alist__[maxerr], fabs(d__1)) > small) {
1221  goto L90;
1222  }
1223  ++nrmax;
1224  /* L50: */
1225  }
1226 
1227  /* perform extrapolation. */
1228 
1229  L60:
1230  ++numrl2;
1231  rlist2[numrl2 - 1] = area;
1232  dqelg_(&numrl2, rlist2, &reseps, &abseps, res3la, &nres);
1233  ++ktmin;
1234  if (ktmin > 5 && *abserr < errsum * .001) {
1235  *ier = 5;
1236  }
1237  if (abseps >= *abserr) {
1238  goto L70;
1239  }
1240  ktmin = 0;
1241  *abserr = abseps;
1242  *result = reseps;
1243  correc = erlarg;
1244  /* Computing MAX */
1245  d__1 = *epsabs, d__2 = *epsrel * fabs(reseps);
1246  ertest = max(d__1,d__2);
1247  if (*abserr <= ertest) {
1248  goto L100;
1249  }
1250 
1251  /* prepare bisection of the smallest interval. */
1252 
1253  L70:
1254  if (numrl2 == 1) {
1255  noext = true;
1256  }
1257  if (*ier == 5) {
1258  goto L100;
1259  }
1260  maxerr = iord[1];
1261  errmax = elist[maxerr];
1262  nrmax = 1;
1263  extrap = false;
1264  small *= .5;
1265  erlarg = errsum;
1266  goto L90;
1267  L80:
1268  small = .375;
1269  erlarg = errsum;
1270  ertest = errbnd;
1271  rlist2[1] = area;
1272  L90:
1273  ;
1274  }
1275 
1276  /* set final result and error estimate. */
1277  /* ------------------------------------ */
1278 
1279 L100:
1280  if (*abserr == oflow) {
1281  goto L115;
1282  }
1283  if (*ier + ierro == 0) {
1284  goto L110;
1285  }
1286  if (ierro == 3) {
1287  *abserr += correc;
1288  }
1289  if (*ier == 0) {
1290  *ier = 3;
1291  }
1292  if (*result != 0. && area != 0.) {
1293  goto L105;
1294  }
1295  if (*abserr > errsum) {
1296  goto L115;
1297  }
1298  if (area == 0.) {
1299  goto L130;
1300  }
1301  goto L110;
1302 L105:
1303  if (*abserr / fabs(*result) > errsum / fabs(area)) {
1304  goto L115;
1305  }
1306 
1307  /* test on divergence */
1308 
1309 L110:
1310  /* Computing MAX */
1311  d__1 = fabs(*result), d__2 = fabs(area);
1312  if (ksgn == -1 && max(d__1,d__2) <= defabs * .01) {
1313  goto L130;
1314  }
1315  if (.01 > *result / area || *result / area > 100. || errsum > fabs(area)) {
1316  *ier = 6;
1317  }
1318  goto L130;
1319 
1320  /* compute global integral sum. */
1321 
1322 L115:
1323  *result = 0.;
1324  i__1 = *last;
1325  for (k = 1; k <= i__1; ++k) {
1326  *result += rlist[k];
1327  /* L120: */
1328  }
1329  *abserr = errsum;
1330 L130:
1331  *neval = *last * 30 - 15;
1332  if (*inf == 2) {
1333  *neval <<= 1;
1334  }
1335  if (*ier > 2) {
1336  --(*ier);
1337  }
1338 L999:
1339  return;
1340 } /* dqagie_ */
1341 
1342 void dqagi_(const D_fp& f, const double *bound, const long *inf,
1343  const double *epsabs, const double *epsrel, double *result,
1344  double *abserr, long *neval, long *ier, long *limit,
1345  const long *lenw, long *last, long *iwork, double *work)
1346 {
1347  long l1, l2, l3, lvl;
1348 
1349  /* ***begin prologue dqagi */
1350  /* ***date written 800101 (yymmdd) */
1351  /* ***revision date 830518 (yymmdd) */
1352  /* ***category no. h2a3a1,h2a4a1 */
1353  /* ***keywords automatic integrator, infinite intervals, */
1354  /* general-purpose, transformation, extrapolation, */
1355  /* globally adaptive */
1356  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
1357  /* de doncker,elise,appl. math. & progr. div. -k.u.leuven */
1358  /* ***purpose the routine calculates an approximation result to a given */
1359  /* integral i = integral of f over (bound,+infinity) */
1360  /* or i = integral of f over (-infinity,bound) */
1361  /* or i = integral of f over (-infinity,+infinity) */
1362  /* hopefully satisfying following claim for accuracy */
1363  /* fabs(i-result).le.max(epsabs,epsrel*fabs(i)). */
1364  /* ***description */
1365 
1366  /* integration over infinite intervals */
1367  /* standard fortran subroutine */
1368 
1369  /* parameters */
1370  /* on entry */
1371  /* f - double precision */
1372  /* function subprogram defining the integrand */
1373  /* function f(x). the actual name for f needs to be */
1374  /* declared e x t e r n a l in the driver program. */
1375 
1376  /* bound - double precision */
1377  /* finite bound of integration range */
1378  /* (has no meaning if interval is doubly-infinite) */
1379 
1380  /* inf - long */
1381  /* indicating the kind of integration range involved */
1382  /* inf = 1 corresponds to (bound,+infinity), */
1383  /* inf = -1 to (-infinity,bound), */
1384  /* inf = 2 to (-infinity,+infinity). */
1385 
1386  /* epsabs - double precision */
1387  /* absolute accuracy requested */
1388  /* epsrel - double precision */
1389  /* relative accuracy requested */
1390  /* if epsabs.le.0 */
1391  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
1392  /* the routine will end with ier = 6. */
1393 
1394 
1395  /* on return */
1396  /* result - double precision */
1397  /* approximation to the integral */
1398 
1399  /* abserr - double precision */
1400  /* estimate of the modulus of the absolute error, */
1401  /* which should equal or exceed fabs(i-result) */
1402 
1403  /* neval - long */
1404  /* number of integrand evaluations */
1405 
1406  /* ier - long */
1407  /* ier = 0 normal and reliable termination of the */
1408  /* routine. it is assumed that the requested */
1409  /* accuracy has been achieved. */
1410  /* - ier.gt.0 abnormal termination of the routine. the */
1411  /* estimates for result and error are less */
1412  /* reliable. it is assumed that the requested */
1413  /* accuracy has not been achieved. */
1414  /* error messages */
1415  /* ier = 1 maximum number of subdivisions allowed */
1416  /* has been achieved. one can allow more */
1417  /* subdivisions by increasing the value of */
1418  /* limit (and taking the according dimension */
1419  /* adjustments into account). however, if */
1420  /* this yields no improvement it is advised */
1421  /* to analyze the integrand in order to */
1422  /* determine the integration difficulties. if */
1423  /* the position of a local difficulty can be */
1424  /* determined (e.g. singularity, */
1425  /* discontinuity within the interval) one */
1426  /* will probably gain from splitting up the */
1427  /* interval at this point and calling the */
1428  /* integrator on the subranges. if possible, */
1429  /* an appropriate special-purpose integrator */
1430  /* should be used, which is designed for */
1431  /* handling the type of difficulty involved. */
1432  /* = 2 the occurrence of roundoff error is */
1433  /* detected, which prevents the requested */
1434  /* tolerance from being achieved. */
1435  /* the error may be under-estimated. */
1436  /* = 3 extremely bad integrand behaviour occurs */
1437  /* at some points of the integration */
1438  /* interval. */
1439  /* = 4 the algorithm does not converge. */
1440  /* roundoff error is detected in the */
1441  /* extrapolation table. */
1442  /* it is assumed that the requested tolerance */
1443  /* cannot be achieved, and that the returned */
1444  /* result is the best which can be obtained. */
1445  /* = 5 the integral is probably divergent, or */
1446  /* slowly convergent. it must be noted that */
1447  /* divergence can occur with any other value */
1448  /* of ier. */
1449  /* = 6 the input is invalid, because */
1450  /* (epsabs.le.0 and */
1451  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28)) */
1452  /* or limit.lt.1 or leniw.lt.limit*4. */
1453  /* result, abserr, neval, last are set to */
1454  /* zero. exept when limit or leniw is */
1455  /* invalid, iwork(1), work(limit*2+1) and */
1456  /* work(limit*3+1) are set to zero, work(1) */
1457  /* is set to a and work(limit+1) to b. */
1458 
1459  /* dimensioning parameters */
1460  /* limit - long */
1461  /* dimensioning parameter for iwork */
1462  /* limit determines the maximum number of subintervals */
1463  /* in the partition of the given integration interval */
1464  /* (a,b), limit.ge.1. */
1465  /* if limit.lt.1, the routine will end with ier = 6. */
1466 
1467  /* lenw - long */
1468  /* dimensioning parameter for work */
1469  /* lenw must be at least limit*4. */
1470  /* if lenw.lt.limit*4, the routine will end */
1471  /* with ier = 6. */
1472 
1473  /* last - long */
1474  /* on return, last equals the number of subintervals */
1475  /* produced in the subdivision process, which */
1476  /* determines the number of significant elements */
1477  /* actually in the work arrays. */
1478 
1479  /* work arrays */
1480  /* iwork - long */
1481  /* vector of dimension at least limit, the first */
1482  /* k elements of which contain pointers */
1483  /* to the error estimates over the subintervals, */
1484  /* such that work(limit*3+iwork(1)),... , */
1485  /* work(limit*3+iwork(k)) form a decreasing */
1486  /* sequence, with k = last if last.le.(limit/2+2), and */
1487  /* k = limit+1-last otherwise */
1488 
1489  /* work - double precision */
1490  /* vector of dimension at least lenw */
1491  /* on return */
1492  /* work(1), ..., work(last) contain the left */
1493  /* end points of the subintervals in the */
1494  /* partition of (a,b), */
1495  /* work(limit+1), ..., work(limit+last) contain */
1496  /* the right end points, */
1497  /* work(limit*2+1), ...,work(limit*2+last) contain the */
1498  /* integral approximations over the subintervals, */
1499  /* work(limit*3+1), ..., work(limit*3) */
1500  /* contain the error estimates. */
1501  /* ***references (none) */
1502  /* ***routines called dqagie,xerror */
1503  /* ***end prologue dqagi */
1504 
1505 
1506 
1507 
1508  /* check validity of limit and lenw. */
1509 
1510  /* ***first executable statement dqagi */
1511  /* Parameter adjustments */
1512  --iwork;
1513  --work;
1514 
1515  /* Function Body */
1516  *ier = 6;
1517  *neval = 0;
1518  *last = 0;
1519  *result = 0.;
1520  *abserr = 0.;
1521  if (*limit < 1 || *lenw < *limit << 2) {
1522  goto L10;
1523  }
1524 
1525  /* prepare call for dqagie. */
1526 
1527  l1 = *limit + 1;
1528  l2 = *limit + l1;
1529  l3 = *limit + l2;
1530 
1531  dqagie_(f, bound, inf, epsabs, epsrel, limit, result, abserr, neval,
1532  ier, &work[1], &work[l1], &work[l2], &work[l3], &iwork[1], last);
1533 
1534  /* call error handler if necessary. */
1535 
1536  lvl = 0;
1537 L10:
1538  if (*ier == 6) {
1539  lvl = 1;
1540  }
1541  if (*ier != 0) {
1542  xerror_("abnormal return from dqagi", &c__26, ier, &lvl, 26);
1543  }
1544  return;
1545 } /* dqagi_ */
1546 
1547 void dqagpe_(const D_fp& f, const double *a, const double *b, const long *npts2,
1548  const double *points, const double *epsabs, const double *epsrel,
1549  const long *limit, double *result, double *abserr, long *
1550  neval, long *ier, double *alist__, double *blist,
1551  double *rlist, double *elist, double *pts, long *iord,
1552  long *level, long *ndin, long *last)
1553 {
1554  /* System generated locals */
1555  int i__1, i__2;
1556  double d__1, d__2;
1557 
1558  /* Local variables */
1559  long i__, j, k=0;
1560  double a1, a2, b1, b2;
1561  long id, ip1, ind1, ind2;
1562  double area;
1563  double resa, dres, sign;
1564  long ksgn;
1565  double temp;
1566  long nres, nint, jlow, npts;
1567  double area1, area2, area12;
1568  double erro12;
1569  long ierro;
1570  double defab1, defab2;
1571  long ktmin, nrmax;
1572  double oflow, uflow;
1573  bool noext;
1574  long iroff1, iroff2, iroff3;
1575  double res3la[3];
1576  long nintp1;
1577  double error1, error2, rlist2[52];
1578  long numrl2;
1579  double defabs, epmach, erlarg, abseps, correc=0., errbnd, resabs;
1580  long jupbnd;
1581  double erlast;
1582  long levmax;
1583  double errmax;
1584  long maxerr, levcur;
1585  double reseps;
1586  bool extrap;
1587  double ertest, errsum;
1588 
1589  /* ***begin prologue dqagpe */
1590  /* ***date written 800101 (yymmdd) */
1591  /* ***revision date 830518 (yymmdd) */
1592  /* ***category no. h2a2a1 */
1593  /* ***keywords automatic integrator, general-purpose, */
1594  /* singularities at user specified points, */
1595  /* extrapolation, globally adaptive. */
1596  /* ***author piessens,robert ,appl. math. & progr. div. - k.u.leuven */
1597  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
1598  /* ***purpose the routine calculates an approximation result to a given */
1599  /* definite integral i = integral of f over (a,b), hopefully */
1600  /* satisfying following claim for accuracy fabs(i-result).le. */
1601  /* max(epsabs,epsrel*fabs(i)). break points of the integration */
1602  /* interval, where local difficulties of the integrand may */
1603  /* occur(e.g. singularities,discontinuities),provided by user. */
1604  /* ***description */
1605 
1606  /* computation of a definite integral */
1607  /* standard fortran subroutine */
1608  /* double precision version */
1609 
1610  /* parameters */
1611  /* on entry */
1612  /* f - double precision */
1613  /* function subprogram defining the integrand */
1614  /* function f(x). the actual name for f needs to be */
1615  /* declared e x t e r n a l in the driver program. */
1616 
1617  /* a - double precision */
1618  /* lower limit of integration */
1619 
1620  /* b - double precision */
1621  /* upper limit of integration */
1622 
1623  /* npts2 - long */
1624  /* number equal to two more than the number of */
1625  /* user-supplied break points within the integration */
1626  /* range, npts2.ge.2. */
1627  /* if npts2.lt.2, the routine will end with ier = 6. */
1628 
1629  /* points - double precision */
1630  /* vector of dimension npts2, the first (npts2-2) */
1631  /* elements of which are the user provided break */
1632  /* points. if these points do not constitute an */
1633  /* ascending sequence there will be an automatic */
1634  /* sorting. */
1635 
1636  /* epsabs - double precision */
1637  /* absolute accuracy requested */
1638  /* epsrel - double precision */
1639  /* relative accuracy requested */
1640  /* if epsabs.le.0 */
1641  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
1642  /* the routine will end with ier = 6. */
1643 
1644  /* limit - long */
1645  /* gives an upper bound on the number of subintervals */
1646  /* in the partition of (a,b), limit.ge.npts2 */
1647  /* if limit.lt.npts2, the routine will end with */
1648  /* ier = 6. */
1649 
1650  /* on return */
1651  /* result - double precision */
1652  /* approximation to the integral */
1653 
1654  /* abserr - double precision */
1655  /* estimate of the modulus of the absolute error, */
1656  /* which should equal or exceed fabs(i-result) */
1657 
1658  /* neval - long */
1659  /* number of integrand evaluations */
1660 
1661  /* ier - long */
1662  /* ier = 0 normal and reliable termination of the */
1663  /* routine. it is assumed that the requested */
1664  /* accuracy has been achieved. */
1665  /* ier.gt.0 abnormal termination of the routine. */
1666  /* the estimates for integral and error are */
1667  /* less reliable. it is assumed that the */
1668  /* requested accuracy has not been achieved. */
1669  /* error messages */
1670  /* ier = 1 maximum number of subdivisions allowed */
1671  /* has been achieved. one can allow more */
1672  /* subdivisions by increasing the value of */
1673  /* limit (and taking the according dimension */
1674  /* adjustments into account). however, if */
1675  /* this yields no improvement it is advised */
1676  /* to analyze the integrand in order to */
1677  /* determine the integration difficulties. if */
1678  /* the position of a local difficulty can be */
1679  /* determined (i.e. singularity, */
1680  /* discontinuity within the interval), it */
1681  /* should be supplied to the routine as an */
1682  /* element of the vector points. if necessary */
1683  /* an appropriate special-purpose integrator */
1684  /* must be used, which is designed for */
1685  /* handling the type of difficulty involved. */
1686  /* = 2 the occurrence of roundoff error is */
1687  /* detected, which prevents the requested */
1688  /* tolerance from being achieved. */
1689  /* the error may be under-estimated. */
1690  /* = 3 extremely bad integrand behaviour occurs */
1691  /* at some points of the integration */
1692  /* interval. */
1693  /* = 4 the algorithm does not converge. */
1694  /* roundoff error is detected in the */
1695  /* extrapolation table. it is presumed that */
1696  /* the requested tolerance cannot be */
1697  /* achieved, and that the returned result is */
1698  /* the best which can be obtained. */
1699  /* = 5 the integral is probably divergent, or */
1700  /* slowly convergent. it must be noted that */
1701  /* divergence can occur with any other value */
1702  /* of ier.gt.0. */
1703  /* = 6 the input is invalid because */
1704  /* npts2.lt.2 or */
1705  /* break points are specified outside */
1706  /* the integration range or */
1707  /* (epsabs.le.0 and */
1708  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28)) */
1709  /* or limit.lt.npts2. */
1710  /* result, abserr, neval, last, rlist(1), */
1711  /* and elist(1) are set to zero. alist(1) and */
1712  /* blist(1) are set to a and b respectively. */
1713 
1714  /* alist - double precision */
1715  /* vector of dimension at least limit, the first */
1716  /* last elements of which are the left end points */
1717  /* of the subintervals in the partition of the given */
1718  /* integration range (a,b) */
1719 
1720  /* blist - double precision */
1721  /* vector of dimension at least limit, the first */
1722  /* last elements of which are the right end points */
1723  /* of the subintervals in the partition of the given */
1724  /* integration range (a,b) */
1725 
1726  /* rlist - double precision */
1727  /* vector of dimension at least limit, the first */
1728  /* last elements of which are the integral */
1729  /* approximations on the subintervals */
1730 
1731  /* elist - double precision */
1732  /* vector of dimension at least limit, the first */
1733  /* last elements of which are the moduli of the */
1734  /* absolute error estimates on the subintervals */
1735 
1736  /* pts - double precision */
1737  /* vector of dimension at least npts2, containing the */
1738  /* integration limits and the break points of the */
1739  /* interval in ascending sequence. */
1740 
1741  /* level - long */
1742  /* vector of dimension at least limit, containing the */
1743  /* subdivision levels of the subinterval, i.e. if */
1744  /* (aa,bb) is a subinterval of (p1,p2) where p1 as */
1745  /* well as p2 is a user-provided break point or */
1746  /* integration limit, then (aa,bb) has level l if */
1747  /* fabs(bb-aa) = fabs(p2-p1)*2**(-l). */
1748 
1749  /* ndin - long */
1750  /* vector of dimension at least npts2, after first */
1751  /* integration over the intervals (pts(i)),pts(i+1), */
1752  /* i = 0,1, ..., npts2-2, the error estimates over */
1753  /* some of the intervals may have been increased */
1754  /* artificially, in order to put their subdivision */
1755  /* forward. if this happens for the subinterval */
1756  /* numbered k, ndin(k) is put to 1, otherwise */
1757  /* ndin(k) = 0. */
1758 
1759  /* iord - long */
1760  /* vector of dimension at least limit, the first k */
1761  /* elements of which are pointers to the */
1762  /* error estimates over the subintervals, */
1763  /* such that elist(iord(1)), ..., elist(iord(k)) */
1764  /* form a decreasing sequence, with k = last */
1765  /* if last.le.(limit/2+2), and k = limit+1-last */
1766  /* otherwise */
1767 
1768  /* last - long */
1769  /* number of subintervals actually produced in the */
1770  /* subdivisions process */
1771 
1772  /* ***references (none) */
1773  /* ***routines called d1mach,dqelg,dqk21,dqpsrt */
1774  /* ***end prologue dqagpe */
1775 
1776 
1777 
1778 
1779  /* the dimension of rlist2 is determined by the value of */
1780  /* limexp in subroutine epsalg (rlist2 should be of dimension */
1781  /* (limexp+2) at least). */
1782 
1783 
1784  /* list of major variables */
1785  /* ----------------------- */
1786 
1787  /* alist - list of left end points of all subintervals */
1788  /* considered up to now */
1789  /* blist - list of right end points of all subintervals */
1790  /* considered up to now */
1791  /* rlist(i) - approximation to the integral over */
1792  /* (alist(i),blist(i)) */
1793  /* rlist2 - array of dimension at least limexp+2 */
1794  /* containing the part of the epsilon table which */
1795  /* is still needed for further computations */
1796  /* elist(i) - error estimate applying to rlist(i) */
1797  /* maxerr - pointer to the interval with largest error */
1798  /* estimate */
1799  /* errmax - elist(maxerr) */
1800  /* erlast - error on the interval currently subdivided */
1801  /* (before that subdivision has taken place) */
1802  /* area - sum of the integrals over the subintervals */
1803  /* errsum - sum of the errors over the subintervals */
1804  /* errbnd - requested accuracy max(epsabs,epsrel* */
1805  /* fabs(result)) */
1806  /* *****1 - variable for the left subinterval */
1807  /* *****2 - variable for the right subinterval */
1808  /* last - index for subdivision */
1809  /* nres - number of calls to the extrapolation routine */
1810  /* numrl2 - number of elements in rlist2. if an appropriate */
1811  /* approximation to the compounded integral has */
1812  /* been obtained, it is put in rlist2(numrl2) after */
1813  /* numrl2 has been increased by one. */
1814  /* erlarg - sum of the errors over the intervals larger */
1815  /* than the smallest interval considered up to now */
1816  /* extrap - bool variable denoting that the routine */
1817  /* is attempting to perform extrapolation. i.e. */
1818  /* before subdividing the smallest interval we */
1819  /* try to decrease the value of erlarg. */
1820  /* noext - bool variable denoting that extrapolation is */
1821  /* no longer allowed (true-value) */
1822 
1823  /* machine dependent constants */
1824  /* --------------------------- */
1825 
1826  /* epmach is the largest relative spacing. */
1827  /* uflow is the smallest positive magnitude. */
1828  /* oflow is the largest positive magnitude. */
1829 
1830  /* ***first executable statement dqagpe */
1831  /* Parameter adjustments */
1832  --ndin;
1833  --pts;
1834  --points;
1835  --level;
1836  --iord;
1837  --elist;
1838  --rlist;
1839  --blist;
1840  --alist__;
1841 
1842  /* Function Body */
1843  epmach = d1mach(c__4);
1844 
1845  /* test on validity of parameters */
1846  /* ----------------------------- */
1847 
1848  *ier = 0;
1849  *neval = 0;
1850  *last = 0;
1851  *result = 0.;
1852  *abserr = 0.;
1853  alist__[1] = *a;
1854  blist[1] = *b;
1855  rlist[1] = 0.;
1856  elist[1] = 0.;
1857  iord[1] = 0;
1858  level[1] = 0;
1859  npts = *npts2 - 2;
1860  /* Computing MAX */
1861  d__1 = epmach * 50.;
1862  if (*npts2 < 2 || *limit <= npts ||
1863  ( *epsabs <= 0. && *epsrel < max(d__1,5e-29 ))) {
1864  *ier = 6;
1865  }
1866  if (*ier == 6) {
1867  goto L999;
1868  }
1869 
1870  /* if any break points are provided, sort them into an */
1871  /* ascending sequence. */
1872 
1873  sign = 1.;
1874  if (*a > *b) {
1875  sign = -1.;
1876  }
1877  pts[1] = min(*a,*b);
1878  if (npts == 0) {
1879  goto L15;
1880  }
1881  i__1 = npts;
1882  for (i__ = 1; i__ <= i__1; ++i__) {
1883  pts[i__ + 1] = points[i__];
1884  /* L10: */
1885  }
1886 L15:
1887  pts[npts + 2] = max(*a,*b);
1888  nint = npts + 1;
1889  a1 = pts[1];
1890  if (npts == 0) {
1891  goto L40;
1892  }
1893  nintp1 = nint + 1;
1894  i__1 = nint;
1895  for (i__ = 1; i__ <= i__1; ++i__) {
1896  ip1 = i__ + 1;
1897  i__2 = nintp1;
1898  for (j = ip1; j <= i__2; ++j) {
1899  if (pts[i__] <= pts[j]) {
1900  goto L20;
1901  }
1902  temp = pts[i__];
1903  pts[i__] = pts[j];
1904  pts[j] = temp;
1905  L20:
1906  ;
1907  }
1908  }
1909  if (pts[1] != min(*a,*b) || pts[nintp1] != max(*a,*b)) {
1910  *ier = 6;
1911  }
1912  if (*ier == 6) {
1913  goto L999;
1914  }
1915 
1916  /* compute first integral and error approximations. */
1917  /* ------------------------------------------------ */
1918 
1919 L40:
1920  resabs = 0.;
1921  i__2 = nint;
1922  for (i__ = 1; i__ <= i__2; ++i__) {
1923  b1 = pts[i__ + 1];
1924  dqk21_(f, &a1, &b1, &area1, &error1, &defabs, &resa);
1925  *abserr += error1;
1926  *result += area1;
1927  ndin[i__] = 0;
1928  if (error1 == resa && error1 != 0.) {
1929  ndin[i__] = 1;
1930  }
1931  resabs += defabs;
1932  level[i__] = 0;
1933  elist[i__] = error1;
1934  alist__[i__] = a1;
1935  blist[i__] = b1;
1936  rlist[i__] = area1;
1937  iord[i__] = i__;
1938  a1 = b1;
1939  /* L50: */
1940  }
1941  errsum = 0.;
1942  i__2 = nint;
1943  for (i__ = 1; i__ <= i__2; ++i__) {
1944  if (ndin[i__] == 1) {
1945  elist[i__] = *abserr;
1946  }
1947  errsum += elist[i__];
1948  /* L55: */
1949  }
1950 
1951  /* test on accuracy. */
1952 
1953  *last = nint;
1954  *neval = nint * 21;
1955  dres = fabs(*result);
1956  /* Computing MAX */
1957  d__1 = *epsabs, d__2 = *epsrel * dres;
1958  errbnd = max(d__1,d__2);
1959  if (*abserr <= epmach * 100. * resabs && *abserr > errbnd) {
1960  *ier = 2;
1961  }
1962  if (nint == 1) {
1963  goto L80;
1964  }
1965  i__2 = npts;
1966  for (i__ = 1; i__ <= i__2; ++i__) {
1967  jlow = i__ + 1;
1968  ind1 = iord[i__];
1969  i__1 = nint;
1970  for (j = jlow; j <= i__1; ++j) {
1971  ind2 = iord[j];
1972  if (elist[ind1] > elist[ind2]) {
1973  goto L60;
1974  }
1975  ind1 = ind2;
1976  k = j;
1977  L60:
1978  ;
1979  }
1980  if (ind1 == iord[i__]) {
1981  goto L70;
1982  }
1983  iord[k] = iord[i__];
1984  iord[i__] = ind1;
1985  L70:
1986  ;
1987  }
1988  if (*limit < *npts2) {
1989  *ier = 1;
1990  }
1991 L80:
1992  if (*ier != 0 || *abserr <= errbnd) {
1993  goto L210;
1994  }
1995 
1996  /* initialization */
1997  /* -------------- */
1998 
1999  rlist2[0] = *result;
2000  maxerr = iord[1];
2001  errmax = elist[maxerr];
2002  area = *result;
2003  nrmax = 1;
2004  nres = 0;
2005  numrl2 = 1;
2006  ktmin = 0;
2007  extrap = false;
2008  noext = false;
2009  erlarg = errsum;
2010  ertest = errbnd;
2011  levmax = 1;
2012  iroff1 = 0;
2013  iroff2 = 0;
2014  iroff3 = 0;
2015  ierro = 0;
2016  uflow = d1mach(c__1);
2017  oflow = d1mach(c__2);
2018  *abserr = oflow;
2019  ksgn = -1;
2020  if (dres >= (1. - epmach * 50.) * resabs) {
2021  ksgn = 1;
2022  }
2023 
2024  /* main do-loop */
2025  /* ------------ */
2026 
2027  i__2 = *limit;
2028  for (*last = *npts2; *last <= i__2; ++(*last)) {
2029 
2030  /* bisect the subinterval with the nrmax-th largest error */
2031  /* estimate. */
2032 
2033  levcur = level[maxerr] + 1;
2034  a1 = alist__[maxerr];
2035  b1 = (alist__[maxerr] + blist[maxerr]) * .5;
2036  a2 = b1;
2037  b2 = blist[maxerr];
2038  erlast = errmax;
2039  dqk21_(f, &a1, &b1, &area1, &error1, &resa, &defab1);
2040  dqk21_(f, &a2, &b2, &area2, &error2, &resa, &defab2);
2041 
2042  /* improve previous approximations to integral */
2043  /* and error and test for accuracy. */
2044 
2045  *neval += 42;
2046  area12 = area1 + area2;
2047  erro12 = error1 + error2;
2048  errsum = errsum + erro12 - errmax;
2049  area = area + area12 - rlist[maxerr];
2050  if (defab1 == error1 || defab2 == error2) {
2051  goto L95;
2052  }
2053  if ((d__1 = rlist[maxerr] - area12, fabs(d__1)) > fabs(area12) * 1e-5 ||
2054  erro12 < errmax * .99) {
2055  goto L90;
2056  }
2057  if (extrap) {
2058  ++iroff2;
2059  }
2060  if (! extrap) {
2061  ++iroff1;
2062  }
2063  L90:
2064  if (*last > 10 && erro12 > errmax) {
2065  ++iroff3;
2066  }
2067  L95:
2068  level[maxerr] = levcur;
2069  level[*last] = levcur;
2070  rlist[maxerr] = area1;
2071  rlist[*last] = area2;
2072  /* Computing MAX */
2073  d__1 = *epsabs, d__2 = *epsrel * fabs(area);
2074  errbnd = max(d__1,d__2);
2075 
2076  /* test for roundoff error and eventually set error flag. */
2077 
2078  if (iroff1 + iroff2 >= 10 || iroff3 >= 20) {
2079  *ier = 2;
2080  }
2081  if (iroff2 >= 5) {
2082  ierro = 3;
2083  }
2084 
2085  /* set error flag in the case that the number of */
2086  /* subintervals equals limit. */
2087 
2088  if (*last == *limit) {
2089  *ier = 1;
2090  }
2091 
2092  /* set error flag in the case of bad integrand behaviour */
2093  /* at a point of the integration range */
2094 
2095  /* Computing MAX */
2096  d__1 = fabs(a1), d__2 = fabs(b2);
2097  if (max(d__1,d__2) <= (epmach * 100. + 1.) * (fabs(a2) + uflow * 1e3))
2098  {
2099  *ier = 4;
2100  }
2101 
2102  /* append the newly-created intervals to the list. */
2103 
2104  if (error2 > error1) {
2105  goto L100;
2106  }
2107  alist__[*last] = a2;
2108  blist[maxerr] = b1;
2109  blist[*last] = b2;
2110  elist[maxerr] = error1;
2111  elist[*last] = error2;
2112  goto L110;
2113  L100:
2114  alist__[maxerr] = a2;
2115  alist__[*last] = a1;
2116  blist[*last] = b1;
2117  rlist[maxerr] = area2;
2118  rlist[*last] = area1;
2119  elist[maxerr] = error2;
2120  elist[*last] = error1;
2121 
2122  /* call subroutine dqpsrt to maintain the descending ordering */
2123  /* in the list of error estimates and select the subinterval */
2124  /* with nrmax-th largest error estimate (to be bisected next). */
2125 
2126  L110:
2127  dqpsrt_(limit, last, &maxerr, &errmax, &elist[1], &iord[1], &nrmax);
2128  /* ***jump out of do-loop */
2129  if (errsum <= errbnd) {
2130  goto L190;
2131  }
2132  /* ***jump out of do-loop */
2133  if (*ier != 0) {
2134  goto L170;
2135  }
2136  if (noext) {
2137  goto L160;
2138  }
2139  erlarg -= erlast;
2140  if (levcur + 1 <= levmax) {
2141  erlarg += erro12;
2142  }
2143  if (extrap) {
2144  goto L120;
2145  }
2146 
2147  /* test whether the interval to be bisected next is the */
2148  /* smallest interval. */
2149 
2150  if (level[maxerr] + 1 <= levmax) {
2151  goto L160;
2152  }
2153  extrap = true;
2154  nrmax = 2;
2155  L120:
2156  if (ierro == 3 || erlarg <= ertest) {
2157  goto L140;
2158  }
2159 
2160  /* the smallest interval has the largest error. */
2161  /* before bisecting decrease the sum of the errors over */
2162  /* the larger intervals (erlarg) and perform extrapolation. */
2163 
2164  id = nrmax;
2165  jupbnd = *last;
2166  if (*last > *limit / 2 + 2) {
2167  jupbnd = *limit + 3 - *last;
2168  }
2169  i__1 = jupbnd;
2170  for (k = id; k <= i__1; ++k) {
2171  maxerr = iord[nrmax];
2172  errmax = elist[maxerr];
2173  /* ***jump out of do-loop */
2174  if (level[maxerr] + 1 <= levmax) {
2175  goto L160;
2176  }
2177  ++nrmax;
2178  /* L130: */
2179  }
2180 
2181  /* perform extrapolation. */
2182 
2183  L140:
2184  ++numrl2;
2185  rlist2[numrl2 - 1] = area;
2186  if (numrl2 <= 2) {
2187  goto L155;
2188  }
2189  dqelg_(&numrl2, rlist2, &reseps, &abseps, res3la, &nres);
2190  ++ktmin;
2191  if (ktmin > 5 && *abserr < errsum * .001) {
2192  *ier = 5;
2193  }
2194  if (abseps >= *abserr) {
2195  goto L150;
2196  }
2197  ktmin = 0;
2198  *abserr = abseps;
2199  *result = reseps;
2200  correc = erlarg;
2201  /* Computing MAX */
2202  d__1 = *epsabs, d__2 = *epsrel * fabs(reseps);
2203  ertest = max(d__1,d__2);
2204  /* ***jump out of do-loop */
2205  if (*abserr < ertest) {
2206  goto L170;
2207  }
2208 
2209  /* prepare bisection of the smallest interval. */
2210 
2211  L150:
2212  if (numrl2 == 1) {
2213  noext = true;
2214  }
2215  if (*ier >= 5) {
2216  goto L170;
2217  }
2218  L155:
2219  maxerr = iord[1];
2220  errmax = elist[maxerr];
2221  nrmax = 1;
2222  extrap = false;
2223  ++levmax;
2224  erlarg = errsum;
2225  L160:
2226  ;
2227  }
2228 
2229  /* set the final result. */
2230  /* --------------------- */
2231 
2232 
2233 L170:
2234  if (*abserr == oflow) {
2235  goto L190;
2236  }
2237  if (*ier + ierro == 0) {
2238  goto L180;
2239  }
2240  if (ierro == 3) {
2241  *abserr += correc;
2242  }
2243  if (*ier == 0) {
2244  *ier = 3;
2245  }
2246  if (*result != 0. && area != 0.) {
2247  goto L175;
2248  }
2249  if (*abserr > errsum) {
2250  goto L190;
2251  }
2252  if (area == 0.) {
2253  goto L210;
2254  }
2255  goto L180;
2256 L175:
2257  if (*abserr / fabs(*result) > errsum / fabs(area)) {
2258  goto L190;
2259  }
2260 
2261  /* test on divergence. */
2262 
2263 L180:
2264  /* Computing MAX */
2265  d__1 = fabs(*result), d__2 = fabs(area);
2266  if (ksgn == -1 && max(d__1,d__2) <= resabs * .01) {
2267  goto L210;
2268  }
2269  if (.01 > *result / area || *result / area > 100. || errsum > fabs(area)) {
2270  *ier = 6;
2271  }
2272  goto L210;
2273 
2274  /* compute global integral sum. */
2275 
2276 L190:
2277  *result = 0.;
2278  i__2 = *last;
2279  for (k = 1; k <= i__2; ++k) {
2280  *result += rlist[k];
2281  /* L200: */
2282  }
2283  *abserr = errsum;
2284 L210:
2285  if (*ier > 2) {
2286  --(*ier);
2287  }
2288  *result *= sign;
2289 L999:
2290  return;
2291 } /* dqagpe_ */
2292 
2293 void dqagp_(const D_fp& f, const double *a, const double *b, const long *npts2,
2294  const double *points, const double *epsabs, const double *epsrel,
2295  double *result, double *abserr, long *neval, long *ier,
2296  const long *leniw, const long *lenw, long *last, long *iwork,
2297  double *work)
2298 {
2299  long l1, l2, l3, l4, lvl, limit;
2300 
2301  /* ***begin prologue dqagp */
2302  /* ***date written 800101 (yymmdd) */
2303  /* ***revision date 830518 (yymmdd) */
2304  /* ***category no. h2a2a1 */
2305  /* ***keywords automatic integrator, general-purpose, */
2306  /* singularities at user specified points, */
2307  /* extrapolation, globally adaptive */
2308  /* ***author piessens,robert,appl. math. & progr. div - k.u.leuven */
2309  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
2310  /* ***purpose the routine calculates an approximation result to a given */
2311  /* definite integral i = integral of f over (a,b), */
2312  /* hopefully satisfying following claim for accuracy */
2313  /* break points of the integration interval, where local */
2314  /* difficulties of the integrand may occur (e.g. */
2315  /* singularities, discontinuities), are provided by the user. */
2316  /* ***description */
2317 
2318  /* computation of a definite integral */
2319  /* standard fortran subroutine */
2320  /* double precision version */
2321 
2322  /* parameters */
2323  /* on entry */
2324  /* f - double precision */
2325  /* function subprogram defining the integrand */
2326  /* function f(x). the actual name for f needs to be */
2327  /* declared e x t e r n a l in the driver program. */
2328 
2329  /* a - double precision */
2330  /* lower limit of integration */
2331 
2332  /* b - double precision */
2333  /* upper limit of integration */
2334 
2335  /* npts2 - long */
2336  /* number equal to two more than the number of */
2337  /* user-supplied break points within the integration */
2338  /* range, npts.ge.2. */
2339  /* if npts2.lt.2, the routine will end with ier = 6. */
2340 
2341  /* points - double precision */
2342  /* vector of dimension npts2, the first (npts2-2) */
2343  /* elements of which are the user provided break */
2344  /* points. if these points do not constitute an */
2345  /* ascending sequence there will be an automatic */
2346  /* sorting. */
2347 
2348  /* epsabs - double precision */
2349  /* absolute accuracy requested */
2350  /* epsrel - double precision */
2351  /* relative accuracy requested */
2352  /* if epsabs.le.0 */
2353  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
2354  /* the routine will end with ier = 6. */
2355 
2356  /* on return */
2357  /* result - double precision */
2358  /* approximation to the integral */
2359 
2360  /* abserr - double precision */
2361  /* estimate of the modulus of the absolute error, */
2362  /* which should equal or exceed fabs(i-result) */
2363 
2364  /* neval - long */
2365  /* number of integrand evaluations */
2366 
2367  /* ier - long */
2368  /* ier = 0 normal and reliable termination of the */
2369  /* routine. it is assumed that the requested */
2370  /* accuracy has been achieved. */
2371  /* ier.gt.0 abnormal termination of the routine. */
2372  /* the estimates for integral and error are */
2373  /* less reliable. it is assumed that the */
2374  /* requested accuracy has not been achieved. */
2375  /* error messages */
2376  /* ier = 1 maximum number of subdivisions allowed */
2377  /* has been achieved. one can allow more */
2378  /* subdivisions by increasing the value of */
2379  /* limit (and taking the according dimension */
2380  /* adjustments into account). however, if */
2381  /* this yields no improvement it is advised */
2382  /* to analyze the integrand in order to */
2383  /* determine the integration difficulties. if */
2384  /* the position of a local difficulty can be */
2385  /* determined (i.e. singularity, */
2386  /* discontinuity within the interval), it */
2387  /* should be supplied to the routine as an */
2388  /* element of the vector points. if necessary */
2389  /* an appropriate special-purpose integrator */
2390  /* must be used, which is designed for */
2391  /* handling the type of difficulty involved. */
2392  /* = 2 the occurrence of roundoff error is */
2393  /* detected, which prevents the requested */
2394  /* tolerance from being achieved. */
2395  /* the error may be under-estimated. */
2396  /* = 3 extremely bad integrand behaviour occurs */
2397  /* at some points of the integration */
2398  /* interval. */
2399  /* = 4 the algorithm does not converge. */
2400  /* roundoff error is detected in the */
2401  /* extrapolation table. */
2402  /* it is presumed that the requested */
2403  /* tolerance cannot be achieved, and that */
2404  /* the returned result is the best which */
2405  /* can be obtained. */
2406  /* = 5 the integral is probably divergent, or */
2407  /* slowly convergent. it must be noted that */
2408  /* divergence can occur with any other value */
2409  /* of ier.gt.0. */
2410  /* = 6 the input is invalid because */
2411  /* npts2.lt.2 or */
2412  /* break points are specified outside */
2413  /* the integration range or */
2414  /* (epsabs.le.0 and */
2415  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28)) */
2416  /* result, abserr, neval, last are set to */
2417  /* zero. exept when leniw or lenw or npts2 is */
2418  /* invalid, iwork(1), iwork(limit+1), */
2419  /* work(limit*2+1) and work(limit*3+1) */
2420  /* are set to zero. */
2421  /* work(1) is set to a and work(limit+1) */
2422  /* to b (where limit = (leniw-npts2)/2). */
2423 
2424  /* dimensioning parameters */
2425  /* leniw - long */
2426  /* dimensioning parameter for iwork */
2427  /* leniw determines limit = (leniw-npts2)/2, */
2428  /* which is the maximum number of subintervals in the */
2429  /* partition of the given integration interval (a,b), */
2430  /* leniw.ge.(3*npts2-2). */
2431  /* if leniw.lt.(3*npts2-2), the routine will end with */
2432  /* ier = 6. */
2433 
2434  /* lenw - long */
2435  /* dimensioning parameter for work */
2436  /* lenw must be at least leniw*2-npts2. */
2437  /* if lenw.lt.leniw*2-npts2, the routine will end */
2438  /* with ier = 6. */
2439 
2440  /* last - long */
2441  /* on return, last equals the number of subintervals */
2442  /* produced in the subdivision process, which */
2443  /* determines the number of significant elements */
2444  /* actually in the work arrays. */
2445 
2446  /* work arrays */
2447  /* iwork - long */
2448  /* vector of dimension at least leniw. on return, */
2449  /* the first k elements of which contain */
2450  /* pointers to the error estimates over the */
2451  /* subintervals, such that work(limit*3+iwork(1)),..., */
2452  /* work(limit*3+iwork(k)) form a decreasing */
2453  /* sequence, with k = last if last.le.(limit/2+2), and */
2454  /* k = limit+1-last otherwise */
2455  /* iwork(limit+1), ...,iwork(limit+last) contain the */
2456  /* subdivision levels of the subintervals, i.e. */
2457  /* if (aa,bb) is a subinterval of (p1,p2) */
2458  /* where p1 as well as p2 is a user-provided */
2459  /* break point or integration limit, then (aa,bb) has */
2460  /* level l if fabs(bb-aa) = fabs(p2-p1)*2**(-l), */
2461  /* iwork(limit*2+1), ..., iwork(limit*2+npts2) have */
2462  /* no significance for the user, */
2463  /* note that limit = (leniw-npts2)/2. */
2464 
2465  /* work - double precision */
2466  /* vector of dimension at least lenw */
2467  /* on return */
2468  /* work(1), ..., work(last) contain the left */
2469  /* end points of the subintervals in the */
2470  /* partition of (a,b), */
2471  /* work(limit+1), ..., work(limit+last) contain */
2472  /* the right end points, */
2473  /* work(limit*2+1), ..., work(limit*2+last) contain */
2474  /* the integral approximations over the subintervals, */
2475  /* work(limit*3+1), ..., work(limit*3+last) */
2476  /* contain the corresponding error estimates, */
2477  /* work(limit*4+1), ..., work(limit*4+npts2) */
2478  /* contain the integration limits and the */
2479  /* break points sorted in an ascending sequence. */
2480  /* note that limit = (leniw-npts2)/2. */
2481 
2482  /* ***references (none) */
2483  /* ***routines called dqagpe,xerror */
2484  /* ***end prologue dqagp */
2485 
2486 
2487 
2488 
2489  /* check validity of limit and lenw. */
2490 
2491  /* ***first executable statement dqagp */
2492  /* Parameter adjustments */
2493  --points;
2494  --iwork;
2495  --work;
2496 
2497  /* Function Body */
2498  *ier = 6;
2499  *neval = 0;
2500  *last = 0;
2501  *result = 0.;
2502  *abserr = 0.;
2503  if (*leniw < *npts2 * 3 - 2 || *lenw < (*leniw << 1) - *npts2 || *npts2 <
2504  2) {
2505  goto L10;
2506  }
2507 
2508  /* prepare call for dqagpe. */
2509 
2510  limit = (*leniw - *npts2) / 2;
2511  l1 = limit + 1;
2512  l2 = limit + l1;
2513  l3 = limit + l2;
2514  l4 = limit + l3;
2515 
2516  dqagpe_(f, a, b, npts2, &points[1], epsabs, epsrel, &limit, result,
2517  abserr, neval, ier, &work[1], &work[l1], &work[l2], &work[l3], &
2518  work[l4], &iwork[1], &iwork[l1], &iwork[l2], last);
2519 
2520  /* call error handler if necessary. */
2521 
2522  lvl = 0;
2523 L10:
2524  if (*ier == 6) {
2525  lvl = 1;
2526  }
2527  if (*ier != 0) {
2528  xerror_("abnormal return from dqagp", &c__26, ier, &lvl, 26);
2529  }
2530  return;
2531 } /* dqagp_ */
2532 
2533 void dqagse_(const D_fp& f, const double *a, const double *b,
2534  const double *epsabs, const double *epsrel, const long *limit,
2535  double *result,
2536  double *abserr, long *neval, long *ier, double *alist__,
2537  double *blist, double *rlist, double *elist, long *
2538  iord, long *last)
2539 {
2540  /* System generated locals */
2541  int i__1, i__2;
2542  double d__1, d__2;
2543 
2544  /* Local variables */
2545  long k;
2546  double a1, a2, b1, b2;
2547  long id;
2548  double area;
2549  double dres;
2550  long ksgn, nres;
2551  double area1, area2, area12;
2552  double small=0., erro12;
2553  long ierro;
2554  double defab1, defab2;
2555  long ktmin, nrmax;
2556  double oflow, uflow;
2557  bool noext;
2558  long iroff1, iroff2, iroff3;
2559  double res3la[3], error1, error2, rlist2[52];
2560  long numrl2;
2561  double defabs, epmach, erlarg=0., abseps, correc=0., errbnd, resabs;
2562  long jupbnd;
2563  double erlast, errmax;
2564  long maxerr;
2565  double reseps;
2566  bool extrap;
2567  double ertest=0., errsum;
2568 
2569  /* ***begin prologue dqagse */
2570  /* ***date written 800101 (yymmdd) */
2571  /* ***revision date 830518 (yymmdd) */
2572  /* ***category no. h2a1a1 */
2573  /* ***keywords automatic integrator, general-purpose, */
2574  /* (end point) singularities, extrapolation, */
2575  /* globally adaptive */
2576  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
2577  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
2578  /* ***purpose the routine calculates an approximation result to a given */
2579  /* definite integral i = integral of f over (a,b), */
2580  /* hopefully satisfying following claim for accuracy */
2581  /* fabs(i-result).le.max(epsabs,epsrel*fabs(i)). */
2582  /* ***description */
2583 
2584  /* computation of a definite integral */
2585  /* standard fortran subroutine */
2586  /* double precision version */
2587 
2588  /* parameters */
2589  /* on entry */
2590  /* f - double precision */
2591  /* function subprogram defining the integrand */
2592  /* function f(x). the actual name for f needs to be */
2593  /* declared e x t e r n a l in the driver program. */
2594 
2595  /* a - double precision */
2596  /* lower limit of integration */
2597 
2598  /* b - double precision */
2599  /* upper limit of integration */
2600 
2601  /* epsabs - double precision */
2602  /* absolute accuracy requested */
2603  /* epsrel - double precision */
2604  /* relative accuracy requested */
2605  /* if epsabs.le.0 */
2606  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
2607  /* the routine will end with ier = 6. */
2608 
2609  /* limit - long */
2610  /* gives an upperbound on the number of subintervals */
2611  /* in the partition of (a,b) */
2612 
2613  /* on return */
2614  /* result - double precision */
2615  /* approximation to the integral */
2616 
2617  /* abserr - double precision */
2618  /* estimate of the modulus of the absolute error, */
2619  /* which should equal or exceed fabs(i-result) */
2620 
2621  /* neval - long */
2622  /* number of integrand evaluations */
2623 
2624  /* ier - long */
2625  /* ier = 0 normal and reliable termination of the */
2626  /* routine. it is assumed that the requested */
2627  /* accuracy has been achieved. */
2628  /* ier.gt.0 abnormal termination of the routine */
2629  /* the estimates for integral and error are */
2630  /* less reliable. it is assumed that the */
2631  /* requested accuracy has not been achieved. */
2632  /* error messages */
2633  /* = 1 maximum number of subdivisions allowed */
2634  /* has been achieved. one can allow more sub- */
2635  /* divisions by increasing the value of limit */
2636  /* (and taking the according dimension */
2637  /* adjustments into account). however, if */
2638  /* this yields no improvement it is advised */
2639  /* to analyze the integrand in order to */
2640  /* determine the integration difficulties. if */
2641  /* the position of a local difficulty can be */
2642  /* determined (e.g. singularity, */
2643  /* discontinuity within the interval) one */
2644  /* will probably gain from splitting up the */
2645  /* interval at this point and calling the */
2646  /* integrator on the subranges. if possible, */
2647  /* an appropriate special-purpose integrator */
2648  /* should be used, which is designed for */
2649  /* handling the type of difficulty involved. */
2650  /* = 2 the occurrence of roundoff error is detec- */
2651  /* ted, which prevents the requested */
2652  /* tolerance from being achieved. */
2653  /* the error may be under-estimated. */
2654  /* = 3 extremely bad integrand behaviour */
2655  /* occurs at some points of the integration */
2656  /* interval. */
2657  /* = 4 the algorithm does not converge. */
2658  /* roundoff error is detected in the */
2659  /* extrapolation table. */
2660  /* it is presumed that the requested */
2661  /* tolerance cannot be achieved, and that the */
2662  /* returned result is the best which can be */
2663  /* obtained. */
2664  /* = 5 the integral is probably divergent, or */
2665  /* slowly convergent. it must be noted that */
2666  /* divergence can occur with any other value */
2667  /* of ier. */
2668  /* = 6 the input is invalid, because */
2669  /* epsabs.le.0 and */
2670  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28). */
2671  /* result, abserr, neval, last, rlist(1), */
2672  /* iord(1) and elist(1) are set to zero. */
2673  /* alist(1) and blist(1) are set to a and b */
2674  /* respectively. */
2675 
2676  /* alist - double precision */
2677  /* vector of dimension at least limit, the first */
2678  /* last elements of which are the left end points */
2679  /* of the subintervals in the partition of the */
2680  /* given integration range (a,b) */
2681 
2682  /* blist - double precision */
2683  /* vector of dimension at least limit, the first */
2684  /* last elements of which are the right end points */
2685  /* of the subintervals in the partition of the given */
2686  /* integration range (a,b) */
2687 
2688  /* rlist - double precision */
2689  /* vector of dimension at least limit, the first */
2690  /* last elements of which are the integral */
2691  /* approximations on the subintervals */
2692 
2693  /* elist - double precision */
2694  /* vector of dimension at least limit, the first */
2695  /* last elements of which are the moduli of the */
2696  /* absolute error estimates on the subintervals */
2697 
2698  /* iord - long */
2699  /* vector of dimension at least limit, the first k */
2700  /* elements of which are pointers to the */
2701  /* error estimates over the subintervals, */
2702  /* such that elist(iord(1)), ..., elist(iord(k)) */
2703  /* form a decreasing sequence, with k = last */
2704  /* if last.le.(limit/2+2), and k = limit+1-last */
2705  /* otherwise */
2706 
2707  /* last - long */
2708  /* number of subintervals actually produced in the */
2709  /* subdivision process */
2710 
2711  /* ***references (none) */
2712  /* ***routines called d1mach,dqelg,dqk21,dqpsrt */
2713  /* ***end prologue dqagse */
2714 
2715 
2716 
2717 
2718  /* the dimension of rlist2 is determined by the value of */
2719  /* limexp in subroutine dqelg (rlist2 should be of dimension */
2720  /* (limexp+2) at least). */
2721 
2722  /* list of major variables */
2723  /* ----------------------- */
2724 
2725  /* alist - list of left end points of all subintervals */
2726  /* considered up to now */
2727  /* blist - list of right end points of all subintervals */
2728  /* considered up to now */
2729  /* rlist(i) - approximation to the integral over */
2730  /* (alist(i),blist(i)) */
2731  /* rlist2 - array of dimension at least limexp+2 containing */
2732  /* the part of the epsilon table which is still */
2733  /* needed for further computations */
2734  /* elist(i) - error estimate applying to rlist(i) */
2735  /* maxerr - pointer to the interval with largest error */
2736  /* estimate */
2737  /* errmax - elist(maxerr) */
2738  /* erlast - error on the interval currently subdivided */
2739  /* (before that subdivision has taken place) */
2740  /* area - sum of the integrals over the subintervals */
2741  /* errsum - sum of the errors over the subintervals */
2742  /* errbnd - requested accuracy max(epsabs,epsrel* */
2743  /* fabs(result)) */
2744  /* *****1 - variable for the left interval */
2745  /* *****2 - variable for the right interval */
2746  /* last - index for subdivision */
2747  /* nres - number of calls to the extrapolation routine */
2748  /* numrl2 - number of elements currently in rlist2. if an */
2749  /* appropriate approximation to the compounded */
2750  /* integral has been obtained it is put in */
2751  /* rlist2(numrl2) after numrl2 has been increased */
2752  /* by one. */
2753  /* small - length of the smallest interval considered up */
2754  /* to now, multiplied by 1.5 */
2755  /* erlarg - sum of the errors over the intervals larger */
2756  /* than the smallest interval considered up to now */
2757  /* extrap - bool variable denoting that the routine is */
2758  /* attempting to perform extrapolation i.e. before */
2759  /* subdividing the smallest interval we try to */
2760  /* decrease the value of erlarg. */
2761  /* noext - bool variable denoting that extrapolation */
2762  /* is no longer allowed (true value) */
2763 
2764  /* machine dependent constants */
2765  /* --------------------------- */
2766 
2767  /* epmach is the largest relative spacing. */
2768  /* uflow is the smallest positive magnitude. */
2769  /* oflow is the largest positive magnitude. */
2770 
2771  /* ***first executable statement dqagse */
2772  /* Parameter adjustments */
2773  --iord;
2774  --elist;
2775  --rlist;
2776  --blist;
2777  --alist__;
2778 
2779  /* Function Body */
2780  epmach = d1mach(c__4);
2781 
2782  /* test on validity of parameters */
2783  /* ------------------------------ */
2784  *ier = 0;
2785  *neval = 0;
2786  *last = 0;
2787  *result = 0.;
2788  *abserr = 0.;
2789  alist__[1] = *a;
2790  blist[1] = *b;
2791  rlist[1] = 0.;
2792  elist[1] = 0.;
2793  /* Computing MAX */
2794  d__1 = epmach * 50.;
2795  if (*epsabs <= 0. && *epsrel < max(d__1,5e-29)) {
2796  *ier = 6;
2797  }
2798  if (*ier == 6) {
2799  goto L999;
2800  }
2801 
2802  /* first approximation to the integral */
2803  /* ----------------------------------- */
2804 
2805  uflow = d1mach(c__1);
2806  oflow = d1mach(c__2);
2807  ierro = 0;
2808  dqk21_(f, a, b, result, abserr, &defabs, &resabs);
2809 
2810  /* test on accuracy. */
2811 
2812  dres = fabs(*result);
2813  /* Computing MAX */
2814  d__1 = *epsabs, d__2 = *epsrel * dres;
2815  errbnd = max(d__1,d__2);
2816  *last = 1;
2817  rlist[1] = *result;
2818  elist[1] = *abserr;
2819  iord[1] = 1;
2820  if (*abserr <= epmach * 100. * defabs && *abserr > errbnd) {
2821  *ier = 2;
2822  }
2823  if (*limit == 1) {
2824  *ier = 1;
2825  }
2826  if (*ier != 0 || ( *abserr <= errbnd && *abserr != resabs ) || *abserr == 0.)
2827  {
2828  goto L140;
2829  }
2830 
2831  /* initialization */
2832  /* -------------- */
2833 
2834  rlist2[0] = *result;
2835  errmax = *abserr;
2836  maxerr = 1;
2837  area = *result;
2838  errsum = *abserr;
2839  *abserr = oflow;
2840  nrmax = 1;
2841  nres = 0;
2842  numrl2 = 2;
2843  ktmin = 0;
2844  extrap = false;
2845  noext = false;
2846  iroff1 = 0;
2847  iroff2 = 0;
2848  iroff3 = 0;
2849  ksgn = -1;
2850  if (dres >= (1. - epmach * 50.) * defabs) {
2851  ksgn = 1;
2852  }
2853 
2854  /* main do-loop */
2855  /* ------------ */
2856 
2857  i__1 = *limit;
2858  for (*last = 2; *last <= i__1; ++(*last)) {
2859 
2860  /* bisect the subinterval with the nrmax-th largest error */
2861  /* estimate. */
2862 
2863  a1 = alist__[maxerr];
2864  b1 = (alist__[maxerr] + blist[maxerr]) * .5;
2865  a2 = b1;
2866  b2 = blist[maxerr];
2867  erlast = errmax;
2868  dqk21_(f, &a1, &b1, &area1, &error1, &resabs, &defab1);
2869  dqk21_(f, &a2, &b2, &area2, &error2, &resabs, &defab2);
2870 
2871  /* improve previous approximations to integral */
2872  /* and error and test for accuracy. */
2873 
2874  area12 = area1 + area2;
2875  erro12 = error1 + error2;
2876  errsum = errsum + erro12 - errmax;
2877  area = area + area12 - rlist[maxerr];
2878  if (defab1 == error1 || defab2 == error2) {
2879  goto L15;
2880  }
2881  if ((d__1 = rlist[maxerr] - area12, fabs(d__1)) > fabs(area12) * 1e-5 ||
2882  erro12 < errmax * .99) {
2883  goto L10;
2884  }
2885  if (extrap) {
2886  ++iroff2;
2887  }
2888  if (! extrap) {
2889  ++iroff1;
2890  }
2891  L10:
2892  if (*last > 10 && erro12 > errmax) {
2893  ++iroff3;
2894  }
2895  L15:
2896  rlist[maxerr] = area1;
2897  rlist[*last] = area2;
2898  /* Computing MAX */
2899  d__1 = *epsabs, d__2 = *epsrel * fabs(area);
2900  errbnd = max(d__1,d__2);
2901 
2902  /* test for roundoff error and eventually set error flag. */
2903 
2904  if (iroff1 + iroff2 >= 10 || iroff3 >= 20) {
2905  *ier = 2;
2906  }
2907  if (iroff2 >= 5) {
2908  ierro = 3;
2909  }
2910 
2911  /* set error flag in the case that the number of subintervals */
2912  /* equals limit. */
2913 
2914  if (*last == *limit) {
2915  *ier = 1;
2916  }
2917 
2918  /* set error flag in the case of bad integrand behaviour */
2919  /* at a point of the integration range. */
2920 
2921  /* Computing MAX */
2922  d__1 = fabs(a1), d__2 = fabs(b2);
2923  if (max(d__1,d__2) <= (epmach * 100. + 1.) * (fabs(a2) + uflow * 1e3))
2924  {
2925  *ier = 4;
2926  }
2927 
2928  /* append the newly-created intervals to the list. */
2929 
2930  if (error2 > error1) {
2931  goto L20;
2932  }
2933  alist__[*last] = a2;
2934  blist[maxerr] = b1;
2935  blist[*last] = b2;
2936  elist[maxerr] = error1;
2937  elist[*last] = error2;
2938  goto L30;
2939  L20:
2940  alist__[maxerr] = a2;
2941  alist__[*last] = a1;
2942  blist[*last] = b1;
2943  rlist[maxerr] = area2;
2944  rlist[*last] = area1;
2945  elist[maxerr] = error2;
2946  elist[*last] = error1;
2947 
2948  /* call subroutine dqpsrt to maintain the descending ordering */
2949  /* in the list of error estimates and select the subinterval */
2950  /* with nrmax-th largest error estimate (to be bisected next). */
2951 
2952  L30:
2953  dqpsrt_(limit, last, &maxerr, &errmax, &elist[1], &iord[1], &nrmax);
2954  /* ***jump out of do-loop */
2955  if (errsum <= errbnd) {
2956  goto L115;
2957  }
2958  /* ***jump out of do-loop */
2959  if (*ier != 0) {
2960  goto L100;
2961  }
2962  if (*last == 2) {
2963  goto L80;
2964  }
2965  if (noext) {
2966  goto L90;
2967  }
2968  erlarg -= erlast;
2969  if ((d__1 = b1 - a1, fabs(d__1)) > small) {
2970  erlarg += erro12;
2971  }
2972  if (extrap) {
2973  goto L40;
2974  }
2975 
2976  /* test whether the interval to be bisected next is the */
2977  /* smallest interval. */
2978 
2979  if ((d__1 = blist[maxerr] - alist__[maxerr], fabs(d__1)) > small) {
2980  goto L90;
2981  }
2982  extrap = true;
2983  nrmax = 2;
2984  L40:
2985  if (ierro == 3 || erlarg <= ertest) {
2986  goto L60;
2987  }
2988 
2989  /* the smallest interval has the largest error. */
2990  /* before bisecting decrease the sum of the errors over the */
2991  /* larger intervals (erlarg) and perform extrapolation. */
2992 
2993  id = nrmax;
2994  jupbnd = *last;
2995  if (*last > *limit / 2 + 2) {
2996  jupbnd = *limit + 3 - *last;
2997  }
2998  i__2 = jupbnd;
2999  for (k = id; k <= i__2; ++k) {
3000  maxerr = iord[nrmax];
3001  errmax = elist[maxerr];
3002  /* ***jump out of do-loop */
3003  if ((d__1 = blist[maxerr] - alist__[maxerr], fabs(d__1)) > small) {
3004  goto L90;
3005  }
3006  ++nrmax;
3007  /* L50: */
3008  }
3009 
3010  /* perform extrapolation. */
3011 
3012  L60:
3013  ++numrl2;
3014  rlist2[numrl2 - 1] = area;
3015  dqelg_(&numrl2, rlist2, &reseps, &abseps, res3la, &nres);
3016  ++ktmin;
3017  if (ktmin > 5 && *abserr < errsum * .001) {
3018  *ier = 5;
3019  }
3020  if (abseps >= *abserr) {
3021  goto L70;
3022  }
3023  ktmin = 0;
3024  *abserr = abseps;
3025  *result = reseps;
3026  correc = erlarg;
3027  /* Computing MAX */
3028  d__1 = *epsabs, d__2 = *epsrel * fabs(reseps);
3029  ertest = max(d__1,d__2);
3030  /* ***jump out of do-loop */
3031  if (*abserr <= ertest) {
3032  goto L100;
3033  }
3034 
3035  /* prepare bisection of the smallest interval. */
3036 
3037  L70:
3038  if (numrl2 == 1) {
3039  noext = true;
3040  }
3041  if (*ier == 5) {
3042  goto L100;
3043  }
3044  maxerr = iord[1];
3045  errmax = elist[maxerr];
3046  nrmax = 1;
3047  extrap = false;
3048  small *= .5;
3049  erlarg = errsum;
3050  goto L90;
3051  L80:
3052  small = (d__1 = *b - *a, fabs(d__1)) * .375;
3053  erlarg = errsum;
3054  ertest = errbnd;
3055  rlist2[1] = area;
3056  L90:
3057  ;
3058  }
3059 
3060  /* set final result and error estimate. */
3061  /* ------------------------------------ */
3062 
3063 L100:
3064  if (*abserr == oflow) {
3065  goto L115;
3066  }
3067  if (*ier + ierro == 0) {
3068  goto L110;
3069  }
3070  if (ierro == 3) {
3071  *abserr += correc;
3072  }
3073  if (*ier == 0) {
3074  *ier = 3;
3075  }
3076  if (*result != 0. && area != 0.) {
3077  goto L105;
3078  }
3079  if (*abserr > errsum) {
3080  goto L115;
3081  }
3082  if (area == 0.) {
3083  goto L130;
3084  }
3085  goto L110;
3086 L105:
3087  if (*abserr / fabs(*result) > errsum / fabs(area)) {
3088  goto L115;
3089  }
3090 
3091  /* test on divergence. */
3092 
3093 L110:
3094  /* Computing MAX */
3095  d__1 = fabs(*result), d__2 = fabs(area);
3096  if (ksgn == -1 && max(d__1,d__2) <= defabs * .01) {
3097  goto L130;
3098  }
3099  if (.01 > *result / area || *result / area > 100. || errsum > fabs(area)) {
3100  *ier = 6;
3101  }
3102  goto L130;
3103 
3104  /* compute global integral sum. */
3105 
3106 L115:
3107  *result = 0.;
3108  i__1 = *last;
3109  for (k = 1; k <= i__1; ++k) {
3110  *result += rlist[k];
3111  /* L120: */
3112  }
3113  *abserr = errsum;
3114 L130:
3115  if (*ier > 2) {
3116  --(*ier);
3117  }
3118 L140:
3119  *neval = *last * 42 - 21;
3120 L999:
3121  return;
3122 } /* dqagse_ */
3123 
3124 void dqags_(const D_fp& f, const double *a, const double *b, const double *epsabs,
3125  const double *epsrel, double *result, double *abserr,
3126  long *neval, long *ier, const long *limit, const long *lenw, long *
3127  last, long *iwork, double *work)
3128 {
3129  long l1, l2, l3, lvl;
3130 
3131  /* ***begin prologue dqags */
3132  /* ***date written 800101 (yymmdd) */
3133  /* ***revision date 830518 (yymmdd) */
3134  /* ***category no. h2a1a1 */
3135  /* ***keywords automatic integrator, general-purpose, */
3136  /* (end-point) singularities, extrapolation, */
3137  /* globally adaptive */
3138  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
3139  /* de doncker,elise,appl. math. & prog. div. - k.u.leuven */
3140  /* ***purpose the routine calculates an approximation result to a given */
3141  /* definite integral i = integral of f over (a,b), */
3142  /* hopefully satisfying following claim for accuracy */
3143  /* fabs(i-result).le.max(epsabs,epsrel*fabs(i)). */
3144  /* ***description */
3145 
3146  /* computation of a definite integral */
3147  /* standard fortran subroutine */
3148  /* double precision version */
3149 
3150 
3151  /* parameters */
3152  /* on entry */
3153  /* f - double precision */
3154  /* function subprogram defining the integrand */
3155  /* function f(x). the actual name for f needs to be */
3156  /* declared e x t e r n a l in the driver program. */
3157 
3158  /* a - double precision */
3159  /* lower limit of integration */
3160 
3161  /* b - double precision */
3162  /* upper limit of integration */
3163 
3164  /* epsabs - double precision */
3165  /* absolute accuracy requested */
3166  /* epsrel - double precision */
3167  /* relative accuracy requested */
3168  /* if epsabs.le.0 */
3169  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
3170  /* the routine will end with ier = 6. */
3171 
3172  /* on return */
3173  /* result - double precision */
3174  /* approximation to the integral */
3175 
3176  /* abserr - double precision */
3177  /* estimate of the modulus of the absolute error, */
3178  /* which should equal or exceed fabs(i-result) */
3179 
3180  /* neval - long */
3181  /* number of integrand evaluations */
3182 
3183  /* ier - long */
3184  /* ier = 0 normal and reliable termination of the */
3185  /* routine. it is assumed that the requested */
3186  /* accuracy has been achieved. */
3187  /* ier.gt.0 abnormal termination of the routine */
3188  /* the estimates for integral and error are */
3189  /* less reliable. it is assumed that the */
3190  /* requested accuracy has not been achieved. */
3191  /* error messages */
3192  /* ier = 1 maximum number of subdivisions allowed */
3193  /* has been achieved. one can allow more sub- */
3194  /* divisions by increasing the value of limit */
3195  /* (and taking the according dimension */
3196  /* adjustments into account. however, if */
3197  /* this yields no improvement it is advised */
3198  /* to analyze the integrand in order to */
3199  /* determine the integration difficulties. if */
3200  /* the position of a local difficulty can be */
3201  /* determined (e.g. singularity, */
3202  /* discontinuity within the interval) one */
3203  /* will probably gain from splitting up the */
3204  /* interval at this point and calling the */
3205  /* integrator on the subranges. if possible, */
3206  /* an appropriate special-purpose integrator */
3207  /* should be used, which is designed for */
3208  /* handling the type of difficulty involved. */
3209  /* = 2 the occurrence of roundoff error is detec- */
3210  /* ted, which prevents the requested */
3211  /* tolerance from being achieved. */
3212  /* the error may be under-estimated. */
3213  /* = 3 extremely bad integrand behaviour */
3214  /* occurs at some points of the integration */
3215  /* interval. */
3216  /* = 4 the algorithm does not converge. */
3217  /* roundoff error is detected in the */
3218  /* extrapolation table. it is presumed that */
3219  /* the requested tolerance cannot be */
3220  /* achieved, and that the returned result is */
3221  /* the best which can be obtained. */
3222  /* = 5 the integral is probably divergent, or */
3223  /* slowly convergent. it must be noted that */
3224  /* divergence can occur with any other value */
3225  /* of ier. */
3226  /* = 6 the input is invalid, because */
3227  /* (epsabs.le.0 and */
3228  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28) */
3229  /* or limit.lt.1 or lenw.lt.limit*4. */
3230  /* result, abserr, neval, last are set to */
3231  /* zero.except when limit or lenw is invalid, */
3232  /* iwork(1), work(limit*2+1) and */
3233  /* work(limit*3+1) are set to zero, work(1) */
3234  /* is set to a and work(limit+1) to b. */
3235 
3236  /* dimensioning parameters */
3237  /* limit - long */
3238  /* dimensioning parameter for iwork */
3239  /* limit determines the maximum number of subintervals */
3240  /* in the partition of the given integration interval */
3241  /* (a,b), limit.ge.1. */
3242  /* if limit.lt.1, the routine will end with ier = 6. */
3243 
3244  /* lenw - long */
3245  /* dimensioning parameter for work */
3246  /* lenw must be at least limit*4. */
3247  /* if lenw.lt.limit*4, the routine will end */
3248  /* with ier = 6. */
3249 
3250  /* last - long */
3251  /* on return, last equals the number of subintervals */
3252  /* produced in the subdivision process, detemines the */
3253  /* number of significant elements actually in the work */
3254  /* arrays. */
3255 
3256  /* work arrays */
3257  /* iwork - long */
3258  /* vector of dimension at least limit, the first k */
3259  /* elements of which contain pointers */
3260  /* to the error estimates over the subintervals */
3261  /* such that work(limit*3+iwork(1)),... , */
3262  /* work(limit*3+iwork(k)) form a decreasing */
3263  /* sequence, with k = last if last.le.(limit/2+2), */
3264  /* and k = limit+1-last otherwise */
3265 
3266  /* work - double precision */
3267  /* vector of dimension at least lenw */
3268  /* on return */
3269  /* work(1), ..., work(last) contain the left */
3270  /* end-points of the subintervals in the */
3271  /* partition of (a,b), */
3272  /* work(limit+1), ..., work(limit+last) contain */
3273  /* the right end-points, */
3274  /* work(limit*2+1), ..., work(limit*2+last) contain */
3275  /* the integral approximations over the subintervals, */
3276  /* work(limit*3+1), ..., work(limit*3+last) */
3277  /* contain the error estimates. */
3278 
3279  /* ***references (none) */
3280  /* ***routines called dqagse,xerror */
3281  /* ***end prologue dqags */
3282 
3283 
3284 
3285 
3286 
3287  /* check validity of limit and lenw. */
3288 
3289  /* ***first executable statement dqags */
3290  /* Parameter adjustments */
3291  --iwork;
3292  --work;
3293 
3294  /* Function Body */
3295  *ier = 6;
3296  *neval = 0;
3297  *last = 0;
3298  *result = 0.;
3299  *abserr = 0.;
3300  if (*limit < 1 || *lenw < *limit << 2) {
3301  goto L10;
3302  }
3303 
3304  /* prepare call for dqagse. */
3305 
3306  l1 = *limit + 1;
3307  l2 = *limit + l1;
3308  l3 = *limit + l2;
3309 
3310  dqagse_(f, a, b, epsabs, epsrel, limit, result, abserr, neval, ier,
3311  &work[1], &work[l1], &work[l2], &work[l3], &iwork[1], last);
3312 
3313  /* call error handler if necessary. */
3314 
3315  lvl = 0;
3316 L10:
3317  if (*ier == 6) {
3318  lvl = 1;
3319  }
3320  if (*ier != 0) {
3321  xerror_("abnormal return from dqags", &c__26, ier, &lvl, 26);
3322  }
3323  return;
3324 } /* dqags_ */
3325 
3326 void dqawce_(const D_fp& f, const double *a, const double *b, const double *c__,
3327  const double *epsabs, const double *epsrel, const long *limit,
3328  double *result, double *abserr, long *neval, long *ier,
3329  double *alist__, double *blist, double *rlist, double
3330  *elist, long *iord, long *last)
3331 {
3332  /* System generated locals */
3333  int i__1;
3334  double d__1, d__2;
3335 
3336  /* Local variables */
3337  long k;
3338  double a1, a2, b1, b2, aa, bb;
3339  long nev;
3340  double area, area1, area2, area12;
3341  double erro12;
3342  long krule, nrmax;
3343  double uflow;
3344  long iroff1, iroff2;
3345  double error1, error2, epmach, errbnd, errmax;
3346  long maxerr;
3347  double errsum;
3348 
3349  /* ***begin prologue dqawce */
3350  /* ***date written 800101 (yymmdd) */
3351  /* ***revision date 830518 (yymmdd) */
3352  /* ***category no. h2a2a1,j4 */
3353  /* ***keywords automatic integrator, special-purpose, */
3354  /* cauchy principal value, clenshaw-curtis method */
3355  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
3356  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
3357  /* *** purpose the routine calculates an approximation result to a */
3358  /* cauchy principal value i = integral of f*w over (a,b) */
3359  /* (w(x) = 1/(x-c), (c.ne.a, c.ne.b), hopefully satisfying */
3360  /* following claim for accuracy */
3361  /* fabs(i-result).le.max(epsabs,epsrel*fabs(i)) */
3362  /* ***description */
3363 
3364  /* computation of a cauchy principal value */
3365  /* standard fortran subroutine */
3366  /* double precision version */
3367 
3368  /* parameters */
3369  /* on entry */
3370  /* f - double precision */
3371  /* function subprogram defining the integrand */
3372  /* function f(x). the actual name for f needs to be */
3373  /* declared e x t e r n a l in the driver program. */
3374 
3375  /* a - double precision */
3376  /* lower limit of integration */
3377 
3378  /* b - double precision */
3379  /* upper limit of integration */
3380 
3381  /* c - double precision */
3382  /* parameter in the weight function, c.ne.a, c.ne.b */
3383  /* if c = a or c = b, the routine will end with */
3384  /* ier = 6. */
3385 
3386  /* epsabs - double precision */
3387  /* absolute accuracy requested */
3388  /* epsrel - double precision */
3389  /* relative accuracy requested */
3390  /* if epsabs.le.0 */
3391  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
3392  /* the routine will end with ier = 6. */
3393 
3394  /* limit - long */
3395  /* gives an upper bound on the number of subintervals */
3396  /* in the partition of (a,b), limit.ge.1 */
3397 
3398  /* on return */
3399  /* result - double precision */
3400  /* approximation to the integral */
3401 
3402  /* abserr - double precision */
3403  /* estimate of the modulus of the absolute error, */
3404  /* which should equal or exceed fabs(i-result) */
3405 
3406  /* neval - long */
3407  /* number of integrand evaluations */
3408 
3409  /* ier - long */
3410  /* ier = 0 normal and reliable termination of the */
3411  /* routine. it is assumed that the requested */
3412  /* accuracy has been achieved. */
3413  /* ier.gt.0 abnormal termination of the routine */
3414  /* the estimates for integral and error are */
3415  /* less reliable. it is assumed that the */
3416  /* requested accuracy has not been achieved. */
3417  /* error messages */
3418  /* ier = 1 maximum number of subdivisions allowed */
3419  /* has been achieved. one can allow more sub- */
3420  /* divisions by increasing the value of */
3421  /* limit. however, if this yields no */
3422  /* improvement it is advised to analyze the */
3423  /* the integrand, in order to determine the */
3424  /* the integration difficulties. if the */
3425  /* position of a local difficulty can be */
3426  /* determined (e.g. singularity, */
3427  /* discontinuity within the interval) one */
3428  /* will probably gain from splitting up the */
3429  /* interval at this point and calling */
3430  /* appropriate integrators on the subranges. */
3431  /* = 2 the occurrence of roundoff error is detec- */
3432  /* ted, which prevents the requested */
3433  /* tolerance from being achieved. */
3434  /* = 3 extremely bad integrand behaviour */
3435  /* occurs at some interior points of */
3436  /* the integration interval. */
3437  /* = 6 the input is invalid, because */
3438  /* c = a or c = b or */
3439  /* (epsabs.le.0 and */
3440  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28)) */
3441  /* or limit.lt.1. */
3442  /* result, abserr, neval, rlist(1), elist(1), */
3443  /* iord(1) and last are set to zero. alist(1) */
3444  /* and blist(1) are set to a and b */
3445  /* respectively. */
3446 
3447  /* alist - double precision */
3448  /* vector of dimension at least limit, the first */
3449  /* last elements of which are the left */
3450  /* end points of the subintervals in the partition */
3451  /* of the given integration range (a,b) */
3452 
3453  /* blist - double precision */
3454  /* vector of dimension at least limit, the first */
3455  /* last elements of which are the right */
3456  /* end points of the subintervals in the partition */
3457  /* of the given integration range (a,b) */
3458 
3459  /* rlist - double precision */
3460  /* vector of dimension at least limit, the first */
3461  /* last elements of which are the integral */
3462  /* approximations on the subintervals */
3463 
3464  /* elist - double precision */
3465  /* vector of dimension limit, the first last */
3466  /* elements of which are the moduli of the absolute */
3467  /* error estimates on the subintervals */
3468 
3469  /* iord - long */
3470  /* vector of dimension at least limit, the first k */
3471  /* elements of which are pointers to the error */
3472  /* estimates over the subintervals, so that */
3473  /* elist(iord(1)), ..., elist(iord(k)) with k = last */
3474  /* if last.le.(limit/2+2), and k = limit+1-last */
3475  /* otherwise, form a decreasing sequence */
3476 
3477  /* last - long */
3478  /* number of subintervals actually produced in */
3479  /* the subdivision process */
3480 
3481  /* ***references (none) */
3482  /* ***routines called d1mach,dqc25c,dqpsrt */
3483  /* ***end prologue dqawce */
3484 
3485 
3486 
3487 
3488  /* list of major variables */
3489  /* ----------------------- */
3490 
3491  /* alist - list of left end points of all subintervals */
3492  /* considered up to now */
3493  /* blist - list of right end points of all subintervals */
3494  /* considered up to now */
3495  /* rlist(i) - approximation to the integral over */
3496  /* (alist(i),blist(i)) */
3497  /* elist(i) - error estimate applying to rlist(i) */
3498  /* maxerr - pointer to the interval with largest */
3499  /* error estimate */
3500  /* errmax - elist(maxerr) */
3501  /* area - sum of the integrals over the subintervals */
3502  /* errsum - sum of the errors over the subintervals */
3503  /* errbnd - requested accuracy max(epsabs,epsrel* */
3504  /* fabs(result)) */
3505  /* *****1 - variable for the left subinterval */
3506  /* *****2 - variable for the right subinterval */
3507  /* last - index for subdivision */
3508 
3509 
3510  /* machine dependent constants */
3511  /* --------------------------- */
3512 
3513  /* epmach is the largest relative spacing. */
3514  /* uflow is the smallest positive magnitude. */
3515 
3516  /* ***first executable statement dqawce */
3517  /* Parameter adjustments */
3518  --iord;
3519  --elist;
3520  --rlist;
3521  --blist;
3522  --alist__;
3523 
3524  /* Function Body */
3525  epmach = d1mach(c__4);
3526  uflow = d1mach(c__1);
3527 
3528 
3529  /* test on validity of parameters */
3530  /* ------------------------------ */
3531 
3532  *ier = 6;
3533  *neval = 0;
3534  *last = 0;
3535  alist__[1] = *a;
3536  blist[1] = *b;
3537  rlist[1] = 0.;
3538  elist[1] = 0.;
3539  iord[1] = 0;
3540  *result = 0.;
3541  *abserr = 0.;
3542  /* Computing MAX */
3543  d__1 = epmach * 50.;
3544  if (*c__ == *a || *c__ == *b || ( *epsabs <= 0. && *epsrel < max(d__1,5e-29) )
3545  ) {
3546  goto L999;
3547  }
3548 
3549  /* first approximation to the integral */
3550  /* ----------------------------------- */
3551 
3552  aa = *a;
3553  bb = *b;
3554  if (*a <= *b) {
3555  goto L10;
3556  }
3557  aa = *b;
3558  bb = *a;
3559 L10:
3560  *ier = 0;
3561  krule = 1;
3562  dqc25c_(f, &aa, &bb, c__, result, abserr, &krule, neval);
3563  *last = 1;
3564  rlist[1] = *result;
3565  elist[1] = *abserr;
3566  iord[1] = 1;
3567  alist__[1] = *a;
3568  blist[1] = *b;
3569 
3570  /* test on accuracy */
3571 
3572  /* Computing MAX */
3573  d__1 = *epsabs, d__2 = *epsrel * fabs(*result);
3574  errbnd = max(d__1,d__2);
3575  if (*limit == 1) {
3576  *ier = 1;
3577  }
3578  /* Computing MIN */
3579  d__1 = fabs(*result) * .01;
3580  if (*abserr < min(d__1,errbnd) || *ier == 1) {
3581  goto L70;
3582  }
3583 
3584  /* initialization */
3585  /* -------------- */
3586 
3587  alist__[1] = aa;
3588  blist[1] = bb;
3589  rlist[1] = *result;
3590  errmax = *abserr;
3591  maxerr = 1;
3592  area = *result;
3593  errsum = *abserr;
3594  nrmax = 1;
3595  iroff1 = 0;
3596  iroff2 = 0;
3597 
3598  /* main do-loop */
3599  /* ------------ */
3600 
3601  i__1 = *limit;
3602  for (*last = 2; *last <= i__1; ++(*last)) {
3603 
3604  /* bisect the subinterval with nrmax-th largest */
3605  /* error estimate. */
3606 
3607  a1 = alist__[maxerr];
3608  b1 = (alist__[maxerr] + blist[maxerr]) * .5;
3609  b2 = blist[maxerr];
3610  if (*c__ <= b1 && *c__ > a1) {
3611  b1 = (*c__ + b2) * .5;
3612  }
3613  if (*c__ > b1 && *c__ < b2) {
3614  b1 = (a1 + *c__) * .5;
3615  }
3616  a2 = b1;
3617  krule = 2;
3618  dqc25c_(f, &a1, &b1, c__, &area1, &error1, &krule, &nev);
3619  *neval += nev;
3620  dqc25c_(f, &a2, &b2, c__, &area2, &error2, &krule, &nev);
3621  *neval += nev;
3622 
3623  /* improve previous approximations to integral */
3624  /* and error and test for accuracy. */
3625 
3626  area12 = area1 + area2;
3627  erro12 = error1 + error2;
3628  errsum = errsum + erro12 - errmax;
3629  area = area + area12 - rlist[maxerr];
3630  if ((d__1 = rlist[maxerr] - area12, fabs(d__1)) < fabs(area12) * 1e-5 &&
3631  erro12 >= errmax * .99 && krule == 0) {
3632  ++iroff1;
3633  }
3634  if (*last > 10 && erro12 > errmax && krule == 0) {
3635  ++iroff2;
3636  }
3637  rlist[maxerr] = area1;
3638  rlist[*last] = area2;
3639  /* Computing MAX */
3640  d__1 = *epsabs, d__2 = *epsrel * fabs(area);
3641  errbnd = max(d__1,d__2);
3642  if (errsum <= errbnd) {
3643  goto L15;
3644  }
3645 
3646  /* test for roundoff error and eventually set error flag. */
3647 
3648  if (iroff1 >= 6 && iroff2 > 20) {
3649  *ier = 2;
3650  }
3651 
3652  /* set error flag in the case that number of interval */
3653  /* bisections exceeds limit. */
3654 
3655  if (*last == *limit) {
3656  *ier = 1;
3657  }
3658 
3659  /* set error flag in the case of bad integrand behaviour */
3660  /* at a point of the integration range. */
3661 
3662  /* Computing MAX */
3663  d__1 = fabs(a1), d__2 = fabs(b2);
3664  if (max(d__1,d__2) <= (epmach * 100. + 1.) * (fabs(a2) + uflow * 1e3))
3665  {
3666  *ier = 3;
3667  }
3668 
3669  /* append the newly-created intervals to the list. */
3670 
3671  L15:
3672  if (error2 > error1) {
3673  goto L20;
3674  }
3675  alist__[*last] = a2;
3676  blist[maxerr] = b1;
3677  blist[*last] = b2;
3678  elist[maxerr] = error1;
3679  elist[*last] = error2;
3680  goto L30;
3681  L20:
3682  alist__[maxerr] = a2;
3683  alist__[*last] = a1;
3684  blist[*last] = b1;
3685  rlist[maxerr] = area2;
3686  rlist[*last] = area1;
3687  elist[maxerr] = error2;
3688  elist[*last] = error1;
3689 
3690  /* call subroutine dqpsrt to maintain the descending ordering */
3691  /* in the list of error estimates and select the subinterval */
3692  /* with nrmax-th largest error estimate (to be bisected next). */
3693 
3694  L30:
3695  dqpsrt_(limit, last, &maxerr, &errmax, &elist[1], &iord[1], &nrmax);
3696  /* ***jump out of do-loop */
3697  if (*ier != 0 || errsum <= errbnd) {
3698  goto L50;
3699  }
3700  /* L40: */
3701  }
3702 
3703  /* compute final result. */
3704  /* --------------------- */
3705 
3706 L50:
3707  *result = 0.;
3708  i__1 = *last;
3709  for (k = 1; k <= i__1; ++k) {
3710  *result += rlist[k];
3711  /* L60: */
3712  }
3713  *abserr = errsum;
3714 L70:
3715  if (aa == *b) {
3716  *result = -(*result);
3717  }
3718 L999:
3719  return;
3720 } /* dqawce_ */
3721 
3722 void dqawc_(const D_fp& f, const double *a, const double *b, const double *c__,
3723  const double *epsabs, const double *epsrel, double *result,
3724  double *abserr, long *neval, long *ier, long *limit,
3725  const long *lenw, long *last, long *iwork, double *work)
3726 {
3727  long l1, l2, l3, lvl;
3728 
3729  /* ***begin prologue dqawc */
3730  /* ***date written 800101 (yymmdd) */
3731  /* ***revision date 830518 (yymmdd) */
3732  /* ***category no. h2a2a1,j4 */
3733  /* ***keywords automatic integrator, special-purpose, */
3734  /* cauchy principal value, */
3735  /* clenshaw-curtis, globally adaptive */
3736  /* ***author piessens,robert ,appl. math. & progr. div. - k.u.leuven */
3737  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
3738  /* ***purpose the routine calculates an approximation result to a */
3739  /* cauchy principal value i = integral of f*w over (a,b) */
3740  /* (w(x) = 1/((x-c), c.ne.a, c.ne.b), hopefully satisfying */
3741  /* following claim for accuracy */
3742  /* fabs(i-result).le.max(epsabe,epsrel*fabs(i)). */
3743  /* ***description */
3744 
3745  /* computation of a cauchy principal value */
3746  /* standard fortran subroutine */
3747  /* double precision version */
3748 
3749 
3750  /* parameters */
3751  /* on entry */
3752  /* f - double precision */
3753  /* function subprogram defining the integrand */
3754  /* function f(x). the actual name for f needs to be */
3755  /* declared e x t e r n a l in the driver program. */
3756 
3757  /* a - double precision */
3758  /* under limit of integration */
3759 
3760  /* b - double precision */
3761  /* upper limit of integration */
3762 
3763  /* c - parameter in the weight function, c.ne.a, c.ne.b. */
3764  /* if c = a or c = b, the routine will end with */
3765  /* ier = 6 . */
3766 
3767  /* epsabs - double precision */
3768  /* absolute accuracy requested */
3769  /* epsrel - double precision */
3770  /* relative accuracy requested */
3771  /* if epsabs.le.0 */
3772  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
3773  /* the routine will end with ier = 6. */
3774 
3775  /* on return */
3776  /* result - double precision */
3777  /* approximation to the integral */
3778 
3779  /* abserr - double precision */
3780  /* estimate or the modulus of the absolute error, */
3781  /* which should equal or exceed fabs(i-result) */
3782 
3783  /* neval - long */
3784  /* number of integrand evaluations */
3785 
3786  /* ier - long */
3787  /* ier = 0 normal and reliable termination of the */
3788  /* routine. it is assumed that the requested */
3789  /* accuracy has been achieved. */
3790  /* ier.gt.0 abnormal termination of the routine */
3791  /* the estimates for integral and error are */
3792  /* less reliable. it is assumed that the */
3793  /* requested accuracy has not been achieved. */
3794  /* error messages */
3795  /* ier = 1 maximum number of subdivisions allowed */
3796  /* has been achieved. one can allow more sub- */
3797  /* divisions by increasing the value of limit */
3798  /* (and taking the according dimension */
3799  /* adjustments into account). however, if */
3800  /* this yields no improvement it is advised */
3801  /* to analyze the integrand in order to */
3802  /* determine the integration difficulties. */
3803  /* if the position of a local difficulty */
3804  /* can be determined (e.g. singularity, */
3805  /* discontinuity within the interval) one */
3806  /* will probably gain from splitting up the */
3807  /* interval at this point and calling */
3808  /* appropriate integrators on the subranges. */
3809  /* = 2 the occurrence of roundoff error is detec- */
3810  /* ted, which prevents the requested */
3811  /* tolerance from being achieved. */
3812  /* = 3 extremely bad integrand behaviour occurs */
3813  /* at some points of the integration */
3814  /* interval. */
3815  /* = 6 the input is invalid, because */
3816  /* c = a or c = b or */
3817  /* (epsabs.le.0 and */
3818  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28)) */
3819  /* or limit.lt.1 or lenw.lt.limit*4. */
3820  /* result, abserr, neval, last are set to */
3821  /* zero. exept when lenw or limit is invalid, */
3822  /* iwork(1), work(limit*2+1) and */
3823  /* work(limit*3+1) are set to zero, work(1) */
3824  /* is set to a and work(limit+1) to b. */
3825 
3826  /* dimensioning parameters */
3827  /* limit - long */
3828  /* dimensioning parameter for iwork */
3829  /* limit determines the maximum number of subintervals */
3830  /* in the partition of the given integration interval */
3831  /* (a,b), limit.ge.1. */
3832  /* if limit.lt.1, the routine will end with ier = 6. */
3833 
3834  /* lenw - long */
3835  /* dimensioning parameter for work */
3836  /* lenw must be at least limit*4. */
3837  /* if lenw.lt.limit*4, the routine will end with */
3838  /* ier = 6. */
3839 
3840  /* last - long */
3841  /* on return, last equals the number of subintervals */
3842  /* produced in the subdivision process, which */
3843  /* determines the number of significant elements */
3844  /* actually in the work arrays. */
3845 
3846  /* work arrays */
3847  /* iwork - long */
3848  /* vector of dimension at least limit, the first k */
3849  /* elements of which contain pointers */
3850  /* to the error estimates over the subintervals, */
3851  /* such that work(limit*3+iwork(1)), ... , */
3852  /* work(limit*3+iwork(k)) form a decreasing */
3853  /* sequence, with k = last if last.le.(limit/2+2), */
3854  /* and k = limit+1-last otherwise */
3855 
3856  /* work - double precision */
3857  /* vector of dimension at least lenw */
3858  /* on return */
3859  /* work(1), ..., work(last) contain the left */
3860  /* end points of the subintervals in the */
3861  /* partition of (a,b), */
3862  /* work(limit+1), ..., work(limit+last) contain */
3863  /* the right end points, */
3864  /* work(limit*2+1), ..., work(limit*2+last) contain */
3865  /* the integral approximations over the subintervals, */
3866  /* work(limit*3+1), ..., work(limit*3+last) */
3867  /* contain the error estimates. */
3868 
3869  /* ***references (none) */
3870  /* ***routines called dqawce,xerror */
3871  /* ***end prologue dqawc */
3872 
3873 
3874 
3875 
3876  /* check validity of limit and lenw. */
3877 
3878  /* ***first executable statement dqawc */
3879  /* Parameter adjustments */
3880  --iwork;
3881  --work;
3882 
3883  /* Function Body */
3884  *ier = 6;
3885  *neval = 0;
3886  *last = 0;
3887  *result = 0.;
3888  *abserr = 0.;
3889  if (*limit < 1 || *lenw < *limit << 2) {
3890  goto L10;
3891  }
3892 
3893  /* prepare call for dqawce. */
3894 
3895  l1 = *limit + 1;
3896  l2 = *limit + l1;
3897  l3 = *limit + l2;
3898  dqawce_(f, a, b, c__, epsabs, epsrel, limit, result, abserr, neval,
3899  ier, &work[1], &work[l1], &work[l2], &work[l3], &iwork[1], last);
3900 
3901  /* call error handler if necessary. */
3902 
3903  lvl = 0;
3904 L10:
3905  if (*ier == 6) {
3906  lvl = 1;
3907  }
3908  if (*ier != 0) {
3909  xerror_("abnormal return from dqawc", &c__26, ier, &lvl, 26);
3910  }
3911  return;
3912 } /* dqawc_ */
3913 
3914 void dqawfe_(const D_fp& f, const double *a, const double *omega,
3915  const long *integr, const double *epsabs, const long *limlst,
3916  const long *limit, const long *maxp1,
3917  double *result, double *abserr, long *neval,
3918  long *ier, double *rslst, double *erlst, long *ierlst,
3919  long *lst, double *alist__, double *blist,
3920  double *rlist, double *elist, long *iord, long *nnlog,
3921  double *chebmo)
3922 {
3923  /* Initialized data */
3924 
3925  double p = .9;
3926  double pi = 3.1415926535897932384626433832795;
3927 
3928  /* System generated locals */
3929  int chebmo_dim1, chebmo_offset, i__1;
3930  double d__1, d__2;
3931 
3932  /* Local variables */
3933  long l;
3934  double c1, c2, p1, dl, ep;
3935  long ll=0;
3936  double drl=0., eps;
3937  long nev;
3938  double fact, epsa;
3939  long last, nres;
3940  double psum[52];
3941  double cycle;
3942  long ktmin;
3943  double uflow;
3944  double res3la[3];
3945  long numrl2;
3946  double abseps, correc;
3947  long momcom;
3948  double reseps, errsum;
3949 
3950  /* ***begin prologue dqawfe */
3951  /* ***date written 800101 (yymmdd) */
3952  /* ***revision date 830518 (yymmdd) */
3953  /* ***category no. h2a3a1 */
3954  /* ***keywords automatic integrator, special-purpose, */
3955  /* fourier integrals, */
3956  /* integration between zeros with dqawoe, */
3957  /* convergence acceleration with dqelg */
3958  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
3959  /* dedoncker,elise,appl. math. & progr. div. - k.u.leuven */
3960  /* ***purpose the routine calculates an approximation result to a */
3961  /* given fourier integal */
3962  /* i = integral of f(x)*w(x) over (a,infinity) */
3963  /* where w(x)=cos(omega*x) or w(x)=sin(omega*x), */
3964  /* hopefully satisfying following claim for accuracy */
3965  /* fabs(i-result).le.epsabs. */
3966  /* ***description */
3967 
3968  /* computation of fourier integrals */
3969  /* standard fortran subroutine */
3970  /* double precision version */
3971 
3972  /* parameters */
3973  /* on entry */
3974  /* f - double precision */
3975  /* function subprogram defining the integrand */
3976  /* function f(x). the actual name for f needs to */
3977  /* be declared e x t e r n a l in the driver program. */
3978 
3979  /* a - double precision */
3980  /* lower limit of integration */
3981 
3982  /* omega - double precision */
3983  /* parameter in the weight function */
3984 
3985  /* integr - long */
3986  /* indicates which weight function is used */
3987  /* integr = 1 w(x) = cos(omega*x) */
3988  /* integr = 2 w(x) = sin(omega*x) */
3989  /* if integr.ne.1.and.integr.ne.2, the routine will */
3990  /* end with ier = 6. */
3991 
3992  /* epsabs - double precision */
3993  /* absolute accuracy requested, epsabs.gt.0 */
3994  /* if epsabs.le.0, the routine will end with ier = 6. */
3995 
3996  /* limlst - long */
3997  /* limlst gives an upper bound on the number of */
3998  /* cycles, limlst.ge.1. */
3999  /* if limlst.lt.3, the routine will end with ier = 6. */
4000 
4001  /* limit - long */
4002  /* gives an upper bound on the number of subintervals */
4003  /* allowed in the partition of each cycle, limit.ge.1 */
4004  /* each cycle, limit.ge.1. */
4005 
4006  /* maxp1 - long */
4007  /* gives an upper bound on the number of */
4008  /* chebyshev moments which can be stored, i.e. */
4009  /* for the intervals of lengths fabs(b-a)*2**(-l), */
4010  /* l=0,1, ..., maxp1-2, maxp1.ge.1 */
4011 
4012  /* on return */
4013  /* result - double precision */
4014  /* approximation to the integral x */
4015 
4016  /* abserr - double precision */
4017  /* estimate of the modulus of the absolute error, */
4018  /* which should equal or exceed fabs(i-result) */
4019 
4020  /* neval - long */
4021  /* number of integrand evaluations */
4022 
4023  /* ier - ier = 0 normal and reliable termination of */
4024  /* the routine. it is assumed that the */
4025  /* requested accuracy has been achieved. */
4026  /* ier.gt.0 abnormal termination of the routine. the */
4027  /* estimates for integral and error are less */
4028  /* reliable. it is assumed that the requested */
4029  /* accuracy has not been achieved. */
4030  /* error messages */
4031  /* if omega.ne.0 */
4032  /* ier = 1 maximum number of cycles allowed */
4033  /* has been achieved., i.e. of subintervals */
4034  /* (a+(k-1)c,a+kc) where */
4035  /* c = (2*int(fabs(omega))+1)*pi/fabs(omega), */
4036  /* for k = 1, 2, ..., lst. */
4037  /* one can allow more cycles by increasing */
4038  /* the value of limlst (and taking the */
4039  /* according dimension adjustments into */
4040  /* account). */
4041  /* examine the array iwork which contains */
4042  /* the error flags on the cycles, in order to */
4043  /* look for eventual local integration */
4044  /* difficulties. if the position of a local */
4045  /* difficulty can be determined (e.g. */
4046  /* singularity, discontinuity within the */
4047  /* interval) one will probably gain from */
4048  /* splitting up the interval at this polong */
4049  /* and calling appropriate integrators on */
4050  /* the subranges. */
4051  /* = 4 the extrapolation table constructed for */
4052  /* convergence acceleration of the series */
4053  /* formed by the integral contributions over */
4054  /* the cycles, does not converge to within */
4055  /* the requested accuracy. as in the case of */
4056  /* ier = 1, it is advised to examine the */
4057  /* array iwork which contains the error */
4058  /* flags on the cycles. */
4059  /* = 6 the input is invalid because */
4060  /* (integr.ne.1 and integr.ne.2) or */
4061  /* epsabs.le.0 or limlst.lt.3. */
4062  /* result, abserr, neval, lst are set */
4063  /* to zero. */
4064  /* = 7 bad integrand behaviour occurs within one */
4065  /* or more of the cycles. location and type */
4066  /* of the difficulty involved can be */
4067  /* determined from the vector ierlst. here */
4068  /* lst is the number of cycles actually */
4069  /* needed (see below). */
4070  /* ierlst(k) = 1 the maximum number of */
4071  /* subdivisions (= limit) has */
4072  /* been achieved on the k th */
4073  /* cycle. */
4074  /* = 2 occurrence of roundoff error */
4075  /* is detected and prevents the */
4076  /* tolerance imposed on the */
4077  /* k th cycle, from being */
4078  /* achieved. */
4079  /* = 3 extremely bad integrand */
4080  /* behaviour occurs at some */
4081  /* points of the k th cycle. */
4082  /* = 4 the integration procedure */
4083  /* over the k th cycle does */
4084  /* not converge (to within the */
4085  /* required accuracy) due to */
4086  /* roundoff in the */
4087  /* extrapolation procedure */
4088  /* invoked on this cycle. it */
4089  /* is assumed that the result */
4090  /* on this interval is the */
4091  /* best which can be obtained. */
4092  /* = 5 the integral over the k th */
4093  /* cycle is probably divergent */
4094  /* or slowly convergent. it */
4095  /* must be noted that */
4096  /* divergence can occur with */
4097  /* any other value of */
4098  /* ierlst(k). */
4099  /* if omega = 0 and integr = 1, */
4100  /* the integral is calculated by means of dqagie */
4101  /* and ier = ierlst(1) (with meaning as described */
4102  /* for ierlst(k), k = 1). */
4103 
4104  /* rslst - double precision */
4105  /* vector of dimension at least limlst */
4106  /* rslst(k) contains the integral contribution */
4107  /* over the interval (a+(k-1)c,a+kc) where */
4108  /* c = (2*int(fabs(omega))+1)*pi/fabs(omega), */
4109  /* k = 1, 2, ..., lst. */
4110  /* note that, if omega = 0, rslst(1) contains */
4111  /* the value of the integral over (a,infinity). */
4112 
4113  /* erlst - double precision */
4114  /* vector of dimension at least limlst */
4115  /* erlst(k) contains the error estimate corresponding */
4116  /* with rslst(k). */
4117 
4118  /* ierlst - long */
4119  /* vector of dimension at least limlst */
4120  /* ierlst(k) contains the error flag corresponding */
4121  /* with rslst(k). for the meaning of the local error */
4122  /* flags see description of output parameter ier. */
4123 
4124  /* lst - long */
4125  /* number of subintervals needed for the integration */
4126  /* if omega = 0 then lst is set to 1. */
4127 
4128  /* alist, blist, rlist, elist - double precision */
4129  /* vector of dimension at least limit, */
4130 
4131  /* iord, nnlog - long */
4132  /* vector of dimension at least limit, providing */
4133  /* space for the quantities needed in the subdivision */
4134  /* process of each cycle */
4135 
4136  /* chebmo - double precision */
4137  /* array of dimension at least (maxp1,25), providing */
4138  /* space for the chebyshev moments needed within the */
4139  /* cycles */
4140 
4141  /* ***references (none) */
4142  /* ***routines called d1mach,dqagie,dqawoe,dqelg */
4143  /* ***end prologue dqawfe */
4144 
4145 
4146 
4147 
4148 
4149  /* the dimension of psum is determined by the value of */
4150  /* limexp in subroutine dqelg (psum must be of dimension */
4151  /* (limexp+2) at least). */
4152 
4153  /* list of major variables */
4154  /* ----------------------- */
4155 
4156  /* c1, c2 - end points of subinterval (of length cycle) */
4157  /* cycle - (2*int(fabs(omega))+1)*pi/fabs(omega) */
4158  /* psum - vector of dimension at least (limexp+2) */
4159  /* (see routine dqelg) */
4160  /* psum contains the part of the epsilon table */
4161  /* which is still needed for further computations. */
4162  /* each element of psum is a partial sum of the */
4163  /* series which should sum to the value of the */
4164  /* integral. */
4165  /* errsum - sum of error estimates over the subintervals, */
4166  /* calculated cumulatively */
4167  /* epsa - absolute tolerance requested over current */
4168  /* subinterval */
4169  /* chebmo - array containing the modified chebyshev */
4170  /* moments (see also routine dqc25f) */
4171 
4172  /* Parameter adjustments */
4173  --ierlst;
4174  --erlst;
4175  --rslst;
4176  --nnlog;
4177  --iord;
4178  --elist;
4179  --rlist;
4180  --blist;
4181  --alist__;
4182  chebmo_dim1 = *maxp1;
4183  chebmo_offset = 1 + chebmo_dim1;
4184  chebmo -= chebmo_offset;
4185 
4186  /* Function Body */
4187 
4188  /* test on validity of parameters */
4189  /* ------------------------------ */
4190 
4191  /* ***first executable statement dqawfe */
4192  *result = 0.;
4193  *abserr = 0.;
4194  *neval = 0;
4195  *lst = 0;
4196  *ier = 0;
4197  if ( (*integr != 1 && *integr != 2 ) || *epsabs <= 0. || *limlst < 3) {
4198  *ier = 6;
4199  }
4200  if (*ier == 6) {
4201  goto L999;
4202  }
4203  if (*omega != 0.) {
4204  goto L10;
4205  }
4206 
4207  /* integration by dqagie if omega is zero */
4208  /* -------------------------------------- */
4209 
4210  if (*integr == 1) {
4211  dqagie_(f, &c_b20, &c__1, epsabs, &c_b20, limit, result, abserr,
4212  neval, ier, &alist__[1], &blist[1], &rlist[1], &elist[1], &
4213  iord[1], &last);
4214  }
4215  rslst[1] = *result;
4216  erlst[1] = *abserr;
4217  ierlst[1] = *ier;
4218  *lst = 1;
4219  goto L999;
4220 
4221  /* initializations */
4222  /* --------------- */
4223 
4224 L10:
4225  l = (int) fabs(*omega);
4226  dl = (double) ((l << 1) + 1);
4227  cycle = dl * pi / fabs(*omega);
4228  *ier = 0;
4229  ktmin = 0;
4230  *neval = 0;
4231  numrl2 = 0;
4232  nres = 0;
4233  c1 = *a;
4234  c2 = cycle + *a;
4235  p1 = 1. - p;
4236  uflow = d1mach(c__1);
4237  eps = *epsabs;
4238  if (*epsabs > uflow / p1) {
4239  eps = *epsabs * p1;
4240  }
4241  ep = eps;
4242  fact = 1.;
4243  correc = 0.;
4244  *abserr = 0.;
4245  errsum = 0.;
4246 
4247  /* main do-loop */
4248  /* ------------ */
4249 
4250  i__1 = *limlst;
4251  for (*lst = 1; *lst <= i__1; ++(*lst)) {
4252 
4253  /* integrate over current subinterval. */
4254 
4255  epsa = eps * fact;
4256  dqawoe_(f, &c1, &c2, omega, integr, &epsa, &c_b20, limit, lst,
4257  maxp1, &rslst[*lst], &erlst[*lst], &nev, &ierlst[*lst], &last,
4258  &alist__[1], &blist[1], &rlist[1], &elist[1], &iord[1], &
4259  nnlog[1], &momcom, &chebmo[chebmo_offset]);
4260  *neval += nev;
4261  fact *= p;
4262  errsum += erlst[*lst];
4263  drl = (d__1 = rslst[*lst], fabs(d__1)) * 50.;
4264 
4265  /* test on accuracy with partial sum */
4266 
4267  if (errsum + drl <= *epsabs && *lst >= 6) {
4268  goto L80;
4269  }
4270  /* Computing MAX */
4271  d__1 = correc, d__2 = erlst[*lst];
4272  correc = max(d__1,d__2);
4273  if (ierlst[*lst] != 0) {
4274  /* Computing MAX */
4275  d__1 = ep, d__2 = correc * p1;
4276  eps = max(d__1,d__2);
4277  }
4278  if (ierlst[*lst] != 0) {
4279  *ier = 7;
4280  }
4281  if (*ier == 7 && errsum + drl <= correc * 10. && *lst > 5) {
4282  goto L80;
4283  }
4284  ++numrl2;
4285  if (*lst > 1) {
4286  goto L20;
4287  }
4288  psum[0] = rslst[1];
4289  goto L40;
4290  L20:
4291  psum[numrl2 - 1] = psum[ll - 1] + rslst[*lst];
4292  if (*lst == 2) {
4293  goto L40;
4294  }
4295 
4296  /* test on maximum number of subintervals */
4297 
4298  if (*lst == *limlst) {
4299  *ier = 1;
4300  }
4301 
4302  /* perform new extrapolation */
4303 
4304  dqelg_(&numrl2, psum, &reseps, &abseps, res3la, &nres);
4305 
4306  /* test whether extrapolated result is influenced by roundoff */
4307 
4308  ++ktmin;
4309  if (ktmin >= 15 && *abserr <= (errsum + drl) * .001) {
4310  *ier = 4;
4311  }
4312  if (abseps > *abserr && *lst != 3) {
4313  goto L30;
4314  }
4315  *abserr = abseps;
4316  *result = reseps;
4317  ktmin = 0;
4318 
4319  /* if ier is not 0, check whether direct result (partial sum) */
4320  /* or extrapolated result yields the best integral */
4321  /* approximation */
4322 
4323  if (*abserr + correc * 10. <= *epsabs ||
4324  ( *abserr <= *epsabs && correc * 10. >= *epsabs ) ) {
4325  goto L60;
4326  }
4327  L30:
4328  if (*ier != 0 && *ier != 7) {
4329  goto L60;
4330  }
4331  L40:
4332  ll = numrl2;
4333  c1 = c2;
4334  c2 += cycle;
4335  /* L50: */
4336  }
4337 
4338  /* set final result and error estimate */
4339  /* ----------------------------------- */
4340 
4341 L60:
4342  *abserr += correc * 10.;
4343  if (*ier == 0) {
4344  goto L999;
4345  }
4346  if (*result != 0. && psum[numrl2 - 1] != 0.) {
4347  goto L70;
4348  }
4349  if (*abserr > errsum) {
4350  goto L80;
4351  }
4352  if (psum[numrl2 - 1] == 0.) {
4353  goto L999;
4354  }
4355 L70:
4356  if (*abserr / fabs(*result) > (errsum + drl) / (d__1 = psum[numrl2 - 1],
4357  fabs(d__1))) {
4358  goto L80;
4359  }
4360  if (*ier >= 1 && *ier != 7) {
4361  *abserr += drl;
4362  }
4363  goto L999;
4364 L80:
4365  *result = psum[numrl2 - 1];
4366  *abserr = errsum + drl;
4367 L999:
4368  return;
4369 } /* dqawfe_ */
4370 
4371 void dqawf_(const D_fp& f, const double *a, const double *omega, const long *integr,
4372  const double *epsabs, double *result, double *abserr,
4373  long *neval, long *ier, long *limlst, long *lst, const long *
4374  leniw, const long *maxp1, const long *lenw, long *iwork, double *
4375  work)
4376 {
4377  long l1, l2, l3, l4, l5, l6, ll2, lvl, limit;
4378 
4379  /* ***begin prologue dqawf */
4380  /* ***date written 800101 (yymmdd) */
4381  /* ***revision date 830518 (yymmdd) */
4382  /* ***category no. h2a3a1 */
4383  /* ***keywords automatic integrator, special-purpose,fourier */
4384  /* integral, integration between zeros with dqawoe, */
4385  /* convergence acceleration with dqelg */
4386  /* ***author piessens,robert ,appl. math. & progr. div. - k.u.leuven */
4387  /* de doncker,elise,appl. math & progr. div. - k.u.leuven */
4388  /* ***purpose the routine calculates an approximation result to a given */
4389  /* fourier integral i=integral of f(x)*w(x) over (a,infinity) */
4390  /* where w(x) = cos(omega*x) or w(x) = sin(omega*x). */
4391  /* hopefully satisfying following claim for accuracy */
4392  /* fabs(i-result).le.epsabs. */
4393  /* ***description */
4394 
4395  /* computation of fourier integrals */
4396  /* standard fortran subroutine */
4397  /* double precision version */
4398 
4399 
4400  /* parameters */
4401  /* on entry */
4402  /* f - double precision */
4403  /* function subprogram defining the integrand */
4404  /* function f(x). the actual name for f needs to be */
4405  /* declared e x t e r n a l in the driver program. */
4406 
4407  /* a - double precision */
4408  /* lower limit of integration */
4409 
4410  /* omega - double precision */
4411  /* parameter in the integrand weight function */
4412 
4413  /* integr - long */
4414  /* indicates which of the weight functions is used */
4415  /* integr = 1 w(x) = cos(omega*x) */
4416  /* integr = 2 w(x) = sin(omega*x) */
4417  /* if integr.ne.1.and.integr.ne.2, the routine */
4418  /* will end with ier = 6. */
4419 
4420  /* epsabs - double precision */
4421  /* absolute accuracy requested, epsabs.gt.0. */
4422  /* if epsabs.le.0, the routine will end with ier = 6. */
4423 
4424  /* on return */
4425  /* result - double precision */
4426  /* approximation to the integral */
4427 
4428  /* abserr - double precision */
4429  /* estimate of the modulus of the absolute error, */
4430  /* which should equal or exceed fabs(i-result) */
4431 
4432  /* neval - long */
4433  /* number of integrand evaluations */
4434 
4435  /* ier - long */
4436  /* ier = 0 normal and reliable termination of the */
4437  /* routine. it is assumed that the requested */
4438  /* accuracy has been achieved. */
4439  /* ier.gt.0 abnormal termination of the routine. */
4440  /* the estimates for integral and error are */
4441  /* less reliable. it is assumed that the */
4442  /* requested accuracy has not been achieved. */
4443  /* error messages */
4444  /* if omega.ne.0 */
4445  /* ier = 1 maximum number of cycles allowed */
4446  /* has been achieved, i.e. of subintervals */
4447  /* (a+(k-1)c,a+kc) where */
4448  /* c = (2*int(fabs(omega))+1)*pi/fabs(omega), */
4449  /* for k = 1, 2, ..., lst. */
4450  /* one can allow more cycles by increasing */
4451  /* the value of limlst (and taking the */
4452  /* according dimension adjustments into */
4453  /* account). examine the array iwork which */
4454  /* contains the error flags on the cycles, in */
4455  /* order to look for eventual local */
4456  /* integration difficulties. */
4457  /* if the position of a local difficulty */
4458  /* can be determined (e.g. singularity, */
4459  /* discontinuity within the interval) one */
4460  /* will probably gain from splitting up the */
4461  /* interval at this point and calling */
4462  /* appropriate integrators on the subranges. */
4463  /* = 4 the extrapolation table constructed for */
4464  /* convergence accelaration of the series */
4465  /* formed by the integral contributions over */
4466  /* the cycles, does not converge to within */
4467  /* the requested accuracy. */
4468  /* as in the case of ier = 1, it is advised */
4469  /* to examine the array iwork which contains */
4470  /* the error flags on the cycles. */
4471  /* = 6 the input is invalid because */
4472  /* (integr.ne.1 and integr.ne.2) or */
4473  /* epsabs.le.0 or limlst.lt.1 or */
4474  /* leniw.lt.(limlst+2) or maxp1.lt.1 or */
4475  /* lenw.lt.(leniw*2+maxp1*25). */
4476  /* result, abserr, neval, lst are set to */
4477  /* zero. */
4478  /* = 7 bad integrand behaviour occurs within */
4479  /* one or more of the cycles. location and */
4480  /* type of the difficulty involved can be */
4481  /* determined from the first lst elements of */
4482  /* vector iwork. here lst is the number of */
4483  /* cycles actually needed (see below). */
4484  /* iwork(k) = 1 the maximum number of */
4485  /* subdivisions (=(leniw-limlst) */
4486  /* /2) has been achieved on the */
4487  /* k th cycle. */
4488  /* = 2 occurrence of roundoff error */
4489  /* is detected and prevents the */
4490  /* tolerance imposed on the k th */
4491  /* cycle, from being achieved */
4492  /* on this cycle. */
4493  /* = 3 extremely bad integrand */
4494  /* behaviour occurs at some */
4495  /* points of the k th cycle. */
4496  /* = 4 the integration procedure */
4497  /* over the k th cycle does */
4498  /* not converge (to within the */
4499  /* required accuracy) due to */
4500  /* roundoff in the extrapolation */
4501  /* procedure invoked on this */
4502  /* cycle. it is assumed that the */
4503  /* result on this interval is */
4504  /* the best which can be */
4505  /* obtained. */
4506  /* = 5 the integral over the k th */
4507  /* cycle is probably divergent */
4508  /* or slowly convergent. it must */
4509  /* be noted that divergence can */
4510  /* occur with any other value of */
4511  /* iwork(k). */
4512  /* if omega = 0 and integr = 1, */
4513  /* the integral is calculated by means of dqagie, */
4514  /* and ier = iwork(1) (with meaning as described */
4515  /* for iwork(k),k = 1). */
4516 
4517  /* dimensioning parameters */
4518  /* limlst - long */
4519  /* limlst gives an upper bound on the number of */
4520  /* cycles, limlst.ge.3. */
4521  /* if limlst.lt.3, the routine will end with ier = 6. */
4522 
4523  /* lst - long */
4524  /* on return, lst indicates the number of cycles */
4525  /* actually needed for the integration. */
4526  /* if omega = 0, then lst is set to 1. */
4527 
4528  /* leniw - long */
4529  /* dimensioning parameter for iwork. on entry, */
4530  /* (leniw-limlst)/2 equals the maximum number of */
4531  /* subintervals allowed in the partition of each */
4532  /* cycle, leniw.ge.(limlst+2). */
4533  /* if leniw.lt.(limlst+2), the routine will end with */
4534  /* ier = 6. */
4535 
4536  /* maxp1 - long */
4537  /* maxp1 gives an upper bound on the number of */
4538  /* chebyshev moments which can be stored, i.e. for */
4539  /* the intervals of lengths fabs(b-a)*2**(-l), */
4540  /* l = 0,1, ..., maxp1-2, maxp1.ge.1. */
4541  /* if maxp1.lt.1, the routine will end with ier = 6. */
4542  /* lenw - long */
4543  /* dimensioning parameter for work */
4544  /* lenw must be at least leniw*2+maxp1*25. */
4545  /* if lenw.lt.(leniw*2+maxp1*25), the routine will */
4546  /* end with ier = 6. */
4547 
4548  /* work arrays */
4549  /* iwork - long */
4550  /* vector of dimension at least leniw */
4551  /* on return, iwork(k) for k = 1, 2, ..., lst */
4552  /* contain the error flags on the cycles. */
4553 
4554  /* work - double precision */
4555  /* vector of dimension at least */
4556  /* on return, */
4557  /* work(1), ..., work(lst) contain the integral */
4558  /* approximations over the cycles, */
4559  /* work(limlst+1), ..., work(limlst+lst) contain */
4560  /* the error extimates over the cycles. */
4561  /* further elements of work have no specific */
4562  /* meaning for the user. */
4563 
4564  /* ***references (none) */
4565  /* ***routines called dqawfe,xerror */
4566  /* ***end prologue dqawf */
4567 
4568 
4569 
4570 
4571  /* check validity of limlst, leniw, maxp1 and lenw. */
4572 
4573  /* ***first executable statement dqawf */
4574  /* Parameter adjustments */
4575  --iwork;
4576  --work;
4577 
4578  /* Function Body */
4579  *ier = 6;
4580  *neval = 0;
4581  *result = 0.;
4582  *abserr = 0.;
4583  if (*limlst < 3 || *leniw < *limlst + 2 || *maxp1 < 1 || *lenw < (*leniw
4584  << 1) + *maxp1 * 25) {
4585  goto L10;
4586  }
4587 
4588  /* prepare call for dqawfe */
4589 
4590  limit = (*leniw - *limlst) / 2;
4591  l1 = *limlst + 1;
4592  l2 = *limlst + l1;
4593  l3 = limit + l2;
4594  l4 = limit + l3;
4595  l5 = limit + l4;
4596  l6 = limit + l5;
4597  ll2 = limit + l1;
4598  dqawfe_(f, a, omega, integr, epsabs, limlst, &limit, maxp1, result,
4599  abserr, neval, ier, &work[1], &work[l1], &iwork[1], lst, &work[l2]
4600  , &work[l3], &work[l4], &work[l5], &iwork[l1], &iwork[ll2], &work[
4601  l6]);
4602 
4603  /* call error handler if necessary */
4604 
4605  lvl = 0;
4606 L10:
4607  if (*ier == 6) {
4608  lvl = 1;
4609  }
4610  if (*ier != 0) {
4611  xerror_("abnormal return from dqawf", &c__26, ier, &lvl, 26);
4612  }
4613  return;
4614 } /* dqawf_ */
4615 
4616 void dqawoe_(const D_fp& f, const double *a, const double *b, const double
4617  *omega, const long *integr, const double *epsabs,
4618  const double *epsrel,
4619  const long *limit, const long *icall, const long *maxp1,
4620  double *result,
4621  double *abserr, long *neval, long *ier, long *last,
4622  double *alist__, double *blist, double *rlist, double
4623  *elist, long *iord, long *nnlog, long *momcom, double *
4624  chebmo)
4625 {
4626  /* System generated locals */
4627  int chebmo_dim1, chebmo_offset, i__1, i__2;
4628  double d__1, d__2;
4629 
4630  /* Local variables */
4631  long k;
4632  double a1, a2, b1, b2;
4633  long id, nev;
4634  double area, dres;
4635  long ksgn, nres;
4636  double area1, area2, area12;
4637  double small, erro12, width, defab1, defab2;
4638  long ierro, ktmin;
4639  double oflow;
4640  long nrmax, nrmom;
4641  double uflow;
4642  bool noext;
4643  long iroff1, iroff2, iroff3;
4644  double res3la[3], error1, error2, rlist2[52];
4645  long numrl2;
4646  double defabs, domega, epmach, erlarg=0., abseps, correc=0., errbnd,
4647  resabs;
4648  long jupbnd;
4649  bool extall;
4650  double erlast, errmax;
4651  long maxerr;
4652  double reseps;
4653  bool extrap;
4654  double ertest=0., errsum;
4655 
4656  /* ***begin prologue dqawoe */
4657  /* ***date written 800101 (yymmdd) */
4658  /* ***revision date 830518 (yymmdd) */
4659  /* ***category no. h2a2a1 */
4660  /* ***keywords automatic integrator, special-purpose, */
4661  /* integrand with oscillatory cos or sin factor, */
4662  /* clenshaw-curtis method, (end point) singularities, */
4663  /* extrapolation, globally adaptive */
4664  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
4665  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
4666  /* ***purpose the routine calculates an approximation result to a given */
4667  /* definite integral */
4668  /* i = integral of f(x)*w(x) over (a,b) */
4669  /* where w(x) = cos(omega*x) or w(x)=sin(omega*x), */
4670  /* hopefully satisfying following claim for accuracy */
4671  /* fabs(i-result).le.max(epsabs,epsrel*fabs(i)). */
4672  /* ***description */
4673 
4674  /* computation of oscillatory integrals */
4675  /* standard fortran subroutine */
4676  /* double precision version */
4677 
4678  /* parameters */
4679  /* on entry */
4680  /* f - double precision */
4681  /* function subprogram defining the integrand */
4682  /* function f(x). the actual name for f needs to be */
4683  /* declared e x t e r n a l in the driver program. */
4684 
4685  /* a - double precision */
4686  /* lower limit of integration */
4687 
4688  /* b - double precision */
4689  /* upper limit of integration */
4690 
4691  /* omega - double precision */
4692  /* parameter in the integrand weight function */
4693 
4694  /* integr - long */
4695  /* indicates which of the weight functions is to be */
4696  /* used */
4697  /* integr = 1 w(x) = cos(omega*x) */
4698  /* integr = 2 w(x) = sin(omega*x) */
4699  /* if integr.ne.1 and integr.ne.2, the routine */
4700  /* will end with ier = 6. */
4701 
4702  /* epsabs - double precision */
4703  /* absolute accuracy requested */
4704  /* epsrel - double precision */
4705  /* relative accuracy requested */
4706  /* if epsabs.le.0 */
4707  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
4708  /* the routine will end with ier = 6. */
4709 
4710  /* limit - long */
4711  /* gives an upper bound on the number of subdivisions */
4712  /* in the partition of (a,b), limit.ge.1. */
4713 
4714  /* icall - long */
4715  /* if dqawoe is to be used only once, icall must */
4716  /* be set to 1. assume that during this call, the */
4717  /* chebyshev moments (for clenshaw-curtis integration */
4718  /* of degree 24) have been computed for intervals of */
4719  /* lenghts (fabs(b-a))*2**(-l), l=0,1,2,...momcom-1. */
4720  /* if icall.gt.1 this means that dqawoe has been */
4721  /* called twice or more on intervals of the same */
4722  /* length fabs(b-a). the chebyshev moments already */
4723  /* computed are then re-used in subsequent calls. */
4724  /* if icall.lt.1, the routine will end with ier = 6. */
4725 
4726  /* maxp1 - long */
4727  /* gives an upper bound on the number of chebyshev */
4728  /* moments which can be stored, i.e. for the */
4729  /* intervals of lenghts fabs(b-a)*2**(-l), */
4730  /* l=0,1, ..., maxp1-2, maxp1.ge.1. */
4731  /* if maxp1.lt.1, the routine will end with ier = 6. */
4732 
4733  /* on return */
4734  /* result - double precision */
4735  /* approximation to the integral */
4736 
4737  /* abserr - double precision */
4738  /* estimate of the modulus of the absolute error, */
4739  /* which should equal or exceed fabs(i-result) */
4740 
4741  /* neval - long */
4742  /* number of integrand evaluations */
4743 
4744  /* ier - long */
4745  /* ier = 0 normal and reliable termination of the */
4746  /* routine. it is assumed that the */
4747  /* requested accuracy has been achieved. */
4748  /* - ier.gt.0 abnormal termination of the routine. */
4749  /* the estimates for integral and error are */
4750  /* less reliable. it is assumed that the */
4751  /* requested accuracy has not been achieved. */
4752  /* error messages */
4753  /* ier = 1 maximum number of subdivisions allowed */
4754  /* has been achieved. one can allow more */
4755  /* subdivisions by increasing the value of */
4756  /* limit (and taking according dimension */
4757  /* adjustments into account). however, if */
4758  /* this yields no improvement it is advised */
4759  /* to analyze the integrand, in order to */
4760  /* determine the integration difficulties. */
4761  /* if the position of a local difficulty can */
4762  /* be determined (e.g. singularity, */
4763  /* discontinuity within the interval) one */
4764  /* will probably gain from splitting up the */
4765  /* interval at this point and calling the */
4766  /* integrator on the subranges. if possible, */
4767  /* an appropriate special-purpose integrator */
4768  /* should be used which is designed for */
4769  /* handling the type of difficulty involved. */
4770  /* = 2 the occurrence of roundoff error is */
4771  /* detected, which prevents the requested */
4772  /* tolerance from being achieved. */
4773  /* the error may be under-estimated. */
4774  /* = 3 extremely bad integrand behaviour occurs */
4775  /* at some points of the integration */
4776  /* interval. */
4777  /* = 4 the algorithm does not converge. */
4778  /* roundoff error is detected in the */
4779  /* extrapolation table. */
4780  /* it is presumed that the requested */
4781  /* tolerance cannot be achieved due to */
4782  /* roundoff in the extrapolation table, */
4783  /* and that the returned result is the */
4784  /* best which can be obtained. */
4785  /* = 5 the integral is probably divergent, or */
4786  /* slowly convergent. it must be noted that */
4787  /* divergence can occur with any other value */
4788  /* of ier.gt.0. */
4789  /* = 6 the input is invalid, because */
4790  /* (epsabs.le.0 and */
4791  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28)) */
4792  /* or (integr.ne.1 and integr.ne.2) or */
4793  /* icall.lt.1 or maxp1.lt.1. */
4794  /* result, abserr, neval, last, rlist(1), */
4795  /* elist(1), iord(1) and nnlog(1) are set */
4796  /* to zero. alist(1) and blist(1) are set */
4797  /* to a and b respectively. */
4798 
4799  /* last - long */
4800  /* on return, last equals the number of */
4801  /* subintervals produces in the subdivision */
4802  /* process, which determines the number of */
4803  /* significant elements actually in the */
4804  /* work arrays. */
4805  /* alist - double precision */
4806  /* vector of dimension at least limit, the first */
4807  /* last elements of which are the left */
4808  /* end points of the subintervals in the partition */
4809  /* of the given integration range (a,b) */
4810 
4811  /* blist - double precision */
4812  /* vector of dimension at least limit, the first */
4813  /* last elements of which are the right */
4814  /* end points of the subintervals in the partition */
4815  /* of the given integration range (a,b) */
4816 
4817  /* rlist - double precision */
4818  /* vector of dimension at least limit, the first */
4819  /* last elements of which are the integral */
4820  /* approximations on the subintervals */
4821 
4822  /* elist - double precision */
4823  /* vector of dimension at least limit, the first */
4824  /* last elements of which are the moduli of the */
4825  /* absolute error estimates on the subintervals */
4826 
4827  /* iord - long */
4828  /* vector of dimension at least limit, the first k */
4829  /* elements of which are pointers to the error */
4830  /* estimates over the subintervals, */
4831  /* such that elist(iord(1)), ..., */
4832  /* elist(iord(k)) form a decreasing sequence, with */
4833  /* k = last if last.le.(limit/2+2), and */
4834  /* k = limit+1-last otherwise. */
4835 
4836  /* nnlog - long */
4837  /* vector of dimension at least limit, containing the */
4838  /* subdivision levels of the subintervals, i.e. */
4839  /* iwork(i) = l means that the subinterval */
4840  /* numbered i is of length fabs(b-a)*2**(1-l) */
4841 
4842  /* on entry and return */
4843  /* momcom - long */
4844  /* indicating that the chebyshev moments */
4845  /* have been computed for intervals of lengths */
4846  /* (fabs(b-a))*2**(-l), l=0,1,2, ..., momcom-1, */
4847  /* momcom.lt.maxp1 */
4848 
4849  /* chebmo - double precision */
4850  /* array of dimension (maxp1,25) containing the */
4851  /* chebyshev moments */
4852 
4853  /* ***references (none) */
4854  /* ***routines called d1mach,dqc25f,dqelg,dqpsrt */
4855  /* ***end prologue dqawoe */
4856 
4857 
4858 
4859 
4860  /* the dimension of rlist2 is determined by the value of */
4861  /* limexp in subroutine dqelg (rlist2 should be of */
4862  /* dimension (limexp+2) at least). */
4863 
4864  /* list of major variables */
4865  /* ----------------------- */
4866 
4867  /* alist - list of left end points of all subintervals */
4868  /* considered up to now */
4869  /* blist - list of right end points of all subintervals */
4870  /* considered up to now */
4871  /* rlist(i) - approximation to the integral over */
4872  /* (alist(i),blist(i)) */
4873  /* rlist2 - array of dimension at least limexp+2 */
4874  /* containing the part of the epsilon table */
4875  /* which is still needed for further computations */
4876  /* elist(i) - error estimate applying to rlist(i) */
4877  /* maxerr - pointer to the interval with largest */
4878  /* error estimate */
4879  /* errmax - elist(maxerr) */
4880  /* erlast - error on the interval currently subdivided */
4881  /* area - sum of the integrals over the subintervals */
4882  /* errsum - sum of the errors over the subintervals */
4883  /* errbnd - requested accuracy max(epsabs,epsrel* */
4884  /* fabs(result)) */
4885  /* *****1 - variable for the left subinterval */
4886  /* *****2 - variable for the right subinterval */
4887  /* last - index for subdivision */
4888  /* nres - number of calls to the extrapolation routine */
4889  /* numrl2 - number of elements in rlist2. if an appropriate */
4890  /* approximation to the compounded integral has */
4891  /* been obtained it is put in rlist2(numrl2) after */
4892  /* numrl2 has been increased by one */
4893  /* small - length of the smallest interval considered */
4894  /* up to now, multiplied by 1.5 */
4895  /* erlarg - sum of the errors over the intervals larger */
4896  /* than the smallest interval considered up to now */
4897  /* extrap - bool variable denoting that the routine is */
4898  /* attempting to perform extrapolation, i.e. before */
4899  /* subdividing the smallest interval we try to */
4900  /* decrease the value of erlarg */
4901  /* noext - bool variable denoting that extrapolation */
4902  /* is no longer allowed (true value) */
4903 
4904  /* machine dependent constants */
4905  /* --------------------------- */
4906 
4907  /* epmach is the largest relative spacing. */
4908  /* uflow is the smallest positive magnitude. */
4909  /* oflow is the largest positive magnitude. */
4910 
4911  /* ***first executable statement dqawoe */
4912  /* Parameter adjustments */
4913  --nnlog;
4914  --iord;
4915  --elist;
4916  --rlist;
4917  --blist;
4918  --alist__;
4919  chebmo_dim1 = *maxp1;
4920  chebmo_offset = 1 + chebmo_dim1;
4921  chebmo -= chebmo_offset;
4922 
4923  /* Function Body */
4924  epmach = d1mach(c__4);
4925 
4926  /* test on validity of parameters */
4927  /* ------------------------------ */
4928 
4929  *ier = 0;
4930  *neval = 0;
4931  *last = 0;
4932  *result = 0.;
4933  *abserr = 0.;
4934  alist__[1] = *a;
4935  blist[1] = *b;
4936  rlist[1] = 0.;
4937  elist[1] = 0.;
4938  iord[1] = 0;
4939  nnlog[1] = 0;
4940  /* Computing MAX */
4941  d__1 = epmach * 50.;
4942  if ( ( *integr != 1 && *integr != 2 ) ||
4943  ( *epsabs <= 0. && *epsrel < max(d__1, 5e-29) ) ||
4944  *icall < 1 || *maxp1 < 1) {
4945  *ier = 6;
4946  }
4947  if (*ier == 6) {
4948  goto L999;
4949  }
4950 
4951  /* first approximation to the integral */
4952  /* ----------------------------------- */
4953 
4954  domega = fabs(*omega);
4955  nrmom = 0;
4956  if (*icall > 1) {
4957  goto L5;
4958  }
4959  *momcom = 0;
4960 L5:
4961  dqc25f_(f, a, b, &domega, integr, &nrmom, maxp1, &c__0, result,
4962  abserr, neval, &defabs, &resabs, momcom, &chebmo[chebmo_offset]);
4963 
4964  /* test on accuracy. */
4965 
4966  dres = fabs(*result);
4967  /* Computing MAX */
4968  d__1 = *epsabs, d__2 = *epsrel * dres;
4969  errbnd = max(d__1,d__2);
4970  rlist[1] = *result;
4971  elist[1] = *abserr;
4972  iord[1] = 1;
4973  if (*abserr <= epmach * 100. * defabs && *abserr > errbnd) {
4974  *ier = 2;
4975  }
4976  if (*limit == 1) {
4977  *ier = 1;
4978  }
4979  if (*ier != 0 || *abserr <= errbnd) {
4980  goto L200;
4981  }
4982 
4983  /* initializations */
4984  /* --------------- */
4985 
4986  uflow = d1mach(c__1);
4987  oflow = d1mach(c__2);
4988  errmax = *abserr;
4989  maxerr = 1;
4990  area = *result;
4991  errsum = *abserr;
4992  *abserr = oflow;
4993  nrmax = 1;
4994  extrap = false;
4995  noext = false;
4996  ierro = 0;
4997  iroff1 = 0;
4998  iroff2 = 0;
4999  iroff3 = 0;
5000  ktmin = 0;
5001  small = (d__1 = *b - *a, fabs(d__1)) * .75;
5002  nres = 0;
5003  numrl2 = 0;
5004  extall = false;
5005  if ((d__1 = *b - *a, fabs(d__1)) * .5 * domega > 2.) {
5006  goto L10;
5007  }
5008  numrl2 = 1;
5009  extall = true;
5010  rlist2[0] = *result;
5011 L10:
5012  if ((d__1 = *b - *a, fabs(d__1)) * .25 * domega <= 2.) {
5013  extall = true;
5014  }
5015  ksgn = -1;
5016  if (dres >= (1. - epmach * 50.) * defabs) {
5017  ksgn = 1;
5018  }
5019 
5020  /* main do-loop */
5021  /* ------------ */
5022 
5023  i__1 = *limit;
5024  for (*last = 2; *last <= i__1; ++(*last)) {
5025 
5026  /* bisect the subinterval with the nrmax-th largest */
5027  /* error estimate. */
5028 
5029  nrmom = nnlog[maxerr] + 1;
5030  a1 = alist__[maxerr];
5031  b1 = (alist__[maxerr] + blist[maxerr]) * .5;
5032  a2 = b1;
5033  b2 = blist[maxerr];
5034  erlast = errmax;
5035  dqc25f_(f, &a1, &b1, &domega, integr, &nrmom, maxp1, &c__0, &
5036  area1, &error1, &nev, &resabs, &defab1, momcom, &chebmo[
5037  chebmo_offset]);
5038  *neval += nev;
5039  dqc25f_(f, &a2, &b2, &domega, integr, &nrmom, maxp1, &c__1, &
5040  area2, &error2, &nev, &resabs, &defab2, momcom, &chebmo[
5041  chebmo_offset]);
5042  *neval += nev;
5043 
5044  /* improve previous approximations to integral */
5045  /* and error and test for accuracy. */
5046 
5047  area12 = area1 + area2;
5048  erro12 = error1 + error2;
5049  errsum = errsum + erro12 - errmax;
5050  area = area + area12 - rlist[maxerr];
5051  if (defab1 == error1 || defab2 == error2) {
5052  goto L25;
5053  }
5054  if ((d__1 = rlist[maxerr] - area12, fabs(d__1)) > fabs(area12) * 1e-5 ||
5055  erro12 < errmax * .99) {
5056  goto L20;
5057  }
5058  if (extrap) {
5059  ++iroff2;
5060  }
5061  if (! extrap) {
5062  ++iroff1;
5063  }
5064  L20:
5065  if (*last > 10 && erro12 > errmax) {
5066  ++iroff3;
5067  }
5068  L25:
5069  rlist[maxerr] = area1;
5070  rlist[*last] = area2;
5071  nnlog[maxerr] = nrmom;
5072  nnlog[*last] = nrmom;
5073  /* Computing MAX */
5074  d__1 = *epsabs, d__2 = *epsrel * fabs(area);
5075  errbnd = max(d__1,d__2);
5076 
5077  /* test for roundoff error and eventually set error flag. */
5078 
5079  if (iroff1 + iroff2 >= 10 || iroff3 >= 20) {
5080  *ier = 2;
5081  }
5082  if (iroff2 >= 5) {
5083  ierro = 3;
5084  }
5085 
5086  /* set error flag in the case that the number of */
5087  /* subintervals equals limit. */
5088 
5089  if (*last == *limit) {
5090  *ier = 1;
5091  }
5092 
5093  /* set error flag in the case of bad integrand behaviour */
5094  /* at a point of the integration range. */
5095 
5096  /* Computing MAX */
5097  d__1 = fabs(a1), d__2 = fabs(b2);
5098  if (max(d__1,d__2) <= (epmach * 100. + 1.) * (fabs(a2) + uflow * 1e3))
5099  {
5100  *ier = 4;
5101  }
5102 
5103  /* append the newly-created intervals to the list. */
5104 
5105  if (error2 > error1) {
5106  goto L30;
5107  }
5108  alist__[*last] = a2;
5109  blist[maxerr] = b1;
5110  blist[*last] = b2;
5111  elist[maxerr] = error1;
5112  elist[*last] = error2;
5113  goto L40;
5114  L30:
5115  alist__[maxerr] = a2;
5116  alist__[*last] = a1;
5117  blist[*last] = b1;
5118  rlist[maxerr] = area2;
5119  rlist[*last] = area1;
5120  elist[maxerr] = error2;
5121  elist[*last] = error1;
5122 
5123  /* call subroutine dqpsrt to maintain the descending ordering */
5124  /* in the list of error estimates and select the subinterval */
5125  /* with nrmax-th largest error estimate (to bisected next). */
5126 
5127  L40:
5128  dqpsrt_(limit, last, &maxerr, &errmax, &elist[1], &iord[1], &nrmax);
5129  /* ***jump out of do-loop */
5130  if (errsum <= errbnd) {
5131  goto L170;
5132  }
5133  if (*ier != 0) {
5134  goto L150;
5135  }
5136  if (*last == 2 && extall) {
5137  goto L120;
5138  }
5139  if (noext) {
5140  goto L140;
5141  }
5142  if (! extall) {
5143  goto L50;
5144  }
5145  erlarg -= erlast;
5146  if ((d__1 = b1 - a1, fabs(d__1)) > small) {
5147  erlarg += erro12;
5148  }
5149  if (extrap) {
5150  goto L70;
5151  }
5152 
5153  /* test whether the interval to be bisected next is the */
5154  /* smallest interval. */
5155 
5156  L50:
5157  width = (d__1 = blist[maxerr] - alist__[maxerr], fabs(d__1));
5158  if (width > small) {
5159  goto L140;
5160  }
5161  if (extall) {
5162  goto L60;
5163  }
5164 
5165  /* test whether we can start with the extrapolation procedure */
5166  /* (we do this if we integrate over the next interval with */
5167  /* use of a gauss-kronrod rule - see subroutine dqc25f). */
5168 
5169  small *= .5;
5170  if (width * .25 * domega > 2.) {
5171  goto L140;
5172  }
5173  extall = true;
5174  goto L130;
5175  L60:
5176  extrap = true;
5177  nrmax = 2;
5178  L70:
5179  if (ierro == 3 || erlarg <= ertest) {
5180  goto L90;
5181  }
5182 
5183  /* the smallest interval has the largest error. */
5184  /* before bisecting decrease the sum of the errors over */
5185  /* the larger intervals (erlarg) and perform extrapolation. */
5186 
5187  jupbnd = *last;
5188  if (*last > *limit / 2 + 2) {
5189  jupbnd = *limit + 3 - *last;
5190  }
5191  id = nrmax;
5192  i__2 = jupbnd;
5193  for (k = id; k <= i__2; ++k) {
5194  maxerr = iord[nrmax];
5195  errmax = elist[maxerr];
5196  if ((d__1 = blist[maxerr] - alist__[maxerr], fabs(d__1)) > small) {
5197  goto L140;
5198  }
5199  ++nrmax;
5200  /* L80: */
5201  }
5202 
5203  /* perform extrapolation. */
5204 
5205  L90:
5206  ++numrl2;
5207  rlist2[numrl2 - 1] = area;
5208  if (numrl2 < 3) {
5209  goto L110;
5210  }
5211  dqelg_(&numrl2, rlist2, &reseps, &abseps, res3la, &nres);
5212  ++ktmin;
5213  if (ktmin > 5 && *abserr < errsum * .001) {
5214  *ier = 5;
5215  }
5216  if (abseps >= *abserr) {
5217  goto L100;
5218  }
5219  ktmin = 0;
5220  *abserr = abseps;
5221  *result = reseps;
5222  correc = erlarg;
5223  /* Computing MAX */
5224  d__1 = *epsabs, d__2 = *epsrel * fabs(reseps);
5225  ertest = max(d__1,d__2);
5226  /* ***jump out of do-loop */
5227  if (*abserr <= ertest) {
5228  goto L150;
5229  }
5230 
5231  /* prepare bisection of the smallest interval. */
5232 
5233  L100:
5234  if (numrl2 == 1) {
5235  noext = true;
5236  }
5237  if (*ier == 5) {
5238  goto L150;
5239  }
5240  L110:
5241  maxerr = iord[1];
5242  errmax = elist[maxerr];
5243  nrmax = 1;
5244  extrap = false;
5245  small *= .5;
5246  erlarg = errsum;
5247  goto L140;
5248  L120:
5249  small *= .5;
5250  ++numrl2;
5251  rlist2[numrl2 - 1] = area;
5252  L130:
5253  ertest = errbnd;
5254  erlarg = errsum;
5255  L140:
5256  ;
5257  }
5258 
5259  /* set the final result. */
5260  /* --------------------- */
5261 
5262 L150:
5263  if (*abserr == oflow || nres == 0) {
5264  goto L170;
5265  }
5266  if (*ier + ierro == 0) {
5267  goto L165;
5268  }
5269  if (ierro == 3) {
5270  *abserr += correc;
5271  }
5272  if (*ier == 0) {
5273  *ier = 3;
5274  }
5275  if (*result != 0. && area != 0.) {
5276  goto L160;
5277  }
5278  if (*abserr > errsum) {
5279  goto L170;
5280  }
5281  if (area == 0.) {
5282  goto L190;
5283  }
5284  goto L165;
5285 L160:
5286  if (*abserr / fabs(*result) > errsum / fabs(area)) {
5287  goto L170;
5288  }
5289 
5290  /* test on divergence. */
5291 
5292 L165:
5293  /* Computing MAX */
5294  d__1 = fabs(*result), d__2 = fabs(area);
5295  if (ksgn == -1 && max(d__1,d__2) <= defabs * .01) {
5296  goto L190;
5297  }
5298  if (.01 > *result / area || *result / area > 100. || errsum >= fabs(area))
5299  {
5300  *ier = 6;
5301  }
5302  goto L190;
5303 
5304  /* compute global integral sum. */
5305 
5306 L170:
5307  *result = 0.;
5308  i__1 = *last;
5309  for (k = 1; k <= i__1; ++k) {
5310  *result += rlist[k];
5311  /* L180: */
5312  }
5313  *abserr = errsum;
5314 L190:
5315  if (*ier > 2) {
5316  --(*ier);
5317  }
5318 L200:
5319  if (*integr == 2 && *omega < 0.) {
5320  *result = -(*result);
5321  }
5322 L999:
5323  return;
5324 } /* dqawoe_ */
5325 
5326 void dqawo_(const D_fp& f, const double *a, const double *b, const double *omega,
5327  const long *integr, const double *epsabs, const double *epsrel,
5328  double *result, double *abserr, long *neval, long *ier,
5329  const long *leniw, long *maxp1, const long *lenw, long *last,
5330  long *iwork, double *work)
5331 {
5332  long l1, l2, l3, l4, lvl, limit;
5333  long momcom;
5334 
5335  /* ***begin prologue dqawo */
5336  /* ***date written 800101 (yymmdd) */
5337  /* ***revision date 830518 (yymmdd) */
5338  /* ***category no. h2a2a1 */
5339  /* ***keywords automatic integrator, special-purpose, */
5340  /* integrand with oscillatory cos or sin factor, */
5341  /* clenshaw-curtis method, (end point) singularities, */
5342  /* extrapolation, globally adaptive */
5343  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
5344  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
5345  /* ***purpose the routine calculates an approximation result to a given */
5346  /* definite integral i=integral of f(x)*w(x) over (a,b) */
5347  /* where w(x) = cos(omega*x) */
5348  /* or w(x) = sin(omega*x), */
5349  /* hopefully satisfying following claim for accuracy */
5350  /* fabs(i-result).le.max(epsabs,epsrel*fabs(i)). */
5351  /* ***description */
5352 
5353  /* computation of oscillatory integrals */
5354  /* standard fortran subroutine */
5355  /* double precision version */
5356 
5357  /* parameters */
5358  /* on entry */
5359  /* f - double precision */
5360  /* function subprogram defining the function */
5361  /* f(x). the actual name for f needs to be */
5362  /* declared e x t e r n a l in the driver program. */
5363 
5364  /* a - double precision */
5365  /* lower limit of integration */
5366 
5367  /* b - double precision */
5368  /* upper limit of integration */
5369 
5370  /* omega - double precision */
5371  /* parameter in the integrand weight function */
5372 
5373  /* integr - long */
5374  /* indicates which of the weight functions is used */
5375  /* integr = 1 w(x) = cos(omega*x) */
5376  /* integr = 2 w(x) = sin(omega*x) */
5377  /* if integr.ne.1.and.integr.ne.2, the routine will */
5378  /* end with ier = 6. */
5379 
5380  /* epsabs - double precision */
5381  /* absolute accuracy requested */
5382  /* epsrel - double precision */
5383  /* relative accuracy requested */
5384  /* if epsabs.le.0 and */
5385  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
5386  /* the routine will end with ier = 6. */
5387 
5388  /* on return */
5389  /* result - double precision */
5390  /* approximation to the integral */
5391 
5392  /* abserr - double precision */
5393  /* estimate of the modulus of the absolute error, */
5394  /* which should equal or exceed fabs(i-result) */
5395 
5396  /* neval - long */
5397  /* number of integrand evaluations */
5398 
5399  /* ier - long */
5400  /* ier = 0 normal and reliable termination of the */
5401  /* routine. it is assumed that the requested */
5402  /* accuracy has been achieved. */
5403  /* - ier.gt.0 abnormal termination of the routine. */
5404  /* the estimates for integral and error are */
5405  /* less reliable. it is assumed that the */
5406  /* requested accuracy has not been achieved. */
5407  /* error messages */
5408  /* ier = 1 maximum number of subdivisions allowed */
5409  /* (= leniw/2) has been achieved. one can */
5410  /* allow more subdivisions by increasing the */
5411  /* value of leniw (and taking the according */
5412  /* dimension adjustments into account). */
5413  /* however, if this yields no improvement it */
5414  /* is advised to analyze the integrand in */
5415  /* order to determine the integration */
5416  /* difficulties. if the position of a local */
5417  /* difficulty can be determined (e.g. */
5418  /* singularity, discontinuity within the */
5419  /* interval) one will probably gain from */
5420  /* splitting up the interval at this polong */
5421  /* and calling the integrator on the */
5422  /* subranges. if possible, an appropriate */
5423  /* special-purpose integrator should be used */
5424  /* which is designed for handling the type of */
5425  /* difficulty involved. */
5426  /* = 2 the occurrence of roundoff error is */
5427  /* detected, which prevents the requested */
5428  /* tolerance from being achieved. */
5429  /* the error may be under-estimated. */
5430  /* = 3 extremely bad integrand behaviour occurs */
5431  /* at some interior points of the */
5432  /* integration interval. */
5433  /* = 4 the algorithm does not converge. */
5434  /* roundoff error is detected in the */
5435  /* extrapolation table. it is presumed that */
5436  /* the requested tolerance cannot be achieved */
5437  /* due to roundoff in the extrapolation */
5438  /* table, and that the returned result is */
5439  /* the best which can be obtained. */
5440  /* = 5 the integral is probably divergent, or */
5441  /* slowly convergent. it must be noted that */
5442  /* divergence can occur with any other value */
5443  /* of ier. */
5444  /* = 6 the input is invalid, because */
5445  /* (epsabs.le.0 and */
5446  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28)) */
5447  /* or (integr.ne.1 and integr.ne.2), */
5448  /* or leniw.lt.2 or maxp1.lt.1 or */
5449  /* lenw.lt.leniw*2+maxp1*25. */
5450  /* result, abserr, neval, last are set to */
5451  /* zero. except when leniw, maxp1 or lenw are */
5452  /* invalid, work(limit*2+1), work(limit*3+1), */
5453  /* iwork(1), iwork(limit+1) are set to zero, */
5454  /* work(1) is set to a and work(limit+1) to */
5455  /* b. */
5456 
5457  /* dimensioning parameters */
5458  /* leniw - long */
5459  /* dimensioning parameter for iwork. */
5460  /* leniw/2 equals the maximum number of subintervals */
5461  /* allowed in the partition of the given integration */
5462  /* interval (a,b), leniw.ge.2. */
5463  /* if leniw.lt.2, the routine will end with ier = 6. */
5464 
5465  /* maxp1 - long */
5466  /* gives an upper bound on the number of chebyshev */
5467  /* moments which can be stored, i.e. for the */
5468  /* intervals of lengths fabs(b-a)*2**(-l), */
5469  /* l=0,1, ..., maxp1-2, maxp1.ge.1 */
5470  /* if maxp1.lt.1, the routine will end with ier = 6. */
5471 
5472  /* lenw - long */
5473  /* dimensioning parameter for work */
5474  /* lenw must be at least leniw*2+maxp1*25. */
5475  /* if lenw.lt.(leniw*2+maxp1*25), the routine will */
5476  /* end with ier = 6. */
5477 
5478  /* last - long */
5479  /* on return, last equals the number of subintervals */
5480  /* produced in the subdivision process, which */
5481  /* determines the number of significant elements */
5482  /* actually in the work arrays. */
5483 
5484  /* work arrays */
5485  /* iwork - long */
5486  /* vector of dimension at least leniw */
5487  /* on return, the first k elements of which contain */
5488  /* pointers to the error estimates over the */
5489  /* subintervals, such that work(limit*3+iwork(1)), .. */
5490  /* work(limit*3+iwork(k)) form a decreasing */
5491  /* sequence, with limit = lenw/2 , and k = last */
5492  /* if last.le.(limit/2+2), and k = limit+1-last */
5493  /* otherwise. */
5494  /* furthermore, iwork(limit+1), ..., iwork(limit+ */
5495  /* last) indicate the subdivision levels of the */
5496  /* subintervals, such that iwork(limit+i) = l means */
5497  /* that the subinterval numbered i is of length */
5498  /* fabs(b-a)*2**(1-l). */
5499 
5500  /* work - double precision */
5501  /* vector of dimension at least lenw */
5502  /* on return */
5503  /* work(1), ..., work(last) contain the left */
5504  /* end points of the subintervals in the */
5505  /* partition of (a,b), */
5506  /* work(limit+1), ..., work(limit+last) contain */
5507  /* the right end points, */
5508  /* work(limit*2+1), ..., work(limit*2+last) contain */
5509  /* the integral approximations over the */
5510  /* subintervals, */
5511  /* work(limit*3+1), ..., work(limit*3+last) */
5512  /* contain the error estimates. */
5513  /* work(limit*4+1), ..., work(limit*4+maxp1*25) */
5514  /* provide space for storing the chebyshev moments. */
5515  /* note that limit = lenw/2. */
5516 
5517  /* ***references (none) */
5518  /* ***routines called dqawoe,xerror */
5519  /* ***end prologue dqawo */
5520 
5521 
5522 
5523 
5524  /* check validity of leniw, maxp1 and lenw. */
5525 
5526  /* ***first executable statement dqawo */
5527  /* Parameter adjustments */
5528  --iwork;
5529  --work;
5530 
5531  /* Function Body */
5532  *ier = 6;
5533  *neval = 0;
5534  *last = 0;
5535  *result = 0.;
5536  *abserr = 0.;
5537  if (*leniw < 2 || *maxp1 < 1 || *lenw < (*leniw << 1) + *maxp1 * 25) {
5538  goto L10;
5539  }
5540 
5541  /* prepare call for dqawoe */
5542 
5543  limit = *leniw / 2;
5544  l1 = limit + 1;
5545  l2 = limit + l1;
5546  l3 = limit + l2;
5547  l4 = limit + l3;
5548  dqawoe_(f, a, b, omega, integr, epsabs, epsrel, &limit, &c__1,
5549  maxp1, result, abserr, neval, ier, last, &work[1], &work[l1], &
5550  work[l2], &work[l3], &iwork[1], &iwork[l1], &momcom, &work[l4]);
5551 
5552  /* call error handler if necessary */
5553 
5554  lvl = 0;
5555 L10:
5556  if (*ier == 6) {
5557  lvl = 0;
5558  }
5559  if (*ier != 0) {
5560  xerror_("abnormal return from dqawo", &c__26, ier, &lvl, 26);
5561  }
5562  return;
5563 } /* dqawo_ */
5564 
5565 void dqawse_(const D_fp& f, const double *a, const double *b, const double *alfa,
5566  const double *beta, const long *integr, const double *epsabs,
5567  const double *epsrel, const long *limit, double *result,
5568  double *abserr, long *neval, long *ier, double *alist__,
5569  double *blist, double *rlist, double *elist, long *iord,
5570  long *last)
5571 {
5572  /* System generated locals */
5573  int i__1;
5574  double d__1, d__2;
5575 
5576  /* Local variables */
5577  long k;
5578  double a1, a2, b1, b2, rg[25], rh[25], ri[25], rj[25];
5579  long nev;
5580  double area, area1, area2, area12;
5581  double erro12;
5582  long nrmax;
5583  double uflow;
5584  long iroff1, iroff2;
5585  double resas1, resas2, error1, error2, epmach, errbnd, centre;
5586  double errmax;
5587  long maxerr;
5588  double errsum;
5589 
5590  /* ***begin prologue dqawse */
5591  /* ***date written 800101 (yymmdd) */
5592  /* ***revision date 830518 (yymmdd) */
5593  /* ***category no. h2a2a1 */
5594  /* ***keywords automatic integrator, special-purpose, */
5595  /* algebraico-logarithmic end point singularities, */
5596  /* clenshaw-curtis method */
5597  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
5598  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
5599  /* ***purpose the routine calculates an approximation result to a given */
5600  /* definite integral i = integral of f*w over (a,b), */
5601  /* (where w shows a singular behaviour at the end points, */
5602  /* see parameter integr). */
5603  /* hopefully satisfying following claim for accuracy */
5604  /* fabs(i-result).le.max(epsabs,epsrel*fabs(i)). */
5605  /* ***description */
5606 
5607  /* integration of functions having algebraico-logarithmic */
5608  /* end point singularities */
5609  /* standard fortran subroutine */
5610  /* double precision version */
5611 
5612  /* parameters */
5613  /* on entry */
5614  /* f - double precision */
5615  /* function subprogram defining the integrand */
5616  /* function f(x). the actual name for f needs to be */
5617  /* declared e x t e r n a l in the driver program. */
5618 
5619  /* a - double precision */
5620  /* lower limit of integration */
5621 
5622  /* b - double precision */
5623  /* upper limit of integration, b.gt.a */
5624  /* if b.le.a, the routine will end with ier = 6. */
5625 
5626  /* alfa - double precision */
5627  /* parameter in the weight function, alfa.gt.(-1) */
5628  /* if alfa.le.(-1), the routine will end with */
5629  /* ier = 6. */
5630 
5631  /* beta - double precision */
5632  /* parameter in the weight function, beta.gt.(-1) */
5633  /* if beta.le.(-1), the routine will end with */
5634  /* ier = 6. */
5635 
5636  /* integr - long */
5637  /* indicates which weight function is to be used */
5638  /* = 1 (x-a)**alfa*(b-x)**beta */
5639  /* = 2 (x-a)**alfa*(b-x)**beta*log(x-a) */
5640  /* = 3 (x-a)**alfa*(b-x)**beta*log(b-x) */
5641  /* = 4 (x-a)**alfa*(b-x)**beta*log(x-a)*log(b-x) */
5642  /* if integr.lt.1 or integr.gt.4, the routine */
5643  /* will end with ier = 6. */
5644 
5645  /* epsabs - double precision */
5646  /* absolute accuracy requested */
5647  /* epsrel - double precision */
5648  /* relative accuracy requested */
5649  /* if epsabs.le.0 */
5650  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
5651  /* the routine will end with ier = 6. */
5652 
5653  /* limit - long */
5654  /* gives an upper bound on the number of subintervals */
5655  /* in the partition of (a,b), limit.ge.2 */
5656  /* if limit.lt.2, the routine will end with ier = 6. */
5657 
5658  /* on return */
5659  /* result - double precision */
5660  /* approximation to the integral */
5661 
5662  /* abserr - double precision */
5663  /* estimate of the modulus of the absolute error, */
5664  /* which should equal or exceed fabs(i-result) */
5665 
5666  /* neval - long */
5667  /* number of integrand evaluations */
5668 
5669  /* ier - long */
5670  /* ier = 0 normal and reliable termination of the */
5671  /* routine. it is assumed that the requested */
5672  /* accuracy has been achieved. */
5673  /* ier.gt.0 abnormal termination of the routine */
5674  /* the estimates for the integral and error */
5675  /* are less reliable. it is assumed that the */
5676  /* requested accuracy has not been achieved. */
5677  /* error messages */
5678  /* = 1 maximum number of subdivisions allowed */
5679  /* has been achieved. one can allow more */
5680  /* subdivisions by increasing the value of */
5681  /* limit. however, if this yields no */
5682  /* improvement, it is advised to analyze the */
5683  /* integrand in order to determine the */
5684  /* integration difficulties which prevent the */
5685  /* requested tolerance from being achieved. */
5686  /* in case of a jump discontinuity or a local */
5687  /* singularity of algebraico-logarithmic type */
5688  /* at one or more interior points of the */
5689  /* integration range, one should proceed by */
5690  /* splitting up the interval at these */
5691  /* points and calling the integrator on the */
5692  /* subranges. */
5693  /* = 2 the occurrence of roundoff error is */
5694  /* detected, which prevents the requested */
5695  /* tolerance from being achieved. */
5696  /* = 3 extremely bad integrand behaviour occurs */
5697  /* at some points of the integration */
5698  /* interval. */
5699  /* = 6 the input is invalid, because */
5700  /* b.le.a or alfa.le.(-1) or beta.le.(-1), or */
5701  /* integr.lt.1 or integr.gt.4, or */
5702  /* (epsabs.le.0 and */
5703  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
5704  /* or limit.lt.2. */
5705  /* result, abserr, neval, rlist(1), elist(1), */
5706  /* iord(1) and last are set to zero. alist(1) */
5707  /* and blist(1) are set to a and b */
5708  /* respectively. */
5709 
5710  /* alist - double precision */
5711  /* vector of dimension at least limit, the first */
5712  /* last elements of which are the left */
5713  /* end points of the subintervals in the partition */
5714  /* of the given integration range (a,b) */
5715 
5716  /* blist - double precision */
5717  /* vector of dimension at least limit, the first */
5718  /* last elements of which are the right */
5719  /* end points of the subintervals in the partition */
5720  /* of the given integration range (a,b) */
5721 
5722  /* rlist - double precision */
5723  /* vector of dimension at least limit,the first */
5724  /* last elements of which are the integral */
5725  /* approximations on the subintervals */
5726 
5727  /* elist - double precision */
5728  /* vector of dimension at least limit, the first */
5729  /* last elements of which are the moduli of the */
5730  /* absolute error estimates on the subintervals */
5731 
5732  /* iord - long */
5733  /* vector of dimension at least limit, the first k */
5734  /* of which are pointers to the error */
5735  /* estimates over the subintervals, so that */
5736  /* elist(iord(1)), ..., elist(iord(k)) with k = last */
5737  /* if last.le.(limit/2+2), and k = limit+1-last */
5738  /* otherwise form a decreasing sequence */
5739 
5740  /* last - long */
5741  /* number of subintervals actually produced in */
5742  /* the subdivision process */
5743 
5744  /* ***references (none) */
5745  /* ***routines called d1mach,dqc25s,dqmomo,dqpsrt */
5746  /* ***end prologue dqawse */
5747 
5748 
5749 
5750 
5751  /* list of major variables */
5752  /* ----------------------- */
5753 
5754  /* alist - list of left end points of all subintervals */
5755  /* considered up to now */
5756  /* blist - list of right end points of all subintervals */
5757  /* considered up to now */
5758  /* rlist(i) - approximation to the integral over */
5759  /* (alist(i),blist(i)) */
5760  /* elist(i) - error estimate applying to rlist(i) */
5761  /* maxerr - pointer to the interval with largest */
5762  /* error estimate */
5763  /* errmax - elist(maxerr) */
5764  /* area - sum of the integrals over the subintervals */
5765  /* errsum - sum of the errors over the subintervals */
5766  /* errbnd - requested accuracy max(epsabs,epsrel* */
5767  /* fabs(result)) */
5768  /* *****1 - variable for the left subinterval */
5769  /* *****2 - variable for the right subinterval */
5770  /* last - index for subdivision */
5771 
5772 
5773  /* machine dependent constants */
5774  /* --------------------------- */
5775 
5776  /* epmach is the largest relative spacing. */
5777  /* uflow is the smallest positive magnitude. */
5778 
5779  /* ***first executable statement dqawse */
5780  /* Parameter adjustments */
5781  --iord;
5782  --elist;
5783  --rlist;
5784  --blist;
5785  --alist__;
5786 
5787  /* Function Body */
5788  epmach = d1mach(c__4);
5789  uflow = d1mach(c__1);
5790 
5791  /* test on validity of parameters */
5792  /* ------------------------------ */
5793 
5794  *ier = 6;
5795  *neval = 0;
5796  *last = 0;
5797  rlist[1] = 0.;
5798  elist[1] = 0.;
5799  iord[1] = 0;
5800  *result = 0.;
5801  *abserr = 0.;
5802  /* Computing MAX */
5803  d__1 = epmach * 50.;
5804  if (*b <= *a || ( *epsabs == 0. && *epsrel < max(d__1,5e-29) ) || *alfa <=
5805  -1. || *beta <= -1. || *integr < 1 || *integr > 4 || *limit < 2) {
5806  goto L999;
5807  }
5808  *ier = 0;
5809 
5810  /* compute the modified chebyshev moments. */
5811 
5812  dqmomo_(alfa, beta, ri, rj, rg, rh, integr);
5813 
5814  /* integrate over the intervals (a,(a+b)/2) and ((a+b)/2,b). */
5815 
5816  centre = (*b + *a) * .5;
5817  dqc25s_(f, a, b, a, &centre, alfa, beta, ri, rj, rg, rh, &area1, &
5818  error1, &resas1, integr, &nev);
5819  *neval = nev;
5820  dqc25s_(f, a, b, &centre, b, alfa, beta, ri, rj, rg, rh, &area2, &
5821  error2, &resas2, integr, &nev);
5822  *last = 2;
5823  *neval += nev;
5824  *result = area1 + area2;
5825  *abserr = error1 + error2;
5826 
5827  /* test on accuracy. */
5828 
5829  /* Computing MAX */
5830  d__1 = *epsabs, d__2 = *epsrel * fabs(*result);
5831  errbnd = max(d__1,d__2);
5832 
5833  /* initialization */
5834  /* -------------- */
5835 
5836  if (error2 > error1) {
5837  goto L10;
5838  }
5839  alist__[1] = *a;
5840  alist__[2] = centre;
5841  blist[1] = centre;
5842  blist[2] = *b;
5843  rlist[1] = area1;
5844  rlist[2] = area2;
5845  elist[1] = error1;
5846  elist[2] = error2;
5847  goto L20;
5848 L10:
5849  alist__[1] = centre;
5850  alist__[2] = *a;
5851  blist[1] = *b;
5852  blist[2] = centre;
5853  rlist[1] = area2;
5854  rlist[2] = area1;
5855  elist[1] = error2;
5856  elist[2] = error1;
5857 L20:
5858  iord[1] = 1;
5859  iord[2] = 2;
5860  if (*limit == 2) {
5861  *ier = 1;
5862  }
5863  if (*abserr <= errbnd || *ier == 1) {
5864  goto L999;
5865  }
5866  errmax = elist[1];
5867  maxerr = 1;
5868  nrmax = 1;
5869  area = *result;
5870  errsum = *abserr;
5871  iroff1 = 0;
5872  iroff2 = 0;
5873 
5874  /* main do-loop */
5875  /* ------------ */
5876 
5877  i__1 = *limit;
5878  for (*last = 3; *last <= i__1; ++(*last)) {
5879 
5880  /* bisect the subinterval with largest error estimate. */
5881 
5882  a1 = alist__[maxerr];
5883  b1 = (alist__[maxerr] + blist[maxerr]) * .5;
5884  a2 = b1;
5885  b2 = blist[maxerr];
5886 
5887  dqc25s_(f, a, b, &a1, &b1, alfa, beta, ri, rj, rg, rh, &area1, &
5888  error1, &resas1, integr, &nev);
5889  *neval += nev;
5890  dqc25s_(f, a, b, &a2, &b2, alfa, beta, ri, rj, rg, rh, &area2, &
5891  error2, &resas2, integr, &nev);
5892  *neval += nev;
5893 
5894  /* improve previous approximations integral and error */
5895  /* and test for accuracy. */
5896 
5897  area12 = area1 + area2;
5898  erro12 = error1 + error2;
5899  errsum = errsum + erro12 - errmax;
5900  area = area + area12 - rlist[maxerr];
5901  if (*a == a1 || *b == b2) {
5902  goto L30;
5903  }
5904  if (resas1 == error1 || resas2 == error2) {
5905  goto L30;
5906  }
5907 
5908  /* test for roundoff error. */
5909 
5910  if ((d__1 = rlist[maxerr] - area12, fabs(d__1)) < fabs(area12) * 1e-5 &&
5911  erro12 >= errmax * .99) {
5912  ++iroff1;
5913  }
5914  if (*last > 10 && erro12 > errmax) {
5915  ++iroff2;
5916  }
5917  L30:
5918  rlist[maxerr] = area1;
5919  rlist[*last] = area2;
5920 
5921  /* test on accuracy. */
5922 
5923  /* Computing MAX */
5924  d__1 = *epsabs, d__2 = *epsrel * fabs(area);
5925  errbnd = max(d__1,d__2);
5926  if (errsum <= errbnd) {
5927  goto L35;
5928  }
5929 
5930  /* set error flag in the case that the number of interval */
5931  /* bisections exceeds limit. */
5932 
5933  if (*last == *limit) {
5934  *ier = 1;
5935  }
5936 
5937 
5938  /* set error flag in the case of roundoff error. */
5939 
5940  if (iroff1 >= 6 || iroff2 >= 20) {
5941  *ier = 2;
5942  }
5943 
5944  /* set error flag in the case of bad integrand behaviour */
5945  /* at interior points of integration range. */
5946 
5947  /* Computing MAX */
5948  d__1 = fabs(a1), d__2 = fabs(b2);
5949  if (max(d__1,d__2) <= (epmach * 100. + 1.) * (fabs(a2) + uflow * 1e3))
5950  {
5951  *ier = 3;
5952  }
5953 
5954  /* append the newly-created intervals to the list. */
5955 
5956  L35:
5957  if (error2 > error1) {
5958  goto L40;
5959  }
5960  alist__[*last] = a2;
5961  blist[maxerr] = b1;
5962  blist[*last] = b2;
5963  elist[maxerr] = error1;
5964  elist[*last] = error2;
5965  goto L50;
5966  L40:
5967  alist__[maxerr] = a2;
5968  alist__[*last] = a1;
5969  blist[*last] = b1;
5970  rlist[maxerr] = area2;
5971  rlist[*last] = area1;
5972  elist[maxerr] = error2;
5973  elist[*last] = error1;
5974 
5975  /* call subroutine dqpsrt to maintain the descending ordering */
5976  /* in the list of error estimates and select the subinterval */
5977  /* with largest error estimate (to be bisected next). */
5978 
5979  L50:
5980  dqpsrt_(limit, last, &maxerr, &errmax, &elist[1], &iord[1], &nrmax);
5981  /* ***jump out of do-loop */
5982  if (*ier != 0 || errsum <= errbnd) {
5983  goto L70;
5984  }
5985  /* L60: */
5986  }
5987 
5988  /* compute final result. */
5989  /* --------------------- */
5990 
5991 L70:
5992  *result = 0.;
5993  i__1 = *last;
5994  for (k = 1; k <= i__1; ++k) {
5995  *result += rlist[k];
5996  /* L80: */
5997  }
5998  *abserr = errsum;
5999 L999:
6000  return;
6001 } /* dqawse_ */
6002 
6003 void dqaws_(const D_fp& f, const double *a, const double *b, const double *alfa,
6004  const double *beta, const long *integr, const double *epsabs,
6005  const double *epsrel, double *result, double *abserr,
6006  long *neval, long *ier, long *limit, const long *lenw, long *last,
6007  long *iwork, double *work)
6008 {
6009  long l1, l2, l3, lvl;
6010 
6011  /* ***begin prologue dqaws */
6012  /* ***date written 800101 (yymmdd) */
6013  /* ***revision date 830518 (yymmdd) */
6014  /* ***category no. h2a2a1 */
6015  /* ***keywords automatic integrator, special-purpose, */
6016  /* algebraico-logarithmic end-point singularities, */
6017  /* clenshaw-curtis, globally adaptive */
6018  /* ***author piessens,robert,appl. math. & progr. div. -k.u.leuven */
6019  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
6020  /* ***purpose the routine calculates an approximation result to a given */
6021  /* definite integral i = integral of f*w over (a,b), */
6022  /* (where w shows a singular behaviour at the end points */
6023  /* see parameter integr). */
6024  /* hopefully satisfying following claim for accuracy */
6025  /* fabs(i-result).le.max(epsabs,epsrel*fabs(i)). */
6026  /* ***description */
6027 
6028  /* integration of functions having algebraico-logarithmic */
6029  /* end point singularities */
6030  /* standard fortran subroutine */
6031  /* double precision version */
6032 
6033  /* parameters */
6034  /* on entry */
6035  /* f - double precision */
6036  /* function subprogram defining the integrand */
6037  /* function f(x). the actual name for f needs to be */
6038  /* declared e x t e r n a l in the driver program. */
6039 
6040  /* a - double precision */
6041  /* lower limit of integration */
6042 
6043  /* b - double precision */
6044  /* upper limit of integration, b.gt.a */
6045  /* if b.le.a, the routine will end with ier = 6. */
6046 
6047  /* alfa - double precision */
6048  /* parameter in the integrand function, alfa.gt.(-1) */
6049  /* if alfa.le.(-1), the routine will end with */
6050  /* ier = 6. */
6051 
6052  /* beta - double precision */
6053  /* parameter in the integrand function, beta.gt.(-1) */
6054  /* if beta.le.(-1), the routine will end with */
6055  /* ier = 6. */
6056 
6057  /* integr - long */
6058  /* indicates which weight function is to be used */
6059  /* = 1 (x-a)**alfa*(b-x)**beta */
6060  /* = 2 (x-a)**alfa*(b-x)**beta*log(x-a) */
6061  /* = 3 (x-a)**alfa*(b-x)**beta*log(b-x) */
6062  /* = 4 (x-a)**alfa*(b-x)**beta*log(x-a)*log(b-x) */
6063  /* if integr.lt.1 or integr.gt.4, the routine */
6064  /* will end with ier = 6. */
6065 
6066  /* epsabs - double precision */
6067  /* absolute accuracy requested */
6068  /* epsrel - double precision */
6069  /* relative accuracy requested */
6070  /* if epsabs.le.0 */
6071  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
6072  /* the routine will end with ier = 6. */
6073 
6074  /* on return */
6075  /* result - double precision */
6076  /* approximation to the integral */
6077 
6078  /* abserr - double precision */
6079  /* estimate of the modulus of the absolute error, */
6080  /* which should equal or exceed fabs(i-result) */
6081 
6082  /* neval - long */
6083  /* number of integrand evaluations */
6084 
6085  /* ier - long */
6086  /* ier = 0 normal and reliable termination of the */
6087  /* routine. it is assumed that the requested */
6088  /* accuracy has been achieved. */
6089  /* ier.gt.0 abnormal termination of the routine */
6090  /* the estimates for the integral and error */
6091  /* are less reliable. it is assumed that the */
6092  /* requested accuracy has not been achieved. */
6093  /* error messages */
6094  /* ier = 1 maximum number of subdivisions allowed */
6095  /* has been achieved. one can allow more */
6096  /* subdivisions by increasing the value of */
6097  /* limit (and taking the according dimension */
6098  /* adjustments into account). however, if */
6099  /* this yields no improvement it is advised */
6100  /* to analyze the integrand, in order to */
6101  /* determine the integration difficulties */
6102  /* which prevent the requested tolerance from */
6103  /* being achieved. in case of a jump */
6104  /* discontinuity or a local singularity */
6105  /* of algebraico-logarithmic type at one or */
6106  /* more interior points of the integration */
6107  /* range, one should proceed by splitting up */
6108  /* the interval at these points and calling */
6109  /* the integrator on the subranges. */
6110  /* = 2 the occurrence of roundoff error is */
6111  /* detected, which prevents the requested */
6112  /* tolerance from being achieved. */
6113  /* = 3 extremely bad integrand behaviour occurs */
6114  /* at some points of the integration */
6115  /* interval. */
6116  /* = 6 the input is invalid, because */
6117  /* b.le.a or alfa.le.(-1) or beta.le.(-1) or */
6118  /* or integr.lt.1 or integr.gt.4 or */
6119  /* (epsabs.le.0 and */
6120  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28)) */
6121  /* or limit.lt.2 or lenw.lt.limit*4. */
6122  /* result, abserr, neval, last are set to */
6123  /* zero. except when lenw or limit is invalid */
6124  /* iwork(1), work(limit*2+1) and */
6125  /* work(limit*3+1) are set to zero, work(1) */
6126  /* is set to a and work(limit+1) to b. */
6127 
6128  /* dimensioning parameters */
6129  /* limit - long */
6130  /* dimensioning parameter for iwork */
6131  /* limit determines the maximum number of */
6132  /* subintervals in the partition of the given */
6133  /* integration interval (a,b), limit.ge.2. */
6134  /* if limit.lt.2, the routine will end with ier = 6. */
6135 
6136  /* lenw - long */
6137  /* dimensioning parameter for work */
6138  /* lenw must be at least limit*4. */
6139  /* if lenw.lt.limit*4, the routine will end */
6140  /* with ier = 6. */
6141 
6142  /* last - long */
6143  /* on return, last equals the number of */
6144  /* subintervals produced in the subdivision process, */
6145  /* which determines the significant number of */
6146  /* elements actually in the work arrays. */
6147 
6148  /* work arrays */
6149  /* iwork - long */
6150  /* vector of dimension limit, the first k */
6151  /* elements of which contain pointers */
6152  /* to the error estimates over the subintervals, */
6153  /* such that work(limit*3+iwork(1)), ..., */
6154  /* work(limit*3+iwork(k)) form a decreasing */
6155  /* sequence with k = last if last.le.(limit/2+2), */
6156  /* and k = limit+1-last otherwise */
6157 
6158  /* work - double precision */
6159  /* vector of dimension lenw */
6160  /* on return */
6161  /* work(1), ..., work(last) contain the left */
6162  /* end points of the subintervals in the */
6163  /* partition of (a,b), */
6164  /* work(limit+1), ..., work(limit+last) contain */
6165  /* the right end points, */
6166  /* work(limit*2+1), ..., work(limit*2+last) */
6167  /* contain the integral approximations over */
6168  /* the subintervals, */
6169  /* work(limit*3+1), ..., work(limit*3+last) */
6170  /* contain the error estimates. */
6171 
6172  /* ***references (none) */
6173  /* ***routines called dqawse,xerror */
6174  /* ***end prologue dqaws */
6175 
6176 
6177 
6178 
6179  /* check validity of limit and lenw. */
6180 
6181  /* ***first executable statement dqaws */
6182  /* Parameter adjustments */
6183  --iwork;
6184  --work;
6185 
6186  /* Function Body */
6187  *ier = 6;
6188  *neval = 0;
6189  *last = 0;
6190  *result = 0.;
6191  *abserr = 0.;
6192  if (*limit < 2 || *lenw < *limit << 2) {
6193  goto L10;
6194  }
6195 
6196  /* prepare call for dqawse. */
6197 
6198  l1 = *limit + 1;
6199  l2 = *limit + l1;
6200  l3 = *limit + l2;
6201 
6202  dqawse_(f, a, b, alfa, beta, integr, epsabs, epsrel, limit, result,
6203  abserr, neval, ier, &work[1], &work[l1], &work[l2], &work[l3], &
6204  iwork[1], last);
6205 
6206  /* call error handler if necessary. */
6207 
6208  lvl = 0;
6209 L10:
6210  if (*ier == 6) {
6211  lvl = 1;
6212  }
6213  if (*ier != 0) {
6214  xerror_("abnormal return from dqaws", &c__26, ier, &lvl, 26);
6215  }
6216  return;
6217 } /* dqaws_ */
6218 
6219 void dqc25c_(const D_fp& f, const double *a, const double *b, const double *c__,
6220  double *result, double *abserr, long *krul, long *neval)
6221 {
6222  /* Initialized data */
6223 
6224  double x[11] = { .991444861373810411144557526928563,
6225  .965925826289068286749743199728897,
6226  .923879532511286756128183189396788,
6227  .866025403784438646763723170752936,
6228  .793353340291235164579776961501299,
6229  .707106781186547524400844362104849,
6230  .608761429008720639416097542898164,.5,
6231  .382683432365089771728459984030399,
6232  .258819045102520762348898837624048,
6233  .130526192220051591548406227895489 };
6234 
6235  /* System generated locals */
6236  double d__1;
6237 
6238  /* Local variables */
6239  long i__, k;
6240  double u, p2, p3, p4, cc;
6241  long kp;
6242  double ak22, fval[25], res12, res24;
6243  long isym;
6244  double amom0, amom1, amom2, cheb12[13], cheb24[25], hlgth,
6245  centr;
6246  double resabs, resasc;
6247 
6248  /* ***begin prologue dqc25c */
6249  /* ***date written 810101 (yymmdd) */
6250  /* ***revision date 830518 (yymmdd) */
6251  /* ***category no. h2a2a2,j4 */
6252  /* ***keywords 25-point clenshaw-curtis integration */
6253  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
6254  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
6255  /* ***purpose to compute i = integral of f*w over (a,b) with */
6256  /* error estimate, where w(x) = 1/(x-c) */
6257  /* ***description */
6258 
6259  /* integration rules for the computation of cauchy */
6260  /* principal value integrals */
6261  /* standard fortran subroutine */
6262  /* double precision version */
6263 
6264  /* parameters */
6265  /* f - double precision */
6266  /* function subprogram defining the integrand function */
6267  /* f(x). the actual name for f needs to be declared */
6268  /* e x t e r n a l in the driver program. */
6269 
6270  /* a - double precision */
6271  /* left end point of the integration interval */
6272 
6273  /* b - double precision */
6274  /* right end point of the integration interval, b.gt.a */
6275 
6276  /* c - double precision */
6277  /* parameter in the weight function */
6278 
6279  /* result - double precision */
6280  /* approximation to the integral */
6281  /* result is computed by using a generalized */
6282  /* clenshaw-curtis method if c lies within ten percent */
6283  /* of the integration interval. in the other case the */
6284  /* 15-point kronrod rule obtained by optimal addition */
6285  /* of abscissae to the 7-point gauss rule, is applied. */
6286 
6287  /* abserr - double precision */
6288  /* estimate of the modulus of the absolute error, */
6289  /* which should equal or exceed fabs(i-result) */
6290 
6291  /* krul - long */
6292  /* key which is decreased by 1 if the 15-polong */
6293  /* gauss-kronrod scheme has been used */
6294 
6295  /* neval - long */
6296  /* number of integrand evaluations */
6297 
6298  /* ....................................................................... */
6299  /* ***references (none) */
6300  /* ***routines called dqcheb,dqk15w,dqwgtc */
6301  /* ***end prologue dqc25c */
6302 
6303 
6304 
6305 
6306  /* the vector x contains the values cos(k*pi/24), */
6307  /* k = 1, ..., 11, to be used for the chebyshev series */
6308  /* expansion of f */
6309 
6310 
6311  /* list of major variables */
6312  /* ---------------------- */
6313  /* fval - value of the function f at the points */
6314  /* cos(k*pi/24), k = 0, ..., 24 */
6315  /* cheb12 - chebyshev series expansion coefficients, */
6316  /* for the function f, of degree 12 */
6317  /* cheb24 - chebyshev series expansion coefficients, */
6318  /* for the function f, of degree 24 */
6319  /* res12 - approximation to the integral corresponding */
6320  /* to the use of cheb12 */
6321  /* res24 - approximation to the integral corresponding */
6322  /* to the use of cheb24 */
6323  /* dqwgtc - external function subprogram defining */
6324  /* the weight function */
6325  /* hlgth - half-length of the interval */
6326  /* centr - mid point of the interval */
6327 
6328 
6329  /* check the position of c. */
6330 
6331  /* ***first executable statement dqc25c */
6332  cc = (2. * *c__ - *b - *a) / (*b - *a);
6333  if (fabs(cc) < 1.1) {
6334  goto L10;
6335  }
6336 
6337  /* apply the 15-point gauss-kronrod scheme. */
6338 
6339  --(*krul);
6340  dqk15w_(f, dqwgtc_, c__, &p2, &p3, &p4, &kp, a, b, result,
6341  abserr, &resabs, &resasc);
6342  *neval = 15;
6343  if (resasc == *abserr) {
6344  ++(*krul);
6345  }
6346  goto L50;
6347 
6348  /* use the generalized clenshaw-curtis method. */
6349 
6350 L10:
6351  hlgth = (*b - *a) * .5;
6352  centr = (*b + *a) * .5;
6353  *neval = 25;
6354  d__1 = hlgth + centr;
6355  fval[0] = f(d__1) * .5;
6356  fval[12] = f(centr);
6357  d__1 = centr - hlgth;
6358  fval[24] = f(d__1) * .5;
6359  for (i__ = 2; i__ <= 12; ++i__) {
6360  u = hlgth * x[i__ - 2];
6361  isym = 26 - i__;
6362  d__1 = u + centr;
6363  fval[i__ - 1] = f(d__1);
6364  d__1 = centr - u;
6365  fval[isym - 1] = f(d__1);
6366  /* L20: */
6367  }
6368 
6369  /* compute the chebyshev series expansion. */
6370 
6371  dqcheb_(x, fval, cheb12, cheb24);
6372 
6373  /* the modified chebyshev moments are computed by forward */
6374  /* recursion, using amom0 and amom1 as starting values. */
6375 
6376  amom0 = log((d__1 = (1. - cc) / (cc + 1.), fabs(d__1)));
6377  amom1 = cc * amom0 + 2.;
6378  res12 = cheb12[0] * amom0 + cheb12[1] * amom1;
6379  res24 = cheb24[0] * amom0 + cheb24[1] * amom1;
6380  for (k = 3; k <= 13; ++k) {
6381  amom2 = cc * 2. * amom1 - amom0;
6382  ak22 = (double) ((k - 2) * (k - 2));
6383  if (k / 2 << 1 == k) {
6384  amom2 -= 4. / (ak22 - 1.);
6385  }
6386  res12 += cheb12[k - 1] * amom2;
6387  res24 += cheb24[k - 1] * amom2;
6388  amom0 = amom1;
6389  amom1 = amom2;
6390  /* L30: */
6391  }
6392  for (k = 14; k <= 25; ++k) {
6393  amom2 = cc * 2. * amom1 - amom0;
6394  ak22 = (double) ((k - 2) * (k - 2));
6395  if (k / 2 << 1 == k) {
6396  amom2 -= 4. / (ak22 - 1.);
6397  }
6398  res24 += cheb24[k - 1] * amom2;
6399  amom0 = amom1;
6400  amom1 = amom2;
6401  /* L40: */
6402  }
6403  *result = res24;
6404  *abserr = (d__1 = res24 - res12, fabs(d__1));
6405 L50:
6406  return;
6407 } /* dqc25c_ */
6408 
6409 void dqc25f_(const D_fp& f, const double *a, const double *b, const double
6410  *omega, const long *integr, const long *nrmom, const long *maxp1,
6411  const long *ksave, double *result, double *abserr, long *neval,
6412  double *resabs, double *resasc, long *momcom, double *
6413  chebmo)
6414 {
6415  /* Initialized data */
6416 
6417  double x[11] = { .991444861373810411144557526928563,
6418  .965925826289068286749743199728897,
6419  .923879532511286756128183189396788,
6420  .866025403784438646763723170752936,
6421  .793353340291235164579776961501299,
6422  .707106781186547524400844362104849,
6423  .608761429008720639416097542898164,.5,
6424  .382683432365089771728459984030399,
6425  .258819045102520762348898837624048,
6426  .130526192220051591548406227895489 };
6427 
6428  /* System generated locals */
6429  int chebmo_dim1, chebmo_offset, i__1;
6430  double d__1, d__2;
6431 
6432  /* Local variables */
6433  double d__[25];
6434  long i__, j, k, m=0;
6435  double v[28], d1[25], d2[25], p2, p3, p4, ac, an, as, an2, ass,
6436  par2, conc, asap, par22, fval[25], estc, cons;
6437  long iers;
6438  double ests;
6439  long isym, noeq1;
6440  double cheb12[13], cheb24[25], resc12, resc24, hlgth, centr;
6441  double ress12, ress24, oflow;
6442  long noequ;
6443  double cospar;
6444  double parint, sinpar;
6445 
6446  /* ***begin prologue dqc25f */
6447  /* ***date written 810101 (yymmdd) */
6448  /* ***revision date 830518 (yymmdd) */
6449  /* ***category no. h2a2a2 */
6450  /* ***keywords integration rules for functions with cos or sin */
6451  /* factor, clenshaw-curtis, gauss-kronrod */
6452  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
6453  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
6454  /* ***purpose to compute the integral i=integral of f(x) over (a,b) */
6455  /* where w(x) = cos(omega*x) or w(x)=sin(omega*x) and to */
6456  /* compute j = integral of fabs(f) over (a,b). for small value */
6457  /* of omega or small intervals (a,b) the 15-point gauss-kronro */
6458  /* rule is used. otherwise a generalized clenshaw-curtis */
6459  /* method is used. */
6460  /* ***description */
6461 
6462  /* integration rules for functions with cos or sin factor */
6463  /* standard fortran subroutine */
6464  /* double precision version */
6465 
6466  /* parameters */
6467  /* on entry */
6468  /* f - double precision */
6469  /* function subprogram defining the integrand */
6470  /* function f(x). the actual name for f needs to */
6471  /* be declared e x t e r n a l in the calling program. */
6472 
6473  /* a - double precision */
6474  /* lower limit of integration */
6475 
6476  /* b - double precision */
6477  /* upper limit of integration */
6478 
6479  /* omega - double precision */
6480  /* parameter in the weight function */
6481 
6482  /* integr - long */
6483  /* indicates which weight function is to be used */
6484  /* integr = 1 w(x) = cos(omega*x) */
6485  /* integr = 2 w(x) = sin(omega*x) */
6486 
6487  /* nrmom - long */
6488  /* the length of interval (a,b) is equal to the length */
6489  /* of the original integration interval divided by */
6490  /* 2**nrmom (we suppose that the routine is used in an */
6491  /* adaptive integration process, otherwise set */
6492  /* nrmom = 0). nrmom must be zero at the first call. */
6493 
6494  /* maxp1 - long */
6495  /* gives an upper bound on the number of chebyshev */
6496  /* moments which can be stored, i.e. for the */
6497  /* intervals of lengths fabs(bb-aa)*2**(-l), */
6498  /* l = 0,1,2, ..., maxp1-2. */
6499 
6500  /* ksave - long */
6501  /* key which is one when the moments for the */
6502  /* current interval have been computed */
6503 
6504  /* on return */
6505  /* result - double precision */
6506  /* approximation to the integral i */
6507 
6508  /* abserr - double precision */
6509  /* estimate of the modulus of the absolute */
6510  /* error, which should equal or exceed fabs(i-result) */
6511 
6512  /* neval - long */
6513  /* number of integrand evaluations */
6514 
6515  /* resabs - double precision */
6516  /* approximation to the integral j */
6517 
6518  /* resasc - double precision */
6519  /* approximation to the integral of fabs(f-i/(b-a)) */
6520 
6521  /* on entry and return */
6522  /* momcom - long */
6523  /* for each interval length we need to compute the */
6524  /* chebyshev moments. momcom counts the number of */
6525  /* intervals for which these moments have already been */
6526  /* computed. if nrmom.lt.momcom or ksave = 1, the */
6527  /* chebyshev moments for the interval (a,b) have */
6528  /* already been computed and stored, otherwise we */
6529  /* compute them and we increase momcom. */
6530 
6531  /* chebmo - double precision */
6532  /* array of dimension at least (maxp1,25) containing */
6533  /* the modified chebyshev moments for the first momcom */
6534  /* momcom interval lengths */
6535 
6536  /* ...................................................................... */
6537  /* ***references (none) */
6538  /* ***routines called d1mach,dgtsl,dqcheb,dqk15w,dqwgtf */
6539  /* ***end prologue dqc25f */
6540 
6541 
6542 
6543 
6544  /* the vector x contains the values cos(k*pi/24) */
6545  /* k = 1, ...,11, to be used for the chebyshev expansion of f */
6546 
6547  /* Parameter adjustments */
6548  chebmo_dim1 = *maxp1;
6549  chebmo_offset = 1 + chebmo_dim1;
6550  chebmo -= chebmo_offset;
6551 
6552  /* Function Body */
6553 
6554  /* list of major variables */
6555  /* ----------------------- */
6556 
6557  /* centr - mid point of the integration interval */
6558  /* hlgth - half-length of the integration interval */
6559  /* fval - value of the function f at the points */
6560  /* (b-a)*0.5*cos(k*pi/12) + (b+a)*0.5, k = 0, ..., 24 */
6561  /* cheb12 - coefficients of the chebyshev series expansion */
6562  /* of degree 12, for the function f, in the */
6563  /* interval (a,b) */
6564  /* cheb24 - coefficients of the chebyshev series expansion */
6565  /* of degree 24, for the function f, in the */
6566  /* interval (a,b) */
6567  /* resc12 - approximation to the integral of */
6568  /* cos(0.5*(b-a)*omega*x)*f(0.5*(b-a)*x+0.5*(b+a)) */
6569  /* over (-1,+1), using the chebyshev series */
6570  /* expansion of degree 12 */
6571  /* resc24 - approximation to the same integral, using the */
6572  /* chebyshev series expansion of degree 24 */
6573  /* ress12 - the analogue of resc12 for the sine */
6574  /* ress24 - the analogue of resc24 for the sine */
6575 
6576 
6577  /* machine dependent constant */
6578  /* -------------------------- */
6579 
6580  /* oflow is the largest positive magnitude. */
6581 
6582  /* ***first executable statement dqc25f */
6583  oflow = d1mach(c__2);
6584 
6585  centr = (*b + *a) * .5;
6586  hlgth = (*b - *a) * .5;
6587  parint = *omega * hlgth;
6588 
6589  /* compute the integral using the 15-point gauss-kronrod */
6590  /* formula if the value of the parameter in the integrand */
6591  /* is small. */
6592 
6593  if (fabs(parint) > 2.) {
6594  goto L10;
6595  }
6596  dqk15w_(f, dqwgtf_, omega, &p2, &p3, &p4, integr, a, b,
6597  result, abserr, resabs, resasc);
6598  *neval = 15;
6599  goto L170;
6600 
6601  /* compute the integral using the generalized clenshaw- */
6602  /* curtis method. */
6603 
6604 L10:
6605  conc = hlgth * cos(centr * *omega);
6606  cons = hlgth * sin(centr * *omega);
6607  *resasc = oflow;
6608  *neval = 25;
6609 
6610  /* check whether the chebyshev moments for this interval */
6611  /* have already been computed. */
6612 
6613  if (*nrmom < *momcom || *ksave == 1) {
6614  goto L120;
6615  }
6616 
6617  /* compute a new set of chebyshev moments. */
6618 
6619  m = *momcom + 1;
6620  par2 = parint * parint;
6621  par22 = par2 + 2.;
6622  sinpar = sin(parint);
6623  cospar = cos(parint);
6624 
6625  /* compute the chebyshev moments with respect to cosine. */
6626 
6627  v[0] = sinpar * 2. / parint;
6628  v[1] = (cospar * 8. + (par2 + par2 - 8.) * sinpar / parint) / par2;
6629  v[2] = ((par2 - 12.) * 32. * cospar + ((par2 - 80.) * par2 + 192.) * 2. *
6630  sinpar / parint) / (par2 * par2);
6631  ac = cospar * 8.;
6632  as = parint * 24. * sinpar;
6633  if (fabs(parint) > 24.) {
6634  goto L30;
6635  }
6636 
6637  /* compute the chebyshev moments as the solutions of a */
6638  /* boundary value problem with 1 initial value (v(3)) and 1 */
6639  /* end value (computed using an asymptotic formula). */
6640 
6641  noequ = 25;
6642  noeq1 = noequ - 1;
6643  an = 6.;
6644  i__1 = noeq1;
6645  for (k = 1; k <= i__1; ++k) {
6646  an2 = an * an;
6647  d__[k - 1] = (an2 - 4.) * -2. * (par22 - an2 - an2);
6648  d2[k - 1] = (an - 1.) * (an - 2.) * par2;
6649  d1[k] = (an + 3.) * (an + 4.) * par2;
6650  v[k + 2] = as - (an2 - 4.) * ac;
6651  an += 2.;
6652  /* L20: */
6653  }
6654  an2 = an * an;
6655  d__[noequ - 1] = (an2 - 4.) * -2. * (par22 - an2 - an2);
6656  v[noequ + 2] = as - (an2 - 4.) * ac;
6657  v[3] -= par2 * 56. * v[2];
6658  ass = parint * sinpar;
6659  asap = (((((par2 * 210. - 1.) * cospar - (par2 * 105. - 63.) * ass) / an2
6660  - (1. - par2 * 15.) * cospar + ass * 15.) / an2 - cospar + ass *
6661  3.) / an2 - cospar) / an2;
6662  v[noequ + 2] -= asap * 2. * par2 * (an - 1.) * (an - 2.);
6663 
6664  /* solve the tridiagonal system by means of gaussian */
6665  /* elimination with partial pivoting. */
6666 
6667  /* *** call to dgtsl must be replaced by call to */
6668  /* *** double precision version of linpack routine sgtsl */
6669 
6670  dgtsl_(&noequ, d1, d__, d2, &v[3], &iers);
6671  goto L50;
6672 
6673  /* compute the chebyshev moments by means of forward */
6674  /* recursion. */
6675 
6676 L30:
6677  an = 4.;
6678  for (i__ = 4; i__ <= 13; ++i__) {
6679  an2 = an * an;
6680  v[i__ - 1] = ((an2 - 4.) * ((par22 - an2 - an2) * 2. * v[i__ - 2] -
6681  ac) + as - par2 * (an + 1.) * (an + 2.) * v[i__ - 3]) / (par2
6682  * (an - 1.) * (an - 2.));
6683  an += 2.;
6684  /* L40: */
6685  }
6686 L50:
6687  for (j = 1; j <= 13; ++j) {
6688  chebmo[m + ((j << 1) - 1) * chebmo_dim1] = v[j - 1];
6689  /* L60: */
6690  }
6691 
6692  /* compute the chebyshev moments with respect to sine. */
6693 
6694  v[0] = (sinpar - parint * cospar) * 2. / par2;
6695  v[1] = (18. - 48. / par2) * sinpar / par2 + (48. / par2 - 2.) * cospar /
6696  parint;
6697  ac = parint * -24. * cospar;
6698  as = sinpar * -8.;
6699  if (fabs(parint) > 24.) {
6700  goto L80;
6701  }
6702 
6703  /* compute the chebyshev moments as the solutions of a boundary */
6704  /* value problem with 1 initial value (v(2)) and 1 end value */
6705  /* (computed using an asymptotic formula). */
6706 
6707  an = 5.;
6708  i__1 = noeq1;
6709  for (k = 1; k <= i__1; ++k) {
6710  an2 = an * an;
6711  d__[k - 1] = (an2 - 4.) * -2. * (par22 - an2 - an2);
6712  d2[k - 1] = (an - 1.) * (an - 2.) * par2;
6713  d1[k] = (an + 3.) * (an + 4.) * par2;
6714  v[k + 1] = ac + (an2 - 4.) * as;
6715  an += 2.;
6716  /* L70: */
6717  }
6718  an2 = an * an;
6719  d__[noequ - 1] = (an2 - 4.) * -2. * (par22 - an2 - an2);
6720  v[noequ + 1] = ac + (an2 - 4.) * as;
6721  v[2] -= par2 * 42. * v[1];
6722  ass = parint * cospar;
6723  asap = (((((par2 * 105. - 63.) * ass + (par2 * 210. - 1.) * sinpar) / an2
6724  + (par2 * 15. - 1.) * sinpar - ass * 15.) / an2 - ass * 3. -
6725  sinpar) / an2 - sinpar) / an2;
6726  v[noequ + 1] -= asap * 2. * par2 * (an - 1.) * (an - 2.);
6727 
6728  /* solve the tridiagonal system by means of gaussian */
6729  /* elimination with partial pivoting. */
6730 
6731  /* *** call to dgtsl must be replaced by call to */
6732  /* *** double precision version of linpack routine sgtsl */
6733 
6734  dgtsl_(&noequ, d1, d__, d2, &v[2], &iers);
6735  goto L100;
6736 
6737  /* compute the chebyshev moments by means of forward recursion. */
6738 
6739 L80:
6740  an = 3.;
6741  for (i__ = 3; i__ <= 12; ++i__) {
6742  an2 = an * an;
6743  v[i__ - 1] = ((an2 - 4.) * ((par22 - an2 - an2) * 2. * v[i__ - 2] +
6744  as) + ac - par2 * (an + 1.) * (an + 2.) * v[i__ - 3]) / (par2
6745  * (an - 1.) * (an - 2.));
6746  an += 2.;
6747  /* L90: */
6748  }
6749 L100:
6750  for (j = 1; j <= 12; ++j) {
6751  chebmo[m + (j << 1) * chebmo_dim1] = v[j - 1];
6752  /* L110: */
6753  }
6754 L120:
6755  if (*nrmom < *momcom) {
6756  m = *nrmom + 1;
6757  }
6758  if (*momcom < *maxp1 - 1 && *nrmom >= *momcom) {
6759  ++(*momcom);
6760  }
6761 
6762  /* compute the coefficients of the chebyshev expansions */
6763  /* of degrees 12 and 24 of the function f. */
6764 
6765  d__1 = centr + hlgth;
6766  fval[0] = f(d__1) * .5;
6767  fval[12] = f(centr);
6768  d__1 = centr - hlgth;
6769  fval[24] = f(d__1) * .5;
6770  for (i__ = 2; i__ <= 12; ++i__) {
6771  isym = 26 - i__;
6772  d__1 = hlgth * x[i__ - 2] + centr;
6773  fval[i__ - 1] = f(d__1);
6774  d__1 = centr - hlgth * x[i__ - 2];
6775  fval[isym - 1] = f(d__1);
6776  /* L130: */
6777  }
6778  dqcheb_(x, fval, cheb12, cheb24);
6779 
6780  /* compute the integral and error estimates. */
6781 
6782  resc12 = cheb12[12] * chebmo[m + chebmo_dim1 * 13];
6783  ress12 = 0.;
6784  k = 11;
6785  for (j = 1; j <= 6; ++j) {
6786  resc12 += cheb12[k - 1] * chebmo[m + k * chebmo_dim1];
6787  ress12 += cheb12[k] * chebmo[m + (k + 1) * chebmo_dim1];
6788  k += -2;
6789  /* L140: */
6790  }
6791  resc24 = cheb24[24] * chebmo[m + chebmo_dim1 * 25];
6792  ress24 = 0.;
6793  *resabs = fabs(cheb24[24]);
6794  k = 23;
6795  for (j = 1; j <= 12; ++j) {
6796  resc24 += cheb24[k - 1] * chebmo[m + k * chebmo_dim1];
6797  ress24 += cheb24[k] * chebmo[m + (k + 1) * chebmo_dim1];
6798  *resabs = (d__1 = cheb24[k - 1], fabs(d__1)) + (d__2 = cheb24[k], fabs(
6799  d__2));
6800  k += -2;
6801  /* L150: */
6802  }
6803  estc = (d__1 = resc24 - resc12, fabs(d__1));
6804  ests = (d__1 = ress24 - ress12, fabs(d__1));
6805  *resabs *= fabs(hlgth);
6806  if (*integr == 2) {
6807  goto L160;
6808  }
6809  *result = conc * resc24 - cons * ress24;
6810  *abserr = (d__1 = conc * estc, fabs(d__1)) + (d__2 = cons * ests, fabs(d__2)
6811  );
6812  goto L170;
6813 L160:
6814  *result = conc * ress24 + cons * resc24;
6815  *abserr = (d__1 = conc * ests, fabs(d__1)) + (d__2 = cons * estc, fabs(d__2)
6816  );
6817 L170:
6818  return;
6819 } /* dqc25f_ */
6820 
6821 void dqc25s_(const D_fp& f, const double *a, const double *b,
6822  const double *bl, const double *br, const double *alfa,
6823  const double *beta, const double *ri, const double *rj,
6824  const double *rg, const double *rh,
6825  double *result, double *abserr, double *resasc,
6826  const long *integr, long *nev)
6827 {
6828  /* Initialized data */
6829 
6830  double x[11] = { .991444861373810411144557526928563,
6831  .965925826289068286749743199728897,
6832  .923879532511286756128183189396788,
6833  .866025403784438646763723170752936,
6834  .793353340291235164579776961501299,
6835  .707106781186547524400844362104849,
6836  .608761429008720639416097542898164,.5,
6837  .382683432365089771728459984030399,
6838  .258819045102520762348898837624048,
6839  .130526192220051591548406227895489 };
6840 
6841  /* System generated locals */
6842  double d__1, d__2;
6843 
6844  /* Local variables */
6845  long i__;
6846  double u, dc, fix, fval[25], res12, res24;
6847  long isym;
6848  double cheb12[13], cheb24[25], hlgth, centr;
6849  double factor, resabs;
6850 
6851  /* ***begin prologue dqc25s */
6852  /* ***date written 810101 (yymmdd) */
6853  /* ***revision date 830518 (yymmdd) */
6854  /* ***category no. h2a2a2 */
6855  /* ***keywords 25-point clenshaw-curtis integration */
6856  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
6857  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
6858  /* ***purpose to compute i = integral of f*w over (bl,br), with error */
6859  /* estimate, where the weight function w has a singular */
6860  /* behaviour of algebraico-logarithmic type at the points */
6861  /* a and/or b. (bl,br) is a part of (a,b). */
6862  /* ***description */
6863 
6864  /* integration rules for integrands having algebraico-logarithmic */
6865  /* end point singularities */
6866  /* standard fortran subroutine */
6867  /* double precision version */
6868 
6869  /* parameters */
6870  /* f - double precision */
6871  /* function subprogram defining the integrand */
6872  /* f(x). the actual name for f needs to be declared */
6873  /* e x t e r n a l in the driver program. */
6874 
6875  /* a - double precision */
6876  /* left end point of the original interval */
6877 
6878  /* b - double precision */
6879  /* right end point of the original interval, b.gt.a */
6880 
6881  /* bl - double precision */
6882  /* lower limit of integration, bl.ge.a */
6883 
6884  /* br - double precision */
6885  /* upper limit of integration, br.le.b */
6886 
6887  /* alfa - double precision */
6888  /* parameter in the weight function */
6889 
6890  /* beta - double precision */
6891  /* parameter in the weight function */
6892 
6893  /* ri,rj,rg,rh - double precision */
6894  /* modified chebyshev moments for the application */
6895  /* of the generalized clenshaw-curtis */
6896  /* method (computed in subroutine dqmomo) */
6897 
6898  /* result - double precision */
6899  /* approximation to the integral */
6900  /* result is computed by using a generalized */
6901  /* clenshaw-curtis method if b1 = a or br = b. */
6902  /* in all other cases the 15-point kronrod */
6903  /* rule is applied, obtained by optimal addition of */
6904  /* abscissae to the 7-point gauss rule. */
6905 
6906  /* abserr - double precision */
6907  /* estimate of the modulus of the absolute error, */
6908  /* which should equal or exceed fabs(i-result) */
6909 
6910  /* resasc - double precision */
6911  /* approximation to the integral of fabs(f*w-i/(b-a)) */
6912 
6913  /* integr - long */
6914  /* which determines the weight function */
6915  /* = 1 w(x) = (x-a)**alfa*(b-x)**beta */
6916  /* = 2 w(x) = (x-a)**alfa*(b-x)**beta*log(x-a) */
6917  /* = 3 w(x) = (x-a)**alfa*(b-x)**beta*log(b-x) */
6918  /* = 4 w(x) = (x-a)**alfa*(b-x)**beta*log(x-a)* */
6919  /* log(b-x) */
6920 
6921  /* nev - long */
6922  /* number of integrand evaluations */
6923  /* ***references (none) */
6924  /* ***routines called dqcheb,dqk15w */
6925  /* ***end prologue dqc25s */
6926 
6927 
6928 
6929 
6930  /* the vector x contains the values cos(k*pi/24) */
6931  /* k = 1, ..., 11, to be used for the computation of the */
6932  /* chebyshev series expansion of f. */
6933 
6934  /* Parameter adjustments */
6935  --rh;
6936  --rg;
6937  --rj;
6938  --ri;
6939 
6940  /* Function Body */
6941 
6942  /* list of major variables */
6943  /* ----------------------- */
6944 
6945  /* fval - value of the function f at the points */
6946  /* (br-bl)*0.5*cos(k*pi/24)+(br+bl)*0.5 */
6947  /* k = 0, ..., 24 */
6948  /* cheb12 - coefficients of the chebyshev series expansion */
6949  /* of degree 12, for the function f, in the */
6950  /* interval (bl,br) */
6951  /* cheb24 - coefficients of the chebyshev series expansion */
6952  /* of degree 24, for the function f, in the */
6953  /* interval (bl,br) */
6954  /* res12 - approximation to the integral obtained from cheb12 */
6955  /* res24 - approximation to the integral obtained from cheb24 */
6956  /* dqwgts - external function subprogram defining */
6957  /* the four possible weight functions */
6958  /* hlgth - half-length of the interval (bl,br) */
6959  /* centr - mid point of the interval (bl,br) */
6960 
6961  /* ***first executable statement dqc25s */
6962  *nev = 25;
6963  if (*bl == *a && (*alfa != 0. || *integr == 2 || *integr == 4)) {
6964  goto L10;
6965  }
6966  if (*br == *b && (*beta != 0. || *integr == 3 || *integr == 4)) {
6967  goto L140;
6968  }
6969 
6970  /* if a.gt.bl and b.lt.br, apply the 15-point gauss-kronrod */
6971  /* scheme. */
6972 
6973 
6974  dqk15w_(f, dqwgts_, a, b, alfa, beta, integr, bl, br, result,
6975  abserr, &resabs, resasc);
6976  *nev = 15;
6977  goto L270;
6978 
6979  /* this part of the program is executed only if a = bl. */
6980  /* ---------------------------------------------------- */
6981 
6982  /* compute the chebyshev series expansion of the */
6983  /* following function */
6984  /* f1 = (0.5*(b+b-br-a)-0.5*(br-a)*x)**beta */
6985  /* *f(0.5*(br-a)*x+0.5*(br+a)) */
6986 
6987 L10:
6988  hlgth = (*br - *bl) * .5;
6989  centr = (*br + *bl) * .5;
6990  fix = *b - centr;
6991  d__1 = hlgth + centr;
6992  d__2 = fix - hlgth;
6993  fval[0] = f(d__1) * .5 * pow(d__2, *beta);
6994  fval[12] = f(centr) * pow(fix, *beta);
6995  d__1 = centr - hlgth;
6996  d__2 = fix + hlgth;
6997  fval[24] = f(d__1) * .5 * pow(d__2, *beta);
6998  for (i__ = 2; i__ <= 12; ++i__) {
6999  u = hlgth * x[i__ - 2];
7000  isym = 26 - i__;
7001  d__1 = u + centr;
7002  d__2 = fix - u;
7003  fval[i__ - 1] = f(d__1) * pow(d__2, *beta);
7004  d__1 = centr - u;
7005  d__2 = fix + u;
7006  fval[isym - 1] = f(d__1) * pow(d__2, *beta);
7007  /* L20: */
7008  }
7009  d__1 = *alfa + 1.;
7010  factor = pow(hlgth, d__1);
7011  *result = 0.;
7012  *abserr = 0.;
7013  res12 = 0.;
7014  res24 = 0.;
7015  if (*integr > 2) {
7016  goto L70;
7017  }
7018  dqcheb_(x, fval, cheb12, cheb24);
7019 
7020  /* integr = 1 (or 2) */
7021 
7022  for (i__ = 1; i__ <= 13; ++i__) {
7023  res12 += cheb12[i__ - 1] * ri[i__];
7024  res24 += cheb24[i__ - 1] * ri[i__];
7025  /* L30: */
7026  }
7027  for (i__ = 14; i__ <= 25; ++i__) {
7028  res24 += cheb24[i__ - 1] * ri[i__];
7029  /* L40: */
7030  }
7031  if (*integr == 1) {
7032  goto L130;
7033  }
7034 
7035  /* integr = 2 */
7036 
7037  dc = log(*br - *bl);
7038  *result = res24 * dc;
7039  *abserr = (d__1 = (res24 - res12) * dc, fabs(d__1));
7040  res12 = 0.;
7041  res24 = 0.;
7042  for (i__ = 1; i__ <= 13; ++i__) {
7043  res12 += cheb12[i__ - 1] * rg[i__];
7044  res24 = res12 + cheb24[i__ - 1] * rg[i__];
7045  /* L50: */
7046  }
7047  for (i__ = 14; i__ <= 25; ++i__) {
7048  res24 += cheb24[i__ - 1] * rg[i__];
7049  /* L60: */
7050  }
7051  goto L130;
7052 
7053  /* compute the chebyshev series expansion of the */
7054  /* following function */
7055  /* f4 = f1*log(0.5*(b+b-br-a)-0.5*(br-a)*x) */
7056 
7057 L70:
7058  fval[0] *= log(fix - hlgth);
7059  fval[12] *= log(fix);
7060  fval[24] *= log(fix + hlgth);
7061  for (i__ = 2; i__ <= 12; ++i__) {
7062  u = hlgth * x[i__ - 2];
7063  isym = 26 - i__;
7064  fval[i__ - 1] *= log(fix - u);
7065  fval[isym - 1] *= log(fix + u);
7066  /* L80: */
7067  }
7068  dqcheb_(x, fval, cheb12, cheb24);
7069 
7070  /* integr = 3 (or 4) */
7071 
7072  for (i__ = 1; i__ <= 13; ++i__) {
7073  res12 += cheb12[i__ - 1] * ri[i__];
7074  res24 += cheb24[i__ - 1] * ri[i__];
7075  /* L90: */
7076  }
7077  for (i__ = 14; i__ <= 25; ++i__) {
7078  res24 += cheb24[i__ - 1] * ri[i__];
7079  /* L100: */
7080  }
7081  if (*integr == 3) {
7082  goto L130;
7083  }
7084 
7085  /* integr = 4 */
7086 
7087  dc = log(*br - *bl);
7088  *result = res24 * dc;
7089  *abserr = (d__1 = (res24 - res12) * dc, fabs(d__1));
7090  res12 = 0.;
7091  res24 = 0.;
7092  for (i__ = 1; i__ <= 13; ++i__) {
7093  res12 += cheb12[i__ - 1] * rg[i__];
7094  res24 += cheb24[i__ - 1] * rg[i__];
7095  /* L110: */
7096  }
7097  for (i__ = 14; i__ <= 25; ++i__) {
7098  res24 += cheb24[i__ - 1] * rg[i__];
7099  /* L120: */
7100  }
7101 L130:
7102  *result = (*result + res24) * factor;
7103  *abserr = (*abserr + (d__1 = res24 - res12, fabs(d__1))) * factor;
7104  goto L270;
7105 
7106  /* this part of the program is executed only if b = br. */
7107  /* ---------------------------------------------------- */
7108 
7109  /* compute the chebyshev series expansion of the */
7110  /* following function */
7111  /* f2 = (0.5*(b+bl-a-a)+0.5*(b-bl)*x)**alfa */
7112  /* *f(0.5*(b-bl)*x+0.5*(b+bl)) */
7113 
7114 L140:
7115  hlgth = (*br - *bl) * .5;
7116  centr = (*br + *bl) * .5;
7117  fix = centr - *a;
7118  d__1 = hlgth + centr;
7119  d__2 = fix + hlgth;
7120  fval[0] = f(d__1) * .5 * pow(d__2, *alfa);
7121  fval[12] = f(centr) * pow(fix, *alfa);
7122  d__1 = centr - hlgth;
7123  d__2 = fix - hlgth;
7124  fval[24] = f(d__1) * .5 * pow(d__2, *alfa);
7125  for (i__ = 2; i__ <= 12; ++i__) {
7126  u = hlgth * x[i__ - 2];
7127  isym = 26 - i__;
7128  d__1 = u + centr;
7129  d__2 = fix + u;
7130  fval[i__ - 1] = f(d__1) * pow(d__2, *alfa);
7131  d__1 = centr - u;
7132  d__2 = fix - u;
7133  fval[isym - 1] = f(d__1) * pow(d__2, *alfa);
7134  /* L150: */
7135  }
7136  d__1 = *beta + 1.;
7137  factor = pow(hlgth, d__1);
7138  *result = 0.;
7139  *abserr = 0.;
7140  res12 = 0.;
7141  res24 = 0.;
7142  if (*integr == 2 || *integr == 4) {
7143  goto L200;
7144  }
7145 
7146  /* integr = 1 (or 3) */
7147 
7148  dqcheb_(x, fval, cheb12, cheb24);
7149  for (i__ = 1; i__ <= 13; ++i__) {
7150  res12 += cheb12[i__ - 1] * rj[i__];
7151  res24 += cheb24[i__ - 1] * rj[i__];
7152  /* L160: */
7153  }
7154  for (i__ = 14; i__ <= 25; ++i__) {
7155  res24 += cheb24[i__ - 1] * rj[i__];
7156  /* L170: */
7157  }
7158  if (*integr == 1) {
7159  goto L260;
7160  }
7161 
7162  /* integr = 3 */
7163 
7164  dc = log(*br - *bl);
7165  *result = res24 * dc;
7166  *abserr = (d__1 = (res24 - res12) * dc, fabs(d__1));
7167  res12 = 0.;
7168  res24 = 0.;
7169  for (i__ = 1; i__ <= 13; ++i__) {
7170  res12 += cheb12[i__ - 1] * rh[i__];
7171  res24 += cheb24[i__ - 1] * rh[i__];
7172  /* L180: */
7173  }
7174  for (i__ = 14; i__ <= 25; ++i__) {
7175  res24 += cheb24[i__ - 1] * rh[i__];
7176  /* L190: */
7177  }
7178  goto L260;
7179 
7180  /* compute the chebyshev series expansion of the */
7181  /* following function */
7182  /* f3 = f2*log(0.5*(b-bl)*x+0.5*(b+bl-a-a)) */
7183 
7184 L200:
7185  fval[0] *= log(hlgth + fix);
7186  fval[12] *= log(fix);
7187  fval[24] *= log(fix - hlgth);
7188  for (i__ = 2; i__ <= 12; ++i__) {
7189  u = hlgth * x[i__ - 2];
7190  isym = 26 - i__;
7191  fval[i__ - 1] *= log(u + fix);
7192  fval[isym - 1] *= log(fix - u);
7193  /* L210: */
7194  }
7195  dqcheb_(x, fval, cheb12, cheb24);
7196 
7197  /* integr = 2 (or 4) */
7198 
7199  for (i__ = 1; i__ <= 13; ++i__) {
7200  res12 += cheb12[i__ - 1] * rj[i__];
7201  res24 += cheb24[i__ - 1] * rj[i__];
7202  /* L220: */
7203  }
7204  for (i__ = 14; i__ <= 25; ++i__) {
7205  res24 += cheb24[i__ - 1] * rj[i__];
7206  /* L230: */
7207  }
7208  if (*integr == 2) {
7209  goto L260;
7210  }
7211  dc = log(*br - *bl);
7212  *result = res24 * dc;
7213  *abserr = (d__1 = (res24 - res12) * dc, fabs(d__1));
7214  res12 = 0.;
7215  res24 = 0.;
7216 
7217  /* integr = 4 */
7218 
7219  for (i__ = 1; i__ <= 13; ++i__) {
7220  res12 += cheb12[i__ - 1] * rh[i__];
7221  res24 += cheb24[i__ - 1] * rh[i__];
7222  /* L240: */
7223  }
7224  for (i__ = 14; i__ <= 25; ++i__) {
7225  res24 += cheb24[i__ - 1] * rh[i__];
7226  /* L250: */
7227  }
7228 L260:
7229  *result = (*result + res24) * factor;
7230  *abserr = (*abserr + (d__1 = res24 - res12, fabs(d__1))) * factor;
7231 L270:
7232  return;
7233 } /* dqc25s_ */
7234 
7235 void dqcheb_(const double *x, double *fval, double *cheb12, double *cheb24)
7236 {
7237  long i__, j;
7238  double v[12], alam, alam1, alam2, part1, part2, part3;
7239 
7240  /* ***begin prologue dqcheb */
7241  /* ***refer to dqc25c,dqc25f,dqc25s */
7242  /* ***routines called (none) */
7243  /* ***revision date 830518 (yymmdd) */
7244  /* ***keywords chebyshev series expansion, fast fourier transform */
7245  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
7246  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
7247  /* ***purpose this routine computes the chebyshev series expansion */
7248  /* of degrees 12 and 24 of a function using a */
7249  /* fast fourier transform method */
7250  /* f(x) = sum(k=1,..,13) (cheb12(k)*t(k-1,x)), */
7251  /* f(x) = sum(k=1,..,25) (cheb24(k)*t(k-1,x)), */
7252  /* where t(k,x) is the chebyshev polynomial of degree k. */
7253  /* ***description */
7254 
7255  /* chebyshev series expansion */
7256  /* standard fortran subroutine */
7257  /* double precision version */
7258 
7259  /* parameters */
7260  /* on entry */
7261  /* x - double precision */
7262  /* vector of dimension 11 containing the */
7263  /* values cos(k*pi/24), k = 1, ..., 11 */
7264 
7265  /* fval - double precision */
7266  /* vector of dimension 25 containing the */
7267  /* function values at the points */
7268  /* (b+a+(b-a)*cos(k*pi/24))/2, k = 0, ...,24, */
7269  /* where (a,b) is the approximation interval. */
7270  /* fval(1) and fval(25) are divided by two */
7271  /* (these values are destroyed at output). */
7272 
7273  /* on return */
7274  /* cheb12 - double precision */
7275  /* vector of dimension 13 containing the */
7276  /* chebyshev coefficients for degree 12 */
7277 
7278  /* cheb24 - double precision */
7279  /* vector of dimension 25 containing the */
7280  /* chebyshev coefficients for degree 24 */
7281 
7282  /* ***end prologue dqcheb */
7283 
7284 
7285 
7286  /* ***first executable statement dqcheb */
7287  /* Parameter adjustments */
7288  --cheb24;
7289  --cheb12;
7290  --fval;
7291  --x;
7292 
7293  /* Function Body */
7294  for (i__ = 1; i__ <= 12; ++i__) {
7295  j = 26 - i__;
7296  v[i__ - 1] = fval[i__] - fval[j];
7297  fval[i__] += fval[j];
7298  /* L10: */
7299  }
7300  alam1 = v[0] - v[8];
7301  alam2 = x[6] * (v[2] - v[6] - v[10]);
7302  cheb12[4] = alam1 + alam2;
7303  cheb12[10] = alam1 - alam2;
7304  alam1 = v[1] - v[7] - v[9];
7305  alam2 = v[3] - v[5] - v[11];
7306  alam = x[3] * alam1 + x[9] * alam2;
7307  cheb24[4] = cheb12[4] + alam;
7308  cheb24[22] = cheb12[4] - alam;
7309  alam = x[9] * alam1 - x[3] * alam2;
7310  cheb24[10] = cheb12[10] + alam;
7311  cheb24[16] = cheb12[10] - alam;
7312  part1 = x[4] * v[4];
7313  part2 = x[8] * v[8];
7314  part3 = x[6] * v[6];
7315  alam1 = v[0] + part1 + part2;
7316  alam2 = x[2] * v[2] + part3 + x[10] * v[10];
7317  cheb12[2] = alam1 + alam2;
7318  cheb12[12] = alam1 - alam2;
7319  alam = x[1] * v[1] + x[3] * v[3] + x[5] * v[5] + x[7] * v[7] + x[9] * v[9]
7320  + x[11] * v[11];
7321  cheb24[2] = cheb12[2] + alam;
7322  cheb24[24] = cheb12[2] - alam;
7323  alam = x[11] * v[1] - x[9] * v[3] + x[7] * v[5] - x[5] * v[7] + x[3] * v[
7324  9] - x[1] * v[11];
7325  cheb24[12] = cheb12[12] + alam;
7326  cheb24[14] = cheb12[12] - alam;
7327  alam1 = v[0] - part1 + part2;
7328  alam2 = x[10] * v[2] - part3 + x[2] * v[10];
7329  cheb12[6] = alam1 + alam2;
7330  cheb12[8] = alam1 - alam2;
7331  alam = x[5] * v[1] - x[9] * v[3] - x[1] * v[5] - x[11] * v[7] + x[3] * v[
7332  9] + x[7] * v[11];
7333  cheb24[6] = cheb12[6] + alam;
7334  cheb24[20] = cheb12[6] - alam;
7335  alam = x[7] * v[1] - x[3] * v[3] - x[11] * v[5] + x[1] * v[7] - x[9] * v[
7336  9] - x[5] * v[11];
7337  cheb24[8] = cheb12[8] + alam;
7338  cheb24[18] = cheb12[8] - alam;
7339  for (i__ = 1; i__ <= 6; ++i__) {
7340  j = 14 - i__;
7341  v[i__ - 1] = fval[i__] - fval[j];
7342  fval[i__] += fval[j];
7343  /* L20: */
7344  }
7345  alam1 = v[0] + x[8] * v[4];
7346  alam2 = x[4] * v[2];
7347  cheb12[3] = alam1 + alam2;
7348  cheb12[11] = alam1 - alam2;
7349  cheb12[7] = v[0] - v[4];
7350  alam = x[2] * v[1] + x[6] * v[3] + x[10] * v[5];
7351  cheb24[3] = cheb12[3] + alam;
7352  cheb24[23] = cheb12[3] - alam;
7353  alam = x[6] * (v[1] - v[3] - v[5]);
7354  cheb24[7] = cheb12[7] + alam;
7355  cheb24[19] = cheb12[7] - alam;
7356  alam = x[10] * v[1] - x[6] * v[3] + x[2] * v[5];
7357  cheb24[11] = cheb12[11] + alam;
7358  cheb24[15] = cheb12[11] - alam;
7359  for (i__ = 1; i__ <= 3; ++i__) {
7360  j = 8 - i__;
7361  v[i__ - 1] = fval[i__] - fval[j];
7362  fval[i__] += fval[j];
7363  /* L30: */
7364  }
7365  cheb12[5] = v[0] + x[8] * v[2];
7366  cheb12[9] = fval[1] - x[8] * fval[3];
7367  alam = x[4] * v[1];
7368  cheb24[5] = cheb12[5] + alam;
7369  cheb24[21] = cheb12[5] - alam;
7370  alam = x[8] * fval[2] - fval[4];
7371  cheb24[9] = cheb12[9] + alam;
7372  cheb24[17] = cheb12[9] - alam;
7373  cheb12[1] = fval[1] + fval[3];
7374  alam = fval[2] + fval[4];
7375  cheb24[1] = cheb12[1] + alam;
7376  cheb24[25] = cheb12[1] - alam;
7377  cheb12[13] = v[0] - v[2];
7378  cheb24[13] = cheb12[13];
7379  alam = .16666666666666666;
7380  for (i__ = 2; i__ <= 12; ++i__) {
7381  cheb12[i__] *= alam;
7382  /* L40: */
7383  }
7384  alam *= .5;
7385  cheb12[1] *= alam;
7386  cheb12[13] *= alam;
7387  for (i__ = 2; i__ <= 24; ++i__) {
7388  cheb24[i__] *= alam;
7389  /* L50: */
7390  }
7391  cheb24[1] = alam * .5 * cheb24[1];
7392  cheb24[25] = alam * .5 * cheb24[25];
7393  return;
7394 } /* dqcheb_ */
7395 
7396 void dqelg_(long *n, double *epstab, double *result,
7397  double *abserr, double *res3la, long *nres)
7398 {
7399  /* System generated locals */
7400  int i__1;
7401  double d__1, d__2, d__3;
7402 
7403  /* Local variables */
7404  long i__;
7405  double e0, e1, e2, e3;
7406  long k1, k2, k3, ib, ie;
7407  double ss;
7408  long ib2;
7409  double res;
7410  long num;
7411  double err1, err2, err3, tol1, tol2, tol3;
7412  long indx;
7413  double e1abs, oflow, error;
7414  double delta1, delta2, delta3, epmach, epsinf;
7415  long newelm, limexp;
7416 
7417  /* ***begin prologue dqelg */
7418  /* ***refer to dqagie,dqagoe,dqagpe,dqagse */
7419  /* ***routines called d1mach */
7420  /* ***revision date 830518 (yymmdd) */
7421  /* ***keywords epsilon algorithm, convergence acceleration, */
7422  /* extrapolation */
7423  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
7424  /* de doncker,elise,appl. math & progr. div. - k.u.leuven */
7425  /* ***purpose the routine determines the limit of a given sequence of */
7426  /* approximations, by means of the epsilon algorithm of */
7427  /* p.wynn. an estimate of the absolute error is also given. */
7428  /* the condensed epsilon table is computed. only those */
7429  /* elements needed for the computation of the next diagonal */
7430  /* are preserved. */
7431  /* ***description */
7432 
7433  /* epsilon algorithm */
7434  /* standard fortran subroutine */
7435  /* double precision version */
7436 
7437  /* parameters */
7438  /* n - long */
7439  /* epstab(n) contains the new element in the */
7440  /* first column of the epsilon table. */
7441 
7442  /* epstab - double precision */
7443  /* vector of dimension 52 containing the elements */
7444  /* of the two lower diagonals of the triangular */
7445  /* epsilon table. the elements are numbered */
7446  /* starting at the right-hand corner of the */
7447  /* triangle. */
7448 
7449  /* result - double precision */
7450  /* resulting approximation to the integral */
7451 
7452  /* abserr - double precision */
7453  /* estimate of the absolute error computed from */
7454  /* result and the 3 previous results */
7455 
7456  /* res3la - double precision */
7457  /* vector of dimension 3 containing the last 3 */
7458  /* results */
7459 
7460  /* nres - long */
7461  /* number of calls to the routine */
7462  /* (should be zero at first call) */
7463 
7464  /* ***end prologue dqelg */
7465 
7466 
7467  /* list of major variables */
7468  /* ----------------------- */
7469 
7470  /* e0 - the 4 elements on which the computation of a new */
7471  /* e1 element in the epsilon table is based */
7472  /* e2 */
7473  /* e3 e0 */
7474  /* e3 e1 new */
7475  /* e2 */
7476  /* newelm - number of elements to be computed in the new */
7477  /* diagonal */
7478  /* error - error = fabs(e1-e0)+fabs(e2-e1)+fabs(new-e2) */
7479  /* result - the element in the new diagonal with least value */
7480  /* of error */
7481 
7482  /* machine dependent constants */
7483  /* --------------------------- */
7484 
7485  /* epmach is the largest relative spacing. */
7486  /* oflow is the largest positive magnitude. */
7487  /* limexp is the maximum number of elements the epsilon */
7488  /* table can contain. if this number is reached, the upper */
7489  /* diagonal of the epsilon table is deleted. */
7490 
7491  /* ***first executable statement dqelg */
7492  /* Parameter adjustments */
7493  --res3la;
7494  --epstab;
7495 
7496  /* Function Body */
7497  epmach = d1mach(c__4);
7498  oflow = d1mach(c__2);
7499  ++(*nres);
7500  *abserr = oflow;
7501  *result = epstab[*n];
7502  if (*n < 3) {
7503  goto L100;
7504  }
7505  limexp = 50;
7506  epstab[*n + 2] = epstab[*n];
7507  newelm = (*n - 1) / 2;
7508  epstab[*n] = oflow;
7509  num = *n;
7510  k1 = *n;
7511  i__1 = newelm;
7512  for (i__ = 1; i__ <= i__1; ++i__) {
7513  k2 = k1 - 1;
7514  k3 = k1 - 2;
7515  res = epstab[k1 + 2];
7516  e0 = epstab[k3];
7517  e1 = epstab[k2];
7518  e2 = res;
7519  e1abs = fabs(e1);
7520  delta2 = e2 - e1;
7521  err2 = fabs(delta2);
7522  /* Computing MAX */
7523  d__1 = fabs(e2);
7524  tol2 = max(d__1,e1abs) * epmach;
7525  delta3 = e1 - e0;
7526  err3 = fabs(delta3);
7527  /* Computing MAX */
7528  d__1 = e1abs, d__2 = fabs(e0);
7529  tol3 = max(d__1,d__2) * epmach;
7530  if (err2 > tol2 || err3 > tol3) {
7531  goto L10;
7532  }
7533 
7534  /* if e0, e1 and e2 are equal to within machine */
7535  /* accuracy, convergence is assumed. */
7536  /* result = e2 */
7537  /* abserr = fabs(e1-e0)+fabs(e2-e1) */
7538 
7539  *result = res;
7540  *abserr = err2 + err3;
7541  /* ***jump out of do-loop */
7542  goto L100;
7543  L10:
7544  e3 = epstab[k1];
7545  epstab[k1] = e1;
7546  delta1 = e1 - e3;
7547  err1 = fabs(delta1);
7548  /* Computing MAX */
7549  d__1 = e1abs, d__2 = fabs(e3);
7550  tol1 = max(d__1,d__2) * epmach;
7551 
7552  /* if two elements are very close to each other, omit */
7553  /* a part of the table by adjusting the value of n */
7554 
7555  if (err1 <= tol1 || err2 <= tol2 || err3 <= tol3) {
7556  goto L20;
7557  }
7558  ss = 1. / delta1 + 1. / delta2 - 1. / delta3;
7559  epsinf = (d__1 = ss * e1, fabs(d__1));
7560 
7561  /* test to detect irregular behaviour in the table, and */
7562  /* eventually omit a part of the table adjusting the value */
7563  /* of n. */
7564 
7565  if (epsinf > 1e-4) {
7566  goto L30;
7567  }
7568  L20:
7569  *n = i__ + i__ - 1;
7570  /* ***jump out of do-loop */
7571  goto L50;
7572 
7573  /* compute a new element and eventually adjust */
7574  /* the value of result. */
7575 
7576  L30:
7577  res = e1 + 1. / ss;
7578  epstab[k1] = res;
7579  k1 += -2;
7580  error = err2 + (d__1 = res - e2, fabs(d__1)) + err3;
7581  if (error > *abserr) {
7582  goto L40;
7583  }
7584  *abserr = error;
7585  *result = res;
7586  L40:
7587  ;
7588  }
7589 
7590  /* shift the table. */
7591 
7592 L50:
7593  if (*n == limexp) {
7594  *n = (limexp / 2 << 1) - 1;
7595  }
7596  ib = 1;
7597  if (num / 2 << 1 == num) {
7598  ib = 2;
7599  }
7600  ie = newelm + 1;
7601  i__1 = ie;
7602  for (i__ = 1; i__ <= i__1; ++i__) {
7603  ib2 = ib + 2;
7604  epstab[ib] = epstab[ib2];
7605  ib = ib2;
7606  /* L60: */
7607  }
7608  if (num == *n) {
7609  goto L80;
7610  }
7611  indx = num - *n + 1;
7612  i__1 = *n;
7613  for (i__ = 1; i__ <= i__1; ++i__) {
7614  epstab[i__] = epstab[indx];
7615  ++indx;
7616  /* L70: */
7617  }
7618 L80:
7619  if (*nres >= 4) {
7620  goto L90;
7621  }
7622  res3la[*nres] = *result;
7623  *abserr = oflow;
7624  goto L100;
7625 
7626  /* compute error estimate */
7627 
7628 L90:
7629  *abserr = (d__1 = *result - res3la[3], fabs(d__1)) + (d__2 = *result -
7630  res3la[2], fabs(d__2)) + (d__3 = *result - res3la[1], fabs(d__3));
7631  res3la[1] = res3la[2];
7632  res3la[2] = res3la[3];
7633  res3la[3] = *result;
7634 L100:
7635  /* Computing MAX */
7636  d__1 = *abserr, d__2 = epmach * 5. * fabs(*result);
7637  *abserr = max(d__1,d__2);
7638  return;
7639 } /* dqelg_ */
7640 
7641 void dqk15_(const D_fp& f, const double *a, const double *b, double *
7642  result, double *abserr, double *resabs, double *resasc)
7643 {
7644  /* Initialized data */
7645 
7646  double wg[4] = { .129484966168869693270611432679082,
7647  .27970539148927666790146777142378,
7648  .381830050505118944950369775488975,
7649  .417959183673469387755102040816327 };
7650  double xgk[8] = { .991455371120812639206854697526329,
7651  .949107912342758524526189684047851,
7652  .864864423359769072789712788640926,
7653  .741531185599394439863864773280788,
7654  .58608723546769113029414483825873,
7655  .405845151377397166906606412076961,
7656  .207784955007898467600689403773245,0. };
7657  double wgk[8] = { .02293532201052922496373200805897,
7658  .063092092629978553290700663189204,
7659  .104790010322250183839876322541518,
7660  .140653259715525918745189590510238,
7661  .16900472663926790282658342659855,
7662  .190350578064785409913256402421014,
7663  .204432940075298892414161999234649,
7664  .209482141084727828012999174891714 };
7665 
7666  /* System generated locals */
7667  double d__1, d__2, d__3;
7668 
7669  /* Local variables */
7670  long j;
7671  double fc, fv1[7], fv2[7];
7672  long jtw;
7673  double absc, resg, resk, fsum, fval1, fval2;
7674  long jtwm1;
7675  double hlgth, centr, reskh, uflow;
7676  double epmach, dhlgth;
7677 
7678  /* ***begin prologue dqk15 */
7679  /* ***date written 800101 (yymmdd) */
7680  /* ***revision date 830518 (yymmdd) */
7681  /* ***category no. h2a1a2 */
7682  /* ***keywords 15-point gauss-kronrod rules */
7683  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
7684  /* de doncker,elise,appl. math. & progr. div - k.u.leuven */
7685  /* ***purpose to compute i = integral of f over (a,b), with error */
7686  /* estimate */
7687  /* j = integral of fabs(f) over (a,b) */
7688  /* ***description */
7689 
7690  /* integration rules */
7691  /* standard fortran subroutine */
7692  /* double precision version */
7693 
7694  /* parameters */
7695  /* on entry */
7696  /* f - double precision */
7697  /* function subprogram defining the integrand */
7698  /* function f(x). the actual name for f needs to be */
7699  /* declared e x t e r n a l in the calling program. */
7700 
7701  /* a - double precision */
7702  /* lower limit of integration */
7703 
7704  /* b - double precision */
7705  /* upper limit of integration */
7706 
7707  /* on return */
7708  /* result - double precision */
7709  /* approximation to the integral i */
7710  /* result is computed by applying the 15-polong */
7711  /* kronrod rule (resk) obtained by optimal addition */
7712  /* of abscissae to the7-point gauss rule(resg). */
7713 
7714  /* abserr - double precision */
7715  /* estimate of the modulus of the absolute error, */
7716  /* which should not exceed fabs(i-result) */
7717 
7718  /* resabs - double precision */
7719  /* approximation to the integral j */
7720 
7721  /* resasc - double precision */
7722  /* approximation to the integral of fabs(f-i/(b-a)) */
7723  /* over (a,b) */
7724 
7725  /* ***references (none) */
7726  /* ***routines called d1mach */
7727  /* ***end prologue dqk15 */
7728 
7729 
7730 
7731  /* the abscissae and weights are given for the interval (-1,1). */
7732  /* because of symmetry only the positive abscissae and their */
7733  /* corresponding weights are given. */
7734 
7735  /* xgk - abscissae of the 15-point kronrod rule */
7736  /* xgk(2), xgk(4), ... abscissae of the 7-polong */
7737  /* gauss rule */
7738  /* xgk(1), xgk(3), ... abscissae which are optimally */
7739  /* added to the 7-point gauss rule */
7740 
7741  /* wgk - weights of the 15-point kronrod rule */
7742 
7743  /* wg - weights of the 7-point gauss rule */
7744 
7745 
7746  /* gauss quadrature weights and kronron quadrature abscissae and weights */
7747  /* as evaluated with 80 decimal digit arithmetic by l. w. fullerton, */
7748  /* bell labs, nov. 1981. */
7749 
7750 
7751 
7752 
7753 
7754  /* list of major variables */
7755  /* ----------------------- */
7756 
7757  /* centr - mid point of the interval */
7758  /* hlgth - half-length of the interval */
7759  /* absc - abscissa */
7760  /* fval* - function value */
7761  /* resg - result of the 7-point gauss formula */
7762  /* resk - result of the 15-point kronrod formula */
7763  /* reskh - approximation to the mean value of f over (a,b), */
7764  /* i.e. to i/(b-a) */
7765 
7766  /* machine dependent constants */
7767  /* --------------------------- */
7768 
7769  /* epmach is the largest relative spacing. */
7770  /* uflow is the smallest positive magnitude. */
7771 
7772  /* ***first executable statement dqk15 */
7773  epmach = d1mach(c__4);
7774  uflow = d1mach(c__1);
7775 
7776  centr = (*a + *b) * .5;
7777  hlgth = (*b - *a) * .5;
7778  dhlgth = fabs(hlgth);
7779 
7780  /* compute the 15-point kronrod approximation to */
7781  /* the integral, and estimate the absolute error. */
7782 
7783  fc = f(centr);
7784  resg = fc * wg[3];
7785  resk = fc * wgk[7];
7786  *resabs = fabs(resk);
7787  for (j = 1; j <= 3; ++j) {
7788  jtw = j << 1;
7789  absc = hlgth * xgk[jtw - 1];
7790  d__1 = centr - absc;
7791  fval1 = f(d__1);
7792  d__1 = centr + absc;
7793  fval2 = f(d__1);
7794  fv1[jtw - 1] = fval1;
7795  fv2[jtw - 1] = fval2;
7796  fsum = fval1 + fval2;
7797  resg += wg[j - 1] * fsum;
7798  resk += wgk[jtw - 1] * fsum;
7799  *resabs += wgk[jtw - 1] * (fabs(fval1) + fabs(fval2));
7800  /* L10: */
7801  }
7802  for (j = 1; j <= 4; ++j) {
7803  jtwm1 = (j << 1) - 1;
7804  absc = hlgth * xgk[jtwm1 - 1];
7805  d__1 = centr - absc;
7806  fval1 = f(d__1);
7807  d__1 = centr + absc;
7808  fval2 = f(d__1);
7809  fv1[jtwm1 - 1] = fval1;
7810  fv2[jtwm1 - 1] = fval2;
7811  fsum = fval1 + fval2;
7812  resk += wgk[jtwm1 - 1] * fsum;
7813  *resabs += wgk[jtwm1 - 1] * (fabs(fval1) + fabs(fval2));
7814  /* L15: */
7815  }
7816  reskh = resk * .5;
7817  *resasc = wgk[7] * (d__1 = fc - reskh, fabs(d__1));
7818  for (j = 1; j <= 7; ++j) {
7819  *resasc += wgk[j - 1] * ((d__1 = fv1[j - 1] - reskh, fabs(d__1)) + (
7820  d__2 = fv2[j - 1] - reskh, fabs(d__2)));
7821  /* L20: */
7822  }
7823  *result = resk * hlgth;
7824  *resabs *= dhlgth;
7825  *resasc *= dhlgth;
7826  *abserr = (d__1 = (resk - resg) * hlgth, fabs(d__1));
7827  if (*resasc != 0. && *abserr != 0.) {
7828  /* Computing MIN */
7829  d__3 = *abserr * 200. / *resasc;
7830  d__1 = 1., d__2 = pow(d__3, c_b270);
7831  *abserr = *resasc * min(d__1,d__2);
7832  }
7833  if (*resabs > uflow / (epmach * 50.)) {
7834  /* Computing MAX */
7835  d__1 = epmach * 50. * *resabs;
7836  *abserr = max(d__1,*abserr);
7837  }
7838  return;
7839 } /* dqk15_ */
7840 
7841 void dqk15i_(const D_fp& f, const double *boun, const long *inf,
7842  const double *a, const double *b, double *result, double *abserr,
7843  double *resabs, double *resasc)
7844 {
7845  /* Initialized data */
7846 
7847  double wg[8] = { 0.,.129484966168869693270611432679082,0.,
7848  .27970539148927666790146777142378,0.,
7849  .381830050505118944950369775488975,0.,
7850  .417959183673469387755102040816327 };
7851  double xgk[8] = { .991455371120812639206854697526329,
7852  .949107912342758524526189684047851,
7853  .864864423359769072789712788640926,
7854  .741531185599394439863864773280788,
7855  .58608723546769113029414483825873,
7856  .405845151377397166906606412076961,
7857  .207784955007898467600689403773245,0. };
7858  double wgk[8] = { .02293532201052922496373200805897,
7859  .063092092629978553290700663189204,
7860  .104790010322250183839876322541518,
7861  .140653259715525918745189590510238,
7862  .16900472663926790282658342659855,
7863  .190350578064785409913256402421014,
7864  .204432940075298892414161999234649,
7865  .209482141084727828012999174891714 };
7866 
7867  /* System generated locals */
7868  double d__1, d__2, d__3;
7869 
7870  /* Local variables */
7871  long j;
7872  double fc, fv1[7], fv2[7], absc, dinf, resg, resk, fsum, absc1,
7873  absc2, fval1, fval2, hlgth, centr, reskh, uflow;
7874  double tabsc1, tabsc2, epmach;
7875 
7876  /* ***begin prologue dqk15i */
7877  /* ***date written 800101 (yymmdd) */
7878  /* ***revision date 830518 (yymmdd) */
7879  /* ***category no. h2a3a2,h2a4a2 */
7880  /* ***keywords 15-point transformed gauss-kronrod rules */
7881  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
7882  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
7883  /* ***purpose the original (infinite integration range is mapped */
7884  /* onto the interval (0,1) and (a,b) is a part of (0,1). */
7885  /* it is the purpose to compute */
7886  /* i = integral of transformed integrand over (a,b), */
7887  /* j = integral of fabs(transformed integrand) over (a,b). */
7888  /* ***description */
7889 
7890  /* integration rule */
7891  /* standard fortran subroutine */
7892  /* double precision version */
7893 
7894  /* parameters */
7895  /* on entry */
7896  /* f - double precision */
7897  /* fuction subprogram defining the integrand */
7898  /* function f(x). the actual name for f needs to be */
7899  /* declared e x t e r n a l in the calling program. */
7900 
7901  /* boun - double precision */
7902  /* finite bound of original integration */
7903  /* range (set to zero if inf = +2) */
7904 
7905  /* inf - long */
7906  /* if inf = -1, the original interval is */
7907  /* (-infinity,bound), */
7908  /* if inf = +1, the original interval is */
7909  /* (bound,+infinity), */
7910  /* if inf = +2, the original interval is */
7911  /* (-infinity,+infinity) and */
7912  /* the integral is computed as the sum of two */
7913  /* integrals, one over (-infinity,0) and one over */
7914  /* (0,+infinity). */
7915 
7916  /* a - double precision */
7917  /* lower limit for integration over subrange */
7918  /* of (0,1) */
7919 
7920  /* b - double precision */
7921  /* upper limit for integration over subrange */
7922  /* of (0,1) */
7923 
7924  /* on return */
7925  /* result - double precision */
7926  /* approximation to the integral i */
7927  /* result is computed by applying the 15-polong */
7928  /* kronrod rule(resk) obtained by optimal addition */
7929  /* of abscissae to the 7-point gauss rule(resg). */
7930 
7931  /* abserr - double precision */
7932  /* estimate of the modulus of the absolute error, */
7933  /* which should equal or exceed fabs(i-result) */
7934 
7935  /* resabs - double precision */
7936  /* approximation to the integral j */
7937 
7938  /* resasc - double precision */
7939  /* approximation to the integral of */
7940  /* fabs((transformed integrand)-i/(b-a)) over (a,b) */
7941 
7942  /* ***references (none) */
7943  /* ***routines called d1mach */
7944  /* ***end prologue dqk15i */
7945 
7946 
7947 
7948  /* the abscissae and weights are supplied for the interval */
7949  /* (-1,1). because of symmetry only the positive abscissae and */
7950  /* their corresponding weights are given. */
7951 
7952  /* xgk - abscissae of the 15-point kronrod rule */
7953  /* xgk(2), xgk(4), ... abscissae of the 7-polong */
7954  /* gauss rule */
7955  /* xgk(1), xgk(3), ... abscissae which are optimally */
7956  /* added to the 7-point gauss rule */
7957 
7958  /* wgk - weights of the 15-point kronrod rule */
7959 
7960  /* wg - weights of the 7-point gauss rule, corresponding */
7961  /* to the abscissae xgk(2), xgk(4), ... */
7962  /* wg(1), wg(3), ... are set to zero. */
7963 
7964 
7965 
7966 
7967 
7968  /* list of major variables */
7969  /* ----------------------- */
7970 
7971  /* centr - mid point of the interval */
7972  /* hlgth - half-length of the interval */
7973  /* absc* - abscissa */
7974  /* tabsc* - transformed abscissa */
7975  /* fval* - function value */
7976  /* resg - result of the 7-point gauss formula */
7977  /* resk - result of the 15-point kronrod formula */
7978  /* reskh - approximation to the mean value of the transformed */
7979  /* integrand over (a,b), i.e. to i/(b-a) */
7980 
7981  /* machine dependent constants */
7982  /* --------------------------- */
7983 
7984  /* epmach is the largest relative spacing. */
7985  /* uflow is the smallest positive magnitude. */
7986 
7987  /* ***first executable statement dqk15i */
7988  epmach = d1mach(c__4);
7989  uflow = d1mach(c__1);
7990  dinf = (double) min(1,*inf);
7991 
7992  centr = (*a + *b) * .5;
7993  hlgth = (*b - *a) * .5;
7994  tabsc1 = *boun + dinf * (1. - centr) / centr;
7995  fval1 = f(tabsc1);
7996  if (*inf == 2) {
7997  d__1 = -tabsc1;
7998  fval1 += f(d__1);
7999  }
8000  fc = fval1 / centr / centr;
8001 
8002  /* compute the 15-point kronrod approximation to */
8003  /* the integral, and estimate the error. */
8004 
8005  resg = wg[7] * fc;
8006  resk = wgk[7] * fc;
8007  *resabs = fabs(resk);
8008  for (j = 1; j <= 7; ++j) {
8009  absc = hlgth * xgk[j - 1];
8010  absc1 = centr - absc;
8011  absc2 = centr + absc;
8012  tabsc1 = *boun + dinf * (1. - absc1) / absc1;
8013  tabsc2 = *boun + dinf * (1. - absc2) / absc2;
8014  fval1 = f(tabsc1);
8015  fval2 = f(tabsc2);
8016  if (*inf == 2) {
8017  d__1 = -tabsc1;
8018  fval1 += f(d__1);
8019  }
8020  if (*inf == 2) {
8021  d__1 = -tabsc2;
8022  fval2 += f(d__1);
8023  }
8024  fval1 = fval1 / absc1 / absc1;
8025  fval2 = fval2 / absc2 / absc2;
8026  fv1[j - 1] = fval1;
8027  fv2[j - 1] = fval2;
8028  fsum = fval1 + fval2;
8029  resg += wg[j - 1] * fsum;
8030  resk += wgk[j - 1] * fsum;
8031  *resabs += wgk[j - 1] * (fabs(fval1) + fabs(fval2));
8032  /* L10: */
8033  }
8034  reskh = resk * .5;
8035  *resasc = wgk[7] * (d__1 = fc - reskh, fabs(d__1));
8036  for (j = 1; j <= 7; ++j) {
8037  *resasc += wgk[j - 1] * ((d__1 = fv1[j - 1] - reskh, fabs(d__1)) + (
8038  d__2 = fv2[j - 1] - reskh, fabs(d__2)));
8039  /* L20: */
8040  }
8041  *result = resk * hlgth;
8042  *resasc *= hlgth;
8043  *resabs *= hlgth;
8044  *abserr = (d__1 = (resk - resg) * hlgth, fabs(d__1));
8045  if (*resasc != 0. && *abserr != 0.) {
8046  /* Computing MIN */
8047  d__3 = *abserr * 200. / *resasc;
8048  d__1 = 1., d__2 = pow(d__3, c_b270);
8049  *abserr = *resasc * min(d__1,d__2);
8050  }
8051  if (*resabs > uflow / (epmach * 50.)) {
8052  /* Computing MAX */
8053  d__1 = epmach * 50. * *resabs;
8054  *abserr = max(d__1,*abserr);
8055  }
8056  return;
8057 } /* dqk15i_ */
8058 
8059 void dqk15w_(const D_fp& f, D_fp1 w, const double *p1, const double *p2,
8060  const double *p3, const double *p4, const long *kp,
8061  const double *a, const double *b,
8062  double *result, double *abserr, double *resabs, double *resasc)
8063 {
8064  /* Initialized data */
8065 
8066  double xgk[8] = { .9914553711208126,.9491079123427585,
8067  .8648644233597691,.7415311855993944,.5860872354676911,
8068  .4058451513773972,.2077849550078985,0. };
8069  double wgk[8] = { .02293532201052922,.06309209262997855,
8070  .1047900103222502,.1406532597155259,.1690047266392679,
8071  .1903505780647854,.2044329400752989,.2094821410847278 };
8072  double wg[4] = { .1294849661688697,.2797053914892767,
8073  .3818300505051889,.4179591836734694 };
8074 
8075  /* System generated locals */
8076  double d__1, d__2, d__3;
8077 
8078  /* Local variables */
8079  long j;
8080  double fc, fv1[7], fv2[7];
8081  long jtw;
8082  double absc, resg, resk, fsum, absc1, absc2, fval1, fval2;
8083  long jtwm1;
8084  double hlgth, centr, reskh, uflow;
8085  double epmach, dhlgth;
8086 
8087  /* ***begin prologue dqk15w */
8088  /* ***date written 810101 (yymmdd) */
8089  /* ***revision date 830518 (mmddyy) */
8090  /* ***category no. h2a2a2 */
8091  /* ***keywords 15-point gauss-kronrod rules */
8092  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
8093  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
8094  /* ***purpose to compute i = integral of f*w over (a,b), with error */
8095  /* estimate */
8096  /* j = integral of fabs(f*w) over (a,b) */
8097  /* ***description */
8098 
8099  /* integration rules */
8100  /* standard fortran subroutine */
8101  /* double precision version */
8102 
8103  /* parameters */
8104  /* on entry */
8105  /* f - double precision */
8106  /* function subprogram defining the integrand */
8107  /* function f(x). the actual name for f needs to be */
8108  /* declared e x t e r n a l in the driver program. */
8109 
8110  /* w - double precision */
8111  /* function subprogram defining the integrand */
8112  /* weight function w(x). the actual name for w */
8113  /* needs to be declared e x t e r n a l in the */
8114  /* calling program. */
8115 
8116  /* p1, p2, p3, p4 - double precision */
8117  /* parameters in the weight function */
8118 
8119  /* kp - long */
8120  /* key for indicating the type of weight function */
8121 
8122  /* a - double precision */
8123  /* lower limit of integration */
8124 
8125  /* b - double precision */
8126  /* upper limit of integration */
8127 
8128  /* on return */
8129  /* result - double precision */
8130  /* approximation to the integral i */
8131  /* result is computed by applying the 15-polong */
8132  /* kronrod rule (resk) obtained by optimal addition */
8133  /* of abscissae to the 7-point gauss rule (resg). */
8134 
8135  /* abserr - double precision */
8136  /* estimate of the modulus of the absolute error, */
8137  /* which should equal or exceed fabs(i-result) */
8138 
8139  /* resabs - double precision */
8140  /* approximation to the integral of fabs(f) */
8141 
8142  /* resasc - double precision */
8143  /* approximation to the integral of fabs(f-i/(b-a)) */
8144 
8145 
8146  /* ***references (none) */
8147  /* ***routines called d1mach */
8148  /* ***end prologue dqk15w */
8149 
8150 
8151 
8152  /* the abscissae and weights are given for the interval (-1,1). */
8153  /* because of symmetry only the positive abscissae and their */
8154  /* corresponding weights are given. */
8155 
8156  /* xgk - abscissae of the 15-point gauss-kronrod rule */
8157  /* xgk(2), xgk(4), ... abscissae of the 7-polong */
8158  /* gauss rule */
8159  /* xgk(1), xgk(3), ... abscissae which are optimally */
8160  /* added to the 7-point gauss rule */
8161 
8162  /* wgk - weights of the 15-point gauss-kronrod rule */
8163 
8164  /* wg - weights of the 7-point gauss rule */
8165 
8166 
8167 
8168 
8169 
8170  /* list of major variables */
8171  /* ----------------------- */
8172 
8173  /* centr - mid point of the interval */
8174  /* hlgth - half-length of the interval */
8175  /* absc* - abscissa */
8176  /* fval* - function value */
8177  /* resg - result of the 7-point gauss formula */
8178  /* resk - result of the 15-point kronrod formula */
8179  /* reskh - approximation to the mean value of f*w over (a,b), */
8180  /* i.e. to i/(b-a) */
8181 
8182  /* machine dependent constants */
8183  /* --------------------------- */
8184 
8185  /* epmach is the largest relative spacing. */
8186  /* uflow is the smallest positive magnitude. */
8187 
8188  /* ***first executable statement dqk15w */
8189  epmach = d1mach(c__4);
8190  uflow = d1mach(c__1);
8191 
8192  centr = (*a + *b) * .5;
8193  hlgth = (*b - *a) * .5;
8194  dhlgth = fabs(hlgth);
8195 
8196  /* compute the 15-point kronrod approximation to the */
8197  /* integral, and estimate the error. */
8198 
8199  fc = f(centr) * w(&centr, p1, p2, p3, p4, kp);
8200  resg = wg[3] * fc;
8201  resk = wgk[7] * fc;
8202  *resabs = fabs(resk);
8203  for (j = 1; j <= 3; ++j) {
8204  jtw = j << 1;
8205  absc = hlgth * xgk[jtw - 1];
8206  absc1 = centr - absc;
8207  absc2 = centr + absc;
8208  fval1 = f(absc1) * w(&absc1, p1, p2, p3, p4, kp);
8209  fval2 = f(absc2) * w(&absc2, p1, p2, p3, p4, kp);
8210  fv1[jtw - 1] = fval1;
8211  fv2[jtw - 1] = fval2;
8212  fsum = fval1 + fval2;
8213  resg += wg[j - 1] * fsum;
8214  resk += wgk[jtw - 1] * fsum;
8215  *resabs += wgk[jtw - 1] * (fabs(fval1) + fabs(fval2));
8216  /* L10: */
8217  }
8218  for (j = 1; j <= 4; ++j) {
8219  jtwm1 = (j << 1) - 1;
8220  absc = hlgth * xgk[jtwm1 - 1];
8221  absc1 = centr - absc;
8222  absc2 = centr + absc;
8223  fval1 = f(absc1) * w(&absc1, p1, p2, p3, p4, kp);
8224  fval2 = f(absc2) * w(&absc2, p1, p2, p3, p4, kp);
8225  fv1[jtwm1 - 1] = fval1;
8226  fv2[jtwm1 - 1] = fval2;
8227  fsum = fval1 + fval2;
8228  resk += wgk[jtwm1 - 1] * fsum;
8229  *resabs += wgk[jtwm1 - 1] * (fabs(fval1) + fabs(fval2));
8230  /* L15: */
8231  }
8232  reskh = resk * .5;
8233  *resasc = wgk[7] * (d__1 = fc - reskh, fabs(d__1));
8234  for (j = 1; j <= 7; ++j) {
8235  *resasc += wgk[j - 1] * ((d__1 = fv1[j - 1] - reskh, fabs(d__1)) + (
8236  d__2 = fv2[j - 1] - reskh, fabs(d__2)));
8237  /* L20: */
8238  }
8239  *result = resk * hlgth;
8240  *resabs *= dhlgth;
8241  *resasc *= dhlgth;
8242  *abserr = (d__1 = (resk - resg) * hlgth, fabs(d__1));
8243  if (*resasc != 0. && *abserr != 0.) {
8244  /* Computing MIN */
8245  d__3 = *abserr * 200. / *resasc;
8246  d__1 = 1., d__2 = pow(d__3, c_b270);
8247  *abserr = *resasc * min(d__1,d__2);
8248  }
8249  if (*resabs > uflow / (epmach * 50.)) {
8250  /* Computing MAX */
8251  d__1 = epmach * 50. * *resabs;
8252  *abserr = max(d__1,*abserr);
8253  }
8254  return;
8255 } /* dqk15w_ */
8256 
8257 void dqk21_(const D_fp& f, const double *a, const double *b, double *
8258  result, double *abserr, double *resabs, double *resasc)
8259 {
8260  /* Initialized data */
8261 
8262  double wg[5] = { .066671344308688137593568809893332,
8263  .149451349150580593145776339657697,
8264  .219086362515982043995534934228163,
8265  .269266719309996355091226921569469,
8266  .295524224714752870173892994651338 };
8267  double xgk[11] = { .995657163025808080735527280689003,
8268  .973906528517171720077964012084452,
8269  .930157491355708226001207180059508,
8270  .865063366688984510732096688423493,
8271  .780817726586416897063717578345042,
8272  .679409568299024406234327365114874,
8273  .562757134668604683339000099272694,
8274  .433395394129247190799265943165784,
8275  .294392862701460198131126603103866,
8276  .14887433898163121088482600112972,0. };
8277  double wgk[11] = { .011694638867371874278064396062192,
8278  .03255816230796472747881897245939,
8279  .05475589657435199603138130024458,
8280  .07503967481091995276704314091619,
8281  .093125454583697605535065465083366,
8282  .109387158802297641899210590325805,
8283  .123491976262065851077958109831074,
8284  .134709217311473325928054001771707,
8285  .142775938577060080797094273138717,
8286  .147739104901338491374841515972068,
8287  .149445554002916905664936468389821 };
8288 
8289  /* System generated locals */
8290  double d__1, d__2, d__3;
8291 
8292  /* Local variables */
8293  long j;
8294  double fc, fv1[10], fv2[10];
8295  long jtw;
8296  double absc, resg, resk, fsum, fval1, fval2;
8297  long jtwm1;
8298  double hlgth, centr, reskh, uflow;
8299  double epmach, dhlgth;
8300 
8301  /* ***begin prologue dqk21 */
8302  /* ***date written 800101 (yymmdd) */
8303  /* ***revision date 830518 (yymmdd) */
8304  /* ***category no. h2a1a2 */
8305  /* ***keywords 21-point gauss-kronrod rules */
8306  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
8307  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
8308  /* ***purpose to compute i = integral of f over (a,b), with error */
8309  /* estimate */
8310  /* j = integral of fabs(f) over (a,b) */
8311  /* ***description */
8312 
8313  /* integration rules */
8314  /* standard fortran subroutine */
8315  /* double precision version */
8316 
8317  /* parameters */
8318  /* on entry */
8319  /* f - double precision */
8320  /* function subprogram defining the integrand */
8321  /* function f(x). the actual name for f needs to be */
8322  /* declared e x t e r n a l in the driver program. */
8323 
8324  /* a - double precision */
8325  /* lower limit of integration */
8326 
8327  /* b - double precision */
8328  /* upper limit of integration */
8329 
8330  /* on return */
8331  /* result - double precision */
8332  /* approximation to the integral i */
8333  /* result is computed by applying the 21-polong */
8334  /* kronrod rule (resk) obtained by optimal addition */
8335  /* of abscissae to the 10-point gauss rule (resg). */
8336 
8337  /* abserr - double precision */
8338  /* estimate of the modulus of the absolute error, */
8339  /* which should not exceed fabs(i-result) */
8340 
8341  /* resabs - double precision */
8342  /* approximation to the integral j */
8343 
8344  /* resasc - double precision */
8345  /* approximation to the integral of fabs(f-i/(b-a)) */
8346  /* over (a,b) */
8347 
8348  /* ***references (none) */
8349  /* ***routines called d1mach */
8350  /* ***end prologue dqk21 */
8351 
8352 
8353 
8354  /* the abscissae and weights are given for the interval (-1,1). */
8355  /* because of symmetry only the positive abscissae and their */
8356  /* corresponding weights are given. */
8357 
8358  /* xgk - abscissae of the 21-point kronrod rule */
8359  /* xgk(2), xgk(4), ... abscissae of the 10-polong */
8360  /* gauss rule */
8361  /* xgk(1), xgk(3), ... abscissae which are optimally */
8362  /* added to the 10-point gauss rule */
8363 
8364  /* wgk - weights of the 21-point kronrod rule */
8365 
8366  /* wg - weights of the 10-point gauss rule */
8367 
8368 
8369  /* gauss quadrature weights and kronron quadrature abscissae and weights */
8370  /* as evaluated with 80 decimal digit arithmetic by l. w. fullerton, */
8371  /* bell labs, nov. 1981. */
8372 
8373 
8374 
8375 
8376 
8377  /* list of major variables */
8378  /* ----------------------- */
8379 
8380  /* centr - mid point of the interval */
8381  /* hlgth - half-length of the interval */
8382  /* absc - abscissa */
8383  /* fval* - function value */
8384  /* resg - result of the 10-point gauss formula */
8385  /* resk - result of the 21-point kronrod formula */
8386  /* reskh - approximation to the mean value of f over (a,b), */
8387  /* i.e. to i/(b-a) */
8388 
8389 
8390  /* machine dependent constants */
8391  /* --------------------------- */
8392 
8393  /* epmach is the largest relative spacing. */
8394  /* uflow is the smallest positive magnitude. */
8395 
8396  /* ***first executable statement dqk21 */
8397  epmach = d1mach(c__4);
8398  uflow = d1mach(c__1);
8399 
8400  centr = (*a + *b) * .5;
8401  hlgth = (*b - *a) * .5;
8402  dhlgth = fabs(hlgth);
8403 
8404  /* compute the 21-point kronrod approximation to */
8405  /* the integral, and estimate the absolute error. */
8406 
8407  resg = 0.;
8408  fc = f(centr);
8409  resk = wgk[10] * fc;
8410  *resabs = fabs(resk);
8411  for (j = 1; j <= 5; ++j) {
8412  jtw = j << 1;
8413  absc = hlgth * xgk[jtw - 1];
8414  d__1 = centr - absc;
8415  fval1 = f(d__1);
8416  d__1 = centr + absc;
8417  fval2 = f(d__1);
8418  fv1[jtw - 1] = fval1;
8419  fv2[jtw - 1] = fval2;
8420  fsum = fval1 + fval2;
8421  resg += wg[j - 1] * fsum;
8422  resk += wgk[jtw - 1] * fsum;
8423  *resabs += wgk[jtw - 1] * (fabs(fval1) + fabs(fval2));
8424  /* L10: */
8425  }
8426  for (j = 1; j <= 5; ++j) {
8427  jtwm1 = (j << 1) - 1;
8428  absc = hlgth * xgk[jtwm1 - 1];
8429  d__1 = centr - absc;
8430  fval1 = f(d__1);
8431  d__1 = centr + absc;
8432  fval2 = f(d__1);
8433  fv1[jtwm1 - 1] = fval1;
8434  fv2[jtwm1 - 1] = fval2;
8435  fsum = fval1 + fval2;
8436  resk += wgk[jtwm1 - 1] * fsum;
8437  *resabs += wgk[jtwm1 - 1] * (fabs(fval1) + fabs(fval2));
8438  /* L15: */
8439  }
8440  reskh = resk * .5;
8441  *resasc = wgk[10] * (d__1 = fc - reskh, fabs(d__1));
8442  for (j = 1; j <= 10; ++j) {
8443  *resasc += wgk[j - 1] * ((d__1 = fv1[j - 1] - reskh, fabs(d__1)) + (
8444  d__2 = fv2[j - 1] - reskh, fabs(d__2)));
8445  /* L20: */
8446  }
8447  *result = resk * hlgth;
8448  *resabs *= dhlgth;
8449  *resasc *= dhlgth;
8450  *abserr = (d__1 = (resk - resg) * hlgth, fabs(d__1));
8451  if (*resasc != 0. && *abserr != 0.) {
8452  /* Computing MIN */
8453  d__3 = *abserr * 200. / *resasc;
8454  d__1 = 1., d__2 = pow(d__3, c_b270);
8455  *abserr = *resasc * min(d__1,d__2);
8456  }
8457  if (*resabs > uflow / (epmach * 50.)) {
8458  /* Computing MAX */
8459  d__1 = epmach * 50. * *resabs;
8460  *abserr = max(d__1,*abserr);
8461  }
8462  return;
8463 } /* dqk21_ */
8464 
8465 void dqk31_(const D_fp& f, const double *a, const double *b, double *
8466  result, double *abserr, double *resabs, double *resasc)
8467 {
8468  /* Initialized data */
8469 
8470  double wg[8] = { .030753241996117268354628393577204,
8471  .070366047488108124709267416450667,
8472  .107159220467171935011869546685869,
8473  .139570677926154314447804794511028,
8474  .166269205816993933553200860481209,
8475  .186161000015562211026800561866423,
8476  .198431485327111576456118326443839,
8477  .202578241925561272880620199967519 };
8478  double xgk[16] = { .998002298693397060285172840152271,
8479  .987992518020485428489565718586613,
8480  .967739075679139134257347978784337,
8481  .937273392400705904307758947710209,
8482  .897264532344081900882509656454496,
8483  .848206583410427216200648320774217,
8484  .790418501442465932967649294817947,
8485  .724417731360170047416186054613938,
8486  .650996741297416970533735895313275,
8487  .570972172608538847537226737253911,
8488  .485081863640239680693655740232351,
8489  .394151347077563369897207370981045,
8490  .299180007153168812166780024266389,
8491  .201194093997434522300628303394596,
8492  .101142066918717499027074231447392,0. };
8493  double wgk[16] = { .005377479872923348987792051430128,
8494  .015007947329316122538374763075807,
8495  .025460847326715320186874001019653,
8496  .03534636079137584622203794847836,
8497  .04458975132476487660822729937328,
8498  .05348152469092808726534314723943,
8499  .062009567800670640285139230960803,
8500  .069854121318728258709520077099147,
8501  .076849680757720378894432777482659,
8502  .083080502823133021038289247286104,
8503  .088564443056211770647275443693774,
8504  .093126598170825321225486872747346,
8505  .096642726983623678505179907627589,
8506  .099173598721791959332393173484603,
8507  .10076984552387559504494666261757,
8508  .101330007014791549017374792767493 };
8509 
8510  /* System generated locals */
8511  double d__1, d__2, d__3;
8512 
8513  /* Local variables */
8514  long j;
8515  double fc, fv1[15], fv2[15];
8516  long jtw;
8517  double absc, resg, resk, fsum, fval1, fval2;
8518  long jtwm1;
8519  double hlgth, centr, reskh, uflow;
8520  double epmach, dhlgth;
8521 
8522  /* ***begin prologue dqk31 */
8523  /* ***date written 800101 (yymmdd) */
8524  /* ***revision date 830518 (yymmdd) */
8525  /* ***category no. h2a1a2 */
8526  /* ***keywords 31-point gauss-kronrod rules */
8527  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
8528  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
8529  /* ***purpose to compute i = integral of f over (a,b) with error */
8530  /* estimate */
8531  /* j = integral of fabs(f) over (a,b) */
8532  /* ***description */
8533 
8534  /* integration rules */
8535  /* standard fortran subroutine */
8536  /* double precision version */
8537 
8538  /* parameters */
8539  /* on entry */
8540  /* f - double precision */
8541  /* function subprogram defining the integrand */
8542  /* function f(x). the actual name for f needs to be */
8543  /* declared e x t e r n a l in the calling program. */
8544 
8545  /* a - double precision */
8546  /* lower limit of integration */
8547 
8548  /* b - double precision */
8549  /* upper limit of integration */
8550 
8551  /* on return */
8552  /* result - double precision */
8553  /* approximation to the integral i */
8554  /* result is computed by applying the 31-polong */
8555  /* gauss-kronrod rule (resk), obtained by optimal */
8556  /* addition of abscissae to the 15-point gauss */
8557  /* rule (resg). */
8558 
8559  /* abserr - double precison */
8560  /* estimate of the modulus of the modulus, */
8561  /* which should not exceed fabs(i-result) */
8562 
8563  /* resabs - double precision */
8564  /* approximation to the integral j */
8565 
8566  /* resasc - double precision */
8567  /* approximation to the integral of fabs(f-i/(b-a)) */
8568  /* over (a,b) */
8569 
8570  /* ***references (none) */
8571  /* ***routines called d1mach */
8572  /* ***end prologue dqk31 */
8573 
8574 
8575  /* the abscissae and weights are given for the interval (-1,1). */
8576  /* because of symmetry only the positive abscissae and their */
8577  /* corresponding weights are given. */
8578 
8579  /* xgk - abscissae of the 31-point kronrod rule */
8580  /* xgk(2), xgk(4), ... abscissae of the 15-polong */
8581  /* gauss rule */
8582  /* xgk(1), xgk(3), ... abscissae which are optimally */
8583  /* added to the 15-point gauss rule */
8584 
8585  /* wgk - weights of the 31-point kronrod rule */
8586 
8587  /* wg - weights of the 15-point gauss rule */
8588 
8589 
8590  /* gauss quadrature weights and kronron quadrature abscissae and weights */
8591  /* as evaluated with 80 decimal digit arithmetic by l. w. fullerton, */
8592  /* bell labs, nov. 1981. */
8593 
8594 
8595 
8596 
8597 
8598  /* list of major variables */
8599  /* ----------------------- */
8600  /* centr - mid point of the interval */
8601  /* hlgth - half-length of the interval */
8602  /* absc - abscissa */
8603  /* fval* - function value */
8604  /* resg - result of the 15-point gauss formula */
8605  /* resk - result of the 31-point kronrod formula */
8606  /* reskh - approximation to the mean value of f over (a,b), */
8607  /* i.e. to i/(b-a) */
8608 
8609  /* machine dependent constants */
8610  /* --------------------------- */
8611  /* epmach is the largest relative spacing. */
8612  /* uflow is the smallest positive magnitude. */
8613  /* ***first executable statement dqk31 */
8614  epmach = d1mach(c__4);
8615  uflow = d1mach(c__1);
8616 
8617  centr = (*a + *b) * .5;
8618  hlgth = (*b - *a) * .5;
8619  dhlgth = fabs(hlgth);
8620 
8621  /* compute the 31-point kronrod approximation to */
8622  /* the integral, and estimate the absolute error. */
8623 
8624  fc = f(centr);
8625  resg = wg[7] * fc;
8626  resk = wgk[15] * fc;
8627  *resabs = fabs(resk);
8628  for (j = 1; j <= 7; ++j) {
8629  jtw = j << 1;
8630  absc = hlgth * xgk[jtw - 1];
8631  d__1 = centr - absc;
8632  fval1 = f(d__1);
8633  d__1 = centr + absc;
8634  fval2 = f(d__1);
8635  fv1[jtw - 1] = fval1;
8636  fv2[jtw - 1] = fval2;
8637  fsum = fval1 + fval2;
8638  resg += wg[j - 1] * fsum;
8639  resk += wgk[jtw - 1] * fsum;
8640  *resabs += wgk[jtw - 1] * (fabs(fval1) + fabs(fval2));
8641  /* L10: */
8642  }
8643  for (j = 1; j <= 8; ++j) {
8644  jtwm1 = (j << 1) - 1;
8645  absc = hlgth * xgk[jtwm1 - 1];
8646  d__1 = centr - absc;
8647  fval1 = f(d__1);
8648  d__1 = centr + absc;
8649  fval2 = f(d__1);
8650  fv1[jtwm1 - 1] = fval1;
8651  fv2[jtwm1 - 1] = fval2;
8652  fsum = fval1 + fval2;
8653  resk += wgk[jtwm1 - 1] * fsum;
8654  *resabs += wgk[jtwm1 - 1] * (fabs(fval1) + fabs(fval2));
8655  /* L15: */
8656  }
8657  reskh = resk * .5;
8658  *resasc = wgk[15] * (d__1 = fc - reskh, fabs(d__1));
8659  for (j = 1; j <= 15; ++j) {
8660  *resasc += wgk[j - 1] * ((d__1 = fv1[j - 1] - reskh, fabs(d__1)) + (
8661  d__2 = fv2[j - 1] - reskh, fabs(d__2)));
8662  /* L20: */
8663  }
8664  *result = resk * hlgth;
8665  *resabs *= dhlgth;
8666  *resasc *= dhlgth;
8667  *abserr = (d__1 = (resk - resg) * hlgth, fabs(d__1));
8668  if (*resasc != 0. && *abserr != 0.) {
8669  /* Computing MIN */
8670  d__3 = *abserr * 200. / *resasc;
8671  d__1 = 1., d__2 = pow(d__3, c_b270);
8672  *abserr = *resasc * min(d__1,d__2);
8673  }
8674  if (*resabs > uflow / (epmach * 50.)) {
8675  /* Computing MAX */
8676  d__1 = epmach * 50. * *resabs;
8677  *abserr = max(d__1,*abserr);
8678  }
8679  return;
8680 } /* dqk31_ */
8681 
8682 void dqk41_(const D_fp& f, const double *a, const double *b, double *
8683  result, double *abserr, double *resabs, double *resasc)
8684 {
8685  /* Initialized data */
8686 
8687  double wg[10] = { .017614007139152118311861962351853,
8688  .040601429800386941331039952274932,
8689  .062672048334109063569506535187042,
8690  .083276741576704748724758143222046,
8691  .10193011981724043503675013548035,
8692  .118194531961518417312377377711382,
8693  .131688638449176626898494499748163,
8694  .142096109318382051329298325067165,
8695  .149172986472603746787828737001969,
8696  .152753387130725850698084331955098 };
8697  double xgk[21] = { .998859031588277663838315576545863,
8698  .99312859918509492478612238847132,
8699  .981507877450250259193342994720217,
8700  .963971927277913791267666131197277,
8701  .940822633831754753519982722212443,
8702  .912234428251325905867752441203298,
8703  .878276811252281976077442995113078,
8704  .839116971822218823394529061701521,
8705  .795041428837551198350638833272788,
8706  .746331906460150792614305070355642,
8707  .693237656334751384805490711845932,
8708  .636053680726515025452836696226286,
8709  .575140446819710315342946036586425,
8710  .510867001950827098004364050955251,
8711  .44359317523872510319999221349264,
8712  .373706088715419560672548177024927,
8713  .301627868114913004320555356858592,
8714  .227785851141645078080496195368575,
8715  .152605465240922675505220241022678,
8716  .076526521133497333754640409398838,0. };
8717  double wgk[21] = { .003073583718520531501218293246031,
8718  .008600269855642942198661787950102,
8719  .014626169256971252983787960308868,
8720  .020388373461266523598010231432755,
8721  .025882133604951158834505067096153,
8722  .031287306777032798958543119323801,
8723  .036600169758200798030557240707211,
8724  .041668873327973686263788305936895,
8725  .046434821867497674720231880926108,
8726  .050944573923728691932707670050345,
8727  .055195105348285994744832372419777,
8728  .059111400880639572374967220648594,
8729  .062653237554781168025870122174255,
8730  .065834597133618422111563556969398,
8731  .068648672928521619345623411885368,
8732  .07105442355344406830579036172321,
8733  .073030690332786667495189417658913,
8734  .074582875400499188986581418362488,
8735  .075704497684556674659542775376617,
8736  .076377867672080736705502835038061,
8737  .076600711917999656445049901530102 };
8738 
8739  /* System generated locals */
8740  double d__1, d__2, d__3;
8741 
8742  /* Local variables */
8743  long j;
8744  double fc, fv1[20], fv2[20];
8745  long jtw;
8746  double absc, resg, resk, fsum, fval1, fval2;
8747  long jtwm1;
8748  double hlgth, centr, reskh, uflow;
8749  double epmach, dhlgth;
8750 
8751  /* ***begin prologue dqk41 */
8752  /* ***date written 800101 (yymmdd) */
8753  /* ***revision date 830518 (yymmdd) */
8754  /* ***category no. h2a1a2 */
8755  /* ***keywords 41-point gauss-kronrod rules */
8756  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
8757  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
8758  /* ***purpose to compute i = integral of f over (a,b), with error */
8759  /* estimate */
8760  /* j = integral of fabs(f) over (a,b) */
8761  /* ***description */
8762 
8763  /* integration rules */
8764  /* standard fortran subroutine */
8765  /* double precision version */
8766 
8767  /* parameters */
8768  /* on entry */
8769  /* f - double precision */
8770  /* function subprogram defining the integrand */
8771  /* function f(x). the actual name for f needs to be */
8772  /* declared e x t e r n a l in the calling program. */
8773 
8774  /* a - double precision */
8775  /* lower limit of integration */
8776 
8777  /* b - double precision */
8778  /* upper limit of integration */
8779 
8780  /* on return */
8781  /* result - double precision */
8782  /* approximation to the integral i */
8783  /* result is computed by applying the 41-polong */
8784  /* gauss-kronrod rule (resk) obtained by optimal */
8785  /* addition of abscissae to the 20-point gauss */
8786  /* rule (resg). */
8787 
8788  /* abserr - double precision */
8789  /* estimate of the modulus of the absolute error, */
8790  /* which should not exceed fabs(i-result) */
8791 
8792  /* resabs - double precision */
8793  /* approximation to the integral j */
8794 
8795  /* resasc - double precision */
8796  /* approximation to the integal of fabs(f-i/(b-a)) */
8797  /* over (a,b) */
8798 
8799  /* ***references (none) */
8800  /* ***routines called d1mach */
8801  /* ***end prologue dqk41 */
8802 
8803 
8804 
8805  /* the abscissae and weights are given for the interval (-1,1). */
8806  /* because of symmetry only the positive abscissae and their */
8807  /* corresponding weights are given. */
8808 
8809  /* xgk - abscissae of the 41-point gauss-kronrod rule */
8810  /* xgk(2), xgk(4), ... abscissae of the 20-polong */
8811  /* gauss rule */
8812  /* xgk(1), xgk(3), ... abscissae which are optimally */
8813  /* added to the 20-point gauss rule */
8814 
8815  /* wgk - weights of the 41-point gauss-kronrod rule */
8816 
8817  /* wg - weights of the 20-point gauss rule */
8818 
8819 
8820  /* gauss quadrature weights and kronron quadrature abscissae and weights */
8821  /* as evaluated with 80 decimal digit arithmetic by l. w. fullerton, */
8822  /* bell labs, nov. 1981. */
8823 
8824 
8825 
8826 
8827 
8828  /* list of major variables */
8829  /* ----------------------- */
8830 
8831  /* centr - mid point of the interval */
8832  /* hlgth - half-length of the interval */
8833  /* absc - abscissa */
8834  /* fval* - function value */
8835  /* resg - result of the 20-point gauss formula */
8836  /* resk - result of the 41-point kronrod formula */
8837  /* reskh - approximation to mean value of f over (a,b), i.e. */
8838  /* to i/(b-a) */
8839 
8840  /* machine dependent constants */
8841  /* --------------------------- */
8842 
8843  /* epmach is the largest relative spacing. */
8844  /* uflow is the smallest positive magnitude. */
8845 
8846  /* ***first executable statement dqk41 */
8847  epmach = d1mach(c__4);
8848  uflow = d1mach(c__1);
8849 
8850  centr = (*a + *b) * .5;
8851  hlgth = (*b - *a) * .5;
8852  dhlgth = fabs(hlgth);
8853 
8854  /* compute the 41-point gauss-kronrod approximation to */
8855  /* the integral, and estimate the absolute error. */
8856 
8857  resg = 0.;
8858  fc = f(centr);
8859  resk = wgk[20] * fc;
8860  *resabs = fabs(resk);
8861  for (j = 1; j <= 10; ++j) {
8862  jtw = j << 1;
8863  absc = hlgth * xgk[jtw - 1];
8864  d__1 = centr - absc;
8865  fval1 = f(d__1);
8866  d__1 = centr + absc;
8867  fval2 = f(d__1);
8868  fv1[jtw - 1] = fval1;
8869  fv2[jtw - 1] = fval2;
8870  fsum = fval1 + fval2;
8871  resg += wg[j - 1] * fsum;
8872  resk += wgk[jtw - 1] * fsum;
8873  *resabs += wgk[jtw - 1] * (fabs(fval1) + fabs(fval2));
8874  /* L10: */
8875  }
8876  for (j = 1; j <= 10; ++j) {
8877  jtwm1 = (j << 1) - 1;
8878  absc = hlgth * xgk[jtwm1 - 1];
8879  d__1 = centr - absc;
8880  fval1 = f(d__1);
8881  d__1 = centr + absc;
8882  fval2 = f(d__1);
8883  fv1[jtwm1 - 1] = fval1;
8884  fv2[jtwm1 - 1] = fval2;
8885  fsum = fval1 + fval2;
8886  resk += wgk[jtwm1 - 1] * fsum;
8887  *resabs += wgk[jtwm1 - 1] * (fabs(fval1) + fabs(fval2));
8888  /* L15: */
8889  }
8890  reskh = resk * .5;
8891  *resasc = wgk[20] * (d__1 = fc - reskh, fabs(d__1));
8892  for (j = 1; j <= 20; ++j) {
8893  *resasc += wgk[j - 1] * ((d__1 = fv1[j - 1] - reskh, fabs(d__1)) + (
8894  d__2 = fv2[j - 1] - reskh, fabs(d__2)));
8895  /* L20: */
8896  }
8897  *result = resk * hlgth;
8898  *resabs *= dhlgth;
8899  *resasc *= dhlgth;
8900  *abserr = (d__1 = (resk - resg) * hlgth, fabs(d__1));
8901  if (*resasc != 0. && *abserr != 0.) {
8902  /* Computing MIN */
8903  d__3 = *abserr * 200. / *resasc;
8904  d__1 = 1., d__2 = pow(d__3, c_b270);
8905  *abserr = *resasc * min(d__1,d__2);
8906  }
8907  if (*resabs > uflow / (epmach * 50.)) {
8908  /* Computing MAX */
8909  d__1 = epmach * 50. * *resabs;
8910  *abserr = max(d__1,*abserr);
8911  }
8912  return;
8913 } /* dqk41_ */
8914 
8915 void dqk51_(const D_fp& f, const double *a, const double *b, double *
8916  result, double *abserr, double *resabs, double *resasc)
8917 {
8918  /* Initialized data */
8919 
8920  double wg[13] = { .011393798501026287947902964113235,
8921  .026354986615032137261901815295299,
8922  .040939156701306312655623487711646,
8923  .054904695975835191925936891540473,
8924  .068038333812356917207187185656708,
8925  .080140700335001018013234959669111,
8926  .091028261982963649811497220702892,
8927  .100535949067050644202206890392686,
8928  .108519624474263653116093957050117,
8929  .114858259145711648339325545869556,
8930  .119455763535784772228178126512901,
8931  .122242442990310041688959518945852,
8932  .12317605372671545120390287307905 };
8933  double xgk[26] = { .999262104992609834193457486540341,
8934  .995556969790498097908784946893902,
8935  .988035794534077247637331014577406,
8936  .976663921459517511498315386479594,
8937  .961614986425842512418130033660167,
8938  .942974571228974339414011169658471,
8939  .920747115281701561746346084546331,
8940  .894991997878275368851042006782805,
8941  .86584706529327559544899696958834,
8942  .83344262876083400142102110869357,
8943  .797873797998500059410410904994307,
8944  .759259263037357630577282865204361,
8945  .717766406813084388186654079773298,
8946  .673566368473468364485120633247622,
8947  .626810099010317412788122681624518,
8948  .577662930241222967723689841612654,
8949  .52632528433471918259962377815801,
8950  .473002731445714960522182115009192,
8951  .417885382193037748851814394594572,
8952  .361172305809387837735821730127641,
8953  .303089538931107830167478909980339,
8954  .243866883720988432045190362797452,
8955  .183718939421048892015969888759528,
8956  .122864692610710396387359818808037,
8957  .061544483005685078886546392366797,0. };
8958  double wgk[26] = { .001987383892330315926507851882843,
8959  .005561932135356713758040236901066,
8960  .009473973386174151607207710523655,
8961  .013236229195571674813656405846976,
8962  .016847817709128298231516667536336,
8963  .020435371145882835456568292235939,
8964  .024009945606953216220092489164881,
8965  .027475317587851737802948455517811,
8966  .030792300167387488891109020215229,
8967  .034002130274329337836748795229551,
8968  .03711627148341554356033062536762,
8969  .040083825504032382074839284467076,
8970  .042872845020170049476895792439495,
8971  .04550291304992178890987058475266,
8972  .047982537138836713906392255756915,
8973  .05027767908071567196332525943344,
8974  .052362885806407475864366712137873,
8975  .054251129888545490144543370459876,
8976  .055950811220412317308240686382747,
8977  .057437116361567832853582693939506,
8978  .058689680022394207961974175856788,
8979  .059720340324174059979099291932562,
8980  .060539455376045862945360267517565,
8981  .061128509717053048305859030416293,
8982  .061471189871425316661544131965264,
8983  .061580818067832935078759824240066 };
8984 
8985  /* System generated locals */
8986  double d__1, d__2, d__3;
8987 
8988  /* Local variables */
8989  long j;
8990  double fc, fv1[25], fv2[25];
8991  long jtw;
8992  double absc, resg, resk, fsum, fval1, fval2;
8993  long jtwm1;
8994  double hlgth, centr, reskh, uflow;
8995  double epmach, dhlgth;
8996 
8997  /* ***begin prologue dqk51 */
8998  /* ***date written 800101 (yymmdd) */
8999  /* ***revision date 830518 (yymmdd) */
9000  /* ***category no. h2a1a2 */
9001  /* ***keywords 51-point gauss-kronrod rules */
9002  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
9003  /* de doncker,elise,appl. math & progr. div. - k.u.leuven */
9004  /* ***purpose to compute i = integral of f over (a,b) with error */
9005  /* estimate */
9006  /* j = integral of fabs(f) over (a,b) */
9007  /* ***description */
9008 
9009  /* integration rules */
9010  /* standard fortran subroutine */
9011  /* double precision version */
9012 
9013  /* parameters */
9014  /* on entry */
9015  /* f - double precision */
9016  /* function subroutine defining the integrand */
9017  /* function f(x). the actual name for f needs to be */
9018  /* declared e x t e r n a l in the calling program. */
9019 
9020  /* a - double precision */
9021  /* lower limit of integration */
9022 
9023  /* b - double precision */
9024  /* upper limit of integration */
9025 
9026  /* on return */
9027  /* result - double precision */
9028  /* approximation to the integral i */
9029  /* result is computed by applying the 51-polong */
9030  /* kronrod rule (resk) obtained by optimal addition */
9031  /* of abscissae to the 25-point gauss rule (resg). */
9032 
9033  /* abserr - double precision */
9034  /* estimate of the modulus of the absolute error, */
9035  /* which should not exceed fabs(i-result) */
9036 
9037  /* resabs - double precision */
9038  /* approximation to the integral j */
9039 
9040  /* resasc - double precision */
9041  /* approximation to the integral of fabs(f-i/(b-a)) */
9042  /* over (a,b) */
9043 
9044  /* ***references (none) */
9045  /* ***routines called d1mach */
9046  /* ***end prologue dqk51 */
9047 
9048 
9049 
9050  /* the abscissae and weights are given for the interval (-1,1). */
9051  /* because of symmetry only the positive abscissae and their */
9052  /* corresponding weights are given. */
9053 
9054  /* xgk - abscissae of the 51-point kronrod rule */
9055  /* xgk(2), xgk(4), ... abscissae of the 25-polong */
9056  /* gauss rule */
9057  /* xgk(1), xgk(3), ... abscissae which are optimally */
9058  /* added to the 25-point gauss rule */
9059 
9060  /* wgk - weights of the 51-point kronrod rule */
9061 
9062  /* wg - weights of the 25-point gauss rule */
9063 
9064 
9065  /* gauss quadrature weights and kronron quadrature abscissae and weights */
9066  /* as evaluated with 80 decimal digit arithmetic by l. w. fullerton, */
9067  /* bell labs, nov. 1981. */
9068 
9069 
9070 
9071  /* note: wgk (26) was calculated from the values of wgk(1..25) */
9072 
9073 
9074  /* list of major variables */
9075  /* ----------------------- */
9076 
9077  /* centr - mid point of the interval */
9078  /* hlgth - half-length of the interval */
9079  /* absc - abscissa */
9080  /* fval* - function value */
9081  /* resg - result of the 25-point gauss formula */
9082  /* resk - result of the 51-point kronrod formula */
9083  /* reskh - approximation to the mean value of f over (a,b), */
9084  /* i.e. to i/(b-a) */
9085 
9086  /* machine dependent constants */
9087  /* --------------------------- */
9088 
9089  /* epmach is the largest relative spacing. */
9090  /* uflow is the smallest positive magnitude. */
9091 
9092  /* ***first executable statement dqk51 */
9093  epmach = d1mach(c__4);
9094  uflow = d1mach(c__1);
9095 
9096  centr = (*a + *b) * .5;
9097  hlgth = (*b - *a) * .5;
9098  dhlgth = fabs(hlgth);
9099 
9100  /* compute the 51-point kronrod approximation to */
9101  /* the integral, and estimate the absolute error. */
9102 
9103  fc = f(centr);
9104  resg = wg[12] * fc;
9105  resk = wgk[25] * fc;
9106  *resabs = fabs(resk);
9107  for (j = 1; j <= 12; ++j) {
9108  jtw = j << 1;
9109  absc = hlgth * xgk[jtw - 1];
9110  d__1 = centr - absc;
9111  fval1 = f(d__1);
9112  d__1 = centr + absc;
9113  fval2 = f(d__1);
9114  fv1[jtw - 1] = fval1;
9115  fv2[jtw - 1] = fval2;
9116  fsum = fval1 + fval2;
9117  resg += wg[j - 1] * fsum;
9118  resk += wgk[jtw - 1] * fsum;
9119  *resabs += wgk[jtw - 1] * (fabs(fval1) + fabs(fval2));
9120  /* L10: */
9121  }
9122  for (j = 1; j <= 13; ++j) {
9123  jtwm1 = (j << 1) - 1;
9124  absc = hlgth * xgk[jtwm1 - 1];
9125  d__1 = centr - absc;
9126  fval1 = f(d__1);
9127  d__1 = centr + absc;
9128  fval2 = f(d__1);
9129  fv1[jtwm1 - 1] = fval1;
9130  fv2[jtwm1 - 1] = fval2;
9131  fsum = fval1 + fval2;
9132  resk += wgk[jtwm1 - 1] * fsum;
9133  *resabs += wgk[jtwm1 - 1] * (fabs(fval1) + fabs(fval2));
9134  /* L15: */
9135  }
9136  reskh = resk * .5;
9137  *resasc = wgk[25] * (d__1 = fc - reskh, fabs(d__1));
9138  for (j = 1; j <= 25; ++j) {
9139  *resasc += wgk[j - 1] * ((d__1 = fv1[j - 1] - reskh, fabs(d__1)) + (
9140  d__2 = fv2[j - 1] - reskh, fabs(d__2)));
9141  /* L20: */
9142  }
9143  *result = resk * hlgth;
9144  *resabs *= dhlgth;
9145  *resasc *= dhlgth;
9146  *abserr = (d__1 = (resk - resg) * hlgth, fabs(d__1));
9147  if (*resasc != 0. && *abserr != 0.) {
9148  /* Computing MIN */
9149  d__3 = *abserr * 200. / *resasc;
9150  d__1 = 1., d__2 = pow(d__3, c_b270);
9151  *abserr = *resasc * min(d__1,d__2);
9152  }
9153  if (*resabs > uflow / (epmach * 50.)) {
9154  /* Computing MAX */
9155  d__1 = epmach * 50. * *resabs;
9156  *abserr = max(d__1,*abserr);
9157  }
9158  return;
9159 } /* dqk51_ */
9160 
9161 void dqk61_(const D_fp& f, const double *a, const double *b, double *
9162  result, double *abserr, double *resabs, double *resasc)
9163 {
9164  /* Initialized data */
9165 
9166  double wg[15] = { .007968192496166605615465883474674,
9167  .018466468311090959142302131912047,
9168  .028784707883323369349719179611292,
9169  .038799192569627049596801936446348,
9170  .048402672830594052902938140422808,
9171  .057493156217619066481721689402056,
9172  .065974229882180495128128515115962,
9173  .073755974737705206268243850022191,
9174  .08075589522942021535469493846053,
9175  .086899787201082979802387530715126,
9176  .092122522237786128717632707087619,
9177  .09636873717464425963946862635181,
9178  .099593420586795267062780282103569,
9179  .101762389748405504596428952168554,
9180  .102852652893558840341285636705415 };
9181  double xgk[31] = { .999484410050490637571325895705811,
9182  .996893484074649540271630050918695,
9183  .991630996870404594858628366109486,
9184  .983668123279747209970032581605663,
9185  .973116322501126268374693868423707,
9186  .960021864968307512216871025581798,
9187  .944374444748559979415831324037439,
9188  .926200047429274325879324277080474,
9189  .905573307699907798546522558925958,
9190  .882560535792052681543116462530226,
9191  .857205233546061098958658510658944,
9192  .829565762382768397442898119732502,
9193  .799727835821839083013668942322683,
9194  .767777432104826194917977340974503,
9195  .733790062453226804726171131369528,
9196  .69785049479331579693229238802664,
9197  .660061064126626961370053668149271,
9198  .620526182989242861140477556431189,
9199  .57934523582636169175602493217254,
9200  .536624148142019899264169793311073,
9201  .492480467861778574993693061207709,
9202  .447033769538089176780609900322854,
9203  .400401254830394392535476211542661,
9204  .352704725530878113471037207089374,
9205  .304073202273625077372677107199257,
9206  .254636926167889846439805129817805,
9207  .204525116682309891438957671002025,
9208  .153869913608583546963794672743256,
9209  .102806937966737030147096751318001,
9210  .051471842555317695833025213166723,0. };
9211  double wgk[31] = { .00138901369867700762455159122676,
9212  .003890461127099884051267201844516,
9213  .00663070391593129217331982636975,
9214  .009273279659517763428441146892024,
9215  .011823015253496341742232898853251,
9216  .01436972950704580481245143244358,
9217  .016920889189053272627572289420322,
9218  .019414141193942381173408951050128,
9219  .021828035821609192297167485738339,
9220  .024191162078080601365686370725232,
9221  .026509954882333101610601709335075,
9222  .028754048765041292843978785354334,
9223  .030907257562387762472884252943092,
9224  .032981447057483726031814191016854,
9225  .034979338028060024137499670731468,
9226  .036882364651821229223911065617136,
9227  .038678945624727592950348651532281,
9228  .040374538951535959111995279752468,
9229  .04196981021516424614714754128597,
9230  .043452539701356069316831728117073,
9231  .044814800133162663192355551616723,
9232  .046059238271006988116271735559374,
9233  .047185546569299153945261478181099,
9234  .048185861757087129140779492298305,
9235  .049055434555029778887528165367238,
9236  .049795683427074206357811569379942,
9237  .050405921402782346840893085653585,
9238  .050881795898749606492297473049805,
9239  .051221547849258772170656282604944,
9240  .051426128537459025933862879215781,
9241  .051494729429451567558340433647099 };
9242 
9243  /* System generated locals */
9244  double d__1, d__2, d__3;
9245 
9246  /* Local variables */
9247  long j;
9248  double fc, fv1[30], fv2[30];
9249  long jtw;
9250  double resg, resk, fsum, fval1, fval2;
9251  long jtwm1;
9252  double dabsc, hlgth, centr, reskh, uflow;
9253  double epmach, dhlgth;
9254 
9255  /* ***begin prologue dqk61 */
9256  /* ***date written 800101 (yymmdd) */
9257  /* ***revision date 830518 (yymmdd) */
9258  /* ***category no. h2a1a2 */
9259  /* ***keywords 61-point gauss-kronrod rules */
9260  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
9261  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
9262  /* ***purpose to compute i = integral of f over (a,b) with error */
9263  /* estimate */
9264  /* j = integral of dfabs(f) over (a,b) */
9265  /* ***description */
9266 
9267  /* integration rule */
9268  /* standard fortran subroutine */
9269  /* double precision version */
9270 
9271 
9272  /* parameters */
9273  /* on entry */
9274  /* f - double precision */
9275  /* function subprogram defining the integrand */
9276  /* function f(x). the actual name for f needs to be */
9277  /* declared e x t e r n a l in the calling program. */
9278 
9279  /* a - double precision */
9280  /* lower limit of integration */
9281 
9282  /* b - double precision */
9283  /* upper limit of integration */
9284 
9285  /* on return */
9286  /* result - double precision */
9287  /* approximation to the integral i */
9288  /* result is computed by applying the 61-polong */
9289  /* kronrod rule (resk) obtained by optimal addition of */
9290  /* abscissae to the 30-point gauss rule (resg). */
9291 
9292  /* abserr - double precision */
9293  /* estimate of the modulus of the absolute error, */
9294  /* which should equal or exceed dfabs(i-result) */
9295 
9296  /* resabs - double precision */
9297  /* approximation to the integral j */
9298 
9299  /* resasc - double precision */
9300  /* approximation to the integral of dfabs(f-i/(b-a)) */
9301 
9302 
9303  /* ***references (none) */
9304  /* ***routines called d1mach */
9305  /* ***end prologue dqk61 */
9306 
9307 
9308 
9309  /* the abscissae and weights are given for the */
9310  /* interval (-1,1). because of symmetry only the positive */
9311  /* abscissae and their corresponding weights are given. */
9312 
9313  /* xgk - abscissae of the 61-point kronrod rule */
9314  /* xgk(2), xgk(4) ... abscissae of the 30-polong */
9315  /* gauss rule */
9316  /* xgk(1), xgk(3) ... optimally added abscissae */
9317  /* to the 30-point gauss rule */
9318 
9319  /* wgk - weights of the 61-point kronrod rule */
9320 
9321  /* wg - weigths of the 30-point gauss rule */
9322 
9323 
9324  /* gauss quadrature weights and kronron quadrature abscissae and weights */
9325  /* as evaluated with 80 decimal digit arithmetic by l. w. fullerton, */
9326  /* bell labs, nov. 1981. */
9327 
9328 
9329 
9330 
9331  /* list of major variables */
9332  /* ----------------------- */
9333 
9334  /* centr - mid point of the interval */
9335  /* hlgth - half-length of the interval */
9336  /* dabsc - abscissa */
9337  /* fval* - function value */
9338  /* resg - result of the 30-point gauss rule */
9339  /* resk - result of the 61-point kronrod rule */
9340  /* reskh - approximation to the mean value of f */
9341  /* over (a,b), i.e. to i/(b-a) */
9342 
9343  /* machine dependent constants */
9344  /* --------------------------- */
9345 
9346  /* epmach is the largest relative spacing. */
9347  /* uflow is the smallest positive magnitude. */
9348 
9349  epmach = d1mach(c__4);
9350  uflow = d1mach(c__1);
9351 
9352  centr = (*b + *a) * .5;
9353  hlgth = (*b - *a) * .5;
9354  dhlgth = fabs(hlgth);
9355 
9356  /* compute the 61-point kronrod approximation to the */
9357  /* integral, and estimate the absolute error. */
9358 
9359  /* ***first executable statement dqk61 */
9360  resg = 0.;
9361  fc = f(centr);
9362  resk = wgk[30] * fc;
9363  *resabs = fabs(resk);
9364  for (j = 1; j <= 15; ++j) {
9365  jtw = j << 1;
9366  dabsc = hlgth * xgk[jtw - 1];
9367  d__1 = centr - dabsc;
9368  fval1 = f(d__1);
9369  d__1 = centr + dabsc;
9370  fval2 = f(d__1);
9371  fv1[jtw - 1] = fval1;
9372  fv2[jtw - 1] = fval2;
9373  fsum = fval1 + fval2;
9374  resg += wg[j - 1] * fsum;
9375  resk += wgk[jtw - 1] * fsum;
9376  *resabs += wgk[jtw - 1] * (fabs(fval1) + fabs(fval2));
9377  /* L10: */
9378  }
9379  for (j = 1; j <= 15; ++j) {
9380  jtwm1 = (j << 1) - 1;
9381  dabsc = hlgth * xgk[jtwm1 - 1];
9382  d__1 = centr - dabsc;
9383  fval1 = f(d__1);
9384  d__1 = centr + dabsc;
9385  fval2 = f(d__1);
9386  fv1[jtwm1 - 1] = fval1;
9387  fv2[jtwm1 - 1] = fval2;
9388  fsum = fval1 + fval2;
9389  resk += wgk[jtwm1 - 1] * fsum;
9390  *resabs += wgk[jtwm1 - 1] * (fabs(fval1) + fabs(fval2));
9391  /* L15: */
9392  }
9393  reskh = resk * .5;
9394  *resasc = wgk[30] * (d__1 = fc - reskh, fabs(d__1));
9395  for (j = 1; j <= 30; ++j) {
9396  *resasc += wgk[j - 1] * ((d__1 = fv1[j - 1] - reskh, fabs(d__1)) + (
9397  d__2 = fv2[j - 1] - reskh, fabs(d__2)));
9398  /* L20: */
9399  }
9400  *result = resk * hlgth;
9401  *resabs *= dhlgth;
9402  *resasc *= dhlgth;
9403  *abserr = (d__1 = (resk - resg) * hlgth, fabs(d__1));
9404  if (*resasc != 0. && *abserr != 0.) {
9405  /* Computing MIN */
9406  d__3 = *abserr * 200. / *resasc;
9407  d__1 = 1., d__2 = pow(d__3, c_b270);
9408  *abserr = *resasc * min(d__1,d__2);
9409  }
9410  if (*resabs > uflow / (epmach * 50.)) {
9411  /* Computing MAX */
9412  d__1 = epmach * 50. * *resabs;
9413  *abserr = max(d__1,*abserr);
9414  }
9415  return;
9416 } /* dqk61_ */
9417 
9418 void dqmomo_(const double *alfa, const double *beta, double *
9419  ri, double *rj, double *rg, double *rh, const long *integr)
9420 {
9421  /* Local variables */
9422  long i__;
9423  double an;
9424  long im1;
9425  double anm1, ralf, rbet, alfp1, alfp2, betp1, betp2;
9426 
9427  /* ***begin prologue dqmomo */
9428  /* ***date written 820101 (yymmdd) */
9429  /* ***revision date 830518 (yymmdd) */
9430  /* ***category no. h2a2a1,c3a2 */
9431  /* ***keywords modified chebyshev moments */
9432  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
9433  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
9434  /* ***purpose this routine computes modified chebsyshev moments. the k-th */
9435  /* modified chebyshev moment is defined as the integral over */
9436  /* (-1,1) of w(x)*t(k,x), where t(k,x) is the chebyshev */
9437  /* polynomial of degree k. */
9438  /* ***description */
9439 
9440  /* modified chebyshev moments */
9441  /* standard fortran subroutine */
9442  /* double precision version */
9443 
9444  /* parameters */
9445  /* alfa - double precision */
9446  /* parameter in the weight function w(x), alfa.gt.(-1) */
9447 
9448  /* beta - double precision */
9449  /* parameter in the weight function w(x), beta.gt.(-1) */
9450 
9451  /* ri - double precision */
9452  /* vector of dimension 25 */
9453  /* ri(k) is the integral over (-1,1) of */
9454  /* (1+x)**alfa*t(k-1,x), k = 1, ..., 25. */
9455 
9456  /* rj - double precision */
9457  /* vector of dimension 25 */
9458  /* rj(k) is the integral over (-1,1) of */
9459  /* (1-x)**beta*t(k-1,x), k = 1, ..., 25. */
9460 
9461  /* rg - double precision */
9462  /* vector of dimension 25 */
9463  /* rg(k) is the integral over (-1,1) of */
9464  /* (1+x)**alfa*log((1+x)/2)*t(k-1,x), k = 1, ..., 25. */
9465 
9466  /* rh - double precision */
9467  /* vector of dimension 25 */
9468  /* rh(k) is the integral over (-1,1) of */
9469  /* (1-x)**beta*log((1-x)/2)*t(k-1,x), k = 1, ..., 25. */
9470 
9471  /* integr - long */
9472  /* input parameter indicating the modified */
9473  /* moments to be computed */
9474  /* integr = 1 compute ri, rj */
9475  /* = 2 compute ri, rj, rg */
9476  /* = 3 compute ri, rj, rh */
9477  /* = 4 compute ri, rj, rg, rh */
9478 
9479  /* ***references (none) */
9480  /* ***routines called (none) */
9481  /* ***end prologue dqmomo */
9482 
9483 
9484 
9485 
9486  /* ***first executable statement dqmomo */
9487  /* Parameter adjustments */
9488  --rh;
9489  --rg;
9490  --rj;
9491  --ri;
9492 
9493  /* Function Body */
9494  alfp1 = *alfa + 1.;
9495  betp1 = *beta + 1.;
9496  alfp2 = *alfa + 2.;
9497  betp2 = *beta + 2.;
9498  ralf = pow(c_b320, alfp1);
9499  rbet = pow(c_b320, betp1);
9500 
9501  /* compute ri, rj using a forward recurrence relation. */
9502 
9503  ri[1] = ralf / alfp1;
9504  rj[1] = rbet / betp1;
9505  ri[2] = ri[1] * *alfa / alfp2;
9506  rj[2] = rj[1] * *beta / betp2;
9507  an = 2.;
9508  anm1 = 1.;
9509  for (i__ = 3; i__ <= 25; ++i__) {
9510  ri[i__] = -(ralf + an * (an - alfp2) * ri[i__ - 1]) / (anm1 * (an +
9511  alfp1));
9512  rj[i__] = -(rbet + an * (an - betp2) * rj[i__ - 1]) / (anm1 * (an +
9513  betp1));
9514  anm1 = an;
9515  an += 1.;
9516  /* L20: */
9517  }
9518  if (*integr == 1) {
9519  goto L70;
9520  }
9521  if (*integr == 3) {
9522  goto L40;
9523  }
9524 
9525  /* compute rg using a forward recurrence relation. */
9526 
9527  rg[1] = -ri[1] / alfp1;
9528  rg[2] = -(ralf + ralf) / (alfp2 * alfp2) - rg[1];
9529  an = 2.;
9530  anm1 = 1.;
9531  im1 = 2;
9532  for (i__ = 3; i__ <= 25; ++i__) {
9533  rg[i__] = -(an * (an - alfp2) * rg[im1] - an * ri[im1] + anm1 * ri[
9534  i__]) / (anm1 * (an + alfp1));
9535  anm1 = an;
9536  an += 1.;
9537  im1 = i__;
9538  /* L30: */
9539  }
9540  if (*integr == 2) {
9541  goto L70;
9542  }
9543 
9544  /* compute rh using a forward recurrence relation. */
9545 
9546 L40:
9547  rh[1] = -rj[1] / betp1;
9548  rh[2] = -(rbet + rbet) / (betp2 * betp2) - rh[1];
9549  an = 2.;
9550  anm1 = 1.;
9551  im1 = 2;
9552  for (i__ = 3; i__ <= 25; ++i__) {
9553  rh[i__] = -(an * (an - betp2) * rh[im1] - an * rj[im1] + anm1 * rj[
9554  i__]) / (anm1 * (an + betp1));
9555  anm1 = an;
9556  an += 1.;
9557  im1 = i__;
9558  /* L50: */
9559  }
9560  for (i__ = 2; i__ <= 25; i__ += 2) {
9561  rh[i__] = -rh[i__];
9562  /* L60: */
9563  }
9564 L70:
9565  for (i__ = 2; i__ <= 25; i__ += 2) {
9566  rj[i__] = -rj[i__];
9567  /* L80: */
9568  }
9569  /* L90: */
9570  return;
9571 } /* dqmomo_ */
9572 
9573 void dqng_(const D_fp& f, const double *a, const double *b, const double *epsabs,
9574  const double *epsrel, double *result, double *abserr,
9575  long *neval, long *ier)
9576 {
9577  /* Initialized data */
9578 
9579  double x1[5] = { .973906528517171720077964012084452,
9580  .865063366688984510732096688423493,
9581  .679409568299024406234327365114874,
9582  .433395394129247190799265943165784,
9583  .14887433898163121088482600112972 };
9584  double w10[5] = { .066671344308688137593568809893332,
9585  .149451349150580593145776339657697,
9586  .219086362515982043995534934228163,
9587  .269266719309996355091226921569469,
9588  .295524224714752870173892994651338 };
9589  double x2[5] = { .995657163025808080735527280689003,
9590  .930157491355708226001207180059508,
9591  .780817726586416897063717578345042,
9592  .562757134668604683339000099272694,
9593  .294392862701460198131126603103866 };
9594  double w21a[5] = { .03255816230796472747881897245939,
9595  .07503967481091995276704314091619,
9596  .109387158802297641899210590325805,
9597  .134709217311473325928054001771707,
9598  .147739104901338491374841515972068 };
9599  double w21b[6] = { .011694638867371874278064396062192,
9600  .05475589657435199603138130024458,
9601  .093125454583697605535065465083366,
9602  .123491976262065851077958109831074,
9603  .142775938577060080797094273138717,
9604  .149445554002916905664936468389821 };
9605  double x3[11] = { .999333360901932081394099323919911,
9606  .987433402908088869795961478381209,
9607  .954807934814266299257919200290473,
9608  .900148695748328293625099494069092,
9609  .82519831498311415084706673258852,
9610  .732148388989304982612354848755461,
9611  .622847970537725238641159120344323,
9612  .499479574071056499952214885499755,
9613  .364901661346580768043989548502644,
9614  .222254919776601296498260928066212,
9615  .074650617461383322043914435796506 };
9616  double w43a[10] = { .016296734289666564924281974617663,
9617  .037522876120869501461613795898115,
9618  .054694902058255442147212685465005,
9619  .067355414609478086075553166302174,
9620  .073870199632393953432140695251367,
9621  .005768556059769796184184327908655,
9622  .027371890593248842081276069289151,
9623  .046560826910428830743339154433824,
9624  .061744995201442564496240336030883,
9625  .071387267268693397768559114425516 };
9626  double w43b[12] = { .001844477640212414100389106552965,
9627  .010798689585891651740465406741293,
9628  .021895363867795428102523123075149,
9629  .032597463975345689443882222526137,
9630  .042163137935191811847627924327955,
9631  .050741939600184577780189020092084,
9632  .058379395542619248375475369330206,
9633  .064746404951445885544689259517511,
9634  .069566197912356484528633315038405,
9635  .072824441471833208150939535192842,
9636  .074507751014175118273571813842889,
9637  .074722147517403005594425168280423 };
9638  double x4[22] = { .999902977262729234490529830591582,
9639  .99798989598667874542749632236596,
9640  .992175497860687222808523352251425,
9641  .981358163572712773571916941623894,
9642  .965057623858384619128284110607926,
9643  .943167613133670596816416634507426,
9644  .91580641468550720959182643072005,
9645  .883221657771316501372117548744163,
9646  .845710748462415666605902011504855,
9647  .803557658035230982788739474980964,
9648  .75700573068549555832894279343202,
9649  .70627320978732181982409427474084,
9650  .651589466501177922534422205016736,
9651  .593223374057961088875273770349144,
9652  .531493605970831932285268948562671,
9653  .46676362304202284487196678165927,
9654  .399424847859218804732101665817923,
9655  .329874877106188288265053371824597,
9656  .258503559202161551802280975429025,
9657  .185695396568346652015917141167606,
9658  .111842213179907468172398359241362,
9659  .037352123394619870814998165437704 };
9660  double w87a[21] = { .00814837738414917290000287844819,
9661  .018761438201562822243935059003794,
9662  .027347451050052286161582829741283,
9663  .033677707311637930046581056957588,
9664  .036935099820427907614589586742499,
9665  .002884872430211530501334156248695,
9666  .013685946022712701888950035273128,
9667  .023280413502888311123409291030404,
9668  .030872497611713358675466394126442,
9669  .035693633639418770719351355457044,
9670  9.15283345202241360843392549948e-4,
9671  .005399280219300471367738743391053,
9672  .010947679601118931134327826856808,
9673  .01629873169678733526266570322328,
9674  .02108156888920383511243306018819,
9675  .02537096976925382724346799983171,
9676  .02918969775647575250144615408492,
9677  .032373202467202789685788194889595,
9678  .034783098950365142750781997949596,
9679  .036412220731351787562801163687577,
9680  .037253875503047708539592001191226 };
9681  double w87b[23] = { 2.74145563762072350016527092881e-4,
9682  .001807124155057942948341311753254,
9683  .00409686928275916486445807068348,
9684  .006758290051847378699816577897424,
9685  .009549957672201646536053581325377,
9686  .01232944765224485369462663996378,
9687  .015010447346388952376697286041943,
9688  .0175489679862431910996653529259,
9689  .019938037786440888202278192730714,
9690  .022194935961012286796332102959499,
9691  .024339147126000805470360647041454,
9692  .026374505414839207241503786552615,
9693  .02828691078877120065996800298796,
9694  .030052581128092695322521110347341,
9695  .031646751371439929404586051078883,
9696  .033050413419978503290785944862689,
9697  .034255099704226061787082821046821,
9698  .035262412660156681033782717998428,
9699  .036076989622888701185500318003895,
9700  .036698604498456094498018047441094,
9701  .037120549269832576114119958413599,
9702  .037334228751935040321235449094698,
9703  .037361073762679023410321241766599 };
9704 
9705  /* System generated locals */
9706  double d__1, d__2, d__3, d__4;
9707 
9708  /* Local variables */
9709  long k, l;
9710  double fv1[5], fv2[5], fv3[5], fv4[5];
9711  long ipx=0.;
9712  double absc, fval, res10, res21=0., res43=0., res87, fval1, fval2,
9713  hlgth, centr, reskh, uflow;
9714  double epmach, dhlgth, resabs=0., resasc=0., fcentr, savfun[21];
9715 
9716  /* ***begin prologue dqng */
9717  /* ***date written 800101 (yymmdd) */
9718  /* ***revision date 810101 (yymmdd) */
9719  /* ***category no. h2a1a1 */
9720  /* ***keywords automatic integrator, smooth integrand, */
9721  /* non-adaptive, gauss-kronrod(patterson) */
9722  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
9723  /* de doncker,elise,appl math & progr. div. - k.u.leuven */
9724  /* kahaner,david,nbs - modified (2/82) */
9725  /* ***purpose the routine calculates an approximation result to a */
9726  /* given definite integral i = integral of f over (a,b), */
9727  /* hopefully satisfying following claim for accuracy */
9728  /* fabs(i-result).le.max(epsabs,epsrel*fabs(i)). */
9729  /* ***description */
9730 
9731  /* non-adaptive integration */
9732  /* standard fortran subroutine */
9733  /* double precision version */
9734 
9735  /* f - double precision */
9736  /* function subprogram defining the integrand function */
9737  /* f(x). the actual name for f needs to be declared */
9738  /* e x t e r n a l in the driver program. */
9739 
9740  /* a - double precision */
9741  /* lower limit of integration */
9742 
9743  /* b - double precision */
9744  /* upper limit of integration */
9745 
9746  /* epsabs - double precision */
9747  /* absolute accuracy requested */
9748  /* epsrel - double precision */
9749  /* relative accuracy requested */
9750  /* if epsabs.le.0 */
9751  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
9752  /* the routine will end with ier = 6. */
9753 
9754  /* on return */
9755  /* result - double precision */
9756  /* approximation to the integral i */
9757  /* result is obtained by applying the 21-polong */
9758  /* gauss-kronrod rule (res21) obtained by optimal */
9759  /* addition of abscissae to the 10-point gauss rule */
9760  /* (res10), or by applying the 43-point rule (res43) */
9761  /* obtained by optimal addition of abscissae to the */
9762  /* 21-point gauss-kronrod rule, or by applying the */
9763  /* 87-point rule (res87) obtained by optimal addition */
9764  /* of abscissae to the 43-point rule. */
9765 
9766  /* abserr - double precision */
9767  /* estimate of the modulus of the absolute error, */
9768  /* which should equal or exceed fabs(i-result) */
9769 
9770  /* neval - long */
9771  /* number of integrand evaluations */
9772 
9773  /* ier - ier = 0 normal and reliable termination of the */
9774  /* routine. it is assumed that the requested */
9775  /* accuracy has been achieved. */
9776  /* ier.gt.0 abnormal termination of the routine. it is */
9777  /* assumed that the requested accuracy has */
9778  /* not been achieved. */
9779  /* error messages */
9780  /* ier = 1 the maximum number of steps has been */
9781  /* executed. the integral is probably too */
9782  /* difficult to be calculated by dqng. */
9783  /* = 6 the input is invalid, because */
9784  /* epsabs.le.0 and */
9785  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28). */
9786  /* result, abserr and neval are set to zero. */
9787 
9788  /* ***references (none) */
9789  /* ***routines called d1mach,xerror */
9790  /* ***end prologue dqng */
9791 
9792 
9793 
9794  /* the following data statements contain the */
9795  /* abscissae and weights of the integration rules used. */
9796 
9797  /* x1 abscissae common to the 10-, 21-, 43- and 87- */
9798  /* point rule */
9799  /* x2 abscissae common to the 21-, 43- and 87-point rule */
9800  /* x3 abscissae common to the 43- and 87-point rule */
9801  /* x4 abscissae of the 87-point rule */
9802  /* w10 weights of the 10-point formula */
9803  /* w21a weights of the 21-point formula for abscissae x1 */
9804  /* w21b weights of the 21-point formula for abscissae x2 */
9805  /* w43a weights of the 43-point formula for abscissae x1, x3 */
9806  /* w43b weights of the 43-point formula for abscissae x3 */
9807  /* w87a weights of the 87-point formula for abscissae x1, */
9808  /* x2, x3 */
9809  /* w87b weights of the 87-point formula for abscissae x4 */
9810 
9811 
9812  /* gauss-kronrod-patterson quadrature coefficients for use in */
9813  /* quadpack routine qng. these coefficients were calculated with */
9814  /* 101 decimal digit arithmetic by l. w. fullerton, bell labs, nov 1981. */
9815 
9816 
9817 
9818 
9819 
9820  /* list of major variables */
9821  /* ----------------------- */
9822 
9823  /* centr - mid point of the integration interval */
9824  /* hlgth - half-length of the integration interval */
9825  /* fcentr - function value at mid polong */
9826  /* absc - abscissa */
9827  /* fval - function value */
9828  /* savfun - array of function values which have already been */
9829  /* computed */
9830  /* res10 - 10-point gauss result */
9831  /* res21 - 21-point kronrod result */
9832  /* res43 - 43-point result */
9833  /* res87 - 87-point result */
9834  /* resabs - approximation to the integral of fabs(f) */
9835  /* resasc - approximation to the integral of fabs(f-i/(b-a)) */
9836 
9837  /* machine dependent constants */
9838  /* --------------------------- */
9839 
9840  /* epmach is the largest relative spacing. */
9841  /* uflow is the smallest positive magnitude. */
9842 
9843  /* ***first executable statement dqng */
9844  epmach = d1mach(c__4);
9845  uflow = d1mach(c__1);
9846 
9847  /* test on validity of parameters */
9848  /* ------------------------------ */
9849 
9850  *result = 0.;
9851  *abserr = 0.;
9852  *neval = 0;
9853  *ier = 6;
9854  /* Computing MAX */
9855  d__1 = epmach * 50.;
9856  if (*epsabs <= 0. && *epsrel < max(d__1,5e-29)) {
9857  goto L80;
9858  }
9859  hlgth = (*b - *a) * .5;
9860  dhlgth = fabs(hlgth);
9861  centr = (*b + *a) * .5;
9862  fcentr = f(centr);
9863  *neval = 21;
9864  *ier = 1;
9865 
9866  /* compute the integral using the 10- and 21-point formula. */
9867 
9868  for (l = 1; l <= 3; ++l) {
9869  switch (l) {
9870  case 1: goto L5;
9871  case 2: goto L25;
9872  case 3: goto L45;
9873  }
9874  L5:
9875  res10 = 0.;
9876  res21 = w21b[5] * fcentr;
9877  resabs = w21b[5] * fabs(fcentr);
9878  for (k = 1; k <= 5; ++k) {
9879  absc = hlgth * x1[k - 1];
9880  d__1 = centr + absc;
9881  fval1 = f(d__1);
9882  d__1 = centr - absc;
9883  fval2 = f(d__1);
9884  fval = fval1 + fval2;
9885  res10 += w10[k - 1] * fval;
9886  res21 += w21a[k - 1] * fval;
9887  resabs += w21a[k - 1] * (fabs(fval1) + fabs(fval2));
9888  savfun[k - 1] = fval;
9889  fv1[k - 1] = fval1;
9890  fv2[k - 1] = fval2;
9891  /* L10: */
9892  }
9893  ipx = 5;
9894  for (k = 1; k <= 5; ++k) {
9895  ++ipx;
9896  absc = hlgth * x2[k - 1];
9897  d__1 = centr + absc;
9898  fval1 = f(d__1);
9899  d__1 = centr - absc;
9900  fval2 = f(d__1);
9901  fval = fval1 + fval2;
9902  res21 += w21b[k - 1] * fval;
9903  resabs += w21b[k - 1] * (fabs(fval1) + fabs(fval2));
9904  savfun[ipx - 1] = fval;
9905  fv3[k - 1] = fval1;
9906  fv4[k - 1] = fval2;
9907  /* L15: */
9908  }
9909 
9910  /* test for convergence. */
9911 
9912  *result = res21 * hlgth;
9913  resabs *= dhlgth;
9914  reskh = res21 * .5;
9915  resasc = w21b[5] * (d__1 = fcentr - reskh, fabs(d__1));
9916  for (k = 1; k <= 5; ++k) {
9917  resasc = resasc + w21a[k - 1] * ((d__1 = fv1[k - 1] - reskh, fabs(
9918  d__1)) + (d__2 = fv2[k - 1] - reskh, fabs(d__2))) + w21b[k
9919  - 1] * ((d__3 = fv3[k - 1] - reskh, fabs(d__3)) + (d__4 =
9920  fv4[k - 1] - reskh, fabs(d__4)));
9921  /* L20: */
9922  }
9923  *abserr = (d__1 = (res21 - res10) * hlgth, fabs(d__1));
9924  resasc *= dhlgth;
9925  goto L65;
9926 
9927  /* compute the integral using the 43-point formula. */
9928 
9929  L25:
9930  res43 = w43b[11] * fcentr;
9931  *neval = 43;
9932  for (k = 1; k <= 10; ++k) {
9933  res43 += savfun[k - 1] * w43a[k - 1];
9934  /* L30: */
9935  }
9936  for (k = 1; k <= 11; ++k) {
9937  ++ipx;
9938  absc = hlgth * x3[k - 1];
9939  d__1 = absc + centr;
9940  d__2 = centr - absc;
9941  fval = f(d__1) + f(d__2);
9942  res43 += fval * w43b[k - 1];
9943  savfun[ipx - 1] = fval;
9944  /* L40: */
9945  }
9946 
9947  /* test for convergence. */
9948 
9949  *result = res43 * hlgth;
9950  *abserr = (d__1 = (res43 - res21) * hlgth, fabs(d__1));
9951  goto L65;
9952 
9953  /* compute the integral using the 87-point formula. */
9954 
9955  L45:
9956  res87 = w87b[22] * fcentr;
9957  *neval = 87;
9958  for (k = 1; k <= 21; ++k) {
9959  res87 += savfun[k - 1] * w87a[k - 1];
9960  /* L50: */
9961  }
9962  for (k = 1; k <= 22; ++k) {
9963  absc = hlgth * x4[k - 1];
9964  d__1 = absc + centr;
9965  d__2 = centr - absc;
9966  res87 += w87b[k - 1] * (f(d__1) + f(d__2));
9967  /* L60: */
9968  }
9969  *result = res87 * hlgth;
9970  *abserr = (d__1 = (res87 - res43) * hlgth, fabs(d__1));
9971  L65:
9972  if (resasc != 0. && *abserr != 0.) {
9973  /* Computing MIN */
9974  d__3 = *abserr * 200. / resasc;
9975  d__1 = 1., d__2 = pow(d__3, c_b270);
9976  *abserr = resasc * min(d__1,d__2);
9977  }
9978  if (resabs > uflow / (epmach * 50.)) {
9979  /* Computing MAX */
9980  d__1 = epmach * 50. * resabs;
9981  *abserr = max(d__1,*abserr);
9982  }
9983  /* Computing MAX */
9984  d__1 = *epsabs, d__2 = *epsrel * fabs(*result);
9985  if (*abserr <= max(d__1,d__2)) {
9986  *ier = 0;
9987  }
9988  /* ***jump out of do-loop */
9989  if (*ier == 0) {
9990  goto L999;
9991  }
9992  /* L70: */
9993  }
9994 L80:
9995  xerror_("abnormal return from dqng ", &c__26, ier, &c__0, 26);
9996 L999:
9997  return;
9998 } /* dqng_ */
9999 
10000 void dqpsrt_(const long *limit, long *last, long *maxerr,
10001  double *ermax, double *elist, long *iord, long *nrmax)
10002 {
10003  /* System generated locals */
10004  int i__1;
10005 
10006  /* Local variables */
10007  long i__, j, k, ido, ibeg, jbnd, isucc, jupbn;
10008  double errmin, errmax;
10009 
10010  /* ***begin prologue dqpsrt */
10011  /* ***refer to dqage,dqagie,dqagpe,dqawse */
10012  /* ***routines called (none) */
10013  /* ***revision date 810101 (yymmdd) */
10014  /* ***keywords sequential sorting */
10015  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
10016  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
10017  /* ***purpose this routine maintains the descending ordering in the */
10018  /* list of the local error estimated resulting from the */
10019  /* interval subdivision process. at each call two error */
10020  /* estimates are inserted using the sequential search */
10021  /* method, top-down for the largest error estimate and */
10022  /* bottom-up for the smallest error estimate. */
10023  /* ***description */
10024 
10025  /* ordering routine */
10026  /* standard fortran subroutine */
10027  /* double precision version */
10028 
10029  /* parameters (meaning at output) */
10030  /* limit - long */
10031  /* maximum number of error estimates the list */
10032  /* can contain */
10033 
10034  /* last - long */
10035  /* number of error estimates currently in the list */
10036 
10037  /* maxerr - long */
10038  /* maxerr points to the nrmax-th largest error */
10039  /* estimate currently in the list */
10040 
10041  /* ermax - double precision */
10042  /* nrmax-th largest error estimate */
10043  /* ermax = elist(maxerr) */
10044 
10045  /* elist - double precision */
10046  /* vector of dimension last containing */
10047  /* the error estimates */
10048 
10049  /* iord - long */
10050  /* vector of dimension last, the first k elements */
10051  /* of which contain pointers to the error */
10052  /* estimates, such that */
10053  /* elist(iord(1)),..., elist(iord(k)) */
10054  /* form a decreasing sequence, with */
10055  /* k = last if last.le.(limit/2+2), and */
10056  /* k = limit+1-last otherwise */
10057 
10058  /* nrmax - long */
10059  /* maxerr = iord(nrmax) */
10060 
10061  /* ***end prologue dqpsrt */
10062 
10063 
10064  /* check whether the list contains more than */
10065  /* two error estimates. */
10066 
10067  /* ***first executable statement dqpsrt */
10068  /* Parameter adjustments */
10069  --iord;
10070  --elist;
10071 
10072  /* Function Body */
10073  if (*last > 2) {
10074  goto L10;
10075  }
10076  iord[1] = 1;
10077  iord[2] = 2;
10078  goto L90;
10079 
10080  /* this part of the routine is only executed if, due to a */
10081  /* difficult integrand, subdivision increased the error */
10082  /* estimate. in the normal case the insert procedure should */
10083  /* start after the nrmax-th largest error estimate. */
10084 
10085 L10:
10086  errmax = elist[*maxerr];
10087  if (*nrmax == 1) {
10088  goto L30;
10089  }
10090  ido = *nrmax - 1;
10091  i__1 = ido;
10092  for (i__ = 1; i__ <= i__1; ++i__) {
10093  isucc = iord[*nrmax - 1];
10094  /* ***jump out of do-loop */
10095  if (errmax <= elist[isucc]) {
10096  goto L30;
10097  }
10098  iord[*nrmax] = isucc;
10099  --(*nrmax);
10100  /* L20: */
10101  }
10102 
10103  /* compute the number of elements in the list to be maintained */
10104  /* in descending order. this number depends on the number of */
10105  /* subdivisions still allowed. */
10106 
10107 L30:
10108  jupbn = *last;
10109  if (*last > *limit / 2 + 2) {
10110  jupbn = *limit + 3 - *last;
10111  }
10112  errmin = elist[*last];
10113 
10114  /* insert errmax by traversing the list top-down, */
10115  /* starting comparison from the element elist(iord(nrmax+1)). */
10116 
10117  jbnd = jupbn - 1;
10118  ibeg = *nrmax + 1;
10119  if (ibeg > jbnd) {
10120  goto L50;
10121  }
10122  i__1 = jbnd;
10123  for (i__ = ibeg; i__ <= i__1; ++i__) {
10124  isucc = iord[i__];
10125  /* ***jump out of do-loop */
10126  if (errmax >= elist[isucc]) {
10127  goto L60;
10128  }
10129  iord[i__ - 1] = isucc;
10130  /* L40: */
10131  }
10132 L50:
10133  iord[jbnd] = *maxerr;
10134  iord[jupbn] = *last;
10135  goto L90;
10136 
10137  /* insert errmin by traversing the list bottom-up. */
10138 
10139 L60:
10140  iord[i__ - 1] = *maxerr;
10141  k = jbnd;
10142  i__1 = jbnd;
10143  for (j = i__; j <= i__1; ++j) {
10144  isucc = iord[k];
10145  /* ***jump out of do-loop */
10146  if (errmin < elist[isucc]) {
10147  goto L80;
10148  }
10149  iord[k + 1] = isucc;
10150  --k;
10151  /* L70: */
10152  }
10153  iord[i__] = *last;
10154  goto L90;
10155 L80:
10156  iord[k + 1] = *last;
10157 
10158  /* set maxerr and ermax. */
10159 
10160 L90:
10161  *maxerr = iord[*nrmax];
10162  *ermax = elist[*maxerr];
10163  return;
10164 } /* dqpsrt_ */
10165 
10166 double dqwgtc_(const double *x, const double *c__, const double *,
10167  const double *, const double *, const long *)
10168 {
10169  /* System generated locals */
10170  double ret_val;
10171 
10172  /* ***begin prologue dqwgtc */
10173  /* ***refer to dqk15w */
10174  /* ***routines called (none) */
10175  /* ***revision date 810101 (yymmdd) */
10176  /* ***keywords weight function, cauchy principal value */
10177  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
10178  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
10179  /* ***purpose this function subprogram is used together with the */
10180  /* routine qawc and defines the weight function. */
10181  /* ***end prologue dqwgtc */
10182 
10183  /* ***first executable statement dqwgtc */
10184  ret_val = 1. / (*x - *c__);
10185  return ret_val;
10186 } /* dqwgtc_ */
10187 
10188 double dqwgtf_(const double *x, const double *omega, const double *,
10189  const double *, const double *, const long *integr)
10190 {
10191  /* System generated locals */
10192  double ret_val;
10193 
10194  /* Local variables */
10195  double omx;
10196 
10197  /* ***begin prologue dqwgtf */
10198  /* ***refer to dqk15w */
10199  /* ***routines called (none) */
10200  /* ***revision date 810101 (yymmdd) */
10201  /* ***keywords cos or sin in weight function */
10202  /* ***author piessens,robert, appl. math. & progr. div. - k.u.leuven */
10203  /* de doncker,elise,appl. math. * progr. div. - k.u.leuven */
10204  /* ***end prologue dqwgtf */
10205 
10206  /* ***first executable statement dqwgtf */
10207  omx = *omega * *x;
10208  switch (*integr) {
10209  case 1: goto L10;
10210  case 2: goto L20;
10211  }
10212 L10:
10213  ret_val = cos(omx);
10214  goto L30;
10215 L20:
10216  ret_val = sin(omx);
10217 L30:
10218  return ret_val;
10219 } /* dqwgtf_ */
10220 
10221 double dqwgts_(const double *x, const double *a, const double *b,
10222  const double *alfa, const double *beta, const long *integr)
10223 {
10224  /* System generated locals */
10225  double ret_val;
10226 
10227  /* Local variables */
10228  double xma, bmx;
10229 
10230  /* ***begin prologue dqwgts */
10231  /* ***refer to dqk15w */
10232  /* ***routines called (none) */
10233  /* ***revision date 810101 (yymmdd) */
10234  /* ***keywords weight function, algebraico-logarithmic */
10235  /* end-point singularities */
10236  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
10237  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
10238  /* ***purpose this function subprogram is used together with the */
10239  /* routine dqaws and defines the weight function. */
10240  /* ***end prologue dqwgts */
10241 
10242  /* ***first executable statement dqwgts */
10243  xma = *x - *a;
10244  bmx = *b - *x;
10245  ret_val = pow(xma, *alfa) * pow(bmx, *beta);
10246  switch (*integr) {
10247  case 1: goto L40;
10248  case 2: goto L10;
10249  case 3: goto L20;
10250  case 4: goto L30;
10251  }
10252 L10:
10253  ret_val *= log(xma);
10254  goto L40;
10255 L20:
10256  ret_val *= log(bmx);
10257  goto L40;
10258 L30:
10259  ret_val = ret_val * log(xma) * log(bmx);
10260 L40:
10261  return ret_val;
10262 } /* dqwgts_ */
10263 
10264 void qage_(const E_fp& f, const sys_float *a, const sys_float *b,
10265  const sys_float *epsabs, const sys_float *epsrel, const long *key,
10266  const long *limit, sys_float *result, sys_float *abserr,
10267  long *neval, long *ier, sys_float *alist__, sys_float *blist, sys_float *rlist,
10268  sys_float *elist, long *iord, long *last)
10269 {
10270  /* System generated locals */
10271  int i__1;
10272  sys_float r__1, r__2;
10273 
10274  /* Local variables */
10275  long k;
10276  sys_float a1, a2, b1, b2;
10277  sys_float area;
10278  long keyf;
10279  sys_float area1, area2, area12, erro12, defab1, defab2;
10280  long nrmax;
10281  sys_float uflow;
10282  long iroff1, iroff2;
10283  sys_float error1, error2, defabs, epmach, errbnd, resabs, errmax;
10284  long maxerr;
10285  sys_float errsum;
10286 
10287  /* ***begin prologue qage */
10288  /* ***date written 800101 (yymmdd) */
10289  /* ***revision date 830518 (yymmdd) */
10290  /* ***category no. h2a1a1 */
10291  /* ***keywords automatic integrator, general-purpose, */
10292  /* integrand examinator, globally adaptive, */
10293  /* gauss-kronrod */
10294  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
10295  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
10296  /* ***purpose the routine calculates an approximation result to a given */
10297  /* definite integral i = integral of f over (a,b), */
10298  /* hopefully satisfying following claim for accuracy */
10299  /* fabs(i-reslt).le.max(epsabs,epsrel*fabs(i)). */
10300  /* ***description */
10301 
10302  /* computation of a definite integral */
10303  /* standard fortran subroutine */
10304  /* sys_float version */
10305 
10306  /* parameters */
10307  /* on entry */
10308  /* f - sys_float */
10309  /* function subprogram defining the integrand */
10310  /* function f(x). the actual name for f needs to be */
10311  /* declared e x t e r n a l in the driver program. */
10312 
10313  /* a - sys_float */
10314  /* lower limit of integration */
10315 
10316  /* b - sys_float */
10317  /* upper limit of integration */
10318 
10319  /* epsabs - sys_float */
10320  /* absolute accuracy requested */
10321  /* epsrel - sys_float */
10322  /* relative accuracy requested */
10323  /* if epsabs.le.0 */
10324  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
10325  /* the routine will end with ier = 6. */
10326 
10327  /* key - long */
10328  /* key for choice of local integration rule */
10329  /* a gauss-kronrod pair is used with */
10330  /* 7 - 15 points if key.lt.2, */
10331  /* 10 - 21 points if key = 2, */
10332  /* 15 - 31 points if key = 3, */
10333  /* 20 - 41 points if key = 4, */
10334  /* 25 - 51 points if key = 5, */
10335  /* 30 - 61 points if key.gt.5. */
10336 
10337  /* limit - long */
10338  /* gives an upperbound on the number of subintervals */
10339  /* in the partition of (a,b), limit.ge.1. */
10340 
10341  /* on return */
10342  /* result - sys_float */
10343  /* approximation to the integral */
10344 
10345  /* abserr - sys_float */
10346  /* estimate of the modulus of the absolute error, */
10347  /* which should equal or exceed fabs(i-result) */
10348 
10349  /* neval - long */
10350  /* number of integrand evaluations */
10351 
10352  /* ier - long */
10353  /* ier = 0 normal and reliable termination of the */
10354  /* routine. it is assumed that the requested */
10355  /* accuracy has been achieved. */
10356  /* ier.gt.0 abnormal termination of the routine */
10357  /* the estimates for result and error are */
10358  /* less reliable. it is assumed that the */
10359  /* requested accuracy has not been achieved. */
10360  /* error messages */
10361  /* ier = 1 maximum number of subdivisions allowed */
10362  /* has been achieved. one can allow more */
10363  /* subdivisions by increasing the value */
10364  /* of limit. */
10365  /* however, if this yields no improvement it */
10366  /* is rather advised to analyze the integrand */
10367  /* in order to determine the integration */
10368  /* difficulties. if the position of a local */
10369  /* difficulty can be determined(e.g. */
10370  /* singularity, discontinuity within the */
10371  /* interval) one will probably gain from */
10372  /* splitting up the interval at this polong */
10373  /* and calling the integrator on the */
10374  /* subranges. if possible, an appropriate */
10375  /* special-purpose integrator should be used */
10376  /* which is designed for handling the type of */
10377  /* difficulty involved. */
10378  /* = 2 the occurrence of roundoff error is */
10379  /* detected, which prevents the requested */
10380  /* tolerance from being achieved. */
10381  /* = 3 extremely bad integrand behaviour occurs */
10382  /* at some points of the integration */
10383  /* interval. */
10384  /* = 6 the input is invalid, because */
10385  /* (epsabs.le.0 and */
10386  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
10387  /* result, abserr, neval, last, rlist(1) , */
10388  /* elist(1) and iord(1) are set to zero. */
10389  /* alist(1) and blist(1) are set to a and b */
10390  /* respectively. */
10391 
10392  /* alist - sys_float */
10393  /* vector of dimension at least limit, the first */
10394  /* last elements of which are the left */
10395  /* end points of the subintervals in the partition */
10396  /* of the given integration range (a,b) */
10397 
10398  /* blist - sys_float */
10399  /* vector of dimension at least limit, the first */
10400  /* last elements of which are the right */
10401  /* end points of the subintervals in the partition */
10402  /* of the given integration range (a,b) */
10403 
10404  /* rlist - sys_float */
10405  /* vector of dimension at least limit, the first */
10406  /* last elements of which are the */
10407  /* integral approximations on the subintervals */
10408 
10409  /* elist - sys_float */
10410  /* vector of dimension at least limit, the first */
10411  /* last elements of which are the moduli of the */
10412  /* absolute error estimates on the subintervals */
10413 
10414  /* iord - long */
10415  /* vector of dimension at least limit, the first k */
10416  /* elements of which are pointers to the */
10417  /* error estimates over the subintervals, */
10418  /* such that elist(iord(1)), ..., */
10419  /* elist(iord(k)) form a decreasing sequence, */
10420  /* with k = last if last.le.(limit/2+2), and */
10421  /* k = limit+1-last otherwise */
10422 
10423  /* last - long */
10424  /* number of subintervals actually produced in the */
10425  /* subdivision process */
10426 
10427  /* ***references (none) */
10428  /* ***routines called qk15,qk21,qk31,qk41,qk51,qk61,qpsrt,r1mach */
10429  /* ***end prologue qage */
10430 
10431 
10432 
10433 
10434  /* list of major variables */
10435  /* ----------------------- */
10436 
10437  /* alist - list of left end points of all subintervals */
10438  /* considered up to now */
10439  /* blist - list of right end points of all subintervals */
10440  /* considered up to now */
10441  /* rlist(i) - approximation to the integral over */
10442  /* (alist(i),blist(i)) */
10443  /* elist(i) - error estimate applying to rlist(i) */
10444  /* maxerr - pointer to the interval with largest */
10445  /* error estimate */
10446  /* errmax - elist(maxerr) */
10447  /* area - sum of the integrals over the subintervals */
10448  /* errsum - sum of the errors over the subintervals */
10449  /* errbnd - requested accuracy max(epsabs,epsrel* */
10450  /* fabs(result)) */
10451  /* *****1 - variable for the left subinterval */
10452  /* *****2 - variable for the right subinterval */
10453  /* last - index for subdivision */
10454 
10455 
10456  /* machine dependent constants */
10457  /* --------------------------- */
10458 
10459  /* epmach is the largest relative spacing. */
10460  /* uflow is the smallest positive magnitude. */
10461 
10462  /* ***first executable statement qage */
10463  /* Parameter adjustments */
10464  --iord;
10465  --elist;
10466  --rlist;
10467  --blist;
10468  --alist__;
10469 
10470  /* Function Body */
10471  epmach = r1mach(c__4);
10472  uflow = r1mach(c__1);
10473 
10474  /* test on validity of parameters */
10475  /* ------------------------------ */
10476 
10477  *ier = 0;
10478  *neval = 0;
10479  *last = 0;
10480  *result = 0.f;
10481  *abserr = 0.f;
10482  alist__[1] = *a;
10483  blist[1] = *b;
10484  rlist[1] = 0.f;
10485  elist[1] = 0.f;
10486  iord[1] = 0;
10487  /* Computing MAX */
10488  r__1 = epmach * 50.f;
10489  if (*epsabs <= 0.f && *epsrel < max(r__1,5e-15f)) {
10490  *ier = 6;
10491  }
10492  if (*ier == 6) {
10493  goto L999;
10494  }
10495 
10496  /* first approximation to the integral */
10497  /* ----------------------------------- */
10498 
10499  keyf = *key;
10500  if (*key <= 0) {
10501  keyf = 1;
10502  }
10503  if (*key >= 7) {
10504  keyf = 6;
10505  }
10506  *neval = 0;
10507  if (keyf == 1) {
10508  qk15_(f, a, b, result, abserr, &defabs, &resabs);
10509  }
10510  if (keyf == 2) {
10511  qk21_(f, a, b, result, abserr, &defabs, &resabs);
10512  }
10513  if (keyf == 3) {
10514  qk31_(f, a, b, result, abserr, &defabs, &resabs);
10515  }
10516  if (keyf == 4) {
10517  qk41_(f, a, b, result, abserr, &defabs, &resabs);
10518  }
10519  if (keyf == 5) {
10520  qk51_(f, a, b, result, abserr, &defabs, &resabs);
10521  }
10522  if (keyf == 6) {
10523  qk61_(f, a, b, result, abserr, &defabs, &resabs);
10524  }
10525  *last = 1;
10526  rlist[1] = *result;
10527  elist[1] = *abserr;
10528  iord[1] = 1;
10529 
10530  /* test on accuracy. */
10531 
10532  /* Computing MAX */
10533  r__1 = *epsabs, r__2 = *epsrel * fabs(*result);
10534  errbnd = max(r__1,r__2);
10535  if (*abserr <= epmach * 50.f * defabs && *abserr > errbnd) {
10536  *ier = 2;
10537  }
10538  if (*limit == 1) {
10539  *ier = 1;
10540  }
10541  if (*ier != 0 || ( *abserr <= errbnd && *abserr != resabs ) || *abserr == 0.f)
10542  {
10543  goto L60;
10544  }
10545 
10546  /* initialization */
10547  /* -------------- */
10548 
10549 
10550  errmax = *abserr;
10551  maxerr = 1;
10552  area = *result;
10553  errsum = *abserr;
10554  nrmax = 1;
10555  iroff1 = 0;
10556  iroff2 = 0;
10557 
10558  /* main do-loop */
10559  /* ------------ */
10560 
10561  i__1 = *limit;
10562  for (*last = 2; *last <= i__1; ++(*last)) {
10563 
10564  /* bisect the subinterval with the largest error estimate. */
10565 
10566  a1 = alist__[maxerr];
10567  b1 = (alist__[maxerr] + blist[maxerr]) * .5f;
10568  a2 = b1;
10569  b2 = blist[maxerr];
10570  if (keyf == 1) {
10571  qk15_(f, &a1, &b1, &area1, &error1, &resabs, &defab1);
10572  }
10573  if (keyf == 2) {
10574  qk21_(f, &a1, &b1, &area1, &error1, &resabs, &defab1);
10575  }
10576  if (keyf == 3) {
10577  qk31_(f, &a1, &b1, &area1, &error1, &resabs, &defab1);
10578  }
10579  if (keyf == 4) {
10580  qk41_(f, &a1, &b1, &area1, &error1, &resabs, &defab1);
10581  }
10582  if (keyf == 5) {
10583  qk51_(f, &a1, &b1, &area1, &error1, &resabs, &defab1);
10584  }
10585  if (keyf == 6) {
10586  qk61_(f, &a1, &b1, &area1, &error1, &resabs, &defab1);
10587  }
10588  if (keyf == 1) {
10589  qk15_(f, &a2, &b2, &area2, &error2, &resabs, &defab2);
10590  }
10591  if (keyf == 2) {
10592  qk21_(f, &a2, &b2, &area2, &error2, &resabs, &defab2);
10593  }
10594  if (keyf == 3) {
10595  qk31_(f, &a2, &b2, &area2, &error2, &resabs, &defab2);
10596  }
10597  if (keyf == 4) {
10598  qk41_(f, &a2, &b2, &area2, &error2, &resabs, &defab2);
10599  }
10600  if (keyf == 5) {
10601  qk51_(f, &a2, &b2, &area2, &error2, &resabs, &defab2);
10602  }
10603  if (keyf == 6) {
10604  qk61_(f, &a2, &b2, &area2, &error2, &resabs, &defab2);
10605  }
10606 
10607  /* improve previous approximations to integral */
10608  /* and error and test for accuracy. */
10609 
10610  ++(*neval);
10611  area12 = area1 + area2;
10612  erro12 = error1 + error2;
10613  errsum = errsum + erro12 - errmax;
10614  area = area + area12 - rlist[maxerr];
10615  if (defab1 == error1 || defab2 == error2) {
10616  goto L5;
10617  }
10618  if ((r__1 = rlist[maxerr] - area12, fabs(r__1)) <= fabs(area12) *
10619  1e-5f && erro12 >= errmax * .99f) {
10620  ++iroff1;
10621  }
10622  if (*last > 10 && erro12 > errmax) {
10623  ++iroff2;
10624  }
10625  L5:
10626  rlist[maxerr] = area1;
10627  rlist[*last] = area2;
10628  /* Computing MAX */
10629  r__1 = *epsabs, r__2 = *epsrel * fabs(area);
10630  errbnd = max(r__1,r__2);
10631  if (errsum <= errbnd) {
10632  goto L8;
10633  }
10634 
10635  /* test for roundoff error and eventually */
10636  /* set error flag. */
10637 
10638  if (iroff1 >= 6 || iroff2 >= 20) {
10639  *ier = 2;
10640  }
10641 
10642  /* set error flag in the case that the number of */
10643  /* subintervals equals limit. */
10644 
10645  if (*last == *limit) {
10646  *ier = 1;
10647  }
10648 
10649  /* set error flag in the case of bad integrand behaviour */
10650  /* at a point of the integration range. */
10651 
10652  /* Computing MAX */
10653  r__1 = fabs(a1), r__2 = fabs(b2);
10654  if (max(r__1,r__2) <= (epmach * 100.f + 1.f) * (fabs(a2) + uflow *
10655  1e3f)) {
10656  *ier = 3;
10657  }
10658 
10659  /* append the newly-created intervals to the list. */
10660 
10661  L8:
10662  if (error2 > error1) {
10663  goto L10;
10664  }
10665  alist__[*last] = a2;
10666  blist[maxerr] = b1;
10667  blist[*last] = b2;
10668  elist[maxerr] = error1;
10669  elist[*last] = error2;
10670  goto L20;
10671  L10:
10672  alist__[maxerr] = a2;
10673  alist__[*last] = a1;
10674  blist[*last] = b1;
10675  rlist[maxerr] = area2;
10676  rlist[*last] = area1;
10677  elist[maxerr] = error2;
10678  elist[*last] = error1;
10679 
10680  /* call subroutine qpsrt to maintain the descending ordering */
10681  /* in the list of error estimates and select the */
10682  /* subinterval with the largest error estimate (to be */
10683  /* bisected next). */
10684 
10685  L20:
10686  qpsrt_(limit, last, &maxerr, &errmax, &elist[1], &iord[1], &nrmax);
10687  /* ***jump out of do-loop */
10688  if (*ier != 0 || errsum <= errbnd) {
10689  goto L40;
10690  }
10691  /* L30: */
10692  }
10693 
10694  /* compute final result. */
10695  /* --------------------- */
10696 
10697 L40:
10698  *result = 0.f;
10699  i__1 = *last;
10700  for (k = 1; k <= i__1; ++k) {
10701  *result += rlist[k];
10702  /* L50: */
10703  }
10704  *abserr = errsum;
10705 L60:
10706  if (keyf != 1) {
10707  *neval = (keyf * 10 + 1) * ((*neval << 1) + 1);
10708  }
10709  if (keyf == 1) {
10710  *neval = *neval * 30 + 15;
10711  }
10712 L999:
10713  return;
10714 } /* qage_ */
10715 
10716 void qag_(const E_fp& f, const sys_float *a, const sys_float *b,
10717  const sys_float *epsabs, const sys_float *epsrel, const long *key,
10718  sys_float *result, sys_float *abserr, long *neval,
10719  long *ier, long *limit, const long *lenw, long *last, long *iwork,
10720  sys_float *work)
10721 {
10722  long l1, l2, l3, lvl;
10723 
10724  /* ***begin prologue qag */
10725  /* ***date written 800101 (yymmdd) */
10726  /* ***revision date 830518 (yymmdd) */
10727  /* ***category no. h2a1a1 */
10728  /* ***keywords automatic integrator, general-purpose, */
10729  /* integrand examinator, globally adaptive, */
10730  /* gauss-kronrod */
10731  /* ***author piessens,robert,appl. math. & progr. div - k.u.leuven */
10732  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
10733  /* ***purpose the routine calculates an approximation result to a given */
10734  /* definite integral i = integral of f over (a,b), */
10735  /* hopefully satisfying following claim for accuracy */
10736  /* fabs(i-result)le.max(epsabs,epsrel*fabs(i)). */
10737  /* ***description */
10738 
10739  /* computation of a definite integral */
10740  /* standard fortran subroutine */
10741  /* sys_float version */
10742 
10743  /* f - sys_float */
10744  /* function subprogam defining the integrand */
10745  /* function f(x). the actual name for f needs to be */
10746  /* declared e x t e r n a l in the driver program. */
10747 
10748  /* a - sys_float */
10749  /* lower limit of integration */
10750 
10751  /* b - sys_float */
10752  /* upper limit of integration */
10753 
10754  /* epsabs - sys_float */
10755  /* absolute accuracy requested */
10756  /* epsrel - sys_float */
10757  /* relative accuracy requested */
10758  /* if epsabs.le.0 */
10759  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
10760  /* the routine will end with ier = 6. */
10761 
10762  /* key - long */
10763  /* key for choice of local integration rule */
10764  /* a gauss-kronrod pair is used with */
10765  /* 7 - 15 points if key.lt.2, */
10766  /* 10 - 21 points if key = 2, */
10767  /* 15 - 31 points if key = 3, */
10768  /* 20 - 41 points if key = 4, */
10769  /* 25 - 51 points if key = 5, */
10770  /* 30 - 61 points if key.gt.5. */
10771 
10772  /* on return */
10773  /* result - sys_float */
10774  /* approximation to the integral */
10775 
10776  /* abserr - sys_float */
10777  /* estimate of the modulus of the absolute error, */
10778  /* which should equal or exceed fabs(i-result) */
10779 
10780  /* neval - long */
10781  /* number of integrand evaluations */
10782 
10783  /* ier - long */
10784  /* ier = 0 normal and reliable termination of the */
10785  /* routine. it is assumed that the requested */
10786  /* accuracy has been achieved. */
10787  /* ier.gt.0 abnormal termination of the routine */
10788  /* the estimates for result and error are */
10789  /* less reliable. it is assumed that the */
10790  /* requested accuracy has not been achieved. */
10791  /* error messages */
10792  /* ier = 1 maximum number of subdivisions allowed */
10793  /* has been achieved. one can allow more */
10794  /* subdivisions by increasing the value of */
10795  /* limit (and taking the according dimension */
10796  /* adjustments into account). however, if */
10797  /* this yield no improvement it is advised */
10798  /* to analyze the integrand in order to */
10799  /* determine the integration difficulaties. */
10800  /* if the position of a local difficulty can */
10801  /* be determined (i.e.singularity, */
10802  /* discontinuity within the interval) one */
10803  /* will probably gain from splitting up the */
10804  /* interval at this point and calling the */
10805  /* integrator on the subranges. if possible, */
10806  /* an appropriate special-purpose integrator */
10807  /* should be used which is designed for */
10808  /* handling the type of difficulty involved. */
10809  /* = 2 the occurrence of roundoff error is */
10810  /* detected, which prevents the requested */
10811  /* tolerance from being achieved. */
10812  /* = 3 extremely bad integrand behaviour occurs */
10813  /* at some points of the integration */
10814  /* interval. */
10815  /* = 6 the input is invalid, because */
10816  /* (epsabs.le.0 and */
10817  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28)) */
10818  /* or limit.lt.1 or lenw.lt.limit*4. */
10819  /* result, abserr, neval, last are set */
10820  /* to zero. */
10821  /* except when lenw is invalid, iwork(1), */
10822  /* work(limit*2+1) and work(limit*3+1) are */
10823  /* set to zero, work(1) is set to a and */
10824  /* work(limit+1) to b. */
10825 
10826  /* dimensioning parameters */
10827  /* limit - long */
10828  /* dimensioning parameter for iwork */
10829  /* limit determines the maximum number of subintervals */
10830  /* in the partition of the given integration interval */
10831  /* (a,b), limit.ge.1. */
10832  /* if limit.lt.1, the routine will end with ier = 6. */
10833 
10834  /* lenw - long */
10835  /* dimensioning parameter for work */
10836  /* lenw must be at least limit*4. */
10837  /* if lenw.lt.limit*4, the routine will end with */
10838  /* ier = 6. */
10839 
10840  /* last - long */
10841  /* on return, last equals the number of subintervals */
10842  /* produced in the subdivision process, which */
10843  /* determines the number of significant elements */
10844  /* actually in the work arrays. */
10845 
10846  /* work arrays */
10847  /* iwork - long */
10848  /* vector of dimension at least limit, the first k */
10849  /* elements of which contain pointers to the error */
10850  /* estimates over the subintervals, such that */
10851  /* work(limit*3+iwork(1)),... , work(limit*3+iwork(k)) */
10852  /* form a decreasing sequence with k = last if */
10853  /* last.le.(limit/2+2), and k = limit+1-last otherwise */
10854 
10855  /* work - sys_float */
10856  /* vector of dimension at least lenw */
10857  /* on return */
10858  /* work(1), ..., work(last) contain the left end */
10859  /* points of the subintervals in the partition of */
10860  /* (a,b), */
10861  /* work(limit+1), ..., work(limit+last) contain the */
10862  /* right end points, */
10863  /* work(limit*2+1), ..., work(limit*2+last) contain */
10864  /* the integral approximations over the subintervals, */
10865  /* work(limit*3+1), ..., work(limit*3+last) contain */
10866  /* the error estimates. */
10867 
10868  /* ***references (none) */
10869  /* ***routines called qage,xerror */
10870  /* ***end prologue qag */
10871 
10872 
10873 
10874 
10875  /* check validity of lenw. */
10876 
10877  /* ***first executable statement qag */
10878  /* Parameter adjustments */
10879  --iwork;
10880  --work;
10881 
10882  /* Function Body */
10883  *ier = 6;
10884  *neval = 0;
10885  *last = 0;
10886  *result = 0.f;
10887  *abserr = 0.f;
10888  if (*limit < 1 || *lenw < *limit << 2) {
10889  goto L10;
10890  }
10891 
10892  /* prepare call for qage. */
10893 
10894  l1 = *limit + 1;
10895  l2 = *limit + l1;
10896  l3 = *limit + l2;
10897 
10898  qage_(f, a, b, epsabs, epsrel, key, limit, result, abserr, neval,
10899  ier, &work[1], &work[l1], &work[l2], &work[l3], &iwork[1], last);
10900 
10901  /* call error handler if necessary. */
10902 
10903  lvl = 0;
10904 L10:
10905  if (*ier == 6) {
10906  lvl = 1;
10907  }
10908  if (*ier != 0) {
10909  xerror_("abnormal return from qag ", &c__26, ier, &lvl, 26);
10910  }
10911  return;
10912 } /* qag_ */
10913 
10914 void qagie_(const E_fp& f, const sys_float *bound, const long *inf,
10915  const sys_float *epsabs, const sys_float *epsrel,
10916  const long *limit,
10917  sys_float *result, sys_float *abserr, long *neval,
10918  long *ier, sys_float *alist__, sys_float *blist, sys_float *rlist,
10919  sys_float *elist, long *iord, long *last)
10920 {
10921  /* System generated locals */
10922  int i__1, i__2;
10923  sys_float r__1, r__2;
10924 
10925  /* Local variables */
10926  long k;
10927  sys_float a1, a2, b1, b2;
10928  long id;
10929  sys_float area;
10930  sys_float dres;
10931  long ksgn;
10932  sys_float boun;
10933  long nres;
10934  sys_float area1, area2, area12, small=0.f, erro12;
10935  long ierro;
10936  sys_float defab1, defab2;
10937  long ktmin, nrmax;
10938  sys_float oflow, uflow;
10939  bool noext;
10940  long iroff1, iroff2, iroff3;
10941  sys_float res3la[3], error1, error2, rlist2[52];
10942  long numrl2;
10943  sys_float defabs, epmach, erlarg=0.f, abseps, correc=0.f, errbnd, resabs;
10944  long jupbnd;
10945  sys_float erlast, errmax;
10946  long maxerr;
10947  sys_float reseps;
10948  bool extrap;
10949  sys_float ertest=0.f, errsum;
10950 
10951  /* ***begin prologue qagie */
10952  /* ***date written 800101 (yymmdd) */
10953  /* ***revision date 830518 (yymmdd) */
10954  /* ***category no. h2a3a1,h2a4a1 */
10955  /* ***keywords automatic integrator, infinite intervals, */
10956  /* general-purpose, transformation, extrapolation, */
10957  /* globally adaptive */
10958  /* ***author piessens,robert,appl. math & progr. div - k.u.leuven */
10959  /* de doncker,elise,appl. math & progr. div - k.u.leuven */
10960  /* ***purpose the routine calculates an approximation result to a given */
10961  /* integral i = integral of f over (bound,+infinity) */
10962  /* or i = integral of f over (-infinity,bound) */
10963  /* or i = integral of f over (-infinity,+infinity), */
10964  /* hopefully satisfying following claim for accuracy */
10965  /* fabs(i-result).le.max(epsabs,epsrel*fabs(i)) */
10966  /* ***description */
10967 
10968  /* integration over infinite intervals */
10969  /* standard fortran subroutine */
10970 
10971  /* f - sys_float */
10972  /* function subprogram defining the integrand */
10973  /* function f(x). the actual name for f needs to be */
10974  /* declared e x t e r n a l in the driver program. */
10975 
10976  /* bound - sys_float */
10977  /* finite bound of integration range */
10978  /* (has no meaning if interval is doubly-infinite) */
10979 
10980  /* inf - sys_float */
10981  /* indicating the kind of integration range involved */
10982  /* inf = 1 corresponds to (bound,+infinity), */
10983  /* inf = -1 to (-infinity,bound), */
10984  /* inf = 2 to (-infinity,+infinity). */
10985 
10986  /* epsabs - sys_float */
10987  /* absolute accuracy requested */
10988  /* epsrel - sys_float */
10989  /* relative accuracy requested */
10990  /* if epsabs.le.0 */
10991  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
10992  /* the routine will end with ier = 6. */
10993 
10994  /* limit - long */
10995  /* gives an upper bound on the number of subintervals */
10996  /* in the partition of (a,b), limit.ge.1 */
10997 
10998  /* on return */
10999  /* result - sys_float */
11000  /* approximation to the integral */
11001 
11002  /* abserr - sys_float */
11003  /* estimate of the modulus of the absolute error, */
11004  /* which should equal or exceed fabs(i-result) */
11005 
11006  /* neval - long */
11007  /* number of integrand evaluations */
11008 
11009  /* ier - long */
11010  /* ier = 0 normal and reliable termination of the */
11011  /* routine. it is assumed that the requested */
11012  /* accuracy has been achieved. */
11013  /* - ier.gt.0 abnormal termination of the routine. the */
11014  /* estimates for result and error are less */
11015  /* reliable. it is assumed that the requested */
11016  /* accuracy has not been achieved. */
11017  /* error messages */
11018  /* ier = 1 maximum number of subdivisions allowed */
11019  /* has been achieved. one can allow more */
11020  /* subdivisions by increasing the value of */
11021  /* limit (and taking the according dimension */
11022  /* adjustments into account). however,if */
11023  /* this yields no improvement it is advised */
11024  /* to analyze the integrand in order to */
11025  /* determine the integration difficulties. */
11026  /* if the position of a local difficulty can */
11027  /* be determined (e.g. singularity, */
11028  /* discontinuity within the interval) one */
11029  /* will probably gain from splitting up the */
11030  /* interval at this point and calling the */
11031  /* integrator on the subranges. if possible, */
11032  /* an appropriate special-purpose integrator */
11033  /* should be used, which is designed for */
11034  /* handling the type of difficulty involved. */
11035  /* = 2 the occurrence of roundoff error is */
11036  /* detected, which prevents the requested */
11037  /* tolerance from being achieved. */
11038  /* the error may be under-estimated. */
11039  /* = 3 extremely bad integrand behaviour occurs */
11040  /* at some points of the integration */
11041  /* interval. */
11042  /* = 4 the algorithm does not converge. */
11043  /* roundoff error is detected in the */
11044  /* extrapolation table. */
11045  /* it is assumed that the requested tolerance */
11046  /* cannot be achieved, and that the returned */
11047  /* result is the best which can be obtained. */
11048  /* = 5 the integral is probably divergent, or */
11049  /* slowly convergent. it must be noted that */
11050  /* divergence can occur with any other value */
11051  /* of ier. */
11052  /* = 6 the input is invalid, because */
11053  /* (epsabs.le.0 and */
11054  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
11055  /* result, abserr, neval, last, rlist(1), */
11056  /* elist(1) and iord(1) are set to zero. */
11057  /* alist(1) and blist(1) are set to 0 */
11058  /* and 1 respectively. */
11059 
11060  /* alist - sys_float */
11061  /* vector of dimension at least limit, the first */
11062  /* last elements of which are the left */
11063  /* end points of the subintervals in the partition */
11064  /* of the transformed integration range (0,1). */
11065 
11066  /* blist - sys_float */
11067  /* vector of dimension at least limit, the first */
11068  /* last elements of which are the right */
11069  /* end points of the subintervals in the partition */
11070  /* of the transformed integration range (0,1). */
11071 
11072  /* rlist - sys_float */
11073  /* vector of dimension at least limit, the first */
11074  /* last elements of which are the integral */
11075  /* approximations on the subintervals */
11076 
11077  /* elist - sys_float */
11078  /* vector of dimension at least limit, the first */
11079  /* last elements of which are the moduli of the */
11080  /* absolute error estimates on the subintervals */
11081 
11082  /* iord - long */
11083  /* vector of dimension limit, the first k */
11084  /* elements of which are pointers to the */
11085  /* error estimates over the subintervals, */
11086  /* such that elist(iord(1)), ..., elist(iord(k)) */
11087  /* form a decreasing sequence, with k = last */
11088  /* if last.le.(limit/2+2), and k = limit+1-last */
11089  /* otherwise */
11090 
11091  /* last - long */
11092  /* number of subintervals actually produced */
11093  /* in the subdivision process */
11094 
11095  /* ***references (none) */
11096  /* ***routines called qelg,qk15i,qpsrt,r1mach */
11097  /* ***end prologue qagie */
11098 
11099 
11100 
11101 
11102  /* the dimension of rlist2 is determined by the value of */
11103  /* limexp in subroutine qelg. */
11104 
11105 
11106  /* list of major variables */
11107  /* ----------------------- */
11108 
11109  /* alist - list of left end points of all subintervals */
11110  /* considered up to now */
11111  /* blist - list of right end points of all subintervals */
11112  /* considered up to now */
11113  /* rlist(i) - approximation to the integral over */
11114  /* (alist(i),blist(i)) */
11115  /* rlist2 - array of dimension at least (limexp+2), */
11116  /* containing the part of the epsilon table */
11117  /* wich is still needed for further computations */
11118  /* elist(i) - error estimate applying to rlist(i) */
11119  /* maxerr - pointer to the interval with largest error */
11120  /* estimate */
11121  /* errmax - elist(maxerr) */
11122  /* erlast - error on the interval currently subdivided */
11123  /* (before that subdivision has taken place) */
11124  /* area - sum of the integrals over the subintervals */
11125  /* errsum - sum of the errors over the subintervals */
11126  /* errbnd - requested accuracy max(epsabs,epsrel* */
11127  /* fabs(result)) */
11128  /* *****1 - variable for the left subinterval */
11129  /* *****2 - variable for the right subinterval */
11130  /* last - index for subdivision */
11131  /* nres - number of calls to the extrapolation routine */
11132  /* numrl2 - number of elements currently in rlist2. if an */
11133  /* appropriate approximation to the compounded */
11134  /* integral has been obtained, it is put in */
11135  /* rlist2(numrl2) after numrl2 has been increased */
11136  /* by one. */
11137  /* small - length of the smallest interval considered up */
11138  /* to now, multiplied by 1.5 */
11139  /* erlarg - sum of the errors over the intervals larger */
11140  /* than the smallest interval considered up to now */
11141  /* extrap - bool variable denoting that the routine */
11142  /* is attempting to perform extrapolation. i.e. */
11143  /* before subdividing the smallest interval we */
11144  /* try to decrease the value of erlarg. */
11145  /* noext - bool variable denoting that extrapolation */
11146  /* is no longer allowed (true-value) */
11147 
11148  /* machine dependent constants */
11149  /* --------------------------- */
11150 
11151  /* epmach is the largest relative spacing. */
11152  /* uflow is the smallest positive magnitude. */
11153  /* oflow is the largest positive magnitude. */
11154 
11155  /* Parameter adjustments */
11156  --iord;
11157  --elist;
11158  --rlist;
11159  --blist;
11160  --alist__;
11161 
11162  /* Function Body */
11163  epmach = r1mach(c__4);
11164 
11165  /* test on validity of parameters */
11166  /* ----------------------------- */
11167 
11168  /* ***first executable statement qagie */
11169  *ier = 0;
11170  *neval = 0;
11171  *last = 0;
11172  *result = 0.f;
11173  *abserr = 0.f;
11174  alist__[1] = 0.f;
11175  blist[1] = 1.f;
11176  rlist[1] = 0.f;
11177  elist[1] = 0.f;
11178  iord[1] = 0;
11179  /* Computing MAX */
11180  r__1 = epmach * 50.f;
11181  if (*epsabs <= 0.f && *epsrel < max(r__1,5e-15f)) {
11182  *ier = 6;
11183  }
11184  if (*ier == 6) {
11185  goto L999;
11186  }
11187 
11188 
11189  /* first approximation to the integral */
11190  /* ----------------------------------- */
11191 
11192  /* determine the interval to be mapped onto (0,1). */
11193  /* if inf = 2 the integral is computed as i = i1+i2, where */
11194  /* i1 = integral of f over (-infinity,0), */
11195  /* i2 = integral of f over (0,+infinity). */
11196 
11197  boun = *bound;
11198  if (*inf == 2) {
11199  boun = 0.f;
11200  }
11201  qk15i_(f, &boun, inf, &c_b390, &c_b391, result, abserr, &defabs, &
11202  resabs);
11203 
11204  /* test on accuracy */
11205 
11206  *last = 1;
11207  rlist[1] = *result;
11208  elist[1] = *abserr;
11209  iord[1] = 1;
11210  dres = fabs(*result);
11211  /* Computing MAX */
11212  r__1 = *epsabs, r__2 = *epsrel * dres;
11213  errbnd = max(r__1,r__2);
11214  if (*abserr <= epmach * 100.f * defabs && *abserr > errbnd) {
11215  *ier = 2;
11216  }
11217  if (*limit == 1) {
11218  *ier = 1;
11219  }
11220  if (*ier != 0 || ( *abserr <= errbnd && *abserr != resabs ) || *abserr == 0.f)
11221  {
11222  goto L130;
11223  }
11224 
11225  /* initialization */
11226  /* -------------- */
11227 
11228  uflow = r1mach(c__1);
11229  oflow = r1mach(c__2);
11230  rlist2[0] = *result;
11231  errmax = *abserr;
11232  maxerr = 1;
11233  area = *result;
11234  errsum = *abserr;
11235  *abserr = oflow;
11236  nrmax = 1;
11237  nres = 0;
11238  ktmin = 0;
11239  numrl2 = 2;
11240  extrap = false;
11241  noext = false;
11242  ierro = 0;
11243  iroff1 = 0;
11244  iroff2 = 0;
11245  iroff3 = 0;
11246  ksgn = -1;
11247  if (dres >= (1.f - epmach * 50.f) * defabs) {
11248  ksgn = 1;
11249  }
11250 
11251  /* main do-loop */
11252  /* ------------ */
11253 
11254  i__1 = *limit;
11255  for (*last = 2; *last <= i__1; ++(*last)) {
11256 
11257  /* bisect the subinterval with nrmax-th largest */
11258  /* error estimate. */
11259 
11260  a1 = alist__[maxerr];
11261  b1 = (alist__[maxerr] + blist[maxerr]) * .5f;
11262  a2 = b1;
11263  b2 = blist[maxerr];
11264  erlast = errmax;
11265  qk15i_(f, &boun, inf, &a1, &b1, &area1, &error1, &resabs, &
11266  defab1);
11267  qk15i_(f, &boun, inf, &a2, &b2, &area2, &error2, &resabs, &
11268  defab2);
11269 
11270  /* improve previous approximations to integral */
11271  /* and error and test for accuracy. */
11272 
11273  area12 = area1 + area2;
11274  erro12 = error1 + error2;
11275  errsum = errsum + erro12 - errmax;
11276  area = area + area12 - rlist[maxerr];
11277  if (defab1 == error1 || defab2 == error2) {
11278  goto L15;
11279  }
11280  if ((r__1 = rlist[maxerr] - area12, fabs(r__1)) > fabs(area12) *
11281  1e-5f || erro12 < errmax * .99f) {
11282  goto L10;
11283  }
11284  if (extrap) {
11285  ++iroff2;
11286  }
11287  if (! extrap) {
11288  ++iroff1;
11289  }
11290  L10:
11291  if (*last > 10 && erro12 > errmax) {
11292  ++iroff3;
11293  }
11294  L15:
11295  rlist[maxerr] = area1;
11296  rlist[*last] = area2;
11297  /* Computing MAX */
11298  r__1 = *epsabs, r__2 = *epsrel * fabs(area);
11299  errbnd = max(r__1,r__2);
11300 
11301  /* test for roundoff error and eventually */
11302  /* set error flag. */
11303 
11304  if (iroff1 + iroff2 >= 10 || iroff3 >= 20) {
11305  *ier = 2;
11306  }
11307  if (iroff2 >= 5) {
11308  ierro = 3;
11309  }
11310 
11311  /* set error flag in the case that the number of */
11312  /* subintervals equals limit. */
11313 
11314  if (*last == *limit) {
11315  *ier = 1;
11316  }
11317 
11318  /* set error flag in the case of bad integrand behaviour */
11319  /* at some points of the integration range. */
11320 
11321  /* Computing MAX */
11322  r__1 = fabs(a1), r__2 = fabs(b2);
11323  if (max(r__1,r__2) <= (epmach * 100.f + 1.f) * (fabs(a2) + uflow *
11324  1e3f)) {
11325  *ier = 4;
11326  }
11327 
11328  /* append the newly-created intervals to the list. */
11329 
11330  if (error2 > error1) {
11331  goto L20;
11332  }
11333  alist__[*last] = a2;
11334  blist[maxerr] = b1;
11335  blist[*last] = b2;
11336  elist[maxerr] = error1;
11337  elist[*last] = error2;
11338  goto L30;
11339  L20:
11340  alist__[maxerr] = a2;
11341  alist__[*last] = a1;
11342  blist[*last] = b1;
11343  rlist[maxerr] = area2;
11344  rlist[*last] = area1;
11345  elist[maxerr] = error2;
11346  elist[*last] = error1;
11347 
11348  /* call subroutine qpsrt to maintain the descending ordering */
11349  /* in the list of error estimates and select the */
11350  /* subinterval with nrmax-th largest error estimate (to be */
11351  /* bisected next). */
11352 
11353  L30:
11354  qpsrt_(limit, last, &maxerr, &errmax, &elist[1], &iord[1], &nrmax);
11355  if (errsum <= errbnd) {
11356  goto L115;
11357  }
11358  if (*ier != 0) {
11359  goto L100;
11360  }
11361  if (*last == 2) {
11362  goto L80;
11363  }
11364  if (noext) {
11365  goto L90;
11366  }
11367  erlarg -= erlast;
11368  if ((r__1 = b1 - a1, fabs(r__1)) > small) {
11369  erlarg += erro12;
11370  }
11371  if (extrap) {
11372  goto L40;
11373  }
11374 
11375  /* test whether the interval to be bisected next is the */
11376  /* smallest interval. */
11377 
11378  if ((r__1 = blist[maxerr] - alist__[maxerr], fabs(r__1)) > small) {
11379  goto L90;
11380  }
11381  extrap = true;
11382  nrmax = 2;
11383  L40:
11384  if (ierro == 3 || erlarg <= ertest) {
11385  goto L60;
11386  }
11387 
11388  /* the smallest interval has the largest error. */
11389  /* before bisecting decrease the sum of the errors */
11390  /* over the larger intervals (erlarg) and perform */
11391  /* extrapolation. */
11392 
11393  id = nrmax;
11394  jupbnd = *last;
11395  if (*last > *limit / 2 + 2) {
11396  jupbnd = *limit + 3 - *last;
11397  }
11398  i__2 = jupbnd;
11399  for (k = id; k <= i__2; ++k) {
11400  maxerr = iord[nrmax];
11401  errmax = elist[maxerr];
11402  if ((r__1 = blist[maxerr] - alist__[maxerr], fabs(r__1)) > small)
11403  {
11404  goto L90;
11405  }
11406  ++nrmax;
11407  /* L50: */
11408  }
11409 
11410  /* perform extrapolation. */
11411 
11412  L60:
11413  ++numrl2;
11414  rlist2[numrl2 - 1] = area;
11415  qelg_(&numrl2, rlist2, &reseps, &abseps, res3la, &nres);
11416  ++ktmin;
11417  if (ktmin > 5 && *abserr < errsum * .001f) {
11418  *ier = 5;
11419  }
11420  if (abseps >= *abserr) {
11421  goto L70;
11422  }
11423  ktmin = 0;
11424  *abserr = abseps;
11425  *result = reseps;
11426  correc = erlarg;
11427  /* Computing MAX */
11428  r__1 = *epsabs, r__2 = *epsrel * fabs(reseps);
11429  ertest = max(r__1,r__2);
11430  if (*abserr <= ertest) {
11431  goto L100;
11432  }
11433 
11434  /* prepare bisection of the smallest interval. */
11435 
11436  L70:
11437  if (numrl2 == 1) {
11438  noext = true;
11439  }
11440  if (*ier == 5) {
11441  goto L100;
11442  }
11443  maxerr = iord[1];
11444  errmax = elist[maxerr];
11445  nrmax = 1;
11446  extrap = false;
11447  small *= .5f;
11448  erlarg = errsum;
11449  goto L90;
11450  L80:
11451  small = .375f;
11452  erlarg = errsum;
11453  ertest = errbnd;
11454  rlist2[1] = area;
11455  L90:
11456  ;
11457  }
11458 
11459  /* set final result and error estimate. */
11460  /* ------------------------------------ */
11461 
11462 L100:
11463  if (*abserr == oflow) {
11464  goto L115;
11465  }
11466  if (*ier + ierro == 0) {
11467  goto L110;
11468  }
11469  if (ierro == 3) {
11470  *abserr += correc;
11471  }
11472  if (*ier == 0) {
11473  *ier = 3;
11474  }
11475  if (*result != 0.f && area != 0.f) {
11476  goto L105;
11477  }
11478  if (*abserr > errsum) {
11479  goto L115;
11480  }
11481  if (area == 0.f) {
11482  goto L130;
11483  }
11484  goto L110;
11485 L105:
11486  if (*abserr / fabs(*result) > errsum / fabs(area)) {
11487  goto L115;
11488  }
11489 
11490  /* test on divergence */
11491 
11492 L110:
11493  /* Computing MAX */
11494  r__1 = fabs(*result), r__2 = fabs(area);
11495  if (ksgn == -1 && max(r__1,r__2) <= defabs * .01f) {
11496  goto L130;
11497  }
11498  if (.01f > *result / area || *result / area > 100.f || errsum > fabs(area)
11499  ) {
11500  *ier = 6;
11501  }
11502  goto L130;
11503 
11504  /* compute global integral sum. */
11505 
11506 L115:
11507  *result = 0.f;
11508  i__1 = *last;
11509  for (k = 1; k <= i__1; ++k) {
11510  *result += rlist[k];
11511  /* L120: */
11512  }
11513  *abserr = errsum;
11514 L130:
11515  *neval = *last * 30 - 15;
11516  if (*inf == 2) {
11517  *neval <<= 1;
11518  }
11519  if (*ier > 2) {
11520  --(*ier);
11521  }
11522 L999:
11523  return;
11524 } /* qagie_ */
11525 
11526 void qagi_(const E_fp& f, const sys_float *bound, const long *inf,
11527  const sys_float *epsabs, const sys_float *epsrel,
11528  sys_float *result, sys_float *abserr, long *neval,
11529  long *ier, const long *limit, const long *lenw, long *last,
11530  long *iwork, sys_float *work)
11531 {
11532  long l1, l2, l3, lvl;
11533 
11534  /* ***begin prologue qagi */
11535  /* ***date written 800101 (yymmdd) */
11536  /* ***revision date 830518 (yymmdd) */
11537  /* ***category no. h2a3a1,h2a4a1 */
11538  /* ***keywords automatic integrator, infinite intervals, */
11539  /* general-purpose, transformation, extrapolation, */
11540  /* globally adaptive */
11541  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
11542  /* de doncker,elise,appl. math. & progr. div. -k.u.leuven */
11543  /* ***purpose the routine calculates an approximation result to a given */
11544  /* integral i = integral of f over (bound,+infinity) */
11545  /* or i = integral of f over (-infinity,bound) */
11546  /* or i = integral of f over (-infinity,+infinity) */
11547  /* hopefully satisfying following claim for accuracy */
11548  /* fabs(i-result).le.max(epsabs,epsrel*fabs(i)). */
11549  /* ***description */
11550 
11551  /* integration over infinite intervals */
11552  /* standard fortran subroutine */
11553 
11554  /* parameters */
11555  /* on entry */
11556  /* f - sys_float */
11557  /* function subprogram defining the integrand */
11558  /* function f(x). the actual name for f needs to be */
11559  /* declared e x t e r n a l in the driver program. */
11560 
11561  /* bound - sys_float */
11562  /* finite bound of integration range */
11563  /* (has no meaning if interval is doubly-infinite) */
11564 
11565  /* inf - long */
11566  /* indicating the kind of integration range involved */
11567  /* inf = 1 corresponds to (bound,+infinity), */
11568  /* inf = -1 to (-infinity,bound), */
11569  /* inf = 2 to (-infinity,+infinity). */
11570 
11571  /* epsabs - sys_float */
11572  /* absolute accuracy requested */
11573  /* epsrel - sys_float */
11574  /* relative accuracy requested */
11575  /* if epsabs.le.0 */
11576  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
11577  /* the routine will end with ier = 6. */
11578 
11579 
11580  /* on return */
11581  /* result - sys_float */
11582  /* approximation to the integral */
11583 
11584  /* abserr - sys_float */
11585  /* estimate of the modulus of the absolute error, */
11586  /* which should equal or exceed fabs(i-result) */
11587 
11588  /* neval - long */
11589  /* number of integrand evaluations */
11590 
11591  /* ier - long */
11592  /* ier = 0 normal and reliable termination of the */
11593  /* routine. it is assumed that the requested */
11594  /* accuracy has been achieved. */
11595  /* - ier.gt.0 abnormal termination of the routine. the */
11596  /* estimates for result and error are less */
11597  /* reliable. it is assumed that the requested */
11598  /* accuracy has not been achieved. */
11599  /* error messages */
11600  /* ier = 1 maximum number of subdivisions allowed */
11601  /* has been achieved. one can allow more */
11602  /* subdivisions by increasing the value of */
11603  /* limit (and taking the according dimension */
11604  /* adjustments into account). however, if */
11605  /* this yields no improvement it is advised */
11606  /* to analyze the integrand in order to */
11607  /* determine the integration difficulties. if */
11608  /* the position of a local difficulty can be */
11609  /* determined (e.g. singularity, */
11610  /* discontinuity within the interval) one */
11611  /* will probably gain from splitting up the */
11612  /* interval at this point and calling the */
11613  /* integrator on the subranges. if possible, */
11614  /* an appropriate special-purpose integrator */
11615  /* should be used, which is designed for */
11616  /* handling the type of difficulty involved. */
11617  /* = 2 the occurrence of roundoff error is */
11618  /* detected, which prevents the requested */
11619  /* tolerance from being achieved. */
11620  /* the error may be under-estimated. */
11621  /* = 3 extremely bad integrand behaviour occurs */
11622  /* at some points of the integration */
11623  /* interval. */
11624  /* = 4 the algorithm does not converge. */
11625  /* roundoff error is detected in the */
11626  /* extrapolation table. */
11627  /* it is assumed that the requested tolerance */
11628  /* cannot be achieved, and that the returned */
11629  /* result is the best which can be obtained. */
11630  /* = 5 the integral is probably divergent, or */
11631  /* slowly convergent. it must be noted that */
11632  /* divergence can occur with any other value */
11633  /* of ier. */
11634  /* = 6 the input is invalid, because */
11635  /* (epsabs.le.0 and */
11636  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28)) */
11637  /* or limit.lt.1 or leniw.lt.limit*4. */
11638  /* result, abserr, neval, last are set to */
11639  /* zero. exept when limit or leniw is */
11640  /* invalid, iwork(1), work(limit*2+1) and */
11641  /* work(limit*3+1) are set to zero, work(1) */
11642  /* is set to a and work(limit+1) to b. */
11643 
11644  /* dimensioning parameters */
11645  /* limit - long */
11646  /* dimensioning parameter for iwork */
11647  /* limit determines the maximum number of subintervals */
11648  /* in the partition of the given integration interval */
11649  /* (a,b), limit.ge.1. */
11650  /* if limit.lt.1, the routine will end with ier = 6. */
11651 
11652  /* lenw - long */
11653  /* dimensioning parameter for work */
11654  /* lenw must be at least limit*4. */
11655  /* if lenw.lt.limit*4, the routine will end */
11656  /* with ier = 6. */
11657 
11658  /* last - long */
11659  /* on return, last equals the number of subintervals */
11660  /* produced in the subdivision process, which */
11661  /* determines the number of significant elements */
11662  /* actually in the work arrays. */
11663 
11664  /* work arrays */
11665  /* iwork - long */
11666  /* vector of dimension at least limit, the first */
11667  /* k elements of which contain pointers */
11668  /* to the error estimates over the subintervals, */
11669  /* such that work(limit*3+iwork(1)),... , */
11670  /* work(limit*3+iwork(k)) form a decreasing */
11671  /* sequence, with k = last if last.le.(limit/2+2), and */
11672  /* k = limit+1-last otherwise */
11673 
11674  /* work - sys_float */
11675  /* vector of dimension at least lenw */
11676  /* on return */
11677  /* work(1), ..., work(last) contain the left */
11678  /* end points of the subintervals in the */
11679  /* partition of (a,b), */
11680  /* work(limit+1), ..., work(limit+last) contain */
11681  /* the right end points, */
11682  /* work(limit*2+1), ...,work(limit*2+last) contain the */
11683  /* integral approximations over the subintervals, */
11684  /* work(limit*3+1), ..., work(limit*3) */
11685  /* contain the error estimates. */
11686  /* ***references (none) */
11687  /* ***routines called qagie,xerror */
11688  /* ***end prologue qagi */
11689 
11690 
11691 
11692 
11693  /* check validity of limit and lenw. */
11694 
11695  /* ***first executable statement qagi */
11696  /* Parameter adjustments */
11697  --iwork;
11698  --work;
11699 
11700  /* Function Body */
11701  *ier = 6;
11702  *neval = 0;
11703  *last = 0;
11704  *result = 0.f;
11705  *abserr = 0.f;
11706  if (*limit < 1 || *lenw < *limit << 2) {
11707  goto L10;
11708  }
11709 
11710  /* prepare call for qagie. */
11711 
11712  l1 = *limit + 1;
11713  l2 = *limit + l1;
11714  l3 = *limit + l2;
11715 
11716  qagie_(f, bound, inf, epsabs, epsrel, limit, result, abserr, neval,
11717  ier, &work[1], &work[l1], &work[l2], &work[l3], &iwork[1], last);
11718 
11719  /* call error handler if necessary. */
11720 
11721  lvl = 0;
11722 L10:
11723  if (*ier == 6) {
11724  lvl = 1;
11725  }
11726  if (*ier != 0) {
11727  xerror_("abnormal return from qagi", &c__26, ier, &lvl, 26);
11728  }
11729  return;
11730 } /* qagi_ */
11731 
11732 void qagpe_(const E_fp& f, const sys_float *a, const sys_float *b, const long *npts2,
11733  const sys_float *points, const sys_float *epsabs,
11734  const sys_float *epsrel, const long *limit, sys_float *result,
11735  sys_float *abserr, long *neval, long *ier, sys_float *alist__,
11736  sys_float *blist, sys_float *rlist, sys_float *elist,
11737  sys_float *pts, long *iord, long *level, long *ndin, long *last)
11738 {
11739  /* System generated locals */
11740  int i__1, i__2;
11741  sys_float r__1, r__2;
11742 
11743  /* Local variables */
11744  long i__, j, k=0;
11745  sys_float a1, a2, b1, b2;
11746  long id, ip1;
11747  long ind1, ind2;
11748  sys_float area;
11749  sys_float resa, dres, sign=0.f;
11750  long ksgn;
11751  sys_float temp;
11752  long nres, nint, jlow, npts;
11753  sys_float area1, area2, area12, erro12;
11754  long ierro;
11755  sys_float defab1, defab2;
11756  long ktmin, nrmax;
11757  sys_float oflow, uflow;
11758  bool noext;
11759  long iroff1, iroff2, iroff3;
11760  sys_float res3la[3];
11761  long nintp1;
11762  sys_float error1, error2, rlist2[52];
11763  long numrl2;
11764  sys_float defabs, epmach, erlarg, abseps, correc=0.f, errbnd, resabs;
11765  long jupbnd;
11766  sys_float erlast;
11767  long levmax;
11768  sys_float errmax;
11769  long maxerr, levcur;
11770  sys_float reseps;
11771  bool extrap;
11772  sys_float ertest, errsum;
11773 
11774  /* ***begin prologue qagpe */
11775  /* ***date written 800101 (yymmdd) */
11776  /* ***revision date 830518 (yymmdd) */
11777  /* ***category no. h2a2a1 */
11778  /* ***keywords automatic integrator, general-purpose, */
11779  /* singularities at user specified points, */
11780  /* extrapolation, globally adaptive. */
11781  /* ***author piessens,robert ,appl. math. & progr. div. - k.u.leuven */
11782  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
11783  /* ***purpose the routine calculates an approximation result to a given */
11784  /* definite integral i = integral of f over (a,b),hopefully */
11785  /* satisfying following claim for accuracy fabs(i-result).le. */
11786  /* max(epsabs,epsrel*fabs(i)). break points of the integration */
11787  /* interval, where local difficulties of the integrand may */
11788  /* occur(e.g. singularities,discontinuities),provided by user. */
11789  /* ***description */
11790 
11791  /* computation of a definite integral */
11792  /* standard fortran subroutine */
11793  /* sys_float version */
11794 
11795  /* parameters */
11796  /* on entry */
11797  /* f - sys_float */
11798  /* function subprogram defining the integrand */
11799  /* function f(x). the actual name for f needs to be */
11800  /* declared e x t e r n a l in the driver program. */
11801 
11802  /* a - sys_float */
11803  /* lower limit of integration */
11804 
11805  /* b - sys_float */
11806  /* upper limit of integration */
11807 
11808  /* npts2 - long */
11809  /* number equal to two more than the number of */
11810  /* user-supplied break points within the integration */
11811  /* range, npts2.ge.2. */
11812  /* if npts2.lt.2, the routine will end with ier = 6. */
11813 
11814  /* points - sys_float */
11815  /* vector of dimension npts2, the first (npts2-2) */
11816  /* elements of which are the user provided break */
11817  /* points. if these points do not constitute an */
11818  /* ascending sequence there will be an automatic */
11819  /* sorting. */
11820 
11821  /* epsabs - sys_float */
11822  /* absolute accuracy requested */
11823  /* epsrel - sys_float */
11824  /* relative accuracy requested */
11825  /* if epsabs.le.0 */
11826  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
11827  /* the routine will end with ier = 6. */
11828 
11829  /* limit - long */
11830  /* gives an upper bound on the number of subintervals */
11831  /* in the partition of (a,b), limit.ge.npts2 */
11832  /* if limit.lt.npts2, the routine will end with */
11833  /* ier = 6. */
11834 
11835  /* on return */
11836  /* result - sys_float */
11837  /* approximation to the integral */
11838 
11839  /* abserr - sys_float */
11840  /* estimate of the modulus of the absolute error, */
11841  /* which should equal or exceed fabs(i-result) */
11842 
11843  /* neval - long */
11844  /* number of integrand evaluations */
11845 
11846  /* ier - long */
11847  /* ier = 0 normal and reliable termination of the */
11848  /* routine. it is assumed that the requested */
11849  /* accuracy has been achieved. */
11850  /* ier.gt.0 abnormal termination of the routine. */
11851  /* the estimates for integral and error are */
11852  /* less reliable. it is assumed that the */
11853  /* requested accuracy has not been achieved. */
11854  /* error messages */
11855  /* ier = 1 maximum number of subdivisions allowed */
11856  /* has been achieved. one can allow more */
11857  /* subdivisions by increasing the value of */
11858  /* limit (and taking the according dimension */
11859  /* adjustments into account). however, if */
11860  /* this yields no improvement it is advised */
11861  /* to analyze the integrand in order to */
11862  /* determine the integration difficulties. if */
11863  /* the position of a local difficulty can be */
11864  /* determined (i.e. singularity, */
11865  /* discontinuity within the interval), it */
11866  /* should be supplied to the routine as an */
11867  /* element of the vector points. if necessary */
11868  /* an appropriate special-purpose integrator */
11869  /* must be used, which is designed for */
11870  /* handling the type of difficulty involved. */
11871  /* = 2 the occurrence of roundoff error is */
11872  /* detected, which prevents the requested */
11873  /* tolerance from being achieved. */
11874  /* the error may be under-estimated. */
11875  /* = 3 extremely bad integrand behaviour occurs */
11876  /* at some points of the integration */
11877  /* interval. */
11878  /* = 4 the algorithm does not converge. */
11879  /* roundoff error is detected in the */
11880  /* extrapolation table. it is presumed that */
11881  /* the requested tolerance cannot be */
11882  /* achieved, and that the returned result is */
11883  /* the best which can be obtained. */
11884  /* = 5 the integral is probably divergent, or */
11885  /* slowly convergent. it must be noted that */
11886  /* divergence can occur with any other value */
11887  /* of ier.gt.0. */
11888  /* = 6 the input is invalid because */
11889  /* npts2.lt.2 or */
11890  /* break points are specified outside */
11891  /* the integration range or */
11892  /* (epsabs.le.0 and */
11893  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28)) */
11894  /* or limit.lt.npts2. */
11895  /* result, abserr, neval, last, rlist(1), */
11896  /* and elist(1) are set to zero. alist(1) and */
11897  /* blist(1) are set to a and b respectively. */
11898 
11899  /* alist - sys_float */
11900  /* vector of dimension at least limit, the first */
11901  /* last elements of which are the left end points */
11902  /* of the subintervals in the partition of the given */
11903  /* integration range (a,b) */
11904 
11905  /* blist - sys_float */
11906  /* vector of dimension at least limit, the first */
11907  /* last elements of which are the right end points */
11908  /* of the subintervals in the partition of the given */
11909  /* integration range (a,b) */
11910 
11911  /* rlist - sys_float */
11912  /* vector of dimension at least limit, the first */
11913  /* last elements of which are the integral */
11914  /* approximations on the subintervals */
11915 
11916  /* elist - sys_float */
11917  /* vector of dimension at least limit, the first */
11918  /* last elements of which are the moduli of the */
11919  /* absolute error estimates on the subintervals */
11920 
11921  /* pts - sys_float */
11922  /* vector of dimension at least npts2, containing the */
11923  /* integration limits and the break points of the */
11924  /* interval in ascending sequence. */
11925 
11926  /* level - long */
11927  /* vector of dimension at least limit, containing the */
11928  /* subdivision levels of the subinterval, i.e. if */
11929  /* (aa,bb) is a subinterval of (p1,p2) where p1 as */
11930  /* well as p2 is a user-provided break point or */
11931  /* integration limit, then (aa,bb) has level l if */
11932  /* fabs(bb-aa) = fabs(p2-p1)*2**(-l). */
11933 
11934  /* ndin - long */
11935  /* vector of dimension at least npts2, after first */
11936  /* integration over the intervals (pts(i)),pts(i+1), */
11937  /* i = 0,1, ..., npts2-2, the error estimates over */
11938  /* some of the intervals may have been increased */
11939  /* artificially, in order to put their subdivision */
11940  /* forward. if this happens for the subinterval */
11941  /* numbered k, ndin(k) is put to 1, otherwise */
11942  /* ndin(k) = 0. */
11943 
11944  /* iord - long */
11945  /* vector of dimension at least limit, the first k */
11946  /* elements of which are pointers to the */
11947  /* error estimates over the subintervals, */
11948  /* such that elist(iord(1)), ..., elist(iord(k)) */
11949  /* form a decreasing sequence, with k = last */
11950  /* if last.le.(limit/2+2), and k = limit+1-last */
11951  /* otherwise */
11952 
11953  /* last - long */
11954  /* number of subintervals actually produced in the */
11955  /* subdivisions process */
11956 
11957  /* ***references (none) */
11958  /* ***routines called qelg,qk21,qpsrt,r1mach */
11959  /* ***end prologue qagpe */
11960 
11961 
11962 
11963 
11964  /* the dimension of rlist2 is determined by the value of */
11965  /* limexp in subroutine epsalg (rlist2 should be of dimension */
11966  /* (limexp+2) at least). */
11967 
11968 
11969  /* list of major variables */
11970  /* ----------------------- */
11971 
11972  /* alist - list of left end points of all subintervals */
11973  /* considered up to now */
11974  /* blist - list of right end points of all subintervals */
11975  /* considered up to now */
11976  /* rlist(i) - approximation to the integral over */
11977  /* (alist(i),blist(i)) */
11978  /* rlist2 - array of dimension at least limexp+2 */
11979  /* containing the part of the epsilon table which */
11980  /* is still needed for further computations */
11981  /* elist(i) - error estimate applying to rlist(i) */
11982  /* maxerr - pointer to the interval with largest error */
11983  /* estimate */
11984  /* errmax - elist(maxerr) */
11985  /* erlast - error on the interval currently subdivided */
11986  /* (before that subdivision has taken place) */
11987  /* area - sum of the integrals over the subintervals */
11988  /* errsum - sum of the errors over the subintervals */
11989  /* errbnd - requested accuracy max(epsabs,epsrel* */
11990  /* fabs(result)) */
11991  /* *****1 - variable for the left subinterval */
11992  /* *****2 - variable for the right subinterval */
11993  /* last - index for subdivision */
11994  /* nres - number of calls to the extrapolation routine */
11995  /* numrl2 - number of elements in rlist2. if an */
11996  /* appropriate approximation to the compounded */
11997  /* integral has been obtained, it is put in */
11998  /* rlist2(numrl2) after numrl2 has been increased */
11999  /* by one. */
12000  /* erlarg - sum of the errors over the intervals larger */
12001  /* than the smallest interval considered up to now */
12002  /* extrap - bool variable denoting that the routine */
12003  /* is attempting to perform extrapolation. i.e. */
12004  /* before subdividing the smallest interval we */
12005  /* try to decrease the value of erlarg. */
12006  /* noext - bool variable denoting that extrapolation is */
12007  /* no longer allowed (true-value) */
12008 
12009  /* machine dependent constants */
12010  /* --------------------------- */
12011 
12012  /* epmach is the largest relative spacing. */
12013  /* uflow is the smallest positive magnitude. */
12014  /* oflow is the largest positive magnitude. */
12015 
12016  /* ***first executable statement qagpe */
12017  /* Parameter adjustments */
12018  --ndin;
12019  --pts;
12020  --points;
12021  --level;
12022  --iord;
12023  --elist;
12024  --rlist;
12025  --blist;
12026  --alist__;
12027 
12028  /* Function Body */
12029  epmach = r1mach(c__4);
12030 
12031  /* test on validity of parameters */
12032  /* ----------------------------- */
12033 
12034  *ier = 0;
12035  *neval = 0;
12036  *last = 0;
12037  *result = 0.f;
12038  *abserr = 0.f;
12039  alist__[1] = *a;
12040  blist[1] = *b;
12041  rlist[1] = 0.f;
12042  elist[1] = 0.f;
12043  iord[1] = 0;
12044  level[1] = 0;
12045  npts = *npts2 - 2;
12046  /* Computing MAX */
12047  r__1 = epmach * 50.f;
12048  if (*npts2 < 2 || *limit <= npts ||
12049  ( *epsabs <= 0.f && *epsrel < max(r__1, 5e-15f)) ) {
12050  *ier = 6;
12051  }
12052  if (*ier == 6) {
12053  goto L210;
12054  }
12055 
12056  /* if any break points are provided, sort them into an */
12057  /* ascending sequence. */
12058 
12059  sign = 1.f;
12060  if (*a > *b) {
12061  sign = -1.f;
12062  }
12063  pts[1] = min(*a,*b);
12064  if (npts == 0) {
12065  goto L15;
12066  }
12067  i__1 = npts;
12068  for (i__ = 1; i__ <= i__1; ++i__) {
12069  pts[i__ + 1] = points[i__];
12070  /* L10: */
12071  }
12072 L15:
12073  pts[npts + 2] = max(*a,*b);
12074  nint = npts + 1;
12075  a1 = pts[1];
12076  if (npts == 0) {
12077  goto L40;
12078  }
12079  nintp1 = nint + 1;
12080  i__1 = nint;
12081  for (i__ = 1; i__ <= i__1; ++i__) {
12082  ip1 = i__ + 1;
12083  i__2 = nintp1;
12084  for (j = ip1; j <= i__2; ++j) {
12085  if (pts[i__] <= pts[j]) {
12086  goto L20;
12087  }
12088  temp = pts[i__];
12089  pts[i__] = pts[j];
12090  pts[j] = temp;
12091  L20:
12092  ;
12093  }
12094  }
12095  if (pts[1] != min(*a,*b) || pts[nintp1] != max(*a,*b)) {
12096  *ier = 6;
12097  }
12098  if (*ier == 6) {
12099  goto L999;
12100  }
12101 
12102  /* compute first integral and error approximations. */
12103  /* ------------------------------------------------ */
12104 
12105 L40:
12106  resabs = 0.f;
12107  i__2 = nint;
12108  for (i__ = 1; i__ <= i__2; ++i__) {
12109  b1 = pts[i__ + 1];
12110  qk21_(f, &a1, &b1, &area1, &error1, &defabs, &resa);
12111  *abserr += error1;
12112  *result += area1;
12113  ndin[i__] = 0;
12114  if (error1 == resa && error1 != 0.f) {
12115  ndin[i__] = 1;
12116  }
12117  resabs += defabs;
12118  level[i__] = 0;
12119  elist[i__] = error1;
12120  alist__[i__] = a1;
12121  blist[i__] = b1;
12122  rlist[i__] = area1;
12123  iord[i__] = i__;
12124  a1 = b1;
12125  /* L50: */
12126  }
12127  errsum = 0.f;
12128  i__2 = nint;
12129  for (i__ = 1; i__ <= i__2; ++i__) {
12130  if (ndin[i__] == 1) {
12131  elist[i__] = *abserr;
12132  }
12133  errsum += elist[i__];
12134  /* L55: */
12135  }
12136 
12137  /* test on accuracy. */
12138 
12139  *last = nint;
12140  *neval = nint * 21;
12141  dres = fabs(*result);
12142  /* Computing MAX */
12143  r__1 = *epsabs, r__2 = *epsrel * dres;
12144  errbnd = max(r__1,r__2);
12145  if (*abserr <= epmach * 100.f * resabs && *abserr > errbnd) {
12146  *ier = 2;
12147  }
12148  if (nint == 1) {
12149  goto L80;
12150  }
12151  i__2 = npts;
12152  for (i__ = 1; i__ <= i__2; ++i__) {
12153  jlow = i__ + 1;
12154  ind1 = iord[i__];
12155  i__1 = nint;
12156  for (j = jlow; j <= i__1; ++j) {
12157  ind2 = iord[j];
12158  if (elist[ind1] > elist[ind2]) {
12159  goto L60;
12160  }
12161  ind1 = ind2;
12162  k = j;
12163  L60:
12164  ;
12165  }
12166  if (ind1 == iord[i__]) {
12167  goto L70;
12168  }
12169  iord[k] = iord[i__];
12170  iord[i__] = ind1;
12171  L70:
12172  ;
12173  }
12174  if (*limit < *npts2) {
12175  *ier = 1;
12176  }
12177 L80:
12178  if (*ier != 0 || *abserr <= errbnd) {
12179  goto L999;
12180  }
12181 
12182  /* initialization */
12183  /* -------------- */
12184 
12185  rlist2[0] = *result;
12186  maxerr = iord[1];
12187  errmax = elist[maxerr];
12188  area = *result;
12189  nrmax = 1;
12190  nres = 0;
12191  numrl2 = 1;
12192  ktmin = 0;
12193  extrap = false;
12194  noext = false;
12195  erlarg = errsum;
12196  ertest = errbnd;
12197  levmax = 1;
12198  iroff1 = 0;
12199  iroff2 = 0;
12200  iroff3 = 0;
12201  ierro = 0;
12202  uflow = r1mach(c__1);
12203  oflow = r1mach(c__2);
12204  *abserr = oflow;
12205  ksgn = -1;
12206  if (dres >= (1.f - epmach * 50.f) * resabs) {
12207  ksgn = 1;
12208  }
12209 
12210  /* main do-loop */
12211  /* ------------ */
12212 
12213  i__2 = *limit;
12214  for (*last = *npts2; *last <= i__2; ++(*last)) {
12215 
12216  /* bisect the subinterval with the nrmax-th largest */
12217  /* error estimate. */
12218 
12219  levcur = level[maxerr] + 1;
12220  a1 = alist__[maxerr];
12221  b1 = (alist__[maxerr] + blist[maxerr]) * .5f;
12222  a2 = b1;
12223  b2 = blist[maxerr];
12224  erlast = errmax;
12225  qk21_(f, &a1, &b1, &area1, &error1, &resa, &defab1);
12226  qk21_(f, &a2, &b2, &area2, &error2, &resa, &defab2);
12227 
12228  /* improve previous approximations to integral */
12229  /* and error and test for accuracy. */
12230 
12231  *neval += 42;
12232  area12 = area1 + area2;
12233  erro12 = error1 + error2;
12234  errsum = errsum + erro12 - errmax;
12235  area = area + area12 - rlist[maxerr];
12236  if (defab1 == error1 || defab2 == error2) {
12237  goto L95;
12238  }
12239  if ((r__1 = rlist[maxerr] - area12, fabs(r__1)) > fabs(area12) *
12240  1e-5f || erro12 < errmax * .99f) {
12241  goto L90;
12242  }
12243  if (extrap) {
12244  ++iroff2;
12245  }
12246  if (! extrap) {
12247  ++iroff1;
12248  }
12249  L90:
12250  if (*last > 10 && erro12 > errmax) {
12251  ++iroff3;
12252  }
12253  L95:
12254  level[maxerr] = levcur;
12255  level[*last] = levcur;
12256  rlist[maxerr] = area1;
12257  rlist[*last] = area2;
12258  /* Computing MAX */
12259  r__1 = *epsabs, r__2 = *epsrel * fabs(area);
12260  errbnd = max(r__1,r__2);
12261 
12262  /* test for roundoff error and eventually */
12263  /* set error flag. */
12264 
12265  if (iroff1 + iroff2 >= 10 || iroff3 >= 20) {
12266  *ier = 2;
12267  }
12268  if (iroff2 >= 5) {
12269  ierro = 3;
12270  }
12271 
12272  /* set error flag in the case that the number of */
12273  /* subintervals equals limit. */
12274 
12275  if (*last == *limit) {
12276  *ier = 1;
12277  }
12278 
12279  /* set error flag in the case of bad integrand behaviour */
12280  /* at a point of the integration range */
12281 
12282  /* Computing MAX */
12283  r__1 = fabs(a1), r__2 = fabs(b2);
12284  if (max(r__1,r__2) <= (epmach * 100.f + 1.f) * (fabs(a2) + uflow *
12285  1e3f)) {
12286  *ier = 4;
12287  }
12288 
12289  /* append the newly-created intervals to the list. */
12290 
12291  if (error2 > error1) {
12292  goto L100;
12293  }
12294  alist__[*last] = a2;
12295  blist[maxerr] = b1;
12296  blist[*last] = b2;
12297  elist[maxerr] = error1;
12298  elist[*last] = error2;
12299  goto L110;
12300  L100:
12301  alist__[maxerr] = a2;
12302  alist__[*last] = a1;
12303  blist[*last] = b1;
12304  rlist[maxerr] = area2;
12305  rlist[*last] = area1;
12306  elist[maxerr] = error2;
12307  elist[*last] = error1;
12308 
12309  /* call subroutine qpsrt to maintain the descending ordering */
12310  /* in the list of error estimates and select the */
12311  /* subinterval with nrmax-th largest error estimate (to be */
12312  /* bisected next). */
12313 
12314  L110:
12315  qpsrt_(limit, last, &maxerr, &errmax, &elist[1], &iord[1], &nrmax);
12316  /* ***jump out of do-loop */
12317  if (errsum <= errbnd) {
12318  goto L190;
12319  }
12320  /* ***jump out of do-loop */
12321  if (*ier != 0) {
12322  goto L170;
12323  }
12324  if (noext) {
12325  goto L160;
12326  }
12327  erlarg -= erlast;
12328  if (levcur + 1 <= levmax) {
12329  erlarg += erro12;
12330  }
12331  if (extrap) {
12332  goto L120;
12333  }
12334 
12335  /* test whether the interval to be bisected next is the */
12336  /* smallest interval. */
12337 
12338  if (level[maxerr] + 1 <= levmax) {
12339  goto L160;
12340  }
12341  extrap = true;
12342  nrmax = 2;
12343  L120:
12344  if (ierro == 3 || erlarg <= ertest) {
12345  goto L140;
12346  }
12347 
12348  /* the smallest interval has the largest error. */
12349  /* before bisecting decrease the sum of the errors */
12350  /* over the larger intervals (erlarg) and perform */
12351  /* extrapolation. */
12352 
12353  id = nrmax;
12354  jupbnd = *last;
12355  if (*last > *limit / 2 + 2) {
12356  jupbnd = *limit + 3 - *last;
12357  }
12358  i__1 = jupbnd;
12359  for (k = id; k <= i__1; ++k) {
12360  maxerr = iord[nrmax];
12361  errmax = elist[maxerr];
12362  /* ***jump out of do-loop */
12363  if (level[maxerr] + 1 <= levmax) {
12364  goto L160;
12365  }
12366  ++nrmax;
12367  /* L130: */
12368  }
12369 
12370  /* perform extrapolation. */
12371 
12372  L140:
12373  ++numrl2;
12374  rlist2[numrl2 - 1] = area;
12375  if (numrl2 <= 2) {
12376  goto L155;
12377  }
12378  qelg_(&numrl2, rlist2, &reseps, &abseps, res3la, &nres);
12379  ++ktmin;
12380  if (ktmin > 5 && *abserr < errsum * .001f) {
12381  *ier = 5;
12382  }
12383  if (abseps >= *abserr) {
12384  goto L150;
12385  }
12386  ktmin = 0;
12387  *abserr = abseps;
12388  *result = reseps;
12389  correc = erlarg;
12390  /* Computing MAX */
12391  r__1 = *epsabs, r__2 = *epsrel * fabs(reseps);
12392  ertest = max(r__1,r__2);
12393  /* ***jump out of do-loop */
12394  if (*abserr < ertest) {
12395  goto L170;
12396  }
12397 
12398  /* prepare bisection of the smallest interval. */
12399 
12400  L150:
12401  if (numrl2 == 1) {
12402  noext = true;
12403  }
12404  if (*ier >= 5) {
12405  goto L170;
12406  }
12407  L155:
12408  maxerr = iord[1];
12409  errmax = elist[maxerr];
12410  nrmax = 1;
12411  extrap = false;
12412  ++levmax;
12413  erlarg = errsum;
12414  L160:
12415  ;
12416  }
12417 
12418  /* set the final result. */
12419  /* --------------------- */
12420 
12421 
12422 L170:
12423  if (*abserr == oflow) {
12424  goto L190;
12425  }
12426  if (*ier + ierro == 0) {
12427  goto L180;
12428  }
12429  if (ierro == 3) {
12430  *abserr += correc;
12431  }
12432  if (*ier == 0) {
12433  *ier = 3;
12434  }
12435  if (*result != 0.f && area != 0.f) {
12436  goto L175;
12437  }
12438  if (*abserr > errsum) {
12439  goto L190;
12440  }
12441  if (area == 0.f) {
12442  goto L210;
12443  }
12444  goto L180;
12445 L175:
12446  if (*abserr / fabs(*result) > errsum / fabs(area)) {
12447  goto L190;
12448  }
12449 
12450  /* test on divergence. */
12451 
12452 L180:
12453  /* Computing MAX */
12454  r__1 = fabs(*result), r__2 = fabs(area);
12455  if (ksgn == -1 && max(r__1,r__2) <= resabs * .01f) {
12456  goto L210;
12457  }
12458  if (.01f > *result / area || *result / area > 100.f || errsum > fabs(area)
12459  ) {
12460  *ier = 6;
12461  }
12462  goto L210;
12463 
12464  /* compute global integral sum. */
12465 
12466 L190:
12467  *result = 0.f;
12468  i__2 = *last;
12469  for (k = 1; k <= i__2; ++k) {
12470  *result += rlist[k];
12471  /* L200: */
12472  }
12473  *abserr = errsum;
12474 L210:
12475  if (*ier > 2) {
12476  --(*ier);
12477  }
12478  *result *= sign;
12479 L999:
12480  return;
12481 } /* qagpe_ */
12482 
12483 void qagp_(const E_fp& f, const sys_float *a, const sys_float *b, const long *npts2,
12484  const sys_float *points, const sys_float *epsabs,
12485  const sys_float *epsrel, sys_float *result, sys_float *abserr,
12486  long *neval, long *ier, const long *leniw, const long *lenw,
12487  long *last, long *iwork, sys_float *work)
12488 {
12489  long l1, l2, l3, l4, lvl;
12490  long limit;
12491 
12492  /* ***begin prologue qagp */
12493  /* ***date written 800101 (yymmdd) */
12494  /* ***revision date 830518 (yymmdd) */
12495  /* ***category no. h2a2a1 */
12496  /* ***keywords automatic integrator, general-purpose, */
12497  /* singularities at user specified points, */
12498  /* extrapolation, globally adaptive */
12499  /* ***author piessens,robert,appl. math. & progr. div - k.u.leuven */
12500  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
12501  /* ***purpose the routine calculates an approximation result to a given */
12502  /* definite integral i = integral of f over (a,b), */
12503  /* hopefully satisfying following claim for accuracy */
12504  /* break points of the integration interval, where local */
12505  /* difficulties of the integrand may occur(e.g. singularities, */
12506  /* discontinuities), are provided by the user. */
12507  /* ***description */
12508 
12509  /* computation of a definite integral */
12510  /* standard fortran subroutine */
12511  /* sys_float version */
12512 
12513  /* parameters */
12514  /* on entry */
12515  /* f - sys_float */
12516  /* function subprogram defining the integrand */
12517  /* function f(x). the actual name for f needs to be */
12518  /* declared e x t e r n a l in the driver program. */
12519 
12520  /* a - sys_float */
12521  /* lower limit of integration */
12522 
12523  /* b - sys_float */
12524  /* upper limit of integration */
12525 
12526  /* npts2 - long */
12527  /* number equal to two more than the number of */
12528  /* user-supplied break points within the integration */
12529  /* range, npts.ge.2. */
12530  /* if npts2.lt.2, the routine will end with ier = 6. */
12531 
12532  /* points - sys_float */
12533  /* vector of dimension npts2, the first (npts2-2) */
12534  /* elements of which are the user provided break */
12535  /* points. if these points do not constitute an */
12536  /* ascending sequence there will be an automatic */
12537  /* sorting. */
12538 
12539  /* epsabs - sys_float */
12540  /* absolute accuracy requested */
12541  /* epsrel - sys_float */
12542  /* relative accuracy requested */
12543  /* if epsabs.le.0 */
12544  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
12545  /* the routine will end with ier = 6. */
12546 
12547  /* on return */
12548  /* result - sys_float */
12549  /* approximation to the integral */
12550 
12551  /* abserr - sys_float */
12552  /* estimate of the modulus of the absolute error, */
12553  /* which should equal or exceed fabs(i-result) */
12554 
12555  /* neval - long */
12556  /* number of integrand evaluations */
12557 
12558  /* ier - long */
12559  /* ier = 0 normal and reliable termination of the */
12560  /* routine. it is assumed that the requested */
12561  /* accuracy has been achieved. */
12562  /* ier.gt.0 abnormal termination of the routine. */
12563  /* the estimates for integral and error are */
12564  /* less reliable. it is assumed that the */
12565  /* requested accuracy has not been achieved. */
12566  /* error messages */
12567  /* ier = 1 maximum number of subdivisions allowed */
12568  /* has been achieved. one can allow more */
12569  /* subdivisions by increasing the value of */
12570  /* limit (and taking the according dimension */
12571  /* adjustments into account). however, if */
12572  /* this yields no improvement it is advised */
12573  /* to analyze the integrand in order to */
12574  /* determine the integration difficulties. if */
12575  /* the position of a local difficulty can be */
12576  /* determined (i.e. singularity, */
12577  /* discontinuity within the interval), it */
12578  /* should be supplied to the routine as an */
12579  /* element of the vector points. if necessary */
12580  /* an appropriate special-purpose integrator */
12581  /* must be used, which is designed for */
12582  /* handling the type of difficulty involved. */
12583  /* = 2 the occurrence of roundoff error is */
12584  /* detected, which prevents the requested */
12585  /* tolerance from being achieved. */
12586  /* the error may be under-estimated. */
12587  /* = 3 extremely bad integrand behaviour occurs */
12588  /* at some points of the integration */
12589  /* interval. */
12590  /* = 4 the algorithm does not converge. */
12591  /* roundoff error is detected in the */
12592  /* extrapolation table. */
12593  /* it is presumed that the requested */
12594  /* tolerance cannot be achieved, and that */
12595  /* the returned result is the best which */
12596  /* can be obtained. */
12597  /* = 5 the integral is probably divergent, or */
12598  /* slowly convergent. it must be noted that */
12599  /* divergence can occur with any other value */
12600  /* of ier.gt.0. */
12601  /* = 6 the input is invalid because */
12602  /* npts2.lt.2 or */
12603  /* break points are specified outside */
12604  /* the integration range or */
12605  /* (epsabs.le.0 and */
12606  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28)) */
12607  /* result, abserr, neval, last are set to */
12608  /* zero. exept when leniw or lenw or npts2 is */
12609  /* invalid, iwork(1), iwork(limit+1), */
12610  /* work(limit*2+1) and work(limit*3+1) */
12611  /* are set to zero. */
12612  /* work(1) is set to a and work(limit+1) */
12613  /* to b (where limit = (leniw-npts2)/2). */
12614 
12615  /* dimensioning parameters */
12616  /* leniw - long */
12617  /* dimensioning parameter for iwork */
12618  /* leniw determines limit = (leniw-npts2)/2, */
12619  /* which is the maximum number of subintervals in the */
12620  /* partition of the given integration interval (a,b), */
12621  /* leniw.ge.(3*npts2-2). */
12622  /* if leniw.lt.(3*npts2-2), the routine will end with */
12623  /* ier = 6. */
12624 
12625  /* lenw - long */
12626  /* dimensioning parameter for work */
12627  /* lenw must be at least leniw*2-npts2. */
12628  /* if lenw.lt.leniw*2-npts2, the routine will end */
12629  /* with ier = 6. */
12630 
12631  /* last - long */
12632  /* on return, last equals the number of subintervals */
12633  /* produced in the subdivision process, which */
12634  /* determines the number of significant elements */
12635  /* actually in the work arrays. */
12636 
12637  /* work arrays */
12638  /* iwork - long */
12639  /* vector of dimension at least leniw. on return, */
12640  /* the first k elements of which contain */
12641  /* pointers to the error estimates over the */
12642  /* subintervals, such that work(limit*3+iwork(1)),..., */
12643  /* work(limit*3+iwork(k)) form a decreasing */
12644  /* sequence, with k = last if last.le.(limit/2+2), and */
12645  /* k = limit+1-last otherwise */
12646  /* iwork(limit+1), ...,iwork(limit+last) contain the */
12647  /* subdivision levels of the subintervals, i.e. */
12648  /* if (aa,bb) is a subinterval of (p1,p2) */
12649  /* where p1 as well as p2 is a user-provided */
12650  /* break point or integration limit, then (aa,bb) has */
12651  /* level l if fabs(bb-aa) = fabs(p2-p1)*2**(-l), */
12652  /* iwork(limit*2+1), ..., iwork(limit*2+npts2) have */
12653  /* no significance for the user, */
12654  /* note that limit = (leniw-npts2)/2. */
12655 
12656  /* work - sys_float */
12657  /* vector of dimension at least lenw */
12658  /* on return */
12659  /* work(1), ..., work(last) contain the left */
12660  /* end points of the subintervals in the */
12661  /* partition of (a,b), */
12662  /* work(limit+1), ..., work(limit+last) contain */
12663  /* the right end points, */
12664  /* work(limit*2+1), ..., work(limit*2+last) contain */
12665  /* the integral approximations over the subintervals, */
12666  /* work(limit*3+1), ..., work(limit*3+last) */
12667  /* contain the corresponding error estimates, */
12668  /* work(limit*4+1), ..., work(limit*4+npts2) */
12669  /* contain the integration limits and the */
12670  /* break points sorted in an ascending sequence. */
12671  /* note that limit = (leniw-npts2)/2. */
12672 
12673  /* ***references (none) */
12674  /* ***routines called qagpe,xerror */
12675  /* ***end prologue qagp */
12676 
12677 
12678 
12679 
12680  /* check validity of limit and lenw. */
12681 
12682  /* ***first executable statement qagp */
12683  /* Parameter adjustments */
12684  --points;
12685  --iwork;
12686  --work;
12687 
12688  /* Function Body */
12689  *ier = 6;
12690  *neval = 0;
12691  *last = 0;
12692  *result = 0.f;
12693  *abserr = 0.f;
12694  if (*leniw < *npts2 * 3 - 2 || *lenw < (*leniw << 1) - *npts2 || *npts2 <
12695  2) {
12696  goto L10;
12697  }
12698 
12699  /* prepare call for qagpe. */
12700 
12701  limit = (*leniw - *npts2) / 2;
12702  l1 = limit + 1;
12703  l2 = limit + l1;
12704  l3 = limit + l2;
12705  l4 = limit + l3;
12706 
12707  qagpe_(f, a, b, npts2, &points[1], epsabs, epsrel, &limit, result,
12708  abserr, neval, ier, &work[1], &work[l1], &work[l2], &work[l3], &
12709  work[l4], &iwork[1], &iwork[l1], &iwork[l2], last);
12710 
12711  /* call error handler if necessary. */
12712 
12713  lvl = 0;
12714 L10:
12715  if (*ier == 6) {
12716  lvl = 1;
12717  }
12718  if (*ier != 0) {
12719  xerror_("abnormal return from qagp", &c__26, ier, &lvl, 26);
12720  }
12721  return;
12722 } /* qagp_ */
12723 
12724 void qagse_(const E_fp& f, const sys_float *a, const sys_float *b,
12725  const sys_float *epsabs, const sys_float *epsrel,
12726  const long *limit, sys_float *result, sys_float *abserr,
12727  long *neval,
12728  long *ier, sys_float *alist__, sys_float *blist,
12729  sys_float *rlist, sys_float *elist,
12730  long *iord, long *last)
12731 {
12732  /* System generated locals */
12733  int i__1, i__2;
12734  sys_float r__1, r__2;
12735 
12736  /* Local variables */
12737  long k;
12738  sys_float a1, a2, b1, b2;
12739  long id;
12740  sys_float area;
12741  sys_float dres;
12742  long ksgn, nres;
12743  sys_float area1, area2, area12, small=0.f, erro12;
12744  long ierro;
12745  sys_float defab1, defab2;
12746  long ktmin, nrmax;
12747  sys_float oflow, uflow;
12748  bool noext;
12749  long iroff1, iroff2, iroff3;
12750  sys_float res3la[3], error1, error2, rlist2[52];
12751  long numrl2;
12752  sys_float defabs, epmach, erlarg=0.f, abseps, correc=0.f, errbnd, resabs;
12753  long jupbnd;
12754  sys_float erlast, errmax;
12755  long maxerr;
12756  sys_float reseps;
12757  bool extrap;
12758  sys_float ertest=0.f, errsum;
12759 
12760  /* ***begin prologue qagse */
12761  /* ***date written 800101 (yymmdd) */
12762  /* ***revision date 830518 (yymmdd) */
12763  /* ***category no. h2a1a1 */
12764  /* ***keywords automatic integrator, general-purpose, */
12765  /* (end point) singularities, extrapolation, */
12766  /* globally adaptive */
12767  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
12768  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
12769  /* ***purpose the routine calculates an approximation result to a given */
12770  /* definite integral i = integral of f over (a,b), */
12771  /* hopefully satisfying following claim for accuracy */
12772  /* fabs(i-result).le.max(epsabs,epsrel*fabs(i)). */
12773  /* ***description */
12774 
12775  /* computation of a definite integral */
12776  /* standard fortran subroutine */
12777  /* sys_float version */
12778 
12779  /* parameters */
12780  /* on entry */
12781  /* f - sys_float */
12782  /* function subprogram defining the integrand */
12783  /* function f(x). the actual name for f needs to be */
12784  /* declared e x t e r n a l in the driver program. */
12785 
12786  /* a - sys_float */
12787  /* lower limit of integration */
12788 
12789  /* b - sys_float */
12790  /* upper limit of integration */
12791 
12792  /* epsabs - sys_float */
12793  /* absolute accuracy requested */
12794  /* epsrel - sys_float */
12795  /* relative accuracy requested */
12796  /* if epsabs.le.0 */
12797  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
12798  /* the routine will end with ier = 6. */
12799 
12800  /* limit - long */
12801  /* gives an upperbound on the number of subintervals */
12802  /* in the partition of (a,b) */
12803 
12804  /* on return */
12805  /* result - sys_float */
12806  /* approximation to the integral */
12807 
12808  /* abserr - sys_float */
12809  /* estimate of the modulus of the absolute error, */
12810  /* which should equal or exceed fabs(i-result) */
12811 
12812  /* neval - long */
12813  /* number of integrand evaluations */
12814 
12815  /* ier - long */
12816  /* ier = 0 normal and reliable termination of the */
12817  /* routine. it is assumed that the requested */
12818  /* accuracy has been achieved. */
12819  /* ier.gt.0 abnormal termination of the routine */
12820  /* the estimates for integral and error are */
12821  /* less reliable. it is assumed that the */
12822  /* requested accuracy has not been achieved. */
12823  /* error messages */
12824  /* = 1 maximum number of subdivisions allowed */
12825  /* has been achieved. one can allow more sub- */
12826  /* divisions by increasing the value of limit */
12827  /* (and taking the according dimension */
12828  /* adjustments into account). however, if */
12829  /* this yields no improvement it is advised */
12830  /* to analyze the integrand in order to */
12831  /* determine the integration difficulties. if */
12832  /* the position of a local difficulty can be */
12833  /* determined (e.g. singularity, */
12834  /* discontinuity within the interval) one */
12835  /* will probably gain from splitting up the */
12836  /* interval at this point and calling the */
12837  /* integrator on the subranges. if possible, */
12838  /* an appropriate special-purpose integrator */
12839  /* should be used, which is designed for */
12840  /* handling the type of difficulty involved. */
12841  /* = 2 the occurrence of roundoff error is detec- */
12842  /* ted, which prevents the requested */
12843  /* tolerance from being achieved. */
12844  /* the error may be under-estimated. */
12845  /* = 3 extremely bad integrand behaviour */
12846  /* occurs at some points of the integration */
12847  /* interval. */
12848  /* = 4 the algorithm does not converge. */
12849  /* roundoff error is detected in the */
12850  /* extrapolation table. */
12851  /* it is presumed that the requested */
12852  /* tolerance cannot be achieved, and that the */
12853  /* returned result is the best which can be */
12854  /* obtained. */
12855  /* = 5 the integral is probably divergent, or */
12856  /* slowly convergent. it must be noted that */
12857  /* divergence can occur with any other value */
12858  /* of ier. */
12859  /* = 6 the input is invalid, because */
12860  /* epsabs.le.0 and */
12861  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28). */
12862  /* result, abserr, neval, last, rlist(1), */
12863  /* iord(1) and elist(1) are set to zero. */
12864  /* alist(1) and blist(1) are set to a and b */
12865  /* respectively. */
12866 
12867  /* alist - sys_float */
12868  /* vector of dimension at least limit, the first */
12869  /* last elements of which are the left end points */
12870  /* of the subintervals in the partition of the */
12871  /* given integration range (a,b) */
12872 
12873  /* blist - sys_float */
12874  /* vector of dimension at least limit, the first */
12875  /* last elements of which are the right end points */
12876  /* of the subintervals in the partition of the given */
12877  /* integration range (a,b) */
12878 
12879  /* rlist - sys_float */
12880  /* vector of dimension at least limit, the first */
12881  /* last elements of which are the integral */
12882  /* approximations on the subintervals */
12883 
12884  /* elist - sys_float */
12885  /* vector of dimension at least limit, the first */
12886  /* last elements of which are the moduli of the */
12887  /* absolute error estimates on the subintervals */
12888 
12889  /* iord - long */
12890  /* vector of dimension at least limit, the first k */
12891  /* elements of which are pointers to the */
12892  /* error estimates over the subintervals, */
12893  /* such that elist(iord(1)), ..., elist(iord(k)) */
12894  /* form a decreasing sequence, with k = last */
12895  /* if last.le.(limit/2+2), and k = limit+1-last */
12896  /* otherwise */
12897 
12898  /* last - long */
12899  /* number of subintervals actually produced in the */
12900  /* subdivision process */
12901 
12902  /* ***references (none) */
12903  /* ***routines called qelg,qk21,qpsrt,r1mach */
12904  /* ***end prologue qagse */
12905 
12906 
12907 
12908 
12909  /* the dimension of rlist2 is determined by the value of */
12910  /* limexp in subroutine qelg (rlist2 should be of dimension */
12911  /* (limexp+2) at least). */
12912 
12913  /* list of major variables */
12914  /* ----------------------- */
12915 
12916  /* alist - list of left end points of all subintervals */
12917  /* considered up to now */
12918  /* blist - list of right end points of all subintervals */
12919  /* considered up to now */
12920  /* rlist(i) - approximation to the integral over */
12921  /* (alist(i),blist(i)) */
12922  /* rlist2 - array of dimension at least limexp+2 */
12923  /* containing the part of the epsilon table */
12924  /* which is still needed for further computations */
12925  /* elist(i) - error estimate applying to rlist(i) */
12926  /* maxerr - pointer to the interval with largest error */
12927  /* estimate */
12928  /* errmax - elist(maxerr) */
12929  /* erlast - error on the interval currently subdivided */
12930  /* (before that subdivision has taken place) */
12931  /* area - sum of the integrals over the subintervals */
12932  /* errsum - sum of the errors over the subintervals */
12933  /* errbnd - requested accuracy max(epsabs,epsrel* */
12934  /* fabs(result)) */
12935  /* *****1 - variable for the left interval */
12936  /* *****2 - variable for the right interval */
12937  /* last - index for subdivision */
12938  /* nres - number of calls to the extrapolation routine */
12939  /* numrl2 - number of elements currently in rlist2. if an */
12940  /* appropriate approximation to the compounded */
12941  /* integral has been obtained it is put in */
12942  /* rlist2(numrl2) after numrl2 has been increased */
12943  /* by one. */
12944  /* small - length of the smallest interval considered */
12945  /* up to now, multiplied by 1.5 */
12946  /* erlarg - sum of the errors over the intervals larger */
12947  /* than the smallest interval considered up to now */
12948  /* extrap - bool variable denoting that the routine */
12949  /* is attempting to perform extrapolation */
12950  /* i.e. before subdividing the smallest interval */
12951  /* we try to decrease the value of erlarg. */
12952  /* noext - bool variable denoting that extrapolation */
12953  /* is no longer allowed (true value) */
12954 
12955  /* machine dependent constants */
12956  /* --------------------------- */
12957 
12958  /* epmach is the largest relative spacing. */
12959  /* uflow is the smallest positive magnitude. */
12960  /* oflow is the largest positive magnitude. */
12961 
12962  /* ***first executable statement qagse */
12963  /* Parameter adjustments */
12964  --iord;
12965  --elist;
12966  --rlist;
12967  --blist;
12968  --alist__;
12969 
12970  /* Function Body */
12971  epmach = r1mach(c__4);
12972 
12973  /* test on validity of parameters */
12974  /* ------------------------------ */
12975  *ier = 0;
12976  *neval = 0;
12977  *last = 0;
12978  *result = 0.f;
12979  *abserr = 0.f;
12980  alist__[1] = *a;
12981  blist[1] = *b;
12982  rlist[1] = 0.f;
12983  elist[1] = 0.f;
12984  /* Computing MAX */
12985  r__1 = epmach * 50.f;
12986  if (*epsabs <= 0.f && *epsrel < max(r__1,5e-15f)) {
12987  *ier = 6;
12988  }
12989  if (*ier == 6) {
12990  goto L999;
12991  }
12992 
12993  /* first approximation to the integral */
12994  /* ----------------------------------- */
12995 
12996  uflow = r1mach(c__1);
12997  oflow = r1mach(c__2);
12998  ierro = 0;
12999  qk21_(f, a, b, result, abserr, &defabs, &resabs);
13000 
13001  /* test on accuracy. */
13002 
13003  dres = fabs(*result);
13004  /* Computing MAX */
13005  r__1 = *epsabs, r__2 = *epsrel * dres;
13006  errbnd = max(r__1,r__2);
13007  *last = 1;
13008  rlist[1] = *result;
13009  elist[1] = *abserr;
13010  iord[1] = 1;
13011  if (*abserr <= epmach * 100.f * defabs && *abserr > errbnd) {
13012  *ier = 2;
13013  }
13014  if (*limit == 1) {
13015  *ier = 1;
13016  }
13017  if (*ier != 0 || ( *abserr <= errbnd && *abserr != resabs ) ||
13018  *abserr == 0.f)
13019  {
13020  goto L140;
13021  }
13022 
13023  /* initialization */
13024  /* -------------- */
13025 
13026  rlist2[0] = *result;
13027  errmax = *abserr;
13028  maxerr = 1;
13029  area = *result;
13030  errsum = *abserr;
13031  *abserr = oflow;
13032  nrmax = 1;
13033  nres = 0;
13034  numrl2 = 2;
13035  ktmin = 0;
13036  extrap = false;
13037  noext = false;
13038  iroff1 = 0;
13039  iroff2 = 0;
13040  iroff3 = 0;
13041  ksgn = -1;
13042  if (dres >= (1.f - epmach * 50.f) * defabs) {
13043  ksgn = 1;
13044  }
13045 
13046  /* main do-loop */
13047  /* ------------ */
13048 
13049  i__1 = *limit;
13050  for (*last = 2; *last <= i__1; ++(*last)) {
13051 
13052  /* bisect the subinterval with the nrmax-th largest */
13053  /* error estimate. */
13054 
13055  a1 = alist__[maxerr];
13056  b1 = (alist__[maxerr] + blist[maxerr]) * .5f;
13057  a2 = b1;
13058  b2 = blist[maxerr];
13059  erlast = errmax;
13060  qk21_(f, &a1, &b1, &area1, &error1, &resabs, &defab1);
13061  qk21_(f, &a2, &b2, &area2, &error2, &resabs, &defab2);
13062 
13063  /* improve previous approximations to integral */
13064  /* and error and test for accuracy. */
13065 
13066  area12 = area1 + area2;
13067  erro12 = error1 + error2;
13068  errsum = errsum + erro12 - errmax;
13069  area = area + area12 - rlist[maxerr];
13070  if (defab1 == error1 || defab2 == error2) {
13071  goto L15;
13072  }
13073  if ((r__1 = rlist[maxerr] - area12, fabs(r__1)) > fabs(area12) *
13074  1e-5f || erro12 < errmax * .99f) {
13075  goto L10;
13076  }
13077  if (extrap) {
13078  ++iroff2;
13079  }
13080  if (! extrap) {
13081  ++iroff1;
13082  }
13083  L10:
13084  if (*last > 10 && erro12 > errmax) {
13085  ++iroff3;
13086  }
13087  L15:
13088  rlist[maxerr] = area1;
13089  rlist[*last] = area2;
13090  /* Computing MAX */
13091  r__1 = *epsabs, r__2 = *epsrel * fabs(area);
13092  errbnd = max(r__1,r__2);
13093 
13094  /* test for roundoff error and eventually */
13095  /* set error flag. */
13096 
13097  if (iroff1 + iroff2 >= 10 || iroff3 >= 20) {
13098  *ier = 2;
13099  }
13100  if (iroff2 >= 5) {
13101  ierro = 3;
13102  }
13103 
13104  /* set error flag in the case that the number of */
13105  /* subintervals equals limit. */
13106 
13107  if (*last == *limit) {
13108  *ier = 1;
13109  }
13110 
13111  /* set error flag in the case of bad integrand behaviour */
13112  /* at a point of the integration range. */
13113 
13114  /* Computing MAX */
13115  r__1 = fabs(a1), r__2 = fabs(b2);
13116  if (max(r__1,r__2) <= (epmach * 100.f + 1.f) * (fabs(a2) + uflow *
13117  1e3f)) {
13118  *ier = 4;
13119  }
13120 
13121  /* append the newly-created intervals to the list. */
13122 
13123  if (error2 > error1) {
13124  goto L20;
13125  }
13126  alist__[*last] = a2;
13127  blist[maxerr] = b1;
13128  blist[*last] = b2;
13129  elist[maxerr] = error1;
13130  elist[*last] = error2;
13131  goto L30;
13132  L20:
13133  alist__[maxerr] = a2;
13134  alist__[*last] = a1;
13135  blist[*last] = b1;
13136  rlist[maxerr] = area2;
13137  rlist[*last] = area1;
13138  elist[maxerr] = error2;
13139  elist[*last] = error1;
13140 
13141  /* call subroutine qpsrt to maintain the descending ordering */
13142  /* in the list of error estimates and select the */
13143  /* subinterval with nrmax-th largest error estimate (to be */
13144  /* bisected next). */
13145 
13146  L30:
13147  qpsrt_(limit, last, &maxerr, &errmax, &elist[1], &iord[1], &nrmax);
13148  /* ***jump out of do-loop */
13149  if (errsum <= errbnd) {
13150  goto L115;
13151  }
13152  /* ***jump out of do-loop */
13153  if (*ier != 0) {
13154  goto L100;
13155  }
13156  if (*last == 2) {
13157  goto L80;
13158  }
13159  if (noext) {
13160  goto L90;
13161  }
13162  erlarg -= erlast;
13163  if ((r__1 = b1 - a1, fabs(r__1)) > small) {
13164  erlarg += erro12;
13165  }
13166  if (extrap) {
13167  goto L40;
13168  }
13169 
13170  /* test whether the interval to be bisected next is the */
13171  /* smallest interval. */
13172 
13173  if ((r__1 = blist[maxerr] - alist__[maxerr], fabs(r__1)) > small) {
13174  goto L90;
13175  }
13176  extrap = true;
13177  nrmax = 2;
13178  L40:
13179  if (ierro == 3 || erlarg <= ertest) {
13180  goto L60;
13181  }
13182 
13183  /* the smallest interval has the largest error. */
13184  /* before bisecting decrease the sum of the errors */
13185  /* over the larger intervals (erlarg) and perform */
13186  /* extrapolation. */
13187 
13188  id = nrmax;
13189  jupbnd = *last;
13190  if (*last > *limit / 2 + 2) {
13191  jupbnd = *limit + 3 - *last;
13192  }
13193  i__2 = jupbnd;
13194  for (k = id; k <= i__2; ++k) {
13195  maxerr = iord[nrmax];
13196  errmax = elist[maxerr];
13197  /* ***jump out of do-loop */
13198  if ((r__1 = blist[maxerr] - alist__[maxerr], fabs(r__1)) > small)
13199  {
13200  goto L90;
13201  }
13202  ++nrmax;
13203  /* L50: */
13204  }
13205 
13206  /* perform extrapolation. */
13207 
13208  L60:
13209  ++numrl2;
13210  rlist2[numrl2 - 1] = area;
13211  qelg_(&numrl2, rlist2, &reseps, &abseps, res3la, &nres);
13212  ++ktmin;
13213  if (ktmin > 5 && *abserr < errsum * .001f) {
13214  *ier = 5;
13215  }
13216  if (abseps >= *abserr) {
13217  goto L70;
13218  }
13219  ktmin = 0;
13220  *abserr = abseps;
13221  *result = reseps;
13222  correc = erlarg;
13223  /* Computing MAX */
13224  r__1 = *epsabs, r__2 = *epsrel * fabs(reseps);
13225  ertest = max(r__1,r__2);
13226  /* ***jump out of do-loop */
13227  if (*abserr <= ertest) {
13228  goto L100;
13229  }
13230 
13231  /* prepare bisection of the smallest interval. */
13232 
13233  L70:
13234  if (numrl2 == 1) {
13235  noext = true;
13236  }
13237  if (*ier == 5) {
13238  goto L100;
13239  }
13240  maxerr = iord[1];
13241  errmax = elist[maxerr];
13242  nrmax = 1;
13243  extrap = false;
13244  small *= .5f;
13245  erlarg = errsum;
13246  goto L90;
13247  L80:
13248  small = (r__1 = *b - *a, fabs(r__1)) * .375f;
13249  erlarg = errsum;
13250  ertest = errbnd;
13251  rlist2[1] = area;
13252  L90:
13253  ;
13254  }
13255 
13256  /* set final result and error estimate. */
13257  /* ------------------------------------ */
13258 
13259 L100:
13260  if (*abserr == oflow) {
13261  goto L115;
13262  }
13263  if (*ier + ierro == 0) {
13264  goto L110;
13265  }
13266  if (ierro == 3) {
13267  *abserr += correc;
13268  }
13269  if (*ier == 0) {
13270  *ier = 3;
13271  }
13272  if (*result != 0.f && area != 0.f) {
13273  goto L105;
13274  }
13275  if (*abserr > errsum) {
13276  goto L115;
13277  }
13278  if (area == 0.f) {
13279  goto L130;
13280  }
13281  goto L110;
13282 L105:
13283  if (*abserr / fabs(*result) > errsum / fabs(area)) {
13284  goto L115;
13285  }
13286 
13287  /* test on divergence. */
13288 
13289 L110:
13290  /* Computing MAX */
13291  r__1 = fabs(*result), r__2 = fabs(area);
13292  if (ksgn == -1 && max(r__1,r__2) <= defabs * .01f) {
13293  goto L130;
13294  }
13295  if (.01f > *result / area || *result / area > 100.f || errsum > fabs(area)
13296  ) {
13297  *ier = 6;
13298  }
13299  goto L130;
13300 
13301  /* compute global integral sum. */
13302 
13303 L115:
13304  *result = 0.f;
13305  i__1 = *last;
13306  for (k = 1; k <= i__1; ++k) {
13307  *result += rlist[k];
13308  /* L120: */
13309  }
13310  *abserr = errsum;
13311 L130:
13312  if (*ier > 2) {
13313  --(*ier);
13314  }
13315 L140:
13316  *neval = *last * 42 - 21;
13317 L999:
13318  return;
13319 } /* qagse_ */
13320 
13321 void qags_(const E_fp& f, const sys_float *a, const sys_float *b,
13322  const sys_float *epsabs, const sys_float *epsrel,
13323  sys_float *result, sys_float *abserr, long *neval, long *ier,
13324  const long *limit, const long *lenw, long *last, long *iwork,
13325  sys_float *work)
13326 {
13327  long l1, l2, l3, lvl;
13328 
13329  /* ***begin prologue qags */
13330  /* ***date written 800101 (yymmdd) */
13331  /* ***revision date 830518 (yymmdd) */
13332  /* ***category no. h2a1a1 */
13333  /* ***keywords automatic integrator, general-purpose, */
13334  /* (end-point) singularities, extrapolation, */
13335  /* globally adaptive */
13336  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
13337  /* de doncker,elise,appl. math. & prog. div. - k.u.leuven */
13338  /* ***purpose the routine calculates an approximation result to a given */
13339  /* definite integral i = integral of f over (a,b), */
13340  /* hopefully satisfying following claim for accuracy */
13341  /* fabs(i-result).le.max(epsabs,epsrel*fabs(i)). */
13342  /* ***description */
13343 
13344  /* computation of a definite integral */
13345  /* standard fortran subroutine */
13346  /* sys_float version */
13347 
13348 
13349  /* parameters */
13350  /* on entry */
13351  /* f - sys_float */
13352  /* function subprogram defining the integrand */
13353  /* function f(x). the actual name for f needs to be */
13354  /* declared e x t e r n a l in the driver program. */
13355 
13356  /* a - sys_float */
13357  /* lower limit of integration */
13358 
13359  /* b - sys_float */
13360  /* upper limit of integration */
13361 
13362  /* epsabs - sys_float */
13363  /* absolute accuracy requested */
13364  /* epsrel - sys_float */
13365  /* relative accuracy requested */
13366  /* if epsabs.le.0 */
13367  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
13368  /* the routine will end with ier = 6. */
13369 
13370  /* on return */
13371  /* result - sys_float */
13372  /* approximation to the integral */
13373 
13374  /* abserr - sys_float */
13375  /* estimate of the modulus of the absolute error, */
13376  /* which should equal or exceed fabs(i-result) */
13377 
13378  /* neval - long */
13379  /* number of integrand evaluations */
13380 
13381  /* ier - long */
13382  /* ier = 0 normal and reliable termination of the */
13383  /* routine. it is assumed that the requested */
13384  /* accuracy has been achieved. */
13385  /* ier.gt.0 abnormal termination of the routine */
13386  /* the estimates for integral and error are */
13387  /* less reliable. it is assumed that the */
13388  /* requested accuracy has not been achieved. */
13389  /* error messages */
13390  /* ier = 1 maximum number of subdivisions allowed */
13391  /* has been achieved. one can allow more sub- */
13392  /* divisions by increasing the value of limit */
13393  /* (and taking the according dimension */
13394  /* adjustments into account. however, if */
13395  /* this yields no improvement it is advised */
13396  /* to analyze the integrand in order to */
13397  /* determine the integration difficulties. if */
13398  /* the position of a local difficulty can be */
13399  /* determined (e.g. singularity, */
13400  /* discontinuity within the interval) one */
13401  /* will probably gain from splitting up the */
13402  /* interval at this point and calling the */
13403  /* integrator on the subranges. if possible, */
13404  /* an appropriate special-purpose integrator */
13405  /* should be used, which is designed for */
13406  /* handling the type of difficulty involved. */
13407  /* = 2 the occurrence of roundoff error is detec- */
13408  /* ted, which prevents the requested */
13409  /* tolerance from being achieved. */
13410  /* the error may be under-estimated. */
13411  /* = 3 extremely bad integrand behaviour */
13412  /* occurs at some points of the integration */
13413  /* interval. */
13414  /* = 4 the algorithm does not converge. */
13415  /* roundoff error is detected in the */
13416  /* extrapolation table. it is presumed that */
13417  /* the requested tolerance cannot be */
13418  /* achieved, and that the returned result is */
13419  /* the best which can be obtained. */
13420  /* = 5 the integral is probably divergent, or */
13421  /* slowly convergent. it must be noted that */
13422  /* divergence can occur with any other value */
13423  /* of ier. */
13424  /* = 6 the input is invalid, because */
13425  /* (epsabs.le.0 and */
13426  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28) */
13427  /* or limit.lt.1 or lenw.lt.limit*4. */
13428  /* result, abserr, neval, last are set to */
13429  /* zero.except when limit or lenw is invalid, */
13430  /* iwork(1), work(limit*2+1) and */
13431  /* work(limit*3+1) are set to zero, work(1) */
13432  /* is set to a and work(limit+1) to b. */
13433 
13434  /* dimensioning parameters */
13435  /* limit - long */
13436  /* dimensioning parameter for iwork */
13437  /* limit determines the maximum number of subintervals */
13438  /* in the partition of the given integration interval */
13439  /* (a,b), limit.ge.1. */
13440  /* if limit.lt.1, the routine will end with ier = 6. */
13441 
13442  /* lenw - long */
13443  /* dimensioning parameter for work */
13444  /* lenw must be at least limit*4. */
13445  /* if lenw.lt.limit*4, the routine will end */
13446  /* with ier = 6. */
13447 
13448  /* last - long */
13449  /* on return, last equals the number of subintervals */
13450  /* produced in the subdivision process, detemines the */
13451  /* number of significant elements actually in the work */
13452  /* arrays. */
13453 
13454  /* work arrays */
13455  /* iwork - long */
13456  /* vector of dimension at least limit, the first k */
13457  /* elements of which contain pointers */
13458  /* to the error estimates over the subintervals */
13459  /* such that work(limit*3+iwork(1)),... , */
13460  /* work(limit*3+iwork(k)) form a decreasing */
13461  /* sequence, with k = last if last.le.(limit/2+2), */
13462  /* and k = limit+1-last otherwise */
13463 
13464  /* work - sys_float */
13465  /* vector of dimension at least lenw */
13466  /* on return */
13467  /* work(1), ..., work(last) contain the left */
13468  /* end-points of the subintervals in the */
13469  /* partition of (a,b), */
13470  /* work(limit+1), ..., work(limit+last) contain */
13471  /* the right end-points, */
13472  /* work(limit*2+1), ..., work(limit*2+last) contain */
13473  /* the integral approximations over the subintervals, */
13474  /* work(limit*3+1), ..., work(limit*3+last) */
13475  /* contain the error estimates. */
13476 
13477 
13478 
13479  /* ***references (none) */
13480  /* ***routines called qagse,xerror */
13481  /* ***end prologue qags */
13482 
13483 
13484 
13485 
13486 
13487  /* check validity of limit and lenw. */
13488 
13489  /* ***first executable statement qags */
13490  /* Parameter adjustments */
13491  --iwork;
13492  --work;
13493 
13494  /* Function Body */
13495  *ier = 6;
13496  *neval = 0;
13497  *last = 0;
13498  *result = 0.f;
13499  *abserr = 0.f;
13500  if (*limit < 1 || *lenw < *limit << 2) {
13501  goto L10;
13502  }
13503 
13504  /* prepare call for qagse. */
13505 
13506  l1 = *limit + 1;
13507  l2 = *limit + l1;
13508  l3 = *limit + l2;
13509 
13510  qagse_(f, a, b, epsabs, epsrel, limit, result, abserr, neval, ier, &
13511  work[1], &work[l1], &work[l2], &work[l3], &iwork[1], last);
13512 
13513  /* call error handler if necessary. */
13514 
13515  lvl = 0;
13516 L10:
13517  if (*ier == 6) {
13518  lvl = 1;
13519  }
13520  if (*ier != 0) {
13521  xerror_("abnormal return from qags", &c__26, ier, &lvl, 26);
13522  }
13523  return;
13524 } /* qags_ */
13525 
13526 void qawce_(const E_fp& f, const sys_float *a, const sys_float *b,
13527  const sys_float *c__, const sys_float *epsabs,
13528  const sys_float *epsrel, const long *limit,
13529  sys_float *result, sys_float *abserr, long *
13530  neval, long *ier, sys_float *alist__, sys_float *blist,
13531  sys_float *rlist, sys_float *elist, long *iord, long *last)
13532 {
13533  /* System generated locals */
13534  int i__1;
13535  sys_float r__1, r__2;
13536 
13537  /* Local variables */
13538  long k;
13539  sys_float a1, a2, b1, b2, aa, bb;
13540  long nev;
13541  sys_float area;
13542  sys_float area1, area2, area12, erro12;
13543  long krule, nrmax;
13544  sys_float uflow;
13545  long iroff1, iroff2;
13546  sys_float error1, error2, epmach, errbnd, errmax;
13547  long maxerr;
13548  sys_float errsum;
13549 
13550  /* ***begin prologue qawce */
13551  /* ***date written 800101 (yymmdd) */
13552  /* ***revision date 830518 (yymmdd) */
13553  /* ***category no. h2a2a1,j4 */
13554  /* ***keywords automatic integrator, special-purpose, */
13555  /* cauchy principal value, clenshaw-curtis method */
13556  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
13557  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
13558  /* *** purpose the routine calculates an approximation result to a */
13559  /* cauchy principal value i = integral of f*w over (a,b) */
13560  /* (w(x) = 1/(x-c), (c.ne.a, c.ne.b), hopefully satisfying */
13561  /* following claim for accuracy */
13562  /* fabs(i-result).le.max(epsabs,epsrel*fabs(i)) */
13563  /* ***description */
13564 
13565  /* computation of a cauchy principal value */
13566  /* standard fortran subroutine */
13567  /* sys_float version */
13568 
13569  /* parameters */
13570  /* on entry */
13571  /* f - sys_float */
13572  /* function subprogram defining the integrand */
13573  /* function f(x). the actual name for f needs to be */
13574  /* declared e x t e r n a l in the driver program. */
13575 
13576  /* a - sys_float */
13577  /* lower limit of integration */
13578 
13579  /* b - sys_float */
13580  /* upper limit of integration */
13581 
13582  /* c - sys_float */
13583  /* parameter in the weight function, c.ne.a, c.ne.b */
13584  /* if c = a or c = b, the routine will end with */
13585  /* ier = 6. */
13586 
13587  /* epsabs - sys_float */
13588  /* absolute accuracy requested */
13589  /* epsrel - sys_float */
13590  /* relative accuracy requested */
13591  /* if epsabs.le.0 */
13592  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
13593  /* the routine will end with ier = 6. */
13594 
13595  /* limit - long */
13596  /* gives an upper bound on the number of subintervals */
13597  /* in the partition of (a,b), limit.ge.1 */
13598 
13599  /* on return */
13600  /* result - sys_float */
13601  /* approximation to the integral */
13602 
13603  /* abserr - sys_float */
13604  /* estimate of the modulus of the absolute error, */
13605  /* which should equal or exceed fabs(i-result) */
13606 
13607  /* neval - long */
13608  /* number of integrand evaluations */
13609 
13610  /* ier - long */
13611  /* ier = 0 normal and reliable termination of the */
13612  /* routine. it is assumed that the requested */
13613  /* accuracy has been achieved. */
13614  /* ier.gt.0 abnormal termination of the routine */
13615  /* the estimates for integral and error are */
13616  /* less reliable. it is assumed that the */
13617  /* requested accuracy has not been achieved. */
13618  /* error messages */
13619  /* ier = 1 maximum number of subdivisions allowed */
13620  /* has been achieved. one can allow more sub- */
13621  /* divisions by increasing the value of */
13622  /* limit. however, if this yields no */
13623  /* improvement it is advised to analyze the */
13624  /* the integrand, in order to determine the */
13625  /* the integration difficulties. if the */
13626  /* position of a local difficulty can be */
13627  /* determined (e.g. singularity, */
13628  /* discontinuity within the interval) one */
13629  /* will probably gain from splitting up the */
13630  /* interval at this point and calling */
13631  /* appropriate integrators on the subranges. */
13632  /* = 2 the occurrence of roundoff error is detec- */
13633  /* ted, which prevents the requested */
13634  /* tolerance from being achieved. */
13635  /* = 3 extremely bad integrand behaviour */
13636  /* occurs at some interior points of */
13637  /* the integration interval. */
13638  /* = 6 the input is invalid, because */
13639  /* c = a or c = b or */
13640  /* (epsabs.le.0 and */
13641  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28)) */
13642  /* or limit.lt.1. */
13643  /* result, abserr, neval, rlist(1), elist(1), */
13644  /* iord(1) and last are set to zero. alist(1) */
13645  /* and blist(1) are set to a and b */
13646  /* respectively. */
13647 
13648  /* alist - sys_float */
13649  /* vector of dimension at least limit, the first */
13650  /* last elements of which are the left */
13651  /* end points of the subintervals in the partition */
13652  /* of the given integration range (a,b) */
13653 
13654  /* blist - sys_float */
13655  /* vector of dimension at least limit, the first */
13656  /* last elements of which are the right */
13657  /* end points of the subintervals in the partition */
13658  /* of the given integration range (a,b) */
13659 
13660  /* rlist - sys_float */
13661  /* vector of dimension at least limit, the first */
13662  /* last elements of which are the integral */
13663  /* approximations on the subintervals */
13664 
13665  /* elist - sys_float */
13666  /* vector of dimension limit, the first last */
13667  /* elements of which are the moduli of the absolute */
13668  /* error estimates on the subintervals */
13669 
13670  /* iord - long */
13671  /* vector of dimension at least limit, the first k */
13672  /* elements of which are pointers to the error */
13673  /* estimates over the subintervals, so that */
13674  /* elist(iord(1)), ..., elist(iord(k)) with k = last */
13675  /* if last.le.(limit/2+2), and k = limit+1-last */
13676  /* otherwise, form a decreasing sequence */
13677 
13678  /* last - long */
13679  /* number of subintervals actually produced in */
13680  /* the subdivision process */
13681 
13682  /* ***references (none) */
13683  /* ***routines called qc25c,qpsrt,r1mach */
13684  /* ***end prologue qawce */
13685 
13686 
13687 
13688 
13689  /* list of major variables */
13690  /* ----------------------- */
13691 
13692  /* alist - list of left end points of all subintervals */
13693  /* considered up to now */
13694  /* blist - list of right end points of all subintervals */
13695  /* considered up to now */
13696  /* rlist(i) - approximation to the integral over */
13697  /* (alist(i),blist(i)) */
13698  /* elist(i) - error estimate applying to rlist(i) */
13699  /* maxerr - pointer to the interval with largest */
13700  /* error estimate */
13701  /* errmax - elist(maxerr) */
13702  /* area - sum of the integrals over the subintervals */
13703  /* errsum - sum of the errors over the subintervals */
13704  /* errbnd - requested accuracy max(epsabs,epsrel* */
13705  /* fabs(result)) */
13706  /* *****1 - variable for the left subinterval */
13707  /* *****2 - variable for the right subinterval */
13708  /* last - index for subdivision */
13709 
13710 
13711  /* machine dependent constants */
13712  /* --------------------------- */
13713 
13714  /* epmach is the largest relative spacing. */
13715  /* uflow is the smallest positive magnitude. */
13716 
13717  /* ***first executable statement qawce */
13718  /* Parameter adjustments */
13719  --iord;
13720  --elist;
13721  --rlist;
13722  --blist;
13723  --alist__;
13724 
13725  /* Function Body */
13726  epmach = r1mach(c__4);
13727  uflow = r1mach(c__1);
13728 
13729 
13730  /* test on validity of parameters */
13731  /* ------------------------------ */
13732 
13733  *ier = 6;
13734  *neval = 0;
13735  *last = 0;
13736  alist__[1] = *a;
13737  blist[1] = *b;
13738  rlist[1] = 0.f;
13739  elist[1] = 0.f;
13740  iord[1] = 0;
13741  *result = 0.f;
13742  *abserr = 0.f;
13743  /* Computing MAX */
13744  r__1 = epmach * 50.f;
13745  if (*c__ == *a || *c__ == *b ||
13746  ( *epsabs <= 0.f && *epsrel < max(r__1, 5e-15f))) {
13747  goto L999;
13748  }
13749 
13750  /* first approximation to the integral */
13751  /* ----------------------------------- */
13752 
13753  aa = *a;
13754  bb = *b;
13755  if (*a <= *b) {
13756  goto L10;
13757  }
13758  aa = *b;
13759  bb = *a;
13760 L10:
13761  *ier = 0;
13762  krule = 1;
13763  qc25c_(f, &aa, &bb, c__, result, abserr, &krule, neval);
13764  *last = 1;
13765  rlist[1] = *result;
13766  elist[1] = *abserr;
13767  iord[1] = 1;
13768  alist__[1] = *a;
13769  blist[1] = *b;
13770 
13771  /* test on accuracy */
13772 
13773  /* Computing MAX */
13774  r__1 = *epsabs, r__2 = *epsrel * fabs(*result);
13775  errbnd = max(r__1,r__2);
13776  if (*limit == 1) {
13777  *ier = 1;
13778  }
13779  /* Computing MIN */
13780  r__1 = fabs(*result) * .01f;
13781  if (*abserr < min(r__1,errbnd) || *ier == 1) {
13782  goto L70;
13783  }
13784 
13785  /* initialization */
13786  /* -------------- */
13787 
13788  alist__[1] = aa;
13789  blist[1] = bb;
13790  rlist[1] = *result;
13791  errmax = *abserr;
13792  maxerr = 1;
13793  area = *result;
13794  errsum = *abserr;
13795  nrmax = 1;
13796  iroff1 = 0;
13797  iroff2 = 0;
13798 
13799  /* main do-loop */
13800  /* ------------ */
13801 
13802  i__1 = *limit;
13803  for (*last = 2; *last <= i__1; ++(*last)) {
13804 
13805  /* bisect the subinterval with nrmax-th largest */
13806  /* error estimate. */
13807 
13808  a1 = alist__[maxerr];
13809  b1 = (alist__[maxerr] + blist[maxerr]) * .5f;
13810  b2 = blist[maxerr];
13811  if (*c__ <= b1 && *c__ > a1) {
13812  b1 = (*c__ + b2) * .5f;
13813  }
13814  if (*c__ > b1 && *c__ < b2) {
13815  b1 = (a1 + *c__) * .5f;
13816  }
13817  a2 = b1;
13818  krule = 2;
13819  qc25c_(f, &a1, &b1, c__, &area1, &error1, &krule, &nev);
13820  *neval += nev;
13821  qc25c_(f, &a2, &b2, c__, &area2, &error2, &krule, &nev);
13822  *neval += nev;
13823 
13824  /* improve previous approximations to integral */
13825  /* and error and test for accuracy. */
13826 
13827  area12 = area1 + area2;
13828  erro12 = error1 + error2;
13829  errsum = errsum + erro12 - errmax;
13830  area = area + area12 - rlist[maxerr];
13831  if ((r__1 = rlist[maxerr] - area12, fabs(r__1)) < fabs(area12) *
13832  1e-5f && erro12 >= errmax * .99f && krule == 0) {
13833  ++iroff1;
13834  }
13835  if (*last > 10 && erro12 > errmax && krule == 0) {
13836  ++iroff2;
13837  }
13838  rlist[maxerr] = area1;
13839  rlist[*last] = area2;
13840  /* Computing MAX */
13841  r__1 = *epsabs, r__2 = *epsrel * fabs(area);
13842  errbnd = max(r__1,r__2);
13843  if (errsum <= errbnd) {
13844  goto L15;
13845  }
13846 
13847  /* test for roundoff error and eventually */
13848  /* set error flag. */
13849 
13850  if (iroff1 >= 6 && iroff2 > 20) {
13851  *ier = 2;
13852  }
13853 
13854  /* set error flag in the case that number of interval */
13855  /* bisections exceeds limit. */
13856 
13857  if (*last == *limit) {
13858  *ier = 1;
13859  }
13860 
13861  /* set error flag in the case of bad integrand behaviour */
13862  /* at a point of the integration range. */
13863 
13864  /* Computing MAX */
13865  r__1 = fabs(a1), r__2 = fabs(b2);
13866  if (max(r__1,r__2) <= (epmach * 100.f + 1.f) * (fabs(a2) + uflow *
13867  1e3f)) {
13868  *ier = 3;
13869  }
13870 
13871  /* append the newly-created intervals to the list. */
13872 
13873  L15:
13874  if (error2 > error1) {
13875  goto L20;
13876  }
13877  alist__[*last] = a2;
13878  blist[maxerr] = b1;
13879  blist[*last] = b2;
13880  elist[maxerr] = error1;
13881  elist[*last] = error2;
13882  goto L30;
13883  L20:
13884  alist__[maxerr] = a2;
13885  alist__[*last] = a1;
13886  blist[*last] = b1;
13887  rlist[maxerr] = area2;
13888  rlist[*last] = area1;
13889  elist[maxerr] = error2;
13890  elist[*last] = error1;
13891 
13892  /* call subroutine qpsrt to maintain the descending ordering */
13893  /* in the list of error estimates and select the */
13894  /* subinterval with nrmax-th largest error estimate (to be */
13895  /* bisected next). */
13896 
13897  L30:
13898  qpsrt_(limit, last, &maxerr, &errmax, &elist[1], &iord[1], &nrmax);
13899  /* ***jump out of do-loop */
13900  if (*ier != 0 || errsum <= errbnd) {
13901  goto L50;
13902  }
13903  /* L40: */
13904  }
13905 
13906  /* compute final result. */
13907  /* --------------------- */
13908 
13909 L50:
13910  *result = 0.f;
13911  i__1 = *last;
13912  for (k = 1; k <= i__1; ++k) {
13913  *result += rlist[k];
13914  /* L60: */
13915  }
13916  *abserr = errsum;
13917 L70:
13918  if (aa == *b) {
13919  *result = -(*result);
13920  }
13921 L999:
13922  return;
13923 } /* qawce_ */
13924 
13925 void qawc_(const E_fp& f, const sys_float *a, const sys_float *b,
13926  const sys_float *c__, const sys_float *epsabs,
13927  const sys_float *epsrel, sys_float *result,
13928  sys_float *abserr, long *neval, long *ier,
13929  long *limit, const long *lenw, long *last, long *iwork,
13930  sys_float *work)
13931 {
13932  long l1, l2, l3, lvl;
13933 
13934  /* ***begin prologue qawc */
13935  /* ***date written 800101 (yymmdd) */
13936  /* ***revision date 830518 (yymmdd) */
13937  /* ***category no. h2a2a1,j4 */
13938  /* ***keywords automatic integrator, special-purpose, */
13939  /* cauchy principal value, */
13940  /* clenshaw-curtis, globally adaptive */
13941  /* ***author piessens,robert ,appl. math. & progr. div. - k.u.leuven */
13942  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
13943  /* ***purpose the routine calculates an approximation result to a */
13944  /* cauchy principal value i = integral of f*w over (a,b) */
13945  /* (w(x) = 1/((x-c), c.ne.a, c.ne.b), hopefully satisfying */
13946  /* following claim for accuracy */
13947  /* fabs(i-result).le.max(epsabe,epsrel*fabs(i)). */
13948  /* ***description */
13949 
13950  /* computation of a cauchy principal value */
13951  /* standard fortran subroutine */
13952  /* sys_float version */
13953 
13954 
13955  /* parameters */
13956  /* on entry */
13957  /* f - sys_float */
13958  /* function subprogram defining the integrand */
13959  /* function f(x). the actual name for f needs to be */
13960  /* declared e x t e r n a l in the driver program. */
13961 
13962  /* a - sys_float */
13963  /* under limit of integration */
13964 
13965  /* b - sys_float */
13966  /* upper limit of integration */
13967 
13968  /* c - parameter in the weight function, c.ne.a, c.ne.b. */
13969  /* if c = a or c = b, the routine will end with */
13970  /* ier = 6 . */
13971 
13972  /* epsabs - sys_float */
13973  /* absolute accuracy requested */
13974  /* epsrel - sys_float */
13975  /* relative accuracy requested */
13976  /* if epsabs.le.0 */
13977  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
13978  /* the routine will end with ier = 6. */
13979 
13980  /* on return */
13981  /* result - sys_float */
13982  /* approximation to the integral */
13983 
13984  /* abserr - sys_float */
13985  /* estimate or the modulus of the absolute error, */
13986  /* which should equal or exceed fabs(i-result) */
13987 
13988  /* neval - long */
13989  /* number of integrand evaluations */
13990 
13991  /* ier - long */
13992  /* ier = 0 normal and reliable termination of the */
13993  /* routine. it is assumed that the requested */
13994  /* accuracy has been achieved. */
13995  /* ier.gt.0 abnormal termination of the routine */
13996  /* the estimates for integral and error are */
13997  /* less reliable. it is assumed that the */
13998  /* requested accuracy has not been achieved. */
13999  /* error messages */
14000  /* ier = 1 maximum number of subdivisions allowed */
14001  /* has been achieved. one can allow more sub- */
14002  /* divisions by increasing the value of limit */
14003  /* (and taking the according dimension */
14004  /* adjustments into account). however, if */
14005  /* this yields no improvement it is advised */
14006  /* to analyze the integrand in order to */
14007  /* determine the integration difficulties. */
14008  /* if the position of a local difficulty */
14009  /* can be determined (e.g. singularity, */
14010  /* discontinuity within the interval) one */
14011  /* will probably gain from splitting up the */
14012  /* interval at this point and calling */
14013  /* appropriate integrators on the subranges. */
14014  /* = 2 the occurrence of roundoff error is detec- */
14015  /* ted, which prevents the requested */
14016  /* tolerance from being achieved. */
14017  /* = 3 extremely bad integrand behaviour occurs */
14018  /* at some points of the integration */
14019  /* interval. */
14020  /* = 6 the input is invalid, because */
14021  /* c = a or c = b or */
14022  /* (epsabs.le.0 and */
14023  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28)) */
14024  /* or limit.lt.1 or lenw.lt.limit*4. */
14025  /* result, abserr, neval, last are set to */
14026  /* zero. exept when lenw or limit is invalid, */
14027  /* iwork(1), work(limit*2+1) and */
14028  /* work(limit*3+1) are set to zero, work(1) */
14029  /* is set to a and work(limit+1) to b. */
14030 
14031  /* dimensioning parameters */
14032  /* limit - long */
14033  /* dimensioning parameter for iwork */
14034  /* limit determines the maximum number of subintervals */
14035  /* in the partition of the given integration interval */
14036  /* (a,b), limit.ge.1. */
14037  /* if limit.lt.1, the routine will end with ier = 6. */
14038 
14039  /* lenw - long */
14040  /* dimensioning parameter for work */
14041  /* lenw must be at least limit*4. */
14042  /* if lenw.lt.limit*4, the routine will end with */
14043  /* ier = 6. */
14044 
14045  /* last - long */
14046  /* on return, last equals the number of subintervals */
14047  /* produced in the subdivision process, which */
14048  /* determines the number of significant elements */
14049  /* actually in the work arrays. */
14050 
14051  /* work arrays */
14052  /* iwork - long */
14053  /* vector of dimension at least limit, the first k */
14054  /* elements of which contain pointers */
14055  /* to the error estimates over the subintervals, */
14056  /* such that work(limit*3+iwork(1)), ... , */
14057  /* work(limit*3+iwork(k)) form a decreasing */
14058  /* sequence, with k = last if last.le.(limit/2+2), */
14059  /* and k = limit+1-last otherwise */
14060 
14061  /* work - sys_float */
14062  /* vector of dimension at least lenw */
14063  /* on return */
14064  /* work(1), ..., work(last) contain the left */
14065  /* end points of the subintervals in the */
14066  /* partition of (a,b), */
14067  /* work(limit+1), ..., work(limit+last) contain */
14068  /* the right end points, */
14069  /* work(limit*2+1), ..., work(limit*2+last) contain */
14070  /* the integral approximations over the subintervals, */
14071  /* work(limit*3+1), ..., work(limit*3+last) */
14072  /* contain the error estimates. */
14073 
14074  /* ***references (none) */
14075  /* ***routines called qawce,xerror */
14076  /* ***end prologue qawc */
14077 
14078 
14079 
14080 
14081  /* check validity of limit and lenw. */
14082 
14083  /* ***first executable statement qawc */
14084  /* Parameter adjustments */
14085  --iwork;
14086  --work;
14087 
14088  /* Function Body */
14089  *ier = 6;
14090  *neval = 0;
14091  *last = 0;
14092  *result = 0.f;
14093  *abserr = 0.f;
14094  if (*limit < 1 || *lenw < *limit << 2) {
14095  goto L10;
14096  }
14097 
14098  /* prepare call for qawce. */
14099 
14100  l1 = *limit + 1;
14101  l2 = *limit + l1;
14102  l3 = *limit + l2;
14103  qawce_(f, a, b, c__, epsabs, epsrel, limit, result, abserr, neval,
14104  ier, &work[1], &work[l1], &work[l2], &work[l3], &iwork[1], last);
14105 
14106  /* call error handler if necessary. */
14107 
14108  lvl = 0;
14109 L10:
14110  if (*ier == 6) {
14111  lvl = 1;
14112  }
14113  if (*ier != 0) {
14114  xerror_("abnormal return from qawc", &c__26, ier, &lvl, 26);
14115  }
14116  return;
14117 } /* qawc_ */
14118 
14119 void qawfe_(const E_fp& f, const sys_float *a, const sys_float *omega,
14120  const long *integr,
14121  const sys_float *epsabs, const long *limlst, const long *limit,
14122  const long *maxp1, sys_float *result, sys_float *abserr,
14123  long *neval, long *ier, sys_float *rslst, sys_float *erlst,
14124  long *ierlst, long *lst, sys_float *alist__, sys_float *blist,
14125  sys_float *rlist, sys_float *elist, long *iord, long *nnlog,
14126  sys_float *chebmo)
14127 {
14128  /* Initialized data */
14129 
14130  sys_float p = .9f;
14131  sys_float pi = 3.1415926535897932f;
14132 
14133  /* System generated locals */
14134  int chebmo_dim1, chebmo_offset, i__1;
14135  sys_float r__1, r__2;
14136 
14137  /* Local variables */
14138  long l;
14139  sys_float c1, c2, p1, dl, ep;
14140  long ll=0;
14141  sys_float drl=0.f, eps;
14142  long nev;
14143  sys_float fact, epsa;
14144  long last, nres;
14145  sys_float psum[52];
14146  sys_float cycle;
14147  long ktmin;
14148  sys_float uflow;
14149  sys_float res3la[3];
14150  long numrl2;
14151  sys_float abseps, correc;
14152  long momcom;
14153  sys_float reseps, errsum;
14154 
14155  /* ***begin prologue qawfe */
14156  /* ***date written 800101 (yymmdd) */
14157  /* ***revision date 830518 (yymmdd) */
14158  /* ***category no. h2a3a1 */
14159  /* ***keywords automatic integrator, special-purpose, */
14160  /* fourier integrals, */
14161  /* integration between zeros with dqawoe, */
14162  /* convergence acceleration with dqelg */
14163  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
14164  /* dedoncker,elise,appl. math. & progr. div. - k.u.leuven */
14165  /* ***purpose the routine calculates an approximation result to a */
14166  /* given fourier integal */
14167  /* i = integral of f(x)*w(x) over (a,infinity) */
14168  /* where w(x) = cos(omega*x) or w(x) = sin(omega*x), */
14169  /* hopefully satisfying following claim for accuracy */
14170  /* fabs(i-result).le.epsabs. */
14171  /* ***description */
14172 
14173  /* computation of fourier integrals */
14174  /* standard fortran subroutine */
14175  /* sys_float version */
14176 
14177  /* parameters */
14178  /* on entry */
14179  /* f - sys_float */
14180  /* function subprogram defining the integrand */
14181  /* function f(x). the actual name for f needs to */
14182  /* be declared e x t e r n a l in the driver program. */
14183 
14184  /* a - sys_float */
14185  /* lower limit of integration */
14186 
14187  /* omega - sys_float */
14188  /* parameter in the weight function */
14189 
14190  /* integr - long */
14191  /* indicates which weight function is used */
14192  /* integr = 1 w(x) = cos(omega*x) */
14193  /* integr = 2 w(x) = sin(omega*x) */
14194  /* if integr.ne.1.and.integr.ne.2, the routine will */
14195  /* end with ier = 6. */
14196 
14197  /* epsabs - sys_float */
14198  /* absolute accuracy requested, epsabs.gt.0 */
14199  /* if epsabs.le.0, the routine will end with ier = 6. */
14200 
14201  /* limlst - long */
14202  /* limlst gives an upper bound on the number of */
14203  /* cycles, limlst.ge.1. */
14204  /* if limlst.lt.3, the routine will end with ier = 6. */
14205 
14206  /* limit - long */
14207  /* gives an upper bound on the number of subintervals */
14208  /* allowed in the partition of each cycle, limit.ge.1 */
14209  /* each cycle, limit.ge.1. */
14210 
14211  /* maxp1 - long */
14212  /* gives an upper bound on the number of */
14213  /* chebyshev moments which can be stored, i.e. */
14214  /* for the intervals of lengths fabs(b-a)*2**(-l), */
14215  /* l=0,1, ..., maxp1-2, maxp1.ge.1 */
14216 
14217  /* on return */
14218  /* result - sys_float */
14219  /* approximation to the integral x */
14220 
14221  /* abserr - sys_float */
14222  /* estimate of the modulus of the absolute error, */
14223  /* which should equal or exceed fabs(i-result) */
14224 
14225  /* neval - long */
14226  /* number of integrand evaluations */
14227 
14228  /* ier - ier = 0 normal and reliable termination of */
14229  /* the routine. it is assumed that the */
14230  /* requested accuracy has been achieved. */
14231  /* ier.gt.0 abnormal termination of the routine. the */
14232  /* estimates for integral and error are less */
14233  /* reliable. it is assumed that the requested */
14234  /* accuracy has not been achieved. */
14235  /* error messages */
14236  /* if omega.ne.0 */
14237  /* ier = 1 maximum number of cycles allowed */
14238  /* has been achieved., i.e. of subintervals */
14239  /* (a+(k-1)c,a+kc) where */
14240  /* c = (2*int(fabs(omega))+1)*pi/fabs(omega), */
14241  /* for k = 1, 2, ..., lst. */
14242  /* one can allow more cycles by increasing */
14243  /* the value of limlst (and taking the */
14244  /* according dimension adjustments into */
14245  /* account). */
14246  /* examine the array iwork which contains */
14247  /* the error flags on the cycles, in order to */
14248  /* look for eventual local integration */
14249  /* difficulties. if the position of a local */
14250  /* difficulty can be determined (e.g. */
14251  /* singularity, discontinuity within the */
14252  /* interval) one will probably gain from */
14253  /* splitting up the interval at this polong */
14254  /* and calling appropriate integrators on */
14255  /* the subranges. */
14256  /* = 4 the extrapolation table constructed for */
14257  /* convergence acceleration of the series */
14258  /* formed by the integral contributions over */
14259  /* the cycles, does not converge to within */
14260  /* the requested accuracy. as in the case of */
14261  /* ier = 1, it is advised to examine the */
14262  /* array iwork which contains the error */
14263  /* flags on the cycles. */
14264  /* = 6 the input is invalid because */
14265  /* (integr.ne.1 and integr.ne.2) or */
14266  /* epsabs.le.0 or limlst.lt.3. */
14267  /* result, abserr, neval, lst are set */
14268  /* to zero. */
14269  /* = 7 bad integrand behaviour occurs within one */
14270  /* or more of the cycles. location and type */
14271  /* of the difficulty involved can be */
14272  /* determined from the vector ierlst. here */
14273  /* lst is the number of cycles actually */
14274  /* needed (see below). */
14275  /* ierlst(k) = 1 the maximum number of */
14276  /* subdivisions (= limit) has */
14277  /* been achieved on the k th */
14278  /* cycle. */
14279  /* = 2 occurrence of roundoff error */
14280  /* is detected and prevents the */
14281  /* tolerance imposed on the */
14282  /* k th cycle, from being */
14283  /* achieved. */
14284  /* = 3 extremely bad integrand */
14285  /* behaviour occurs at some */
14286  /* points of the k th cycle. */
14287  /* = 4 the integration procedure */
14288  /* over the k th cycle does */
14289  /* not converge (to within the */
14290  /* required accuracy) due to */
14291  /* roundoff in the */
14292  /* extrapolation procedure */
14293  /* invoked on this cycle. it */
14294  /* is assumed that the result */
14295  /* on this interval is the */
14296  /* best which can be obtained. */
14297  /* = 5 the integral over the k th */
14298  /* cycle is probably divergent */
14299  /* or slowly convergent. it */
14300  /* must be noted that */
14301  /* divergence can occur with */
14302  /* any other value of */
14303  /* ierlst(k). */
14304  /* if omega = 0 and integr = 1, */
14305  /* the integral is calculated by means of dqagie */
14306  /* and ier = ierlst(1) (with meaning as described */
14307  /* for ierlst(k), k = 1). */
14308 
14309  /* rslst - sys_float */
14310  /* vector of dimension at least limlst */
14311  /* rslst(k) contains the integral contribution */
14312  /* over the interval (a+(k-1)c,a+kc) where */
14313  /* c = (2*int(fabs(omega))+1)*pi/fabs(omega), */
14314  /* k = 1, 2, ..., lst. */
14315  /* note that, if omega = 0, rslst(1) contains */
14316  /* the value of the integral over (a,infinity). */
14317 
14318  /* erlst - sys_float */
14319  /* vector of dimension at least limlst */
14320  /* erlst(k) contains the error estimate corresponding */
14321  /* with rslst(k). */
14322 
14323  /* ierlst - long */
14324  /* vector of dimension at least limlst */
14325  /* ierlst(k) contains the error flag corresponding */
14326  /* with rslst(k). for the meaning of the local error */
14327  /* flags see description of output parameter ier. */
14328 
14329  /* lst - long */
14330  /* number of subintervals needed for the integration */
14331  /* if omega = 0 then lst is set to 1. */
14332 
14333  /* alist, blist, rlist, elist - sys_float */
14334  /* vector of dimension at least limit, */
14335 
14336  /* iord, nnlog - long */
14337  /* vector of dimension at least limit, providing */
14338  /* space for the quantities needed in the subdivision */
14339  /* process of each cycle */
14340 
14341  /* chebmo - sys_float */
14342  /* array of dimension at least (maxp1,25), providing */
14343  /* space for the chebyshev moments needed within the */
14344  /* cycles */
14345 
14346  /* ***references (none) */
14347  /* ***routines called qagie,qawoe,qelg,r1mach */
14348  /* ***end prologue qawfe */
14349 
14350 
14351 
14352 
14353 
14354  /* the dimension of psum is determined by the value of */
14355  /* limexp in subroutine qelg (psum must be */
14356  /* of dimension (limexp+2) at least). */
14357 
14358  /* list of major variables */
14359  /* ----------------------- */
14360 
14361  /* c1, c2 - end points of subinterval (of length */
14362  /* cycle) */
14363  /* cycle - (2*int(fabs(omega))+1)*pi/fabs(omega) */
14364  /* psum - vector of dimension at least (limexp+2) */
14365  /* (see routine qelg) */
14366  /* psum contains the part of the epsilon */
14367  /* table which is still needed for further */
14368  /* computations. */
14369  /* each element of psum is a partial sum of */
14370  /* the series which should sum to the value of */
14371  /* the integral. */
14372  /* errsum - sum of error estimates over the */
14373  /* subintervals, calculated cumulatively */
14374  /* epsa - absolute tolerance requested over current */
14375  /* subinterval */
14376  /* chebmo - array containing the modified chebyshev */
14377  /* moments (see also routine qc25f) */
14378 
14379  /* Parameter adjustments */
14380  --ierlst;
14381  --erlst;
14382  --rslst;
14383  --nnlog;
14384  --iord;
14385  --elist;
14386  --rlist;
14387  --blist;
14388  --alist__;
14389  chebmo_dim1 = *maxp1;
14390  chebmo_offset = 1 + chebmo_dim1;
14391  chebmo -= chebmo_offset;
14392 
14393  /* Function Body */
14394 
14395  /* test on validity of parameters */
14396  /* ------------------------------ */
14397 
14398  /* ***first executable statement qawfe */
14399  *result = 0.f;
14400  *abserr = 0.f;
14401  *neval = 0;
14402  *lst = 0;
14403  *ier = 0;
14404  if ( ( *integr != 1 && *integr != 2 ) || *epsabs <= 0.f || *limlst < 3) {
14405  *ier = 6;
14406  }
14407  if (*ier == 6) {
14408  goto L999;
14409  }
14410  if (*omega != 0.f) {
14411  goto L10;
14412  }
14413 
14414  /* integration by qagie if omega is zero */
14415  /* -------------------------------------- */
14416 
14417  if (*integr == 1) {
14418  qagie_(f, &c_b390, &c__1, epsabs, &c_b390, limit, result,
14419  abserr, neval, ier, &alist__[1], &blist[1], &rlist[1], &elist[
14420  1], &iord[1], &last);
14421  }
14422  rslst[1] = *result;
14423  erlst[1] = *abserr;
14424  ierlst[1] = *ier;
14425  *lst = 1;
14426  goto L999;
14427 
14428  /* initializations */
14429  /* --------------- */
14430 
14431 L10:
14432  l = fabs(*omega);
14433  dl = (sys_float) ((l << 1) + 1);
14434  cycle = dl * pi / fabs(*omega);
14435  *ier = 0;
14436  ktmin = 0;
14437  *neval = 0;
14438  numrl2 = 0;
14439  nres = 0;
14440  c1 = *a;
14441  c2 = cycle + *a;
14442  p1 = 1.f - p;
14443  eps = *epsabs;
14444  uflow = r1mach(c__1);
14445  if (*epsabs > uflow / p1) {
14446  eps = *epsabs * p1;
14447  }
14448  ep = eps;
14449  fact = 1.f;
14450  correc = 0.f;
14451  *abserr = 0.f;
14452  errsum = 0.f;
14453 
14454  /* main do-loop */
14455  /* ------------ */
14456 
14457  i__1 = *limlst;
14458  for (*lst = 1; *lst <= i__1; ++(*lst)) {
14459 
14460  /* integrate over current subinterval. */
14461 
14462  epsa = eps * fact;
14463  qawoe_(f, &c1, &c2, omega, integr, &epsa, &c_b390, limit, lst,
14464  maxp1, &rslst[*lst], &erlst[*lst], &nev, &ierlst[*lst], &last,
14465  &alist__[1], &blist[1], &rlist[1], &elist[1], &iord[1], &
14466  nnlog[1], &momcom, &chebmo[chebmo_offset]);
14467  *neval += nev;
14468  fact *= p;
14469  errsum += erlst[*lst];
14470  drl = (r__1 = rslst[*lst], fabs(r__1)) * 50.f;
14471 
14472  /* test on accuracy with partial sum */
14473 
14474  if (errsum + drl <= *epsabs && *lst >= 6) {
14475  goto L80;
14476  }
14477  /* Computing MAX */
14478  r__1 = correc, r__2 = erlst[*lst];
14479  correc = max(r__1,r__2);
14480  if (ierlst[*lst] != 0) {
14481  /* Computing MAX */
14482  r__1 = ep, r__2 = correc * p1;
14483  eps = max(r__1,r__2);
14484  }
14485  if (ierlst[*lst] != 0) {
14486  *ier = 7;
14487  }
14488  if (*ier == 7 && errsum + drl <= correc * 10.f && *lst > 5) {
14489  goto L80;
14490  }
14491  ++numrl2;
14492  if (*lst > 1) {
14493  goto L20;
14494  }
14495  psum[0] = rslst[1];
14496  goto L40;
14497  L20:
14498  psum[numrl2 - 1] = psum[ll - 1] + rslst[*lst];
14499  if (*lst == 2) {
14500  goto L40;
14501  }
14502 
14503  /* test on maximum number of subintervals */
14504 
14505  if (*lst == *limlst) {
14506  *ier = 1;
14507  }
14508 
14509  /* perform new extrapolation */
14510 
14511  qelg_(&numrl2, psum, &reseps, &abseps, res3la, &nres);
14512 
14513  /* test whether extrapolated result is influenced by */
14514  /* roundoff */
14515 
14516  ++ktmin;
14517  if (ktmin >= 15 && *abserr <= (errsum + drl) * .001f) {
14518  *ier = 4;
14519  }
14520  if (abseps > *abserr && *lst != 3) {
14521  goto L30;
14522  }
14523  *abserr = abseps;
14524  *result = reseps;
14525  ktmin = 0;
14526 
14527  /* if ier is not 0, check whether direct result (partial */
14528  /* sum) or extrapolated result yields the best integral */
14529  /* approximation */
14530 
14531  if (*abserr + correc * 10.f <= *epsabs ||
14532  ( *abserr <= *epsabs && correc * 10.f >= *epsabs) ) {
14533  goto L60;
14534  }
14535  L30:
14536  if (*ier != 0 && *ier != 7) {
14537  goto L60;
14538  }
14539  L40:
14540  ll = numrl2;
14541  c1 = c2;
14542  c2 += cycle;
14543  /* L50: */
14544  }
14545 
14546  /* set final result and error estimate */
14547  /* ----------------------------------- */
14548 
14549 L60:
14550  *abserr += correc * 10.f;
14551  if (*ier == 0) {
14552  goto L999;
14553  }
14554  if (*result != 0.f && psum[numrl2 - 1] != 0.f) {
14555  goto L70;
14556  }
14557  if (*abserr > errsum) {
14558  goto L80;
14559  }
14560  if (psum[numrl2 - 1] == 0.f) {
14561  goto L999;
14562  }
14563 L70:
14564  if (*abserr / fabs(*result) > (errsum + drl) / (r__1 = psum[numrl2 - 1],
14565  fabs(r__1))) {
14566  goto L80;
14567  }
14568  if (*ier >= 1 && *ier != 7) {
14569  *abserr += drl;
14570  }
14571  goto L999;
14572 L80:
14573  *result = psum[numrl2 - 1];
14574  *abserr = errsum + drl;
14575 L999:
14576  return;
14577 } /* qawfe_ */
14578 
14579 void qawf_(const E_fp& f, const sys_float *a, const sys_float *omega,
14580  const long *integr,
14581  const sys_float *epsabs, sys_float *result, sys_float *abserr,
14582  long *neval, long *ier, const long *limlst, long *lst,
14583  const long *leniw, const long *maxp1,
14584  const long *lenw, long *iwork, sys_float *work)
14585 {
14586  long l1, l2, l3, l4, l5, l6, ll2, lvl;
14587  long limit;
14588 
14589  /* ***begin prologue qawf */
14590  /* ***date written 800101 (yymmdd) */
14591  /* ***revision date 830518 (yymmdd) */
14592  /* ***category no. h2a3a1 */
14593  /* ***keywords automatic integrator, special-purpose,fourier */
14594  /* integral, integration between zeros with dqawoe, */
14595  /* convergence acceleration with dqext */
14596  /* ***author piessens,robert ,appl. math. & progr. div. - k.u.leuven */
14597  /* de doncker,elise,appl. math & progr. div. - k.u.leuven */
14598  /* ***purpose the routine calculates an approximation result to a given */
14599  /* fourier integral */
14600  /* i = integral of f(x)*w(x) over (a,infinity) */
14601  /* where w(x) = cos(omega*x) or w(x) = sin(omega*x). */
14602  /* hopefully satisfying following claim for accuracy */
14603  /* fabs(i-result).le.epsabs. */
14604  /* ***description */
14605 
14606  /* computation of fourier integrals */
14607  /* standard fortran subroutine */
14608  /* sys_float version */
14609 
14610 
14611  /* parameters */
14612  /* on entry */
14613  /* f - sys_float */
14614  /* function subprogram defining the integrand */
14615  /* function f(x). the actual name for f needs to be */
14616  /* declared e x t e r n a l in the driver program. */
14617 
14618  /* a - sys_float */
14619  /* lower limit of integration */
14620 
14621  /* omega - sys_float */
14622  /* parameter in the integrand weight function */
14623 
14624  /* integr - long */
14625  /* indicates which of the weight functions is used */
14626  /* integr = 1 w(x) = cos(omega*x) */
14627  /* integr = 2 w(x) = sin(omega*x) */
14628  /* if integr.ne.1.and.integr.ne.2, the routine */
14629  /* will end with ier = 6. */
14630 
14631  /* epsabs - sys_float */
14632  /* absolute accuracy requested, epsabs.gt.0. */
14633  /* if epsabs.le.0, the routine will end with ier = 6. */
14634 
14635  /* on return */
14636  /* result - sys_float */
14637  /* approximation to the integral */
14638 
14639  /* abserr - sys_float */
14640  /* estimate of the modulus of the absolute error, */
14641  /* which should equal or exceed fabs(i-result) */
14642 
14643  /* neval - long */
14644  /* number of integrand evaluations */
14645 
14646  /* ier - long */
14647  /* ier = 0 normal and reliable termination of the */
14648  /* routine. it is assumed that the requested */
14649  /* accuracy has been achieved. */
14650  /* ier.gt.0 abnormal termination of the routine. */
14651  /* the estimates for integral and error are */
14652  /* less reliable. it is assumed that the */
14653  /* requested accuracy has not been achieved. */
14654  /* error messages */
14655  /* if omega.ne.0 */
14656  /* ier = 1 maximum number of cycles allowed */
14657  /* has been achieved, i.e. of subintervals */
14658  /* (a+(k-1)c,a+kc) where */
14659  /* c = (2*int(fabs(omega))+1)*pi/fabs(omega), */
14660  /* for k = 1, 2, ..., lst. */
14661  /* one can allow more cycles by increasing */
14662  /* the value of limlst (and taking the */
14663  /* according dimension adjustments into */
14664  /* account). examine the array iwork which */
14665  /* contains the error flags on the cycles, in */
14666  /* order to look for eventual local */
14667  /* integration difficulties. */
14668  /* if the position of a local difficulty */
14669  /* can be determined (e.g. singularity, */
14670  /* discontinuity within the interval) one */
14671  /* will probably gain from splitting up the */
14672  /* interval at this point and calling */
14673  /* appropriate integrators on the subranges. */
14674  /* = 4 the extrapolation table constructed for */
14675  /* convergence accelaration of the series */
14676  /* formed by the integral contributions over */
14677  /* the cycles, does not converge to within */
14678  /* the requested accuracy. */
14679  /* as in the case of ier = 1, it is advised */
14680  /* to examine the array iwork which contains */
14681  /* the error flags on the cycles. */
14682  /* = 6 the input is invalid because */
14683  /* (integr.ne.1 and integr.ne.2) or */
14684  /* epsabs.le.0 or limlst.lt.1 or */
14685  /* leniw.lt.(limlst+2) or maxp1.lt.1 or */
14686  /* lenw.lt.(leniw*2+maxp1*25). */
14687  /* result, abserr, neval, lst are set to */
14688  /* zero. */
14689  /* = 7 bad integrand behaviour occurs within */
14690  /* one or more of the cycles. location and */
14691  /* type of the difficulty involved can be */
14692  /* determined from the first lst elements of */
14693  /* vector iwork. here lst is the number of */
14694  /* cycles actually needed (see below). */
14695  /* iwork(k) = 1 the maximum number of */
14696  /* subdivisions (=(leniw-limlst) */
14697  /* /2) has been achieved on the */
14698  /* k th cycle. */
14699  /* = 2 occurrence of roundoff error */
14700  /* is detected and prevents the */
14701  /* tolerance imposed on the k th */
14702  /* cycle, from being achieved */
14703  /* on this cycle. */
14704  /* = 3 extremely bad integrand */
14705  /* behaviour occurs at some */
14706  /* points of the k th cycle. */
14707  /* = 4 the integration procedure */
14708  /* over the k th cycle does */
14709  /* not converge (to within the */
14710  /* required accuracy) due to */
14711  /* roundoff in the extrapolation */
14712  /* procedure invoked on this */
14713  /* cycle. it is assumed that the */
14714  /* result on this interval is */
14715  /* the best which can be */
14716  /* obtained. */
14717  /* = 5 the integral over the k th */
14718  /* cycle is probably divergent */
14719  /* or slowly convergent. it must */
14720  /* be noted that divergence can */
14721  /* occur with any other value of */
14722  /* iwork(k). */
14723  /* if omega = 0 and integr = 1, */
14724  /* the integral is calculated by means of dqagie, */
14725  /* and ier = iwork(1) (with meaning as described */
14726  /* for iwork(k),k = 1). */
14727 
14728  /* dimensioning parameters */
14729  /* limlst - long */
14730  /* limlst gives an upper bound on the number of */
14731  /* cycles, limlst.ge.3. */
14732  /* if limlst.lt.3, the routine will end with ier = 6. */
14733 
14734  /* lst - long */
14735  /* on return, lst indicates the number of cycles */
14736  /* actually needed for the integration. */
14737  /* if omega = 0, then lst is set to 1. */
14738 
14739  /* leniw - long */
14740  /* dimensioning parameter for iwork. on entry, */
14741  /* (leniw-limlst)/2 equals the maximum number of */
14742  /* subintervals allowed in the partition of each */
14743  /* cycle, leniw.ge.(limlst+2). */
14744  /* if leniw.lt.(limlst+2), the routine will end with */
14745  /* ier = 6. */
14746 
14747  /* maxp1 - long */
14748  /* maxp1 gives an upper bound on the number of */
14749  /* chebyshev moments which can be stored, i.e. for */
14750  /* the intervals of lengths fabs(b-a)*2**(-l), */
14751  /* l = 0,1, ..., maxp1-2, maxp1.ge.1. */
14752  /* if maxp1.lt.1, the routine will end with ier = 6. */
14753  /* lenw - long */
14754  /* dimensioning parameter for work */
14755  /* lenw must be at least leniw*2+maxp1*25. */
14756  /* if lenw.lt.(leniw*2+maxp1*25), the routine will */
14757  /* end with ier = 6. */
14758 
14759  /* work arrays */
14760  /* iwork - long */
14761  /* vector of dimension at least leniw */
14762  /* on return, iwork(k) for k = 1, 2, ..., lst */
14763  /* contain the error flags on the cycles. */
14764 
14765  /* work - sys_float */
14766  /* vector of dimension at least */
14767  /* on return, */
14768  /* work(1), ..., work(lst) contain the integral */
14769  /* approximations over the cycles, */
14770  /* work(limlst+1), ..., work(limlst+lst) contain */
14771  /* the error extimates over the cycles. */
14772  /* further elements of work have no specific */
14773  /* meaning for the user. */
14774 
14775  /* ***references (none) */
14776  /* ***routines called qawfe,xerror */
14777  /* ***end prologue qawf */
14778 
14779 
14780 
14781 
14782  /* check validity of limlst, leniw, maxp1 and lenw. */
14783 
14784  /* ***first executable statement qawf */
14785  /* Parameter adjustments */
14786  --iwork;
14787  --work;
14788 
14789  /* Function Body */
14790  *ier = 6;
14791  *neval = 0;
14792  *result = 0.f;
14793  *abserr = 0.f;
14794  if (*limlst < 3 || *leniw < *limlst + 2 || *maxp1 < 1 || *lenw < (*leniw
14795  << 1) + *maxp1 * 25) {
14796  goto L10;
14797  }
14798 
14799  /* prepare call for qawfe */
14800 
14801  limit = (*leniw - *limlst) / 2;
14802  l1 = *limlst + 1;
14803  l2 = *limlst + l1;
14804  l3 = limit + l2;
14805  l4 = limit + l3;
14806  l5 = limit + l4;
14807  l6 = limit + l5;
14808  ll2 = limit + l1;
14809  qawfe_(f, a, omega, integr, epsabs, limlst, &limit, maxp1, result,
14810  abserr, neval, ier, &work[1], &work[l1], &iwork[1], lst, &work[l2]
14811  , &work[l3], &work[l4], &work[l5], &iwork[l1], &iwork[ll2], &work[
14812  l6]);
14813 
14814  /* call error handler if necessary */
14815 
14816  lvl = 0;
14817 L10:
14818  if (*ier == 6) {
14819  lvl = 1;
14820  }
14821  if (*ier != 0) {
14822  xerror_("abnormal return from qawf", &c__26, ier, &lvl, 26);
14823  }
14824  return;
14825 } /* qawf_ */
14826 
14827 void qawoe_(const E_fp& f, const sys_float *a, const sys_float *b,
14828  const sys_float *omega, const long *integr,
14829  const sys_float *epsabs, const sys_float *epsrel,
14830  const long *limit, const long *icall, const long *maxp1,
14831  sys_float *result, sys_float *abserr, long *neval, long *
14832  ier, long *last, sys_float *alist__, sys_float *blist, sys_float *rlist, sys_float *
14833  elist, long *iord, long *nnlog, long *momcom, sys_float *chebmo)
14834 {
14835  /* System generated locals */
14836  int chebmo_dim1, chebmo_offset, i__1, i__2;
14837  sys_float r__1, r__2;
14838 
14839  /* Local variables */
14840  long k;
14841  sys_float a1, a2, b1, b2;
14842  long id, nev;
14843  sys_float area;
14844  sys_float dres;
14845  long ksgn, nres;
14846  sys_float area1, area2, area12, small, erro12, defab1, defab2, width;
14847  long ierro;
14848  sys_float oflow;
14849  long ktmin, nrmax, nrmom;
14850  sys_float uflow;
14851  bool noext;
14852  long iroff1, iroff2, iroff3;
14853  sys_float res3la[3], error1, error2, rlist2[52];
14854  long numrl2;
14855  sys_float defabs, domega, epmach, erlarg=0.f, abseps, correc=0.f, errbnd,
14856  resabs;
14857  long jupbnd;
14858  bool extall;
14859  sys_float erlast, errmax;
14860  long maxerr;
14861  sys_float reseps;
14862  bool extrap;
14863  sys_float ertest=0.f, errsum;
14864 
14865  /* ***begin prologue qawoe */
14866  /* ***date written 800101 (yymmdd) */
14867  /* ***revision date 830518 (yymmdd) */
14868  /* ***category no. h2a2a1 */
14869  /* ***keywords automatic integrator, special-purpose, */
14870  /* integrand with oscillatory cos or sin factor, */
14871  /* clenshaw-curtis method, (end point) singularities, */
14872  /* extrapolation, globally adaptive */
14873  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
14874  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
14875  /* ***purpose the routine calculates an approximation result to a given */
14876  /* definite integral */
14877  /* i = integral of f(x)*w(x) over (a,b) */
14878  /* where w(x) = cos(omega*x) or w(x) = sin(omega*x), */
14879  /* hopefully satisfying following claim for accuracy */
14880  /* fabs(i-result).le.max(epsabs,epsrel*fabs(i)). */
14881  /* ***description */
14882 
14883  /* computation of oscillatory integrals */
14884  /* standard fortran subroutine */
14885  /* sys_float version */
14886 
14887  /* parameters */
14888  /* on entry */
14889  /* f - sys_float */
14890  /* function subprogram defining the integrand */
14891  /* function f(x). the actual name for f needs to be */
14892  /* declared e x t e r n a l in the driver program. */
14893 
14894  /* a - sys_float */
14895  /* lower limit of integration */
14896 
14897  /* b - sys_float */
14898  /* upper limit of integration */
14899 
14900  /* omega - sys_float */
14901  /* parameter in the integrand weight function */
14902 
14903  /* integr - long */
14904  /* indicates which of the weight functions is to be */
14905  /* used */
14906  /* integr = 1 w(x) = cos(omega*x) */
14907  /* integr = 2 w(x) = sin(omega*x) */
14908  /* if integr.ne.1 and integr.ne.2, the routine */
14909  /* will end with ier = 6. */
14910 
14911  /* epsabs - sys_float */
14912  /* absolute accuracy requested */
14913  /* epsrel - sys_float */
14914  /* relative accuracy requested */
14915  /* if epsabs.le.0 */
14916  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
14917  /* the routine will end with ier = 6. */
14918 
14919  /* limit - long */
14920  /* gives an upper bound on the number of subdivisions */
14921  /* in the partition of (a,b), limit.ge.1. */
14922 
14923  /* icall - long */
14924  /* if dqawoe is to be used only once, icall must */
14925  /* be set to 1. assume that during this call, the */
14926  /* chebyshev moments (for clenshaw-curtis integration */
14927  /* of degree 24) have been computed for intervals of */
14928  /* lenghts (fabs(b-a))*2**(-l), l=0,1,2,...momcom-1. */
14929  /* if icall.gt.1 this means that dqawoe has been */
14930  /* called twice or more on intervals of the same */
14931  /* length fabs(b-a). the chebyshev moments already */
14932  /* computed are then re-used in subsequent calls. */
14933  /* if icall.lt.1, the routine will end with ier = 6. */
14934 
14935  /* maxp1 - long */
14936  /* gives an upper bound on the number of chebyshev */
14937  /* moments which can be stored, i.e. for the */
14938  /* intervals of lenghts fabs(b-a)*2**(-l), */
14939  /* l=0,1, ..., maxp1-2, maxp1.ge.1. */
14940  /* if maxp1.lt.1, the routine will end with ier = 6. */
14941 
14942  /* on return */
14943  /* result - sys_float */
14944  /* approximation to the integral */
14945 
14946  /* abserr - sys_float */
14947  /* estimate of the modulus of the absolute error, */
14948  /* which should equal or exceed fabs(i-result) */
14949 
14950  /* neval - long */
14951  /* number of integrand evaluations */
14952 
14953  /* ier - long */
14954  /* ier = 0 normal and reliable termination of the */
14955  /* routine. it is assumed that the */
14956  /* requested accuracy has been achieved. */
14957  /* - ier.gt.0 abnormal termination of the routine. */
14958  /* the estimates for integral and error are */
14959  /* less reliable. it is assumed that the */
14960  /* requested accuracy has not been achieved. */
14961  /* error messages */
14962  /* ier = 1 maximum number of subdivisions allowed */
14963  /* has been achieved. one can allow more */
14964  /* subdivisions by increasing the value of */
14965  /* limit (and taking according dimension */
14966  /* adjustments into account). however, if */
14967  /* this yields no improvement it is advised */
14968  /* to analyze the integrand, in order to */
14969  /* determine the integration difficulties. */
14970  /* if the position of a local difficulty can */
14971  /* be determined (e.g. singularity, */
14972  /* discontinuity within the interval) one */
14973  /* will probably gain from splitting up the */
14974  /* interval at this point and calling the */
14975  /* integrator on the subranges. if possible, */
14976  /* an appropriate special-purpose integrator */
14977  /* should be used which is designed for */
14978  /* handling the type of difficulty involved. */
14979  /* = 2 the occurrence of roundoff error is */
14980  /* detected, which prevents the requested */
14981  /* tolerance from being achieved. */
14982  /* the error may be under-estimated. */
14983  /* = 3 extremely bad integrand behaviour occurs */
14984  /* at some points of the integration */
14985  /* interval. */
14986  /* = 4 the algorithm does not converge. */
14987  /* roundoff error is detected in the */
14988  /* extrapolation table. */
14989  /* it is presumed that the requested */
14990  /* tolerance cannot be achieved due to */
14991  /* roundoff in the extrapolation table, */
14992  /* and that the returned result is the */
14993  /* best which can be obtained. */
14994  /* = 5 the integral is probably divergent, or */
14995  /* slowly convergent. it must be noted that */
14996  /* divergence can occur with any other value */
14997  /* of ier.gt.0. */
14998  /* = 6 the input is invalid, because */
14999  /* (epsabs.le.0 and */
15000  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28)) */
15001  /* or (integr.ne.1 and integr.ne.2) or */
15002  /* icall.lt.1 or maxp1.lt.1. */
15003  /* result, abserr, neval, last, rlist(1), */
15004  /* elist(1), iord(1) and nnlog(1) are set */
15005  /* to zero. alist(1) and blist(1) are set */
15006  /* to a and b respectively. */
15007 
15008  /* last - long */
15009  /* on return, last equals the number of */
15010  /* subintervals produces in the subdivision */
15011  /* process, which determines the number of */
15012  /* significant elements actually in the */
15013  /* work arrays. */
15014  /* alist - sys_float */
15015  /* vector of dimension at least limit, the first */
15016  /* last elements of which are the left */
15017  /* end points of the subintervals in the partition */
15018  /* of the given integration range (a,b) */
15019 
15020  /* blist - sys_float */
15021  /* vector of dimension at least limit, the first */
15022  /* last elements of which are the right */
15023  /* end points of the subintervals in the partition */
15024  /* of the given integration range (a,b) */
15025 
15026  /* rlist - sys_float */
15027  /* vector of dimension at least limit, the first */
15028  /* last elements of which are the integral */
15029  /* approximations on the subintervals */
15030 
15031  /* elist - sys_float */
15032  /* vector of dimension at least limit, the first */
15033  /* last elements of which are the moduli of the */
15034  /* absolute error estimates on the subintervals */
15035 
15036  /* iord - long */
15037  /* vector of dimension at least limit, the first k */
15038  /* elements of which are pointers to the error */
15039  /* estimates over the subintervals, */
15040  /* such that elist(iord(1)), ..., */
15041  /* elist(iord(k)) form a decreasing sequence, with */
15042  /* k = last if last.le.(limit/2+2), and */
15043  /* k = limit+1-last otherwise. */
15044 
15045  /* nnlog - long */
15046  /* vector of dimension at least limit, containing the */
15047  /* subdivision levels of the subintervals, i.e. */
15048  /* iwork(i) = l means that the subinterval */
15049  /* numbered i is of length fabs(b-a)*2**(1-l) */
15050 
15051  /* on entry and return */
15052  /* momcom - long */
15053  /* indicating that the chebyshev moments */
15054  /* have been computed for intervals of lengths */
15055  /* (fabs(b-a))*2**(-l), l=0,1,2, ..., momcom-1, */
15056  /* momcom.lt.maxp1 */
15057 
15058  /* chebmo - sys_float */
15059  /* array of dimension (maxp1,25) containing the */
15060  /* chebyshev moments */
15061 
15062  /* ***references (none) */
15063  /* ***routines called qc25f,qelg,qpsrt,r1mach */
15064  /* ***end prologue qawoe */
15065 
15066 
15067 
15068 
15069  /* the dimension of rlist2 is determined by the value of */
15070  /* limexp in subroutine qelg (rlist2 should be of */
15071  /* dimension (limexp+2) at least). */
15072 
15073  /* list of major variables */
15074  /* ----------------------- */
15075 
15076  /* alist - list of left end points of all subintervals */
15077  /* considered up to now */
15078  /* blist - list of right end points of all subintervals */
15079  /* considered up to now */
15080  /* rlist(i) - approximation to the integral over */
15081  /* (alist(i),blist(i)) */
15082  /* rlist2 - array of dimension at least limexp+2 */
15083  /* containing the part of the epsilon table */
15084  /* which is still needed for further computations */
15085  /* elist(i) - error estimate applying to rlist(i) */
15086  /* maxerr - pointer to the interval with largest */
15087  /* error estimate */
15088  /* errmax - elist(maxerr) */
15089  /* erlast - error on the interval currently subdivided */
15090  /* area - sum of the integrals over the subintervals */
15091  /* errsum - sum of the errors over the subintervals */
15092  /* errbnd - requested accuracy max(epsabs,epsrel* */
15093  /* fabs(result)) */
15094  /* *****1 - variable for the left subinterval */
15095  /* *****2 - variable for the right subinterval */
15096  /* last - index for subdivision */
15097  /* nres - number of calls to the extrapolation routine */
15098  /* numrl2 - number of elements in rlist2. if an appropriate */
15099  /* approximation to the compounded integral has */
15100  /* been obtained it is put in rlist2(numrl2) after */
15101  /* numrl2 has been increased by one */
15102  /* small - length of the smallest interval considered */
15103  /* up to now, multiplied by 1.5 */
15104  /* erlarg - sum of the errors over the intervals larger */
15105  /* than the smallest interval considered up to now */
15106  /* extrap - bool variable denoting that the routine is */
15107  /* attempting to perform extrapolation, i.e. before */
15108  /* subdividing the smallest interval we try to */
15109  /* decrease the value of erlarg */
15110  /* noext - bool variable denoting that extrapolation */
15111  /* is no longer allowed (true value) */
15112 
15113  /* machine dependent constants */
15114  /* --------------------------- */
15115 
15116  /* epmach is the largest relative spacing. */
15117  /* uflow is the smallest positive magnitude. */
15118  /* oflow is the largest positive magnitude. */
15119 
15120  /* ***first executable statement qawoe */
15121  /* Parameter adjustments */
15122  --nnlog;
15123  --iord;
15124  --elist;
15125  --rlist;
15126  --blist;
15127  --alist__;
15128  chebmo_dim1 = *maxp1;
15129  chebmo_offset = 1 + chebmo_dim1;
15130  chebmo -= chebmo_offset;
15131 
15132  /* Function Body */
15133  epmach = r1mach(c__4);
15134 
15135  /* test on validity of parameters */
15136  /* ------------------------------ */
15137 
15138  *ier = 0;
15139  *neval = 0;
15140  *last = 0;
15141  *result = 0.f;
15142  *abserr = 0.f;
15143  alist__[1] = *a;
15144  blist[1] = *b;
15145  rlist[1] = 0.f;
15146  elist[1] = 0.f;
15147  iord[1] = 0;
15148  nnlog[1] = 0;
15149  /* Computing MAX */
15150  r__1 = epmach * 50.f;
15151  if ( ( *integr != 1 && *integr != 2) ||
15152  (*epsabs <= 0.f && *epsrel < max(r__1,5e-15f)) ||
15153  *icall < 1 || *maxp1 < 1) {
15154  *ier = 6;
15155  }
15156  if (*ier == 6) {
15157  goto L999;
15158  }
15159 
15160  /* first approximation to the integral */
15161  /* ----------------------------------- */
15162 
15163  domega = fabs(*omega);
15164  nrmom = 0;
15165  if (*icall > 1) {
15166  goto L5;
15167  }
15168  *momcom = 0;
15169 L5:
15170  qc25f_(f, a, b, &domega, integr, &nrmom, maxp1, &c__0, result,
15171  abserr, neval, &defabs, &resabs, momcom, &chebmo[chebmo_offset]);
15172 
15173  /* test on accuracy. */
15174 
15175  dres = fabs(*result);
15176  /* Computing MAX */
15177  r__1 = *epsabs, r__2 = *epsrel * dres;
15178  errbnd = max(r__1,r__2);
15179  rlist[1] = *result;
15180  elist[1] = *abserr;
15181  iord[1] = 1;
15182  if (*abserr <= epmach * 100.f * defabs && *abserr > errbnd) {
15183  *ier = 2;
15184  }
15185  if (*limit == 1) {
15186  *ier = 1;
15187  }
15188  if (*ier != 0 || *abserr <= errbnd) {
15189  goto L200;
15190  }
15191 
15192  /* initializations */
15193  /* --------------- */
15194 
15195  uflow = r1mach(c__1);
15196  oflow = r1mach(c__2);
15197  errmax = *abserr;
15198  maxerr = 1;
15199  area = *result;
15200  errsum = *abserr;
15201  *abserr = oflow;
15202  nrmax = 1;
15203  extrap = false;
15204  noext = false;
15205  ierro = 0;
15206  iroff1 = 0;
15207  iroff2 = 0;
15208  iroff3 = 0;
15209  ktmin = 0;
15210  small = (r__1 = *b - *a, fabs(r__1)) * .75f;
15211  nres = 0;
15212  numrl2 = 0;
15213  extall = false;
15214  if ((r__1 = *b - *a, fabs(r__1)) * .5f * domega > 2.f) {
15215  goto L10;
15216  }
15217  numrl2 = 1;
15218  extall = true;
15219  rlist2[0] = *result;
15220 L10:
15221  if ((r__1 = *b - *a, fabs(r__1)) * .25f * domega <= 2.f) {
15222  extall = true;
15223  }
15224  ksgn = -1;
15225  if (dres >= (1.f - epmach * 50.f) * defabs) {
15226  ksgn = 1;
15227  }
15228 
15229  /* main do-loop */
15230  /* ------------ */
15231 
15232  i__1 = *limit;
15233  for (*last = 2; *last <= i__1; ++(*last)) {
15234 
15235  /* bisect the subinterval with the nrmax-th largest */
15236  /* error estimate. */
15237 
15238  nrmom = nnlog[maxerr] + 1;
15239  a1 = alist__[maxerr];
15240  b1 = (alist__[maxerr] + blist[maxerr]) * .5f;
15241  a2 = b1;
15242  b2 = blist[maxerr];
15243  erlast = errmax;
15244  qc25f_(f, &a1, &b1, &domega, integr, &nrmom, maxp1, &c__0, &
15245  area1, &error1, &nev, &resabs, &defab1, momcom, &chebmo[
15246  chebmo_offset]);
15247  *neval += nev;
15248  qc25f_(f, &a2, &b2, &domega, integr, &nrmom, maxp1, &c__1, &
15249  area2, &error2, &nev, &resabs, &defab2, momcom, &chebmo[
15250  chebmo_offset]);
15251  *neval += nev;
15252 
15253  /* improve previous approximations to integral */
15254  /* and error and test for accuracy. */
15255 
15256  area12 = area1 + area2;
15257  erro12 = error1 + error2;
15258  errsum = errsum + erro12 - errmax;
15259  area = area + area12 - rlist[maxerr];
15260  if (defab1 == error1 || defab2 == error2) {
15261  goto L25;
15262  }
15263  if ((r__1 = rlist[maxerr] - area12, fabs(r__1)) > fabs(area12) *
15264  1e-5f || erro12 < errmax * .99f) {
15265  goto L20;
15266  }
15267  if (extrap) {
15268  ++iroff2;
15269  }
15270  if (! extrap) {
15271  ++iroff1;
15272  }
15273  L20:
15274  if (*last > 10 && erro12 > errmax) {
15275  ++iroff3;
15276  }
15277  L25:
15278  rlist[maxerr] = area1;
15279  rlist[*last] = area2;
15280  nnlog[maxerr] = nrmom;
15281  nnlog[*last] = nrmom;
15282  /* Computing MAX */
15283  r__1 = *epsabs, r__2 = *epsrel * fabs(area);
15284  errbnd = max(r__1,r__2);
15285 
15286  /* test for roundoff error and eventually */
15287  /* set error flag */
15288 
15289  if (iroff1 + iroff2 >= 10 || iroff3 >= 20) {
15290  *ier = 2;
15291  }
15292  if (iroff2 >= 5) {
15293  ierro = 3;
15294  }
15295 
15296  /* set error flag in the case that the number of */
15297  /* subintervals equals limit. */
15298 
15299  if (*last == *limit) {
15300  *ier = 1;
15301  }
15302 
15303  /* set error flag in the case of bad integrand behaviour */
15304  /* at a point of the integration range. */
15305 
15306  /* Computing MAX */
15307  r__1 = fabs(a1), r__2 = fabs(b2);
15308  if (max(r__1,r__2) <= (epmach * 100.f + 1.f) * (fabs(a2) + uflow *
15309  1e3f)) {
15310  *ier = 4;
15311  }
15312 
15313  /* append the newly-created intervals to the list. */
15314 
15315  if (error2 > error1) {
15316  goto L30;
15317  }
15318  alist__[*last] = a2;
15319  blist[maxerr] = b1;
15320  blist[*last] = b2;
15321  elist[maxerr] = error1;
15322  elist[*last] = error2;
15323  goto L40;
15324  L30:
15325  alist__[maxerr] = a2;
15326  alist__[*last] = a1;
15327  blist[*last] = b1;
15328  rlist[maxerr] = area2;
15329  rlist[*last] = area1;
15330  elist[maxerr] = error2;
15331  elist[*last] = error1;
15332 
15333  /* call subroutine qpsrt to maintain the descending ordering */
15334  /* in the list of error estimates and select the */
15335  /* subinterval with nrmax-th largest error estimate (to be */
15336  /* bisected next). */
15337 
15338  L40:
15339  qpsrt_(limit, last, &maxerr, &errmax, &elist[1], &iord[1], &nrmax);
15340  /* ***jump out of do-loop */
15341  if (errsum <= errbnd) {
15342  goto L170;
15343  }
15344  if (*ier != 0) {
15345  goto L150;
15346  }
15347  if (*last == 2 && extall) {
15348  goto L120;
15349  }
15350  if (noext) {
15351  goto L140;
15352  }
15353  if (! extall) {
15354  goto L50;
15355  }
15356  erlarg -= erlast;
15357  if ((r__1 = b1 - a1, fabs(r__1)) > small) {
15358  erlarg += erro12;
15359  }
15360  if (extrap) {
15361  goto L70;
15362  }
15363 
15364  /* test whether the interval to be bisected next is the */
15365  /* smallest interval. */
15366 
15367  L50:
15368  width = (r__1 = blist[maxerr] - alist__[maxerr], fabs(r__1));
15369  if (width > small) {
15370  goto L140;
15371  }
15372  if (extall) {
15373  goto L60;
15374  }
15375 
15376  /* test whether we can start with the extrapolation */
15377  /* procedure (we do this if we integrate over the */
15378  /* next interval with use of a gauss-kronrod rule - see */
15379  /* subroutine qc25f). */
15380 
15381  small *= .5f;
15382  if (width * .25f * domega > 2.f) {
15383  goto L140;
15384  }
15385  extall = true;
15386  goto L130;
15387  L60:
15388  extrap = true;
15389  nrmax = 2;
15390  L70:
15391  if (ierro == 3 || erlarg <= ertest) {
15392  goto L90;
15393  }
15394 
15395  /* the smallest interval has the largest error. */
15396  /* before bisecting decrease the sum of the errors */
15397  /* over the larger intervals (erlarg) and perform */
15398  /* extrapolation. */
15399 
15400  jupbnd = *last;
15401  if (*last > *limit / 2 + 2) {
15402  jupbnd = *limit + 3 - *last;
15403  }
15404  id = nrmax;
15405  i__2 = jupbnd;
15406  for (k = id; k <= i__2; ++k) {
15407  maxerr = iord[nrmax];
15408  errmax = elist[maxerr];
15409  if ((r__1 = blist[maxerr] - alist__[maxerr], fabs(r__1)) > small)
15410  {
15411  goto L140;
15412  }
15413  ++nrmax;
15414  /* L80: */
15415  }
15416 
15417  /* perform extrapolation. */
15418 
15419  L90:
15420  ++numrl2;
15421  rlist2[numrl2 - 1] = area;
15422  if (numrl2 < 3) {
15423  goto L110;
15424  }
15425  qelg_(&numrl2, rlist2, &reseps, &abseps, res3la, &nres);
15426  ++ktmin;
15427  if (ktmin > 5 && *abserr < errsum * .001f) {
15428  *ier = 5;
15429  }
15430  if (abseps >= *abserr) {
15431  goto L100;
15432  }
15433  ktmin = 0;
15434  *abserr = abseps;
15435  *result = reseps;
15436  correc = erlarg;
15437  /* Computing MAX */
15438  r__1 = *epsabs, r__2 = *epsrel * fabs(reseps);
15439  ertest = max(r__1,r__2);
15440  /* ***jump out of do-loop */
15441  if (*abserr <= ertest) {
15442  goto L150;
15443  }
15444 
15445  /* prepare bisection of the smallest interval. */
15446 
15447  L100:
15448  if (numrl2 == 1) {
15449  noext = true;
15450  }
15451  if (*ier == 5) {
15452  goto L150;
15453  }
15454  L110:
15455  maxerr = iord[1];
15456  errmax = elist[maxerr];
15457  nrmax = 1;
15458  extrap = false;
15459  small *= .5f;
15460  erlarg = errsum;
15461  goto L140;
15462  L120:
15463  small *= .5f;
15464  ++numrl2;
15465  rlist2[numrl2 - 1] = area;
15466  L130:
15467  ertest = errbnd;
15468  erlarg = errsum;
15469  L140:
15470  ;
15471  }
15472 
15473  /* set the final result. */
15474  /* --------------------- */
15475 
15476 L150:
15477  if (*abserr == oflow || nres == 0) {
15478  goto L170;
15479  }
15480  if (*ier + ierro == 0) {
15481  goto L165;
15482  }
15483  if (ierro == 3) {
15484  *abserr += correc;
15485  }
15486  if (*ier == 0) {
15487  *ier = 3;
15488  }
15489  if (*result != 0.f && area != 0.f) {
15490  goto L160;
15491  }
15492  if (*abserr > errsum) {
15493  goto L170;
15494  }
15495  if (area == 0.f) {
15496  goto L190;
15497  }
15498  goto L165;
15499 L160:
15500  if (*abserr / fabs(*result) > errsum / fabs(area)) {
15501  goto L170;
15502  }
15503 
15504  /* test on divergence. */
15505 
15506 L165:
15507  /* Computing MAX */
15508  r__1 = fabs(*result), r__2 = fabs(area);
15509  if (ksgn == -1 && max(r__1,r__2) <= defabs * .01f) {
15510  goto L190;
15511  }
15512  if (.01f > *result / area || *result / area > 100.f || errsum >= fabs(
15513  area)) {
15514  *ier = 6;
15515  }
15516  goto L190;
15517 
15518  /* compute global integral sum. */
15519 
15520 L170:
15521  *result = 0.f;
15522  i__1 = *last;
15523  for (k = 1; k <= i__1; ++k) {
15524  *result += rlist[k];
15525  /* L180: */
15526  }
15527  *abserr = errsum;
15528 L190:
15529  if (*ier > 2) {
15530  --(*ier);
15531  }
15532 L200:
15533  if (*integr == 2 && *omega < 0.f) {
15534  *result = -(*result);
15535  }
15536 L999:
15537  return;
15538 } /* qawoe_ */
15539 
15540 void qawo_(const E_fp& f, const sys_float *a, const sys_float *b,
15541  const sys_float *omega, const long *integr,
15542  const sys_float *epsabs, const sys_float *epsrel,
15543  sys_float *result, sys_float *abserr,
15544  long *neval, long *ier, const long *leniw, const long *maxp1,
15545  const long *lenw, long *last, long *iwork, sys_float *work)
15546 {
15547  long l1, l2, l3, l4, lvl;
15548  long limit, momcom;
15549 
15550  /* ***begin prologue qawo */
15551  /* ***date written 800101 (yymmdd) */
15552  /* ***revision date 830518 (yymmdd) */
15553  /* ***category no. h2a2a1 */
15554  /* ***keywords automatic integrator, special-purpose, */
15555  /* integrand with oscillatory cos or sin factor, */
15556  /* clenshaw-curtis method, (end point) singularities, */
15557  /* extrapolation, globally adaptive */
15558  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
15559  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
15560  /* ***purpose the routine calculates an approximation result to a given */
15561  /* definite integral */
15562  /* i = integral of f(x)*w(x) over (a,b) */
15563  /* where w(x) = cos(omega*x) or w(x) = sin(omega*x), */
15564  /* hopefully satisfying following claim for accuracy */
15565  /* fabs(i-result).le.max(epsabs,epsrel*fabs(i)). */
15566  /* ***description */
15567 
15568  /* computation of oscillatory integrals */
15569  /* standard fortran subroutine */
15570  /* sys_float version */
15571 
15572  /* parameters */
15573  /* on entry */
15574  /* f - sys_float */
15575  /* function subprogram defining the function */
15576  /* f(x). the actual name for f needs to be */
15577  /* declared e x t e r n a l in the driver program. */
15578 
15579  /* a - sys_float */
15580  /* lower limit of integration */
15581 
15582  /* b - sys_float */
15583  /* upper limit of integration */
15584 
15585  /* omega - sys_float */
15586  /* parameter in the integrand weight function */
15587 
15588  /* integr - long */
15589  /* indicates which of the weight functions is used */
15590  /* integr = 1 w(x) = cos(omega*x) */
15591  /* integr = 2 w(x) = sin(omega*x) */
15592  /* if integr.ne.1.and.integr.ne.2, the routine will */
15593  /* end with ier = 6. */
15594 
15595  /* epsabs - sys_float */
15596  /* absolute accuracy requested */
15597  /* epsrel - sys_float */
15598  /* relative accuracy requested */
15599  /* if epsabs.le.0 and */
15600  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
15601  /* the routine will end with ier = 6. */
15602 
15603  /* on return */
15604  /* result - sys_float */
15605  /* approximation to the integral */
15606 
15607  /* abserr - sys_float */
15608  /* estimate of the modulus of the absolute error, */
15609  /* which should equal or exceed fabs(i-result) */
15610 
15611  /* neval - long */
15612  /* number of integrand evaluations */
15613 
15614  /* ier - long */
15615  /* ier = 0 normal and reliable termination of the */
15616  /* routine. it is assumed that the requested */
15617  /* accuracy has been achieved. */
15618  /* - ier.gt.0 abnormal termination of the routine. */
15619  /* the estimates for integral and error are */
15620  /* less reliable. it is assumed that the */
15621  /* requested accuracy has not been achieved. */
15622  /* error messages */
15623  /* ier = 1 maximum number of subdivisions allowed */
15624  /* (= leniw/2) has been achieved. one can */
15625  /* allow more subdivisions by increasing the */
15626  /* value of leniw (and taking the according */
15627  /* dimension adjustments into account). */
15628  /* however, if this yields no improvement it */
15629  /* is advised to analyze the integrand in */
15630  /* order to determine the integration */
15631  /* difficulties. if the position of a local */
15632  /* difficulty can be determined (e.g. */
15633  /* singularity, discontinuity within the */
15634  /* interval) one will probably gain from */
15635  /* splitting up the interval at this polong */
15636  /* and calling the integrator on the */
15637  /* subranges. if possible, an appropriate */
15638  /* special-purpose integrator should be used */
15639  /* which is designed for handling the type of */
15640  /* difficulty involved. */
15641  /* = 2 the occurrence of roundoff error is */
15642  /* detected, which prevents the requested */
15643  /* tolerance from being achieved. */
15644  /* the error may be under-estimated. */
15645  /* = 3 extremely bad integrand behaviour occurs */
15646  /* at some interior points of the */
15647  /* integration interval. */
15648  /* = 4 the algorithm does not converge. */
15649  /* roundoff error is detected in the */
15650  /* extrapolation table. it is presumed that */
15651  /* the requested tolerance cannot be achieved */
15652  /* due to roundoff in the extrapolation */
15653  /* table, and that the returned result is */
15654  /* the best which can be obtained. */
15655  /* = 5 the integral is probably divergent, or */
15656  /* slowly convergent. it must be noted that */
15657  /* divergence can occur with any other value */
15658  /* of ier. */
15659  /* = 6 the input is invalid, because */
15660  /* (epsabs.le.0 and */
15661  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28)) */
15662  /* or (integr.ne.1 and integr.ne.2), */
15663  /* or leniw.lt.2 or maxp1.lt.1 or */
15664  /* lenw.lt.leniw*2+maxp1*25. */
15665  /* result, abserr, neval, last are set to */
15666  /* zero. except when leniw, maxp1 or lenw are */
15667  /* invalid, work(limit*2+1), work(limit*3+1), */
15668  /* iwork(1), iwork(limit+1) are set to zero, */
15669  /* work(1) is set to a and work(limit+1) to */
15670  /* b. */
15671 
15672  /* dimensioning parameters */
15673  /* leniw - long */
15674  /* dimensioning parameter for iwork. */
15675  /* leniw/2 equals the maximum number of subintervals */
15676  /* allowed in the partition of the given integration */
15677  /* interval (a,b), leniw.ge.2. */
15678  /* if leniw.lt.2, the routine will end with ier = 6. */
15679 
15680  /* maxp1 - long */
15681  /* gives an upper bound on the number of chebyshev */
15682  /* moments which can be stored, i.e. for the */
15683  /* intervals of lengths fabs(b-a)*2**(-l), */
15684  /* l=0,1, ..., maxp1-2, maxp1.ge.1 */
15685  /* if maxp1.lt.1, the routine will end with ier = 6. */
15686 
15687  /* lenw - long */
15688  /* dimensioning parameter for work */
15689  /* lenw must be at least leniw*2+maxp1*25. */
15690  /* if lenw.lt.(leniw*2+maxp1*25), the routine will */
15691  /* end with ier = 6. */
15692 
15693  /* last - long */
15694  /* on return, last equals the number of subintervals */
15695  /* produced in the subdivision process, which */
15696  /* determines the number of significant elements */
15697  /* actually in the work arrays. */
15698 
15699  /* work arrays */
15700  /* iwork - long */
15701  /* vector of dimension at least leniw */
15702  /* on return, the first k elements of which contain */
15703  /* pointers to the error estimates over the */
15704  /* subintervals, such that work(limit*3+iwork(1)), .. */
15705  /* work(limit*3+iwork(k)) form a decreasing */
15706  /* sequence, with limit = lenw/2 , and k = last */
15707  /* if last.le.(limit/2+2), and k = limit+1-last */
15708  /* otherwise. */
15709  /* furthermore, iwork(limit+1), ..., iwork(limit+ */
15710  /* last) indicate the subdivision levels of the */
15711  /* subintervals, such that iwork(limit+i) = l means */
15712  /* that the subinterval numbered i is of length */
15713  /* fabs(b-a)*2**(1-l). */
15714 
15715  /* work - sys_float */
15716  /* vector of dimension at least lenw */
15717  /* on return */
15718  /* work(1), ..., work(last) contain the left */
15719  /* end points of the subintervals in the */
15720  /* partition of (a,b), */
15721  /* work(limit+1), ..., work(limit+last) contain */
15722  /* the right end points, */
15723  /* work(limit*2+1), ..., work(limit*2+last) contain */
15724  /* the integral approximations over the */
15725  /* subintervals, */
15726  /* work(limit*3+1), ..., work(limit*3+last) */
15727  /* contain the error estimates. */
15728  /* work(limit*4+1), ..., work(limit*4+maxp1*25) */
15729  /* provide space for storing the chebyshev moments. */
15730  /* note that limit = lenw/2. */
15731 
15732  /* ***references (none) */
15733  /* ***routines called qawoe,xerror */
15734  /* ***end prologue qawo */
15735 
15736 
15737 
15738 
15739  /* check validity of leniw, maxp1 and lenw. */
15740 
15741  /* ***first executable statement qawo */
15742  /* Parameter adjustments */
15743  --iwork;
15744  --work;
15745 
15746  /* Function Body */
15747  *ier = 6;
15748  *neval = 0;
15749  *last = 0;
15750  *result = 0.f;
15751  *abserr = 0.f;
15752  if (*leniw < 2 || *maxp1 < 1 || *lenw < (*leniw << 1) + *maxp1 * 25) {
15753  goto L10;
15754  }
15755 
15756  /* prepare call for qawoe */
15757 
15758  limit = *leniw / 2;
15759  l1 = limit + 1;
15760  l2 = limit + l1;
15761  l3 = limit + l2;
15762  l4 = limit + l3;
15763  qawoe_(f, a, b, omega, integr, epsabs, epsrel, &limit, &c__1, maxp1,
15764  result, abserr, neval, ier, last, &work[1], &work[l1], &work[l2],
15765  &work[l3], &iwork[1], &iwork[l1], &momcom, &work[l4]);
15766 
15767  /* call error handler if necessary */
15768 
15769  lvl = 0;
15770 L10:
15771  if (*ier == 6) {
15772  lvl = 1;
15773  }
15774  if (*ier != 0) {
15775  xerror_("abnormal return from qawo", &c__26, ier, &lvl, 26);
15776  }
15777  return;
15778 } /* qawo_ */
15779 
15780 void qawse_(const E_fp& f, const sys_float *a, const sys_float *b,
15781  const sys_float *alfa, const sys_float *beta,
15782  const long *integr, const sys_float *epsabs,
15783  const sys_float *epsrel, const long *limit, sys_float *result,
15784  sys_float *abserr, long *neval, long *ier, sys_float *alist__,
15785  sys_float *blist, sys_float *rlist, sys_float *elist, long *iord, long *last)
15786 {
15787  /* System generated locals */
15788  int i__1;
15789  sys_float r__1, r__2;
15790 
15791  /* Local variables */
15792  long k;
15793  sys_float a1, a2, b1, b2, rg[25], rh[25], ri[25], rj[25];
15794  long nev;
15795  sys_float area;
15796  sys_float area1, area2, area12, erro12;
15797  long nrmax;
15798  sys_float uflow;
15799  long iroff1, iroff2;
15800  sys_float resas1, resas2, error1, error2, epmach, errbnd, centre,
15801  errmax;
15802  long maxerr;
15803  sys_float errsum;
15804 
15805  /* ***begin prologue qawse */
15806  /* ***date written 800101 (yymmdd) */
15807  /* ***revision date 830518 (yymmdd) */
15808  /* ***category no. h2a2a1 */
15809  /* ***keywords automatic integrator, special-purpose, */
15810  /* algebraico-logarithmic end point singularities, */
15811  /* clenshaw-curtis method */
15812  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
15813  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
15814  /* ***purpose the routine calculates an approximation result to a given */
15815  /* definite integral i = integral of f*w over (a,b), */
15816  /* (where w shows a singular behaviour at the end points, */
15817  /* see parameter integr). */
15818  /* hopefully satisfying following claim for accuracy */
15819  /* fabs(i-result).le.max(epsabs,epsrel*fabs(i)). */
15820  /* ***description */
15821 
15822  /* integration of functions having algebraico-logarithmic */
15823  /* end point singularities */
15824  /* standard fortran subroutine */
15825  /* sys_float version */
15826 
15827  /* parameters */
15828  /* on entry */
15829  /* f - sys_float */
15830  /* function subprogram defining the integrand */
15831  /* function f(x). the actual name for f needs to be */
15832  /* declared e x t e r n a l in the driver program. */
15833 
15834  /* a - sys_float */
15835  /* lower limit of integration */
15836 
15837  /* b - sys_float */
15838  /* upper limit of integration, b.gt.a */
15839  /* if b.le.a, the routine will end with ier = 6. */
15840 
15841  /* alfa - sys_float */
15842  /* parameter in the weight function, alfa.gt.(-1) */
15843  /* if alfa.le.(-1), the routine will end with */
15844  /* ier = 6. */
15845 
15846  /* beta - sys_float */
15847  /* parameter in the weight function, beta.gt.(-1) */
15848  /* if beta.le.(-1), the routine will end with */
15849  /* ier = 6. */
15850 
15851  /* integr - long */
15852  /* indicates which weight function is to be used */
15853  /* = 1 (x-a)**alfa*(b-x)**beta */
15854  /* = 2 (x-a)**alfa*(b-x)**beta*log(x-a) */
15855  /* = 3 (x-a)**alfa*(b-x)**beta*log(b-x) */
15856  /* = 4 (x-a)**alfa*(b-x)**beta*log(x-a)*log(b-x) */
15857  /* if integr.lt.1 or integr.gt.4, the routine */
15858  /* will end with ier = 6. */
15859 
15860  /* epsabs - sys_float */
15861  /* absolute accuracy requested */
15862  /* epsrel - sys_float */
15863  /* relative accuracy requested */
15864  /* if epsabs.le.0 */
15865  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
15866  /* the routine will end with ier = 6. */
15867 
15868  /* limit - long */
15869  /* gives an upper bound on the number of subintervals */
15870  /* in the partition of (a,b), limit.ge.2 */
15871  /* if limit.lt.2, the routine will end with ier = 6. */
15872 
15873  /* on return */
15874  /* result - sys_float */
15875  /* approximation to the integral */
15876 
15877  /* abserr - sys_float */
15878  /* estimate of the modulus of the absolute error, */
15879  /* which should equal or exceed fabs(i-result) */
15880 
15881  /* neval - long */
15882  /* number of integrand evaluations */
15883 
15884  /* ier - long */
15885  /* ier = 0 normal and reliable termination of the */
15886  /* routine. it is assumed that the requested */
15887  /* accuracy has been achieved. */
15888  /* ier.gt.0 abnormal termination of the routine */
15889  /* the estimates for the integral and error */
15890  /* are less reliable. it is assumed that the */
15891  /* requested accuracy has not been achieved. */
15892  /* error messages */
15893  /* = 1 maximum number of subdivisions allowed */
15894  /* has been achieved. one can allow more */
15895  /* subdivisions by increasing the value of */
15896  /* limit. however, if this yields no */
15897  /* improvement, it is advised to analyze the */
15898  /* integrand in order to determine the */
15899  /* integration difficulties which prevent the */
15900  /* requested tolerance from being achieved. */
15901  /* in case of a jump discontinuity or a local */
15902  /* singularity of algebraico-logarithmic type */
15903  /* at one or more interior points of the */
15904  /* integration range, one should proceed by */
15905  /* splitting up the interval at these */
15906  /* points and calling the integrator on the */
15907  /* subranges. */
15908  /* = 2 the occurrence of roundoff error is */
15909  /* detected, which prevents the requested */
15910  /* tolerance from being achieved. */
15911  /* = 3 extremely bad integrand behaviour occurs */
15912  /* at some points of the integration */
15913  /* interval. */
15914  /* = 6 the input is invalid, because */
15915  /* b.le.a or alfa.le.(-1) or beta.le.(-1), or */
15916  /* integr.lt.1 or integr.gt.4, or */
15917  /* (epsabs.le.0 and */
15918  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
15919  /* or limit.lt.2. */
15920  /* result, abserr, neval, rlist(1), elist(1), */
15921  /* iord(1) and last are set to zero. alist(1) */
15922  /* and blist(1) are set to a and b */
15923  /* respectively. */
15924 
15925  /* alist - sys_float */
15926  /* vector of dimension at least limit, the first */
15927  /* last elements of which are the left */
15928  /* end points of the subintervals in the partition */
15929  /* of the given integration range (a,b) */
15930 
15931  /* blist - sys_float */
15932  /* vector of dimension at least limit, the first */
15933  /* last elements of which are the right */
15934  /* end points of the subintervals in the partition */
15935  /* of the given integration range (a,b) */
15936 
15937  /* rlist - sys_float */
15938  /* vector of dimension at least limit,the first */
15939  /* last elements of which are the integral */
15940  /* approximations on the subintervals */
15941 
15942  /* elist - sys_float */
15943  /* vector of dimension at least limit, the first */
15944  /* last elements of which are the moduli of the */
15945  /* absolute error estimates on the subintervals */
15946 
15947  /* iord - long */
15948  /* vector of dimension at least limit, the first k */
15949  /* of which are pointers to the error */
15950  /* estimates over the subintervals, so that */
15951  /* elist(iord(1)), ..., elist(iord(k)) with k = last */
15952  /* if last.le.(limit/2+2), and k = limit+1-last */
15953  /* otherwise form a decreasing sequence */
15954 
15955  /* last - long */
15956  /* number of subintervals actually produced in */
15957  /* the subdivision process */
15958 
15959  /* ***references (none) */
15960  /* ***routines called qc25s,qmomo,qpsrt,r1mach */
15961  /* ***end prologue qawse */
15962 
15963 
15964 
15965 
15966  /* list of major variables */
15967  /* ----------------------- */
15968 
15969  /* alist - list of left end points of all subintervals */
15970  /* considered up to now */
15971  /* blist - list of right end points of all subintervals */
15972  /* considered up to now */
15973  /* rlist(i) - approximation to the integral over */
15974  /* (alist(i),blist(i)) */
15975  /* elist(i) - error estimate applying to rlist(i) */
15976  /* maxerr - pointer to the interval with largest */
15977  /* error estimate */
15978  /* errmax - elist(maxerr) */
15979  /* area - sum of the integrals over the subintervals */
15980  /* errsum - sum of the errors over the subintervals */
15981  /* errbnd - requested accuracy max(epsabs,epsrel* */
15982  /* fabs(result)) */
15983  /* *****1 - variable for the left subinterval */
15984  /* *****2 - variable for the right subinterval */
15985  /* last - index for subdivision */
15986 
15987 
15988  /* machine dependent constants */
15989  /* --------------------------- */
15990 
15991  /* epmach is the largest relative spacing. */
15992  /* uflow is the smallest positive magnitude. */
15993 
15994  /* ***first executable statement qawse */
15995  /* Parameter adjustments */
15996  --iord;
15997  --elist;
15998  --rlist;
15999  --blist;
16000  --alist__;
16001 
16002  /* Function Body */
16003  epmach = r1mach(c__4);
16004  uflow = r1mach(c__1);
16005 
16006  /* test on validity of parameters */
16007  /* ------------------------------ */
16008 
16009  *ier = 6;
16010  *neval = 0;
16011  *last = 0;
16012  rlist[1] = 0.f;
16013  elist[1] = 0.f;
16014  iord[1] = 0;
16015  *result = 0.f;
16016  *abserr = 0.f;
16017  /* Computing MAX */
16018  r__1 = epmach * 50.f;
16019  if (*b <= *a || ( *epsabs == 0.f && *epsrel < max(r__1,5e-15f)) || *alfa <=
16020  -1.f || *beta <= -1.f || *integr < 1 || *integr > 4 || *limit < 2)
16021  {
16022  goto L999;
16023  }
16024  *ier = 0;
16025 
16026  /* compute the modified chebyshev moments. */
16027 
16028  qmomo_(alfa, beta, ri, rj, rg, rh, integr);
16029 
16030  /* integrate over the intervals (a,(a+b)/2) */
16031  /* and ((a+b)/2,b). */
16032 
16033  centre = (*b + *a) * .5f;
16034  qc25s_(f, a, b, a, &centre, alfa, beta, ri, rj, rg, rh, &area1, &
16035  error1, &resas1, integr, &nev);
16036  *neval = nev;
16037  qc25s_(f, a, b, &centre, b, alfa, beta, ri, rj, rg, rh, &area2, &
16038  error2, &resas2, integr, &nev);
16039  *last = 2;
16040  *neval += nev;
16041  *result = area1 + area2;
16042  *abserr = error1 + error2;
16043 
16044  /* test on accuracy. */
16045 
16046  /* Computing MAX */
16047  r__1 = *epsabs, r__2 = *epsrel * fabs(*result);
16048  errbnd = max(r__1,r__2);
16049 
16050  /* initialization */
16051  /* -------------- */
16052 
16053  if (error2 > error1) {
16054  goto L10;
16055  }
16056  alist__[1] = *a;
16057  alist__[2] = centre;
16058  blist[1] = centre;
16059  blist[2] = *b;
16060  rlist[1] = area1;
16061  rlist[2] = area2;
16062  elist[1] = error1;
16063  elist[2] = error2;
16064  goto L20;
16065 L10:
16066  alist__[1] = centre;
16067  alist__[2] = *a;
16068  blist[1] = *b;
16069  blist[2] = centre;
16070  rlist[1] = area2;
16071  rlist[2] = area1;
16072  elist[1] = error2;
16073  elist[2] = error1;
16074 L20:
16075  iord[1] = 1;
16076  iord[2] = 2;
16077  if (*limit == 2) {
16078  *ier = 1;
16079  }
16080  if (*abserr <= errbnd || *ier == 1) {
16081  goto L999;
16082  }
16083  errmax = elist[1];
16084  maxerr = 1;
16085  nrmax = 1;
16086  area = *result;
16087  errsum = *abserr;
16088  iroff1 = 0;
16089  iroff2 = 0;
16090 
16091  /* main do-loop */
16092  /* ------------ */
16093 
16094  i__1 = *limit;
16095  for (*last = 3; *last <= i__1; ++(*last)) {
16096 
16097  /* bisect the subinterval with largest error estimate. */
16098 
16099  a1 = alist__[maxerr];
16100  b1 = (alist__[maxerr] + blist[maxerr]) * .5f;
16101  a2 = b1;
16102  b2 = blist[maxerr];
16103 
16104  qc25s_(f, a, b, &a1, &b1, alfa, beta, ri, rj, rg, rh, &area1, &
16105  error1, &resas1, integr, &nev);
16106  *neval += nev;
16107  qc25s_(f, a, b, &a2, &b2, alfa, beta, ri, rj, rg, rh, &area2, &
16108  error2, &resas2, integr, &nev);
16109  *neval += nev;
16110 
16111  /* improve previous approximations integral and error */
16112  /* and test for accuracy. */
16113 
16114  area12 = area1 + area2;
16115  erro12 = error1 + error2;
16116  errsum = errsum + erro12 - errmax;
16117  area = area + area12 - rlist[maxerr];
16118  if (*a == a1 || *b == b2) {
16119  goto L30;
16120  }
16121  if (resas1 == error1 || resas2 == error2) {
16122  goto L30;
16123  }
16124 
16125  /* test for roundoff error. */
16126 
16127  if ((r__1 = rlist[maxerr] - area12, fabs(r__1)) < fabs(area12) *
16128  1e-5f && erro12 >= errmax * .99f) {
16129  ++iroff1;
16130  }
16131  if (*last > 10 && erro12 > errmax) {
16132  ++iroff2;
16133  }
16134  L30:
16135  rlist[maxerr] = area1;
16136  rlist[*last] = area2;
16137 
16138  /* test on accuracy. */
16139 
16140  /* Computing MAX */
16141  r__1 = *epsabs, r__2 = *epsrel * fabs(area);
16142  errbnd = max(r__1,r__2);
16143  if (errsum <= errbnd) {
16144  goto L35;
16145  }
16146 
16147  /* set error flag in the case that the number of interval */
16148  /* bisections exceeds limit. */
16149 
16150  if (*last == *limit) {
16151  *ier = 1;
16152  }
16153 
16154 
16155  /* set error flag in the case of roundoff error. */
16156 
16157  if (iroff1 >= 6 || iroff2 >= 20) {
16158  *ier = 2;
16159  }
16160 
16161  /* set error flag in the case of bad integrand behaviour */
16162  /* at interior points of integration range. */
16163 
16164  /* Computing MAX */
16165  r__1 = fabs(a1), r__2 = fabs(b2);
16166  if (max(r__1,r__2) <= (epmach * 100.f + 1.f) * (fabs(a2) + uflow *
16167  1e3f)) {
16168  *ier = 3;
16169  }
16170 
16171  /* append the newly-created intervals to the list. */
16172 
16173  L35:
16174  if (error2 > error1) {
16175  goto L40;
16176  }
16177  alist__[*last] = a2;
16178  blist[maxerr] = b1;
16179  blist[*last] = b2;
16180  elist[maxerr] = error1;
16181  elist[*last] = error2;
16182  goto L50;
16183  L40:
16184  alist__[maxerr] = a2;
16185  alist__[*last] = a1;
16186  blist[*last] = b1;
16187  rlist[maxerr] = area2;
16188  rlist[*last] = area1;
16189  elist[maxerr] = error2;
16190  elist[*last] = error1;
16191 
16192  /* call subroutine qpsrt to maintain the descending ordering */
16193  /* in the list of error estimates and select the */
16194  /* subinterval with largest error estimate (to be */
16195  /* bisected next). */
16196 
16197  L50:
16198  qpsrt_(limit, last, &maxerr, &errmax, &elist[1], &iord[1], &nrmax);
16199  /* ***jump out of do-loop */
16200  if (*ier != 0 || errsum <= errbnd) {
16201  goto L70;
16202  }
16203  /* L60: */
16204  }
16205 
16206  /* compute final result. */
16207  /* --------------------- */
16208 
16209 L70:
16210  *result = 0.f;
16211  i__1 = *last;
16212  for (k = 1; k <= i__1; ++k) {
16213  *result += rlist[k];
16214  /* L80: */
16215  }
16216  *abserr = errsum;
16217 L999:
16218  return;
16219 } /* qawse_ */
16220 
16221 void qaws_(const E_fp& f, const sys_float *a, const sys_float *b,
16222  const sys_float *alfa, const sys_float *beta,
16223  const long *integr, const sys_float *epsabs,
16224  const sys_float *epsrel, sys_float *result, sys_float *abserr,
16225  long *neval, long *ier, const long *limit, const long *lenw,
16226  long *last, long *iwork, sys_float *work)
16227 {
16228  long l1, l2, l3, lvl;
16229 
16230  /* ***begin prologue qaws */
16231  /* ***date written 800101 (yymmdd) */
16232  /* ***revision date 830518 (yymmdd) */
16233  /* ***category no. h2a2a1 */
16234  /* ***keywords automatic integrator, special-purpose, */
16235  /* algebraico-logarithmic end-point singularities, */
16236  /* clenshaw-curtis, globally adaptive */
16237  /* ***author piessens,robert,appl. math. & progr. div. -k.u.leuven */
16238  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
16239  /* ***purpose the routine calculates an approximation result to a given */
16240  /* definite integral i = integral of f*w over (a,b), */
16241  /* (where w shows a singular behaviour at the end points */
16242  /* see parameter integr). */
16243  /* hopefully satisfying following claim for accuracy */
16244  /* fabs(i-result).le.max(epsabs,epsrel*fabs(i)). */
16245  /* ***description */
16246 
16247  /* integration of functions having algebraico-logarithmic */
16248  /* end point singularities */
16249  /* standard fortran subroutine */
16250  /* sys_float version */
16251 
16252  /* parameters */
16253  /* on entry */
16254  /* f - sys_float */
16255  /* function subprogram defining the integrand */
16256  /* function f(x). the actual name for f needs to be */
16257  /* declared e x t e r n a l in the driver program. */
16258 
16259  /* a - sys_float */
16260  /* lower limit of integration */
16261 
16262  /* b - sys_float */
16263  /* upper limit of integration, b.gt.a */
16264  /* if b.le.a, the routine will end with ier = 6. */
16265 
16266  /* alfa - sys_float */
16267  /* parameter in the integrand function, alfa.gt.(-1) */
16268  /* if alfa.le.(-1), the routine will end with */
16269  /* ier = 6. */
16270 
16271  /* beta - sys_float */
16272  /* parameter in the integrand function, beta.gt.(-1) */
16273  /* if beta.le.(-1), the routine will end with */
16274  /* ier = 6. */
16275 
16276  /* integr - long */
16277  /* indicates which weight function is to be used */
16278  /* = 1 (x-a)**alfa*(b-x)**beta */
16279  /* = 2 (x-a)**alfa*(b-x)**beta*log(x-a) */
16280  /* = 3 (x-a)**alfa*(b-x)**beta*log(b-x) */
16281  /* = 4 (x-a)**alfa*(b-x)**beta*log(x-a)*log(b-x) */
16282  /* if integr.lt.1 or integr.gt.4, the routine */
16283  /* will end with ier = 6. */
16284 
16285  /* epsabs - sys_float */
16286  /* absolute accuracy requested */
16287  /* epsrel - sys_float */
16288  /* relative accuracy requested */
16289  /* if epsabs.le.0 */
16290  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
16291  /* the routine will end with ier = 6. */
16292 
16293  /* on return */
16294  /* result - sys_float */
16295  /* approximation to the integral */
16296 
16297  /* abserr - sys_float */
16298  /* estimate of the modulus of the absolute error, */
16299  /* which should equal or exceed fabs(i-result) */
16300 
16301  /* neval - long */
16302  /* number of integrand evaluations */
16303 
16304  /* ier - long */
16305  /* ier = 0 normal and reliable termination of the */
16306  /* routine. it is assumed that the requested */
16307  /* accuracy has been achieved. */
16308  /* ier.gt.0 abnormal termination of the routine */
16309  /* the estimates for the integral and error */
16310  /* are less reliable. it is assumed that the */
16311  /* requested accuracy has not been achieved. */
16312  /* error messages */
16313  /* ier = 1 maximum number of subdivisions allowed */
16314  /* has been achieved. one can allow more */
16315  /* subdivisions by increasing the value of */
16316  /* limit (and taking the according dimension */
16317  /* adjustments into account). however, if */
16318  /* this yields no improvement it is advised */
16319  /* to analyze the integrand, in order to */
16320  /* determine the integration difficulties */
16321  /* which prevent the requested tolerance from */
16322  /* being achieved. in case of a jump */
16323  /* discontinuity or a local singularity */
16324  /* of algebraico-logarithmic type at one or */
16325  /* more interior points of the integration */
16326  /* range, one should proceed by splitting up */
16327  /* the interval at these points and calling */
16328  /* the integrator on the subranges. */
16329  /* = 2 the occurrence of roundoff error is */
16330  /* detected, which prevents the requested */
16331  /* tolerance from being achieved. */
16332  /* = 3 extremely bad integrand behaviour occurs */
16333  /* at some points of the integration */
16334  /* interval. */
16335  /* = 6 the input is invalid, because */
16336  /* b.le.a or alfa.le.(-1) or beta.le.(-1) or */
16337  /* or integr.lt.1 or integr.gt.4 or */
16338  /* (epsabs.le.0 and */
16339  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28)) */
16340  /* or limit.lt.2 or lenw.lt.limit*4. */
16341  /* result, abserr, neval, last are set to */
16342  /* zero. except when lenw or limit is invalid */
16343  /* iwork(1), work(limit*2+1) and */
16344  /* work(limit*3+1) are set to zero, work(1) */
16345  /* is set to a and work(limit+1) to b. */
16346 
16347  /* dimensioning parameters */
16348  /* limit - long */
16349  /* dimensioning parameter for iwork */
16350  /* limit determines the maximum number of */
16351  /* subintervals in the partition of the given */
16352  /* integration interval (a,b), limit.ge.2. */
16353  /* if limit.lt.2, the routine will end with ier = 6. */
16354 
16355  /* lenw - long */
16356  /* dimensioning parameter for work */
16357  /* lenw must be at least limit*4. */
16358  /* if lenw.lt.limit*4, the routine will end */
16359  /* with ier = 6. */
16360 
16361  /* last - long */
16362  /* on return, last equals the number of */
16363  /* subintervals produced in the subdivision process, */
16364  /* which determines the significant number of */
16365  /* elements actually in the work arrays. */
16366 
16367  /* work arrays */
16368  /* iwork - long */
16369  /* vector of dimension limit, the first k */
16370  /* elements of which contain pointers */
16371  /* to the error estimates over the subintervals, */
16372  /* such that work(limit*3+iwork(1)), ..., */
16373  /* work(limit*3+iwork(k)) form a decreasing */
16374  /* sequence with k = last if last.le.(limit/2+2), */
16375  /* and k = limit+1-last otherwise */
16376 
16377  /* work - sys_float */
16378  /* vector of dimension lenw */
16379  /* on return */
16380  /* work(1), ..., work(last) contain the left */
16381  /* end points of the subintervals in the */
16382  /* partition of (a,b), */
16383  /* work(limit+1), ..., work(limit+last) contain */
16384  /* the right end points, */
16385  /* work(limit*2+1), ..., work(limit*2+last) */
16386  /* contain the integral approximations over */
16387  /* the subintervals, */
16388  /* work(limit*3+1), ..., work(limit*3+last) */
16389  /* contain the error estimates. */
16390 
16391  /* ***references (none) */
16392  /* ***routines called qawse,xerror */
16393  /* ***end prologue qaws */
16394 
16395 
16396 
16397 
16398  /* check validity of limit and lenw. */
16399 
16400  /* ***first executable statement qaws */
16401  /* Parameter adjustments */
16402  --iwork;
16403  --work;
16404 
16405  /* Function Body */
16406  *ier = 6;
16407  *neval = 0;
16408  *last = 0;
16409  *result = 0.f;
16410  *abserr = 0.f;
16411  if (*limit < 2 || *lenw < *limit << 2) {
16412  goto L10;
16413  }
16414 
16415  /* prepare call for qawse. */
16416 
16417  l1 = *limit + 1;
16418  l2 = *limit + l1;
16419  l3 = *limit + l2;
16420 
16421  qawse_(f, a, b, alfa, beta, integr, epsabs, epsrel, limit, result,
16422  abserr, neval, ier, &work[1], &work[l1], &work[l2], &work[l3], &
16423  iwork[1], last);
16424 
16425  /* call error handler if necessary. */
16426 
16427  lvl = 0;
16428 L10:
16429  if (*ier == 6) {
16430  lvl = 1;
16431  }
16432  if (*ier != 0) {
16433  xerror_("abnormal return from qaws", &c__26, ier, &lvl, 26);
16434  }
16435  return;
16436 } /* qaws_ */
16437 
16438 void qc25c_(const E_fp& f, const sys_float *a, const sys_float *b,
16439  const sys_float *c__, sys_float *result,
16440  sys_float *abserr, long *krul, long *neval)
16441 {
16442  /* Initialized data */
16443 
16444  sys_float x[11] = { .9914448613738104f,.9659258262890683f,
16445  .9238795325112868f,.8660254037844386f,.7933533402912352f,
16446  .7071067811865475f,.6087614290087206f,.5f,.3826834323650898f,
16447  .2588190451025208f,.1305261922200516f };
16448 
16449  /* System generated locals */
16450  sys_float r__1;
16451 
16452  /* Local variables */
16453  long i__, k;
16454  sys_float u, p2, p3, p4, cc;
16455  long kp;
16456  sys_float ak22, fval[25], res12, res24;
16457  long isym;
16458  sys_float amom0, amom1, amom2, cheb12[13], cheb24[25];
16459  sys_float hlgth, centr;
16460  sys_float resabs, resasc;
16461 
16462  /* ***begin prologue qc25c */
16463  /* ***date written 810101 (yymmdd) */
16464  /* ***revision date 830518 (yymmdd) */
16465  /* ***category no. h2a2a2,j4 */
16466  /* ***keywords 25-point clenshaw-curtis integration */
16467  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
16468  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
16469  /* ***purpose to compute i = integral of f*w over (a,b) with */
16470  /* error estimate, where w(x) = 1/(x-c) */
16471  /* ***description */
16472 
16473  /* integration rules for the computation of cauchy */
16474  /* principal value integrals */
16475  /* standard fortran subroutine */
16476  /* sys_float version */
16477 
16478  /* parameters */
16479  /* f - sys_float */
16480  /* function subprogram defining the integrand function */
16481  /* f(x). the actual name for f needs to be declared */
16482  /* e x t e r n a l in the driver program. */
16483 
16484  /* a - sys_float */
16485  /* left end point of the integration interval */
16486 
16487  /* b - sys_float */
16488  /* right end point of the integration interval, b.gt.a */
16489 
16490  /* c - sys_float */
16491  /* parameter in the weight function */
16492 
16493  /* result - sys_float */
16494  /* approximation to the integral */
16495  /* result is computed by using a generalized */
16496  /* clenshaw-curtis method if c lies within ten percent */
16497  /* of the integration interval. in the other case the */
16498  /* 15-point kronrod rule obtained by optimal addition */
16499  /* of abscissae to the 7-point gauss rule, is applied. */
16500 
16501  /* abserr - sys_float */
16502  /* estimate of the modulus of the absolute error, */
16503  /* which should equal or exceed fabs(i-result) */
16504 
16505  /* krul - long */
16506  /* key which is decreased by 1 if the 15-polong */
16507  /* gauss-kronrod scheme has been used */
16508 
16509  /* neval - long */
16510  /* number of integrand evaluations */
16511 
16512  /* ***references (none) */
16513  /* ***routines called qcheb,qk15w,qwgtc */
16514  /* ***end prologue qc25c */
16515 
16516 
16517 
16518 
16519  /* the vector x contains the values cos(k*pi/24), */
16520  /* k = 1, ..., 11, to be used for the chebyshev series */
16521  /* expansion of f */
16522 
16523 
16524  /* list of major variables */
16525  /* ---------------------- */
16526  /* fval - value of the function f at the points */
16527  /* cos(k*pi/24), k = 0, ..., 24 */
16528  /* cheb12 - chebyshev series expansion coefficients, */
16529  /* for the function f, of degree 12 */
16530  /* cheb24 - chebyshev series expansion coefficients, */
16531  /* for the function f, of degree 24 */
16532  /* res12 - approximation to the integral corresponding */
16533  /* to the use of cheb12 */
16534  /* res24 - approximation to the integral corresponding */
16535  /* to the use of cheb24 */
16536  /* qwgtc - external function subprogram defining */
16537  /* the weight function */
16538  /* hlgth - half-length of the interval */
16539  /* centr - mid point of the interval */
16540 
16541 
16542  /* check the position of c. */
16543 
16544  /* ***first executable statement qc25c */
16545  cc = (2.f * *c__ - *b - *a) / (*b - *a);
16546  if (fabs(cc) < 1.1f) {
16547  goto L10;
16548  }
16549 
16550  /* apply the 15-point gauss-kronrod scheme. */
16551 
16552  --(*krul);
16553  qk15w_(f, qwgtc_, c__, &p2, &p3, &p4, &kp, a, b, result,
16554  abserr, &resabs, &resasc);
16555  *neval = 15;
16556  if (resasc == *abserr) {
16557  ++(*krul);
16558  }
16559  goto L50;
16560 
16561  /* use the generalized clenshaw-curtis method. */
16562 
16563 L10:
16564  hlgth = (*b - *a) * .5f;
16565  centr = (*b + *a) * .5f;
16566  *neval = 25;
16567  r__1 = hlgth + centr;
16568  fval[0] = f(r__1) * .5f;
16569  fval[12] = f(centr);
16570  r__1 = centr - hlgth;
16571  fval[24] = f(r__1) * .5f;
16572  for (i__ = 2; i__ <= 12; ++i__) {
16573  u = hlgth * x[i__ - 2];
16574  isym = 26 - i__;
16575  r__1 = u + centr;
16576  fval[i__ - 1] = f(r__1);
16577  r__1 = centr - u;
16578  fval[isym - 1] = f(r__1);
16579  /* L20: */
16580  }
16581 
16582  /* compute the chebyshev series expansion. */
16583 
16584  qcheb_(x, fval, cheb12, cheb24);
16585 
16586  /* the modified chebyshev moments are computed */
16587  /* by forward recursion, using amom0 and amom1 */
16588  /* as starting values. */
16589 
16590  amom0 = log((r__1 = (1.f - cc) / (cc + 1.f), fabs(r__1)));
16591  amom1 = cc * amom0 + 2.f;
16592  res12 = cheb12[0] * amom0 + cheb12[1] * amom1;
16593  res24 = cheb24[0] * amom0 + cheb24[1] * amom1;
16594  for (k = 3; k <= 13; ++k) {
16595  amom2 = cc * 2.f * amom1 - amom0;
16596  ak22 = (sys_float) ((k - 2) * (k - 2));
16597  if (k / 2 << 1 == k) {
16598  amom2 -= 4.f / (ak22 - 1.f);
16599  }
16600  res12 += cheb12[k - 1] * amom2;
16601  res24 += cheb24[k - 1] * amom2;
16602  amom0 = amom1;
16603  amom1 = amom2;
16604  /* L30: */
16605  }
16606  for (k = 14; k <= 25; ++k) {
16607  amom2 = cc * 2.f * amom1 - amom0;
16608  ak22 = (sys_float) ((k - 2) * (k - 2));
16609  if (k / 2 << 1 == k) {
16610  amom2 -= 4.f / (ak22 - 1.f);
16611  }
16612  res24 += cheb24[k - 1] * amom2;
16613  amom0 = amom1;
16614  amom1 = amom2;
16615  /* L40: */
16616  }
16617  *result = res24;
16618  *abserr = (r__1 = res24 - res12, fabs(r__1));
16619 L50:
16620  return;
16621 } /* qc25c_ */
16622 
16623 void qc25f_(const E_fp& f, const sys_float *a, const sys_float *b,
16624  const sys_float *omega, const long *integr,
16625  const long *nrmom, const long *maxp1, const long *ksave,
16626  sys_float *result,
16627  sys_float *abserr, long *neval, sys_float *resabs, sys_float *resasc, long *
16628  momcom, sys_float *chebmo)
16629 {
16630  /* Initialized data */
16631 
16632  sys_float x[11] = { .9914448613738104f,.9659258262890683f,
16633  .9238795325112868f,.8660254037844386f,.7933533402912352f,
16634  .7071067811865475f,.6087614290087206f,.5f,.3826834323650898f,
16635  .2588190451025208f,.1305261922200516f };
16636 
16637  /* System generated locals */
16638  int chebmo_dim1, chebmo_offset, i__1;
16639  sys_float r__1, r__2;
16640 
16641  /* Local variables */
16642  sys_float d__[25];
16643  long i__, j, k, m=0;
16644  sys_float v[28], d1[25], d2[25], p2, p3, p4, ac, an, as, an2, ass, par2,
16645  conc, asap, par22, fval[25], estc, cons;
16646  long iers;
16647  sys_float ests;
16648  long isym, noeq1;
16649  sys_float cheb12[13], cheb24[25];
16650  sys_float resc12, resc24, hlgth, centr, ress12, ress24, oflow;
16651  long noequ;
16652  sys_float cospar, sinpar, parint;
16653 
16654  /* ***begin prologue qc25f */
16655  /* ***date written 810101 (yymmdd) */
16656  /* ***revision date 830518 (yymmdd) */
16657  /* ***category no. h2a2a2 */
16658  /* ***keywords integration rules for functions with cos or sin */
16659  /* factor, clenshaw-curtis, gauss-kronrod */
16660  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
16661  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
16662  /* ***purpose to compute the integral i=integral of f(x) over (a,b) */
16663  /* where w(x) = cos(omega*x) or (wx)=sin(omega*x) */
16664  /* and to compute j=integral of fabs(f) over (a,b). for small */
16665  /* value of omega or small intervals (a,b) 15-point gauss- */
16666  /* kronrod rule used. otherwise generalized clenshaw-curtis us */
16667  /* ***description */
16668 
16669  /* integration rules for functions with cos or sin factor */
16670  /* standard fortran subroutine */
16671  /* sys_float version */
16672 
16673  /* parameters */
16674  /* on entry */
16675  /* f - sys_float */
16676  /* function subprogram defining the integrand */
16677  /* function f(x). the actual name for f needs to */
16678  /* be declared e x t e r n a l in the calling program. */
16679 
16680  /* a - sys_float */
16681  /* lower limit of integration */
16682 
16683  /* b - sys_float */
16684  /* upper limit of integration */
16685 
16686  /* omega - sys_float */
16687  /* parameter in the weight function */
16688 
16689  /* integr - long */
16690  /* indicates which weight function is to be used */
16691  /* integr = 1 w(x) = cos(omega*x) */
16692  /* integr = 2 w(x) = sin(omega*x) */
16693 
16694  /* nrmom - long */
16695  /* the length of interval (a,b) is equal to the length */
16696  /* of the original integration interval divided by */
16697  /* 2**nrmom (we suppose that the routine is used in an */
16698  /* adaptive integration process, otherwise set */
16699  /* nrmom = 0). nrmom must be zero at the first call. */
16700 
16701  /* maxp1 - long */
16702  /* gives an upper bound on the number of chebyshev */
16703  /* moments which can be stored, i.e. for the */
16704  /* intervals of lengths fabs(bb-aa)*2**(-l), */
16705  /* l = 0,1,2, ..., maxp1-2. */
16706 
16707  /* ksave - long */
16708  /* key which is one when the moments for the */
16709  /* current interval have been computed */
16710 
16711  /* on return */
16712  /* result - sys_float */
16713  /* approximation to the integral i */
16714 
16715  /* abserr - sys_float */
16716  /* estimate of the modulus of the absolute */
16717  /* error, which should equal or exceed fabs(i-result) */
16718 
16719  /* neval - long */
16720  /* number of integrand evaluations */
16721 
16722  /* resabs - sys_float */
16723  /* approximation to the integral j */
16724 
16725  /* resasc - sys_float */
16726  /* approximation to the integral of fabs(f-i/(b-a)) */
16727 
16728  /* on entry and return */
16729  /* momcom - long */
16730  /* for each interval length we need to compute the */
16731  /* chebyshev moments. momcom counts the number of */
16732  /* intervals for which these moments have already been */
16733  /* computed. if nrmom.lt.momcom or ksave = 1, the */
16734  /* chebyshev moments for the interval (a,b) have */
16735  /* already been computed and stored, otherwise we */
16736  /* compute them and we increase momcom. */
16737 
16738  /* chebmo - sys_float */
16739  /* array of dimension at least (maxp1,25) containing */
16740  /* the modified chebyshev moments for the first momcom */
16741  /* momcom interval lengths */
16742 
16743  /* ***references (none) */
16744  /* ***routines called qcheb,qk15w,qwgtf,r1mach,sgtsl */
16745  /* ***end prologue qc25f */
16746 
16747 
16748 
16749 
16750  /* the vector x contains the values cos(k*pi/24) */
16751  /* k = 1, ...,11, to be used for the chebyshev expansion of f */
16752 
16753  /* Parameter adjustments */
16754  chebmo_dim1 = *maxp1;
16755  chebmo_offset = 1 + chebmo_dim1;
16756  chebmo -= chebmo_offset;
16757 
16758  /* Function Body */
16759 
16760  /* list of major variables */
16761  /* ----------------------- */
16762 
16763  /* centr - mid point of the integration interval */
16764  /* hlgth - half-length of the integration interval */
16765  /* fval - value of the function f at the points */
16766  /* (b-a)*0.5*cos(k*pi/12) + (b+a)*0.5, */
16767  /* k = 0, ..., 24 */
16768  /* cheb12 - coefficients of the chebyshev series expansion */
16769  /* of degree 12, for the function f, in the */
16770  /* interval (a,b) */
16771  /* cheb24 - coefficients of the chebyshev series expansion */
16772  /* of degree 24, for the function f, in the */
16773  /* interval (a,b) */
16774  /* resc12 - approximation to the integral of */
16775  /* cos(0.5*(b-a)*omega*x)*f(0.5*(b-a)*x+0.5*(b+a)) */
16776  /* over (-1,+1), using the chebyshev series */
16777  /* expansion of degree 12 */
16778  /* resc24 - approximation to the same integral, using the */
16779  /* chebyshev series expansion of degree 24 */
16780  /* ress12 - the analogue of resc12 for the sine */
16781  /* ress24 - the analogue of resc24 for the sine */
16782 
16783 
16784  /* machine dependent constant */
16785  /* -------------------------- */
16786 
16787  /* oflow is the largest positive magnitude. */
16788 
16789  /* ***first executable statement qc25f */
16790  oflow = r1mach(c__2);
16791 
16792  centr = (*b + *a) * .5f;
16793  hlgth = (*b - *a) * .5f;
16794  parint = *omega * hlgth;
16795 
16796  /* compute the integral using the 15-point gauss-kronrod */
16797  /* formula if the value of the parameter in the integrand */
16798  /* is small. */
16799 
16800  if (fabs(parint) > 2.f) {
16801  goto L10;
16802  }
16803  qk15w_(f, qwgtf_, omega, &p2, &p3, &p4, integr, a, b, result,
16804  abserr, resabs, resasc);
16805  *neval = 15;
16806  goto L170;
16807 
16808  /* compute the integral using the generalized clenshaw- */
16809  /* curtis method. */
16810 
16811 L10:
16812  conc = hlgth * cos(centr * *omega);
16813  cons = hlgth * sin(centr * *omega);
16814  *resasc = oflow;
16815  *neval = 25;
16816 
16817  /* check whether the chebyshev moments for this interval */
16818  /* have already been computed. */
16819 
16820  if (*nrmom < *momcom || *ksave == 1) {
16821  goto L120;
16822  }
16823 
16824  /* compute a new set of chebyshev moments. */
16825 
16826  m = *momcom + 1;
16827  par2 = parint * parint;
16828  par22 = par2 + 2.f;
16829  sinpar = sin(parint);
16830  cospar = cos(parint);
16831 
16832  /* compute the chebyshev moments with respect to cosine. */
16833 
16834  v[0] = sinpar * 2.f / parint;
16835  v[1] = (cospar * 8.f + (par2 + par2 - 8.f) * sinpar / parint) / par2;
16836  v[2] = ((par2 - 12.f) * 32.f * cospar + ((par2 - 80.f) * par2 + 192.f) *
16837  2.f * sinpar / parint) / (par2 * par2);
16838  ac = cospar * 8.f;
16839  as = parint * 24.f * sinpar;
16840  if (fabs(parint) > 24.f) {
16841  goto L30;
16842  }
16843 
16844  /* compute the chebyshev moments as the */
16845  /* solutions of a boundary value problem with 1 */
16846  /* initial value (v(3)) and 1 end value (computed */
16847  /* using an asymptotic formula). */
16848 
16849  noequ = 25;
16850  noeq1 = noequ - 1;
16851  an = 6.f;
16852  i__1 = noeq1;
16853  for (k = 1; k <= i__1; ++k) {
16854  an2 = an * an;
16855  d__[k - 1] = (an2 - 4.f) * -2.f * (par22 - an2 - an2);
16856  d2[k - 1] = (an - 1.f) * (an - 2.f) * par2;
16857  d1[k] = (an + 3.f) * (an + 4.f) * par2;
16858  v[k + 2] = as - (an2 - 4.f) * ac;
16859  an += 2.f;
16860  /* L20: */
16861  }
16862  an2 = an * an;
16863  d__[noequ - 1] = (an2 - 4.f) * -2.f * (par22 - an2 - an2);
16864  v[noequ + 2] = as - (an2 - 4.f) * ac;
16865  v[3] -= par2 * 56.f * v[2];
16866  ass = parint * sinpar;
16867  asap = (((((par2 * 210.f - 1.f) * cospar - (par2 * 105.f - 63.f) * ass) /
16868  an2 - (1.f - par2 * 15.f) * cospar + ass * 15.f) / an2 - cospar +
16869  ass * 3.f) / an2 - cospar) / an2;
16870  v[noequ + 2] -= asap * 2.f * par2 * (an - 1.f) * (an - 2.f);
16871 
16872  /* solve the tridiagonal system by means of gaussian */
16873  /* elimination with partial pivoting. */
16874 
16875  sgtsl_(&noequ, d1, d__, d2, &v[3], &iers);
16876  goto L50;
16877 
16878  /* compute the chebyshev moments by means of forward */
16879  /* recursion. */
16880 
16881 L30:
16882  an = 4.f;
16883  for (i__ = 4; i__ <= 13; ++i__) {
16884  an2 = an * an;
16885  v[i__ - 1] = ((an2 - 4.f) * ((par22 - an2 - an2) * 2.f * v[i__ - 2] -
16886  ac) + as - par2 * (an + 1.f) * (an + 2.f) * v[i__ - 3]) / (
16887  par2 * (an - 1.f) * (an - 2.f));
16888  an += 2.f;
16889  /* L40: */
16890  }
16891 L50:
16892  for (j = 1; j <= 13; ++j) {
16893  chebmo[m + ((j << 1) - 1) * chebmo_dim1] = v[j - 1];
16894  /* L60: */
16895  }
16896 
16897  /* compute the chebyshev moments with respect to sine. */
16898 
16899  v[0] = (sinpar - parint * cospar) * 2.f / par2;
16900  v[1] = (18.f - 48.f / par2) * sinpar / par2 + (48.f / par2 - 2.f) *
16901  cospar / parint;
16902  ac = parint * -24.f * cospar;
16903  as = sinpar * -8.f;
16904  if (fabs(parint) > 24.f) {
16905  goto L80;
16906  }
16907 
16908  /* compute the chebyshev moments as the */
16909  /* solutions of a boundary value problem with 1 */
16910  /* initial value (v(2)) and 1 end value (computed */
16911  /* using an asymptotic formula). */
16912 
16913  an = 5.f;
16914  i__1 = noeq1;
16915  for (k = 1; k <= i__1; ++k) {
16916  an2 = an * an;
16917  d__[k - 1] = (an2 - 4.f) * -2.f * (par22 - an2 - an2);
16918  d2[k - 1] = (an - 1.f) * (an - 2.f) * par2;
16919  d1[k] = (an + 3.f) * (an + 4.f) * par2;
16920  v[k + 1] = ac + (an2 - 4.f) * as;
16921  an += 2.f;
16922  /* L70: */
16923  }
16924  an2 = an * an;
16925  d__[noequ - 1] = (an2 - 4.f) * -2.f * (par22 - an2 - an2);
16926  v[noequ + 1] = ac + (an2 - 4.f) * as;
16927  v[2] -= par2 * 42.f * v[1];
16928  ass = parint * cospar;
16929  asap = (((((par2 * 105.f - 63.f) * ass + (par2 * 210.f - 1.f) * sinpar) /
16930  an2 + (par2 * 15.f - 1.f) * sinpar - ass * 15.f) / an2 - ass *
16931  3.f - sinpar) / an2 - sinpar) / an2;
16932  v[noequ + 1] -= asap * 2.f * par2 * (an - 1.f) * (an - 2.f);
16933 
16934  /* solve the tridiagonal system by means of gaussian */
16935  /* elimination with partial pivoting. */
16936 
16937  sgtsl_(&noequ, d1, d__, d2, &v[2], &iers);
16938  goto L100;
16939 
16940  /* compute the chebyshev moments by means of */
16941  /* forward recursion. */
16942 
16943 L80:
16944  an = 3.f;
16945  for (i__ = 3; i__ <= 12; ++i__) {
16946  an2 = an * an;
16947  v[i__ - 1] = ((an2 - 4.f) * ((par22 - an2 - an2) * 2.f * v[i__ - 2] +
16948  as) + ac - par2 * (an + 1.f) * (an + 2.f) * v[i__ - 3]) / (
16949  par2 * (an - 1.f) * (an - 2.f));
16950  an += 2.f;
16951  /* L90: */
16952  }
16953 L100:
16954  for (j = 1; j <= 12; ++j) {
16955  chebmo[m + (j << 1) * chebmo_dim1] = v[j - 1];
16956  /* L110: */
16957  }
16958 L120:
16959  if (*nrmom < *momcom) {
16960  m = *nrmom + 1;
16961  }
16962  if (*momcom < *maxp1 - 1 && *nrmom >= *momcom) {
16963  ++(*momcom);
16964  }
16965 
16966  /* compute the coefficients of the chebyshev expansions */
16967  /* of degrees 12 and 24 of the function f. */
16968 
16969  r__1 = centr + hlgth;
16970  fval[0] = f(r__1) * .5f;
16971  fval[12] = f(centr);
16972  r__1 = centr - hlgth;
16973  fval[24] = f(r__1) * .5f;
16974  for (i__ = 2; i__ <= 12; ++i__) {
16975  isym = 26 - i__;
16976  r__1 = hlgth * x[i__ - 2] + centr;
16977  fval[i__ - 1] = f(r__1);
16978  r__1 = centr - hlgth * x[i__ - 2];
16979  fval[isym - 1] = f(r__1);
16980  /* L130: */
16981  }
16982  qcheb_(x, fval, cheb12, cheb24);
16983 
16984  /* compute the integral and error estimates. */
16985 
16986  resc12 = cheb12[12] * chebmo[m + chebmo_dim1 * 13];
16987  ress12 = 0.f;
16988  k = 11;
16989  for (j = 1; j <= 6; ++j) {
16990  resc12 += cheb12[k - 1] * chebmo[m + k * chebmo_dim1];
16991  ress12 += cheb12[k] * chebmo[m + (k + 1) * chebmo_dim1];
16992  k += -2;
16993  /* L140: */
16994  }
16995  resc24 = cheb24[24] * chebmo[m + chebmo_dim1 * 25];
16996  ress24 = 0.f;
16997  *resabs = fabs(cheb24[24]);
16998  k = 23;
16999  for (j = 1; j <= 12; ++j) {
17000  resc24 += cheb24[k - 1] * chebmo[m + k * chebmo_dim1];
17001  ress24 += cheb24[k] * chebmo[m + (k + 1) * chebmo_dim1];
17002  *resabs = (r__1 = cheb24[k - 1], fabs(r__1)) + (r__2 = cheb24[k],
17003  fabs(r__2));
17004  k += -2;
17005  /* L150: */
17006  }
17007  estc = (r__1 = resc24 - resc12, fabs(r__1));
17008  ests = (r__1 = ress24 - ress12, fabs(r__1));
17009  *resabs *= fabs(hlgth);
17010  if (*integr == 2) {
17011  goto L160;
17012  }
17013  *result = conc * resc24 - cons * ress24;
17014  *abserr = (r__1 = conc * estc, fabs(r__1)) + (r__2 = cons * ests, fabs(
17015  r__2));
17016  goto L170;
17017 L160:
17018  *result = conc * ress24 + cons * resc24;
17019  *abserr = (r__1 = conc * ests, fabs(r__1)) + (r__2 = cons * estc, fabs(
17020  r__2));
17021 L170:
17022  return;
17023 } /* qc25f_ */
17024 
17025 void qc25s_(const E_fp& f, const sys_float *a, const sys_float *b,
17026  const sys_float *bl, const sys_float *br,
17027  const sys_float *alfa, const sys_float *beta,
17028  sys_float *ri, sys_float *rj, sys_float *rg, sys_float *rh,
17029  sys_float *result, sys_float *abserr, sys_float *resasc,
17030  const long *integr, long *nev)
17031 {
17032  /* Initialized data */
17033 
17034  sys_float x[11] = { .9914448613738104f,.9659258262890683f,
17035  .9238795325112868f,.8660254037844386f,.7933533402912352f,
17036  .7071067811865475f,.6087614290087206f,.5f,.3826834323650898f,
17037  .2588190451025208f,.1305261922200516f };
17038 
17039  /* System generated locals */
17040  sys_float r__1;
17041  double d__1, d__2;
17042 
17043  /* Local variables */
17044  long i__;
17045  sys_float u, dc, fix, fval[25], res12, res24;
17046  long isym;
17047  sys_float cheb12[13], cheb24[25];
17048  sys_float hlgth, centr;
17049  sys_float factor, resabs;
17050 
17051  /* ***begin prologue qc25s */
17052  /* ***date written 810101 (yymmdd) */
17053  /* ***revision date 830518 (yymmdd) */
17054  /* ***category no. h2a2a2 */
17055  /* ***keywords 25-point clenshaw-curtis integration */
17056  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
17057  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
17058  /* ***purpose to compute i = integral of f*w over (bl,br), with error */
17059  /* estimate, where the weight function w has a singular */
17060  /* behaviour of algebraico-logarithmic type at the points */
17061  /* a and/or b. (bl,br) is a part of (a,b). */
17062  /* ***description */
17063 
17064  /* integration rules for integrands having algebraico-logarithmic */
17065  /* end point singularities */
17066  /* standard fortran subroutine */
17067  /* sys_float version */
17068 
17069  /* parameters */
17070  /* f - sys_float */
17071  /* function subprogram defining the integrand */
17072  /* f(x). the actual name for f needs to be declared */
17073  /* e x t e r n a l in the driver program. */
17074 
17075  /* a - sys_float */
17076  /* left end point of the original interval */
17077 
17078  /* b - sys_float */
17079  /* right end point of the original interval, b.gt.a */
17080 
17081  /* bl - sys_float */
17082  /* lower limit of integration, bl.ge.a */
17083 
17084  /* br - sys_float */
17085  /* upper limit of integration, br.le.b */
17086 
17087  /* alfa - sys_float */
17088  /* parameter in the weight function */
17089 
17090  /* beta - sys_float */
17091  /* parameter in the weight function */
17092 
17093  /* ri,rj,rg,rh - sys_float */
17094  /* modified chebyshev moments for the application */
17095  /* of the generalized clenshaw-curtis */
17096  /* method (computed in subroutine dqmomo) */
17097 
17098  /* result - sys_float */
17099  /* approximation to the integral */
17100  /* result is computed by using a generalized */
17101  /* clenshaw-curtis method if b1 = a or br = b. */
17102  /* in all other cases the 15-point kronrod */
17103  /* rule is applied, obtained by optimal addition of */
17104  /* abscissae to the 7-point gauss rule. */
17105 
17106  /* abserr - sys_float */
17107  /* estimate of the modulus of the absolute error, */
17108  /* which should equal or exceed fabs(i-result) */
17109 
17110  /* resasc - sys_float */
17111  /* approximation to the integral of fabs(f*w-i/(b-a)) */
17112 
17113  /* integr - long */
17114  /* which determines the weight function */
17115  /* = 1 w(x) = (x-a)**alfa*(b-x)**beta */
17116  /* = 2 w(x) = (x-a)**alfa*(b-x)**beta*log(x-a) */
17117  /* = 3 w(x) = (x-a)**alfa*(b-x)**beta*log(b-x) */
17118  /* = 4 w(x) = (x-a)**alfa*(b-x)**beta*log(x-a)* */
17119  /* log(b-x) */
17120 
17121  /* nev - long */
17122  /* number of integrand evaluations */
17123 
17124  /* ***references (none) */
17125  /* ***routines called qcheb,qk15w */
17126  /* ***end prologue qc25s */
17127 
17128 
17129 
17130 
17131  /* the vector x contains the values cos(k*pi/24) */
17132  /* k = 1, ..., 11, to be used for the computation of the */
17133  /* chebyshev series expansion of f. */
17134 
17135  /* Parameter adjustments */
17136  --rh;
17137  --rg;
17138  --rj;
17139  --ri;
17140 
17141  /* Function Body */
17142 
17143  /* list of major variables */
17144  /* ----------------------- */
17145 
17146  /* fval - value of the function f at the points */
17147  /* (br-bl)*0.5*cos(k*pi/24)+(br+bl)*0.5 */
17148  /* k = 0, ..., 24 */
17149  /* cheb12 - coefficients of the chebyshev series expansion */
17150  /* of degree 12, for the function f, in the */
17151  /* interval (bl,br) */
17152  /* cheb24 - coefficients of the chebyshev series expansion */
17153  /* of degree 24, for the function f, in the */
17154  /* interval (bl,br) */
17155  /* res12 - approximation to the integral obtained from cheb12 */
17156  /* res24 - approximation to the integral obtained from cheb24 */
17157  /* qwgts - external function subprogram defining */
17158  /* the four possible weight functions */
17159  /* hlgth - half-length of the interval (bl,br) */
17160  /* centr - mid point of the interval (bl,br) */
17161 
17162  /* ***first executable statement qc25s */
17163  *nev = 25;
17164  if (*bl == *a && (*alfa != 0.f || *integr == 2 || *integr == 4)) {
17165  goto L10;
17166  }
17167  if (*br == *b && (*beta != 0.f || *integr == 3 || *integr == 4)) {
17168  goto L140;
17169  }
17170 
17171  /* if a.gt.bl and b.lt.br, apply the 15-point gauss-kronrod */
17172  /* scheme. */
17173 
17174 
17175  qk15w_(f, qwgts_, a, b, alfa, beta, integr, bl, br, result,
17176  abserr, &resabs, resasc);
17177  *nev = 15;
17178  goto L270;
17179 
17180  /* this part of the program is executed only if a = bl. */
17181  /* ---------------------------------------------------- */
17182 
17183  /* compute the chebyshev series expansion of the */
17184  /* following function */
17185  /* f1 = (0.5*(b+b-br-a)-0.5*(br-a)*x)**beta */
17186  /* *f(0.5*(br-a)*x+0.5*(br+a)) */
17187 
17188 L10:
17189  hlgth = (*br - *bl) * .5f;
17190  centr = (*br + *bl) * .5f;
17191  fix = *b - centr;
17192  r__1 = hlgth + centr;
17193  d__1 = (double) (fix - hlgth);
17194  d__2 = (double) (*beta);
17195  fval[0] = f(r__1) * .5f * pow(d__1, d__2);
17196  d__1 = (double) fix;
17197  d__2 = (double) (*beta);
17198  fval[12] = f(centr) * pow(d__1, d__2);
17199  r__1 = centr - hlgth;
17200  d__1 = (double) (fix + hlgth);
17201  d__2 = (double) (*beta);
17202  fval[24] = f(r__1) * .5f * pow(d__1, d__2);
17203  for (i__ = 2; i__ <= 12; ++i__) {
17204  u = hlgth * x[i__ - 2];
17205  isym = 26 - i__;
17206  r__1 = u + centr;
17207  d__1 = (double) (fix - u);
17208  d__2 = (double) (*beta);
17209  fval[i__ - 1] = f(r__1) * pow(d__1, d__2);
17210  r__1 = centr - u;
17211  d__1 = (double) (fix + u);
17212  d__2 = (double) (*beta);
17213  fval[isym - 1] = f(r__1) * pow(d__1, d__2);
17214  /* L20: */
17215  }
17216  d__1 = (double) hlgth;
17217  d__2 = (double) (*alfa + 1.f);
17218  factor = pow(d__1, d__2);
17219  *result = 0.f;
17220  *abserr = 0.f;
17221  res12 = 0.f;
17222  res24 = 0.f;
17223  if (*integr > 2) {
17224  goto L70;
17225  }
17226  qcheb_(x, fval, cheb12, cheb24);
17227 
17228  /* integr = 1 (or 2) */
17229 
17230  for (i__ = 1; i__ <= 13; ++i__) {
17231  res12 += cheb12[i__ - 1] * ri[i__];
17232  res24 += cheb24[i__ - 1] * ri[i__];
17233  /* L30: */
17234  }
17235  for (i__ = 14; i__ <= 25; ++i__) {
17236  res24 += cheb24[i__ - 1] * ri[i__];
17237  /* L40: */
17238  }
17239  if (*integr == 1) {
17240  goto L130;
17241  }
17242 
17243  /* integr = 2 */
17244 
17245  dc = log(*br - *bl);
17246  *result = res24 * dc;
17247  *abserr = (r__1 = (res24 - res12) * dc, fabs(r__1));
17248  res12 = 0.f;
17249  res24 = 0.f;
17250  for (i__ = 1; i__ <= 13; ++i__) {
17251  res12 += cheb12[i__ - 1] * rg[i__];
17252  res24 = res12 + cheb24[i__ - 1] * rg[i__];
17253  /* L50: */
17254  }
17255  for (i__ = 14; i__ <= 25; ++i__) {
17256  res24 += cheb24[i__ - 1] * rg[i__];
17257  /* L60: */
17258  }
17259  goto L130;
17260 
17261  /* compute the chebyshev series expansion of the */
17262  /* following function */
17263  /* f4 = f1*log(0.5*(b+b-br-a)-0.5*(br-a)*x) */
17264 
17265 L70:
17266  fval[0] *= log(fix - hlgth);
17267  fval[12] *= log(fix);
17268  fval[24] *= log(fix + hlgth);
17269  for (i__ = 2; i__ <= 12; ++i__) {
17270  u = hlgth * x[i__ - 2];
17271  isym = 26 - i__;
17272  fval[i__ - 1] *= log(fix - u);
17273  fval[isym - 1] *= log(fix + u);
17274  /* L80: */
17275  }
17276  qcheb_(x, fval, cheb12, cheb24);
17277 
17278  /* integr = 3 (or 4) */
17279 
17280  for (i__ = 1; i__ <= 13; ++i__) {
17281  res12 += cheb12[i__ - 1] * ri[i__];
17282  res24 += cheb24[i__ - 1] * ri[i__];
17283  /* L90: */
17284  }
17285  for (i__ = 14; i__ <= 25; ++i__) {
17286  res24 += cheb24[i__ - 1] * ri[i__];
17287  /* L100: */
17288  }
17289  if (*integr == 3) {
17290  goto L130;
17291  }
17292 
17293  /* integr = 4 */
17294 
17295  dc = log(*br - *bl);
17296  *result = res24 * dc;
17297  *abserr = (r__1 = (res24 - res12) * dc, fabs(r__1));
17298  res12 = 0.f;
17299  res24 = 0.f;
17300  for (i__ = 1; i__ <= 13; ++i__) {
17301  res12 += cheb12[i__ - 1] * rg[i__];
17302  res24 += cheb24[i__ - 1] * rg[i__];
17303  /* L110: */
17304  }
17305  for (i__ = 14; i__ <= 25; ++i__) {
17306  res24 += cheb24[i__ - 1] * rg[i__];
17307  /* L120: */
17308  }
17309 L130:
17310  *result = (*result + res24) * factor;
17311  *abserr = (*abserr + (r__1 = res24 - res12, fabs(r__1))) * factor;
17312  goto L270;
17313 
17314  /* this part of the program is executed only if b = br. */
17315  /* ---------------------------------------------------- */
17316 
17317  /* compute the chebyshev series expansion of the */
17318  /* following function */
17319  /* f2 = (0.5*(b+bl-a-a)+0.5*(b-bl)*x)**alfa */
17320  /* *f(0.5*(b-bl)*x+0.5*(b+bl)) */
17321 
17322 L140:
17323  hlgth = (*br - *bl) * .5f;
17324  centr = (*br + *bl) * .5f;
17325  fix = centr - *a;
17326  r__1 = hlgth + centr;
17327  d__1 = (double) (fix + hlgth);
17328  d__2 = (double) (*alfa);
17329  fval[0] = f(r__1) * .5f * pow(d__1, d__2);
17330  d__1 = (double) fix;
17331  d__2 = (double) (*alfa);
17332  fval[12] = f(centr) * pow(d__1, d__2);
17333  r__1 = centr - hlgth;
17334  d__1 = (double) (fix - hlgth);
17335  d__2 = (double) (*alfa);
17336  fval[24] = f(r__1) * .5f * pow(d__1, d__2);
17337  for (i__ = 2; i__ <= 12; ++i__) {
17338  u = hlgth * x[i__ - 2];
17339  isym = 26 - i__;
17340  r__1 = u + centr;
17341  d__1 = (double) (fix + u);
17342  d__2 = (double) (*alfa);
17343  fval[i__ - 1] = f(r__1) * pow(d__1, d__2);
17344  r__1 = centr - u;
17345  d__1 = (double) (fix - u);
17346  d__2 = (double) (*alfa);
17347  fval[isym - 1] = f(r__1) * pow(d__1, d__2);
17348  /* L150: */
17349  }
17350  d__1 = (double) hlgth;
17351  d__2 = (double) (*beta + 1.f);
17352  factor = pow(d__1, d__2);
17353  *result = 0.f;
17354  *abserr = 0.f;
17355  res12 = 0.f;
17356  res24 = 0.f;
17357  if (*integr == 2 || *integr == 4) {
17358  goto L200;
17359  }
17360 
17361  /* integr = 1 (or 3) */
17362 
17363  qcheb_(x, fval, cheb12, cheb24);
17364  for (i__ = 1; i__ <= 13; ++i__) {
17365  res12 += cheb12[i__ - 1] * rj[i__];
17366  res24 += cheb24[i__ - 1] * rj[i__];
17367  /* L160: */
17368  }
17369  for (i__ = 14; i__ <= 25; ++i__) {
17370  res24 += cheb24[i__ - 1] * rj[i__];
17371  /* L170: */
17372  }
17373  if (*integr == 1) {
17374  goto L260;
17375  }
17376 
17377  /* integr = 3 */
17378 
17379  dc = log(*br - *bl);
17380  *result = res24 * dc;
17381  *abserr = (r__1 = (res24 - res12) * dc, fabs(r__1));
17382  res12 = 0.f;
17383  res24 = 0.f;
17384  for (i__ = 1; i__ <= 13; ++i__) {
17385  res12 += cheb12[i__ - 1] * rh[i__];
17386  res24 += cheb24[i__ - 1] * rh[i__];
17387  /* L180: */
17388  }
17389  for (i__ = 14; i__ <= 25; ++i__) {
17390  res24 += cheb24[i__ - 1] * rh[i__];
17391  /* L190: */
17392  }
17393  goto L260;
17394 
17395  /* compute the chebyshev series expansion of the */
17396  /* following function */
17397  /* f3 = f2*log(0.5*(b-bl)*x+0.5*(b+bl-a-a)) */
17398 
17399 L200:
17400  fval[0] *= log(hlgth + fix);
17401  fval[12] *= log(fix);
17402  fval[24] *= log(fix - hlgth);
17403  for (i__ = 2; i__ <= 12; ++i__) {
17404  u = hlgth * x[i__ - 2];
17405  isym = 26 - i__;
17406  fval[i__ - 1] *= log(u + fix);
17407  fval[isym - 1] *= log(fix - u);
17408  /* L210: */
17409  }
17410  qcheb_(x, fval, cheb12, cheb24);
17411 
17412  /* integr = 2 (or 4) */
17413 
17414  for (i__ = 1; i__ <= 13; ++i__) {
17415  res12 += cheb12[i__ - 1] * rj[i__];
17416  res24 += cheb24[i__ - 1] * rj[i__];
17417  /* L220: */
17418  }
17419  for (i__ = 14; i__ <= 25; ++i__) {
17420  res24 += cheb24[i__ - 1] * rj[i__];
17421  /* L230: */
17422  }
17423  if (*integr == 2) {
17424  goto L260;
17425  }
17426  dc = log(*br - *bl);
17427  *result = res24 * dc;
17428  *abserr = (r__1 = (res24 - res12) * dc, fabs(r__1));
17429  res12 = 0.f;
17430  res24 = 0.f;
17431 
17432  /* integr = 4 */
17433 
17434  for (i__ = 1; i__ <= 13; ++i__) {
17435  res12 += cheb12[i__ - 1] * rh[i__];
17436  res24 += cheb24[i__ - 1] * rh[i__];
17437  /* L240: */
17438  }
17439  for (i__ = 14; i__ <= 25; ++i__) {
17440  res24 += cheb24[i__ - 1] * rh[i__];
17441  /* L250: */
17442  }
17443 L260:
17444  *result = (*result + res24) * factor;
17445  *abserr = (*abserr + (r__1 = res24 - res12, fabs(r__1))) * factor;
17446 L270:
17447  return;
17448 } /* qc25s_ */
17449 
17450 void qcheb_(sys_float *x, sys_float *fval, sys_float *cheb12, sys_float *cheb24)
17451 {
17452  long i__, j;
17453  sys_float v[12], alam, alam1, alam2, part1, part2, part3;
17454 
17455  /* ***begin prologue qcheb */
17456  /* ***refer to qc25c,qc25f,qc25s */
17457  /* ***routines called (none) */
17458  /* ***revision date 830518 (yymmdd) */
17459  /* ***keywords chebyshev series expansion, fast fourier transform */
17460  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
17461  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
17462  /* ***purpose this routine computes the chebyshev series expansion */
17463  /* of degrees 12 and 24 of a function using a */
17464  /* fast fourier transform method */
17465  /* f(x) = sum(k=1,..,13) (cheb12(k)*t(k-1,x)), */
17466  /* f(x) = sum(k=1,..,25) (cheb24(k)*t(k-1,x)), */
17467  /* where t(k,x) is the chebyshev polynomial of degree k. */
17468  /* ***description */
17469 
17470  /* chebyshev series expansion */
17471  /* standard fortran subroutine */
17472  /* sys_float version */
17473 
17474  /* parameters */
17475  /* on entry */
17476  /* x - sys_float */
17477  /* vector of dimension 11 containing the */
17478  /* values cos(k*pi/24), k = 1, ..., 11 */
17479 
17480  /* fval - sys_float */
17481  /* vector of dimension 25 containing the */
17482  /* function values at the points */
17483  /* (b+a+(b-a)*cos(k*pi/24))/2, k = 0, ...,24, */
17484  /* where (a,b) is the approximation interval. */
17485  /* fval(1) and fval(25) are divided by two */
17486  /* (these values are destroyed at output). */
17487 
17488  /* on return */
17489  /* cheb12 - sys_float */
17490  /* vector of dimension 13 containing the */
17491  /* chebyshev coefficients for degree 12 */
17492 
17493  /* cheb24 - sys_float */
17494  /* vector of dimension 25 containing the */
17495  /* chebyshev coefficients for degree 24 */
17496 
17497  /* ***end prologue qcheb */
17498 
17499 
17500 
17501  /* ***first executable statement qcheb */
17502  /* Parameter adjustments */
17503  --cheb24;
17504  --cheb12;
17505  --fval;
17506  --x;
17507 
17508  /* Function Body */
17509  for (i__ = 1; i__ <= 12; ++i__) {
17510  j = 26 - i__;
17511  v[i__ - 1] = fval[i__] - fval[j];
17512  fval[i__] += fval[j];
17513  /* L10: */
17514  }
17515  alam1 = v[0] - v[8];
17516  alam2 = x[6] * (v[2] - v[6] - v[10]);
17517  cheb12[4] = alam1 + alam2;
17518  cheb12[10] = alam1 - alam2;
17519  alam1 = v[1] - v[7] - v[9];
17520  alam2 = v[3] - v[5] - v[11];
17521  alam = x[3] * alam1 + x[9] * alam2;
17522  cheb24[4] = cheb12[4] + alam;
17523  cheb24[22] = cheb12[4] - alam;
17524  alam = x[9] * alam1 - x[3] * alam2;
17525  cheb24[10] = cheb12[10] + alam;
17526  cheb24[16] = cheb12[10] - alam;
17527  part1 = x[4] * v[4];
17528  part2 = x[8] * v[8];
17529  part3 = x[6] * v[6];
17530  alam1 = v[0] + part1 + part2;
17531  alam2 = x[2] * v[2] + part3 + x[10] * v[10];
17532  cheb12[2] = alam1 + alam2;
17533  cheb12[12] = alam1 - alam2;
17534  alam = x[1] * v[1] + x[3] * v[3] + x[5] * v[5] + x[7] * v[7] + x[9] * v[9]
17535  + x[11] * v[11];
17536  cheb24[2] = cheb12[2] + alam;
17537  cheb24[24] = cheb12[2] - alam;
17538  alam = x[11] * v[1] - x[9] * v[3] + x[7] * v[5] - x[5] * v[7] + x[3] * v[
17539  9] - x[1] * v[11];
17540  cheb24[12] = cheb12[12] + alam;
17541  cheb24[14] = cheb12[12] - alam;
17542  alam1 = v[0] - part1 + part2;
17543  alam2 = x[10] * v[2] - part3 + x[2] * v[10];
17544  cheb12[6] = alam1 + alam2;
17545  cheb12[8] = alam1 - alam2;
17546  alam = x[5] * v[1] - x[9] * v[3] - x[1] * v[5] - x[11] * v[7] + x[3] * v[
17547  9] + x[7] * v[11];
17548  cheb24[6] = cheb12[6] + alam;
17549  cheb24[20] = cheb12[6] - alam;
17550  alam = x[7] * v[1] - x[3] * v[3] - x[11] * v[5] + x[1] * v[7] - x[9] * v[
17551  9] - x[5] * v[11];
17552  cheb24[8] = cheb12[8] + alam;
17553  cheb24[18] = cheb12[8] - alam;
17554  for (i__ = 1; i__ <= 6; ++i__) {
17555  j = 14 - i__;
17556  v[i__ - 1] = fval[i__] - fval[j];
17557  fval[i__] += fval[j];
17558  /* L20: */
17559  }
17560  alam1 = v[0] + x[8] * v[4];
17561  alam2 = x[4] * v[2];
17562  cheb12[3] = alam1 + alam2;
17563  cheb12[11] = alam1 - alam2;
17564  cheb12[7] = v[0] - v[4];
17565  alam = x[2] * v[1] + x[6] * v[3] + x[10] * v[5];
17566  cheb24[3] = cheb12[3] + alam;
17567  cheb24[23] = cheb12[3] - alam;
17568  alam = x[6] * (v[1] - v[3] - v[5]);
17569  cheb24[7] = cheb12[7] + alam;
17570  cheb24[19] = cheb12[7] - alam;
17571  alam = x[10] * v[1] - x[6] * v[3] + x[2] * v[5];
17572  cheb24[11] = cheb12[11] + alam;
17573  cheb24[15] = cheb12[11] - alam;
17574  for (i__ = 1; i__ <= 3; ++i__) {
17575  j = 8 - i__;
17576  v[i__ - 1] = fval[i__] - fval[j];
17577  fval[i__] += fval[j];
17578  /* L30: */
17579  }
17580  cheb12[5] = v[0] + x[8] * v[2];
17581  cheb12[9] = fval[1] - x[8] * fval[3];
17582  alam = x[4] * v[1];
17583  cheb24[5] = cheb12[5] + alam;
17584  cheb24[21] = cheb12[5] - alam;
17585  alam = x[8] * fval[2] - fval[4];
17586  cheb24[9] = cheb12[9] + alam;
17587  cheb24[17] = cheb12[9] - alam;
17588  cheb12[1] = fval[1] + fval[3];
17589  alam = fval[2] + fval[4];
17590  cheb24[1] = cheb12[1] + alam;
17591  cheb24[25] = cheb12[1] - alam;
17592  cheb12[13] = v[0] - v[2];
17593  cheb24[13] = cheb12[13];
17594  alam = .16666666666666666f;
17595  for (i__ = 2; i__ <= 12; ++i__) {
17596  cheb12[i__] *= alam;
17597  /* L40: */
17598  }
17599  alam *= .5f;
17600  cheb12[1] *= alam;
17601  cheb12[13] *= alam;
17602  for (i__ = 2; i__ <= 24; ++i__) {
17603  cheb24[i__] *= alam;
17604  /* L50: */
17605  }
17606  cheb24[1] = alam * .5f * cheb24[1];
17607  cheb24[25] = alam * .5f * cheb24[25];
17608  return;
17609 } /* qcheb_ */
17610 
17611 void qelg_(long *n, sys_float *epstab, sys_float *result, sys_float *
17612  abserr, sys_float *res3la, long *nres)
17613 {
17614  /* System generated locals */
17615  int i__1;
17616  sys_float r__1, r__2, r__3;
17617 
17618  /* Local variables */
17619  long i__;
17620  sys_float e0, e1, e2, e3;
17621  long k1, k2, k3, ib, ie;
17622  sys_float ss;
17623  long ib2;
17624  sys_float res;
17625  long num;
17626  sys_float err1, err2, err3, tol1, tol2, tol3;
17627  long indx;
17628  sys_float e1abs, oflow, error, delta1, delta2, delta3;
17629  sys_float epmach, epsinf;
17630  long newelm, limexp;
17631 
17632  /* ***begin prologue qelg */
17633  /* ***refer to qagie,qagoe,qagpe,qagse */
17634  /* ***routines called r1mach */
17635  /* ***revision date 830518 (yymmdd) */
17636  /* ***keywords epsilon algorithm, convergence acceleration, */
17637  /* extrapolation */
17638  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
17639  /* de doncker,elise,appl. math & progr. div. - k.u.leuven */
17640  /* ***purpose the routine determines the limit of a given sequence of */
17641  /* approximations, by means of the epsilon algorithm of */
17642  /* p. wynn. an estimate of the absolute error is also given. */
17643  /* the condensed epsilon table is computed. only those */
17644  /* elements needed for the computation of the next diagonal */
17645  /* are preserved. */
17646  /* ***description */
17647 
17648  /* epsilon algorithm */
17649  /* standard fortran subroutine */
17650  /* sys_float version */
17651 
17652  /* parameters */
17653  /* n - long */
17654  /* epstab(n) contains the new element in the */
17655  /* first column of the epsilon table. */
17656 
17657  /* epstab - sys_float */
17658  /* vector of dimension 52 containing the elements */
17659  /* of the two lower diagonals of the triangular */
17660  /* epsilon table. the elements are numbered */
17661  /* starting at the right-hand corner of the */
17662  /* triangle. */
17663 
17664  /* result - sys_float */
17665  /* resulting approximation to the integral */
17666 
17667  /* abserr - sys_float */
17668  /* estimate of the absolute error computed from */
17669  /* result and the 3 previous results */
17670 
17671  /* res3la - sys_float */
17672  /* vector of dimension 3 containing the last 3 */
17673  /* results */
17674 
17675  /* nres - long */
17676  /* number of calls to the routine */
17677  /* (should be zero at first call) */
17678 
17679  /* ***end prologue qelg */
17680 
17681 
17682  /* list of major variables */
17683  /* ----------------------- */
17684 
17685  /* e0 - the 4 elements on which the */
17686  /* e1 computation of a new element in */
17687  /* e2 the epsilon table is based */
17688  /* e3 e0 */
17689  /* e3 e1 new */
17690  /* e2 */
17691  /* newelm - number of elements to be computed in the new */
17692  /* diagonal */
17693  /* error - error = fabs(e1-e0)+fabs(e2-e1)+fabs(new-e2) */
17694  /* result - the element in the new diagonal with least value */
17695  /* of error */
17696 
17697  /* machine dependent constants */
17698  /* --------------------------- */
17699 
17700  /* epmach is the largest relative spacing. */
17701  /* oflow is the largest positive magnitude. */
17702  /* limexp is the maximum number of elements the epsilon */
17703  /* table can contain. if this number is reached, the upper */
17704  /* diagonal of the epsilon table is deleted. */
17705 
17706  /* ***first executable statement qelg */
17707  /* Parameter adjustments */
17708  --res3la;
17709  --epstab;
17710 
17711  /* Function Body */
17712  epmach = r1mach(c__4);
17713  oflow = r1mach(c__2);
17714  ++(*nres);
17715  *abserr = oflow;
17716  *result = epstab[*n];
17717  if (*n < 3) {
17718  goto L100;
17719  }
17720  limexp = 50;
17721  epstab[*n + 2] = epstab[*n];
17722  newelm = (*n - 1) / 2;
17723  epstab[*n] = oflow;
17724  num = *n;
17725  k1 = *n;
17726  i__1 = newelm;
17727  for (i__ = 1; i__ <= i__1; ++i__) {
17728  k2 = k1 - 1;
17729  k3 = k1 - 2;
17730  res = epstab[k1 + 2];
17731  e0 = epstab[k3];
17732  e1 = epstab[k2];
17733  e2 = res;
17734  e1abs = fabs(e1);
17735  delta2 = e2 - e1;
17736  err2 = fabs(delta2);
17737  /* Computing MAX */
17738  r__1 = fabs(e2);
17739  tol2 = max(r__1,e1abs) * epmach;
17740  delta3 = e1 - e0;
17741  err3 = fabs(delta3);
17742  /* Computing MAX */
17743  r__1 = e1abs, r__2 = fabs(e0);
17744  tol3 = max(r__1,r__2) * epmach;
17745  if (err2 > tol2 || err3 > tol3) {
17746  goto L10;
17747  }
17748 
17749  /* if e0, e1 and e2 are equal to within machine */
17750  /* accuracy, convergence is assumed. */
17751  /* result = e2 */
17752  /* abserr = fabs(e1-e0)+fabs(e2-e1) */
17753 
17754  *result = res;
17755  *abserr = err2 + err3;
17756  /* ***jump out of do-loop */
17757  goto L100;
17758  L10:
17759  e3 = epstab[k1];
17760  epstab[k1] = e1;
17761  delta1 = e1 - e3;
17762  err1 = fabs(delta1);
17763  /* Computing MAX */
17764  r__1 = e1abs, r__2 = fabs(e3);
17765  tol1 = max(r__1,r__2) * epmach;
17766 
17767  /* if two elements are very close to each other, omit */
17768  /* a part of the table by adjusting the value of n */
17769 
17770  if (err1 <= tol1 || err2 <= tol2 || err3 <= tol3) {
17771  goto L20;
17772  }
17773  ss = 1.f / delta1 + 1.f / delta2 - 1.f / delta3;
17774  epsinf = (r__1 = ss * e1, fabs(r__1));
17775 
17776  /* test to detect irregular behaviour in the table, and */
17777  /* eventually omit a part of the table adjusting the value */
17778  /* of n. */
17779 
17780  if (epsinf > 1e-4f) {
17781  goto L30;
17782  }
17783  L20:
17784  *n = i__ + i__ - 1;
17785  /* ***jump out of do-loop */
17786  goto L50;
17787 
17788  /* compute a new element and eventually adjust */
17789  /* the value of result. */
17790 
17791  L30:
17792  res = e1 + 1.f / ss;
17793  epstab[k1] = res;
17794  k1 += -2;
17795  error = err2 + (r__1 = res - e2, fabs(r__1)) + err3;
17796  if (error > *abserr) {
17797  goto L40;
17798  }
17799  *abserr = error;
17800  *result = res;
17801  L40:
17802  ;
17803  }
17804 
17805  /* shift the table. */
17806 
17807 L50:
17808  if (*n == limexp) {
17809  *n = (limexp / 2 << 1) - 1;
17810  }
17811  ib = 1;
17812  if (num / 2 << 1 == num) {
17813  ib = 2;
17814  }
17815  ie = newelm + 1;
17816  i__1 = ie;
17817  for (i__ = 1; i__ <= i__1; ++i__) {
17818  ib2 = ib + 2;
17819  epstab[ib] = epstab[ib2];
17820  ib = ib2;
17821  /* L60: */
17822  }
17823  if (num == *n) {
17824  goto L80;
17825  }
17826  indx = num - *n + 1;
17827  i__1 = *n;
17828  for (i__ = 1; i__ <= i__1; ++i__) {
17829  epstab[i__] = epstab[indx];
17830  ++indx;
17831  /* L70: */
17832  }
17833 L80:
17834  if (*nres >= 4) {
17835  goto L90;
17836  }
17837  res3la[*nres] = *result;
17838  *abserr = oflow;
17839  goto L100;
17840 
17841  /* compute error estimate */
17842 
17843 L90:
17844  *abserr = (r__1 = *result - res3la[3], fabs(r__1)) + (r__2 = *result -
17845  res3la[2], fabs(r__2)) + (r__3 = *result - res3la[1], fabs(r__3));
17846  res3la[1] = res3la[2];
17847  res3la[2] = res3la[3];
17848  res3la[3] = *result;
17849 L100:
17850  /* Computing MAX */
17851  r__1 = *abserr, r__2 = epmach * 5.f * fabs(*result);
17852  *abserr = max(r__1,r__2);
17853  return;
17854 } /* qelg_ */
17855 
17856 void qk15_(const E_fp& f, const sys_float *a, const sys_float *b,
17857  sys_float *result, sys_float *abserr,
17858  sys_float *resabs, sys_float *resasc)
17859 {
17860  /* Initialized data */
17861 
17862  sys_float xgk[8] = { .9914553711208126f,.9491079123427585f,
17863  .8648644233597691f,.7415311855993944f,.5860872354676911f,
17864  .4058451513773972f,.2077849550078985f,0.f };
17865  sys_float wgk[8] = { .02293532201052922f,.06309209262997855f,
17866  .1047900103222502f,.1406532597155259f,.1690047266392679f,
17867  .1903505780647854f,.2044329400752989f,.2094821410847278f };
17868  sys_float wg[4] = { .1294849661688697f,.2797053914892767f,
17869  .3818300505051189f,.4179591836734694f };
17870 
17871  /* System generated locals */
17872  sys_float r__1, r__2;
17873  double d__1;
17874 
17875  /* Local variables */
17876  long j;
17877  sys_float fc, fv1[7], fv2[7];
17878  long jtw;
17879  sys_float absc, resg, resk, fsum, fval1, fval2;
17880  long jtwm1;
17881  sys_float hlgth, centr, reskh, uflow;
17882  sys_float epmach, dhlgth;
17883 
17884  /* ***begin prologue qk15 */
17885  /* ***date written 800101 (yymmdd) */
17886  /* ***revision date 830518 (yymmdd) */
17887  /* ***category no. h2a1a2 */
17888  /* ***keywords 15-point gauss-kronrod rules */
17889  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
17890  /* de doncker,elise,appl. math. & progr. div - k.u.leuven */
17891  /* ***purpose to compute i = integral of f over (a,b), with error */
17892  /* estimate */
17893  /* j = integral of fabs(f) over (a,b) */
17894  /* ***description */
17895 
17896  /* integration rules */
17897  /* standard fortran subroutine */
17898  /* sys_float version */
17899 
17900  /* parameters */
17901  /* on entry */
17902  /* f - sys_float */
17903  /* function subprogram defining the integrand */
17904  /* function f(x). the actual name for f needs to be */
17905  /* declared e x t e r n a l in the calling program. */
17906 
17907  /* a - sys_float */
17908  /* lower limit of integration */
17909 
17910  /* b - sys_float */
17911  /* upper limit of integration */
17912 
17913  /* on return */
17914  /* result - sys_float */
17915  /* approximation to the integral i */
17916  /* result is computed by applying the 15-polong */
17917  /* kronrod rule (resk) obtained by optimal addition */
17918  /* of abscissae to the7-point gauss rule(resg). */
17919 
17920  /* abserr - sys_float */
17921  /* estimate of the modulus of the absolute error, */
17922  /* which should not exceed fabs(i-result) */
17923 
17924  /* resabs - sys_float */
17925  /* approximation to the integral j */
17926 
17927  /* resasc - sys_float */
17928  /* approximation to the integral of fabs(f-i/(b-a)) */
17929  /* over (a,b) */
17930 
17931  /* ***references (none) */
17932  /* ***routines called r1mach */
17933  /* ***end prologue qk15 */
17934 
17935 
17936 
17937  /* the abscissae and weights are given for the interval (-1,1). */
17938  /* because of symmetry only the positive abscissae and their */
17939  /* corresponding weights are given. */
17940 
17941  /* xgk - abscissae of the 15-point kronrod rule */
17942  /* xgk(2), xgk(4), ... abscissae of the 7-polong */
17943  /* gauss rule */
17944  /* xgk(1), xgk(3), ... abscissae which are optimally */
17945  /* added to the 7-point gauss rule */
17946 
17947  /* wgk - weights of the 15-point kronrod rule */
17948 
17949  /* wg - weights of the 7-point gauss rule */
17950 
17951 
17952 
17953  /* list of major variables */
17954  /* ----------------------- */
17955 
17956  /* centr - mid point of the interval */
17957  /* hlgth - half-length of the interval */
17958  /* absc - abscissa */
17959  /* fval* - function value */
17960  /* resg - result of the 7-point gauss formula */
17961  /* resk - result of the 15-point kronrod formula */
17962  /* reskh - approximation to the mean value of f over (a,b), */
17963  /* i.e. to i/(b-a) */
17964 
17965  /* machine dependent constants */
17966  /* --------------------------- */
17967 
17968  /* epmach is the largest relative spacing. */
17969  /* uflow is the smallest positive magnitude. */
17970 
17971  /* ***first executable statement qk15 */
17972  epmach = r1mach(c__4);
17973  uflow = r1mach(c__1);
17974 
17975  centr = (*a + *b) * .5f;
17976  hlgth = (*b - *a) * .5f;
17977  dhlgth = fabs(hlgth);
17978 
17979  /* compute the 15-point kronrod approximation to */
17980  /* the integral, and estimate the absolute error. */
17981 
17982  fc = f(centr);
17983  resg = fc * wg[3];
17984  resk = fc * wgk[7];
17985  *resabs = fabs(resk);
17986  for (j = 1; j <= 3; ++j) {
17987  jtw = j << 1;
17988  absc = hlgth * xgk[jtw - 1];
17989  r__1 = centr - absc;
17990  fval1 = f(r__1);
17991  r__1 = centr + absc;
17992  fval2 = f(r__1);
17993  fv1[jtw - 1] = fval1;
17994  fv2[jtw - 1] = fval2;
17995  fsum = fval1 + fval2;
17996  resg += wg[j - 1] * fsum;
17997  resk += wgk[jtw - 1] * fsum;
17998  *resabs += wgk[jtw - 1] * (fabs(fval1) + fabs(fval2));
17999  /* L10: */
18000  }
18001  for (j = 1; j <= 4; ++j) {
18002  jtwm1 = (j << 1) - 1;
18003  absc = hlgth * xgk[jtwm1 - 1];
18004  r__1 = centr - absc;
18005  fval1 = f(r__1);
18006  r__1 = centr + absc;
18007  fval2 = f(r__1);
18008  fv1[jtwm1 - 1] = fval1;
18009  fv2[jtwm1 - 1] = fval2;
18010  fsum = fval1 + fval2;
18011  resk += wgk[jtwm1 - 1] * fsum;
18012  *resabs += wgk[jtwm1 - 1] * (fabs(fval1) + fabs(fval2));
18013  /* L15: */
18014  }
18015  reskh = resk * .5f;
18016  *resasc = wgk[7] * (r__1 = fc - reskh, fabs(r__1));
18017  for (j = 1; j <= 7; ++j) {
18018  *resasc += wgk[j - 1] * ((r__1 = fv1[j - 1] - reskh, fabs(r__1)) + (
18019  r__2 = fv2[j - 1] - reskh, fabs(r__2)));
18020  /* L20: */
18021  }
18022  *result = resk * hlgth;
18023  *resabs *= dhlgth;
18024  *resasc *= dhlgth;
18025  *abserr = (r__1 = (resk - resg) * hlgth, fabs(r__1));
18026  if (*resasc != 0.f && *abserr != 0.f) {
18027  /* Computing MIN */
18028  d__1 = (double) (*abserr * 200.f / *resasc);
18029  r__1 = 1.f, r__2 = pow(d__1, c_b270);
18030  *abserr = *resasc * min(r__1,r__2);
18031  }
18032  if (*resabs > uflow / (epmach * 50.f)) {
18033  /* Computing MAX */
18034  r__1 = epmach * 50.f * *resabs;
18035  *abserr = max(r__1,*abserr);
18036  }
18037  return;
18038 } /* qk15_ */
18039 
18040 void qk15i_(const E_fp& f, const sys_float *boun, const long *inf, const sys_float *a,
18041  const sys_float *b, sys_float *result, sys_float *abserr,
18042  sys_float *resabs, sys_float *resasc)
18043 {
18044  /* Initialized data */
18045 
18046  sys_float xgk[8] = { .9914553711208126f,.9491079123427585f,
18047  .8648644233597691f,.7415311855993944f,.5860872354676911f,
18048  .4058451513773972f,.2077849550078985f,0.f };
18049  sys_float wgk[8] = { .02293532201052922f,.06309209262997855f,
18050  .1047900103222502f,.1406532597155259f,.1690047266392679f,
18051  .1903505780647854f,.2044329400752989f,.2094821410847278f };
18052  sys_float wg[8] = { 0.f,.1294849661688697f,0.f,.2797053914892767f,0.f,
18053  .3818300505051189f,0.f,.4179591836734694f };
18054 
18055  /* System generated locals */
18056  sys_float r__1, r__2;
18057  double d__1;
18058 
18059  /* Local variables */
18060  long j;
18061  sys_float fc, fv1[7], fv2[7], absc, dinf, resg, resk, fsum, absc1,
18062  absc2, fval1, fval2, hlgth, centr, reskh, uflow;
18063  sys_float tabsc1, tabsc2, epmach;
18064 
18065  /* ***begin prologue qk15i */
18066  /* ***date written 800101 (yymmdd) */
18067  /* ***revision date 830518 (yymmdd) */
18068  /* ***category no. h2a3a2,h2a4a2 */
18069  /* ***keywords 15-point transformed gauss-kronrod rules */
18070  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
18071  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
18072  /* ***purpose the original (infinite integration range is mapped */
18073  /* onto the interval (0,1) and (a,b) is a part of (0,1). */
18074  /* it is the purpose to compute */
18075  /* i = integral of transformed integrand over (a,b), */
18076  /* j = integral of fabs(transformed integrand) over (a,b). */
18077  /* ***description */
18078 
18079  /* integration rule */
18080  /* standard fortran subroutine */
18081  /* sys_float version */
18082 
18083  /* parameters */
18084  /* on entry */
18085  /* f - sys_float */
18086  /* fuction subprogram defining the integrand */
18087  /* function f(x). the actual name for f needs to be */
18088  /* declared e x t e r n a l in the calling program. */
18089 
18090  /* boun - sys_float */
18091  /* finite bound of original integration */
18092  /* range (set to zero if inf = +2) */
18093 
18094  /* inf - long */
18095  /* if inf = -1, the original interval is */
18096  /* (-infinity,bound), */
18097  /* if inf = +1, the original interval is */
18098  /* (bound,+infinity), */
18099  /* if inf = +2, the original interval is */
18100  /* (-infinity,+infinity) and */
18101  /* the integral is computed as the sum of two */
18102  /* integrals, one over (-infinity,0) and one over */
18103  /* (0,+infinity). */
18104 
18105  /* a - sys_float */
18106  /* lower limit for integration over subrange */
18107  /* of (0,1) */
18108 
18109  /* b - sys_float */
18110  /* upper limit for integration over subrange */
18111  /* of (0,1) */
18112 
18113  /* on return */
18114  /* result - sys_float */
18115  /* approximation to the integral i */
18116  /* result is computed by applying the 15-polong */
18117  /* kronrod rule(resk) obtained by optimal addition */
18118  /* of abscissae to the 7-point gauss rule(resg). */
18119 
18120  /* abserr - sys_float */
18121  /* estimate of the modulus of the absolute error, */
18122  /* which should equal or exceed fabs(i-result) */
18123 
18124  /* resabs - sys_float */
18125  /* approximation to the integral j */
18126 
18127  /* resasc - sys_float */
18128  /* approximation to the integral of */
18129  /* fabs((transformed integrand)-i/(b-a)) over (a,b) */
18130 
18131  /* ***references (none) */
18132  /* ***routines called r1mach */
18133  /* ***end prologue qk15i */
18134 
18135 
18136 
18137  /* the abscissae and weights are supplied for the interval */
18138  /* (-1,1). because of symmetry only the positive abscissae and */
18139  /* their corresponding weights are given. */
18140 
18141  /* xgk - abscissae of the 15-point kronrod rule */
18142  /* xgk(2), xgk(4), ... abscissae of the 7-polong */
18143  /* gauss rule */
18144  /* xgk(1), xgk(3), ... abscissae which are optimally */
18145  /* added to the 7-point gauss rule */
18146 
18147  /* wgk - weights of the 15-point kronrod rule */
18148 
18149  /* wg - weights of the 7-point gauss rule, corresponding */
18150  /* to the abscissae xgk(2), xgk(4), ... */
18151  /* wg(1), wg(3), ... are set to zero. */
18152 
18153 
18154 
18155 
18156 
18157  /* list of major variables */
18158  /* ----------------------- */
18159 
18160  /* centr - mid point of the interval */
18161  /* hlgth - half-length of the interval */
18162  /* absc* - abscissa */
18163  /* tabsc* - transformed abscissa */
18164  /* fval* - function value */
18165  /* resg - result of the 7-point gauss formula */
18166  /* resk - result of the 15-point kronrod formula */
18167  /* reskh - approximation to the mean value of the transformed */
18168  /* integrand over (a,b), i.e. to i/(b-a) */
18169 
18170  /* machine dependent constants */
18171  /* --------------------------- */
18172 
18173  /* epmach is the largest relative spacing. */
18174  /* uflow is the smallest positive magnitude. */
18175 
18176  /* ***first executable statement qk15i */
18177  epmach = r1mach(c__4);
18178  uflow = r1mach(c__1);
18179  dinf = (sys_float) min(1,*inf);
18180 
18181  centr = (*a + *b) * .5f;
18182  hlgth = (*b - *a) * .5f;
18183  tabsc1 = *boun + dinf * (1.f - centr) / centr;
18184  fval1 = f(tabsc1);
18185  if (*inf == 2) {
18186  r__1 = -tabsc1;
18187  fval1 += f(r__1);
18188  }
18189  fc = fval1 / centr / centr;
18190 
18191  /* compute the 15-point kronrod approximation to */
18192  /* the integral, and estimate the error. */
18193 
18194  resg = wg[7] * fc;
18195  resk = wgk[7] * fc;
18196  *resabs = fabs(resk);
18197  for (j = 1; j <= 7; ++j) {
18198  absc = hlgth * xgk[j - 1];
18199  absc1 = centr - absc;
18200  absc2 = centr + absc;
18201  tabsc1 = *boun + dinf * (1.f - absc1) / absc1;
18202  tabsc2 = *boun + dinf * (1.f - absc2) / absc2;
18203  fval1 = f(tabsc1);
18204  fval2 = f(tabsc2);
18205  if (*inf == 2) {
18206  r__1 = -tabsc1;
18207  fval1 += f(r__1);
18208  }
18209  if (*inf == 2) {
18210  r__1 = -tabsc2;
18211  fval2 += f(r__1);
18212  }
18213  fval1 = fval1 / absc1 / absc1;
18214  fval2 = fval2 / absc2 / absc2;
18215  fv1[j - 1] = fval1;
18216  fv2[j - 1] = fval2;
18217  fsum = fval1 + fval2;
18218  resg += wg[j - 1] * fsum;
18219  resk += wgk[j - 1] * fsum;
18220  *resabs += wgk[j - 1] * (fabs(fval1) + fabs(fval2));
18221  /* L10: */
18222  }
18223  reskh = resk * .5f;
18224  *resasc = wgk[7] * (r__1 = fc - reskh, fabs(r__1));
18225  for (j = 1; j <= 7; ++j) {
18226  *resasc += wgk[j - 1] * ((r__1 = fv1[j - 1] - reskh, fabs(r__1)) + (
18227  r__2 = fv2[j - 1] - reskh, fabs(r__2)));
18228  /* L20: */
18229  }
18230  *result = resk * hlgth;
18231  *resasc *= hlgth;
18232  *resabs *= hlgth;
18233  *abserr = (r__1 = (resk - resg) * hlgth, fabs(r__1));
18234  if (*resasc != 0.f && *abserr != 0.f) {
18235  /* Computing MIN */
18236  d__1 = (double) (*abserr * 200.f / *resasc);
18237  r__1 = 1.f, r__2 = pow(d__1, c_b270);
18238  *abserr = *resasc * min(r__1,r__2);
18239  }
18240  if (*resabs > uflow / (epmach * 50.f)) {
18241  /* Computing MAX */
18242  r__1 = epmach * 50.f * *resabs;
18243  *abserr = max(r__1,*abserr);
18244  }
18245  return;
18246 } /* qk15i_ */
18247 
18248 void qk15w_(const E_fp& f, E_fp1 w, const sys_float *p1, const sys_float *p2,
18249  const sys_float *p3, const sys_float *p4, const long *kp,
18250  const sys_float *a, const sys_float *b, sys_float *result,
18251  sys_float *abserr, sys_float *resabs, sys_float *resasc)
18252 {
18253  /* Initialized data */
18254 
18255  sys_float xgk[8] = { .9914553711208126f,.9491079123427585f,
18256  .8648644233597691f,.7415311855993944f,.5860872354676911f,
18257  .4058451513773972f,.2077849550078985f,0.f };
18258  sys_float wgk[8] = { .02293532201052922f,.06309209262997855f,
18259  .1047900103222502f,.1406532597155259f,.1690047266392679f,
18260  .1903505780647854f,.2044329400752989f,.2094821410847278f };
18261  sys_float wg[4] = { .1294849661688697f,.2797053914892767f,
18262  .3818300505051889f,.4179591836734694f };
18263 
18264  /* System generated locals */
18265  sys_float r__1, r__2;
18266  double d__1;
18267 
18268  /* Local variables */
18269  long j;
18270  sys_float fc, fv1[7], fv2[7];
18271  long jtw;
18272  sys_float absc, resg, resk, fsum, absc1, absc2, fval1, fval2;
18273  long jtwm1;
18274  sys_float hlgth, centr, reskh, uflow;
18275  sys_float epmach, dhlgth;
18276 
18277  /* ***begin prologue qk15w */
18278  /* ***date written 810101 (yymmdd) */
18279  /* ***revision date 830518 (mmddyy) */
18280  /* ***category no. h2a2a2 */
18281  /* ***keywords 15-point gauss-kronrod rules */
18282  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
18283  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
18284  /* ***purpose to compute i = integral of f*w over (a,b), with error */
18285  /* estimate */
18286  /* j = integral of fabs(f*w) over (a,b) */
18287  /* ***description */
18288 
18289  /* integration rules */
18290  /* standard fortran subroutine */
18291  /* sys_float version */
18292 
18293  /* parameters */
18294  /* on entry */
18295  /* f - sys_float */
18296  /* function subprogram defining the integrand */
18297  /* function f(x). the actual name for f needs to be */
18298  /* declared e x t e r n a l in the driver program. */
18299 
18300  /* w - sys_float */
18301  /* function subprogram defining the integrand */
18302  /* weight function w(x). the actual name for w */
18303  /* needs to be declared e x t e r n a l in the */
18304  /* calling program. */
18305 
18306  /* p1, p2, p3, p4 - sys_float */
18307  /* parameters in the weight function */
18308 
18309  /* kp - long */
18310  /* key for indicating the type of weight function */
18311 
18312  /* a - sys_float */
18313  /* lower limit of integration */
18314 
18315  /* b - sys_float */
18316  /* upper limit of integration */
18317 
18318  /* on return */
18319  /* result - sys_float */
18320  /* approximation to the integral i */
18321  /* result is computed by applying the 15-polong */
18322  /* kronrod rule (resk) obtained by optimal addition */
18323  /* of abscissae to the 7-point gauss rule (resg). */
18324 
18325  /* abserr - sys_float */
18326  /* estimate of the modulus of the absolute error, */
18327  /* which should equal or exceed fabs(i-result) */
18328 
18329  /* resabs - sys_float */
18330  /* approximation to the integral of fabs(f) */
18331 
18332  /* resasc - sys_float */
18333  /* approximation to the integral of fabs(f-i/(b-a)) */
18334 
18335  /* ***references (none) */
18336  /* ***routines called r1mach */
18337  /* ***end prologue qk15w */
18338 
18339 
18340 
18341  /* the abscissae and weights are given for the interval (-1,1). */
18342  /* because of symmetry only the positive abscissae and their */
18343  /* corresponding weights are given. */
18344 
18345  /* xgk - abscissae of the 15-point gauss-kronrod rule */
18346  /* xgk(2), xgk(4), ... abscissae of the 7-polong */
18347  /* gauss rule */
18348  /* xgk(1), xgk(3), ... abscissae which are optimally */
18349  /* added to the 7-point gauss rule */
18350 
18351  /* wgk - weights of the 15-point gauss-kronrod rule */
18352 
18353  /* wg - weights of the 7-point gauss rule */
18354 
18355 
18356 
18357 
18358 
18359  /* list of major variables */
18360  /* ----------------------- */
18361 
18362  /* centr - mid point of the interval */
18363  /* hlgth - half-length of the interval */
18364  /* absc* - abscissa */
18365  /* fval* - function value */
18366  /* resg - result of the 7-point gauss formula */
18367  /* resk - result of the 15-point kronrod formula */
18368  /* reskh - approximation to the mean value of f*w over (a,b), */
18369  /* i.e. to i/(b-a) */
18370 
18371  /* machine dependent constants */
18372  /* --------------------------- */
18373 
18374  /* epmach is the largest relative spacing. */
18375  /* uflow is the smallest positive magnitude. */
18376 
18377  /* ***first executable statement qk15w */
18378  epmach = r1mach(c__4);
18379  uflow = r1mach(c__1);
18380 
18381  centr = (*a + *b) * .5f;
18382  hlgth = (*b - *a) * .5f;
18383  dhlgth = fabs(hlgth);
18384 
18385  /* compute the 15-point kronrod approximation to the */
18386  /* integral, and estimate the error. */
18387 
18388  fc = f(centr) * w(&centr, p1, p2, p3, p4, kp);
18389  resg = wg[3] * fc;
18390  resk = wgk[7] * fc;
18391  *resabs = fabs(resk);
18392  for (j = 1; j <= 3; ++j) {
18393  jtw = j << 1;
18394  absc = hlgth * xgk[jtw - 1];
18395  absc1 = centr - absc;
18396  absc2 = centr + absc;
18397  fval1 = f(absc1) * w(&absc1, p1, p2, p3, p4, kp);
18398  fval2 = f(absc2) * w(&absc2, p1, p2, p3, p4, kp);
18399  fv1[jtw - 1] = fval1;
18400  fv2[jtw - 1] = fval2;
18401  fsum = fval1 + fval2;
18402  resg += wg[j - 1] * fsum;
18403  resk += wgk[jtw - 1] * fsum;
18404  *resabs += wgk[jtw - 1] * (fabs(fval1) + fabs(fval2));
18405  /* L10: */
18406  }
18407  for (j = 1; j <= 4; ++j) {
18408  jtwm1 = (j << 1) - 1;
18409  absc = hlgth * xgk[jtwm1 - 1];
18410  absc1 = centr - absc;
18411  absc2 = centr + absc;
18412  fval1 = f(absc1) * w(&absc1, p1, p2, p3, p4, kp);
18413  fval2 = f(absc2) * w(&absc2, p1, p2, p3, p4, kp);
18414  fv1[jtwm1 - 1] = fval1;
18415  fv2[jtwm1 - 1] = fval2;
18416  fsum = fval1 + fval2;
18417  resk += wgk[jtwm1 - 1] * fsum;
18418  *resabs += wgk[jtwm1 - 1] * (fabs(fval1) + fabs(fval2));
18419  /* L15: */
18420  }
18421  reskh = resk * .5f;
18422  *resasc = wgk[7] * (r__1 = fc - reskh, fabs(r__1));
18423  for (j = 1; j <= 7; ++j) {
18424  *resasc += wgk[j - 1] * ((r__1 = fv1[j - 1] - reskh, fabs(r__1)) + (
18425  r__2 = fv2[j - 1] - reskh, fabs(r__2)));
18426  /* L20: */
18427  }
18428  *result = resk * hlgth;
18429  *resabs *= dhlgth;
18430  *resasc *= dhlgth;
18431  *abserr = (r__1 = (resk - resg) * hlgth, fabs(r__1));
18432  if (*resasc != 0.f && *abserr != 0.f) {
18433  /* Computing MIN */
18434  d__1 = (double) (*abserr * 200.f / *resasc);
18435  r__1 = 1.f, r__2 = pow(d__1, c_b270);
18436  *abserr = *resasc * min(r__1,r__2);
18437  }
18438  if (*resabs > uflow / (epmach * 50.f)) {
18439  /* Computing MAX */
18440  r__1 = epmach * 50.f * *resabs;
18441  *abserr = max(r__1,*abserr);
18442  }
18443  return;
18444 } /* qk15w_ */
18445 
18446 void qk21_(const E_fp& f, const sys_float *a, const sys_float *b, sys_float *result,
18447  sys_float *abserr, sys_float *resabs, sys_float *resasc)
18448 {
18449  /* Initialized data */
18450 
18451  sys_float xgk[11] = { .9956571630258081f,.9739065285171717f,
18452  .9301574913557082f,.8650633666889845f,.7808177265864169f,
18453  .6794095682990244f,.5627571346686047f,.4333953941292472f,
18454  .2943928627014602f,.1488743389816312f,0.f };
18455  sys_float wgk[11] = { .01169463886737187f,.03255816230796473f,
18456  .054755896574352f,.07503967481091995f,.09312545458369761f,
18457  .1093871588022976f,.1234919762620659f,.1347092173114733f,
18458  .1427759385770601f,.1477391049013385f,.1494455540029169f };
18459  sys_float wg[5] = { .06667134430868814f,.1494513491505806f,
18460  .219086362515982f,.2692667193099964f,.2955242247147529f };
18461 
18462  /* System generated locals */
18463  sys_float r__1, r__2;
18464  double d__1;
18465 
18466  /* Local variables */
18467  long j;
18468  sys_float fc, fv1[10], fv2[10];
18469  long jtw;
18470  sys_float absc, resg, resk, fsum, fval1, fval2;
18471  long jtwm1;
18472  sys_float hlgth, centr, reskh, uflow;
18473  sys_float epmach, dhlgth;
18474 
18475  /* ***begin prologue qk21 */
18476  /* ***date written 800101 (yymmdd) */
18477  /* ***revision date 830518 (yymmdd) */
18478  /* ***category no. h2a1a2 */
18479  /* ***keywords 21-point gauss-kronrod rules */
18480  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
18481  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
18482  /* ***purpose to compute i = integral of f over (a,b), with error */
18483  /* estimate */
18484  /* j = integral of fabs(f) over (a,b) */
18485  /* ***description */
18486 
18487  /* integration rules */
18488  /* standard fortran subroutine */
18489  /* sys_float version */
18490 
18491  /* parameters */
18492  /* on entry */
18493  /* f - sys_float */
18494  /* function subprogram defining the integrand */
18495  /* function f(x). the actual name for f needs to be */
18496  /* declared e x t e r n a l in the driver program. */
18497 
18498  /* a - sys_float */
18499  /* lower limit of integration */
18500 
18501  /* b - sys_float */
18502  /* upper limit of integration */
18503 
18504  /* on return */
18505  /* result - sys_float */
18506  /* approximation to the integral i */
18507  /* result is computed by applying the 21-polong */
18508  /* kronrod rule (resk) obtained by optimal addition */
18509  /* of abscissae to the 10-point gauss rule (resg). */
18510 
18511  /* abserr - sys_float */
18512  /* estimate of the modulus of the absolute error, */
18513  /* which should not exceed fabs(i-result) */
18514 
18515  /* resabs - sys_float */
18516  /* approximation to the integral j */
18517 
18518  /* resasc - sys_float */
18519  /* approximation to the integral of fabs(f-i/(b-a)) */
18520  /* over (a,b) */
18521 
18522  /* ***references (none) */
18523  /* ***routines called r1mach */
18524  /* ***end prologue qk21 */
18525 
18526 
18527 
18528  /* the abscissae and weights are given for the interval (-1,1). */
18529  /* because of symmetry only the positive abscissae and their */
18530  /* corresponding weights are given. */
18531 
18532  /* xgk - abscissae of the 21-point kronrod rule */
18533  /* xgk(2), xgk(4), ... abscissae of the 10-polong */
18534  /* gauss rule */
18535  /* xgk(1), xgk(3), ... abscissae which are optimally */
18536  /* added to the 10-point gauss rule */
18537 
18538  /* wgk - weights of the 21-point kronrod rule */
18539 
18540  /* wg - weights of the 10-point gauss rule */
18541 
18542 
18543 
18544 
18545 
18546  /* list of major variables */
18547  /* ----------------------- */
18548 
18549  /* centr - mid point of the interval */
18550  /* hlgth - half-length of the interval */
18551  /* absc - abscissa */
18552  /* fval* - function value */
18553  /* resg - result of the 10-point gauss formula */
18554  /* resk - result of the 21-point kronrod formula */
18555  /* reskh - approximation to the mean value of f over (a,b), */
18556  /* i.e. to i/(b-a) */
18557 
18558 
18559  /* machine dependent constants */
18560  /* --------------------------- */
18561 
18562  /* epmach is the largest relative spacing. */
18563  /* uflow is the smallest positive magnitude. */
18564 
18565  /* ***first executable statement qk21 */
18566  epmach = r1mach(c__4);
18567  uflow = r1mach(c__1);
18568 
18569  centr = (*a + *b) * .5f;
18570  hlgth = (*b - *a) * .5f;
18571  dhlgth = fabs(hlgth);
18572 
18573  /* compute the 21-point kronrod approximation to */
18574  /* the integral, and estimate the absolute error. */
18575 
18576  resg = 0.f;
18577  fc = f(centr);
18578  resk = wgk[10] * fc;
18579  *resabs = fabs(resk);
18580  for (j = 1; j <= 5; ++j) {
18581  jtw = j << 1;
18582  absc = hlgth * xgk[jtw - 1];
18583  r__1 = centr - absc;
18584  fval1 = f(r__1);
18585  r__1 = centr + absc;
18586  fval2 = f(r__1);
18587  fv1[jtw - 1] = fval1;
18588  fv2[jtw - 1] = fval2;
18589  fsum = fval1 + fval2;
18590  resg += wg[j - 1] * fsum;
18591  resk += wgk[jtw - 1] * fsum;
18592  *resabs += wgk[jtw - 1] * (fabs(fval1) + fabs(fval2));
18593  /* L10: */
18594  }
18595  for (j = 1; j <= 5; ++j) {
18596  jtwm1 = (j << 1) - 1;
18597  absc = hlgth * xgk[jtwm1 - 1];
18598  r__1 = centr - absc;
18599  fval1 = f(r__1);
18600  r__1 = centr + absc;
18601  fval2 = f(r__1);
18602  fv1[jtwm1 - 1] = fval1;
18603  fv2[jtwm1 - 1] = fval2;
18604  fsum = fval1 + fval2;
18605  resk += wgk[jtwm1 - 1] * fsum;
18606  *resabs += wgk[jtwm1 - 1] * (fabs(fval1) + fabs(fval2));
18607  /* L15: */
18608  }
18609  reskh = resk * .5f;
18610  *resasc = wgk[10] * (r__1 = fc - reskh, fabs(r__1));
18611  for (j = 1; j <= 10; ++j) {
18612  *resasc += wgk[j - 1] * ((r__1 = fv1[j - 1] - reskh, fabs(r__1)) + (
18613  r__2 = fv2[j - 1] - reskh, fabs(r__2)));
18614  /* L20: */
18615  }
18616  *result = resk * hlgth;
18617  *resabs *= dhlgth;
18618  *resasc *= dhlgth;
18619  *abserr = (r__1 = (resk - resg) * hlgth, fabs(r__1));
18620  if (*resasc != 0.f && *abserr != 0.f) {
18621  /* Computing MIN */
18622  d__1 = (double) (*abserr * 200.f / *resasc);
18623  r__1 = 1.f, r__2 = pow(d__1, c_b270);
18624  *abserr = *resasc * min(r__1,r__2);
18625  }
18626  if (*resabs > uflow / (epmach * 50.f)) {
18627  /* Computing MAX */
18628  r__1 = epmach * 50.f * *resabs;
18629  *abserr = max(r__1,*abserr);
18630  }
18631  return;
18632 } /* qk21_ */
18633 
18634 void qk31_(const E_fp& f, const sys_float *a, const sys_float *b, sys_float *result,
18635  sys_float *abserr, sys_float *resabs, sys_float *resasc)
18636 {
18637  /* Initialized data */
18638 
18639  sys_float xgk[16] = { .9980022986933971f,.9879925180204854f,
18640  .9677390756791391f,.9372733924007059f,.8972645323440819f,
18641  .8482065834104272f,.7904185014424659f,.72441773136017f,
18642  .650996741297417f,.5709721726085388f,.4850818636402397f,
18643  .3941513470775634f,.2991800071531688f,.2011940939974345f,
18644  .1011420669187175f,0.f };
18645  sys_float wgk[16] = { .005377479872923349f,.01500794732931612f,
18646  .02546084732671532f,.03534636079137585f,.04458975132476488f,
18647  .05348152469092809f,.06200956780067064f,.06985412131872826f,
18648  .07684968075772038f,.08308050282313302f,.08856444305621177f,
18649  .09312659817082532f,.09664272698362368f,.09917359872179196f,
18650  .1007698455238756f,.1013300070147915f };
18651  sys_float wg[8] = { .03075324199611727f,.07036604748810812f,
18652  .1071592204671719f,.1395706779261543f,.1662692058169939f,
18653  .1861610000155622f,.1984314853271116f,.2025782419255613f };
18654 
18655  /* System generated locals */
18656  sys_float r__1, r__2;
18657  double d__1;
18658 
18659  /* Local variables */
18660  long j;
18661  sys_float fc, fv1[15], fv2[15];
18662  long jtw;
18663  sys_float absc, resg, resk, fsum, fval1, fval2;
18664  long jtwm1;
18665  sys_float hlgth, centr, reskh, uflow;
18666  sys_float epmach, dhlgth;
18667 
18668  /* ***begin prologue qk31 */
18669  /* ***date written 800101 (yymmdd) */
18670  /* ***revision date 830518 (yymmdd) */
18671  /* ***category no. h2a1a2 */
18672  /* ***keywords 31-point gauss-kronrod rules */
18673  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
18674  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
18675  /* ***purpose to compute i = integral of f over (a,b) with error */
18676  /* estimate */
18677  /* j = integral of fabs(f) over (a,b) */
18678  /* ***description */
18679 
18680  /* integration rules */
18681  /* standard fortran subroutine */
18682  /* sys_float version */
18683 
18684  /* parameters */
18685  /* on entry */
18686  /* f - sys_float */
18687  /* function subprogram defining the integrand */
18688  /* function f(x). the actual name for f needs to be */
18689  /* declared e x t e r n a l in the calling program. */
18690 
18691  /* a - sys_float */
18692  /* lower limit of integration */
18693 
18694  /* b - sys_float */
18695  /* upper limit of integration */
18696 
18697  /* on return */
18698  /* result - sys_float */
18699  /* approximation to the integral i */
18700  /* result is computed by applying the 31-polong */
18701  /* gauss-kronrod rule (resk), obtained by optimal */
18702  /* addition of abscissae to the 15-point gauss */
18703  /* rule (resg). */
18704 
18705  /* abserr - sys_float */
18706  /* estimate of the modulus of the modulus, */
18707  /* which should not exceed fabs(i-result) */
18708 
18709  /* resabs - sys_float */
18710  /* approximation to the integral j */
18711 
18712  /* resasc - sys_float */
18713  /* approximation to the integral of fabs(f-i/(b-a)) */
18714  /* over (a,b) */
18715 
18716  /* ***references (none) */
18717  /* ***routines called r1mach */
18718  /* ***end prologue qk31 */
18719 
18720 
18721  /* the abscissae and weights are given for the interval (-1,1). */
18722  /* because of symmetry only the positive abscissae and their */
18723  /* corresponding weights are given. */
18724 
18725  /* xgk - abscissae of the 31-point kronrod rule */
18726  /* xgk(2), xgk(4), ... abscissae of the 15-polong */
18727  /* gauss rule */
18728  /* xgk(1), xgk(3), ... abscissae which are optimally */
18729  /* added to the 15-point gauss rule */
18730 
18731  /* wgk - weights of the 31-point kronrod rule */
18732 
18733  /* wg - weights of the 15-point gauss rule */
18734 
18735 
18736 
18737  /* list of major variables */
18738  /* ----------------------- */
18739  /* centr - mid point of the interval */
18740  /* hlgth - half-length of the interval */
18741  /* absc - abscissa */
18742  /* fval* - function value */
18743  /* resg - result of the 15-point gauss formula */
18744  /* resk - result of the 31-point kronrod formula */
18745  /* reskh - approximation to the mean value of f over (a,b), */
18746  /* i.e. to i/(b-a) */
18747 
18748  /* machine dependent constants */
18749  /* --------------------------- */
18750  /* epmach is the largest relative spacing. */
18751  /* uflow is the smallest positive magnitude. */
18752 
18753  /* ***first executable statement qk31 */
18754  epmach = r1mach(c__4);
18755  uflow = r1mach(c__1);
18756 
18757  centr = (*a + *b) * .5f;
18758  hlgth = (*b - *a) * .5f;
18759  dhlgth = fabs(hlgth);
18760 
18761  /* compute the 31-point kronrod approximation to */
18762  /* the integral, and estimate the absolute error. */
18763 
18764  fc = f(centr);
18765  resg = wg[7] * fc;
18766  resk = wgk[15] * fc;
18767  *resabs = fabs(resk);
18768  for (j = 1; j <= 7; ++j) {
18769  jtw = j << 1;
18770  absc = hlgth * xgk[jtw - 1];
18771  r__1 = centr - absc;
18772  fval1 = f(r__1);
18773  r__1 = centr + absc;
18774  fval2 = f(r__1);
18775  fv1[jtw - 1] = fval1;
18776  fv2[jtw - 1] = fval2;
18777  fsum = fval1 + fval2;
18778  resg += wg[j - 1] * fsum;
18779  resk += wgk[jtw - 1] * fsum;
18780  *resabs += wgk[jtw - 1] * (fabs(fval1) + fabs(fval2));
18781  /* L10: */
18782  }
18783  for (j = 1; j <= 8; ++j) {
18784  jtwm1 = (j << 1) - 1;
18785  absc = hlgth * xgk[jtwm1 - 1];
18786  r__1 = centr - absc;
18787  fval1 = f(r__1);
18788  r__1 = centr + absc;
18789  fval2 = f(r__1);
18790  fv1[jtwm1 - 1] = fval1;
18791  fv2[jtwm1 - 1] = fval2;
18792  fsum = fval1 + fval2;
18793  resk += wgk[jtwm1 - 1] * fsum;
18794  *resabs += wgk[jtwm1 - 1] * (fabs(fval1) + fabs(fval2));
18795  /* L15: */
18796  }
18797  reskh = resk * .5f;
18798  *resasc = wgk[15] * (r__1 = fc - reskh, fabs(r__1));
18799  for (j = 1; j <= 15; ++j) {
18800  *resasc += wgk[j - 1] * ((r__1 = fv1[j - 1] - reskh, fabs(r__1)) + (
18801  r__2 = fv2[j - 1] - reskh, fabs(r__2)));
18802  /* L20: */
18803  }
18804  *result = resk * hlgth;
18805  *resabs *= dhlgth;
18806  *resasc *= dhlgth;
18807  *abserr = (r__1 = (resk - resg) * hlgth, fabs(r__1));
18808  if (*resasc != 0.f && *abserr != 0.f) {
18809  /* Computing MIN */
18810  d__1 = (double) (*abserr * 200.f / *resasc);
18811  r__1 = 1.f, r__2 = pow(d__1, c_b270);
18812  *abserr = *resasc * min(r__1,r__2);
18813  }
18814  if (*resabs > uflow / (epmach * 50.f)) {
18815  /* Computing MAX */
18816  r__1 = epmach * 50.f * *resabs;
18817  *abserr = max(r__1,*abserr);
18818  }
18819  return;
18820 } /* qk31_ */
18821 
18822 void qk41_(const E_fp& f, const sys_float *a, const sys_float *b, sys_float *result,
18823  sys_float *abserr, sys_float *resabs, sys_float *resasc)
18824 {
18825  /* Initialized data */
18826 
18827  sys_float xgk[21] = { .9988590315882777f,.9931285991850949f,
18828  .9815078774502503f,.9639719272779138f,.9408226338317548f,
18829  .9122344282513259f,.878276811252282f,.8391169718222188f,
18830  .7950414288375512f,.7463319064601508f,.6932376563347514f,
18831  .636053680726515f,.5751404468197103f,.5108670019508271f,
18832  .4435931752387251f,.3737060887154196f,.301627868114913f,
18833  .2277858511416451f,.1526054652409227f,.07652652113349733f,0.f };
18834  sys_float wgk[21] = { .003073583718520532f,.008600269855642942f,
18835  .01462616925697125f,.02038837346126652f,.02588213360495116f,
18836  .0312873067770328f,.0366001697582008f,.04166887332797369f,
18837  .04643482186749767f,.05094457392372869f,.05519510534828599f,
18838  .05911140088063957f,.06265323755478117f,.06583459713361842f,
18839  .06864867292852162f,.07105442355344407f,.07303069033278667f,
18840  .07458287540049919f,.07570449768455667f,.07637786767208074f,
18841  .07660071191799966f };
18842  sys_float wg[10] = { .01761400713915212f,.04060142980038694f,
18843  .06267204833410906f,.08327674157670475f,.1019301198172404f,
18844  .1181945319615184f,.1316886384491766f,.1420961093183821f,
18845  .1491729864726037f,.1527533871307259f };
18846 
18847  /* System generated locals */
18848  sys_float r__1, r__2;
18849  double d__1;
18850 
18851  /* Local variables */
18852  long j;
18853  sys_float fc, fv1[20], fv2[20];
18854  long jtw;
18855  sys_float absc, resg, resk, fsum, fval1, fval2;
18856  long jtwm1;
18857  sys_float hlgth, centr, reskh, uflow;
18858  sys_float epmach, dhlgth;
18859 
18860  /* ***begin prologue qk41 */
18861  /* ***date written 800101 (yymmdd) */
18862  /* ***revision date 830518 (yymmdd) */
18863  /* ***category no. h2a1a2 */
18864  /* ***keywords 41-point gauss-kronrod rules */
18865  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
18866  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
18867  /* ***purpose to compute i = integral of f over (a,b), with error */
18868  /* estimate */
18869  /* j = integral of fabs(f) over (a,b) */
18870  /* ***description */
18871 
18872  /* integration rules */
18873  /* standard fortran subroutine */
18874  /* sys_float version */
18875 
18876  /* parameters */
18877  /* on entry */
18878  /* f - sys_float */
18879  /* function subprogram defining the integrand */
18880  /* function f(x). the actual name for f needs to be */
18881  /* declared e x t e r n a l in the calling program. */
18882 
18883  /* a - sys_float */
18884  /* lower limit of integration */
18885 
18886  /* b - sys_float */
18887  /* upper limit of integration */
18888 
18889  /* on return */
18890  /* result - sys_float */
18891  /* approximation to the integral i */
18892  /* result is computed by applying the 41-polong */
18893  /* gauss-kronrod rule (resk) obtained by optimal */
18894  /* addition of abscissae to the 20-point gauss */
18895  /* rule (resg). */
18896 
18897  /* abserr - sys_float */
18898  /* estimate of the modulus of the absolute error, */
18899  /* which should not exceed fabs(i-result) */
18900 
18901  /* resabs - sys_float */
18902  /* approximation to the integral j */
18903 
18904  /* resasc - sys_float */
18905  /* approximation to the integal of fabs(f-i/(b-a)) */
18906  /* over (a,b) */
18907 
18908  /* ***references (none) */
18909  /* ***routines called r1mach */
18910  /* ***end prologue qk41 */
18911 
18912 
18913 
18914  /* the abscissae and weights are given for the interval (-1,1). */
18915  /* because of symmetry only the positive abscissae and their */
18916  /* corresponding weights are given. */
18917 
18918  /* xgk - abscissae of the 41-point gauss-kronrod rule */
18919  /* xgk(2), xgk(4), ... abscissae of the 20-polong */
18920  /* gauss rule */
18921  /* xgk(1), xgk(3), ... abscissae which are optimally */
18922  /* added to the 20-point gauss rule */
18923 
18924  /* wgk - weights of the 41-point gauss-kronrod rule */
18925 
18926  /* wg - weights of the 20-point gauss rule */
18927 
18928 
18929 
18930  /* list of major variables */
18931  /* ----------------------- */
18932 
18933  /* centr - mid point of the interval */
18934  /* hlgth - half-length of the interval */
18935  /* absc - abscissa */
18936  /* fval* - function value */
18937  /* resg - result of the 20-point gauss formula */
18938  /* resk - result of the 41-point kronrod formula */
18939  /* reskh - approximation to mean value of f over (a,b), i.e. */
18940  /* to i/(b-a) */
18941 
18942  /* machine dependent constants */
18943  /* --------------------------- */
18944 
18945  /* epmach is the largest relative spacing. */
18946  /* uflow is the smallest positive magnitude. */
18947 
18948  /* ***first executable statement qk41 */
18949  epmach = r1mach(c__4);
18950  uflow = r1mach(c__1);
18951 
18952  centr = (*a + *b) * .5f;
18953  hlgth = (*b - *a) * .5f;
18954  dhlgth = fabs(hlgth);
18955 
18956  /* compute the 41-point gauss-kronrod approximation to */
18957  /* the integral, and estimate the absolute error. */
18958 
18959  resg = 0.f;
18960  fc = f(centr);
18961  resk = wgk[20] * fc;
18962  *resabs = fabs(resk);
18963  for (j = 1; j <= 10; ++j) {
18964  jtw = j << 1;
18965  absc = hlgth * xgk[jtw - 1];
18966  r__1 = centr - absc;
18967  fval1 = f(r__1);
18968  r__1 = centr + absc;
18969  fval2 = f(r__1);
18970  fv1[jtw - 1] = fval1;
18971  fv2[jtw - 1] = fval2;
18972  fsum = fval1 + fval2;
18973  resg += wg[j - 1] * fsum;
18974  resk += wgk[jtw - 1] * fsum;
18975  *resabs += wgk[jtw - 1] * (fabs(fval1) + fabs(fval2));
18976  /* L10: */
18977  }
18978  for (j = 1; j <= 10; ++j) {
18979  jtwm1 = (j << 1) - 1;
18980  absc = hlgth * xgk[jtwm1 - 1];
18981  r__1 = centr - absc;
18982  fval1 = f(r__1);
18983  r__1 = centr + absc;
18984  fval2 = f(r__1);
18985  fv1[jtwm1 - 1] = fval1;
18986  fv2[jtwm1 - 1] = fval2;
18987  fsum = fval1 + fval2;
18988  resk += wgk[jtwm1 - 1] * fsum;
18989  *resabs += wgk[jtwm1 - 1] * (fabs(fval1) + fabs(fval2));
18990  /* L15: */
18991  }
18992  reskh = resk * .5f;
18993  *resasc = wgk[20] * (r__1 = fc - reskh, fabs(r__1));
18994  for (j = 1; j <= 20; ++j) {
18995  *resasc += wgk[j - 1] * ((r__1 = fv1[j - 1] - reskh, fabs(r__1)) + (
18996  r__2 = fv2[j - 1] - reskh, fabs(r__2)));
18997  /* L20: */
18998  }
18999  *result = resk * hlgth;
19000  *resabs *= dhlgth;
19001  *resasc *= dhlgth;
19002  *abserr = (r__1 = (resk - resg) * hlgth, fabs(r__1));
19003  if (*resasc != 0.f && *abserr != 0.f) {
19004  /* Computing MIN */
19005  d__1 = (double) (*abserr * 200.f / *resasc);
19006  r__1 = 1.f, r__2 = pow(d__1, c_b270);
19007  *abserr = *resasc * min(r__1,r__2);
19008  }
19009  if (*resabs > uflow / (epmach * 50.f)) {
19010  /* Computing MAX */
19011  r__1 = epmach * 50.f * *resabs;
19012  *abserr = max(r__1,*abserr);
19013  }
19014  return;
19015 } /* qk41_ */
19016 
19017 void qk51_(const E_fp& f, const sys_float *a, const sys_float *b, sys_float *result,
19018  sys_float *abserr, sys_float *resabs, sys_float *resasc)
19019 {
19020  /* Initialized data */
19021 
19022  sys_float xgk[26] = { .9992621049926098f,.9955569697904981f,
19023  .9880357945340772f,.9766639214595175f,.9616149864258425f,
19024  .9429745712289743f,.9207471152817016f,.8949919978782754f,
19025  .8658470652932756f,.833442628760834f,.7978737979985001f,
19026  .7592592630373576f,.7177664068130844f,.6735663684734684f,
19027  .6268100990103174f,.577662930241223f,.5263252843347192f,
19028  .473002731445715f,.4178853821930377f,.3611723058093878f,
19029  .3030895389311078f,.2438668837209884f,.1837189394210489f,
19030  .1228646926107104f,.06154448300568508f,0.f };
19031  sys_float wgk[26] = { .001987383892330316f,.005561932135356714f,
19032  .009473973386174152f,.01323622919557167f,.0168478177091283f,
19033  .02043537114588284f,.02400994560695322f,.02747531758785174f,
19034  .03079230016738749f,.03400213027432934f,.03711627148341554f,
19035  .04008382550403238f,.04287284502017005f,.04550291304992179f,
19036  .04798253713883671f,.05027767908071567f,.05236288580640748f,
19037  .05425112988854549f,.05595081122041232f,.05743711636156783f,
19038  .05868968002239421f,.05972034032417406f,.06053945537604586f,
19039  .06112850971705305f,.06147118987142532f,.06158081806783294f };
19040  sys_float wg[13] = { .01139379850102629f,.02635498661503214f,
19041  .04093915670130631f,.05490469597583519f,.06803833381235692f,
19042  .08014070033500102f,.09102826198296365f,.1005359490670506f,
19043  .1085196244742637f,.1148582591457116f,.1194557635357848f,
19044  .12224244299031f,.1231760537267155f };
19045 
19046  /* System generated locals */
19047  sys_float r__1, r__2;
19048  double d__1;
19049 
19050  /* Local variables */
19051  long j;
19052  sys_float fc, fv1[25], fv2[25];
19053  long jtw;
19054  sys_float absc, resg, resk, fsum, fval1, fval2;
19055  long jtwm1;
19056  sys_float hlgth, centr, reskh, uflow;
19057  sys_float epmach, dhlgth;
19058 
19059  /* ***begin prologue qk51 */
19060  /* ***date written 800101 (yymmdd) */
19061  /* ***revision date 830518 (yymmdd) */
19062  /* ***category no. h2a1a2 */
19063  /* ***keywords 51-point gauss-kronrod rules */
19064  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
19065  /* de doncker,elise,appl. math & progr. div. - k.u.leuven */
19066  /* ***purpose to compute i = integral of f over (a,b) with error */
19067  /* estimate */
19068  /* j = integral of fabs(f) over (a,b) */
19069  /* ***description */
19070 
19071  /* integration rules */
19072  /* standard fortran subroutine */
19073  /* sys_float version */
19074 
19075  /* parameters */
19076  /* on entry */
19077  /* f - sys_float */
19078  /* function subroutine defining the integrand */
19079  /* function f(x). the actual name for f needs to be */
19080  /* declared e x t e r n a l in the calling program. */
19081 
19082  /* a - sys_float */
19083  /* lower limit of integration */
19084 
19085  /* b - sys_float */
19086  /* upper limit of integration */
19087 
19088  /* on return */
19089  /* result - sys_float */
19090  /* approximation to the integral i */
19091  /* result is computed by applying the 51-polong */
19092  /* kronrod rule (resk) obtained by optimal addition */
19093  /* of abscissae to the 25-point gauss rule (resg). */
19094 
19095  /* abserr - sys_float */
19096  /* estimate of the modulus of the absolute error, */
19097  /* which should not exceed fabs(i-result) */
19098 
19099  /* resabs - sys_float */
19100  /* approximation to the integral j */
19101 
19102  /* resasc - sys_float */
19103  /* approximation to the integral of fabs(f-i/(b-a)) */
19104  /* over (a,b) */
19105 
19106  /* ***references (none) */
19107  /* ***routines called r1mach */
19108  /* ***end prologue qk51 */
19109 
19110 
19111 
19112  /* the abscissae and weights are given for the interval (-1,1). */
19113  /* because of symmetry only the positive abscissae and their */
19114  /* corresponding weights are given. */
19115 
19116  /* xgk - abscissae of the 51-point kronrod rule */
19117  /* xgk(2), xgk(4), ... abscissae of the 25-polong */
19118  /* gauss rule */
19119  /* xgk(1), xgk(3), ... abscissae which are optimally */
19120  /* added to the 25-point gauss rule */
19121 
19122  /* wgk - weights of the 51-point kronrod rule */
19123 
19124  /* wg - weights of the 25-point gauss rule */
19125 
19126 
19127 
19128  /* list of major variables */
19129  /* ----------------------- */
19130 
19131  /* centr - mid point of the interval */
19132  /* hlgth - half-length of the interval */
19133  /* absc - abscissa */
19134  /* fval* - function value */
19135  /* resg - result of the 25-point gauss formula */
19136  /* resk - result of the 51-point kronrod formula */
19137  /* reskh - approximation to the mean value of f over (a,b), */
19138  /* i.e. to i/(b-a) */
19139 
19140  /* machine dependent constants */
19141  /* --------------------------- */
19142 
19143  /* epmach is the largest relative spacing. */
19144  /* uflow is the smallest positive magnitude. */
19145 
19146  /* ***first executable statement qk51 */
19147  epmach = r1mach(c__4);
19148  uflow = r1mach(c__1);
19149 
19150  centr = (*a + *b) * .5f;
19151  hlgth = (*b - *a) * .5f;
19152  dhlgth = fabs(hlgth);
19153 
19154  /* compute the 51-point kronrod approximation to */
19155  /* the integral, and estimate the absolute error. */
19156 
19157  fc = f(centr);
19158  resg = wg[12] * fc;
19159  resk = wgk[25] * fc;
19160  *resabs = fabs(resk);
19161  for (j = 1; j <= 12; ++j) {
19162  jtw = j << 1;
19163  absc = hlgth * xgk[jtw - 1];
19164  r__1 = centr - absc;
19165  fval1 = f(r__1);
19166  r__1 = centr + absc;
19167  fval2 = f(r__1);
19168  fv1[jtw - 1] = fval1;
19169  fv2[jtw - 1] = fval2;
19170  fsum = fval1 + fval2;
19171  resg += wg[j - 1] * fsum;
19172  resk += wgk[jtw - 1] * fsum;
19173  *resabs += wgk[jtw - 1] * (fabs(fval1) + fabs(fval2));
19174  /* L10: */
19175  }
19176  for (j = 1; j <= 13; ++j) {
19177  jtwm1 = (j << 1) - 1;
19178  absc = hlgth * xgk[jtwm1 - 1];
19179  r__1 = centr - absc;
19180  fval1 = f(r__1);
19181  r__1 = centr + absc;
19182  fval2 = f(r__1);
19183  fv1[jtwm1 - 1] = fval1;
19184  fv2[jtwm1 - 1] = fval2;
19185  fsum = fval1 + fval2;
19186  resk += wgk[jtwm1 - 1] * fsum;
19187  *resabs += wgk[jtwm1 - 1] * (fabs(fval1) + fabs(fval2));
19188  /* L15: */
19189  }
19190  reskh = resk * .5f;
19191  *resasc = wgk[25] * (r__1 = fc - reskh, fabs(r__1));
19192  for (j = 1; j <= 25; ++j) {
19193  *resasc += wgk[j - 1] * ((r__1 = fv1[j - 1] - reskh, fabs(r__1)) + (
19194  r__2 = fv2[j - 1] - reskh, fabs(r__2)));
19195  /* L20: */
19196  }
19197  *result = resk * hlgth;
19198  *resabs *= dhlgth;
19199  *resasc *= dhlgth;
19200  *abserr = (r__1 = (resk - resg) * hlgth, fabs(r__1));
19201  if (*resasc != 0.f && *abserr != 0.f) {
19202  /* Computing MIN */
19203  d__1 = (double) (*abserr * 200.f / *resasc);
19204  r__1 = 1.f, r__2 = pow(d__1, c_b270);
19205  *abserr = *resasc * min(r__1,r__2);
19206  }
19207  if (*resabs > uflow / (epmach * 50.f)) {
19208  /* Computing MAX */
19209  r__1 = epmach * 50.f * *resabs;
19210  *abserr = max(r__1,*abserr);
19211  }
19212  return;
19213 } /* qk51_ */
19214 
19215 void qk61_(const E_fp& f, const sys_float *a, const sys_float *b, sys_float *result,
19216  sys_float *abserr, sys_float *resabs, sys_float *resasc)
19217 {
19218  /* Initialized data */
19219 
19220  sys_float xgk[31] = { .9994844100504906f,.9968934840746495f,
19221  .9916309968704046f,.9836681232797472f,.9731163225011263f,
19222  .9600218649683075f,.94437444474856f,.9262000474292743f,
19223  .9055733076999078f,.8825605357920527f,.8572052335460611f,
19224  .8295657623827684f,.7997278358218391f,.7677774321048262f,
19225  .7337900624532268f,.6978504947933158f,.660061064126627f,
19226  .6205261829892429f,.5793452358263617f,.5366241481420199f,
19227  .4924804678617786f,.4470337695380892f,.4004012548303944f,
19228  .3527047255308781f,.3040732022736251f,.2546369261678898f,
19229  .2045251166823099f,.1538699136085835f,.102806937966737f,
19230  .0514718425553177f,0.f };
19231  sys_float wgk[31] = { .001389013698677008f,.003890461127099884f,
19232  .006630703915931292f,.009273279659517763f,.01182301525349634f,
19233  .0143697295070458f,.01692088918905327f,.01941414119394238f,
19234  .02182803582160919f,.0241911620780806f,.0265099548823331f,
19235  .02875404876504129f,.03090725756238776f,.03298144705748373f,
19236  .03497933802806002f,.03688236465182123f,.03867894562472759f,
19237  .04037453895153596f,.04196981021516425f,.04345253970135607f,
19238  .04481480013316266f,.04605923827100699f,.04718554656929915f,
19239  .04818586175708713f,.04905543455502978f,.04979568342707421f,
19240  .05040592140278235f,.05088179589874961f,.05122154784925877f,
19241  .05142612853745903f,.05149472942945157f };
19242  sys_float wg[15] = { .007968192496166606f,.01846646831109096f,
19243  .02878470788332337f,.03879919256962705f,.04840267283059405f,
19244  .05749315621761907f,.0659742298821805f,.07375597473770521f,
19245  .08075589522942022f,.08689978720108298f,.09212252223778613f,
19246  .09636873717464426f,.09959342058679527f,.1017623897484055f,
19247  .1028526528935588f };
19248 
19249  /* System generated locals */
19250  sys_float r__1, r__2;
19251  double d__1;
19252 
19253  /* Local variables */
19254  long j;
19255  sys_float fc, fv1[30], fv2[30];
19256  long jtw;
19257  sys_float absc, resg, resk, fsum, fval1, fval2;
19258  long jtwm1;
19259  sys_float hlgth, centr, reskh, uflow;
19260  sys_float epmach, dhlgth;
19261 
19262  /* ***begin prologue qk61 */
19263  /* ***date written 800101 (yymmdd) */
19264  /* ***revision date 830518 (yymmdd) */
19265  /* ***category no. h2a1a2 */
19266  /* ***keywords 61-point gauss-kronrod rules */
19267  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
19268  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
19269  /* ***purpose to compute i = integral of f over (a,b) with error */
19270  /* estimate */
19271  /* j = integral of fabs(f) over (a,b) */
19272  /* ***description */
19273 
19274  /* integration rule */
19275  /* standard fortran subroutine */
19276  /* sys_float version */
19277 
19278 
19279  /* parameters */
19280  /* on entry */
19281  /* f - sys_float */
19282  /* function subprogram defining the integrand */
19283  /* function f(x). the actual name for f needs to be */
19284  /* declared e x t e r n a l in the calling program. */
19285 
19286  /* a - sys_float */
19287  /* lower limit of integration */
19288 
19289  /* b - sys_float */
19290  /* upper limit of integration */
19291 
19292  /* on return */
19293  /* result - sys_float */
19294  /* approximation to the integral i */
19295  /* result is computed by applying the 61-polong */
19296  /* kronrod rule (resk) obtained by optimal addition of */
19297  /* abscissae to the 30-point gauss rule (resg). */
19298 
19299  /* abserr - sys_float */
19300  /* estimate of the modulus of the absolute error, */
19301  /* which should equal or exceed fabs(i-result) */
19302 
19303  /* resabs - sys_float */
19304  /* approximation to the integral j */
19305 
19306  /* resasc - sys_float */
19307  /* approximation to the integral of fabs(f-i/(b-a)) */
19308 
19309 
19310  /* ***references (none) */
19311  /* ***routines called r1mach */
19312  /* ***end prologue qk61 */
19313 
19314 
19315 
19316  /* the abscissae and weights are given for the */
19317  /* interval (-1,1). because of symmetry only the positive */
19318  /* abscissae and their corresponding weights are given. */
19319 
19320  /* xgk - abscissae of the 61-point kronrod rule */
19321  /* xgk(2), xgk(4) ... abscissae of the 30-polong */
19322  /* gauss rule */
19323  /* xgk(1), xgk(3) ... optimally added abscissae */
19324  /* to the 30-point gauss rule */
19325 
19326  /* wgk - weights of the 61-point kronrod rule */
19327 
19328  /* wg - weigths of the 30-point gauss rule */
19329 
19330 
19331  /* list of major variables */
19332  /* ----------------------- */
19333 
19334  /* centr - mid point of the interval */
19335  /* hlgth - half-length of the interval */
19336  /* absc - abscissa */
19337  /* fval* - function value */
19338  /* resg - result of the 30-point gauss rule */
19339  /* resk - result of the 61-point kronrod rule */
19340  /* reskh - approximation to the mean value of f */
19341  /* over (a,b), i.e. to i/(b-a) */
19342 
19343  /* machine dependent constants */
19344  /* --------------------------- */
19345 
19346  /* epmach is the largest relative spacing. */
19347  /* uflow is the smallest positive magnitude. */
19348 
19349  /* ***first executable statement qk61 */
19350  epmach = r1mach(c__4);
19351  uflow = r1mach(c__1);
19352 
19353  centr = (*b + *a) * .5f;
19354  hlgth = (*b - *a) * .5f;
19355  dhlgth = fabs(hlgth);
19356 
19357  /* compute the 61-point kronrod approximation to the */
19358  /* integral, and estimate the absolute error. */
19359 
19360  resg = 0.f;
19361  fc = f(centr);
19362  resk = wgk[30] * fc;
19363  *resabs = fabs(resk);
19364  for (j = 1; j <= 15; ++j) {
19365  jtw = j << 1;
19366  absc = hlgth * xgk[jtw - 1];
19367  r__1 = centr - absc;
19368  fval1 = f(r__1);
19369  r__1 = centr + absc;
19370  fval2 = f(r__1);
19371  fv1[jtw - 1] = fval1;
19372  fv2[jtw - 1] = fval2;
19373  fsum = fval1 + fval2;
19374  resg += wg[j - 1] * fsum;
19375  resk += wgk[jtw - 1] * fsum;
19376  *resabs += wgk[jtw - 1] * (fabs(fval1) + fabs(fval2));
19377  /* L10: */
19378  }
19379  for (j = 1; j <= 15; ++j) {
19380  jtwm1 = (j << 1) - 1;
19381  absc = hlgth * xgk[jtwm1 - 1];
19382  r__1 = centr - absc;
19383  fval1 = f(r__1);
19384  r__1 = centr + absc;
19385  fval2 = f(r__1);
19386  fv1[jtwm1 - 1] = fval1;
19387  fv2[jtwm1 - 1] = fval2;
19388  fsum = fval1 + fval2;
19389  resk += wgk[jtwm1 - 1] * fsum;
19390  *resabs += wgk[jtwm1 - 1] * (fabs(fval1) + fabs(fval2));
19391  /* L15: */
19392  }
19393  reskh = resk * .5f;
19394  *resasc = wgk[30] * (r__1 = fc - reskh, fabs(r__1));
19395  for (j = 1; j <= 30; ++j) {
19396  *resasc += wgk[j - 1] * ((r__1 = fv1[j - 1] - reskh, fabs(r__1)) + (
19397  r__2 = fv2[j - 1] - reskh, fabs(r__2)));
19398  /* L20: */
19399  }
19400  *result = resk * hlgth;
19401  *resabs *= dhlgth;
19402  *resasc *= dhlgth;
19403  *abserr = (r__1 = (resk - resg) * hlgth, fabs(r__1));
19404  if (*resasc != 0.f && *abserr != 0.f) {
19405  /* Computing MIN */
19406  d__1 = (double) (*abserr * 200.f / *resasc);
19407  r__1 = 1.f, r__2 = pow(d__1, c_b270);
19408  *abserr = *resasc * min(r__1,r__2);
19409  }
19410  if (*resabs > uflow / (epmach * 50.f)) {
19411  /* Computing MAX */
19412  r__1 = epmach * 50.f * *resabs;
19413  *abserr = max(r__1,*abserr);
19414  }
19415  return;
19416 } /* qk61_ */
19417 
19418 void qmomo_(const sys_float *alfa, const sys_float *beta, sys_float *ri,
19419  sys_float *rj, sys_float *rg, sys_float *rh, const long *integr)
19420 {
19421  /* System generated locals */
19422  double d__1;
19423 
19424  /* Local variables */
19425  long i__;
19426  sys_float an;
19427  long im1;
19428  sys_float anm1, ralf, rbet, alfp1, alfp2, betp1, betp2;
19429 
19430  /* ***begin prologue qmomo */
19431  /* ***date written 810101 (yymmdd) */
19432  /* ***revision date 830518 (yymmdd) */
19433  /* ***category no. h2a2a1,c3a2 */
19434  /* ***keywords modified chebyshev moments */
19435  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
19436  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
19437  /* ***purpose this routine computes modified chebsyshev moments. the k-th */
19438  /* modified chebyshev moment is defined as the integral over */
19439  /* (-1,1) of w(x)*t(k,x), where t(k,x) is the chebyshev */
19440  /* polynomial of degree k. */
19441  /* ***description */
19442 
19443  /* modified chebyshev moments */
19444  /* standard fortran subroutine */
19445  /* sys_float version */
19446 
19447  /* parameters */
19448  /* alfa - sys_float */
19449  /* parameter in the weight function w(x), alfa.gt.(-1) */
19450 
19451  /* beta - sys_float */
19452  /* parameter in the weight function w(x), beta.gt.(-1) */
19453 
19454  /* ri - sys_float */
19455  /* vector of dimension 25 */
19456  /* ri(k) is the integral over (-1,1) of */
19457  /* (1+x)**alfa*t(k-1,x), k = 1, ..., 25. */
19458 
19459  /* rj - sys_float */
19460  /* vector of dimension 25 */
19461  /* rj(k) is the integral over (-1,1) of */
19462  /* (1-x)**beta*t(k-1,x), k = 1, ..., 25. */
19463 
19464  /* rg - sys_float */
19465  /* vector of dimension 25 */
19466  /* rg(k) is the integral over (-1,1) of */
19467  /* (1+x)**alfa*log((1+x)/2)*t(k-1,x), k = 1, ..., 25. */
19468 
19469  /* rh - sys_float */
19470  /* vector of dimension 25 */
19471  /* rh(k) is the integral over (-1,1) of */
19472  /* (1-x)**beta*log((1-x)/2)*t(k-1,x), k = 1, ..., 25. */
19473 
19474  /* integr - long */
19475  /* input parameter indicating the modified */
19476  /* moments to be computed */
19477  /* integr = 1 compute ri, rj */
19478  /* = 2 compute ri, rj, rg */
19479  /* = 3 compute ri, rj, rh */
19480  /* = 4 compute ri, rj, rg, rh */
19481  /* ***references (none) */
19482  /* ***routines called (none) */
19483  /* ***end prologue qmomo */
19484 
19485 
19486 
19487 
19488  /* ***first executable statement qmomo */
19489  /* Parameter adjustments */
19490  --rh;
19491  --rg;
19492  --rj;
19493  --ri;
19494 
19495  /* Function Body */
19496  alfp1 = *alfa + 1.f;
19497  betp1 = *beta + 1.f;
19498  alfp2 = *alfa + 2.f;
19499  betp2 = *beta + 2.f;
19500  d__1 = (double) alfp1;
19501  ralf = pow(c_b320, d__1);
19502  d__1 = (double) betp1;
19503  rbet = pow(c_b320, d__1);
19504 
19505  /* compute ri, rj using a forward recurrence relation. */
19506 
19507  ri[1] = ralf / alfp1;
19508  rj[1] = rbet / betp1;
19509  ri[2] = ri[1] * *alfa / alfp2;
19510  rj[2] = rj[1] * *beta / betp2;
19511  an = 2.f;
19512  anm1 = 1.f;
19513  for (i__ = 3; i__ <= 25; ++i__) {
19514  ri[i__] = -(ralf + an * (an - alfp2) * ri[i__ - 1]) / (anm1 * (an +
19515  alfp1));
19516  rj[i__] = -(rbet + an * (an - betp2) * rj[i__ - 1]) / (anm1 * (an +
19517  betp1));
19518  anm1 = an;
19519  an += 1.f;
19520  /* L20: */
19521  }
19522  if (*integr == 1) {
19523  goto L70;
19524  }
19525  if (*integr == 3) {
19526  goto L40;
19527  }
19528 
19529  /* compute rg using a forward recurrence relation. */
19530 
19531  rg[1] = -ri[1] / alfp1;
19532  rg[2] = -(ralf + ralf) / (alfp2 * alfp2) - rg[1];
19533  an = 2.f;
19534  anm1 = 1.f;
19535  im1 = 2;
19536  for (i__ = 3; i__ <= 25; ++i__) {
19537  rg[i__] = -(an * (an - alfp2) * rg[im1] - an * ri[im1] + anm1 * ri[
19538  i__]) / (anm1 * (an + alfp1));
19539  anm1 = an;
19540  an += 1.f;
19541  im1 = i__;
19542  /* L30: */
19543  }
19544  if (*integr == 2) {
19545  goto L70;
19546  }
19547 
19548  /* compute rh using a forward recurrence relation. */
19549 
19550 L40:
19551  rh[1] = -rj[1] / betp1;
19552  rh[2] = -(rbet + rbet) / (betp2 * betp2) - rh[1];
19553  an = 2.f;
19554  anm1 = 1.f;
19555  im1 = 2;
19556  for (i__ = 3; i__ <= 25; ++i__) {
19557  rh[i__] = -(an * (an - betp2) * rh[im1] - an * rj[im1] + anm1 * rj[
19558  i__]) / (anm1 * (an + betp1));
19559  anm1 = an;
19560  an += 1.f;
19561  im1 = i__;
19562  /* L50: */
19563  }
19564  for (i__ = 2; i__ <= 25; i__ += 2) {
19565  rh[i__] = -rh[i__];
19566  /* L60: */
19567  }
19568 L70:
19569  for (i__ = 2; i__ <= 25; i__ += 2) {
19570  rj[i__] = -rj[i__];
19571  /* L80: */
19572  }
19573  /* L90: */
19574  return;
19575 } /* qmomo_ */
19576 
19577 void qng_(const E_fp& f, sys_float *a, sys_float *b, sys_float *epsabs, sys_float *
19578  epsrel, sys_float *result, sys_float *abserr, long *neval, long *ier)
19579 {
19580  /* Initialized data */
19581 
19582  sys_float x1[5] = { .9739065285171717f,.8650633666889845f,
19583  .6794095682990244f,.4333953941292472f,.1488743389816312f };
19584  sys_float x2[5] = { .9956571630258081f,.9301574913557082f,
19585  .7808177265864169f,.5627571346686047f,.2943928627014602f };
19586  sys_float x3[11] = { .9993333609019321f,.9874334029080889f,
19587  .9548079348142663f,.9001486957483283f,.8251983149831142f,
19588  .732148388989305f,.6228479705377252f,.4994795740710565f,
19589  .3649016613465808f,.2222549197766013f,.07465061746138332f };
19590  sys_float x4[22] = { .9999029772627292f,.9979898959866787f,
19591  .9921754978606872f,.9813581635727128f,.9650576238583846f,
19592  .9431676131336706f,.9158064146855072f,.8832216577713165f,
19593  .8457107484624157f,.803557658035231f,.7570057306854956f,
19594  .7062732097873218f,.6515894665011779f,.5932233740579611f,
19595  .5314936059708319f,.4667636230420228f,.3994248478592188f,
19596  .3298748771061883f,.2585035592021616f,.1856953965683467f,
19597  .1118422131799075f,.03735212339461987f };
19598  sys_float w10[5] = { .06667134430868814f,.1494513491505806f,
19599  .219086362515982f,.2692667193099964f,.2955242247147529f };
19600  sys_float w21a[5] = { .03255816230796473f,.07503967481091995f,
19601  .1093871588022976f,.1347092173114733f,.1477391049013385f };
19602  sys_float w21b[6] = { .01169463886737187f,.054755896574352f,
19603  .09312545458369761f,.1234919762620659f,.1427759385770601f,
19604  .1494455540029169f };
19605  sys_float w43a[10] = { .01629673428966656f,.0375228761208695f,
19606  .05469490205825544f,.06735541460947809f,.07387019963239395f,
19607  .005768556059769796f,.02737189059324884f,.04656082691042883f,
19608  .06174499520144256f,.0713872672686934f };
19609  sys_float w43b[12] = { .001844477640212414f,.01079868958589165f,
19610  .02189536386779543f,.03259746397534569f,.04216313793519181f,
19611  .05074193960018458f,.05837939554261925f,.06474640495144589f,
19612  .06956619791235648f,.07282444147183321f,.07450775101417512f,
19613  .07472214751740301f };
19614  sys_float w87a[21] = { .008148377384149173f,.01876143820156282f,
19615  .02734745105005229f,.03367770731163793f,.03693509982042791f,
19616  .002884872430211531f,.0136859460227127f,.02328041350288831f,
19617  .03087249761171336f,.03569363363941877f,9.152833452022414e-4f,
19618  .005399280219300471f,.01094767960111893f,.01629873169678734f,
19619  .02108156888920384f,.02537096976925383f,.02918969775647575f,
19620  .03237320246720279f,.03478309895036514f,.03641222073135179f,
19621  .03725387550304771f };
19622  sys_float w87b[23] = { 2.741455637620724e-4f,.001807124155057943f,
19623  .004096869282759165f,.006758290051847379f,.009549957672201647f,
19624  .01232944765224485f,.01501044734638895f,.01754896798624319f,
19625  .01993803778644089f,.02219493596101229f,.02433914712600081f,
19626  .02637450541483921f,.0282869107887712f,.0300525811280927f,
19627  .03164675137143993f,.0330504134199785f,.03425509970422606f,
19628  .03526241266015668f,.0360769896228887f,.03669860449845609f,
19629  .03712054926983258f,.03733422875193504f,.03736107376267902f };
19630 
19631  /* System generated locals */
19632  sys_float r__1, r__2, r__3, r__4;
19633  double d__1;
19634 
19635  /* Local variables */
19636  long k, l;
19637  sys_float fv1[5], fv2[5], fv3[5], fv4[5];
19638  long ipx=0;
19639  sys_float absc, fval, res10, res21=0., res43=0., res87, fval1, fval2, hlgth,
19640  centr, reskh, uflow;
19641  sys_float epmach, dhlgth, resabs=0., resasc=0., fcentr, savfun[21];
19642 
19643  /* ***begin prologue qng */
19644  /* ***date written 800101 (yymmdd) */
19645  /* ***revision date 830518 (yymmdd) */
19646  /* ***category no. h2a1a1 */
19647  /* ***keywords automatic integrator, smooth integrand, */
19648  /* non-adaptive, gauss-kronrod(patterson) */
19649  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
19650  /* de doncker,elise,appl math & progr. div. - k.u.leuven */
19651  /* kahaner,david,nbs - modified (2/82) */
19652  /* ***purpose the routine calculates an approximation result to a */
19653  /* given definite integral i = integral of f over (a,b), */
19654  /* hopefully satisfying following claim for accuracy */
19655  /* fabs(i-result).le.max(epsabs,epsrel*fabs(i)). */
19656  /* ***description */
19657 
19658  /* non-adaptive integration */
19659  /* standard fortran subroutine */
19660  /* sys_float version */
19661 
19662  /* f - sys_float version */
19663  /* function subprogram defining the integrand function */
19664  /* f(x). the actual name for f needs to be declared */
19665  /* e x t e r n a l in the driver program. */
19666 
19667  /* a - sys_float version */
19668  /* lower limit of integration */
19669 
19670  /* b - sys_float version */
19671  /* upper limit of integration */
19672 
19673  /* epsabs - sys_float */
19674  /* absolute accuracy requested */
19675  /* epsrel - sys_float */
19676  /* relative accuracy requested */
19677  /* if epsabs.le.0 */
19678  /* and epsrel.lt.max(50*rel.mach.acc.,0.5d-28), */
19679  /* the routine will end with ier = 6. */
19680 
19681  /* on return */
19682  /* result - sys_float */
19683  /* approximation to the integral i */
19684  /* result is obtained by applying the 21-polong */
19685  /* gauss-kronrod rule (res21) obtained by optimal */
19686  /* addition of abscissae to the 10-point gauss rule */
19687  /* (res10), or by applying the 43-point rule (res43) */
19688  /* obtained by optimal addition of abscissae to the */
19689  /* 21-point gauss-kronrod rule, or by applying the */
19690  /* 87-point rule (res87) obtained by optimal addition */
19691  /* of abscissae to the 43-point rule. */
19692 
19693  /* abserr - sys_float */
19694  /* estimate of the modulus of the absolute error, */
19695  /* which should equal or exceed fabs(i-result) */
19696 
19697  /* neval - long */
19698  /* number of integrand evaluations */
19699 
19700  /* ier - ier = 0 normal and reliable termination of the */
19701  /* routine. it is assumed that the requested */
19702  /* accuracy has been achieved. */
19703  /* ier.gt.0 abnormal termination of the routine. it is */
19704  /* assumed that the requested accuracy has */
19705  /* not been achieved. */
19706  /* error messages */
19707  /* ier = 1 the maximum number of steps has been */
19708  /* executed. the integral is probably too */
19709  /* difficult to be calculated by dqng. */
19710  /* = 6 the input is invalid, because */
19711  /* epsabs.le.0 and */
19712  /* epsrel.lt.max(50*rel.mach.acc.,0.5d-28). */
19713  /* result, abserr and neval are set to zero. */
19714 
19715  /* ***references (none) */
19716  /* ***routines called r1mach,xerror */
19717  /* ***end prologue qng */
19718 
19719 
19720 
19721  /* the following data statements contain the */
19722  /* abscissae and weights of the integration rules used. */
19723 
19724  /* x1 abscissae common to the 10-, 21-, 43- */
19725  /* and 87-point rule */
19726  /* x2 abscissae common to the 21-, 43- and */
19727  /* 87-point rule */
19728  /* x3 abscissae common to the 43- and 87-polong */
19729  /* rule */
19730  /* x4 abscissae of the 87-point rule */
19731  /* w10 weights of the 10-point formula */
19732  /* w21a weights of the 21-point formula for */
19733  /* abscissae x1 */
19734  /* w21b weights of the 21-point formula for */
19735  /* abscissae x2 */
19736  /* w43a weights of the 43-point formula for */
19737  /* abscissae x1, x3 */
19738  /* w43b weights of the 43-point formula for */
19739  /* abscissae x3 */
19740  /* w87a weights of the 87-point formula for */
19741  /* abscissae x1, x2, x3 */
19742  /* w87b weights of the 87-point formula for */
19743  /* abscissae x4 */
19744 
19745 
19746  /* list of major variables */
19747  /* ----------------------- */
19748 
19749  /* centr - mid point of the integration interval */
19750  /* hlgth - half-length of the integration interval */
19751  /* fcentr - function value at mid polong */
19752  /* absc - abscissa */
19753  /* fval - function value */
19754  /* savfun - array of function values which */
19755  /* have already been computed */
19756  /* res10 - 10-point gauss result */
19757  /* res21 - 21-point kronrod result */
19758  /* res43 - 43-point result */
19759  /* res87 - 87-point result */
19760  /* resabs - approximation to the integral of fabs(f) */
19761  /* resasc - approximation to the integral of fabs(f-i/(b-a)) */
19762 
19763  /* machine dependent constants */
19764  /* --------------------------- */
19765 
19766  /* epmach is the largest relative spacing. */
19767  /* uflow is the smallest positive magnitude. */
19768 
19769  /* ***first executable statement qng */
19770  epmach = r1mach(c__4);
19771  uflow = r1mach(c__1);
19772 
19773  /* test on validity of parameters */
19774  /* ------------------------------ */
19775 
19776  *result = 0.f;
19777  *abserr = 0.f;
19778  *neval = 0;
19779  *ier = 6;
19780  /* Computing MAX */
19781  r__1 = 5e-15f, r__2 = epmach * 50.f;
19782  if (*epsabs <= 0.f && *epsrel < max(r__1,r__2)) {
19783  goto L80;
19784  }
19785  hlgth = (*b - *a) * .5f;
19786  dhlgth = fabs(hlgth);
19787  centr = (*b + *a) * .5f;
19788  fcentr = f(centr);
19789  *neval = 21;
19790  *ier = 1;
19791 
19792  /* compute the integral using the 10- and 21-point formula. */
19793 
19794  for (l = 1; l <= 3; ++l) {
19795  switch (l) {
19796  case 1: goto L5;
19797  case 2: goto L25;
19798  case 3: goto L45;
19799  }
19800  L5:
19801  res10 = 0.f;
19802  res21 = w21b[5] * fcentr;
19803  resabs = w21b[5] * fabs(fcentr);
19804  for (k = 1; k <= 5; ++k) {
19805  absc = hlgth * x1[k - 1];
19806  r__1 = centr + absc;
19807  fval1 = f(r__1);
19808  r__1 = centr - absc;
19809  fval2 = f(r__1);
19810  fval = fval1 + fval2;
19811  res10 += w10[k - 1] * fval;
19812  res21 += w21a[k - 1] * fval;
19813  resabs += w21a[k - 1] * (fabs(fval1) + fabs(fval2));
19814  savfun[k - 1] = fval;
19815  fv1[k - 1] = fval1;
19816  fv2[k - 1] = fval2;
19817  /* L10: */
19818  }
19819  ipx = 5;
19820  for (k = 1; k <= 5; ++k) {
19821  ++ipx;
19822  absc = hlgth * x2[k - 1];
19823  r__1 = centr + absc;
19824  fval1 = f(r__1);
19825  r__1 = centr - absc;
19826  fval2 = f(r__1);
19827  fval = fval1 + fval2;
19828  res21 += w21b[k - 1] * fval;
19829  resabs += w21b[k - 1] * (fabs(fval1) + fabs(fval2));
19830  savfun[ipx - 1] = fval;
19831  fv3[k - 1] = fval1;
19832  fv4[k - 1] = fval2;
19833  /* L15: */
19834  }
19835 
19836  /* test for convergence. */
19837 
19838  *result = res21 * hlgth;
19839  resabs *= dhlgth;
19840  reskh = res21 * .5f;
19841  resasc = w21b[5] * (r__1 = fcentr - reskh, fabs(r__1));
19842  for (k = 1; k <= 5; ++k) {
19843  resasc = resasc + w21a[k - 1] * ((r__1 = fv1[k - 1] - reskh, fabs(
19844  r__1)) + (r__2 = fv2[k - 1] - reskh, fabs(r__2))) + w21b[
19845  k - 1] * ((r__3 = fv3[k - 1] - reskh, fabs(r__3)) + (r__4
19846  = fv4[k - 1] - reskh, fabs(r__4)));
19847  /* L20: */
19848  }
19849  *abserr = (r__1 = (res21 - res10) * hlgth, fabs(r__1));
19850  resasc *= dhlgth;
19851  goto L65;
19852 
19853  /* compute the integral using the 43-point formula. */
19854 
19855  L25:
19856  res43 = w43b[11] * fcentr;
19857  *neval = 43;
19858  for (k = 1; k <= 10; ++k) {
19859  res43 += savfun[k - 1] * w43a[k - 1];
19860  /* L30: */
19861  }
19862  for (k = 1; k <= 11; ++k) {
19863  ++ipx;
19864  absc = hlgth * x3[k - 1];
19865  r__1 = absc + centr;
19866  r__2 = centr - absc;
19867  fval = f(r__1) + f(r__2);
19868  res43 += fval * w43b[k - 1];
19869  savfun[ipx - 1] = fval;
19870  /* L40: */
19871  }
19872 
19873  /* test for convergence. */
19874 
19875  *result = res43 * hlgth;
19876  *abserr = (r__1 = (res43 - res21) * hlgth, fabs(r__1));
19877  goto L65;
19878 
19879  /* compute the integral using the 87-point formula. */
19880 
19881  L45:
19882  res87 = w87b[22] * fcentr;
19883  *neval = 87;
19884  for (k = 1; k <= 21; ++k) {
19885  res87 += savfun[k - 1] * w87a[k - 1];
19886  /* L50: */
19887  }
19888  for (k = 1; k <= 22; ++k) {
19889  absc = hlgth * x4[k - 1];
19890  r__1 = absc + centr;
19891  r__2 = centr - absc;
19892  res87 += w87b[k - 1] * (f(r__1) + f(r__2));
19893  /* L60: */
19894  }
19895  *result = res87 * hlgth;
19896  *abserr = (r__1 = (res87 - res43) * hlgth, fabs(r__1));
19897  L65:
19898  if (resasc != 0.f && *abserr != 0.f) {
19899  /* Computing MIN */
19900  d__1 = (double) (*abserr * 200.f / resasc);
19901  r__1 = 1.f, r__2 = pow(d__1, c_b270);
19902  *abserr = resasc * min(r__1,r__2);
19903  }
19904  if (resabs > uflow / (epmach * 50.f)) {
19905  /* Computing MAX */
19906  r__1 = epmach * 50.f * resabs;
19907  *abserr = max(r__1,*abserr);
19908  }
19909  /* Computing MAX */
19910  r__1 = *epsabs, r__2 = *epsrel * fabs(*result);
19911  if (*abserr <= max(r__1,r__2)) {
19912  *ier = 0;
19913  }
19914  /* ***jump out of do-loop */
19915  if (*ier == 0) {
19916  goto L999;
19917  }
19918  /* L70: */
19919  }
19920 L80:
19921  xerror_("abnormal return from qng ", &c__26, ier, &c__0, 26);
19922 L999:
19923  return;
19924 } /* qng_ */
19925 
19926 void qpsrt_(const long *limit, long *last, long *maxerr,
19927  sys_float *ermax, sys_float *elist, long *iord, long *nrmax)
19928 {
19929  /* System generated locals */
19930  int i__1;
19931 
19932  /* Local variables */
19933  long i__, j, k, ido, ibeg, jbnd, isucc, jupbn;
19934  sys_float errmin, errmax;
19935 
19936  /* ***begin prologue qpsrt */
19937  /* ***refer to qage,qagie,qagpe,qagse,qawce,qawse,qawoe */
19938  /* ***routines called (none) */
19939  /* ***keywords sequential sorting */
19940  /* ***description */
19941 
19942  /* 1. qpsrt */
19943  /* ordering routine */
19944  /* standard fortran subroutine */
19945  /* sys_float version */
19946 
19947  /* 2. purpose */
19948  /* this routine maintains the descending ordering */
19949  /* in the list of the local error estimates resulting from */
19950  /* the interval subdivision process. at each call two error */
19951  /* estimates are inserted using the sequential search */
19952  /* method, top-down for the largest error estimate */
19953  /* and bottom-up for the smallest error estimate. */
19954 
19955  /* 3. calling sequence */
19956  /* call qpsrt(limit,last,maxerr,ermax,elist,iord,nrmax) */
19957 
19958  /* parameters (meaning at output) */
19959  /* limit - long */
19960  /* maximum number of error estimates the list */
19961  /* can contain */
19962 
19963  /* last - long */
19964  /* number of error estimates currently */
19965  /* in the list */
19966 
19967  /* maxerr - long */
19968  /* maxerr points to the nrmax-th largest error */
19969  /* estimate currently in the list */
19970 
19971  /* ermax - sys_float */
19972  /* nrmax-th largest error estimate */
19973  /* ermax = elist(maxerr) */
19974 
19975  /* elist - sys_float */
19976  /* vector of dimension last containing */
19977  /* the error estimates */
19978 
19979  /* iord - long */
19980  /* vector of dimension last, the first k */
19981  /* elements of which contain pointers */
19982  /* to the error estimates, such that */
19983  /* elist(iord(1)),... , elist(iord(k)) */
19984  /* form a decreasing sequence, with */
19985  /* k = last if last.le.(limit/2+2), and */
19986  /* k = limit+1-last otherwise */
19987 
19988  /* nrmax - long */
19989  /* maxerr = iord(nrmax) */
19990 
19991  /* 4. no subroutines or functions needed */
19992  /* ***end prologue qpsrt */
19993 
19994 
19995  /* check whether the list contains more than */
19996  /* two error estimates. */
19997 
19998  /* ***first executable statement qpsrt */
19999  /* Parameter adjustments */
20000  --iord;
20001  --elist;
20002 
20003  /* Function Body */
20004  if (*last > 2) {
20005  goto L10;
20006  }
20007  iord[1] = 1;
20008  iord[2] = 2;
20009  goto L90;
20010 
20011  /* this part of the routine is only executed */
20012  /* if, due to a difficult integrand, subdivision */
20013  /* increased the error estimate. in the normal case */
20014  /* the insert procedure should start after the */
20015  /* nrmax-th largest error estimate. */
20016 
20017 L10:
20018  errmax = elist[*maxerr];
20019  if (*nrmax == 1) {
20020  goto L30;
20021  }
20022  ido = *nrmax - 1;
20023  i__1 = ido;
20024  for (i__ = 1; i__ <= i__1; ++i__) {
20025  isucc = iord[*nrmax - 1];
20026  /* ***jump out of do-loop */
20027  if (errmax <= elist[isucc]) {
20028  goto L30;
20029  }
20030  iord[*nrmax] = isucc;
20031  --(*nrmax);
20032  /* L20: */
20033  }
20034 
20035  /* compute the number of elements in the list to */
20036  /* be maintained in descending order. this number */
20037  /* depends on the number of subdivisions still */
20038  /* allowed. */
20039 
20040 L30:
20041  jupbn = *last;
20042  if (*last > *limit / 2 + 2) {
20043  jupbn = *limit + 3 - *last;
20044  }
20045  errmin = elist[*last];
20046 
20047  /* insert errmax by traversing the list top-down, */
20048  /* starting comparison from the element elist(iord(nrmax+1)). */
20049 
20050  jbnd = jupbn - 1;
20051  ibeg = *nrmax + 1;
20052  if (ibeg > jbnd) {
20053  goto L50;
20054  }
20055  i__1 = jbnd;
20056  for (i__ = ibeg; i__ <= i__1; ++i__) {
20057  isucc = iord[i__];
20058  /* ***jump out of do-loop */
20059  if (errmax >= elist[isucc]) {
20060  goto L60;
20061  }
20062  iord[i__ - 1] = isucc;
20063  /* L40: */
20064  }
20065 L50:
20066  iord[jbnd] = *maxerr;
20067  iord[jupbn] = *last;
20068  goto L90;
20069 
20070  /* insert errmin by traversing the list bottom-up. */
20071 
20072 L60:
20073  iord[i__ - 1] = *maxerr;
20074  k = jbnd;
20075  i__1 = jbnd;
20076  for (j = i__; j <= i__1; ++j) {
20077  isucc = iord[k];
20078  /* ***jump out of do-loop */
20079  if (errmin < elist[isucc]) {
20080  goto L80;
20081  }
20082  iord[k + 1] = isucc;
20083  --k;
20084  /* L70: */
20085  }
20086  iord[i__] = *last;
20087  goto L90;
20088 L80:
20089  iord[k + 1] = *last;
20090 
20091  /* set maxerr and ermax. */
20092 
20093 L90:
20094  *maxerr = iord[*nrmax];
20095  *ermax = elist[*maxerr];
20096  return;
20097 } /* qpsrt_ */
20098 
20099 sys_float qwgtc_(const sys_float *x, const sys_float *c__, const sys_float *,
20100  const sys_float *, const sys_float *, const long *)
20101 {
20102  /* System generated locals */
20103  sys_float ret_val;
20104 
20105  /* ***begin prologue qwgtc */
20106  /* ***refer to qk15w */
20107  /* ***routines called (none) */
20108  /* ***revision date 810101 (yymmdd) */
20109  /* ***keywords weight function, cauchy principal value */
20110  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
20111  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
20112  /* ***purpose this function subprogram is used together with the */
20113  /* routine qawc and defines the weight function. */
20114  /* ***end prologue qwgtc */
20115 
20116  /* ***first executable statement */
20117  ret_val = 1.f / (*x - *c__);
20118  return ret_val;
20119 } /* qwgtc_ */
20120 
20121 sys_float qwgtf_(const sys_float *x, const sys_float *omega, const sys_float *,
20122  const sys_float *, const sys_float *, const long *integr)
20123 {
20124  /* System generated locals */
20125  sys_float ret_val;
20126 
20127  /* Local variables */
20128  sys_float omx;
20129 
20130  /* ***begin prologue qwgtf */
20131  /* ***refer to qk15w */
20132  /* ***routines called (none) */
20133  /* ***revision date 810101 (yymmdd) */
20134  /* ***keywords cos or sin in weight function */
20135  /* ***author piessens,robert, appl. math. & progr. div. - k.u.leuven */
20136  /* de doncker,elise,appl. math. * progr. div. - k.u.leuven */
20137  /* ***end prologue qwgtf */
20138 
20139  /* ***first executable statement */
20140  omx = *omega * *x;
20141  switch (*integr) {
20142  case 1: goto L10;
20143  case 2: goto L20;
20144  }
20145 L10:
20146  ret_val = cos(omx);
20147  goto L30;
20148 L20:
20149  ret_val = sin(omx);
20150 L30:
20151  return ret_val;
20152 } /* qwgtf_ */
20153 
20154 sys_float qwgts_(const sys_float *x, const sys_float *a, const sys_float *b,
20155  const sys_float *alfa, const sys_float *beta,
20156  const long *integr)
20157 {
20158  /* System generated locals */
20159  sys_float ret_val;
20160  double d__1, d__2, d__3, d__4;
20161 
20162  /* Local variables */
20163  sys_float xma, bmx;
20164 
20165  /* ***begin prologue qwgts */
20166  /* ***refer to qk15w */
20167  /* ***routines called (none) */
20168  /* ***revision date 810101 (yymmdd) */
20169  /* ***keywords weight function, algebraico-logarithmic */
20170  /* end-point singularities */
20171  /* ***author piessens,robert,appl. math. & progr. div. - k.u.leuven */
20172  /* de doncker,elise,appl. math. & progr. div. - k.u.leuven */
20173  /* ***purpose this function subprogram is used together with the */
20174  /* routine qaws and defines the weight function. */
20175  /* ***end prologue qwgts */
20176 
20177  /* ***first executable statement */
20178  xma = *x - *a;
20179  bmx = *b - *x;
20180  d__1 = (double) xma;
20181  d__2 = (double) (*alfa);
20182  d__3 = (double) bmx;
20183  d__4 = (double) (*beta);
20184  ret_val = pow(d__1, d__2) * pow(d__3, d__4);
20185  switch (*integr) {
20186  case 1: goto L40;
20187  case 2: goto L10;
20188  case 3: goto L20;
20189  case 4: goto L30;
20190  }
20191 L10:
20192  ret_val *= log(xma);
20193  goto L40;
20194 L20:
20195  ret_val *= log(bmx);
20196  goto L40;
20197 L30:
20198  ret_val = ret_val * log(xma) * log(bmx);
20199 L40:
20200  return ret_val;
20201 } /* qwgts_ */
20202 
20203 void sgtsl_(const long *n, sys_float *c__, sys_float *d__,
20204  sys_float *e, sys_float *b, long *info)
20205 {
20206  /* System generated locals */
20207  int i__1;
20208  sys_float r__1, r__2;
20209 
20210  /* Local variables */
20211  long k;
20212  sys_float t;
20213  long kb, kp1, nm1, nm2;
20214 
20215 
20216  /* sgtsl given a general tridiagonal matrix and a right hand */
20217  /* side will find the solution. */
20218 
20219  /* on entry */
20220 
20221  /* n long */
20222  /* is the order of the tridiagonal matrix. */
20223 
20224  /* c sys_float(n) */
20225  /* is the subdiagonal of the tridiagonal matrix. */
20226  /* c(2) through c(n) should contain the subdiagonal. */
20227  /* on output c is destroyed. */
20228 
20229  /* d sys_float(n) */
20230  /* is the diagonal of the tridiagonal matrix. */
20231  /* on output d is destroyed. */
20232 
20233  /* e sys_float(n) */
20234  /* is the superdiagonal of the tridiagonal matrix. */
20235  /* e(1) through e(n-1) should contain the superdiagonal. */
20236  /* on output e is destroyed. */
20237 
20238  /* b sys_float(n) */
20239  /* is the right hand side vector. */
20240 
20241  /* on return */
20242 
20243  /* b is the solution vector. */
20244 
20245  /* info long */
20246  /* = 0 normal value. */
20247  /* = k if the k-th element of the diagonal becomes */
20248  /* exactly zero. the subroutine returns when */
20249  /* this is detected. */
20250 
20251  /* linpack. this version dated 08/14/78 . */
20252  /* jack dongarra, argonne national laboratory. */
20253 
20254  /* no externals */
20255  /* fortran abs */
20256 
20257  /* internal variables */
20258 
20259  /* begin block permitting ...exits to 100 */
20260 
20261  /* Parameter adjustments */
20262  --b;
20263  --e;
20264  --d__;
20265  --c__;
20266 
20267  /* Function Body */
20268  *info = 0;
20269  c__[1] = d__[1];
20270  nm1 = *n - 1;
20271  if (nm1 < 1) {
20272  goto L40;
20273  }
20274  d__[1] = e[1];
20275  e[1] = 0.f;
20276  e[*n] = 0.f;
20277 
20278  i__1 = nm1;
20279  for (k = 1; k <= i__1; ++k) {
20280  kp1 = k + 1;
20281 
20282  /* find the largest of the two rows */
20283 
20284  if ((r__1 = c__[kp1], fabs(r__1)) < (r__2 = c__[k], fabs(r__2))) {
20285  goto L10;
20286  }
20287 
20288  /* interchange row */
20289 
20290  t = c__[kp1];
20291  c__[kp1] = c__[k];
20292  c__[k] = t;
20293  t = d__[kp1];
20294  d__[kp1] = d__[k];
20295  d__[k] = t;
20296  t = e[kp1];
20297  e[kp1] = e[k];
20298  e[k] = t;
20299  t = b[kp1];
20300  b[kp1] = b[k];
20301  b[k] = t;
20302  L10:
20303 
20304  /* zero elements */
20305 
20306  if (c__[k] != 0.f) {
20307  goto L20;
20308  }
20309  *info = k;
20310  /* ............exit */
20311  goto L100;
20312  L20:
20313  t = -c__[kp1] / c__[k];
20314  c__[kp1] = d__[kp1] + t * d__[k];
20315  d__[kp1] = e[kp1] + t * e[k];
20316  e[kp1] = 0.f;
20317  b[kp1] += t * b[k];
20318  /* L30: */
20319  }
20320 L40:
20321  if (c__[*n] != 0.f) {
20322  goto L50;
20323  }
20324  *info = *n;
20325  goto L90;
20326 L50:
20327 
20328  /* back solve */
20329 
20330  nm2 = *n - 2;
20331  b[*n] /= c__[*n];
20332  if (*n == 1) {
20333  goto L80;
20334  }
20335  b[nm1] = (b[nm1] - d__[nm1] * b[*n]) / c__[nm1];
20336  if (nm2 < 1) {
20337  goto L70;
20338  }
20339  i__1 = nm2;
20340  for (kb = 1; kb <= i__1; ++kb) {
20341  k = nm2 - kb + 1;
20342  b[k] = (b[k] - d__[k] * b[k + 1] - e[k] * b[k + 2]) / c__[k];
20343  /* L60: */
20344  }
20345 L70:
20346 L80:
20347 L90:
20348 L100:
20349 
20350  return;
20351 } /* sgtsl_ */
20352 
20353 void dgtsl_(const long *n, double *c__, double *d__,
20354  double *e, double *b, long *info)
20355 {
20356  /* System generated locals */
20357  int i__1;
20358  double d__1, d__2;
20359 
20360  /* Local variables */
20361  long k;
20362  double t;
20363  long kb, kp1, nm1, nm2;
20364 
20365 
20366  /* dgtsl given a general tridiagonal matrix and a right hand */
20367  /* side will find the solution. */
20368 
20369  /* on entry */
20370 
20371  /* n long */
20372  /* is the order of the tridiagonal matrix. */
20373 
20374  /* c double precision(n) */
20375  /* is the subdiagonal of the tridiagonal matrix. */
20376  /* c(2) through c(n) should contain the subdiagonal. */
20377  /* on output c is destroyed. */
20378 
20379  /* d double precision(n) */
20380  /* is the diagonal of the tridiagonal matrix. */
20381  /* on output d is destroyed. */
20382 
20383  /* e double precision(n) */
20384  /* is the superdiagonal of the tridiagonal matrix. */
20385  /* e(1) through e(n-1) should contain the superdiagonal. */
20386  /* on output e is destroyed. */
20387 
20388  /* b double precision(n) */
20389  /* is the right hand side vector. */
20390 
20391  /* on return */
20392 
20393  /* b is the solution vector. */
20394 
20395  /* info long */
20396  /* = 0 normal value. */
20397  /* = k if the k-th element of the diagonal becomes */
20398  /* exactly zero. the subroutine returns when */
20399  /* this is detected. */
20400 
20401  /* linpack. this version dated 08/14/78 . */
20402  /* jack dongarra, argonne national laboratory. */
20403 
20404  /* no externals */
20405  /* fortran dabs */
20406 
20407  /* internal variables */
20408 
20409  /* begin block permitting ...exits to 100 */
20410 
20411  /* Parameter adjustments */
20412  --b;
20413  --e;
20414  --d__;
20415  --c__;
20416 
20417  /* Function Body */
20418  *info = 0;
20419  c__[1] = d__[1];
20420  nm1 = *n - 1;
20421  if (nm1 < 1) {
20422  goto L40;
20423  }
20424  d__[1] = e[1];
20425  e[1] = 0.;
20426  e[*n] = 0.;
20427 
20428  i__1 = nm1;
20429  for (k = 1; k <= i__1; ++k) {
20430  kp1 = k + 1;
20431 
20432  /* find the largest of the two rows */
20433 
20434  if ((d__1 = c__[kp1], fabs(d__1)) < (d__2 = c__[k], fabs(d__2))) {
20435  goto L10;
20436  }
20437 
20438  /* interchange row */
20439 
20440  t = c__[kp1];
20441  c__[kp1] = c__[k];
20442  c__[k] = t;
20443  t = d__[kp1];
20444  d__[kp1] = d__[k];
20445  d__[k] = t;
20446  t = e[kp1];
20447  e[kp1] = e[k];
20448  e[k] = t;
20449  t = b[kp1];
20450  b[kp1] = b[k];
20451  b[k] = t;
20452  L10:
20453 
20454  /* zero elements */
20455 
20456  if (c__[k] != 0.) {
20457  goto L20;
20458  }
20459  *info = k;
20460  /* ............exit */
20461  goto L100;
20462  L20:
20463  t = -c__[kp1] / c__[k];
20464  c__[kp1] = d__[kp1] + t * d__[k];
20465  d__[kp1] = e[kp1] + t * e[k];
20466  e[kp1] = 0.;
20467  b[kp1] += t * b[k];
20468  /* L30: */
20469  }
20470 L40:
20471  if (c__[*n] != 0.) {
20472  goto L50;
20473  }
20474  *info = *n;
20475  goto L90;
20476 L50:
20477 
20478  /* back solve */
20479 
20480  nm2 = *n - 2;
20481  b[*n] /= c__[*n];
20482  if (*n == 1) {
20483  goto L80;
20484  }
20485  b[nm1] = (b[nm1] - d__[nm1] * b[*n]) / c__[nm1];
20486  if (nm2 < 1) {
20487  goto L70;
20488  }
20489  i__1 = nm2;
20490  for (kb = 1; kb <= i__1; ++kb) {
20491  k = nm2 - kb + 1;
20492  b[k] = (b[k] - d__[k] * b[k + 1] - e[k] * b[k + 2]) / c__[k];
20493  /* L60: */
20494  }
20495 L70:
20496 L80:
20497 L90:
20498 L100:
20499 
20500  return;
20501 } /* dgtsl_ */
20502 
qk15i_
void qk15i_(const E_fp &f, const sys_float *boun, const long *inf, const sys_float *a, const sys_float *b, sys_float *result, sys_float *abserr, sys_float *resabs, sys_float *resasc)
Definition: thirdparty_quadpack.cpp:18040
E_fp1
sys_float(* E_fp1)(const sys_float *, const sys_float *, const sys_float *, const sys_float *, const sys_float *, const long *)
Definition: thirdparty_quadpack.h:47
qc25f_
void qc25f_(const E_fp &f, const sys_float *a, const sys_float *b, const sys_float *omega, const long *integr, const long *nrmom, const long *maxp1, const long *ksave, sys_float *result, sys_float *abserr, long *neval, sys_float *resabs, sys_float *resasc, long *momcom, sys_float *chebmo)
Definition: thirdparty_quadpack.cpp:16623
dqwgtc_
double dqwgtc_(const double *x, const double *c__, const double *, const double *, const double *, const long *)
Definition: thirdparty_quadpack.cpp:10166
dqk61_
void dqk61_(const D_fp &f, const double *a, const double *b, double *result, double *abserr, double *resabs, double *resasc)
Definition: thirdparty_quadpack.cpp:9161
sgtsl_
static void sgtsl_(const long *, sys_float *, sys_float *, sys_float *, sys_float *, long *)
Definition: thirdparty_quadpack.cpp:20203
c__0
static const long c__0
Definition: thirdparty_quadpack.cpp:81
dqk15w_
void dqk15w_(const D_fp &f, D_fp1 w, const double *p1, const double *p2, const double *p3, const double *p4, const long *kp, const double *a, const double *b, double *result, double *abserr, double *resabs, double *resasc)
Definition: thirdparty_quadpack.cpp:8059
x2
static double x2[63]
Definition: atmdat_3body.cpp:18
qk51_
void qk51_(const E_fp &f, const sys_float *a, const sys_float *b, sys_float *result, sys_float *abserr, sys_float *resabs, sys_float *resasc)
Definition: thirdparty_quadpack.cpp:19017
qelg_
void qelg_(long *n, sys_float *epstab, sys_float *result, sys_float *abserr, sys_float *res3la, long *nres)
Definition: thirdparty_quadpack.cpp:17611
qk15w_
void qk15w_(const E_fp &f, E_fp1 w, const sys_float *p1, const sys_float *p2, const sys_float *p3, const sys_float *p4, const long *kp, const sys_float *a, const sys_float *b, sys_float *result, sys_float *abserr, sys_float *resabs, sys_float *resasc)
Definition: thirdparty_quadpack.cpp:18248
qagse_
void qagse_(const E_fp &f, const sys_float *a, const sys_float *b, const sys_float *epsabs, const sys_float *epsrel, const long *limit, sys_float *result, sys_float *abserr, long *neval, long *ier, sys_float *alist__, sys_float *blist, sys_float *rlist, sys_float *elist, long *iord, long *last)
Definition: thirdparty_quadpack.cpp:12724
x1
static double x1[83]
Definition: atmdat_3body.cpp:27
qk21_
void qk21_(const E_fp &f, const sys_float *a, const sys_float *b, sys_float *result, sys_float *abserr, sys_float *resabs, sys_float *resasc)
Definition: thirdparty_quadpack.cpp:18446
dqawoe_
void dqawoe_(const D_fp &f, const double *a, const double *b, const double *omega, const long *integr, const double *epsabs, const double *epsrel, const long *limit, const long *icall, const long *maxp1, double *result, double *abserr, long *neval, long *ier, long *last, double *alist__, double *blist, double *rlist, double *elist, long *iord, long *nnlog, long *momcom, double *chebmo)
Definition: thirdparty_quadpack.cpp:4616
e1
double e1(double x)
Definition: thirdparty.cpp:3258
c_b20
static const double c_b20
Definition: thirdparty_quadpack.cpp:78
D_fp1
double(* D_fp1)(const double *, const double *, const double *, const double *, const double *, const long *)
Definition: thirdparty_quadpack.h:44
dqagse_
void dqagse_(const D_fp &f, const double *a, const double *b, const double *epsabs, const double *epsrel, const long *limit, double *result, double *abserr, long *neval, long *ier, double *alist__, double *blist, double *rlist, double *elist, long *iord, long *last)
Definition: thirdparty_quadpack.cpp:2533
dqag_
void dqag_(const D_fp &f, const double *a, const double *b, const double *epsabs, const double *epsrel, const long *key, double *result, double *abserr, long *neval, long *ier, long *limit, const long *lenw, long *last, long *iwork, double *work)
Definition: thirdparty_quadpack.cpp:542
dqagie_
void dqagie_(const D_fp &f, const double *bound, const long *inf, const double *epsabs, const double *epsrel, const long *limit, double *result, double *abserr, long *neval, long *ier, double *alist__, double *blist, double *rlist, double *elist, long *iord, long *last)
Definition: thirdparty_quadpack.cpp:738
c_b21
static const double c_b21
Definition: thirdparty_quadpack.cpp:79
sign
T sign(T x, T y)
Definition: cddefines.h:842
D_fp
Definition: thirdparty_quadpack.h:26
qage_
void qage_(const E_fp &f, const sys_float *a, const sys_float *b, const sys_float *epsabs, const sys_float *epsrel, const long *key, const long *limit, sys_float *result, sys_float *abserr, long *neval, long *ier, sys_float *alist__, sys_float *blist, sys_float *rlist, sys_float *elist, long *iord, long *last)
Definition: thirdparty_quadpack.cpp:10264
dqk15_
void dqk15_(const D_fp &f, const double *a, const double *b, double *result, double *abserr, double *resabs, double *resasc)
Definition: thirdparty_quadpack.cpp:7641
c_b320
static const double c_b320
Definition: thirdparty_quadpack.cpp:83
dqmomo_
void dqmomo_(const double *alfa, const double *beta, double *ri, double *rj, double *rg, double *rh, const long *integr)
Definition: thirdparty_quadpack.cpp:9418
d1mach
static double d1mach(long i)
Definition: thirdparty_quadpack.cpp:47
ioQQQ
FILE * ioQQQ
Definition: cddefines.cpp:7
qk41_
void qk41_(const E_fp &f, const sys_float *a, const sys_float *b, sys_float *result, sys_float *abserr, sys_float *resabs, sys_float *resasc)
Definition: thirdparty_quadpack.cpp:18822
r1mach
static sys_float r1mach(long i)
Definition: thirdparty_quadpack.cpp:21
dqwgtf_
double dqwgtf_(const double *x, const double *omega, const double *, const double *, const double *, const long *integr)
Definition: thirdparty_quadpack.cpp:10188
qawse_
void qawse_(const E_fp &f, const sys_float *a, const sys_float *b, const sys_float *alfa, const sys_float *beta, const long *integr, const sys_float *epsabs, const sys_float *epsrel, const long *limit, sys_float *result, sys_float *abserr, long *neval, long *ier, sys_float *alist__, sys_float *blist, sys_float *rlist, sys_float *elist, long *iord, long *last)
Definition: thirdparty_quadpack.cpp:15780
qc25c_
void qc25c_(const E_fp &f, const sys_float *a, const sys_float *b, const sys_float *c__, sys_float *result, sys_float *abserr, long *krul, long *neval)
Definition: thirdparty_quadpack.cpp:16438
dqagp_
void dqagp_(const D_fp &f, const double *a, const double *b, const long *npts2, const double *points, const double *epsabs, const double *epsrel, double *result, double *abserr, long *neval, long *ier, const long *leniw, const long *lenw, long *last, long *iwork, double *work)
Definition: thirdparty_quadpack.cpp:2293
qwgtf_
sys_float qwgtf_(const sys_float *x, const sys_float *omega, const sys_float *, const sys_float *, const sys_float *, const long *integr)
Definition: thirdparty_quadpack.cpp:20121
dqawc_
void dqawc_(const D_fp &f, const double *a, const double *b, const double *c__, const double *epsabs, const double *epsrel, double *result, double *abserr, long *neval, long *ier, long *limit, const long *lenw, long *last, long *iwork, double *work)
Definition: thirdparty_quadpack.cpp:3722
qagie_
void qagie_(const E_fp &f, const sys_float *bound, const long *inf, const sys_float *epsabs, const sys_float *epsrel, const long *limit, sys_float *result, sys_float *abserr, long *neval, long *ier, sys_float *alist__, sys_float *blist, sys_float *rlist, sys_float *elist, long *iord, long *last)
Definition: thirdparty_quadpack.cpp:10914
dgtsl_
static void dgtsl_(const long *, double *, double *, double *, double *, long *)
Definition: thirdparty_quadpack.cpp:20353
qk15_
void qk15_(const E_fp &f, const sys_float *a, const sys_float *b, sys_float *result, sys_float *abserr, sys_float *resabs, sys_float *resasc)
Definition: thirdparty_quadpack.cpp:17856
dqage_
void dqage_(const D_fp &f, const double *a, const double *b, const double *epsabs, const double *epsrel, const long *key, const long *limit, double *result, double *abserr, long *neval, long *ier, double *alist__, double *blist, double *rlist, double *elist, long *iord, long *last)
Definition: thirdparty_quadpack.cpp:92
qwgtc_
sys_float qwgtc_(const sys_float *x, const sys_float *c__, const sys_float *, const sys_float *, const sys_float *, const long *)
Definition: thirdparty_quadpack.cpp:20099
E_fp
Definition: thirdparty_quadpack.h:7
b2
static double b2[63]
Definition: atmdat_3body.cpp:18
qaws_
void qaws_(const E_fp &f, const sys_float *a, const sys_float *b, const sys_float *alfa, const sys_float *beta, const long *integr, const sys_float *epsabs, const sys_float *epsrel, sys_float *result, sys_float *abserr, long *neval, long *ier, const long *limit, const long *lenw, long *last, long *iwork, sys_float *work)
Definition: thirdparty_quadpack.cpp:16221
sinpar
STATIC void sinpar(double, double, double, double *, double *, double *, double *, double *, long *)
STATIC
#define STATIC
Definition: cddefines.h:118
c__1
static const long c__1
Definition: thirdparty_quadpack.cpp:76
dqawo_
void dqawo_(const D_fp &f, const double *a, const double *b, const double *omega, const long *integr, const double *epsabs, const double *epsrel, double *result, double *abserr, long *neval, long *ier, const long *leniw, long *maxp1, const long *lenw, long *last, long *iwork, double *work)
Definition: thirdparty_quadpack.cpp:5326
dqawfe_
void dqawfe_(const D_fp &f, const double *a, const double *omega, const long *integr, const double *epsabs, const long *limlst, const long *limit, const long *maxp1, double *result, double *abserr, long *neval, long *ier, double *rslst, double *erlst, long *ierlst, long *lst, double *alist__, double *blist, double *rlist, double *elist, long *iord, long *nnlog, double *chebmo)
Definition: thirdparty_quadpack.cpp:3914
c_b390
static const sys_float c_b390
Definition: thirdparty_quadpack.cpp:84
c__2
static const long c__2
Definition: thirdparty_quadpack.cpp:80
qk61_
void qk61_(const E_fp &f, const sys_float *a, const sys_float *b, sys_float *result, sys_float *abserr, sys_float *resabs, sys_float *resasc)
Definition: thirdparty_quadpack.cpp:19215
dqc25s_
void dqc25s_(const D_fp &f, const double *a, const double *b, const double *bl, const double *br, const double *alfa, const double *beta, const double *ri, const double *rj, const double *rg, const double *rh, double *result, double *abserr, double *resasc, const long *integr, long *nev)
Definition: thirdparty_quadpack.cpp:6821
dqags_
void dqags_(const D_fp &f, const double *a, const double *b, const double *epsabs, const double *epsrel, double *result, double *abserr, long *neval, long *ier, const long *limit, const long *lenw, long *last, long *iwork, double *work)
Definition: thirdparty_quadpack.cpp:3124
EXIT_FAILURE
#define EXIT_FAILURE
Definition: cddefines.h:168
sys_float
float sys_float
Definition: cddefines.h:127
dqawf_
void dqawf_(const D_fp &f, const double *a, const double *omega, const long *integr, const double *epsabs, double *result, double *abserr, long *neval, long *ier, long *limlst, long *lst, const long *leniw, const long *maxp1, const long *lenw, long *iwork, double *work)
Definition: thirdparty_quadpack.cpp:4371
qc25s_
void qc25s_(const E_fp &f, const sys_float *a, const sys_float *b, const sys_float *bl, const sys_float *br, const sys_float *alfa, const sys_float *beta, sys_float *ri, sys_float *rj, sys_float *rg, sys_float *rh, sys_float *result, sys_float *abserr, sys_float *resasc, const long *integr, long *nev)
Definition: thirdparty_quadpack.cpp:17025
qawo_
void qawo_(const E_fp &f, const sys_float *a, const sys_float *b, const sys_float *omega, const long *integr, const sys_float *epsabs, const sys_float *epsrel, sys_float *result, sys_float *abserr, long *neval, long *ier, const long *leniw, const long *maxp1, const long *lenw, long *last, long *iwork, sys_float *work)
Definition: thirdparty_quadpack.cpp:15540
max
long max(int a, long b)
Definition: cddefines.h:817
cdEXIT
#define cdEXIT(FAIL)
Definition: cddefines.h:482
qwgts_
sys_float qwgts_(const sys_float *x, const sys_float *a, const sys_float *b, const sys_float *alfa, const sys_float *beta, const long *integr)
Definition: thirdparty_quadpack.cpp:20154
a1
static double a1[83]
Definition: atmdat_3body.cpp:27
dqaws_
void dqaws_(const D_fp &f, const double *a, const double *b, const double *alfa, const double *beta, const long *integr, const double *epsabs, const double *epsrel, double *result, double *abserr, long *neval, long *ier, long *limit, const long *lenw, long *last, long *iwork, double *work)
Definition: thirdparty_quadpack.cpp:6003
dqawce_
void dqawce_(const D_fp &f, const double *a, const double *b, const double *c__, const double *epsabs, const double *epsrel, const long *limit, double *result, double *abserr, long *neval, long *ier, double *alist__, double *blist, double *rlist, double *elist, long *iord, long *last)
Definition: thirdparty_quadpack.cpp:3326
b1
static realnum b1[83]
Definition: atmdat_3body.cpp:24
min
long min(int a, long b)
Definition: cddefines.h:762
qcheb_
void qcheb_(sys_float *x, sys_float *fval, sys_float *cheb12, sys_float *cheb24)
Definition: thirdparty_quadpack.cpp:17450
qawoe_
void qawoe_(const E_fp &f, const sys_float *a, const sys_float *b, const sys_float *omega, const long *integr, const sys_float *epsabs, const sys_float *epsrel, const long *limit, const long *icall, const long *maxp1, sys_float *result, sys_float *abserr, long *neval, long *ier, long *last, sys_float *alist__, sys_float *blist, sys_float *rlist, sys_float *elist, long *iord, long *nnlog, long *momcom, sys_float *chebmo)
Definition: thirdparty_quadpack.cpp:14827
dqng_
void dqng_(const D_fp &f, const double *a, const double *b, const double *epsabs, const double *epsrel, double *result, double *abserr, long *neval, long *ier)
Definition: thirdparty_quadpack.cpp:9573
c__4
static const long c__4
Definition: thirdparty_quadpack.cpp:75
qawc_
void qawc_(const E_fp &f, const sys_float *a, const sys_float *b, const sys_float *c__, const sys_float *epsabs, const sys_float *epsrel, sys_float *result, sys_float *abserr, long *neval, long *ier, long *limit, const long *lenw, long *last, long *iwork, sys_float *work)
Definition: thirdparty_quadpack.cpp:13925
qmomo_
void qmomo_(const sys_float *alfa, const sys_float *beta, sys_float *ri, sys_float *rj, sys_float *rg, sys_float *rh, const long *integr)
Definition: thirdparty_quadpack.cpp:19418
qagpe_
void qagpe_(const E_fp &f, const sys_float *a, const sys_float *b, const long *npts2, const sys_float *points, const sys_float *epsabs, const sys_float *epsrel, const long *limit, sys_float *result, sys_float *abserr, long *neval, long *ier, sys_float *alist__, sys_float *blist, sys_float *rlist, sys_float *elist, sys_float *pts, long *iord, long *level, long *ndin, long *last)
Definition: thirdparty_quadpack.cpp:11732
dqk51_
void dqk51_(const D_fp &f, const double *a, const double *b, double *result, double *abserr, double *resabs, double *resasc)
Definition: thirdparty_quadpack.cpp:8915
dqpsrt_
void dqpsrt_(const long *limit, long *last, long *maxerr, double *ermax, double *elist, long *iord, long *nrmax)
Definition: thirdparty_quadpack.cpp:10000
dqc25f_
void dqc25f_(const D_fp &f, const double *a, const double *b, const double *omega, const long *integr, const long *nrmom, const long *maxp1, const long *ksave, double *result, double *abserr, long *neval, double *resabs, double *resasc, long *momcom, double *chebmo)
Definition: thirdparty_quadpack.cpp:6409
dqk15i_
void dqk15i_(const D_fp &f, const double *boun, const long *inf, const double *a, const double *b, double *result, double *abserr, double *resabs, double *resasc)
Definition: thirdparty_quadpack.cpp:7841
dqelg_
void dqelg_(long *n, double *epstab, double *result, double *abserr, double *res3la, long *nres)
Definition: thirdparty_quadpack.cpp:7396
dqwgts_
double dqwgts_(const double *x, const double *a, const double *b, const double *alfa, const double *beta, const long *integr)
Definition: thirdparty_quadpack.cpp:10221
qpsrt_
void qpsrt_(const long *limit, long *last, long *maxerr, sys_float *ermax, sys_float *elist, long *iord, long *nrmax)
Definition: thirdparty_quadpack.cpp:19926
qags_
void qags_(const E_fp &f, const sys_float *a, const sys_float *b, const sys_float *epsabs, const sys_float *epsrel, sys_float *result, sys_float *abserr, long *neval, long *ier, const long *limit, const long *lenw, long *last, long *iwork, sys_float *work)
Definition: thirdparty_quadpack.cpp:13321
qagp_
void qagp_(const E_fp &f, const sys_float *a, const sys_float *b, const long *npts2, const sys_float *points, const sys_float *epsabs, const sys_float *epsrel, sys_float *result, sys_float *abserr, long *neval, long *ier, const long *leniw, const long *lenw, long *last, long *iwork, sys_float *work)
Definition: thirdparty_quadpack.cpp:12483
DEBUG_ENTRY
#define DEBUG_ENTRY(funcname)
Definition: cddefines.h:723
c_b270
static const double c_b270
Definition: thirdparty_quadpack.cpp:82
c_b391
static const sys_float c_b391
Definition: thirdparty_quadpack.cpp:85
dqk21_
void dqk21_(const D_fp &f, const double *a, const double *b, double *result, double *abserr, double *resabs, double *resasc)
Definition: thirdparty_quadpack.cpp:8257
qawf_
void qawf_(const E_fp &f, const sys_float *a, const sys_float *omega, const long *integr, const sys_float *epsabs, sys_float *result, sys_float *abserr, long *neval, long *ier, const long *limlst, long *lst, const long *leniw, const long *maxp1, const long *lenw, long *iwork, sys_float *work)
Definition: thirdparty_quadpack.cpp:14579
fprintf
int fprintf(const Output &stream, const char *format,...)
Definition: service.cpp:1121
dqagi_
void dqagi_(const D_fp &f, const double *bound, const long *inf, const double *epsabs, const double *epsrel, double *result, double *abserr, long *neval, long *ier, long *limit, const long *lenw, long *last, long *iwork, double *work)
Definition: thirdparty_quadpack.cpp:1342
e2
double e2(double x)
Definition: thirdparty.cpp:3328
qag_
void qag_(const E_fp &f, const sys_float *a, const sys_float *b, const sys_float *epsabs, const sys_float *epsrel, const long *key, sys_float *result, sys_float *abserr, long *neval, long *ier, long *limit, const long *lenw, long *last, long *iwork, sys_float *work)
Definition: thirdparty_quadpack.cpp:10716
nint
long nint(double x)
Definition: cddefines.h:758
dqk41_
void dqk41_(const D_fp &f, const double *a, const double *b, double *result, double *abserr, double *resabs, double *resasc)
Definition: thirdparty_quadpack.cpp:8682
dqcheb_
void dqcheb_(const double *x, double *fval, double *cheb12, double *cheb24)
Definition: thirdparty_quadpack.cpp:7235
dqk31_
void dqk31_(const D_fp &f, const double *a, const double *b, double *result, double *abserr, double *resabs, double *resasc)
Definition: thirdparty_quadpack.cpp:8465
qagi_
void qagi_(const E_fp &f, const sys_float *bound, const long *inf, const sys_float *epsabs, const sys_float *epsrel, sys_float *result, sys_float *abserr, long *neval, long *ier, const long *limit, const long *lenw, long *last, long *iwork, sys_float *work)
Definition: thirdparty_quadpack.cpp:11526
xerror_
STATIC long xerror_(const char *mesg, const long *nmesg, const long *nerr, const long *level, long)
Definition: thirdparty_quadpack.cpp:6
qawfe_
void qawfe_(const E_fp &f, const sys_float *a, const sys_float *omega, const long *integr, const sys_float *epsabs, const long *limlst, const long *limit, const long *maxp1, sys_float *result, sys_float *abserr, long *neval, long *ier, sys_float *rslst, sys_float *erlst, long *ierlst, long *lst, sys_float *alist__, sys_float *blist, sys_float *rlist, sys_float *elist, long *iord, long *nnlog, sys_float *chebmo)
Definition: thirdparty_quadpack.cpp:14119
thirdparty_quadpack.h
qawce_
void qawce_(const E_fp &f, const sys_float *a, const sys_float *b, const sys_float *c__, const sys_float *epsabs, const sys_float *epsrel, const long *limit, sys_float *result, sys_float *abserr, long *neval, long *ier, sys_float *alist__, sys_float *blist, sys_float *rlist, sys_float *elist, long *iord, long *last)
Definition: thirdparty_quadpack.cpp:13526
dqc25c_
void dqc25c_(const D_fp &f, const double *a, const double *b, const double *c__, double *result, double *abserr, long *krul, long *neval)
Definition: thirdparty_quadpack.cpp:6219
a2
static double a2[63]
Definition: atmdat_3body.cpp:18
qng_
void qng_(const E_fp &f, sys_float *a, sys_float *b, sys_float *epsabs, sys_float *epsrel, sys_float *result, sys_float *abserr, long *neval, long *ier)
Definition: thirdparty_quadpack.cpp:19577
qk31_
void qk31_(const E_fp &f, const sys_float *a, const sys_float *b, sys_float *result, sys_float *abserr, sys_float *resabs, sys_float *resasc)
Definition: thirdparty_quadpack.cpp:18634
dqagpe_
void dqagpe_(const D_fp &f, const double *a, const double *b, const long *npts2, const double *points, const double *epsabs, const double *epsrel, const long *limit, double *result, double *abserr, long *neval, long *ier, double *alist__, double *blist, double *rlist, double *elist, double *pts, long *iord, long *level, long *ndin, long *last)
Definition: thirdparty_quadpack.cpp:1547
dqawse_
void dqawse_(const D_fp &f, const double *a, const double *b, const double *alfa, const double *beta, const long *integr, const double *epsabs, const double *epsrel, const long *limit, double *result, double *abserr, long *neval, long *ier, double *alist__, double *blist, double *rlist, double *elist, long *iord, long *last)
Definition: thirdparty_quadpack.cpp:5565
c__26
static const long c__26
Definition: thirdparty_quadpack.cpp:77
Generated by   doxygen 1.8.5