double
sigma(double beta, double p) {
double fac2, fac3;
double term1, term2, term3;
double sum2, sum3, gama;
double delta, result;
delta = 1 + 4*quad(beta) + 3*qquad(beta);
gama = 1 + 2*quad(beta);
term1 = 2*pow((1 + 4*quad(beta)),-p/2.0);
fac2 = 2*pow(gama,-p);
sum2 = (1 + 2*p*qquad(beta)/quad(gama));
sum2 += (3*p*(p + 2)*qqquad(beta)/(4.0*qquad(gama)));
term2 = fac2 * sum2;
fac3 = (-4*pow(delta,-p/2.0));
sum3 = 1 + 3*p*qquad(beta)/(2*delta);
sum3 += p*(p+2)*qqquad(beta)/(2*quad(delta));
term3 = fac3 * sum3;
result = term1 + term2 + term3;
return result;
}
/* Rootr and rooti are assumed to contain starting points for the root
search on entry to lbpoly(). */
static int lbpoly(double *a, int order, double *rootr, double *rooti) {
int ord, ordm1, ordm2, itcnt, i, k, mmk, mmkp2, mmkp1, ntrys;
double err, p, q, delp, delq, b[MAXORDER], c[MAXORDER], den;
double lim0 = 0.5*sqrt(DBL_MAX);
for(ord = order; ord > 2; ord -= 2){
ordm1 = ord-1;
ordm2 = ord-2;
/* Here is a kluge to prevent UNDERFLOW! (Sometimes the near-zero
roots left in rootr and/or rooti cause underflow here... */
if(fabs(rootr[ordm1]) < 1.0e-10) rootr[ordm1] = 0.0;
if(fabs(rooti[ordm1]) < 1.0e-10) rooti[ordm1] = 0.0;
p = -2.0 * rootr[ordm1]; /* set initial guesses for quad factor */
q = (rootr[ordm1] * rootr[ordm1]) + (rooti[ordm1] * rooti[ordm1]);
for(ntrys = 0; ntrys < MAX_TRYS; ntrys++)
{
int found = false;
for(itcnt = 0; itcnt < MAX_ITS; itcnt++)
{
double lim = lim0 / (1 + fabs(p) + fabs(q));
b[ord] = a[ord];
b[ordm1] = a[ordm1] - (p * b[ord]);
c[ord] = b[ord];
c[ordm1] = b[ordm1] - (p * c[ord]);
for(k = 2; k <= ordm1; k++){
mmk = ord - k;
mmkp2 = mmk+2;
mmkp1 = mmk+1;
b[mmk] = a[mmk] - (p* b[mmkp1]) - (q* b[mmkp2]);
c[mmk] = b[mmk] - (p* c[mmkp1]) - (q* c[mmkp2]);
if (b[mmk] > lim || c[mmk] > lim)
break;
}
if (k > ordm1) { /* normal exit from for(k ... */
/* ???? b[0] = a[0] - q * b[2]; */
b[0] = a[0] - p * b[1] - q * b[2];
if (b[0] <= lim) k++;
}
if (k <= ord) /* Some coefficient exceeded lim; */
break; /* potential overflow below. */
err = fabs(b[0]) + fabs(b[1]);
if(err <= MAX_ERR) {
found = true;
break;
}
den = (c[2] * c[2]) - (c[3] * (c[1] - b[1]));
if(den == 0.0)
break;
delp = ((c[2] * b[1]) - (c[3] * b[0]))/den;
delq = ((c[2] * b[0]) - (b[1] * (c[1] - b[1])))/den;
p += delp;
q += delq;
} /* for(itcnt... */
if (found) /* we finally found the root! */
break;
else { /* try some new starting values */
p = ((double)rand() - 0.5*RAND_MAX)/(double)RAND_MAX;
q = ((double)rand() - 0.5*RAND_MAX)/(double)RAND_MAX;
}
} /* for(ntrys... */
if((itcnt >= MAX_ITS) && (ntrys >= MAX_TRYS)){
return(false);
}
if(!qquad(1.0, p, q,
&rootr[ordm1], &rooti[ordm1], &rootr[ordm2], &rooti[ordm2]))
return(false);
/* Update the coefficient array with the coeffs. of the
reduced polynomial. */
for( i = 0; i <= ordm2; i++) a[i] = b[i+2];
}
if(ord == 2){ /* Is the last factor a quadratic? */
if(!qquad(a[2], a[1], a[0],
&rootr[1], &rooti[1], &rootr[0], &rooti[0]))
return(false);
return(true);
}
if(ord < 1) {
return(false);
}
if( a[1] != 0.0) rootr[0] = -a[0]/a[1];
else {
rootr[0] = 100.0; /* arbitrary recovery value */
}
rooti[0] = 0.0;
return(true);
}
