00001 /* rg.f -- translated by f2c (version 19961017).
00002    You must link the resulting object file with the libraries:
00003         -lf2c -lm   (in that order)
00004 */
00005 
00006 #include "f2c.h"
00007 
00008 /* Subroutine */ int rg_(integer *nm, integer *n, doublereal *a, doublereal *
00009         wr, doublereal *wi, integer *matz, doublereal *z__, integer *iv1, 
00010         doublereal *fv1, integer *ierr)
00011 {
00012     /* System generated locals */
00013     integer a_dim1, a_offset, z_dim1, z_offset;
00014 
00015     /* Local variables */
00016     extern /* Subroutine */ int balbak_(integer *, integer *, integer *, 
00017             integer *, doublereal *, integer *, doublereal *), balanc_(
00018             integer *, integer *, doublereal *, integer *, integer *, 
00019             doublereal *), elmhes_(integer *, integer *, integer *, integer *,
00020              doublereal *, integer *), eltran_(integer *, integer *, integer *
00021             , integer *, doublereal *, integer *, doublereal *);
00022     static integer is1, is2;
00023     extern /* Subroutine */ int hqr_(integer *, integer *, integer *, integer 
00024             *, doublereal *, doublereal *, doublereal *, integer *), hqr2_(
00025             integer *, integer *, integer *, integer *, doublereal *, 
00026             doublereal *, doublereal *, doublereal *, integer *);
00027 
00028 
00029 
00030 /*     THIS SUBROUTINE CALLS THE RECOMMENDED SEQUENCE OF */
00031 /*     SUBROUTINES FROM THE EIGENSYSTEM SUBROUTINE PACKAGE (EISPACK) */
00032 /*     TO FIND THE EIGENVALUES AND EIGENVECTORS (IF DESIRED) */
00033 /*     OF A REAL GENERAL MATRIX. */
00034 
00035 /*     ON INPUT */
00036 
00037 /*        NM  MUST BE SET TO THE ROW DIMENSION OF THE TWO-DIMENSIONAL */
00038 /*        ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM */
00039 /*        DIMENSION STATEMENT. */
00040 
00041 /*        N  IS THE ORDER OF THE MATRIX  A. */
00042 
00043 /*        A  CONTAINS THE REAL GENERAL MATRIX. */
00044 
00045 /*        MATZ  IS AN INTEGER VARIABLE SET EQUAL TO ZERO IF */
00046 /*        ONLY EIGENVALUES ARE DESIRED.  OTHERWISE IT IS SET TO */
00047 /*        ANY NON-ZERO INTEGER FOR BOTH EIGENVALUES AND EIGENVECTORS. */
00048 
00049 /*     ON OUTPUT */
00050 
00051 /*        WR  AND  WI  CONTAIN THE REAL AND IMAGINARY PARTS, */
00052 /*        RESPECTIVELY, OF THE EIGENVALUES.  COMPLEX CONJUGATE */
00053 /*        PAIRS OF EIGENVALUES APPEAR CONSECUTIVELY WITH THE */
00054 /*        EIGENVALUE HAVING THE POSITIVE IMAGINARY PART FIRST. */
00055 
00056 /*        Z  CONTAINS THE REAL AND IMAGINARY PARTS OF THE EIGENVECTORS */
00057 /*        IF MATZ IS NOT ZERO.  IF THE J-TH EIGENVALUE IS REAL, THE */
00058 /*        J-TH COLUMN OF  Z  CONTAINS ITS EIGENVECTOR.  IF THE J-TH */
00059 /*        EIGENVALUE IS COMPLEX WITH POSITIVE IMAGINARY PART, THE */
00060 /*        J-TH AND (J+1)-TH COLUMNS OF  Z  CONTAIN THE REAL AND */
00061 /*        IMAGINARY PARTS OF ITS EIGENVECTOR.  THE CONJUGATE OF THIS */
00062 /*        VECTOR IS THE EIGENVECTOR FOR THE CONJUGATE EIGENVALUE. */
00063 
00064 /*        IERR  IS AN INTEGER OUTPUT VARIABLE SET EQUAL TO AN ERROR */
00065 /*           COMPLETION CODE DESCRIBED IN THE DOCUMENTATION FOR HQR */
00066 /*           AND HQR2.  THE NORMAL COMPLETION CODE IS ZERO. */
00067 
00068 /*        IV1  AND  FV1  ARE TEMPORARY STORAGE ARRAYS. */
00069 
00070 /*     QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, */
00071 /*     MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY 
00072 */
00073 
00074 /*     THIS VERSION DATED AUGUST 1983. */
00075 
00076 /*     ------------------------------------------------------------------ 
00077 */
00078 
00079     /* Parameter adjustments */
00080     --fv1;
00081     --iv1;
00082     z_dim1 = *nm;
00083     z_offset = z_dim1 + 1;
00084     z__ -= z_offset;
00085     --wi;
00086     --wr;
00087     a_dim1 = *nm;
00088     a_offset = a_dim1 + 1;
00089     a -= a_offset;
00090 
00091     /* Function Body */
00092     if (*n <= *nm) {
00093         goto L10;
00094     }
00095     *ierr = *n * 10;
00096     goto L50;
00097 
00098 L10:
00099     balanc_(nm, n, &a[a_offset], &is1, &is2, &fv1[1]);
00100     elmhes_(nm, n, &is1, &is2, &a[a_offset], &iv1[1]);
00101     if (*matz != 0) {
00102         goto L20;
00103     }
00104 /*     .......... FIND EIGENVALUES ONLY .......... */
00105     hqr_(nm, n, &is1, &is2, &a[a_offset], &wr[1], &wi[1], ierr);
00106     goto L50;
00107 /*     .......... FIND BOTH EIGENVALUES AND EIGENVECTORS .......... */
00108 L20:
00109     eltran_(nm, n, &is1, &is2, &a[a_offset], &iv1[1], &z__[z_offset]);
00110     hqr2_(nm, n, &is1, &is2, &a[a_offset], &wr[1], &wi[1], &z__[z_offset], 
00111             ierr);
00112     if (*ierr != 0) {
00113         goto L50;
00114     }
00115     balbak_(nm, n, &is1, &is2, &fv1[1], n, &z__[z_offset]);
00116 L50:
00117     return 0;
00118 } /* rg_ */
00119