00001 /* rsm.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 rsm_(integer *nm, integer *n, doublereal *a, doublereal *
00009         w, integer *m, doublereal *z__, doublereal *fwork, integer *iwork, 
00010         integer *ierr)
00011 {
00012     /* System generated locals */
00013     integer a_dim1, a_offset, z_dim1, z_offset;
00014 
00015     /* Local variables */
00016     extern /* Subroutine */ int tred1_(integer *, integer *, doublereal *, 
00017             doublereal *, doublereal *, doublereal *);
00018     static integer k1, k2, k3, k4, k5, k6, k7, k8;
00019     extern /* Subroutine */ int trbak1_(integer *, integer *, doublereal *, 
00020             doublereal *, integer *, doublereal *), tqlrat_(integer *, 
00021             doublereal *, doublereal *, integer *), imtqlv_(integer *, 
00022             doublereal *, doublereal *, doublereal *, doublereal *, integer *,
00023              integer *, doublereal *), tinvit_(integer *, integer *, 
00024             doublereal *, doublereal *, doublereal *, integer *, doublereal *,
00025              integer *, doublereal *, integer *, doublereal *, doublereal *, 
00026             doublereal *, doublereal *, doublereal *);
00027 
00028 
00029 
00030 /*     THIS SUBROUTINE CALLS THE RECOMMENDED SEQUENCE OF */
00031 /*     SUBROUTINES FROM THE EIGENSYSTEM SUBROUTINE PACKAGE (EISPACK) */
00032 /*     TO FIND ALL OF THE EIGENVALUES AND SOME OF THE EIGENVECTORS */
00033 /*     OF A REAL SYMMETRIC MATRIX. */
00034 
00035 /*     ON INPUT */
00036 
00037 /*        NM  MUST BE SET TO THE ROW DIMENSION OF THE TWO-DIMENSIONAL */
00038 /*        ARRAY PARAMETERS AS DECLARED IN THE CALLING PROGRAM */
00039 /*        DIMENSION STATEMENT. */
00040 
00041 /*        N  IS THE ORDER OF THE MATRIX  A. */
00042 
00043 /*        A  CONTAINS THE REAL SYMMETRIC MATRIX. */
00044 
00045 /*        M  THE EIGENVECTORS CORRESPONDING TO THE FIRST M EIGENVALUES */
00046 /*           ARE TO BE COMPUTED. */
00047 /*           IF M = 0 THEN NO EIGENVECTORS ARE COMPUTED. */
00048 /*           IF M = N THEN ALL OF THE EIGENVECTORS ARE COMPUTED. */
00049 
00050 /*     ON OUTPUT */
00051 
00052 /*        W  CONTAINS ALL N EIGENVALUES IN ASCENDING ORDER. */
00053 
00054 /*        Z  CONTAINS THE ORTHONORMAL EIGENVECTORS ASSOCIATED WITH */
00055 /*           THE FIRST M EIGENVALUES. */
00056 
00057 /*        IERR  IS AN INTEGER OUTPUT VARIABLE SET EQUAL TO AN ERROR */
00058 /*           COMPLETION CODE DESCRIBED IN THE DOCUMENTATION FOR TQLRAT, */
00059 /*           IMTQLV AND TINVIT.  THE NORMAL COMPLETION CODE IS ZERO. */
00060 
00061 /*        FWORK  IS A TEMPORARY STORAGE ARRAY OF DIMENSION 8*N. */
00062 
00063 /*        IWORK  IS AN INTEGER TEMPORARY STORAGE ARRAY OF DIMENSION N. */
00064 
00065 /*     QUESTIONS AND COMMENTS SHOULD BE DIRECTED TO BURTON S. GARBOW, */
00066 /*     MATHEMATICS AND COMPUTER SCIENCE DIV, ARGONNE NATIONAL LABORATORY 
00067 */
00068 
00069 /*     THIS VERSION DATED AUGUST 1983. */
00070 
00071 /*     ------------------------------------------------------------------ 
00072 */
00073 
00074     /* Parameter adjustments */
00075     --iwork;
00076     --w;
00077     a_dim1 = *nm;
00078     a_offset = a_dim1 + 1;
00079     a -= a_offset;
00080     z_dim1 = *nm;
00081     z_offset = z_dim1 + 1;
00082     z__ -= z_offset;
00083     --fwork;
00084 
00085     /* Function Body */
00086     *ierr = *n * 10;
00087     if (*n > *nm || *m > *nm) {
00088         goto L50;
00089     }
00090     k1 = 1;
00091     k2 = k1 + *n;
00092     k3 = k2 + *n;
00093     k4 = k3 + *n;
00094     k5 = k4 + *n;
00095     k6 = k5 + *n;
00096     k7 = k6 + *n;
00097     k8 = k7 + *n;
00098     if (*m > 0) {
00099         goto L10;
00100     }
00101 /*     .......... FIND EIGENVALUES ONLY .......... */
00102     tred1_(nm, n, &a[a_offset], &w[1], &fwork[k1], &fwork[k2]);
00103     tqlrat_(n, &w[1], &fwork[k2], ierr);
00104     goto L50;
00105 /*     .......... FIND ALL EIGENVALUES AND M EIGENVECTORS .......... */
00106 L10:
00107     tred1_(nm, n, &a[a_offset], &fwork[k1], &fwork[k2], &fwork[k3]);
00108     imtqlv_(n, &fwork[k1], &fwork[k2], &fwork[k3], &w[1], &iwork[1], ierr, &
00109             fwork[k4]);
00110     tinvit_(nm, n, &fwork[k1], &fwork[k2], &fwork[k3], m, &w[1], &iwork[1], &
00111             z__[z_offset], ierr, &fwork[k4], &fwork[k5], &fwork[k6], &fwork[
00112             k7], &fwork[k8]);
00113     trbak1_(nm, n, &a[a_offset], &fwork[k2], m, &z__[z_offset]);
00114 L50:
00115     return 0;
00116 } /* rsm_ */
00117