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