00010 {
00011     /* System generated locals */
00012     integer a_dim1, a_offset, zr_dim1, zr_offset, zi_dim1, zi_offset, i__1, 
00013             i__2, i__3;
00014 
00015     /* Local variables */
00016     static doublereal h__;
00017     static integer i__, j, k, l;
00018     static doublereal s, si;
00019 
00020 
00021 
00022 /*     THIS SUBROUTINE IS A TRANSLATION OF A COMPLEX ANALOGUE OF */
00023 /*     THE ALGOL PROCEDURE TRBAK3, NUM. MATH. 11, 181-195(1968) */
00024 /*     BY MARTIN, REINSCH, AND WILKINSON. */
00025 /*     HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 212-226(1971). */
00026 
00027 /*     THIS SUBROUTINE FORMS THE EIGENVECTORS OF A COMPLEX HERMITIAN */
00028 /*     MATRIX BY BACK TRANSFORMING THOSE OF THE CORRESPONDING */
00029 /*     REAL SYMMETRIC TRIDIAGONAL MATRIX DETERMINED BY  HTRID3. */
00030 
00031 /*     ON INPUT */
00032 
00033 /*        NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL */
00034 /*          ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM */
00035 /*          DIMENSION STATEMENT. */
00036 
00037 /*        N IS THE ORDER OF THE MATRIX. */
00038 
00039 /*        A CONTAINS INFORMATION ABOUT THE UNITARY TRANSFORMATIONS */
00040 /*          USED IN THE REDUCTION BY  HTRID3. */
00041 
00042 /*        TAU CONTAINS FURTHER INFORMATION ABOUT THE TRANSFORMATIONS. */
00043 
00044 /*        M IS THE NUMBER OF EIGENVECTORS TO BE BACK TRANSFORMED. */
00045 
00046 /*        ZR CONTAINS THE EIGENVECTORS TO BE BACK TRANSFORMED */
00047 /*          IN ITS FIRST M COLUMNS. */
00048 
00049 /*     ON OUTPUT */
00050 
00051 /*        ZR AND ZI CONTAIN THE REAL AND IMAGINARY PARTS, */
00052 /*          RESPECTIVELY, OF THE TRANSFORMED EIGENVECTORS */
00053 /*          IN THEIR FIRST M COLUMNS. */
00054 
00055 /*     NOTE THAT THE LAST COMPONENT OF EACH RETURNED VECTOR */
00056 /*     IS REAL AND THAT VECTOR EUCLIDEAN NORMS ARE PRESERVED. */
00057 
00058 /*     QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, */
00059 /*     MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY 
00060 */
00061 
00062 /*     THIS VERSION DATED AUGUST 1983. */
00063 
00064 /*     ------------------------------------------------------------------ 
00065 */
00066 
00067     /* Parameter adjustments */
00068     tau -= 3;
00069     a_dim1 = *nm;
00070     a_offset = a_dim1 + 1;
00071     a -= a_offset;
00072     zi_dim1 = *nm;
00073     zi_offset = zi_dim1 + 1;
00074     zi -= zi_offset;
00075     zr_dim1 = *nm;
00076     zr_offset = zr_dim1 + 1;
00077     zr -= zr_offset;
00078 
00079     /* Function Body */
00080     if (*m == 0) {
00081         goto L200;
00082     }
00083 /*     .......... TRANSFORM THE EIGENVECTORS OF THE REAL SYMMETRIC */
00084 /*                TRIDIAGONAL MATRIX TO THOSE OF THE HERMITIAN */
00085 /*                TRIDIAGONAL MATRIX. .......... */
00086     i__1 = *n;
00087     for (k = 1; k <= i__1; ++k) {
00088 
00089         i__2 = *m;
00090         for (j = 1; j <= i__2; ++j) {
00091             zi[k + j * zi_dim1] = -zr[k + j * zr_dim1] * tau[(k << 1) + 2];
00092             zr[k + j * zr_dim1] *= tau[(k << 1) + 1];
00093 /* L50: */
00094         }
00095     }
00096 
00097     if (*n == 1) {
00098         goto L200;
00099     }
00100 /*     .......... RECOVER AND APPLY THE HOUSEHOLDER MATRICES .......... */
00101     i__2 = *n;
00102     for (i__ = 2; i__ <= i__2; ++i__) {
00103         l = i__ - 1;
00104         h__ = a[i__ + i__ * a_dim1];
00105         if (h__ == 0.) {
00106             goto L140;
00107         }
00108 
00109         i__1 = *m;
00110         for (j = 1; j <= i__1; ++j) {
00111             s = 0.;
00112             si = 0.;
00113 
00114             i__3 = l;
00115             for (k = 1; k <= i__3; ++k) {
00116                 s = s + a[i__ + k * a_dim1] * zr[k + j * zr_dim1] - a[k + i__ 
00117                         * a_dim1] * zi[k + j * zi_dim1];
00118                 si = si + a[i__ + k * a_dim1] * zi[k + j * zi_dim1] + a[k + 
00119                         i__ * a_dim1] * zr[k + j * zr_dim1];
00120 /* L110: */
00121             }
00122 /*     .......... DOUBLE DIVISIONS AVOID POSSIBLE UNDERFLOW ......
00123 .... */
00124             s = s / h__ / h__;
00125             si = si / h__ / h__;
00126 
00127             i__3 = l;
00128             for (k = 1; k <= i__3; ++k) {
00129                 zr[k + j * zr_dim1] = zr[k + j * zr_dim1] - s * a[i__ + k * 
00130                         a_dim1] - si * a[k + i__ * a_dim1];
00131                 zi[k + j * zi_dim1] = zi[k + j * zi_dim1] - si * a[i__ + k * 
00132                         a_dim1] + s * a[k + i__ * a_dim1];
00133 /* L120: */
00134             }
00135 
00136 /* L130: */
00137         }
00138 
00139 L140:
00140         ;
00141     }
00142 
00143 L200:
00144     return 0;
00145 } /* htrib3_ */