/* ch.f -- translated by f2c (version 19961017). You must link the resulting object file with the libraries: -lf2c -lm (in that order) */ #include #include "f2c.h" /* Subroutine */ int ch_(integer *nm, integer *n, doublereal *ar, doublereal * ai, doublereal *w, integer *matz, doublereal *zr, doublereal *zi, doublereal *fv1, doublereal *fv2, doublereal *fm1, integer *ierr) { /* System generated locals */ integer ar_dim1, ar_offset, ai_dim1, ai_offset, zr_dim1, zr_offset, zi_dim1, zi_offset, i__1, i__2; /* Local variables */ integer i__, j; extern /* Subroutine */ int htridi_(integer *, integer *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), htribk_(integer *, integer *, doublereal *, doublereal *, doublereal *, integer *, doublereal *, doublereal *) , tqlrat_(integer *, doublereal *, doublereal *, integer *), tql2_(integer *, integer *, doublereal *, doublereal *, doublereal *, integer *); /* THIS SUBROUTINE CALLS THE RECOMMENDED SEQUENCE OF */ /* SUBROUTINES FROM THE EIGENSYSTEM SUBROUTINE PACKAGE (EISPACK) */ /* TO FIND THE EIGENVALUES AND EIGENVECTORS (IF DESIRED) */ /* OF A COMPLEX HERMITIAN MATRIX. */ /* ON INPUT */ /* NM MUST BE SET TO THE ROW DIMENSION OF THE TWO-DIMENSIONAL */ /* ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM */ /* DIMENSION STATEMENT. */ /* N IS THE ORDER OF THE MATRIX A=(AR,AI). */ /* AR AND AI CONTAIN THE REAL AND IMAGINARY PARTS, */ /* RESPECTIVELY, OF THE COMPLEX HERMITIAN MATRIX. */ /* MATZ IS AN INTEGER VARIABLE SET EQUAL TO ZERO IF */ /* ONLY EIGENVALUES ARE DESIRED. OTHERWISE IT IS SET TO */ /* ANY NON-ZERO INTEGER FOR BOTH EIGENVALUES AND EIGENVECTORS. */ /* ON OUTPUT */ /* W CONTAINS THE EIGENVALUES IN ASCENDING ORDER. */ /* ZR AND ZI CONTAIN THE REAL AND IMAGINARY PARTS, */ /* RESPECTIVELY, OF THE EIGENVECTORS IF MATZ IS NOT ZERO. */ /* IERR IS AN INTEGER OUTPUT VARIABLE SET EQUAL TO AN ERROR */ /* COMPLETION CODE DESCRIBED IN THE DOCUMENTATION FOR TQLRAT */ /* AND TQL2. THE NORMAL COMPLETION CODE IS ZERO. */ /* FV1, FV2, AND FM1 ARE TEMPORARY STORAGE ARRAYS. */ /* QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, */ /* MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY */ /* THIS VERSION DATED AUGUST 1983. */ /* ------------------------------------------------------------------ */ /* Parameter adjustments */ fm1 -= 3; --fv2; --fv1; zi_dim1 = *nm; zi_offset = zi_dim1 + 1; zi -= zi_offset; zr_dim1 = *nm; zr_offset = zr_dim1 + 1; zr -= zr_offset; --w; ai_dim1 = *nm; ai_offset = ai_dim1 + 1; ai -= ai_offset; ar_dim1 = *nm; ar_offset = ar_dim1 + 1; ar -= ar_offset; /* Function Body */ if (*n <= *nm) { goto L10; } *ierr = *n * 10; goto L50; L10: htridi_(nm, n, &ar[ar_offset], &ai[ai_offset], &w[1], &fv1[1], &fv2[1], & fm1[3]); if (*matz != 0) { goto L20; } /* .......... FIND EIGENVALUES ONLY .......... */ tqlrat_(n, &w[1], &fv2[1], ierr); goto L50; /* .......... FIND BOTH EIGENVALUES AND EIGENVECTORS .......... */ L20: i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { i__2 = *n; for (j = 1; j <= i__2; ++j) { zr[j + i__ * zr_dim1] = 0.; /* L30: */ } zr[i__ + i__ * zr_dim1] = 1.; /* L40: */ } tql2_(nm, n, &w[1], &fv1[1], &zr[zr_offset], ierr); if (*ierr != 0) { goto L50; } htribk_(nm, n, &ar[ar_offset], &ai[ai_offset], &fm1[3], n, &zr[zr_offset], &zi[zi_offset]); L50: return 0; } /* ch_ */