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