/* DQAGP - Integration over finite intervals. (From QUADPACK)
* Accepts a list of known singularities.
*
* Adaptive integration routine which handles functions
* to be integrated between two finite bounds.
*
* The adaptive strategy compares results of integration
* over the given interval with the sum of results obtained
* from integration over a bisected interval. Since error
* estimates are available from each regional integration, the
* region with the largest error is bisected and new results
* are computed. This bisection process is continued until the
* error is less than the prescribed limit or convergence
* failure is determined.
*
* PARAMETERS:
*
* f() - double precision function to be integrated.
*
* a - lower limit of integration.
*
* b - upper limit of integration.
*
* npts2 - number equal to 2 more than the number of sinularities.
*
* points - vector of dimension npts2, the first (npts2-2) elements
* of which are the user provided interior break points.
*
* epsabs - absolute accuracy requested.
*
* epsrel - relative accuracy requested.
*/
double dqagp(dq_function_type f,double a,double b,int npts2,double *points,
double epsabs,double epsrel,double *abserr,int *neval,int *ier, void* user_data)
{
double abseps,alist[LIMIT],area,area1,area12,area2;
double a1,a2,blist[LIMIT],b1,b2,correc,defabs,defab1;
double defab2,dres,elist[LIMIT],erlarg,erlast,errbnd;
double errmax,error1,error2,erro12,errsum,ertest,ndin[40];
double pts[40],resa,resabs,reseps,result,res3la[3];
double rlist[LIMIT],rlist2[52],sign,temp;
int i,id,ierro,ind1,ind2,ip1,iord[LIMIT],iroff1,iroff2,iroff3;
int j,jlow,jupbnd,k,ksgn,ktmin,last,levcur,level[LIMIT],levmax;
int maxerr,nint,nintp1,npts,nres,nrmax,numrl2,limit,extrap,noext;
limit = LIMIT - 1;
/* Test validity of parameters. */
*ier = 0;
*neval = 0;
last = 0;
result = 0.0;
*abserr = 0.0;
alist[0] = a;
blist[0] = b;
rlist[0] = 0.0;
elist[0] = 0.0;
iord[0] = 0;
level[0] = 0;
npts = npts2-2;
if ((npts2 < 2) || (limit < npts) || ((epsabs < 0.0) &&
(epsrel < 0.0))) *ier = 6;
if (*ier == 6) goto _999;
/* If any break points are provided, sort them into an ascending sequence. */
sign = (a < b) ? 1.0 : -1.0;
pts[0] = min(a,b);
if (npts == 0) goto _15;
for (i = 0; i < npts; i++)
pts[i+1] = points[i];
_15:
pts[npts+1] = max(a,b);
nint = npts + 1;
a1 = pts[0];
if (npts == 0) goto _40;
nintp1 = nint + 1;
for (i = 0; i < nint; i++) {
ip1 = i + 1;
for (j = ip1; j < nintp1; j++) {
if (pts[i] <= pts[j])
goto _20;
temp = pts[i];
pts[i] = pts[j];
pts[j] = temp;
_20:
;
}
}
if ((pts[0] != min(a,b)) || (pts[nintp1-1] != max(a,b)))
*ier = 6;
if (*ier == 6)
goto _999;
/* Compute first integral and error approximations. */
_40:
resabs = 0.0;
for (i = 0; i < nint; i++) {
b1 = pts[i+1];
area1 = G_K21(f,a1,b1,&error1,&defabs,&resa, user_data);
*abserr = *abserr + error1;
result = result + area1;
ndin[i] = 0;
if ((error1 == resa) && (error1 != 0.0))
ndin[i] = 1;
resabs += defabs;
level[i] = 0;
elist[i] = error1;
alist[i] = a1;
blist[i] = b1;
rlist[i] = area1;
iord[i] = i;
a1 = b1;
}
errsum = 0.0;
for (i = 0; i < nint; i++) {
if (ndin[i] == 1)
elist[i] = *abserr;
errsum += elist[i];
}
/* Test on accuracy. */
/* last = nint; */
*neval = 21 * nint;
dres = fabs(result);
errbnd = max(epsabs,epsrel*dres);
if ((*abserr <= 100.0 * epmach * resabs) && (*abserr > errbnd))
*ier = 2;
if (nint == 0)
goto _80;
for (i = 0; i < npts; i++) {
jlow = i + 1;
ind1 = iord[i];
for (j = jlow; j < nint; j++) {
ind2 = iord[j];
if (elist[ind1] > elist[ind2])
goto _60; /* use continue after debugging */
ind1 = ind2;
k = j;
_60:
;
}
if (ind1 == iord[i])
goto _70;
iord[k] = iord[i];
iord[i] = ind1;
_70:
;
}
if (limit < npts2)
*ier = 1;
_80:
if ((*ier != 0) || (*abserr <= errbnd))
goto _999;
/* Initialization. */
res3la[0] = 0.0;
res3la[1] = 0.0;
res3la[2] = 0.0;
rlist2[0] = result;
maxerr = iord[0];
errmax = elist[maxerr];
area = result;
nrmax = 0;
nrmax = 0;
nres = -1; /* nres = 0 */
numrl2 = 0; /* numrl2 = 1 */
ktmin = 0;
extrap = FALSE;
noext = FALSE;
erlarg = errsum;
ertest = errbnd;
levmax = 1;
iroff1 = 0;
iroff2 = 0;
iroff3 = 0;
ierro = 0;
*abserr = oflow;
ksgn = -1;
if (dres > (1.0 - 50.0 * epmach) * resabs)
ksgn = 1;
/* Main loop. */
for (last = npts2; last <= limit; last++) {
/* Bisect the interval with the nrmax-th largest error estimate. */
levcur = level[maxerr] + 1;
a1 = alist[maxerr];
b1 = 0.5 * (alist[maxerr] + blist[maxerr]);
a2 = b1;
b2 = blist[maxerr];
erlast = errmax;
area1 = G_K21(f,a1,b1,&error1,&resa,&defab1, user_data);
area2 = G_K21(f,a2,b2,&error2,&resa,&defab2, user_data);
/* Improve previous approximations to integral and error
and test for accuracy. */
*neval += 42;
area12 = area1 + area2;
erro12 = error1 + error2;
errsum = errsum + erro12 - errmax;
area = area + area12 - rlist[maxerr];
if ((defab1 == error1) || (defab2 == error2)) goto _95;
if ((fabs(rlist[maxerr] - area12) > 1.0e-5 * fabs(area12))
|| (erro12 < .99 * errmax)) goto _90;
if (extrap) iroff2++;
else iroff1++;
_90:
if ((last > 9) && (erro12 > errmax)) /* last > 10 */
iroff3++;
_95:
level[maxerr] = levcur;
level[last] = levcur;
rlist[maxerr] = area1;
rlist[last] = area2;
errbnd = max(epsabs,epsrel * fabs(area));
/* Test for roundoff error and eventually set error flag. */
if (((iroff1 + iroff2) >= 10) || (iroff3 >= 20))
*ier = 2;
if (iroff2 > 5)
*ier = 3;
/* Set error flag in the case that the number of subintervals
equals limit. */
if (last == limit) /* last == limit */
*ier = 1;
/* Set error flag in the case of bad integrand behavior at some
points in the integration range. */
if (max(fabs(a1),fabs(b2)) <= (1.0 +1000.0 * epmach) *
(fabs(a2) + 1000.0*uflow))
*ier = 4;
/* Append the newly-created intervals to the list. */
if (error2 > error1) goto _100;
alist[last] = a2;
blist[maxerr] = b1;
blist[last] = b2;
elist[maxerr] = error1;
elist[last] = error2;
goto _110;
_100:
alist[maxerr] = a2;
alist[last] = a1;
blist[last] = b1;
rlist[maxerr] = area2;
rlist[last] = area1;
elist[maxerr] = error2;
elist[last] = error1;
/* Call dqsort to maintain the descending ordering in the list of error
estimates and select the subinterval with nrmax-th largest
error estimate (to be bisected next). */
_110:
dqsort(limit,last,&maxerr,&errmax,elist,iord,&nrmax);
if (errsum <= errbnd) goto _190;
if (*ier != 0) goto _170;
if (noext) goto _160;
erlarg -= erlast;
if (levcur+1 <= levmax)
erlarg += erro12;
if (extrap) goto _120;
/* Test whether the interval to be bisected next is the smallest interval. */
if ((level[maxerr]+1) <= levmax)
goto _160;
extrap = TRUE;
nrmax = 1; /* nrmax = 2 */
_120:
if ((ierro == 3) || (erlarg <= ertest)) goto _140;
/* The smallest interval has the largest error. Before bisecting, decrease
the sum of the errors over the larger intervals (erlarg) and
perform extrapolation.) */
id = nrmax;
jupbnd = last;
if (last > (2 + limit/2))
jupbnd = limit + 3 - last;
for (k = id;k <= jupbnd; k++) {
maxerr = iord[nrmax];
errmax = elist[maxerr];
if (level[maxerr]+1 <= levmax)
goto _160;
nrmax++;
}
/* Perform extrapolation. */
_140:
numrl2++;
rlist2[numrl2] = area;
if (numrl2 <= 1) goto _155;
reseps=dqext(&numrl2,rlist2,&abseps,res3la,&nres);
ktmin++;
if ((ktmin > 5) && (*abserr < 1.0e-3 * errsum)) *ier = 5;
if (abseps >= *abserr) goto _150;
ktmin = 0;
*abserr = abseps;
result = reseps;
correc = erlarg;
ertest = max(epsabs,epsrel * fabs(reseps));
if (*abserr <= ertest) goto _170;
/* Prepare bisection of the smallest interval. */
_150:
if (numrl2 == 0) noext = TRUE;
if (*ier == 5) goto _170;
_155:
maxerr = iord[0];
errmax = elist[maxerr];
nrmax = 0;
extrap = FALSE;
levmax += 1.0;
erlarg = errsum;
_160:
;
}
_170:
if (*abserr == oflow) goto _190;
if ((*ier + ierro) == 0) goto _180;
if (ierro == 3) *abserr += correc;
if (*ier == 0) *ier = 3;
if ((result != 0.0) && (area != 0.0)) goto _175;
if (*abserr > errsum) goto _190;
if (area == 0.0) goto _210;
goto _180;
_175:
if (*abserr/fabs(result) > errsum/fabs(area)) goto _190;
/* Test on divergence. */
_180:
if ((ksgn == -1) && (max(fabs(result),fabs(area)) <= defabs * .01))
goto _210;
if ((0.01 > result/area) || (result/area > 100.0) ||
(errsum > fabs(area))) *ier = 6;
goto _210;
/* Compute global integral. */
_190:
result = 0.0;
for (k = 0; k <= last; k++)
result += rlist[k];
*abserr = errsum;
_210:
if (*ier > 2) (*ier)--;
result = result * sign;
_999:
return result;
}
/* DQAGE - Approximation to definite integral. (From QUADPACK)
*
* Allows user's choice of Gauss-Kronrod integration rule.
*
* PARAMETERS:
*
* f() - double precision function to be integrated.
*
* a - lower limit of integration.
*
* b - upper limit of integration.
*
* epsabs - absolute accuracy requested.
*
* epsrel - relative accuracy requested.
*
* irule - integration rule to be used as follows:
* irule = 1 -- G_K 7-15
* irule = 2 -- G_K 10-21
* irule = 3 -- G_K 15-31
* irule = 4 -- G_K 20-41
* irule = 5 -- G_K 25-51
* irule = 6 -- G_K 30-61
*
* limit - maximum number of subintervals.
*/
double dqage(double f(double, void*),void * cbData,double a,double b,double epsabs,double epsrel,
int irule,double *abserr,int *neval,int *ier,int *last)
{
double area,area1,area2,area12,a1,a2,b1,b2,c,defabs;
double defab1,defab2,errbnd,errmax,error1,error2;
double erro12,errsum,resabs,result;
double alist[LIMIT],blist[LIMIT],rlist[LIMIT],elist[LIMIT];
int iroff1,iroff2,k,keyf,maxerr,nrmax,iord[LIMIT],limit;
limit = LIMIT - 1;
*ier = 0;
*neval = 0;
*last = 0;
result = 0.0;
*abserr = 0.0;
alist[0] = a;
blist[0] = b;
rlist[0] = 0.0;
elist[0] = 0.0;
iord[0] = 0;
defabs = 0.0;
resabs = 0.0;
if ((epsabs < 0.0) && (epsrel < 0.0))
*ier = 6;
if (*ier == 6) return result;
/* First approximation to the integral. */
keyf = irule;
if (irule <= 0) keyf = 1;
if (irule >= 7) keyf = 6;
c = keyf;
*neval = 0;
switch (keyf) {
case 1:
result = G_K15(f,cbData,a,b,abserr,&defabs,&resabs);
break;
case 2:
result = G_K21(f,cbData,a,b,abserr,&defabs,&resabs);
break;
case 3:
result = G_K31(f,cbData,a,b,abserr,&defabs,&resabs);
break;
case 4:
result = G_K41(f,cbData,a,b,abserr,&defabs,&resabs);
break;
case 5:
result = G_K51(f,cbData,a,b,abserr,&defabs,&resabs);
break;
case 6:
result = G_K61(f,cbData,a,b,abserr,&defabs,&resabs);
break;
}
*last = 0;
rlist[0] = result;
elist[0] = *abserr;
iord[0] = 0;
/* Test on accuracy. */
errbnd = max(epsabs,epsrel * fabs(result));
if ((*abserr <= 50.0 * epmach * defabs) && (*abserr > errbnd))
*ier = 2;
if (limit == 0) *ier = 1;
if ((*ier != 0) || ((*abserr <= errbnd) && (*abserr != resabs)) ||
(*abserr == 0.0)) goto _60;
/* Initialization. */
errmax = *abserr;
maxerr = 0;
area = result;
errsum = *abserr;
nrmax = 0;
iroff1 = 0;
iroff2 = 0;
/* Main Loop. */
for (*last = 1; *last <= limit; (*last)++) {
/* Bisect the subinterval with the largest error estimate. */
a1 = alist[maxerr];
b1 = 0.5 * (alist[maxerr] + blist[maxerr]);
a2 = b1;
b2 = blist[maxerr];
switch (keyf) {
case 1:
area1 = G_K15(f,cbData,a1,b1,&error1,&resabs,&defab1);
area2 = G_K15(f,cbData,a2,b2,&error2,&resabs,&defab2);
break;
case 2:
area1 = G_K21(f,cbData,a1,b1,&error1,&resabs,&defab1);
area2 = G_K21(f,cbData,a2,b2,&error2,&resabs,&defab2);
break;
case 3:
area1 = G_K31(f,cbData,a1,b1,&error1,&resabs,&defab1);
area2 = G_K31(f,cbData,a2,b2,&error2,&resabs,&defab2);
break;
case 4:
area1 = G_K41(f,cbData,a1,b1,&error1,&resabs,&defab1);
area2 = G_K41(f,cbData,a2,b2,&error2,&resabs,&defab2);
break;
case 5:
area1 = G_K51(f,cbData,a1,b1,&error1,&resabs,&defab1);
area2 = G_K51(f,cbData,a2,b2,&error2,&resabs,&defab2);
break;
case 6:
area1 = G_K61(f,cbData,a1,b1,&error1,&resabs,&defab1);
area2 = G_K61(f,cbData,a2,b2,&error2,&resabs,&defab2);
break;
}
/* Improve previous approximations to integral and error,
and test for accuracy. */
(*neval) += 1;
area12 = area1 + area2;
erro12 = error1 + error2;
errsum = errsum + erro12 - errmax;
area = area + area12 - rlist[maxerr];
if ((defab1 != error1) && (defab2 != error2)) {
if ((fabs(rlist[maxerr]-area12) <= 1.0e-5 * fabs(area12)) &&
(erro12 >= .99 * errmax))
iroff1++;
if ((*last > 9) && (erro12 > errmax))
iroff2++;
}
rlist[maxerr] = area1;
rlist[*last] = area2;
errbnd = max(epsabs,epsrel * fabs(area));
if (errsum > errbnd) {
/* Test for roundoff error and eventually set error flag. */
if ((iroff1 > 6) || (iroff2 > 20))
*ier = 2;
/* Set error flag in the case that the number of subintervals
equals the limit. */
if (*last == limit)
*ier = 1;
/* Set error flag in the case of bad integrand behavior at a
point of the integration range. */
if (max(fabs(a1),fabs(b2)) <= (1.0 + c * 1000.0 * epmach) *
(fabs(a2)+1.0e4 * uflow))
*ier = 3;
}
/* Append the newly-created intervals to the list. */
if (error2 <= error1) {
alist[*last] = a2;
blist[maxerr] = b1;
blist[*last] = b2;
elist[maxerr] = error1;
elist[*last] = error2;
}
else {
alist[maxerr] = a2;
alist[*last] = a1;
blist[*last] = b1;
rlist[maxerr] = area2;
rlist[*last] = area1;
elist[maxerr] = error2;
elist[*last] = error1;
}
/* Call DQSORT to maintain the descending ordering in the list of
error estimates and select the subinterval with the
largest error estimate (to be bisected next). */
dqsort(limit,*last,&maxerr,&errmax,elist,iord,&nrmax);
if ((*ier != 0) || (errsum <= errbnd)) break;
}
/* Compute final result. */
result = 0.0;
for (k = 0; k <= *last; k++) {
result += rlist[k];
}
*abserr = errsum;
_60:
if (keyf != 1)
*neval = (10 * keyf + 1) * (2 * (*neval) + 1);
else
*neval = 30 * (*neval) + 15;
return result;
}
double dqfour(dq_function_type f,double a,double b,double omega,
int sincos,double epsabs,double epsrel,
int icall,int maxp1,double *abserr,
int *neval,int *ier,
int *momcom,double **chebmo, void* user_data)
{
double abseps,area,area1,area12,area2;
double a1,a2,b1,b2,correc,defabs,defab1;
double defab2,domega,dres,erlarg,erlast,errbnd;
double errmax,error1,error2,erro12,errsum,ertest;
double resabs,reseps,result,res3la[3];
double alist[LIMIT],blist[LIMIT],rlist[LIMIT];
double elist[LIMIT],rlist2[52],small,width;
int id,ierro,iroff1,iroff2,iroff3,jupbnd,k,ksgn,limit;
int ktmin,last,maxerr,nev,nres,nrmax,nrmom,numrl2;
int extrap,noext,extall,iord[LIMIT],nnlog[LIMIT];
limit = LIMIT - 1;
/* Test validity of parameters. */
*ier = 0;
*neval = 0;
// last = 0;
result = 0.0;
*abserr = 0.0;
alist[0] = a;
blist[0] = b;
rlist[0] = 0.0;
elist[0] = 0.0;
iord[0] = 0;
nnlog[0] = 0;
if (((sincos != COSINE) && (sincos != SINE)) || ((epsabs < 0.0) &&
(epsrel < 0.0)) || (icall < 1) || (maxp1 < 1)) *ier = 6;
if (*ier == 6) return result;
/* First approximation to the integral. */
domega = fabs(omega);
nrmom = 0;
if (icall <= 1)
*momcom = 0;
_5:
result = dqc25o(f,a,b,domega,sincos,nrmom,maxp1,0,
abserr,neval,&defabs,&resabs,momcom,chebmo, user_data);
/* Test on accuracy. */
dres = fabs(result);
errbnd = max(epsabs,epsrel*dres);
rlist[0] = result;
elist[0] = *abserr;
iord[0] = 0;
if ((*abserr <= 100.0 * epmach * defabs) && (*abserr > errbnd))
*ier = 2;
if (limit == 0) *ier = 1;
if ((*ier != 0) || (*abserr <= errbnd) && (*abserr != resabs) ||
(*abserr == 0.0)) goto _200;
/* Initialization. */
errmax = *abserr;
maxerr = 0; /* maxerr = 1 */
area = result;
errsum = *abserr;
*abserr = oflow;
nrmax = 0;
extrap = FALSE;
noext = FALSE;
ierro = 0;
iroff1 = 0;
iroff2 = 0;
iroff3 = 0;
ktmin = 0;
small = fabs(b-a) * 0.75;
nres = 0;
numrl2 = -1;
extall = FALSE;
if ((0.5 * fabs(b-a) * domega) > 2.0)
goto _10;
numrl2 = 0;
extall = TRUE;
rlist2[0] = result;
_10:
if ((0.25 * fabs(b-a) * domega) <= 2.0)
extall = TRUE;
ksgn = -1;
if (dres > (1.0 - 50.0 * epmach) * defabs)
ksgn = 1;
/* Main loop. */
for (last = 1; last < limit; last++) {
/* Bisect the interval with the nrmax-th largest error estimate. */
nrmom = nnlog[maxerr] + 1;
a1 = alist[maxerr];
b1 = 0.5 * (alist[maxerr] + blist[maxerr]);
a2 = b1;
b2 = blist[maxerr];
erlast = errmax;
area1 = dqc25o(f,a1,b1,domega,sincos,nrmom,maxp1,0,
&error1,&nev,&resabs,&defab1,momcom,chebmo, user_data);
*neval += nev;
area2 = dqc25o(f,a2,b2,domega,sincos,nrmom,maxp1,1,
&error2,&nev,&resabs,&defab2,momcom,chebmo, user_data);
*neval += nev;
/* Improve previous approximations to integral and error
and test for accuracy. */
area12 = area1 + area2;
erro12 = error1 + error2;
errsum = errsum + erro12 - errmax;
area = area + area12 - rlist[maxerr];
if ((defab1 == error1) || (defab2 == error2)) goto _25;
if ((fabs(rlist[maxerr] - area12) > 1.0e-5 * fabs(area12))
|| (erro12 < .99 * errmax)) goto _20;
if (extrap) iroff2++;
else iroff1++;
_20:
if ((last > 9) && (erro12 > errmax)) /* last > 10 */
iroff3++;
_25:
rlist[maxerr] = area1;
rlist[last] = area2;
nnlog[maxerr] = nrmom;
nnlog[last] = nrmom;
errbnd = max(epsabs,epsrel * fabs(area));
/* Test for roundoff error and eventually set error flag. */
if (((iroff1 + iroff2) >= 10) || (iroff3 >= 20))
*ier = 2;
if (iroff2 >= 5)
*ier = 3;
/* Set error flag in the case that the number of subintervals
equals limit. */
if (last == limit) /* last == limit */
*ier = 1;
/* Set error flag in the case of bad integrand behavior at some
points in the integration range. */
if (max(fabs(a1),fabs(b2)) <= (1.0 +1000.0 * epmach) *
(fabs(a2) + 1000.0*uflow))
*ier = 4;
/* Append the newly-created intervals to the list. */
if (error2 <= error1) {
alist[last] = a2;
blist[maxerr] = b1;
blist[last] = b2;
elist[maxerr] = error1;
elist[last] = error2;
}
else {
alist[maxerr] = a2;
alist[last] = a1;
blist[last] = b1;
rlist[maxerr] = area2;
rlist[last] = area1;
elist[maxerr] = error2;
elist[last] = error1;
}
/* Call dqsort to maintain the descending ordering in the list of error
estimates and select the subinterval with nrmax-th largest
error estimate (to be bisected next). */
dqsort(limit,last,&maxerr,&errmax,elist,iord,&nrmax);
if (errsum <= errbnd) goto _170;
if (*ier != 0) goto _150;
if ((last == 1) && (extall)) goto _120; /* last == 2 */
if (noext) goto _140;
if (!extall) goto _50;
erlarg -= erlast;
if (fabs(b1-a1) > small)
erlarg += erro12;
if (extrap) goto _70;
/* Test whether the interval to be bisected next is the smallest interval. */
_50:
width = fabs(blist[maxerr] - alist[maxerr]);
if (width > small)
goto _140;
if (extall)
goto _60;
/* Test whether we can start with the extrapolation procedure (we do
* this if we integrate over the next interval with use of a Gauss-
* Kronrod rule) - see routine dqc25o. */
small *= 0.5;
if ((0.25 * width * domega) > 2.0)
goto _140;
extall = TRUE;
goto _130;
_60:
extrap = TRUE;
nrmax = 1; /* FORTRAN: nrmax = 2 */
_70:
if ((ierro == 3) || (erlarg <= ertest))
goto _90;
/* The smallest interval has the largest error. Before bisecting, decrease
the sum of the erorrs over the larger intervals (erlarg) and
perform extrapolation. */
jupbnd = last;
if (last > (2 + limit/2))
jupbnd = limit + 3 - last;
id = nrmax;
for (k = id;k <= jupbnd; k++) {
maxerr = iord[nrmax];
errmax = elist[maxerr];
if (fabs(blist[maxerr] - alist[maxerr]) > small)
goto _140;
nrmax++;
}
/* Perform extrapolation. */
_90:
numrl2++;
rlist2[numrl2] = area;
if (numrl2 < 2)
goto _110;
reseps = dqext(&numrl2,rlist2,&abseps,res3la,&nres);
ktmin++;
if ((ktmin > 5) && (*abserr < 1.0e-3 * errsum)) *ier = 5;
if (abseps >= *abserr) goto _100;
ktmin = 0;
*abserr = abseps;
result = reseps;
correc = erlarg;
ertest = max(epsabs,epsrel * fabs(reseps));
if (*abserr <= ertest) goto _150;
/* Prepare bisection of the smallest interval. */
_100:
if (numrl2 == 0) noext = TRUE;
if (*ier == 5) goto _150;
_110:
maxerr = iord[0];
errmax = elist[maxerr];
nrmax = 0;
extrap = FALSE;
small *= 0.5;
erlarg = errsum;
goto _140;
_120:
small *= 0.5;
numrl2++;
rlist2[numrl2] = area;
_130:
erlarg = errsum;
ertest = errbnd;
_140:
;
}
/* Set the final result. */
_150:
if ((*abserr == oflow) || (nres == 0)) goto _170;
if ((*ier + ierro) == 0) goto _165;
if (ierro == 3) *abserr += correc;
if (*ier == 0) *ier = 3;
if ((result != 0.0) && (area != 0.0)) goto _160;
if (*abserr > errsum) goto _170;
if (area == 0.0) goto _190;
goto _165;
_160:
if (*abserr/fabs(result) > errsum/fabs(area)) goto _170;
/* Test on divergence. */
_165:
if ((ksgn == -1) && (max(fabs(result),fabs(area)) <= defabs * .01))
goto _190;
if ((0.01 > result/area) || (result/area > 100.0) ||
(errsum > fabs(area))) *ier = 6;
goto _190;
/* Compute global integral. */
_170:
result = 0.0;
for (k = 0; k <= last; k++)
result += rlist[k];
*abserr = errsum;
_190:
if (*ier > 2) (*ier)--;
_200:
if ((sincos == SINE) && (omega < 0.0))
result = - result;
return result;
}
/* DQAGS - Integration over finite intervals. (From QUADPACK)
*
* Adaptive integration routine which handles functions
* to be integrated between two finite bounds.
*
* The adaptive strategy compares results of integration
* over the given interval with the sum of results obtained
* from integration over a bisected interval. Since error
* estimates are available from each regional integration, the
* region with the largest error is bisected and new results
* are computed. This bisection process is continued until the
* error is less than the prescribed limit or convergence
* failure is determined.
*
* PARAMETERS:
*
* f() - double precision function to be integrated.
*
* a - lower limit of integration.
*
* b - upper limit of integration.
*
* epsabs - absolute accuracy requested.
*
* epsrel - relative accuracy requested.
*/
double dqags(dq_function_type f,double a,double b,double epsabs,
double epsrel,double *abserr,int *neval,int *ier, void* user_data)
{
double abseps,alist[LIMIT],area,area1,area12,area2;
double a1,a2,blist[LIMIT],b1,b2,correc,defabs,defab1;
double defab2,dres,elist[LIMIT],erlarg,erlast,errbnd;
double errmax,error1,error2,erro12,errsum,ertest;
double resabs,reseps,result,res3la[3],rlist[LIMIT];
double rlist2[52],small = 0; /* small will be initialized in _80 */
int id,ierro,iord[LIMIT],iroff1,iroff2,iroff3,jupbnd,k,ksgn;
int ktmin,last,maxerr,nres,nrmax,numrl2;
int limit;
int extrap,noext;
limit = LIMIT -1;
/* Test validity of parameters. */
*ier = 0;
*neval = 0;
result = 0.0;
*abserr = 0.0;
alist[0] = a;
blist[0] = b;
rlist[0] = 0.0;
elist[0] = 0.0;
if ((epsabs < 0.0) && (epsrel < 0.0)) *ier = 6;
if (*ier == 6) return result;
/* First approximation to the integral. */
ierro = 0;
result = G_K21(f,a,b,abserr,&defabs,&resabs, user_data);
/* Test on accuracy. */
dres = fabs(result);
errbnd = max(epsabs,epsrel*dres);
last = 1;
rlist[0] = result;
elist[0] = *abserr;
iord[0] = 0;
if ((*abserr <= 100.0 * epmach * defabs) && (*abserr > errbnd))
*ier = 2;
if (limit == 0) *ier = 1;
if ((*ier != 0) || ((*abserr <= errbnd) && (*abserr != resabs)) ||
(*abserr == 0.0)) goto _140;
/* Initialization. */
rlist2[0] = result;
errmax = *abserr;
maxerr = 0; /* maxerr = 1 */
area = result;
errsum = *abserr;
*abserr = oflow;
nrmax = 0;
nres = 0; /* nres = 0 */
numrl2 = 1; /* numrl2 = 2 */
ktmin = 0;
extrap = FALSE;
noext = FALSE;
ierro = 0;
iroff1 = 0;
iroff2 = 0;
iroff3 = 0;
ksgn = -1;
if (dres > (1.0 - 50.0 * epmach) * defabs)
ksgn = 1;
/* Main loop. */
for (last = 1; last <= limit; last++) {
/* Bisect the interval with the nrmax-th largest error estimate. */
a1 = alist[maxerr];
b1 = 0.5 * (alist[maxerr] + blist[maxerr]);
a2 = b1;
b2 = blist[maxerr];
erlast = errmax;
area1 = G_K21(f,a1,b1,&error1,&resabs,&defab1, user_data);
area2 = G_K21(f,a2,b2,&error2,&resabs,&defab2, user_data);
/* Improve previous approximation's to integral and error
and test for accuracy. */
area12 = area1 + area2;
erro12 = error1 + error2;
errsum = errsum + erro12 - errmax;
area = area + area12 - rlist[maxerr];
if ((defab1 == error1) || (defab2 == error2)) goto _15;
if ((fabs(rlist[maxerr] - area12) > 1.0e-5 * fabs(area12))
|| (erro12 < .99 * errmax)) goto _10;
if (extrap) iroff2++;
else iroff1++;
_10:
if ((last > 9) && (erro12 > errmax)) /* last > 10 */
iroff3++;
_15:
rlist[maxerr] = area1;
rlist[last] = area2;
errbnd = max(epsabs,epsrel * fabs(area));
/* Test for roundoff error and eventually set error flag. */
if (((iroff1 + iroff2) >= 10) || (iroff3 >= 20))
*ier = 2;
if (iroff2 > 5)
ierro = 3;
/* Set error flag in the case that the number of subintervals
equals limit. */
if (last == limit) /* last == limit */
*ier = 1;
/* Set error flag in the case of bad integrand behavior at some
points in the integration range. */
if (max(fabs(a1),fabs(b2)) <= (1.0 +1000.0 * epmach) *
(fabs(a2) + 1000.0*uflow))
*ier = 4;
/* Append the newly-created intervals to the list. */
if (error2 > error1) goto _20;
alist[last] = a2;
blist[maxerr] = b1;
blist[last] = b2;
elist[maxerr] = error1;
elist[last] = error2;
goto _30;
_20:
alist[maxerr] = a2;
alist[last] = a1;
blist[last] = b1;
rlist[maxerr] = area2;
rlist[last] = area1;
elist[maxerr] = error2;
elist[last] = error1;
/* Call dqsort to maintain the descending ordering in the list of error
estimates and select the subinterval with nrmax-th largest
error estimate (to be bisected next). */
_30:
dqsort(limit,last,&maxerr,&errmax,elist,iord,&nrmax);
if (errsum <= errbnd) goto _115;
if (*ier != 0) goto _100;
if (last == 1) goto _80; /* last == 2 */
if (noext) goto _90; /* goto 90 */
erlarg -= erlast;
if (fabs(b1-a1) > small)
erlarg += erro12;
if (extrap) goto _40;
/* Test whether the interval to be bisected next is the smallest interval. */
if ((fabs(blist[maxerr] - alist[maxerr])) > small)
goto _90; /* goto 90 */
extrap = TRUE;
nrmax = 1; /* nrmax = 2 */
_40:
if ((ierro == 3) || (erlarg <= ertest)) goto _60;
/* The smallest interval has the largest error. Before bisecting, decrease
the sum of the errors over the larger intervals (erlarg) and
perform extrapolation.) */
id = nrmax;
jupbnd = last;
if (last > (2 + limit/2))
jupbnd = limit + 3 - last;
for (k = id;k <= jupbnd; k++) {
maxerr = iord[nrmax];
errmax = elist[maxerr];
if (fabs(blist[maxerr] - alist[maxerr]) > small)
goto _90; /* goto 90 */
nrmax++;
}
/* Perform extrapolation. */
_60:
numrl2++;
rlist2[numrl2] = area;
reseps=dqext(&numrl2,rlist2,&abseps,res3la,&nres);
ktmin++;
if ((ktmin > 5) && (*abserr < 1.0e-3 * errsum)) *ier = 5;
if (abseps >= *abserr) goto _70;
ktmin = 0;
*abserr = abseps;
result = reseps;
correc = erlarg;
ertest = max(epsabs,epsrel * fabs(reseps));
if (*abserr <= ertest) goto _100;
/* Prepare bisection of the smallest interval. */
_70:
if (numrl2 == 0) noext = TRUE;
if (*ier == 5) goto _100;
maxerr = iord[0];
errmax = elist[maxerr];
nrmax = 0;
extrap = FALSE;
small = small * 0.5;
erlarg = errsum;
goto _90; /* goto 90 */
_80:
small = fabs(b-a)*0.375;
erlarg = errsum;
ertest = errbnd;
rlist2[1] = area;
_90:
;
} /* 90: */
_100:
if (*abserr == oflow) goto _115;
if ((*ier + ierro) == 0) goto _110;
if (ierro == 3) *abserr += correc;
if (*ier == 0) *ier = 3;
if ((result != 0.0) && (area != 0.0)) goto _105;
if (*abserr > errsum) goto _115;
if (area == 0.0) goto _130;
goto _110;
_105:
if (*abserr/fabs(result) > errsum/fabs(area)) goto _115;
/* Test on divergence. */
_110:
if ((ksgn == -1) && (max(fabs(result),fabs(area)) <= defabs * .01))
goto _130;
if ((0.01 > result/area) || (result/area > 100.0) ||
(errsum > fabs(area))) *ier = 6;
goto _130;
/* Compute global integral. */
_115:
result = 0.0;
for (k = 0; k <= last; k++)
result += rlist[k];
*abserr = errsum;
_130:
if (*ier > 2) (*ier)--;
_140:
*neval = 42 * last - 21;
return result;
}
/* DQAWSE - Approximation to integral with algebraic and/or logarithmic
* singularities.
*
* PARAMETERS:
*
* f() - double precision function to be integrated.
*
* a - double lower limit of integration.
*
* b - upper limit of integration.
*
* alfa - parameter in the weight function.
*
* beta - parameter in the weight function.
*
* wgtfunc - indicates which weight function is to be used.
* = 1: (x-a)^alfa * (b-x)^beta
* = 2: (x-a)^alfa * (b-x)^beta * log(x-a)
* = 3: (x-a)^alfa * (b-x)^beta * log(b-x)
* = 4: (x-a)^alfa * (b-x)^beta * log(x-a) * log(b-x)
*
* epsabs - absolute accuracy requested.
*
* epsrel - relative accuracy requested.
*
*/
double dqawse(double f(double, void *),void * cbData,double a,double b,double alfa,double beta,
int wgtfunc,double epsabs,double epsrel,double *abserr,
int *neval,int *ier)
{
double alist[LIMIT],blist[LIMIT],rlist[LIMIT],elist[LIMIT];
double ri[25],rj[25],rh[25],rg[25];
double area,area1,area12,area2,a1,a2,b1,b2,centre;
double errbnd,errmax,error1,erro12,error2,errsum;
double resas1,resas2,result;
int iord[LIMIT],iroff1,iroff2,k,last,limit,maxerr,nev,nrmax;
limit = LIMIT - 1;
/* Test on validity of parameters. */
*ier = 6;
*neval = 0;
rlist[0] = 0.0;
elist[0] = 0.0;
iord[0] = 0;
result = 0.0;
*abserr = 0.0;
if ((b <= a) || ((epsabs < 0.0) && (epsrel < 0.0)) ||
(alfa <= -1.0) || (beta <= -1.0) || (wgtfunc < 1) ||
(wgtfunc > 4) || (limit < 1)) goto _999;
*ier = 0;
/* Compute the modified Chebyshev moments. */
dqmomo(alfa,beta,ri,rj,rg,rh,wgtfunc);
/* Integrate over the invervals (a,(a+b)/2) and ((a+b)/2,b). */
centre = 0.5 * (a+b);
area1 = dqc25s(f,cbData,a,b,a,centre,alfa,beta,ri,rj,rg,rh,&error1,
&resas1,wgtfunc,&nev);
*neval = *neval + nev;
area2 = dqc25s(f,cbData,a,b,centre,b,alfa,beta,ri,rj,rg,rh,&error2,
&resas2,wgtfunc,&nev);
*neval = *neval + nev;
result = area1 + area2;
*abserr = error1 + error2;
/* Test on accuracy. */
errbnd = max(epsabs,epsrel * fabs(result));
/* Initialization. */
if (error1 >= error2) {
alist[0] = a;
alist[1] = centre;
blist[0] = centre;
blist[1] = b;
rlist[0] = area1;
rlist[1] = area2;
elist[0] = error1;
elist[1] = error2;
}
else {
alist[0] = centre;
alist[1] = a;
blist[0] = b;
blist[1] = centre;
rlist[0] = area2;
rlist[1] = area1;
elist[0] = error2;
elist[1] = error1;
}
iord[0] = 0;
iord[1] = 1;
if (limit == 1) *ier = 1;
if ((*abserr <= errbnd) || (*ier == 1)) goto _999;
errmax = elist[0];
maxerr = 0;
nrmax = 0;
area = result;
errsum = maxerr;
iroff1 = 0;
iroff2 = 0;
/* Main loop. */
for (last = 2;last < limit;last++) {
a1 = alist[maxerr];
b1 = 0.5 * (alist[maxerr]+blist[maxerr]);
a2 = b1;
b2 = blist[maxerr];
area1 = dqc25s(f,cbData,a,b,a1,b1,alfa,beta,ri,rj,rg,rh,&error1,
&resas1,wgtfunc,&nev);
*neval = *neval + nev;
area2 = dqc25s(f,cbData,a,b,a2,b2,alfa,beta,ri,rj,rg,rh,&error2,
&resas2,wgtfunc,&nev);
*neval = *neval + nev;
/* Improve previous approximation and error test for accuracy. */
area12 = area1 + area2;
erro12 = error1 + error2;
errsum += (erro12 - errmax);
area += (area12-rlist[maxerr]);
if ((a == a1) || (b == b2)) goto _30;
if ((resas1 == error1) || (resas2 == error2)) goto _30;
/* Test for roundoff error. */
if ((fabs(rlist[maxerr]-area12) < (1.0e-5 * fabs(area12))) &&
(erro12 >= (0.99 *errmax))) iroff1++;
if ((last > 9) && (erro12 > errmax)) iroff2++;
_30:
rlist[maxerr] = area1;
rlist[last] = area2;
/* Test on accuracy. */
errbnd = max(epsabs,epsrel*fabs(area));
if (errsum <= errbnd) goto _35;
/* Set error flag in the case that number of intervals exceeds limit. */
if (last == limit) *ier = 1;
/* Set error flag in the case of roundoff error. */
if ((iroff1 > 5) || (iroff2 > 19)) *ier = 2;
/* Set error flag in case of bad integrand behavior at interior points. */
if ( max(fabs(a1),fabs(b2)) <= ((1.0 + 1.0e3 * epmach) *
(fabs(a2)+1.0e3 * uflow)) ) *ier = 3;
/* Append the newly created intervals to the list. */
_35:
if (error2 <= error1) {
alist[last] = a2;
blist[maxerr] = b1;
blist[last] = b2;
elist[maxerr] = error1;
elist[last] = error2;
}
else {
alist[maxerr] = a2;
alist[last] = a1;
blist[last] = b1;
rlist[maxerr] = area2;
rlist[last] = area1;
elist[maxerr] = error2;
elist[last] = error1;
}
/* Call subroutine qsort to maintain the descending ordering. */
dqsort(limit,last,&maxerr,&errmax,elist,iord,&nrmax);
/* Jump out of loop. */
if ((*ier != 0) || (errsum <= errbnd)) break;
}
result = 0.0;
for (k=0;k<=last;k++) {
result += rlist[k];
}
*abserr = errsum;
_999:
return result;
}
