int TSIL_Tanalytic (TSIL_REAL X, TSIL_REAL Y, TSIL_REAL Z, TSIL_COMPLEX S, TSIL_REAL QQ, TSIL_COMPLEX *result) { TSIL_REAL tmp; int success = 1; if (Y < Z) { tmp = Z; Z = Y; Y = tmp; } if (X < TSIL_TOL) { TSIL_Warn("Tanalytic", "T(x,y,z) is undefined for x = 0."); *result = TSIL_Infinity; } else if (Z < TSIL_TOL) *result = TSIL_Tx0y (X,Y,S,QQ); else if (TSIL_CABS(S) < TSIL_TOL) *result = TSIL_TAtZero(X, Y, Z, QQ); else if (TSIL_CABS(S-X) + TSIL_FABS(Y-Z) < TSIL_TOL) *result = TSIL_TxyyAtx(X,Y,QQ); else if (TSIL_CABS(S-Z) + TSIL_FABS(Y-X) < TSIL_TOL) *result = TSIL_TyyxAtx(Z,Y,QQ); else if (TSIL_CABS(S-Y) + TSIL_FABS(Z-X) < TSIL_TOL) *result = TSIL_TyyxAtx(Y,X,QQ); else success = 0; return success; }
TSIL_COMPLEX TSIL_Trilogunitdisk (TSIL_COMPLEX z) { TSIL_COMPLEX result; TSIL_REAL rez = TSIL_CREAL (z); TSIL_REAL absz = TSIL_CABS (z); TSIL_REAL absimz = TSIL_FABS (TSIL_CIMAG (z)); if (TSIL_CABS(z - 1.0L) < 2.0L * TSIL_TOL) result = cZeta3; else if (TSIL_CABS(z) < 2.0L * TSIL_TOL) result = 0.0L; else if (TSIL_CABS(TSIL_CLOG(z)) < trilog_CLZseries_radius) result = TSIL_TrilogCLZseries (z); else if (absz <= trilog_powerseries_radius) result = TSIL_Trilogseries (z); else if (rez <= 0.0L) result = TSIL_TrilogregionA (z); else if (rez <= absimz) result = TSIL_TrilogregionB (z); else { TSIL_Warn("TSIL_Trilogunitdisk", "trilog function yielding undefined result."); result = TSIL_Infinity; } return result; }
TSIL_COMPLEX TSIL_BAtZero (TSIL_REAL x, TSIL_REAL y, TSIL_REAL qq) { if (TSIL_FABS(x - y) > TSIL_TOL) return (TSIL_A(y,qq) - TSIL_A(x,qq))/(x - y); else return -TSIL_A(x,qq)/x - 1.0L; }
TSIL_COMPLEX TSIL_Aeps (TSIL_REAL x, TSIL_REAL qq) { TSIL_COMPLEX lnbarx = TSIL_Ap (x, qq); if (TSIL_FABS(x) < TSIL_TOL) return 0.0L; else return x * (-1.0L - 0.5L*Zeta2 + lnbarx - 0.5L*lnbarx*lnbarx); }
TSIL_COMPLEX TSIL_BprimeAtZero (TSIL_REAL x, TSIL_REAL y, TSIL_REAL qq) { TSIL_REAL xoy, onemxoy, onemxoy2, onemxoy3, onemxoy4, temp; if (x < y) {temp = y; y = x; x = temp;} xoy = x/y; onemxoy = 1.0L - xoy; if (TSIL_FABS(onemxoy) > 0.005) return (x*x - 2.L*TSIL_A(x,qq)*y - y*y + 2.L*x*TSIL_A(y,qq))/(2.L*TSIL_POW(x - y,3)); else { onemxoy2 = onemxoy * onemxoy; onemxoy3 = onemxoy2 * onemxoy; onemxoy4 = onemxoy3 * onemxoy; return (1.0L - onemxoy/2.0L - onemxoy2/5.0L - onemxoy3/10.0L - 2.0L*onemxoy4/35.0L - onemxoy2*onemxoy3/28.0L - onemxoy3*onemxoy3/42.0L - onemxoy4*onemxoy3/60.0L - 2.0L*onemxoy4*onemxoy4/165.0L - onemxoy3*onemxoy3*onemxoy3/110.0L - onemxoy3*onemxoy3*onemxoy4/143.0L - onemxoy3*onemxoy4*onemxoy4/182.0L - 2.0L*onemxoy4*onemxoy4*onemxoy4/455.0L)/(6.0L * x); } }
TSIL_COMPLEX SUMO_dBds (TSIL_REAL x, TSIL_REAL y, TSIL_COMPLEX s, TSIL_REAL qq, int interp) { TSIL_COMPLEX snew, dBdsplus, dBdsminus; TSIL_REAL delta; if (interp == NO) return TSIL_dBds (x,y,s,qq); delta = TSIL_CABS(s)/TSIL_POW(TSIL_SQRT(x)+TSIL_SQRT(y), 2) - 1.0L; if (TSIL_FABS(delta) > THRESH_TOL) return TSIL_dBds (x,y,s,qq); /* If we get here we interpolate: */ snew = (1.0L + THRESH_TOL)*s; dBdsplus = TSIL_dBds (x,y,snew,qq); snew = (1.0L - THRESH_TOL)*s; dBdsminus = TSIL_dBds (x,y,snew,qq); return 0.5L*(1.0L + delta/THRESH_TOL)*dBdsplus + 0.5L*(1.0L - delta/THRESH_TOL)*dBdsminus; }
TSIL_COMPLEX TSIL_Bp (TSIL_REAL X, TSIL_REAL Y, TSIL_COMPLEX S, TSIL_REAL QQ) { if (X < TSIL_TOL) { TSIL_Warn("Bp", "B(x',y) is undefined for x=0."); return TSIL_Infinity; } if (TSIL_CABS(1.0L - S/(X+Y+2.0L*TSIL_SQRT(X*Y))) < TSIL_TOL) { TSIL_Warn("Bp", "B(x',y) is undefined at s = (sqrt(x) + sqrt(y))^2."); return TSIL_Infinity; } if (TSIL_CABS(S) < TSIL_TOL) { if (TSIL_FABS(1.0L - X/Y) < TSIL_TOL) return (-0.5L/X); else return 1.0L/(Y-X) + Y*TSIL_LOG(X/Y)/((Y-X)*(Y-X)); } if (TSIL_CABS(1.0L - (X + Y - 2.0L*TSIL_SQRT(X*Y))/S) < TSIL_TOL) return (1.0L - TSIL_SQRT(Y/X) +0.5L*TSIL_LOG(Y/X))/(X + Y - 2.0L*TSIL_SQRT(X*Y)); else return ((X-Y-S)*TSIL_B(X,Y,S,QQ) + (X+Y-S)*TSIL_LOG(X/QQ) -2.0L*TSIL_A(Y,QQ) + 2.0L*(S-X))/TSIL_Delta(S,X,Y); }
TSIL_COMPLEX TSIL_A (TSIL_REAL x, TSIL_REAL qq) { if (TSIL_FABS(x) < TSIL_TOL) return 0.0; if (x > 0) return (x * (TSIL_LOG(x/qq) - 1.)); return (x * (TSIL_LOG(-x/qq) - 1. + I*PI)); }
TSIL_COMPLEX TSIL_Ap (TSIL_REAL x, TSIL_REAL qq) { if (TSIL_FABS(x) < TSIL_TOL) return 0.0; if (x > 0) return (TSIL_LOG(x/qq)); return (TSIL_LOG(-x/qq) + I*PI); }
void BracketMin (TSIL_REAL *ax, TSIL_REAL *bx, TSIL_REAL *cx, TSIL_REAL *fa, TSIL_REAL *fb, TSIL_REAL *fc, TSIL_REAL (*func)(TSIL_REAL)) { TSIL_REAL ulim, u, r, q, fu, dum; *fa = (*func)(*ax); *fb = (*func)(*bx); if (*fb > *fa) { SHFT(dum,*ax,*bx,dum) ; SHFT(dum,*fb,*fa,dum) ; } *cx = (*bx) + GOLD*(*bx - *ax); *fc = (*func)(*cx); while (*fb > *fc) { r = (*bx - *ax)*(*fb - *fc); q = (*bx - *cx)*(*fb - *fa); u = (*bx) - ((*bx - *cx)*q - (*bx - *ax)*r)/ (2.0L*SIGN(FMAX(TSIL_FABS(q-r),TINY), q-r)); ulim = (*bx) + GLIMIT*(*cx - *bx); if ((*bx - u)*(u - *cx) > 0.0) { fu = (*func)(u); if (fu < *fc) { *ax = *bx; *bx = u; *fa = *fb; *fb = fu; return; } else if (fu > *fb) { *cx = u; *fc = fu; return; } u = (*cx) + GOLD*(*cx - *bx); fu = (*func)(u); } else if ((*cx - u)*(u - ulim) > 0.0) { fu = (*func)(u); if (fu < *fc) { SHFT(*bx,*cx,u,*cx + GOLD*(*cx - *bx)) ; SHFT(*fb,*fc,fu,(*func)(u)) ; } } else if ((u-ulim)*(ulim-*cx) >= 0.0) { u = ulim; fu = (*func)(u); } else { u = *cx + GOLD*(*cx - *bx); fu = (*func)(u); } SHFT(*ax,*bx,*cx,u) ; SHFT(*fa,*fb,*fc,fu) ; } }
int SUMO_FPCompare (TSIL_REAL x, TSIL_REAL y) { TSIL_REAL tmp; TSIL_REAL absx, absy; absx = TSIL_FABS(x); absy = TSIL_FABS(y); /* First check for 0 = 0? */ if (absx < 1000*TSIL_TOL) { if (absy < 1000*TSIL_TOL) return TRUE; else return FALSE; } /* Make x the one with the larger abs value: */ if (absx < absy) { tmp = y; y = x; x = tmp; } if (TSIL_FABS(x-y) < absx*TSIL_TOL) return TRUE; else return FALSE; }
TSIL_COMPLEX SUMO_GetFunction (TSIL_DATA *foo, const char *which, int interp) { TSIL_REAL arg1, arg2, delta, snew; TSIL_COMPLEX Vplus, Vminus; TSIL_DATA gaak; /* This is cut and pasted from tsil_names.h: */ const char *vname[4][2] = {{"Vzxyv","Vzxvy"}, {"Vuyxv","Vuyvx"}, {"Vxzuv","Vxzvu"}, {"Vyuzv","Vyuvz"}}; /* If no interp requested, or not a V function, just return the usual thing: */ if (interp == NO || strncmp (which, "V", 1) != 0) return TSIL_GetFunction (foo, which); /* Check for a threshold case: */ if ( !strcmp(which, vname[0][0]) || !strcmp(which, vname[0][1]) || !strcmp(which, vname[2][0]) || !strcmp(which, vname[2][1])) { arg1 = foo->z; arg2 = foo->x; } else if ( !strcmp(which, vname[1][0]) || !strcmp(which, vname[1][1]) || !strcmp(which, vname[3][0]) || !strcmp(which, vname[3][1])) { arg1 = foo->u; arg2 = foo->y; } else { printf("This can never happen!!!\n"); exit(234); } delta = foo->s/TSIL_POW(TSIL_SQRT(arg1)+TSIL_SQRT(arg2),2) - 1.0L; if (TSIL_FABS(delta) > THRESH_TOL) return TSIL_GetFunction (foo, which); /* If we get here we interpolate: */ TSIL_SetParameters (&gaak, foo->x, foo->y, foo->z, foo->u, foo->v, foo->qq); snew = (1.0L + THRESH_TOL)*(foo->s); TSIL_Evaluate (&gaak, snew); Vplus = TSIL_GetFunction (&gaak, which); snew = (1.0L - THRESH_TOL)*(foo->s); TSIL_Evaluate (&gaak, snew); Vminus = TSIL_GetFunction (&gaak, which); return 0.5L*(1.0L + delta/THRESH_TOL)*Vplus + 0.5L*(1.0L - delta/THRESH_TOL)*Vminus; }
TSIL_COMPLEX TSIL_B0x (TSIL_REAL X, TSIL_COMPLEX S, TSIL_REAL QQ) { if (TSIL_FABS (X) < TSIL_TOL) return TSIL_B00(S,QQ); if (TSIL_CABS (S) < TSIL_TOL) return (1.0L - TSIL_LOG (X/QQ)); if (TSIL_CABS (1.0L - S/X) < 10.0L*TSIL_TOL) return 2.0L - TSIL_LOG(X/QQ); S = TSIL_AddIeps(S); return 2.0L + ((X - S)*TSIL_CLOG((X - S)/QQ) - X*TSIL_LOG(X/QQ))/S; }
TSIL_COMPLEX TSIL_B (TSIL_REAL X, TSIL_REAL Y, TSIL_COMPLEX S, TSIL_REAL QQ) { TSIL_REAL temp; TSIL_COMPLEX sqDeltaSXY, lnbarX, lnbarY; if (TSIL_FABS (X) < TSIL_FABS (Y)) {temp = Y; Y = X; X = temp;} if (TSIL_FABS (X) < TSIL_TOL) return TSIL_B00(S,QQ); if (TSIL_FABS (Y) < TSIL_TOL) return TSIL_B0x(X,S,QQ); if (TSIL_CABS (S) < TSIL_TOL) { if (TSIL_FABS (1.0L - Y/X) > 0.0L) return (1.0L + (Y*TSIL_LOG(Y/QQ) - X*TSIL_LOG(X/QQ))/(X-Y)); else return (-TSIL_LOG (X/QQ)); } S = TSIL_AddIeps(S); sqDeltaSXY = TSIL_CSQRT(TSIL_Delta(S, X, Y)); lnbarX = TSIL_LOG (X/QQ); lnbarY = TSIL_LOG (Y/QQ); /* Following avoids roundoff error for very negative s. */ if ((TSIL_CREAL(S) < -10.0L*(X+Y)) && (TSIL_CIMAG(S) < TSIL_TOL)) { return (2.0L - 0.5L * (lnbarX + lnbarY) + (sqDeltaSXY * TSIL_CLOG(0.5L*(X + Y - S + sqDeltaSXY)/Y) + 0.5L * (Y - X - sqDeltaSXY) * (lnbarX - lnbarY))/S); } return (2.0L - 0.5L * (lnbarX + lnbarY) + (-sqDeltaSXY * TSIL_CLOG(0.5L*(X + Y - S - sqDeltaSXY)/X) + 0.5L * (Y - X - sqDeltaSXY) * (lnbarX - lnbarY))/S); }
TSIL_COMPLEX TSIL_BepsAtZero (TSIL_REAL x, TSIL_REAL y, TSIL_REAL qq) { TSIL_COMPLEX lnbarx, lnbary; TSIL_REAL temp; if (x < y) {temp = x; x = y; y = temp;} if (x < TSIL_TOL) { TSIL_Warn("TSIL_BepsAtZero", "Beps(0,0) is undefined at s = 0."); return TSIL_Infinity; } lnbarx = TSIL_CLOG(x/qq); if (y < TSIL_TOL) return 1.0L + Zeta2/2.0L - lnbarx + lnbarx*lnbarx/2.0L; if (TSIL_FABS(x-y)/(x+y) < TSIL_TOL) return (Zeta2 + lnbarx*lnbarx)/2.0L; lnbary = TSIL_CLOG(y/qq); return 1.0L + Zeta2/2.0L + (x*lnbarx*(lnbarx/2.0L - 1.0L) - y*lnbary*(lnbary/2.0L - 1.0L))/(x-y); }
void SimplexMin (TSIL_REAL **p, TSIL_REAL y[], int ndim, TSIL_REAL ftol, TSIL_REAL (*func)(TSIL_REAL []), int *nfunc) { int i, ihi, ilo, inhi, j, mpts = ndim + 1; TSIL_REAL rtol, sum, swap, ysave, ytry, *psum; psum = (TSIL_REAL *) calloc (ndim, sizeof(TSIL_REAL)); *nfunc = 0; GET_PSUM ; for (;;) { ilo = 0; ihi = y[1]>y[2] ? (inhi=2,1) : (inhi=1,2); for (i=0; i<mpts; i++) { if (y[i] <= y[ilo]) ilo = i; if (y[i] > y[ihi]) { inhi = ihi; ihi = i; } else if (y[i] > y[inhi] && i != ihi) inhi = i; } rtol = 2.0L*TSIL_FABS(y[ihi]-y[ilo])/ (TSIL_FABS(y[ihi]) + TSIL_FABS(y[ilo]) + TINY); if (rtol < ftol) { SWAP(y[1],y[ilo]) ; for (i=0; i<ndim; i++) SWAP(p[1][i],p[ilo][i]) ; break; } if (*nfunc >= MAXEVALS) TSIL_Error ("simplexMin", "MAXEVALS exceeded", 42); *nfunc += 2; ytry = SimplexTry (p,y,psum,ndim,func,ihi,-1.0L); if (ytry <= y[ilo]) ytry = SimplexTry (p,y,psum,ndim,func,ihi,2.0L); else if (ytry >= y[inhi]) { ysave = y[ihi]; ytry = SimplexTry (p,y,psum,ndim,func,ihi,0.5L); if (ytry >= ysave) { for (i=0; i<mpts; i++) { if (i != ilo) { for (j=0; j<ndim; j++) p[i][j] = psum[j]=0.5L*(p[i][j] + p[ilo][j]); y[i] = (*func)(psum); } } *nfunc += ndim; GET_PSUM ; } } else --(*nfunc); } free (psum); return; }
void PowellMin (TSIL_REAL p[], TSIL_REAL **xi, int n, TSIL_REAL ftol, int *iter, TSIL_REAL *fret, TSIL_REAL (*func)(TSIL_REAL [])) { int i, ibig, j; TSIL_REAL del, fp, fptt, t, *pt, *ptt, *xit; pt = (TSIL_REAL *) calloc (n, sizeof(TSIL_REAL)); ptt = (TSIL_REAL *) calloc (n, sizeof(TSIL_REAL)); xit = (TSIL_REAL *) calloc (n, sizeof(TSIL_REAL)); *fret = (*func)(p); /* printf("Initial fret = %Lf\n", *fret); */ for (j=0; j<n; j++) pt[j] = p[j]; for (*iter=1; ; ++(*iter)) { fp = *fret; ibig = 0; del = 0.0; for (i=0; i<n; i++) { for (j=0; j<n; j++) xit[j] = xi[j][i]; fptt = *fret; linmin (p, xit, n, fret, func); if (fptt - *fret > del) { del = fptt - *fret; ibig = i; } } if (2.0L*(fp-(*fret)) <= ftol*(TSIL_FABS(fp)+TSIL_FABS(*fret))+TINY) { /* printf("Powell exiting...\n"); */ /* printf("fp = %Lf\n", fp); */ /* printf("fret = %Lf\n", *fret); */ free (xit); free (ptt); free (pt); return; } if (*iter == ITMAX) TSIL_Error ("PowellMin", "Max iterations exceeded", 42); for (j=0; j<n; j++) { ptt[j] = 2.0L*p[j] - pt[j]; xit[j] = p[j] - pt[j]; pt[j] = p[j]; } fptt = (*func)(ptt); if (fptt < fp) { t = 2.0L*(fp - 2.0L*(*fret) + fptt)*TSIL_POW(fp - (*fret) - del, 2) - del*TSIL_POW(fp - fptt, 2); if (t < 0.0) { linmin (p, xit, n, fret, func); for (j=0; j<n; j++) { xi[j][ibig] = xi[j][n-1]; xi[j][n-1] = xit[j]; } } } } }
TSIL_REAL BrentMin (TSIL_REAL ax, TSIL_REAL bx, TSIL_REAL cx, TSIL_REAL (*f)(TSIL_REAL), TSIL_REAL tol, TSIL_REAL *xmin) { int iter; TSIL_REAL a,b,d,etemp,fu,fv,fw,fx,p,q,r,tol1,tol2,u,v,w,x,xm; TSIL_REAL e = 0.0; a = (ax < cx ? ax : cx); b = (ax > cx ? ax : cx); x = w = v = bx; fw = fv = fx = (*f)(x); for (iter=1; iter<=ITMAX; iter++) { xm = 0.5L*(a + b); tol2 = 2.0L*(tol1 = tol*TSIL_FABS(x) + ZEPS); if (TSIL_FABS(x - xm) <= (tol2 - 0.5*(b-a))) { *xmin = x; /* printf("Brent: %d evaluations\n", iter); */ return fx; } if (TSIL_FABS(e) > tol1) { r = (x - w)*(fx - fv); q = (x - v)*(fx - fw); p = (x - v)*q - (x - w)*r; q = 2.0L*(q - r); if (q > 0.0) p = -p; q = TSIL_FABS(q); etemp = e; e = d; if (TSIL_FABS(p) >= TSIL_FABS(0.5L*q*etemp) || p <= q*(a - x) || p >= q*(b - x)) d = CGOLD*(e = (x >= xm ? a-x : b-x)); else { d = p/q; u = x + d; if (u-a < tol2 || b-u < tol2) d = SIGN(tol1, xm-x); } } else { d = CGOLD*(e = (x >= xm ? a-x: b-x)); } u = (TSIL_FABS(d) >= tol1 ? x+d : x + SIGN(tol1,d)); fu = (*f)(u); if (fu <= fx) { if (u >= x) a = x; else b = x; SHFT(v,w,x,u) ; SHFT(fv,fw,fx,fu) ; } else { if (u < x) a = u; else b = u; if (fu <= fw || w == x) { v = w; w = u; fv = fw; fw = fu; } else if (fu <= fv || v == x || v == w) { v = u; fv = fu; } } } TSIL_Error ("Brent", "Too many iterations", 42); *xmin = x; return fx; }
void TSIL_Compare (const char *name, TSIL_COMPLEX actual, TSIL_COMPLEX computed, TSIL_REAL allow_pass, TSIL_REAL allow_warn, int *result) { TSIL_REAL a_re, a_im, c_re, c_im, magnitude, err; int foo; a_re = TSIL_CREAL (actual); a_im = TSIL_CIMAG (actual); c_re = TSIL_CREAL (computed); c_im = TSIL_CIMAG (computed); magnitude = TSIL_CABS (actual) + TSIL_TOL; /* DGR */ if (TSIL_IsInfinite (actual)) { if (TSIL_IsInfinite (computed)) foo = PASS * PASS; else foo = FAIL; } else { /* Check Real part */ err = TSIL_FABS (a_re - c_re) / magnitude; if (err < allow_pass) foo = PASS; else if (err < allow_warn) foo = WARN; else { /* printf("\nFailure in re part: err = %Le\n", (long double) err); */ foo = FAIL; } /* Check Imaginary part */ err = TSIL_FABS (a_im - c_im) / magnitude; if (err < allow_pass) foo *= PASS; else if (err < allow_warn) foo *= WARN; else { /* printf("\nFailure in im part: err = %Le\n", (long double) err); */ foo *= FAIL; } } if (foo == 4) *result = PASS; else if (foo == 1 || foo == 2) { *result = WARN; printf ("\nWARN\n"); printf ("Expected for %s: ", name); TSIL_cprintfM (actual); printf ("\n"); printf ("Obtained for %s: ", name); TSIL_cprintfM (computed); printf ("\n"); } else if (foo == 0) { *result = FAIL; printf ("\nFAIL\n"); printf ("Expected for %s: ", name); TSIL_cprintfM (actual); printf ("\n"); printf ("Obtained for %s: ", name); TSIL_cprintfM (computed); printf ("\n"); } else printf ("NOPE! Can't EVER get here in TSIL_Compare!!!\n"); return; }
void TSIL_CaseGeneric (TSIL_DATA *foo) { TSIL_COMPLEX sInit, sFinal, rInit, rFinal, imDisp; TSIL_REAL sthresh; TSIL_REAL s = foo->s; TSIL_REAL qq = foo->qq; TSIL_REAL threshMin = foo->threshMin; TSIL_REAL smallestspecialpoint; TSIL_REAL temp; int i; TSIL_Info("GENERIC CASE"); /* Decide how to initialize; is s=0 a threshold, or close to one? */ if (threshMin < TSIL_TOL) { TSIL_Info("There is a threshold at s=0."); sInit = I*SINIT; TSIL_InitialValueThreshAt0 (foo, sInit); } else if (threshMin < THRESH_CUTOFF) { TSIL_Info("There is a threshold close to, but not at, s=0."); sInit = -SINIT; TSIL_InitialValue (foo, sInit); } else { sInit = 0.L + 0.L*I; TSIL_InitialValue (foo, 0.0L + 0.0L*I); } /* Find the point nearest s=0 that could give problems: */ smallestspecialpoint = (foo->threshold)[0]; for (i=1; i<(foo->nThresh); i++) { if ((foo->threshold)[i] < smallestspecialpoint) smallestspecialpoint = (foo->threshold)[i]; } for (i=0; i<(foo->nPthresh); i++) { if ((foo->pseudoThreshold)[i] < smallestspecialpoint) smallestspecialpoint = (foo->pseudoThreshold)[i]; } if (s < (smallestspecialpoint - THRESH_CUTOFF)) { /* Integrate along real s axis. */ sFinal = (TSIL_COMPLEX) 0.5L*s; if (threshMin < THRESH_CUTOFF) { /* The smallest threshold is either 0 or close to 0, so change variables to r = lnbar(-s) for the first part of integration. */ rInit = TSIL_CLOG(-sInit/qq); temp = -0.5L*s/qq; if (temp > TSIL_TOL) rFinal = TSIL_CLOG(temp); else if (temp < -TSIL_TOL) rFinal = TSIL_CLOG(-temp) - I*PI; else rFinal = TSIL_CLOG(0.001L*TSIL_EPSILON) - I*0.5L*PI; TSIL_Integrate (foo, rInit, rFinal, TSIL_MaxSteps(foo,rFinal-rInit), 3, 0.0L); } else TSIL_Integrate (foo, sInit, sFinal, TSIL_MaxSteps(foo,sFinal-sInit), 0, 0.0L); sInit = sFinal; sFinal = (TSIL_COMPLEX) s; TSIL_Integrate (foo, sInit, sFinal, TSIL_MaxSteps(foo, sFinal-sInit), 1, 0.0L); /* Set status value */ foo->status = REAXIS; } else { /* Integrate in complex s plane. */ /* No reason to go too far off the real axis if s is small. */ if (s < IM_DISPL/10.0) imDisp = 10.0L * s * I; else imDisp = IM_DISPL * I; sFinal = imDisp; if (threshMin < THRESH_CUTOFF) { TSIL_Info("Using ln(-s/qq) as independent variable for first leg of contour."); rInit = TSIL_CLOG(-sInit/qq); rFinal = TSIL_CLOG(-sFinal/qq); TSIL_Integrate (foo, rInit, rFinal, TSIL_MaxSteps(foo,rFinal-rInit), 3, 0.0L); } else TSIL_Integrate (foo, sInit, sFinal, TSIL_MaxSteps(foo,sFinal - sInit), 0, 0.0L); sInit = sFinal; sFinal = s + imDisp; TSIL_Integrate (foo, sInit, sFinal, TSIL_MaxSteps(foo,sFinal - sInit), 0, 0.0L); sInit = sFinal; sFinal = s; if (TSIL_NearThreshold (foo, &sthresh, THRESH_CUTOFF) == YES) { if (TSIL_FABS(sthresh) < TSIL_TOL) { rInit = TSIL_CLOG(-sInit/qq); rFinal = TSIL_CLOG(-sFinal/qq - I*TSIL_EPSILON); TSIL_Integrate (foo, rInit, rFinal, TSIL_MaxSteps(foo,rFinal-rInit), 3, 0.0L); } else { TSIL_Info("Using near-threshold stepper for final leg of contour."); rInit = TSIL_CLOG(1.L - sInit/sthresh); temp = 1.L - s/sthresh; if (temp > TSIL_TOL) rFinal = TSIL_CLOG(temp); else if (temp < -TSIL_TOL) rFinal = TSIL_CLOG(-temp) - I*PI; else rFinal = TSIL_CLOG(0.001L*TSIL_EPSILON) - I*0.5L*PI; TSIL_Integrate (foo, rInit, rFinal, TSIL_MaxSteps(foo,rFinal - rInit), 2, sthresh); } } else TSIL_Integrate (foo, sInit, sFinal, TSIL_MaxSteps(foo,sFinal - sInit), 1, 0.0L); /* Set status value */ foo->status = CONTOUR; } /* Check whether we had a double pole case in any of the U's and fix it, if necessary: */ if ((foo->x < TSIL_TOL) || (foo->y < TSIL_TOL) || (foo->z < TSIL_TOL) || (foo->u < TSIL_TOL)) TSIL_CorrectUs (foo); /* Finally, convert s*M to M */ foo->M.value /= s; return; }