/* ch.f -- translated by f2c (version 19961017).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#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 */
static 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_ */
syntax highlighted by Code2HTML, v. 0.9.1