/* ortran.f -- translated by f2c (version 19961017).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "f2c.h"
/* Subroutine */ int ortran_(integer *nm, integer *n, integer *low, integer *
igh, doublereal *a, doublereal *ort, doublereal *z__)
{
/* System generated locals */
integer a_dim1, a_offset, z_dim1, z_offset, i__1, i__2, i__3;
/* Local variables */
static doublereal g;
static integer i__, j, kl, mm, mp, mp1;
/* THIS SUBROUTINE IS A TRANSLATION OF THE ALGOL PROCEDURE ORTRANS, */
/* 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 ORTHOGONAL SIMILARITY */
/* TRANSFORMATIONS USED IN THE REDUCTION OF A REAL GENERAL */
/* MATRIX TO UPPER HESSENBERG FORM BY ORTHES. */
/* 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 INFORMATION ABOUT THE ORTHOGONAL TRANS- */
/* FORMATIONS USED IN THE REDUCTION BY ORTHES */
/* IN ITS STRICT LOWER TRIANGLE. */
/* ORT CONTAINS FURTHER INFORMATION ABOUT THE TRANS- */
/* FORMATIONS USED IN THE REDUCTION BY ORTHES. */
/* ONLY ELEMENTS LOW THROUGH IGH ARE USED. */
/* ON OUTPUT */
/* Z CONTAINS THE TRANSFORMATION MATRIX PRODUCED IN THE */
/* REDUCTION BY ORTHES. */
/* ORT HAS BEEN ALTERED. */
/* 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;
--ort;
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;
if (a[mp + (mp - 1) * a_dim1] == 0.) {
goto L140;
}
mp1 = mp + 1;
i__2 = *igh;
for (i__ = mp1; i__ <= i__2; ++i__) {
/* L100: */
ort[i__] = a[i__ + (mp - 1) * a_dim1];
}
i__2 = *igh;
for (j = mp; j <= i__2; ++j) {
g = 0.;
i__3 = *igh;
for (i__ = mp; i__ <= i__3; ++i__) {
/* L110: */
g += ort[i__] * z__[i__ + j * z_dim1];
}
/* .......... DIVISOR BELOW IS NEGATIVE OF H FORMED IN ORTHES.
*/
/* DOUBLE DIVISION AVOIDS POSSIBLE UNDERFLOW ......
.... */
g = g / ort[mp] / a[mp + (mp - 1) * a_dim1];
i__3 = *igh;
for (i__ = mp; i__ <= i__3; ++i__) {
/* L120: */
z__[i__ + j * z_dim1] += g * ort[i__];
}
/* L130: */
}
L140:
;
}
L200:
return 0;
} /* ortran_ */
syntax highlighted by Code2HTML, v. 0.9.1