/* eltran.f -- translated by f2c (version 19961017). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ #include #include "f2c.h" /* Subroutine */ int eltran_(integer *nm, integer *n, integer *low, integer * igh, doublereal *a, integer *int__, doublereal *z__) { /* System generated locals */ integer a_dim1, a_offset, z_dim1, z_offset, i__1, i__2; /* Local variables */ integer i__, j, kl, mm, mp, mp1; /* THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE ELMTRANS, */ /* NUM. MATH. 16, 181-204(1970) BY PETERS AND WILKINSON. */ /* HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 372-395(1971). */ /* THIS SUBROUTINE ACCUMULATES THE STABILIZED ELEMENTARY */ /* SIMILARITY TRANSFORMATIONS USED IN THE REDUCTION OF A */ /* REAL GENERAL MATRIX TO UPPER HESSENBERG FORM BY ELMHES. */ /* ON INPUT */ /* NM MUST BE SET TO THE ROW DIMENSION OF TWO-DIMENSIONAL */ /* ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM */ /* DIMENSION STATEMENT. */ /* N IS THE ORDER OF THE MATRIX. */ /* LOW AND IGH ARE INTEGERS DETERMINED BY THE BALANCING */ /* SUBROUTINE BALANC. IF BALANC HAS NOT BEEN USED, */ /* SET LOW=1, IGH=N. */ /* A CONTAINS THE MULTIPLIERS WHICH WERE USED IN THE */ /* REDUCTION BY ELMHES IN ITS LOWER TRIANGLE */ /* BELOW THE SUBDIAGONAL. */ /* INT CONTAINS INFORMATION ON THE ROWS AND COLUMNS */ /* INTERCHANGED IN THE REDUCTION BY ELMHES. */ /* ONLY ELEMENTS LOW THROUGH IGH ARE USED. */ /* ON OUTPUT */ /* Z CONTAINS THE TRANSFORMATION MATRIX PRODUCED IN THE */ /* REDUCTION BY ELMHES. */ /* QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, */ /* MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY */ /* THIS VERSION DATED AUGUST 1983. */ /* ------------------------------------------------------------------ */ /* .......... INITIALIZE Z TO IDENTITY MATRIX .......... */ /* Parameter adjustments */ z_dim1 = *nm; z_offset = z_dim1 + 1; z__ -= z_offset; --int__; a_dim1 = *nm; a_offset = a_dim1 + 1; a -= a_offset; /* Function Body */ i__1 = *n; for (j = 1; j <= i__1; ++j) { i__2 = *n; for (i__ = 1; i__ <= i__2; ++i__) { /* L60: */ z__[i__ + j * z_dim1] = 0.; } z__[j + j * z_dim1] = 1.; /* L80: */ } kl = *igh - *low - 1; if (kl < 1) { goto L200; } /* .......... FOR MP=IGH-1 STEP -1 UNTIL LOW+1 DO -- .......... */ i__1 = kl; for (mm = 1; mm <= i__1; ++mm) { mp = *igh - mm; mp1 = mp + 1; i__2 = *igh; for (i__ = mp1; i__ <= i__2; ++i__) { /* L100: */ z__[i__ + mp * z_dim1] = a[i__ + (mp - 1) * a_dim1]; } i__ = int__[mp]; if (i__ == mp) { goto L140; } i__2 = *igh; for (j = mp; j <= i__2; ++j) { z__[mp + j * z_dim1] = z__[i__ + j * z_dim1]; z__[i__ + j * z_dim1] = 0.; /* L130: */ } z__[i__ + mp * z_dim1] = 1.; L140: ; } L200: return 0; } /* eltran_ */