00001 /* cg.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 cg_(integer *nm, integer *n, doublereal *ar, doublereal *
00009         ai, doublereal *wr, doublereal *wi, integer *matz, doublereal *zr, 
00010         doublereal *zi, doublereal *fv1, doublereal *fv2, doublereal *fv3, 
00011         integer *ierr)
00012 {
00013     /* System generated locals */
00014     integer ar_dim1, ar_offset, ai_dim1, ai_offset, zr_dim1, zr_offset, 
00015             zi_dim1, zi_offset;
00016 
00017     /* Local variables */
00018     extern /* Subroutine */ int cbal_(integer *, integer *, doublereal *, 
00019             doublereal *, integer *, integer *, doublereal *), corth_(integer 
00020             *, integer *, integer *, integer *, doublereal *, doublereal *, 
00021             doublereal *, doublereal *), comqr_(integer *, integer *, integer 
00022             *, integer *, doublereal *, doublereal *, doublereal *, 
00023             doublereal *, integer *), cbabk2_(integer *, integer *, integer *,
00024              integer *, doublereal *, integer *, doublereal *, doublereal *), 
00025             comqr2_(integer *, integer *, integer *, integer *, doublereal *, 
00026             doublereal *, doublereal *, doublereal *, doublereal *, 
00027             doublereal *, doublereal *, doublereal *, integer *);
00028     static integer is1, is2;
00029 
00030 
00031 
00032 /*     THIS SUBROUTINE CALLS THE RECOMMENDED SEQUENCE OF */
00033 /*     SUBROUTINES FROM THE EIGENSYSTEM SUBROUTINE PACKAGE (EISPACK) */
00034 /*     TO FIND THE EIGENVALUES AND EIGENVECTORS (IF DESIRED) */
00035 /*     OF A COMPLEX GENERAL MATRIX. */
00036 
00037 /*     ON INPUT */
00038 
00039 /*        NM  MUST BE SET TO THE ROW DIMENSION OF THE TWO-DIMENSIONAL */
00040 /*        ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM */
00041 /*        DIMENSION STATEMENT. */
00042 
00043 /*        N  IS THE ORDER OF THE MATRIX  A=(AR,AI). */
00044 
00045 /*        AR  AND  AI  CONTAIN THE REAL AND IMAGINARY PARTS, */
00046 /*        RESPECTIVELY, OF THE COMPLEX GENERAL MATRIX. */
00047 
00048 /*        MATZ  IS AN INTEGER VARIABLE SET EQUAL TO ZERO IF */
00049 /*        ONLY EIGENVALUES ARE DESIRED.  OTHERWISE IT IS SET TO */
00050 /*        ANY NON-ZERO INTEGER FOR BOTH EIGENVALUES AND EIGENVECTORS. */
00051 
00052 /*     ON OUTPUT */
00053 
00054 /*        WR  AND  WI  CONTAIN THE REAL AND IMAGINARY PARTS, */
00055 /*        RESPECTIVELY, OF THE EIGENVALUES. */
00056 
00057 /*        ZR  AND  ZI  CONTAIN THE REAL AND IMAGINARY PARTS, */
00058 /*        RESPECTIVELY, OF THE EIGENVECTORS IF MATZ IS NOT ZERO. */
00059 
00060 /*        IERR  IS AN INTEGER OUTPUT VARIABLE SET EQUAL TO AN ERROR */
00061 /*           COMPLETION CODE DESCRIBED IN THE DOCUMENTATION FOR COMQR */
00062 /*           AND COMQR2.  THE NORMAL COMPLETION CODE IS ZERO. */
00063 
00064 /*        FV1, FV2, AND  FV3  ARE TEMPORARY STORAGE ARRAYS. */
00065 
00066 /*     QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, */
00067 /*     MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY 
00068 */
00069 
00070 /*     THIS VERSION DATED AUGUST 1983. */
00071 
00072 /*     ------------------------------------------------------------------ 
00073 */
00074 
00075     /* Parameter adjustments */
00076     --fv3;
00077     --fv2;
00078     --fv1;
00079     zi_dim1 = *nm;
00080     zi_offset = zi_dim1 + 1;
00081     zi -= zi_offset;
00082     zr_dim1 = *nm;
00083     zr_offset = zr_dim1 + 1;
00084     zr -= zr_offset;
00085     --wi;
00086     --wr;
00087     ai_dim1 = *nm;
00088     ai_offset = ai_dim1 + 1;
00089     ai -= ai_offset;
00090     ar_dim1 = *nm;
00091     ar_offset = ar_dim1 + 1;
00092     ar -= ar_offset;
00093 
00094     /* Function Body */
00095     if (*n <= *nm) {
00096         goto L10;
00097     }
00098     *ierr = *n * 10;
00099     goto L50;
00100 
00101 L10:
00102     cbal_(nm, n, &ar[ar_offset], &ai[ai_offset], &is1, &is2, &fv1[1]);
00103     corth_(nm, n, &is1, &is2, &ar[ar_offset], &ai[ai_offset], &fv2[1], &fv3[1]
00104             );
00105     if (*matz != 0) {
00106         goto L20;
00107     }
00108 /*     .......... FIND EIGENVALUES ONLY .......... */
00109     comqr_(nm, n, &is1, &is2, &ar[ar_offset], &ai[ai_offset], &wr[1], &wi[1], 
00110             ierr);
00111     goto L50;
00112 /*     .......... FIND BOTH EIGENVALUES AND EIGENVECTORS .......... */
00113 L20:
00114     comqr2_(nm, n, &is1, &is2, &fv2[1], &fv3[1], &ar[ar_offset], &ai[
00115             ai_offset], &wr[1], &wi[1], &zr[zr_offset], &zi[zi_offset], ierr);
00116     if (*ierr != 0) {
00117         goto L50;
00118     }
00119     cbabk2_(nm, n, &is1, &is2, &fv1[1], n, &zr[zr_offset], &zi[zi_offset]);
00120 L50:
00121     return 0;
00122 } /* cg_ */
00123