00001 /* elmbak.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 elmbak_(integer *nm, integer *low, integer *igh, 
00009         doublereal *a, integer *int__, integer *m, doublereal *z__)
00010 {
00011     /* System generated locals */
00012     integer a_dim1, a_offset, z_dim1, z_offset, i__1, i__2, i__3;
00013 
00014     /* Local variables */
00015     static integer i__, j;
00016     static doublereal x;
00017     static integer la, mm, mp, kp1, mp1;
00018 
00019 
00020 
00021 /*     THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE ELMBAK, */
00022 /*     NUM. MATH. 12, 349-368(1968) BY MARTIN AND WILKINSON. */
00023 /*     HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 339-358(1971). */
00024 
00025 /*     THIS SUBROUTINE FORMS THE EIGENVECTORS OF A REAL GENERAL */
00026 /*     MATRIX BY BACK TRANSFORMING THOSE OF THE CORRESPONDING */
00027 /*     UPPER HESSENBERG MATRIX DETERMINED BY  ELMHES. */
00028 
00029 /*     ON INPUT */
00030 
00031 /*        NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL */
00032 /*          ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM */
00033 /*          DIMENSION STATEMENT. */
00034 
00035 /*        LOW AND IGH ARE INTEGERS DETERMINED BY THE BALANCING */
00036 /*          SUBROUTINE  BALANC.  IF  BALANC  HAS NOT BEEN USED, */
00037 /*          SET LOW=1 AND IGH EQUAL TO THE ORDER OF THE MATRIX. */
00038 
00039 /*        A CONTAINS THE MULTIPLIERS WHICH WERE USED IN THE */
00040 /*          REDUCTION BY  ELMHES  IN ITS LOWER TRIANGLE */
00041 /*          BELOW THE SUBDIAGONAL. */
00042 
00043 /*        INT CONTAINS INFORMATION ON THE ROWS AND COLUMNS */
00044 /*          INTERCHANGED IN THE REDUCTION BY  ELMHES. */
00045 /*          ONLY ELEMENTS LOW THROUGH IGH ARE USED. */
00046 
00047 /*        M IS THE NUMBER OF COLUMNS OF Z TO BE BACK TRANSFORMED. */
00048 
00049 /*        Z CONTAINS THE REAL AND IMAGINARY PARTS OF THE EIGEN- */
00050 /*          VECTORS TO BE BACK TRANSFORMED IN ITS FIRST M COLUMNS. */
00051 
00052 /*     ON OUTPUT */
00053 
00054 /*        Z CONTAINS THE REAL AND IMAGINARY PARTS OF THE */
00055 /*          TRANSFORMED EIGENVECTORS IN ITS FIRST M COLUMNS. */
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     --int__;
00068     a_dim1 = *nm;
00069     a_offset = a_dim1 + 1;
00070     a -= a_offset;
00071     z_dim1 = *nm;
00072     z_offset = z_dim1 + 1;
00073     z__ -= z_offset;
00074 
00075     /* Function Body */
00076     if (*m == 0) {
00077         goto L200;
00078     }
00079     la = *igh - 1;
00080     kp1 = *low + 1;
00081     if (la < kp1) {
00082         goto L200;
00083     }
00084 /*     .......... FOR MP=IGH-1 STEP -1 UNTIL LOW+1 DO -- .......... */
00085     i__1 = la;
00086     for (mm = kp1; mm <= i__1; ++mm) {
00087         mp = *low + *igh - mm;
00088         mp1 = mp + 1;
00089 
00090         i__2 = *igh;
00091         for (i__ = mp1; i__ <= i__2; ++i__) {
00092             x = a[i__ + (mp - 1) * a_dim1];
00093             if (x == 0.) {
00094                 goto L110;
00095             }
00096 
00097             i__3 = *m;
00098             for (j = 1; j <= i__3; ++j) {
00099 /* L100: */
00100                 z__[i__ + j * z_dim1] += x * z__[mp + j * z_dim1];
00101             }
00102 
00103 L110:
00104             ;
00105         }
00106 
00107         i__ = int__[mp];
00108         if (i__ == mp) {
00109             goto L140;
00110         }
00111 
00112         i__2 = *m;
00113         for (j = 1; j <= i__2; ++j) {
00114             x = z__[i__ + j * z_dim1];
00115             z__[i__ + j * z_dim1] = z__[mp + j * z_dim1];
00116             z__[mp + j * z_dim1] = x;
00117 /* L130: */
00118         }
00119 
00120 L140:
00121         ;
00122     }
00123 
00124 L200:
00125     return 0;
00126 } /* elmbak_ */
00127