1      SUBROUTINE RG(NM,N,A,WR,WI,MATZ,Z,IV1,FV1,IERR)
2C***BEGIN PROLOGUE  RG
3C***DATE WRITTEN   760101   (YYMMDD)
4C***REVISION DATE  830518   (YYMMDD)
5C***CATEGORY NO.  D4A2
6C***KEYWORDS  EIGENVALUES,EIGENVECTORS,EISPACK
7C***AUTHOR  SMITH, B. T., ET AL.
8C***PURPOSE  Computes eigenvalues and, optionally, eigenvectors of a
9C            real general matrix.
10C***DESCRIPTION
11C
12C     This subroutine calls the recommended sequence of
13C     subroutines from the eigensystem subroutine package (EISPACK)
14C     To find the eigenvalues and eigenvectors (if desired)
15C     of a REAL GENERAL matrix.
16C
17C     On Input
18C
19C        NM  must be set to the row dimension of the two-dimensional
20C        array parameters as declared in the calling program
21C        dimension statement.
22C
23C        N  is the order of the matrix  A.
24C
25C        A  contains the real general matrix.
26C
27C        MATZ  is an integer variable set equal to zero if
28C        only eigenvalues are desired.  Otherwise it is set to
29C        any non-zero integer for both eigenvalues and eigenvectors.
30C
31C     On Output
32C
33C        WR  and  WI  contain the real and imaginary parts,
34C        respectively, of the eigenvalues.  Complex conjugate
35C        pairs of eigenvalues appear consecutively with the
36C        eigenvalue having the positive imaginary part first.
37C
38C        Z  contains the real and imaginary parts of the eigenvectors
39C        if MATZ is not zero.  If the J-th eigenvalue is real, the
40C        J-th column of  Z  contains its eigenvector.  If the J-TH
41C        eigenvalue is complex with positive imaginary part, the
42C        J-th and (J+1)-th columns of  Z  contain the real and
43C        imaginary parts of its eigenvector.  The conjugate of this
44C        vector is the eigenvector for the conjugate eigenvalue.
45C
46C        IERR  is an integer output variable set equal to an
47C        error completion code described in section 2B of the
48C        documentation.  The normal completion code is zero.
49C
50C        IV1  and  FV1  are temporary storage arrays.
51C
52C     Questions and comments should be directed to B. S. Garbow,
53C     APPLIED MATHEMATICS DIVISION, ARGONNE NATIONAL LABORATORY
54C     ------------------------------------------------------------------
55C***REFERENCES  B. T. SMITH, J. M. BOYLE, J. J. DONGARRA, B. S. GARBOW,
56C                 Y. IKEBE, V. C. KLEMA, C. B. MOLER, *MATRIX EIGEN-
57C                 SYSTEM ROUTINES - EISPACK GUIDE*, SPRINGER-VERLAG,
58C                 1976.
59C***ROUTINES CALLED  BALANC,BALBAK,ELMHES,ELTRAN,HQR,HQR2
60C***END PROLOGUE  RG
61C
62      INTEGER N,NM,IS1,IS2,IERR,MATZ
63      REAL A(NM,N),WR(N),WI(N),Z(NM,N),FV1(N)
64      INTEGER IV1(N)
65C
66C***FIRST EXECUTABLE STATEMENT  RG
67      IF (N .LE. NM) GO TO 10
68      IERR = 10 * N
69      GO TO 50
70C
71   10 CALL  BALANC(NM,N,A,IS1,IS2,FV1)
72      CALL  ELMHES(NM,N,IS1,IS2,A,IV1)
73      IF (MATZ .NE. 0) GO TO 20
74C     .......... FIND EIGENVALUES ONLY ..........
75      CALL  HQR(NM,N,IS1,IS2,A,WR,WI,IERR)
76      GO TO 50
77C     .......... FIND BOTH EIGENVALUES AND EIGENVECTORS ..........
78   20 CALL  ELTRAN(NM,N,IS1,IS2,A,IV1,Z)
79      CALL  HQR2(NM,N,IS1,IS2,A,WR,WI,Z,IERR)
80      IF (IERR .NE. 0) GO TO 50
81      CALL  BALBAK(NM,N,IS1,IS2,FV1,N,Z)
82   50 RETURN
83      END
84