/* Computes up to L2 fixed shift k-polynomials, * testing for convergence in the linear or quadratic * case. Initiates one of the variable shift * iterations and returns with the number of zeros * found. */ void fxshfr(int l2,int *nz) { double svu,svv,ui,vi,s; double betas,betav,oss,ovv,ss,vv,ts,tv; double ots,otv,tvv,tss; int type, i,j,iflag,vpass,spass,vtry,stry; *nz = 0; betav = 0.25; betas = 0.25; oss = sr; ovv = v; /* Evaluate polynomial by synthetic division. */ quadsd(n,&u,&v,p,qp,&a,&b); calcsc(&type); for (j=0;j<l2;j++) { /* Calculate next k polynomial and estimate v. */ nextk(&type); calcsc(&type); newest(type,&ui,&vi); vv = vi; /* Estimate s. */ ss = 0.0; if (k[n-1] != 0.0) ss = -p[n]/k[n-1]; tv = 1.0; ts = 1.0; if (j == 0 || type == 3) goto _70; /* Compute relative measures of convergence of s and v sequences. */ if (vv != 0.0) tv = fabs((vv-ovv)/vv); if (ss != 0.0) ts = fabs((ss-oss)/ss); /* If decreasing, multiply two most recent convergence measures. */ tvv = 1.0; if (tv < otv) tvv = tv*otv; tss = 1.0; if (ts < ots) tss = ts*ots; /* Compare with convergence criteria. */ vpass = (tvv < betav); spass = (tss < betas); if (!(spass || vpass)) goto _70; /* At least one sequence has passed the convergence test. * Store variables before iterating. */ svu = u; svv = v; for (i=0;i<n;i++) { svk[i] = k[i]; } s = ss; /* Choose iteration according to the fastest converging * sequence. */ vtry = 0; stry = 0; if ((spass && (!vpass)) || (tss < tvv)) goto _40; _20: quadit(&ui,&vi,nz); if (*nz > 0) return; /* Quadratic iteration has failed. Flag that it has * been tried and decrease the convergence criterion. */ vtry = 1; betav *= 0.25; /* Try linear iteration if it has not been tried and * the S sequence is converging. */ if (stry || !spass) goto _50; for (i=0;i<n;i++) { k[i] = svk[i]; } _40: realit(s,nz,&iflag); if (*nz > 0) return; /* Linear iteration has failed. Flag that it has been * tried and decrease the convergence criterion. */ stry = 1; betas *=0.25; if (iflag == 0) goto _50; /* If linear iteration signals an almost double real * zero attempt quadratic iteration. */ ui = -(s+s); vi = s*s; goto _20; /* Restore variables. */ _50: u = svu; v = svv; for (i=0;i<n;i++) { k[i] = svk[i]; } /* Try quadratic iteration if it has not been tried * and the V sequence is convergin. */ if (vpass && !vtry) goto _20; /* Recompute QP and scalar values to continue the * second stage. */ quadsd(n,&u,&v,p,qp,&a,&b); calcsc(&type); _70: ovv = vv; oss = ss; otv = tv; ots = ts; } }
/* Variable-shift k-polynomial iteration for a * quadratic factor converges only if the zeros are * equimodular or nearly so. * uu, vv - coefficients of starting quadratic. * nz - number of zeros found. */ void quadit(double *uu,double *vv,int *nz) { double ui,vi; double mp,omp,ee,relstp,t,zm; int type,i,j,tried; *nz = 0; tried = 0; u = *uu; v = *vv; j = 0; /* Main loop. */ _10: itercnt++; quad(1.0,u,v,&szr,&szi,&lzr,&lzi); /* Return if roots of the quadratic are real and not * close to multiple or nearly equal and of opposite * sign. */ if (fabs(fabs(szr)-fabs(lzr)) > 0.01 * fabs(lzr)) return; /* Evaluate polynomial by quadratic synthetic division. */ quadsd(n,&u,&v,p,qp,&a,&b); mp = fabs(a-szr*b) + fabs(szi*b); /* Compute a rigorous bound on the rounding error in * evaluating p. */ zm = sqrt(fabs(v)); ee = 2.0*fabs(qp[0]); t = -szr*b; for (i=1;i<n;i++) { ee = ee*zm + fabs(qp[i]); } ee = ee*zm + fabs(a+t); ee *= (5.0 *mre + 4.0*are); ee = ee - (5.0*mre+2.0*are)*(fabs(a+t)+fabs(b)*zm); ee = ee + 2.0*are*fabs(t); /* Iteration has converged sufficiently if the * polynomial value is less than 20 times this bound. */ if (mp <= 20.0*ee) { *nz = 2; return; } j++; /* Stop iteration after 20 steps. */ if (j > 20) return; if (j < 2) goto _50; if (relstp > 0.01 || mp < omp || tried) goto _50; /* A cluster appears to be stalling the convergence. * Five fixed shift steps are taken with a u,v close * to the cluster. */ if (relstp < eta) relstp = eta; relstp = sqrt(relstp); u = u - u*relstp; v = v + v*relstp; quadsd(n,&u,&v,p,qp,&a,&b); for (i=0;i<5;i++) { calcsc(&type); nextk(&type); } tried = 1; j = 0; _50: omp = mp; /* Calculate next k polynomial and new u and v. */ calcsc(&type); nextk(&type); calcsc(&type); newest(type,&ui,&vi); /* If vi is zero the iteration is not converging. */ if (vi == 0.0) return; relstp = fabs((vi-v)/vi); u = ui; v = vi; goto _10; }
types::Function::ReturnValue sci_newest(types::typed_list &in, int _iRetCount, types::typed_list &out) { int iRet = 0; int iNbrString = 0; wchar_t** pwcsStringInput = NULL; if (in.size() == 0) { out.push_back(types::Double::Empty()); return types::Function::OK; } if (in.size() == 1) { if (in[0]->isString() == FALSE) { if (in[0]->getAs<types::GenericType>()->getSize() == 0) { out.push_back(types::Double::Empty()); return types::Function::OK; } else { Scierror(999, _("%s: Wrong type for input argument #%d: A String(s) expected.\n"), "newest", 1); return types::Function::Error; } } if (in[0]->getAs<types::String>()->isScalar()) { out.push_back(new types::Double(1)); return types::Function::OK; } else { int size = in[0]->getAs<types::String>()->getSize(); pwcsStringInput = (wchar_t**)MALLOC(size * sizeof(wchar_t*)); for (iNbrString = 0; iNbrString < size; iNbrString++) { pwcsStringInput[iNbrString] = in[0]->getAs<types::String>()->get(iNbrString); } iRet = newest(pwcsStringInput, iNbrString); FREE(pwcsStringInput); out.push_back(new types::Double(iRet)); } } else { int size = (int)in.size(); pwcsStringInput = (wchar_t**)MALLOC(size * sizeof(wchar_t*)); for (iNbrString = 0; iNbrString < size; iNbrString++) { if (in[iNbrString]->isString() == FALSE) { FREE(pwcsStringInput); Scierror(999, _("%s: Wrong type for input argument #%d: A string expected.\n"), "newest", iNbrString + 1); return types::Function::Error; } pwcsStringInput[iNbrString] = in[iNbrString]->getAs<types::String>()->get(0); } if (in[1]->getAs<types::String>()->isScalar() == false) { FREE(pwcsStringInput); Scierror(999, _("%s: Wrong size for input argument #%d: A string expected.\n"), "newest", 2); return types::Function::Error; } iRet = newest(pwcsStringInput, iNbrString); FREE(pwcsStringInput); out.push_back(new types::Double((double)iRet)); } return types::Function::OK; }