00001 /* cbabk2.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 cbabk2_(integer *nm, integer *n, integer *low, integer *
00009         igh, doublereal *scale, integer *m, doublereal *zr, doublereal *zi)
00010 {
00011     /* System generated locals */
00012     integer zr_dim1, zr_offset, zi_dim1, zi_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 */
00022 /*     CBABK2, WHICH IS A COMPLEX VERSION OF BALBAK, */
00023 /*     NUM. MATH. 13, 293-304(1969) BY PARLETT AND REINSCH. */
00024 /*     HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 315-326(1971). */
00025 
00026 /*     THIS SUBROUTINE FORMS THE EIGENVECTORS OF A COMPLEX GENERAL */
00027 /*     MATRIX BY BACK TRANSFORMING THOSE OF THE CORRESPONDING */
00028 /*     BALANCED MATRIX DETERMINED BY  CBAL. */
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 /*        LOW AND IGH ARE INTEGERS DETERMINED BY  CBAL. */
00039 
00040 /*        SCALE CONTAINS INFORMATION DETERMINING THE PERMUTATIONS */
00041 /*          AND SCALING FACTORS USED BY  CBAL. */
00042 
00043 /*        M IS THE NUMBER OF EIGENVECTORS TO BE BACK TRANSFORMED. */
00044 
00045 /*        ZR AND ZI CONTAIN THE REAL AND IMAGINARY PARTS, */
00046 /*          RESPECTIVELY, OF THE EIGENVECTORS TO BE */
00047 /*          BACK TRANSFORMED IN THEIR 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 /*     QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, */
00056 /*     MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY 
00057 */
00058 
00059 /*     THIS VERSION DATED AUGUST 1983. */
00060 
00061 /*     ------------------------------------------------------------------ 
00062 */
00063 
00064     /* Parameter adjustments */
00065     --scale;
00066     zi_dim1 = *nm;
00067     zi_offset = zi_dim1 + 1;
00068     zi -= zi_offset;
00069     zr_dim1 = *nm;
00070     zr_offset = zr_dim1 + 1;
00071     zr -= zr_offset;
00072 
00073     /* Function Body */
00074     if (*m == 0) {
00075         goto L200;
00076     }
00077     if (*igh == *low) {
00078         goto L120;
00079     }
00080 
00081     i__1 = *igh;
00082     for (i__ = *low; i__ <= i__1; ++i__) {
00083         s = scale[i__];
00084 /*     .......... LEFT HAND EIGENVECTORS ARE BACK TRANSFORMED */
00085 /*                IF THE FOREGOING STATEMENT IS REPLACED BY */
00086 /*                S=1.0D0/SCALE(I). .......... */
00087         i__2 = *m;
00088         for (j = 1; j <= i__2; ++j) {
00089             zr[i__ + j * zr_dim1] *= s;
00090             zi[i__ + j * zi_dim1] *= s;
00091 /* L100: */
00092         }
00093 
00094 /* L110: */
00095     }
00096 /*     .......... FOR I=LOW-1 STEP -1 UNTIL 1, */
00097 /*                IGH+1 STEP 1 UNTIL N DO -- .......... */
00098 L120:
00099     i__1 = *n;
00100     for (ii = 1; ii <= i__1; ++ii) {
00101         i__ = ii;
00102         if (i__ >= *low && i__ <= *igh) {
00103             goto L140;
00104         }
00105         if (i__ < *low) {
00106             i__ = *low - ii;
00107         }
00108         k = (integer) scale[i__];
00109         if (k == i__) {
00110             goto L140;
00111         }
00112 
00113         i__2 = *m;
00114         for (j = 1; j <= i__2; ++j) {
00115             s = zr[i__ + j * zr_dim1];
00116             zr[i__ + j * zr_dim1] = zr[k + j * zr_dim1];
00117             zr[k + j * zr_dim1] = s;
00118             s = zi[i__ + j * zi_dim1];
00119             zi[i__ + j * zi_dim1] = zi[k + j * zi_dim1];
00120             zi[k + j * zi_dim1] = s;
00121 /* L130: */
00122         }
00123 
00124 L140:
00125         ;
00126     }
00127 
00128 L200:
00129     return 0;
00130 } /* cbabk2_ */
00131