00010 {
00011     /* System generated locals */
00012     integer a_dim1, a_offset, z_dim1, z_offset, i__1, i__2;
00013 
00014     /* Local variables */
00015     static integer i__, j, kl, mm, mp, mp1;
00016 
00017 
00018 
00019 /*     THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE ELMTRANS, 
00020 */
00021 /*     NUM. MATH. 16, 181-204(1970) BY PETERS AND WILKINSON. */
00022 /*     HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 372-395(1971). */
00023 
00024 /*     THIS SUBROUTINE ACCUMULATES THE STABILIZED ELEMENTARY */
00025 /*     SIMILARITY TRANSFORMATIONS USED IN THE REDUCTION OF A */
00026 /*     REAL GENERAL MATRIX TO UPPER HESSENBERG FORM BY  ELMHES. */
00027 
00028 /*     ON INPUT */
00029 
00030 /*        NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL */
00031 /*          ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM */
00032 /*          DIMENSION STATEMENT. */
00033 
00034 /*        N IS THE ORDER OF THE MATRIX. */
00035 
00036 /*        LOW AND IGH ARE INTEGERS DETERMINED BY THE BALANCING */
00037 /*          SUBROUTINE  BALANC.  IF  BALANC  HAS NOT BEEN USED, */
00038 /*          SET LOW=1, IGH=N. */
00039 
00040 /*        A CONTAINS THE MULTIPLIERS WHICH WERE USED IN THE */
00041 /*          REDUCTION BY  ELMHES  IN ITS LOWER TRIANGLE */
00042 /*          BELOW THE SUBDIAGONAL. */
00043 
00044 /*        INT CONTAINS INFORMATION ON THE ROWS AND COLUMNS */
00045 /*          INTERCHANGED IN THE REDUCTION BY  ELMHES. */
00046 /*          ONLY ELEMENTS LOW THROUGH IGH ARE USED. */
00047 
00048 /*     ON OUTPUT */
00049 
00050 /*        Z CONTAINS THE TRANSFORMATION MATRIX PRODUCED IN THE */
00051 /*          REDUCTION BY  ELMHES. */
00052 
00053 /*     QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, */
00054 /*     MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY 
00055 */
00056 
00057 /*     THIS VERSION DATED AUGUST 1983. */
00058 
00059 /*     ------------------------------------------------------------------ 
00060 */
00061 
00062 /*     .......... INITIALIZE Z TO IDENTITY MATRIX .......... */
00063     /* Parameter adjustments */
00064     z_dim1 = *nm;
00065     z_offset = z_dim1 + 1;
00066     z__ -= z_offset;
00067     --int__;
00068     a_dim1 = *nm;
00069     a_offset = a_dim1 + 1;
00070     a -= a_offset;
00071 
00072     /* Function Body */
00073     i__1 = *n;
00074     for (j = 1; j <= i__1; ++j) {
00075 
00076         i__2 = *n;
00077         for (i__ = 1; i__ <= i__2; ++i__) {
00078 /* L60: */
00079             z__[i__ + j * z_dim1] = 0.;
00080         }
00081 
00082         z__[j + j * z_dim1] = 1.;
00083 /* L80: */
00084     }
00085 
00086     kl = *igh - *low - 1;
00087     if (kl < 1) {
00088         goto L200;
00089     }
00090 /*     .......... FOR MP=IGH-1 STEP -1 UNTIL LOW+1 DO -- .......... */
00091     i__1 = kl;
00092     for (mm = 1; mm <= i__1; ++mm) {
00093         mp = *igh - mm;
00094         mp1 = mp + 1;
00095 
00096         i__2 = *igh;
00097         for (i__ = mp1; i__ <= i__2; ++i__) {
00098 /* L100: */
00099             z__[i__ + mp * z_dim1] = a[i__ + (mp - 1) * a_dim1];
00100         }
00101 
00102         i__ = int__[mp];
00103         if (i__ == mp) {
00104             goto L140;
00105         }
00106 
00107         i__2 = *igh;
00108         for (j = mp; j <= i__2; ++j) {
00109             z__[mp + j * z_dim1] = z__[i__ + j * z_dim1];
00110             z__[i__ + j * z_dim1] = 0.;
00111 /* L130: */
00112         }
00113 
00114         z__[i__ + mp * z_dim1] = 1.;
00115 L140:
00116         ;
00117     }
00118 
00119 L200:
00120     return 0;
00121 } /* eltran_ */