1      SUBROUTINE ELMHES(NM,N,LOW,IGH,A,INT)
2C***BEGIN PROLOGUE  ELMHES
3C***DATE WRITTEN   760101   (YYMMDD)
4C***REVISION DATE  830518   (YYMMDD)
5C***CATEGORY NO.  D4C1B2
6C***KEYWORDS  EIGENVALUES,EIGENVECTORS,EISPACK
7C***AUTHOR  SMITH, B. T., ET AL.
8C***PURPOSE  Reduces real general matrix to upper Hessenberg form
9C            stabilized elementary similarity transformations.
10C***DESCRIPTION
11C
12C     This subroutine is a translation of the ALGOL procedure ELMHES,
13C     NUM. MATH. 12, 349-368(1968) by Martin and Wilkinson.
14C     HANDBOOK FOR AUTO. COMP., VOL.II-LINEAR ALGEBRA, 339-358(1971).
15C
16C     Given a REAL GENERAL matrix, this subroutine
17C     reduces a submatrix situated in rows and columns
18C     LOW through IGH to upper Hessenberg form by
19C     stabilized elementary similarity transformations.
20C
21C     On INPUT
22C
23C        NM must be set to the row dimension of two-dimensional
24C          array parameters as declared in the calling program
25C          dimension statement.
26C
27C        N is the order of the matrix.
28C
29C        LOW and IGH are integers determined by the balancing
30C          subroutine  BALANC.  If  BALANC  has not been used,
31C          set LOW=1, IGH=N.
32C
33C        A contains the input matrix.
34C
35C     On OUTPUT
36C
37C        A contains the Hessenberg matrix.  The multipliers
38C          which were used in the reduction are stored in the
39C          remaining triangle under the Hessenberg matrix.
40C
41C        INT contains information on the rows and columns
42C          interchanged in the reduction.
43C          Only elements LOW through IGH are used.
44C
45C     Questions and comments should be directed to B. S. Garbow,
46C     APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
47C     ------------------------------------------------------------------
48C***REFERENCES  B. T. SMITH, J. M. BOYLE, J. J. DONGARRA, B. S. GARBOW,
49C                 Y. IKEBE, V. C. KLEMA, C. B. MOLER, *MATRIX EIGEN-
50C                 SYSTEM ROUTINES - EISPACK GUIDE*, SPRINGER-VERLAG,
51C                 1976.
52C***ROUTINES CALLED  (NONE)
53C***END PROLOGUE  ELMHES
54C
55      INTEGER I,J,M,N,LA,NM,IGH,KP1,LOW,MM1,MP1
56      REAL A(NM,N)
57      REAL X,Y
58      INTEGER INT(IGH)
59C
60C***FIRST EXECUTABLE STATEMENT  ELMHES
61      LA = IGH - 1
62      KP1 = LOW + 1
63      IF (LA .LT. KP1) GO TO 200
64C
65      DO 180 M = KP1, LA
66         MM1 = M - 1
67         X = 0.0E0
68         I = M
69C
70         DO 100 J = M, IGH
71            IF (ABS(A(J,MM1)) .LE. ABS(X)) GO TO 100
72            X = A(J,MM1)
73            I = J
74  100    CONTINUE
75C
76         INT(M) = I
77         IF (I .EQ. M) GO TO 130
78C    .......... INTERCHANGE ROWS AND COLUMNS OF A ..........
79         DO 110 J = MM1, N
80            Y = A(I,J)
81            A(I,J) = A(M,J)
82            A(M,J) = Y
83  110    CONTINUE
84C
85         DO 120 J = 1, IGH
86            Y = A(J,I)
87            A(J,I) = A(J,M)
88            A(J,M) = Y
89  120    CONTINUE
90C    .......... END INTERCHANGE ..........
91  130    IF (X .EQ. 0.0E0) GO TO 180
92         MP1 = M + 1
93C
94         DO 160 I = MP1, IGH
95            Y = A(I,MM1)
96            IF (Y .EQ. 0.0E0) GO TO 160
97            Y = Y / X
98            A(I,MM1) = Y
99C
100            DO 140 J = M, N
101  140       A(I,J) = A(I,J) - Y * A(M,J)
102C
103            DO 150 J = 1, IGH
104  150       A(J,M) = A(J,M) + Y * A(J,I)
105C
106  160    CONTINUE
107C
108  180 CONTINUE
109C
110  200 RETURN
111      END
112