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