/* figi.f -- translated by f2c (version 19961017).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "f2c.h"
/* Subroutine */ int figi_(integer *nm, integer *n, doublereal *t, doublereal
*d__, doublereal *e, doublereal *e2, integer *ierr)
{
/* System generated locals */
integer t_dim1, t_offset, i__1;
doublereal d__1;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
static integer i__;
/* GIVEN A NONSYMMETRIC TRIDIAGONAL MATRIX SUCH THAT THE PRODUCTS */
/* OF CORRESPONDING PAIRS OF OFF-DIAGONAL ELEMENTS ARE ALL */
/* NON-NEGATIVE, THIS SUBROUTINE REDUCES IT TO A SYMMETRIC */
/* TRIDIAGONAL MATRIX WITH THE SAME EIGENVALUES. IF, FURTHER, */
/* A ZERO PRODUCT ONLY OCCURS WHEN BOTH FACTORS ARE ZERO, */
/* THE REDUCED MATRIX IS SIMILAR TO THE ORIGINAL MATRIX. */
/* ON INPUT */
/* NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL */
/* ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM */
/* DIMENSION STATEMENT. */
/* N IS THE ORDER OF THE MATRIX. */
/* T CONTAINS THE INPUT MATRIX. ITS SUBDIAGONAL IS */
/* STORED IN THE LAST N-1 POSITIONS OF THE FIRST COLUMN, */
/* ITS DIAGONAL IN THE N POSITIONS OF THE SECOND COLUMN, */
/* AND ITS SUPERDIAGONAL IN THE FIRST N-1 POSITIONS OF */
/* THE THIRD COLUMN. T(1,1) AND T(N,3) ARE ARBITRARY. */
/* ON OUTPUT */
/* T IS UNALTERED. */
/* D CONTAINS THE DIAGONAL ELEMENTS OF THE SYMMETRIC MATRIX. */
/* E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE SYMMETRIC */
/* MATRIX IN ITS LAST N-1 POSITIONS. E(1) IS NOT SET. */
/* E2 CONTAINS THE SQUARES OF THE CORRESPONDING ELEMENTS OF E. */
/* E2 MAY COINCIDE WITH E IF THE SQUARES ARE NOT NEEDED. */
/* IERR IS SET TO */
/* ZERO FOR NORMAL RETURN, */
/* N+I IF T(I,1)*T(I-1,3) IS NEGATIVE, */
/* -(3*N+I) IF T(I,1)*T(I-1,3) IS ZERO WITH ONE FACTOR */
/* NON-ZERO. IN THIS CASE, THE EIGENVECTORS OF */
/* THE SYMMETRIC MATRIX ARE NOT SIMPLY RELATED */
/* TO THOSE OF T AND SHOULD NOT BE SOUGHT. */
/* QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, */
/* MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY
*/
/* THIS VERSION DATED AUGUST 1983. */
/* ------------------------------------------------------------------
*/
/* Parameter adjustments */
t_dim1 = *nm;
t_offset = t_dim1 + 1;
t -= t_offset;
--e2;
--e;
--d__;
/* Function Body */
*ierr = 0;
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
if (i__ == 1) {
goto L90;
}
e2[i__] = t[i__ + t_dim1] * t[i__ - 1 + t_dim1 * 3];
if ((d__1 = e2[i__]) < 0.) {
goto L1000;
} else if (d__1 == 0) {
goto L60;
} else {
goto L80;
}
L60:
if (t[i__ + t_dim1] == 0. && t[i__ - 1 + t_dim1 * 3] == 0.) {
goto L80;
}
/* .......... SET ERROR -- PRODUCT OF SOME PAIR OF OFF-DIAGONAL */
/* ELEMENTS IS ZERO WITH ONE MEMBER NON-ZERO ..........
*/
*ierr = -(*n * 3 + i__);
L80:
e[i__] = sqrt(e2[i__]);
L90:
d__[i__] = t[i__ + (t_dim1 << 1)];
/* L100: */
}
goto L1001;
/* .......... SET ERROR -- PRODUCT OF SOME PAIR OF OFF-DIAGONAL */
/* ELEMENTS IS NEGATIVE .......... */
L1000:
*ierr = *n + i__;
L1001:
return 0;
} /* figi_ */
syntax highlighted by Code2HTML, v. 0.9.1