39 #include "sinfo_solve_poly_root.h"
42 #define GSL_SET_COMPLEX_PACKED(zp,n,x,y) \
43 do {*((zp)+2*(n))=(x); *((zp)+(2*(n)+1))=(y);} while(0)
44 #define GSL_DBL_EPSILON 2.2204460492503131e-16
48 sinfo_qr_companion (
double *h,
size_t nc, gsl_complex_packed_ptr zroot)
52 size_t iterations, e, i, j, k, m;
56 double p = 0, q = 0, r = 0;
76 for (e = n; e >= 2; e--)
78 double a1 = fabs (FMAT (h, e, e - 1, nc));
79 double a2 = fabs (FMAT (h, e - 1, e - 1, nc));
80 double a3 = fabs (FMAT (h, e, e, nc));
82 if (a1 <= GSL_DBL_EPSILON * (a2 + a3))
86 x = FMAT (h, n, n, nc);
90 GSL_SET_COMPLEX_PACKED (zroot, n-1, x + t, 0);
96 y = FMAT (h, n - 1, n - 1, nc);
97 w = FMAT (h, n - 1, n, nc) * FMAT (h, n, n - 1, nc);
113 GSL_SET_COMPLEX_PACKED (zroot, n-1, x - w / y, 0);
114 GSL_SET_COMPLEX_PACKED (zroot, n-2, x + y, 0);
118 GSL_SET_COMPLEX_PACKED (zroot, n-1, x + p, -y);
119 GSL_SET_COMPLEX_PACKED (zroot, n-2, x + p, y);
129 if (iterations == 60)
132 cpl_msg_error(
"qr:",
"too many iterations-give up") ;
136 if (iterations % 10 == 0 && iterations > 0)
142 for (i = 1; i <= n; i++)
144 FMAT (h, i, i, nc) -= x;
147 s = fabs (FMAT (h, n, n - 1, nc)) + fabs (FMAT (h, n - 1, n - 2, nc));
155 for (m = n - 2; m >= e; m--)
159 z = FMAT (h, m, m, nc);
162 p = FMAT (h, m, m + 1, nc) + (r * s - w) / FMAT (h, m + 1, m, nc);
163 q = FMAT (h, m + 1, m + 1, nc) - z - r - s;
164 r = FMAT (h, m + 2, m + 1, nc);
165 s = fabs (p) + fabs (q) + fabs (r);
173 a1 = fabs (FMAT (h, m, m - 1, nc));
174 a2 = fabs (FMAT (h, m - 1, m - 1, nc));
175 a3 = fabs (FMAT (h, m + 1, m + 1, nc));
177 if (a1 * (fabs (q) + fabs (r)) <= GSL_DBL_EPSILON * fabs (p) * (a2 + a3))
181 for (i = m + 2; i <= n; i++)
183 FMAT (h, i, i - 2, nc) = 0;
186 for (i = m + 3; i <= n; i++)
188 FMAT (h, i, i - 3, nc) = 0;
193 for (k = m; k <= n - 1; k++)
195 notlast = (k != n - 1);
199 p = FMAT (h, k, k - 1, nc);
200 q = FMAT (h, k + 1, k - 1, nc);
201 r = notlast ? FMAT (h, k + 2, k - 1, nc) : 0.0;
203 x = fabs (p) + fabs (q) + fabs (r);
213 s = sqrt (p * p + q * q + r * r);
220 FMAT (h, k, k - 1, nc) = -s * x;
224 FMAT (h, k, k - 1, nc) *= -1;
236 for (j = k; j <= n; j++)
238 p = FMAT (h, k, j, nc) + q * FMAT (h, k + 1, j, nc);
242 p += r * FMAT (h, k + 2, j, nc);
243 FMAT (h, k + 2, j, nc) -= p * z;
246 FMAT (h, k + 1, j, nc) -= p * y;
247 FMAT (h, k, j, nc) -= p * x;
250 j = (k + 3 < n) ? (k + 3) : n;
254 for (i = e; i <= j; i++)
256 p = x * FMAT (h, i, k, nc) + y * FMAT (h, i, k + 1, nc);
260 p += z * FMAT (h, i, k + 2, nc);
261 FMAT (h, i, k + 2, nc) -= p * r;
263 FMAT (h, i, k + 1, nc) -= p * q;
264 FMAT (h, i, k, nc) -= p;