00001 /* bakvec.f -- translated by f2c (version 19961017).
00002    You must link the resulting object file with the libraries:
00003         -lf2c -lm   (in that order)
00004 */
00005 
00006 #include "f2c.h"
00007 
00008 /* Subroutine */ int bakvec_(integer *nm, integer *n, doublereal *t, 
00009         doublereal *e, integer *m, doublereal *z__, integer *ierr)
00010 {
00011     /* System generated locals */
00012     integer t_dim1, t_offset, z_dim1, z_offset, i__1, i__2;
00013 
00014     /* Local variables */
00015     static integer i__, j;
00016 
00017 
00018 
00019 /*     THIS SUBROUTINE FORMS THE EIGENVECTORS OF A NONSYMMETRIC */
00020 /*     TRIDIAGONAL MATRIX BY BACK TRANSFORMING THOSE OF THE */
00021 /*     CORRESPONDING SYMMETRIC MATRIX DETERMINED BY  FIGI. */
00022 
00023 /*     ON INPUT */
00024 
00025 /*        NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL */
00026 /*          ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM */
00027 /*          DIMENSION STATEMENT. */
00028 
00029 /*        N IS THE ORDER OF THE MATRIX. */
00030 
00031 /*        T CONTAINS THE NONSYMMETRIC MATRIX.  ITS SUBDIAGONAL IS */
00032 /*          STORED IN THE LAST N-1 POSITIONS OF THE FIRST COLUMN, */
00033 /*          ITS DIAGONAL IN THE N POSITIONS OF THE SECOND COLUMN, */
00034 /*          AND ITS SUPERDIAGONAL IN THE FIRST N-1 POSITIONS OF */
00035 /*          THE THIRD COLUMN.  T(1,1) AND T(N,3) ARE ARBITRARY. */
00036 
00037 /*        E CONTAINS THE SUBDIAGONAL ELEMENTS OF THE SYMMETRIC */
00038 /*          MATRIX IN ITS LAST N-1 POSITIONS.  E(1) IS ARBITRARY. */
00039 
00040 /*        M IS THE NUMBER OF EIGENVECTORS TO BE BACK TRANSFORMED. */
00041 
00042 /*        Z CONTAINS THE EIGENVECTORS TO BE BACK TRANSFORMED */
00043 /*          IN ITS FIRST M COLUMNS. */
00044 
00045 /*     ON OUTPUT */
00046 
00047 /*        T IS UNALTERED. */
00048 
00049 /*        E IS DESTROYED. */
00050 
00051 /*        Z CONTAINS THE TRANSFORMED EIGENVECTORS */
00052 /*          IN ITS FIRST M COLUMNS. */
00053 
00054 /*        IERR IS SET TO */
00055 /*          ZERO       FOR NORMAL RETURN, */
00056 /*          2*N+I      IF E(I) IS ZERO WITH T(I,1) OR T(I-1,3) NON-ZERO. 
00057 */
00058 /*                     IN THIS CASE, THE SYMMETRIC MATRIX IS NOT SIMILAR 
00059 */
00060 /*                     TO THE ORIGINAL MATRIX, AND THE EIGENVECTORS */
00061 /*                     CANNOT BE FOUND BY THIS PROGRAM. */
00062 
00063 /*     QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, */
00064 /*     MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY 
00065 */
00066 
00067 /*     THIS VERSION DATED AUGUST 1983. */
00068 
00069 /*     ------------------------------------------------------------------ 
00070 */
00071 
00072     /* Parameter adjustments */
00073     t_dim1 = *nm;
00074     t_offset = t_dim1 + 1;
00075     t -= t_offset;
00076     --e;
00077     z_dim1 = *nm;
00078     z_offset = z_dim1 + 1;
00079     z__ -= z_offset;
00080 
00081     /* Function Body */
00082     *ierr = 0;
00083     if (*m == 0) {
00084         goto L1001;
00085     }
00086     e[1] = 1.;
00087     if (*n == 1) {
00088         goto L1001;
00089     }
00090 
00091     i__1 = *n;
00092     for (i__ = 2; i__ <= i__1; ++i__) {
00093         if (e[i__] != 0.) {
00094             goto L80;
00095         }
00096         if (t[i__ + t_dim1] != 0. || t[i__ - 1 + t_dim1 * 3] != 0.) {
00097             goto L1000;
00098         }
00099         e[i__] = 1.;
00100         goto L100;
00101 L80:
00102         e[i__] = e[i__ - 1] * e[i__] / t[i__ - 1 + t_dim1 * 3];
00103 L100:
00104         ;
00105     }
00106 
00107     i__1 = *m;
00108     for (j = 1; j <= i__1; ++j) {
00109 
00110         i__2 = *n;
00111         for (i__ = 2; i__ <= i__2; ++i__) {
00112             z__[i__ + j * z_dim1] *= e[i__];
00113 /* L120: */
00114         }
00115     }
00116 
00117     goto L1001;
00118 /*     .......... SET ERROR -- EIGENVECTORS CANNOT BE */
00119 /*                FOUND BY THIS PROGRAM .......... */
00120 L1000:
00121     *ierr = (*n << 1) + i__;
00122 L1001:
00123     return 0;
00124 } /* bakvec_ */
00125