mirror of
https://github.com/nasa/trick.git
synced 2025-06-11 20:01:53 +00:00
19025d77ad
Reorganized. Created a new top level include directory that will hold all of Trick's header files. Moved all of the Trick headers to this directory. Created a libexec directory that holds all of the executables that users don't need to execute directly. Changed all of the executables remaining in bin to start with "trick-". In the sim_services directories changed all source files to find the Trick headers in their new location. Since all of the include files are gone in sim_services, removed the src directories as well, moving all of the source files up a level. Moved the makefiles, docs, man, and other architecture independent files into a top level share directory. Renamed lib_${TRICK_HOST_CPU} to lib64 or lib depending on the platform we're currently on.
refs #63
86 lines
2.7 KiB
C
86 lines
2.7 KiB
C
/*
|
|
PURPOSE: (Eigenvalues and eigenvectors of symmetric matrix)
|
|
|
|
REFERENCE: ((Numerical Recipes [FORTRAN]) (QL transformation with origin shifts))
|
|
|
|
ASSUMPTIONS AND LIMITATIONS: ((Square matrix))
|
|
|
|
PROGRAMMERS: (((M Schira) (MDSS) (Jan 1994) (v1.0) (Init Release))) */
|
|
|
|
#include <stdio.h>
|
|
#include <stdlib.h>
|
|
#include <math.h>
|
|
#include "trick/trick_math.h"
|
|
|
|
void eigen_ql(double *d, /* Inout: input diagonal elements, output eigenvalues */
|
|
double *e, /* In: off diagonal elements */
|
|
int n, /* In: array size */
|
|
double **z)
|
|
{ /* Out: eigenvectors */
|
|
int i, k, l, m, iter;
|
|
double f, g, r, s, c, p, dd, b;
|
|
|
|
if (n > 1) {
|
|
for (i = 1; i < n; i++)
|
|
e[i - 1] = e[i];
|
|
e[n - 1] = 0.0;
|
|
for (l = 0; l < n; l++) {
|
|
iter = 0;
|
|
label_1:
|
|
for (m = l; m < n - 1; m++) {
|
|
dd = fabs(d[m]) + fabs(d[m + 1]);
|
|
if (fabs(e[m]) + dd == dd)
|
|
goto label_2;
|
|
}
|
|
m = n - 1;
|
|
label_2:
|
|
if (m != l) {
|
|
if (iter == 30) {
|
|
fprintf(stderr, "30 iterations in tqli \n");
|
|
exit(0);
|
|
}
|
|
iter++;
|
|
g = (d[l + 1] - d[l]) / (2.0 * e[l]);
|
|
r = sqrt(g * g + 1.0);
|
|
g = d[m] - d[l] + e[l] / (g + copysign(r, g));
|
|
s = 1.0;
|
|
c = 1.0;
|
|
p = 0.0;
|
|
for (i = m - 1; i >= l; i--) {
|
|
f = s * e[i];
|
|
b = c * e[i];
|
|
if (fabs(f) >= fabs(g)) {
|
|
c = g / f;
|
|
r = sqrt(c * c + 1.0);
|
|
e[i + 1] = f * r;
|
|
s = 1.0 / r;
|
|
c = c * s;
|
|
} else {
|
|
s = f / g;
|
|
r = sqrt(s * s + 1.0);
|
|
e[i + 1] = g * r;
|
|
c = 1.0 / r;
|
|
s = s * c;
|
|
}
|
|
g = d[i + 1] - p;
|
|
r = (d[i] - g) * s + 2.0 * c * b;
|
|
p = s * r;
|
|
d[i + 1] = g + p;
|
|
g = c * r - b;
|
|
for (k = 0; k < n; k++) {
|
|
f = z[k][i + 1];
|
|
z[k][i + 1] = s * z[k][i] + c * f;
|
|
z[k][i] = c * z[k][i] - s * f;
|
|
}
|
|
}
|
|
d[l] -= p;
|
|
e[l] = g;
|
|
e[m] = 0.0;
|
|
goto label_1;
|
|
}
|
|
}
|
|
}
|
|
|
|
return;
|
|
}
|