/* 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; }