#include #include #include "keigen.h" void ke_core_strq(int n, double *q, double *b, double *c) { int i, j, k, u, v; double h, f, g, h2; for (i = n - 1; i >= 1; i--) { h = 0.0; if (i > 1) for (k = 0; k < i; k++) { u = i * n + k; h = h + q[u] * q[u]; } if (h + 1.0 == 1.0) { c[i] = 0.0; if (i == 1) c[i] = q[i * n + i - 1]; b[i] = 0.0; } else { c[i] = sqrt(h); u = i * n + i - 1; if (q[u] > 0.0) c[i] = -c[i]; h = h - q[u] * c[i]; q[u] = q[u] - c[i]; f = 0.0; for (j = 0; j < i; j++) { q[j * n + i] = q[i * n + j] / h; g = 0.0; for (k = 0; k <= j; k++) g = g + q[j * n + k] * q[i * n + k]; if (j + 1 < i) for (k = j + 1; k <= i - 1; k++) g = g + q[k * n + j] * q[i * n + k]; c[j] = g / h; f = f + g * q[j * n + i]; } h2 = f / (h + h); for (j = 0; j < i; j++) { f = q[i * n + j]; g = c[j] - h2 * f; c[j] = g; for (k = 0; k <= j; k++) { u = j * n + k; q[u] = q[u] - f * c[k] - g * q[i * n + k]; } } b[i] = h; } } for (i = 0; i < n - 1; i++) c[i] = c[i + 1]; c[n - 1] = 0.0; b[0] = 0.0; for (i = 0; i < n; i++) { if (b[i] != 0.0 && i - 1 >= 0) for (j = 0; j < i; j++) { g = 0.0; for (k = 0; k < i; k++) g = g + q[i * n + k] * q[k * n + j]; for (k = 0; k < i; k++) { u = k * n + j; q[u] = q[u] - g * q[k * n + i]; } } u = i * n + i; b[i] = q[u]; q[u] = 1.0; if (i - 1 >= 0) for (j = 0; j < i; j++) { q[i * n + j] = 0.0; q[j * n + i] = 0.0; } } } int ke_core_sstq(int n, double *b, double *c, double *q, int cal_ev, double eps, int l) { int i, j, k, m, it, u, v; double d, f, h, g, p, r, e, s; c[n - 1] = 0.0; d = 0.0; f = 0.0; for (j = 0; j < n; j++) { it = 0; h = eps * (fabs(b[j]) + fabs(c[j])); if (h > d) d = h; m = j; while (m < n && fabs(c[m]) > d) m = m + 1; if (m != j) { do { if (it == l) return KE_EXCESS_ITER; it = it + 1; g = b[j]; p = (b[j + 1] - g) / (2.0 * c[j]); r = sqrt(p * p + 1.0); if (p >= 0.0) b[j] = c[j] / (p + r); else b[j] = c[j] / (p - r); h = g - b[j]; for (i = j + 1; i < n; i++) b[i] = b[i] - h; f = f + h; p = b[m]; e = 1.0; s = 0.0; for (i = m - 1; i >= j; i--) { g = e * c[i]; h = e * p; if (fabs(p) >= fabs(c[i])) { e = c[i] / p; r = sqrt(e * e + 1.0); c[i + 1] = s * p * r; s = e / r; e = 1.0 / r; } else { e = p / c[i]; r = sqrt(e * e + 1.0); c[i + 1] = s * c[i] * r; s = 1.0 / r; e = e / r; } p = e * b[i] - s * g; b[i + 1] = h + s * (e * g + s * b[i]); if (cal_ev) { for (k = 0; k < n; k++) { u = k * n + i + 1; v = u - 1; h = q[u]; q[u] = s * q[v] + e * h; q[v] = e * q[v] - s * h; } } } c[j] = s * p; b[j] = e * p; } while (fabs(c[j]) > d); } b[j] = b[j] + f; } for (i = 0; i < n; i++) { k = i; p = b[i]; if (i + 1 < n) { j = i + 1; while (j < n && b[j] <= p) { k = j; p = b[j]; j = j + 1; } } if (k != i) { b[k] = b[i]; b[i] = p; for (j = 0; j < n; j++) { u = j * n + i; v = j * n + k; p = q[u]; q[u] = q[v]; q[v] = p; } } } return 0; } #define MALLOC(type, size) ((type*)malloc(size * sizeof(type))) int ke_eigen_sd(int n, double *a, double *v, int cal_ev, double eps, int max_iter) { double *c; int r; if (1.0 + eps <= 1.0) eps = 1e-7; if (max_iter <= 0) max_iter = 50; c = MALLOC(double, n); ke_core_strq(n, a, v, c); r = ke_core_sstq(n, v, c, a, cal_ev, eps, max_iter); free(c); return r; }