Rpoly.cpp
Go to the documentation of this file.
1 #include "Rpoly.h"
2 
3 #include <iostream>
4 #include <fstream>
5 #include <cctype>
6 #include <cmath>
7 #include <cfloat>
8 
9 using namespace std;
10 
11 void rpoly_ak1(double op[MDP1], int* Degree, double zeror[MAXDEGREE], double zeroi[MAXDEGREE]){
12  int i, j, jj, l, N, NM1, NN, NZ, zerok;
13 
14  double K[MDP1], p[MDP1], pt[MDP1], qp[MDP1], temp[MDP1];
15  double bnd, df, dx, factor, ff, moduli_max, moduli_min, sc, x, xm;
16  double aa, bb, cc, lzi, lzr, sr, szi, szr, t, u, xx, xxx, yy;
17 
18  const double RADFAC = 3.14159265358979323846/180; // Degrees-to-radians conversion factor = pi/180
19  const double lb2 = log(2.0); // Dummy variable to avoid re-calculating this value in loop below
20  const double lo = DBL_MIN/DBL_EPSILON;
21  const double cosr = cos(94.0*RADFAC); // = -0.069756474
22  const double sinr = sin(94.0*RADFAC); // = 0.99756405
23 
24  if ((*Degree) > MAXDEGREE){
25  cout << "\nThe entered Degree is greater than MAXDEGREE. Exiting rpoly. No further action taken.\n";
26  *Degree = -1;
27  return;
28  } // End ((*Degree) > MAXDEGREE)
29 
30  //Do a quick check to see if leading coefficient is 0
31  if (op[0] != 0){
32 
33  N = *Degree;
34  xx = sqrt(0.5); // = 0.70710678
35  yy = -xx;
36 
37  // Remove zeros at the origin, if any
38  j = 0;
39  while (op[N] == 0){
40  zeror[j] = zeroi[j] = 0.0;
41  N--;
42  j++;
43  } // End while (op[N] == 0)
44 
45  NN = N + 1;
46 
47  // Make a copy of the coefficients
48  for (i = 0; i < NN; i++)
49  p[i] = op[i];
50 
51  while (N >= 1){ // Main loop
52  // Start the algorithm for one zero
53  if (N <= 2){
54  // Calculate the final zero or pair of zeros
55  if (N < 2){
56  zeror[(*Degree) - 1] = -(p[1]/p[0]);
57  zeroi[(*Degree) - 1] = 0.0;
58  } // End if (N < 2)
59  else { // else N == 2
60  Quad_ak1(p[0], p[1], p[2], &zeror[(*Degree) - 2], &zeroi[(*Degree) - 2], &zeror[(*Degree) - 1], &zeroi[(*Degree) - 1]);
61  } // End else N == 2
62  break;
63  } // End if (N <= 2)
64 
65  // Find the largest and smallest moduli of the coefficients
66 
67  moduli_max = 0.0;
68  moduli_min = DBL_MAX;
69 
70  for (i = 0; i < NN; i++){
71  x = fabs(p[i]);
72  if (x > moduli_max) moduli_max = x;
73  if ((x != 0) && (x < moduli_min)) moduli_min = x;
74  } // End for i
75 
76  // Scale if there are large or very small coefficients
77  // Computes a scale factor to multiply the coefficients of the polynomial. The scaling
78  // is done to avoid overflow and to avoid undetected underflow interfering with the
79  // convergence criterion.
80  // The factor is a power of the base.
81 
82  sc = lo/moduli_min;
83 
84  if (((sc <= 1.0) && (moduli_max >= 10)) || ((sc > 1.0) && (DBL_MAX/sc >= moduli_max))){
85  sc = ((sc == 0) ? DBL_MIN : sc);
86  l = (int)(log(sc)/lb2 + 0.5);
87  factor = pow(2.0, l);
88  if (factor != 1.0){
89  for (i = 0; i < NN; i++) p[i] *= factor;
90  } // End if (factor != 1.0)
91  } // End if (((sc <= 1.0) && (moduli_max >= 10)) || ((sc > 1.0) && (DBL_MAX/sc >= moduli_max)))
92 
93  // Compute lower bound on moduli of zeros
94 
95  for (i = 0; i < NN; i++) pt[i] = fabs(p[i]);
96  pt[N] = -(pt[N]);
97 
98  NM1 = N - 1;
99 
100  // Compute upper estimate of bound
101 
102  x = exp((log(-pt[N]) - log(pt[0]))/(double)N);
103 
104  if (pt[NM1] != 0) {
105  // If Newton step at the origin is better, use it
106  xm = -pt[N]/pt[NM1];
107  x = ((xm < x) ? xm : x);
108  } // End if (pt[NM1] != 0)
109 
110  // Chop the interval (0, x) until ff <= 0
111 
112  xm = x;
113  do {
114  x = xm;
115  xm = 0.1*x;
116  ff = pt[0];
117  for (i = 1; i < NN; i++) ff = ff *xm + pt[i];
118  } while (ff > 0); // End do-while loop
119 
120  dx = x;
121 
122  // Do Newton iteration until x converges to two decimal places
123 
124  do {
125  df = ff = pt[0];
126  for (i = 1; i < N; i++){
127  ff = x*ff + pt[i];
128  df = x*df + ff;
129  } // End for i
130  ff = x*ff + pt[N];
131  dx = ff/df;
132  x -= dx;
133  } while (fabs(dx/x) > 0.005); // End do-while loop
134 
135  bnd = x;
136 
137  // Compute the derivative as the initial K polynomial and do 5 steps with no shift
138 
139  for (i = 1; i < N; i++) K[i] = (double)(N - i)*p[i]/((double)N);
140  K[0] = p[0];
141 
142  aa = p[N];
143  bb = p[NM1];
144  zerok = ((K[NM1] == 0) ? 1 : 0);
145 
146  for (jj = 0; jj < 5; jj++) {
147  cc = K[NM1];
148  if (zerok){
149  // Use unscaled form of recurrence
150  for (i = 0; i < NM1; i++){
151  j = NM1 - i;
152  K[j] = K[j - 1];
153  } // End for i
154  K[0] = 0;
155  zerok = ((K[NM1] == 0) ? 1 : 0);
156  } // End if (zerok)
157 
158  else { // else !zerok
159  // Used scaled form of recurrence if value of K at 0 is nonzero
160  t = -aa/cc;
161  for (i = 0; i < NM1; i++){
162  j = NM1 - i;
163  K[j] = t*K[j - 1] + p[j];
164  } // End for i
165  K[0] = p[0];
166  zerok = ((fabs(K[NM1]) <= fabs(bb)*DBL_EPSILON*10.0) ? 1 : 0);
167  } // End else !zerok
168 
169  } // End for jj
170 
171  // Save K for restarts with new shifts
172  for (i = 0; i < N; i++) temp[i] = K[i];
173 
174  // Loop to select the quadratic corresponding to each new shift
175 
176  for (jj = 1; jj <= 20; jj++){
177 
178  // Quadratic corresponds to a double shift to a non-real point and its
179  // complex conjugate. The point has modulus BND and amplitude rotated
180  // by 94 degrees from the previous shift.
181 
182  xxx = -(sinr*yy) + cosr*xx;
183  yy = sinr*xx + cosr*yy;
184  xx = xxx;
185  sr = bnd*xx;
186  u = -(2.0*sr);
187 
188  // Second stage calculation, fixed quadratic
189 
190  Fxshfr_ak1(20*jj, &NZ, sr, bnd, K, N, p, NN, qp, u, &lzi, &lzr, &szi, &szr);
191 
192  if (NZ != 0){
193 
194  // The second stage jumps directly to one of the third stage iterations and
195  // returns here if successful. Deflate the polynomial, store the zero or
196  // zeros, and return to the main algorithm.
197 
198  j = (*Degree) - N;
199  zeror[j] = szr;
200  zeroi[j] = szi;
201  NN = NN - NZ;
202  N = NN - 1;
203  for (i = 0; i < NN; i++) p[i] = qp[i];
204  if (NZ != 1){
205  zeror[j + 1] = lzr;
206  zeroi[j + 1] = lzi;
207  } // End if (NZ != 1)
208  break;
209  } // End if (NZ != 0)
210  else { // Else (NZ == 0)
211 
212  // If the iteration is unsuccessful, another quadratic is chosen after restoring K
213  for (i = 0; i < N; i++) K[i] = temp[i];
214  } // End else (NZ == 0)
215 
216  } // End for jj
217 
218  // Return with failure if no convergence with 20 shifts
219 
220  if (jj > 20) {
221  cout << "\nFailure. No convergence after 20 shifts. Program terminated.\n";
222  *Degree -= N;
223  break;
224  } // End if (jj > 20)
225 
226  } // End while (N >= 1)
227  } // End if op[0] != 0
228  else { // else op[0] == 0
229  cout << "\nThe leading coefficient is zero. No further action taken. Program terminated.\n";
230  *Degree = 0;
231  } // End else op[0] == 0
232 
233  return;
234 } // End rpoly_ak1
235 
236 void Fxshfr_ak1(int L2, int* NZ, double sr, double v, double K[MDP1], int N, double p[MDP1], int NN, double qp[MDP1], double u, double* lzi, double* lzr, double* szi, double* szr)
237 {
238 
239  // Computes up to L2 fixed shift K-polynomials, testing for convergence in the linear or
240  // quadratic case. Initiates one of the variable shift iterations and returns with the
241  // number of zeros found.
242 
243  // L2 limit of fixed shift steps
244  // NZ number of zeros found
245 
246  int fflag, i, iFlag = 1, j, spass, stry, tFlag, vpass, vtry;
247  double a, a1, a3, a7, b, betas, betav, c, d, e, f, g, h, oss, ots=0, otv=0, ovv, s, ss, ts, tss, tv, tvv, ui, vi, vv;
248  double qk[MDP1], svk[MDP1];
249 
250  *NZ = 0;
251  betav = betas = 0.25;
252  oss = sr;
253  ovv = v;
254 
255  //Evaluate polynomial by synthetic division
256  QuadSD_ak1(NN, u, v, p, qp, &a, &b);
257 
258  tFlag = calcSC_ak1(N, a, b, &a1, &a3, &a7, &c, &d, &e, &f, &g, &h, K, u, v, qk);
259 
260  for (j = 0; j < L2; j++){
261 
262  fflag = 1;
263  //Calculate next K polynomial and estimate v
264  nextK_ak1(N, tFlag, a, b, a1, &a3, &a7, K, qk, qp);
265  tFlag = calcSC_ak1(N, a, b, &a1, &a3, &a7, &c, &d, &e, &f, &g, &h, K, u, v, qk);
266  newest_ak1(tFlag, &ui, &vi, a, a1, a3, a7, b, c, d, f, g, h, u, v, K, N, p);
267 
268  vv = vi;
269 
270  // Estimate s
271 
272  ss = ((K[N - 1] != 0.0) ? -(p[N]/K[N - 1]) : 0.0);
273 
274  ts = tv = 1.0;
275 
276  if ((j != 0) && (tFlag != 3)){
277 
278  // Compute relative measures of convergence of s and v sequences
279 
280  tv = ((vv != 0.0) ? fabs((vv - ovv)/vv) : tv);
281  ts = ((ss != 0.0) ? fabs((ss - oss)/ss) : ts);
282 
283  // If decreasing, multiply the two most recent convergence measures
284 
285  tvv = ((tv < otv) ? tv*otv : 1.0);
286  tss = ((ts < ots) ? ts*ots : 1.0);
287 
288  // Compare with convergence criteria
289 
290  vpass = ((tvv < betav) ? 1 : 0);
291  spass = ((tss < betas) ? 1 : 0);
292 
293  if ((spass) || (vpass)){
294 
295  // At least one sequence has passed the convergence test.
296  // Store variables before iterating
297 
298  for (i = 0; i < N; i++) svk[i] = K[i];
299 
300  s = ss;
301 
302  // Choose iteration according to the fastest converging sequence
303 
304  stry = vtry = 0;
305 
306  for ( ; ; ) {
307 
308  if ((fflag && ((fflag = 0) == 0)) && ((spass) && (!vpass || (tss < tvv)))){
309  ; // Do nothing. Provides a quick "short circuit".
310  } // End if (fflag)
311 
312  else { // else !fflag
313  QuadIT_ak1(N, NZ, ui, vi, szr, szi, lzr, lzi, qp, NN, &a, &b, p, qk, &a1, &a3, &a7, &c, &d, &e, &f, &g, &h, K);
314 
315  if ((*NZ) > 0) return;
316 
317  // Quadratic iteration has failed. Flag that it has been tried and decrease the
318  // convergence criterion
319 
320  iFlag = vtry = 1;
321  betav *= 0.25;
322 
323  // Try linear iteration if it has not been tried and the s sequence is converging
324  if (stry || (!spass)){
325  iFlag = 0;
326  } // End if (stry || (!spass))
327  else {
328  for (i = 0; i < N; i++) K[i] = svk[i];
329  } // End if (stry || !spass)
330 
331  } // End else fflag
332 
333  if (iFlag != 0){
334  RealIT_ak1(&iFlag, NZ, &s, N, p, NN, qp, szr, szi, K, qk);
335 
336  if ((*NZ) > 0) return;
337 
338  // Linear iteration has failed. Flag that it has been tried and decrease the
339  // convergence criterion
340 
341  stry = 1;
342  betas *= 0.25;
343 
344  if (iFlag != 0){
345 
346  // If linear iteration signals an almost double real zero, attempt quadratic iteration
347 
348  ui = -(s + s);
349  vi = s*s;
350  continue;
351 
352  } // End if (iFlag != 0)
353  } // End if (iFlag != 0)
354 
355  // Restore variables
356  for (i = 0; i < N; i++) K[i] = svk[i];
357 
358  // Try quadratic iteration if it has not been tried and the v sequence is converging
359 
360  if (!vpass || vtry) break; // Break out of infinite for loop
361 
362  } // End infinite for loop
363 
364  // Re-compute qp and scalar values to continue the second stage
365 
366  QuadSD_ak1(NN, u, v, p, qp, &a, &b);
367  tFlag = calcSC_ak1(N, a, b, &a1, &a3, &a7, &c, &d, &e, &f, &g, &h, K, u, v, qk);
368 
369  } // End if ((spass) || (vpass))
370 
371  } // End if ((j != 0) && (tFlag != 3))
372 
373  ovv = vv;
374  oss = ss;
375  otv = tv;
376  ots = ts;
377  } // End for j
378 
379  return;
380 } // End Fxshfr_ak1
381 
382 void QuadSD_ak1(int NN, double u, double v, double p[MDP1], double q[MDP1], double* a, double* b)
383 {
384  // Divides p by the quadratic 1, u, v placing the quotient in q and the remainder in a, b
385 
386  int i;
387 
388  q[0] = *b = p[0];
389  q[1] = *a = -((*b)*u) + p[1];
390 
391  for (i = 2; i < NN; i++){
392  q[i] = -((*a)*u + (*b)*v) + p[i];
393  *b = (*a);
394  *a = q[i];
395  } // End for i
396 
397  return;
398 } // End QuadSD_ak1
399 
400 int calcSC_ak1(int N, double a, double b, double* a1, double* a3, double* a7, double* c, double* d, double* e, double* f, double* g, double* h, double K[MDP1], double u, double v, double qk[MDP1])
401 {
402 
403  // This routine calculates scalar quantities used to compute the next K polynomial and
404  // new estimates of the quadratic coefficients.
405 
406  // calcSC - integer variable set here indicating how the calculations are normalized
407  // to avoid overflow.
408 
409  int dumFlag = 3; // TYPE = 3 indicates the quadratic is almost a factor of K
410 
411  // Synthetic division of K by the quadratic 1, u, v
412  QuadSD_ak1(N, u, v, K, qk, c, d);
413 
414  if (fabs((*c)) <= (100.0*DBL_EPSILON*fabs(K[N - 1]))) {
415  if (fabs((*d)) <= (100.0*DBL_EPSILON*fabs(K[N - 2]))) return dumFlag;
416  } // End if (fabs(c) <= (100.0*DBL_EPSILON*fabs(K[N - 1])))
417 
418  *h = v*b;
419  if (fabs((*d)) >= fabs((*c))){
420  dumFlag = 2; // TYPE = 2 indicates that all formulas are divided by d
421  *e = a/(*d);
422  *f = (*c)/(*d);
423  *g = u*b;
424  *a3 = (*e)*((*g) + a) + (*h)*(b/(*d));
425  *a1 = -a + (*f)*b;
426  *a7 = (*h) + ((*f) + u)*a;
427  } // End if(fabs(d) >= fabs(c))
428  else {
429  dumFlag = 1; // TYPE = 1 indicates that all formulas are divided by c;
430  *e = a/(*c);
431  *f = (*d)/(*c);
432  *g = (*e)*u;
433  *a3 = (*e)*a + ((*g) + (*h)/(*c))*b;
434  *a1 = -(a*((*d)/(*c))) + b;
435  *a7 = (*g)*(*d) + (*h)*(*f) + a;
436  } // End else
437 
438  return dumFlag;
439 } // End calcSC_ak1
440 
441 void nextK_ak1(int N, int tFlag, double a, double b, double a1, double* a3, double* a7, double K[MDP1], double qk[MDP1], double qp[MDP1])
442 {
443  // Computes the next K polynomials using the scalars computed in calcSC_ak1
444 
445  int i;
446  double temp;
447 
448  if (tFlag == 3){ // Use unscaled form of the recurrence
449  K[1] = K[0] = 0.0;
450 
451  for (i = 2; i < N; i++) K[i] = qk[i - 2];
452 
453  return;
454  } // End if (tFlag == 3)
455 
456  temp = ((tFlag == 1) ? b : a);
457 
458  if (fabs(a1) > (10.0*DBL_EPSILON*fabs(temp))){
459  // Use scaled form of the recurrence
460 
461  (*a7) /= a1;
462  (*a3) /= a1;
463  K[0] = qp[0];
464  K[1] = -((*a7)*qp[0]) + qp[1];
465 
466  for (i = 2; i < N; i++) K[i] = -((*a7)*qp[i - 1]) + (*a3)*qk[i - 2] + qp[i];
467 
468  } // End if (fabs(a1) > (10.0*DBL_EPSILON*fabs(temp)))
469  else {
470  // If a1 is nearly zero, then use a special form of the recurrence
471 
472  K[0] = 0.0;
473  K[1] = -(*a7)*qp[0];
474 
475  for (i = 2; i < N; i++) K[i] = -((*a7)*qp[i - 1]) + (*a3)*qk[i - 2];
476  } // End else
477 
478  return;
479 } // End nextK_ak1
480 
481 void newest_ak1(int tFlag, double* uu, double* vv, double a, double a1, double a3, double a7, double b, double c, double d, double f, double g, double h, double u, double v, double K[MDP1], int N, double p[MDP1])
482 {
483  // Compute new estimates of the quadratic coefficients using the scalars computed in calcSC_ak1
484 
485  double a4, a5, b1, b2, c1, c2, c3, c4, temp;
486 
487  (*vv) = (*uu) = 0.0; // The quadratic is zeroed
488 
489  if (tFlag != 3){
490 
491  if (tFlag != 2){
492  a4 = a + u*b + h*f;
493  a5 = c + (u + v*f)*d;
494  } // End if (tFlag != 2)
495  else { // else tFlag == 2
496  a4 = (a + g)*f + h;
497  a5 = (f + u)*c + v*d;
498  } // End else tFlag == 2
499 
500  // Evaluate new quadratic coefficients
501 
502  b1 = -K[N - 1]/p[N];
503  b2 = -(K[N - 2] + b1*p[N - 1])/p[N];
504  c1 = v*b2*a1;
505  c2 = b1*a7;
506  c3 = b1*b1*a3;
507  c4 = -(c2 + c3) + c1;
508  temp = -c4 + a5 + b1*a4;
509  if (temp != 0.0) {
510  *uu= -((u*(c3 + c2) + v*(b1*a1 + b2*a7))/temp) + u;
511  *vv = v*(1.0 + c4/temp);
512  } // End if (temp != 0)
513 
514  } // End if (tFlag != 3)
515 
516  return;
517 } // End newest_ak1
518 
519 void QuadIT_ak1(int N, int* NZ, double uu, double vv, double* szr, double* szi, double* lzr, double* lzi, double qp[MDP1], int NN, double* a, double* b, double p[MDP1], double qk[MDP1], double* a1, double* a3, double* a7, double* c, double* d, double* e, double* f, double* g, double* h, double K[MDP1])
520 {
521  // Variable-shift K-polynomial iteration for a quadratic factor converges only if the
522  // zeros are equimodular or nearly so.
523 
524  int i, j = 0, tFlag, triedFlag = 0;
525  double ee, mp, omp, relstp=0, t, u, ui, v, vi, zm;
526 
527  *NZ = 0; // Number of zeros found
528  u = uu; // uu and vv are coefficients of the starting quadratic
529  v = vv;
530 
531  do {
532  Quad_ak1(1.0, u, v, szr, szi, lzr, lzi);
533 
534  // Return if roots of the quadratic are real and not close to multiple or nearly
535  // equal and of opposite sign.
536 
537  if (fabs(fabs(*szr) - fabs(*lzr)) > 0.01*fabs(*lzr)) break;
538 
539  // Evaluate polynomial by quadratic synthetic division
540 
541  QuadSD_ak1(NN, u, v, p, qp, a, b);
542 
543  mp = fabs(-((*szr)*(*b)) + (*a)) + fabs((*szi)*(*b));
544 
545  // Compute a rigorous bound on the rounding error in evaluating p
546 
547  zm = sqrt(fabs(v));
548  ee = 2.0*fabs(qp[0]);
549  t = -((*szr)*(*b));
550 
551  for (i = 1; i < N; i++) ee = ee*zm + fabs(qp[i]);
552 
553  ee = ee*zm + fabs((*a) + t);
554  ee = (9.0*ee + 2.0*fabs(t) - 7.0*(fabs((*a) + t) + zm*fabs((*b))))*DBL_EPSILON;
555 
556  // Iteration has converged sufficiently if the polynomial value is less than 20 times this bound
557 
558  if (mp <= 20.0*ee){
559  *NZ = 2;
560  break;
561  } // End if (mp <= 20.0*ee)
562 
563  j++;
564 
565  // Stop iteration after 20 steps
566  if (j > 20) break;
567 
568  if (j >= 2){
569  if ((relstp <= 0.01) && (mp >= omp) && (!triedFlag)){
570  // A cluster appears to be stalling the convergence. Five fixed shift
571  // steps are taken with a u, v close to the cluster.
572 
573  relstp = ((relstp < DBL_EPSILON) ? sqrt(DBL_EPSILON) : sqrt(relstp));
574 
575  u -= u*relstp;
576  v += v*relstp;
577 
578  QuadSD_ak1(NN, u, v, p, qp, a, b);
579 
580  for (i = 0; i < 5; i++){
581  tFlag = calcSC_ak1(N, *a, *b, a1, a3, a7, c, d, e, f, g, h, K, u, v, qk);
582  nextK_ak1(N, tFlag, *a, *b, *a1, a3, a7, K, qk, qp);
583  } // End for i
584 
585  triedFlag = 1;
586  j = 0;
587 
588  } // End if ((relstp <= 0.01) && (mp >= omp) && (!triedFlag))
589 
590  } // End if (j >= 2)
591 
592  omp = mp;
593 
594  // Calculate next K polynomial and new u and v
595 
596  tFlag = calcSC_ak1(N, *a, *b, a1, a3, a7, c, d, e, f, g, h, K, u, v, qk);
597  nextK_ak1(N, tFlag, *a, *b, *a1, a3, a7, K, qk, qp);
598  tFlag = calcSC_ak1(N, *a, *b, a1, a3, a7, c, d, e, f, g, h, K, u, v, qk);
599  newest_ak1(tFlag, &ui, &vi, *a, *a1, *a3, *a7, *b, *c, *d, *f, *g, *h, u, v, K, N, p);
600 
601  // If vi is zero, the iteration is not converging
602  if (vi != 0){
603  relstp = fabs((-v + vi)/vi);
604  u = ui;
605  v = vi;
606  } // End if (vi != 0)
607  } while (vi != 0); // End do-while loop
608 
609  return;
610 
611 } //End QuadIT_ak1
612 
613 void RealIT_ak1(int* iFlag, int* NZ, double* sss, int N, double p[MDP1], int NN, double qp[MDP1], double* szr, double* szi, double K[MDP1], double qk[MDP1])
614 {
615 
616  // Variable-shift H-polynomial iteration for a real zero
617 
618  // sss - starting iterate
619  // NZ - number of zeros found
620  // iFlag - flag to indicate a pair of zeros near real axis
621 
622  int i, j = 0, nm1 = N - 1;
623  double ee, kv, mp, ms, omp, pv, s, t=0;
624 
625  *iFlag = *NZ = 0;
626  s = *sss;
627 
628  for ( ; ; ) {
629  pv = p[0];
630 
631  // Evaluate p at s
632  qp[0] = pv;
633  for (i = 1; i < NN; i++) qp[i] = pv = pv*s + p[i];
634 
635  mp = fabs(pv);
636 
637  // Compute a rigorous bound on the error in evaluating p
638 
639  ms = fabs(s);
640  ee = 0.5*fabs(qp[0]);
641  for (i = 1; i < NN; i++) ee = ee*ms + fabs(qp[i]);
642 
643  // Iteration has converged sufficiently if the polynomial value is less than
644  // 20 times this bound
645 
646  if (mp <= 20.0*DBL_EPSILON*(2.0*ee - mp)){
647  *NZ = 1;
648  *szr = s;
649  *szi = 0.0;
650  break;
651  } // End if (mp <= 20.0*DBL_EPSILON*(2.0*ee - mp))
652 
653  j++;
654 
655  // Stop iteration after 10 steps
656 
657  if (j > 10) break;
658 
659  if (j >= 2){
660  if ((fabs(t) <= 0.001*fabs(-t + s)) && (mp > omp)){
661  // A cluster of zeros near the real axis has been encountered;
662  // Return with iFlag set to initiate a quadratic iteration
663 
664  *iFlag = 1;
665  *sss = s;
666  break;
667  } // End if ((fabs(t) <= 0.001*fabs(s - t)) && (mp > omp))
668 
669  } //End if (j >= 2)
670 
671  // Return if the polynomial value has increased significantly
672 
673  omp = mp;
674 
675  // Compute t, the next polynomial and the new iterate
676  qk[0] = kv = K[0];
677  for (i = 1; i < N; i++) qk[i] = kv = kv*s + K[i];
678 
679  if (fabs(kv) > fabs(K[nm1])*10.0*DBL_EPSILON){
680  // Use the scaled form of the recurrence if the value of K at s is non-zero
681  t = -(pv/kv);
682  K[0] = qp[0];
683  for (i = 1; i < N; i++) K[i] = t*qk[i - 1] + qp[i];
684  } // End if (fabs(kv) > fabs(K[nm1])*10.0*DBL_EPSILON)
685  else { // else (fabs(kv) <= fabs(K[nm1])*10.0*DBL_EPSILON)
686  // Use unscaled form
687  K[0] = 0.0;
688  for (i = 1; i < N; i++) K[i] = qk[i - 1];
689  } // End else (fabs(kv) <= fabs(K[nm1])*10.0*DBL_EPSILON)
690 
691  kv = K[0];
692  for (i = 1; i < N; i++) kv = kv*s + K[i];
693 
694  t = ((fabs(kv) > (fabs(K[nm1])*10.0*DBL_EPSILON)) ? -(pv/kv) : 0.0);
695 
696  s += t;
697 
698  } // End infinite for loop
699 
700  return;
701 
702 } // End RealIT_ak1
703 
704 void Quad_ak1(double a, double b1, double c, double* sr, double* si, double* lr, double* li)
705 {
706  // Calculates the zeros of the quadratic a*Z^2 + b1*Z + c
707  // The quadratic formula, modified to avoid overflow, is used to find the larger zero if the
708  // zeros are real and both zeros are complex. The smaller real zero is found directly from
709  // the product of the zeros c/a.
710 
711  double b, d, e;
712 
713  *sr = *si = *lr = *li = 0.0;
714 
715  if (a == 0) {
716  *sr = ((b1 != 0) ? -(c/b1) : *sr);
717  return;
718  } // End if (a == 0))
719 
720  if (c == 0){
721  *lr = -(b1/a);
722  return;
723  } // End if (c == 0)
724 
725  // Compute discriminant avoiding overflow
726 
727  b = b1/2.0;
728  if (fabs(b) < fabs(c)){
729  e = ((c >= 0) ? a : -a);
730  e = -e + b*(b/fabs(c));
731  d = sqrt(fabs(e))*sqrt(fabs(c));
732  } // End if (fabs(b) < fabs(c))
733  else { // Else (fabs(b) >= fabs(c))
734  e = -((a/b)*(c/b)) + 1.0;
735  d = sqrt(fabs(e))*(fabs(b));
736  } // End else (fabs(b) >= fabs(c))
737 
738  if (e >= 0) {
739  // Real zeros
740 
741  d = ((b >= 0) ? -d : d);
742  *lr = (-b + d)/a;
743  *sr = ((*lr != 0) ? (c/(*lr))/a : *sr);
744  } // End if (e >= 0)
745  else { // Else (e < 0)
746  // Complex conjugate zeros
747 
748  *lr = *sr = -(b/a);
749  *si = fabs(d/a);
750  *li = -(*si);
751  } // End else (e < 0)
752 
753  return;
754 } // End Quad_ak1
755 /*
756 int main()
757 {
758  char rflag = 0; //Readiness flag
759 
760 cout << " rpoly_ak1 (14 July 2007)\n";
761 cout << "=========================================================================== \n";
762 cout << "This program calculates the roots of a polynomial of real coefficients:\n";
763 cout << "\nop[0]*x^N + op[1]*x^(N-1) + op[2]*x^(N-2) + . . . + op[N]*x^0 = 0 \n";
764 cout << "\n--------------------------------------------------------------------------- \n";
765 cout << "\nThis program can accept polynomials of degree 100 or less, specified by the\n";
766 cout << "constant MAXDEGREE. If a higher order polynomial is to be input, redefine\n";
767 cout << "MAXDEGREE and re-compile the program.\n";
768 cout << "\n--------------------------------------------------------------------------- \n";
769 cout << "\nAll relevant data for the polynomial whose roots will be sought should have\n";
770 cout << "been saved beforehand in a file named rpoly_ak1dat.txt.\n";
771 cout << "rpoly_ak1dat.txt should be in the same folder as the rpoly_ak1 executable. \n";
772 cout << "--------------------------------------------------------------------------- \n";
773 cout << "\nThe first entry of this file must be the degree, N, of the polynomial for\n";
774 cout << "which the roots are to be calculated.\n";
775 cout << "Entries for the coefficients of the polynomial should follow, starting with\n";
776 cout << "the coefficient for the highest power of x and working down to the coefficient\n";
777 cout << "for the x^0 term.\n";
778 cout << "\nThe data is assumed to be of type double. Variables used within this program\n";
779 cout << "are type double.\n";
780 cout << "\n--------------------------------------------------------------------------- \n";
781 cout << "\nThe output is written to the file rpoly_ak1out.txt.\n";
782 cout << "\nNote the returned value of the variable Degree.\n";
783 cout << "If Degree > 0, it specifies the number of zeros found.\n";
784 cout << "If Degree = 0, the leading coefficient of the input polynomial was 0.\n";
785 cout << "If Degree = -1, the input value of Degree was greater than MAXDEGREE.\n";
786 cout << "\n--------------------------------------------------------------------------- \n";
787 cout << "\nAdditional information is posted at the following URL:\n";
788 cout << "http://www.akiti.ca/rpoly_ak1_Intro.html\n";
789 cout << "--------------------------------------------------------------------------- \n";
790 cout << "\nIs everything ready (are you ready to continue?)? If yes, Enter y. \n";
791 cout << "Otherwise Enter any other key. \n";
792 cin >> rflag;
793 
794 if (toupper(rflag) == 'Y') {
795 
796  int Degree; // The degree of the polynomial to be solved
797  cout << "Appear to be ready. \n";
798 
799  ifstream in("rpoly_ak1dat.txt", ios::in);
800 
801  if (!in) {
802  cout << "Cannot open the input file.\n";
803  return 0;
804  }
805 
806  in >> Degree; //Input the polynomial degree from the file
807  if (Degree < 0) {
808  cout << "Invalid polynomial degree entered. Program terminated. \n";
809  in.close(); //Close the input file before terminating
810  return 0;
811  }
812 
813  ofstream out("rpoly_ak1out.txt", ios::out);
814  if (!out) {
815  cout << "Cannot open the output file. Program terminated.\n";
816  in.close(); //Close the input file before terminating
817  return 0;
818  }
819 
820  double op[MDP1], zeroi[MAXDEGREE], zeror[MAXDEGREE]; // Coefficient vectors
821  int i; // vector index
822 
823  //Input the polynomial coefficients from the file and put them in the op vector
824  for (i = 0; i < (Degree+1); i++){
825  in >> op[i];
826  }//End for i
827 
828  in.close(); //Close the input file
829 
830  rpoly_ak1(op, &Degree, zeror, zeroi);
831 
832  out << "Degree = " << Degree << ".\n";
833  out << "\n";
834 
835  if (Degree <= 0){
836  cout << "\nReturned from rpoly_ak1 and Degree had a value <= 0.\n";
837  } // End if (Degree <= 0)
838  else { // else Degree > 0
839  out.precision(DBL_DIG);
840  out << "The roots follow:\n";
841  out << "\n";
842  for (i = 0; i < Degree; i++){
843  out << zeror[i] << " + " << zeroi[i] << "i" << " \n";
844  }//End for i
845  } // End else Degree > 0
846 
847  out.close(); // Close the output file
848 } //End if rflag = 'Y'
849 else cout << "\nNot ready. Try again when ready with information. \n";
850 cout << "\nEnter any key to continue. \n";
851 cin >> rflag;
852 return 0;
853 } // End main program.
854 */
d
void newest_ak1(int tFlag, double *uu, double *vv, double a, double a1, double a3, double a7, double b, double c, double d, double f, double g, double h, double u, double v, double K[MDP1], int N, double p[MDP1])
Definition: Rpoly.cpp:481
void RealIT_ak1(int *iFlag, int *NZ, double *sss, int N, double p[MDP1], int NN, double qp[MDP1], double *szr, double *szi, double K[MDP1], double qk[MDP1])
Definition: Rpoly.cpp:613
#define MAXDEGREE
Definition: Rpoly.h:33
f
XmlRpcServer s
void nextK_ak1(int N, int tFlag, double a, double b, double a1, double *a3, double *a7, double K[MDP1], double qk[MDP1], double qp[MDP1])
Definition: Rpoly.cpp:441
void QuadIT_ak1(int N, int *NZ, double uu, double vv, double *szr, double *szi, double *lzr, double *lzi, double qp[MDP1], int NN, double *a, double *b, double p[MDP1], double qk[MDP1], double *a1, double *a3, double *a7, double *c, double *d, double *e, double *f, double *g, double *h, double K[MDP1])
Definition: Rpoly.cpp:519
void QuadSD_ak1(int NN, double u, double v, double p[MDP1], double q[MDP1], double *a, double *b)
Definition: Rpoly.cpp:382
int calcSC_ak1(int N, double a, double b, double *a1, double *a3, double *a7, double *c, double *d, double *e, double *f, double *g, double *h, double K[MDP1], double u, double v, double qk[MDP1])
Definition: Rpoly.cpp:400
TFSIMD_FORCE_INLINE const tfScalar & x() const
#define MDP1
Definition: Rpoly.h:34
void rpoly_ak1(double op[MDP1], int *Degree, double zeror[MAXDEGREE], double zeroi[MAXDEGREE])
Definition: Rpoly.cpp:11
void Fxshfr_ak1(int L2, int *NZ, double sr, double v, double K[MDP1], int N, double p[MDP1], int NN, double qp[MDP1], double u, double *lzi, double *lzr, double *szi, double *szr)
Definition: Rpoly.cpp:236
void Quad_ak1(double a, double b1, double c, double *sr, double *si, double *lr, double *li)
Definition: Rpoly.cpp:704


fiducial_pose
Author(s): Jim Vaughan
autogenerated on Thu Dec 28 2017 04:06:58