00010 {
00011     /* System generated locals */
00012     integer z_dim1, z_offset, i__1, i__2, i__3;
00013 
00014     /* Local variables */
00015     static doublereal h__;
00016     static integer i__, j, k, l;
00017     static doublereal s;
00018     static integer ik, iz;
00019 
00020 
00021 
00022 /*     THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE TRBAK3, */
00023 /*     NUM. MATH. 11, 181-195(1968) BY MARTIN, REINSCH, AND WILKINSON. */
00024 /*     HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971). */
00025 
00026 /*     THIS SUBROUTINE FORMS THE EIGENVECTORS OF A REAL SYMMETRIC */
00027 /*     MATRIX BY BACK TRANSFORMING THOSE OF THE CORRESPONDING */
00028 /*     SYMMETRIC TRIDIAGONAL MATRIX DETERMINED BY  TRED3. */
00029 
00030 /*     ON INPUT */
00031 
00032 /*        NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL */
00033 /*          ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM */
00034 /*          DIMENSION STATEMENT. */
00035 
00036 /*        N IS THE ORDER OF THE MATRIX. */
00037 
00038 /*        NV MUST BE SET TO THE DIMENSION OF THE ARRAY PARAMETER A */
00039 /*          AS DECLARED IN THE CALLING PROGRAM DIMENSION STATEMENT. */
00040 
00041 /*        A CONTAINS INFORMATION ABOUT THE ORTHOGONAL TRANSFORMATIONS */
00042 /*          USED IN THE REDUCTION BY  TRED3  IN ITS FIRST */
00043 /*          N*(N+1)/2 POSITIONS. */
00044 
00045 /*        M IS THE NUMBER OF EIGENVECTORS TO BE BACK TRANSFORMED. */
00046 
00047 /*        Z CONTAINS THE EIGENVECTORS TO BE BACK TRANSFORMED */
00048 /*          IN ITS FIRST M COLUMNS. */
00049 
00050 /*     ON OUTPUT */
00051 
00052 /*        Z CONTAINS THE TRANSFORMED EIGENVECTORS */
00053 /*          IN ITS FIRST M COLUMNS. */
00054 
00055 /*     NOTE THAT TRBAK3 PRESERVES VECTOR EUCLIDEAN NORMS. */
00056 
00057 /*     QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, */
00058 /*     MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY 
00059 */
00060 
00061 /*     THIS VERSION DATED AUGUST 1983. */
00062 
00063 /*     ------------------------------------------------------------------ 
00064 */
00065 
00066     /* Parameter adjustments */
00067     --a;
00068     z_dim1 = *nm;
00069     z_offset = z_dim1 + 1;
00070     z__ -= z_offset;
00071 
00072     /* Function Body */
00073     if (*m == 0) {
00074         goto L200;
00075     }
00076     if (*n == 1) {
00077         goto L200;
00078     }
00079 
00080     i__1 = *n;
00081     for (i__ = 2; i__ <= i__1; ++i__) {
00082         l = i__ - 1;
00083         iz = i__ * l / 2;
00084         ik = iz + i__;
00085         h__ = a[ik];
00086         if (h__ == 0.) {
00087             goto L140;
00088         }
00089 
00090         i__2 = *m;
00091         for (j = 1; j <= i__2; ++j) {
00092             s = 0.;
00093             ik = iz;
00094 
00095             i__3 = l;
00096             for (k = 1; k <= i__3; ++k) {
00097                 ++ik;
00098                 s += a[ik] * z__[k + j * z_dim1];
00099 /* L110: */
00100             }
00101 /*     .......... DOUBLE DIVISION AVOIDS POSSIBLE UNDERFLOW ......
00102 .... */
00103             s = s / h__ / h__;
00104             ik = iz;
00105 
00106             i__3 = l;
00107             for (k = 1; k <= i__3; ++k) {
00108                 ++ik;
00109                 z__[k + j * z_dim1] -= s * a[ik];
00110 /* L120: */
00111             }
00112 
00113 /* L130: */
00114         }
00115 
00116 L140:
00117         ;
00118     }
00119 
00120 L200:
00121     return 0;
00122 } /* trbak3_ */