/* rsp.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 rsp_(integer *nm, integer *n, integer *nv, doublereal *a,
doublereal *w, integer *matz, doublereal *z__, doublereal *fv1,
doublereal *fv2, integer *ierr)
{
/* System generated locals */
integer z_dim1, z_offset, i__1, i__2;
/* Local variables */
extern /* Subroutine */ int tred3_(integer *, integer *, doublereal *,
doublereal *, doublereal *, doublereal *);
static integer i__, j;
extern /* Subroutine */ int trbak3_(integer *, integer *, integer *,
doublereal *, integer *, 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 REAL SYMMETRIC PACKED 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. */
/* NV IS AN INTEGER VARIABLE SET EQUAL TO THE */
/* DIMENSION OF THE ARRAY A AS SPECIFIED FOR */
/* A IN THE CALLING PROGRAM. NV MUST NOT BE */
/* LESS THAN N*(N+1)/2. */
/* A CONTAINS THE LOWER TRIANGLE OF THE REAL SYMMETRIC */
/* PACKED MATRIX STORED ROW-WISE. */
/* 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. */
/* Z CONTAINS 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 AND FV2 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 */
--fv2;
--fv1;
z_dim1 = *nm;
z_offset = z_dim1 + 1;
z__ -= z_offset;
--w;
--a;
/* Function Body */
if (*n <= *nm) {
goto L5;
}
*ierr = *n * 10;
goto L50;
L5:
if (*nv >= *n * (*n + 1) / 2) {
goto L10;
}
*ierr = *n * 20;
goto L50;
L10:
tred3_(n, nv, &a[1], &w[1], &fv1[1], &fv2[1]);
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) {
z__[j + i__ * z_dim1] = 0.;
/* L30: */
}
z__[i__ + i__ * z_dim1] = 1.;
/* L40: */
}
tql2_(nm, n, &w[1], &fv1[1], &z__[z_offset], ierr);
if (*ierr != 0) {
goto L50;
}
trbak3_(nm, n, nv, &a[1], n, &z__[z_offset]);
L50:
return 0;
} /* rsp_ */
syntax highlighted by Code2HTML, v. 0.9.1