00001 /* balbak.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 balbak_(integer *nm, integer *n, integer *low, integer *
00009         igh, doublereal *scale, integer *m, doublereal *z__)
00010 {
00011     /* System generated locals */
00012     integer z_dim1, z_offset, i__1, i__2;
00013 
00014     /* Local variables */
00015     static integer i__, j, k;
00016     static doublereal s;
00017     static integer ii;
00018 
00019 
00020 
00021 /*     THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE BALBAK, */
00022 /*     NUM. MATH. 13, 293-304(1969) BY PARLETT AND REINSCH. */
00023 /*     HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 315-326(1971). */
00024 
00025 /*     THIS SUBROUTINE FORMS THE EIGENVECTORS OF A REAL GENERAL */
00026 /*     MATRIX BY BACK TRANSFORMING THOSE OF THE CORRESPONDING */
00027 /*     BALANCED MATRIX DETERMINED BY  BALANC. */
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 /*        N IS THE ORDER OF THE MATRIX. */
00036 
00037 /*        LOW AND IGH ARE INTEGERS DETERMINED BY  BALANC. */
00038 
00039 /*        SCALE CONTAINS INFORMATION DETERMINING THE PERMUTATIONS */
00040 /*          AND SCALING FACTORS USED BY  BALANC. */
00041 
00042 /*        M IS THE NUMBER OF COLUMNS OF Z TO BE BACK TRANSFORMED. */
00043 
00044 /*        Z CONTAINS THE REAL AND IMAGINARY PARTS OF THE EIGEN- */
00045 /*          VECTORS TO BE BACK TRANSFORMED IN ITS FIRST M COLUMNS. */
00046 
00047 /*     ON OUTPUT */
00048 
00049 /*        Z CONTAINS THE REAL AND IMAGINARY PARTS OF THE */
00050 /*          TRANSFORMED EIGENVECTORS IN ITS FIRST M COLUMNS. */
00051 
00052 /*     QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, */
00053 /*     MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY 
00054 */
00055 
00056 /*     THIS VERSION DATED AUGUST 1983. */
00057 
00058 /*     ------------------------------------------------------------------ 
00059 */
00060 
00061     /* Parameter adjustments */
00062     --scale;
00063     z_dim1 = *nm;
00064     z_offset = z_dim1 + 1;
00065     z__ -= z_offset;
00066 
00067     /* Function Body */
00068     if (*m == 0) {
00069         goto L200;
00070     }
00071     if (*igh == *low) {
00072         goto L120;
00073     }
00074 
00075     i__1 = *igh;
00076     for (i__ = *low; i__ <= i__1; ++i__) {
00077         s = scale[i__];
00078 /*     .......... LEFT HAND EIGENVECTORS ARE BACK TRANSFORMED */
00079 /*                IF THE FOREGOING STATEMENT IS REPLACED BY */
00080 /*                S=1.0D0/SCALE(I). .......... */
00081         i__2 = *m;
00082         for (j = 1; j <= i__2; ++j) {
00083 /* L100: */
00084             z__[i__ + j * z_dim1] *= s;
00085         }
00086 
00087 /* L110: */
00088     }
00089 /*     ......... FOR I=LOW-1 STEP -1 UNTIL 1, */
00090 /*               IGH+1 STEP 1 UNTIL N DO -- .......... */
00091 L120:
00092     i__1 = *n;
00093     for (ii = 1; ii <= i__1; ++ii) {
00094         i__ = ii;
00095         if (i__ >= *low && i__ <= *igh) {
00096             goto L140;
00097         }
00098         if (i__ < *low) {
00099             i__ = *low - ii;
00100         }
00101         k = (integer) scale[i__];
00102         if (k == i__) {
00103             goto L140;
00104         }
00105 
00106         i__2 = *m;
00107         for (j = 1; j <= i__2; ++j) {
00108             s = z__[i__ + j * z_dim1];
00109             z__[i__ + j * z_dim1] = z__[k + j * z_dim1];
00110             z__[k + j * z_dim1] = s;
00111 /* L130: */
00112         }
00113 
00114 L140:
00115         ;
00116     }
00117 
00118 L200:
00119     return 0;
00120 } /* balbak_ */
00121