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