/*< subroutine rsg(nm,n,a,b,w,matz,z,fv1,fv2,ierr) >*/
/* Subroutine */ int rsg_(integer *nm, integer *n, doublereal *a, doublereal *
b, doublereal *w, integer *matz, doublereal *z__, doublereal *fv1,
doublereal *fv2, integer *ierr)
{
/* System generated locals */
integer a_dim1, a_offset, b_dim1, b_offset, z_dim1, z_offset;
/* Local variables */
extern /* Subroutine */ int tql2_(integer *, integer *, doublereal *,
doublereal *, doublereal *, integer *), tred1_(integer *, integer
*, doublereal *, doublereal *, doublereal *, doublereal *),
tred2_(integer *, integer *, doublereal *, doublereal *,
doublereal *, doublereal *), rebak_(integer *, integer *,
doublereal *, doublereal *, integer *, doublereal *), reduc_(
integer *, integer *, doublereal *, doublereal *, doublereal *,
integer *), tqlrat_(integer *, doublereal *, doublereal *,
integer *);
/*< integer n,nm,ierr,matz >*/
/*< double precision a(nm,n),b(nm,n),w(n),z(nm,n),fv1(n),fv2(n) >*/
/* this subroutine calls the recommended sequence of */
/* subroutines from the eigensystem subroutine package (eispack) */
/* to find the eigenvalues and eigenvectors (if desired) */
/* for the real symmetric generalized eigenproblem ax = (lambda)bx. */
/* 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 matrices a and b. */
/* a contains a real symmetric matrix. */
/* b contains a positive definite real symmetric 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. */
/* 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. */
/* ------------------------------------------------------------------ */
/*< if (n .le. nm) go to 10 >*/
/* Parameter adjustments */
--fv2;
--fv1;
z_dim1 = *nm;
z_offset = 1 + z_dim1;
z__ -= z_offset;
--w;
b_dim1 = *nm;
b_offset = 1 + b_dim1;
b -= b_offset;
a_dim1 = *nm;
a_offset = 1 + a_dim1;
a -= a_offset;
/* Function Body */
if (*n <= *nm) {
goto L10;
}
/*< ierr = 10 * n >*/
*ierr = *n * 10;
/*< go to 50 >*/
goto L50;
/*< 10 call reduc(nm,n,a,b,fv2,ierr) >*/
L10:
reduc_(nm, n, &a[a_offset], &b[b_offset], &fv2[1], ierr);
/*< if (ierr .ne. 0) go to 50 >*/
if (*ierr != 0) {
goto L50;
}
/*< if (matz .ne. 0) go to 20 >*/
if (*matz != 0) {
goto L20;
}
/* .......... find eigenvalues only .......... */
/*< call tred1(nm,n,a,w,fv1,fv2) >*/
tred1_(nm, n, &a[a_offset], &w[1], &fv1[1], &fv2[1]);
/*< call tqlrat(n,w,fv2,ierr) >*/
tqlrat_(n, &w[1], &fv2[1], ierr);
/*< go to 50 >*/
goto L50;
/* .......... find both eigenvalues and eigenvectors .......... */
/*< 20 call tred2(nm,n,a,w,fv1,z) >*/
L20:
tred2_(nm, n, &a[a_offset], &w[1], &fv1[1], &z__[z_offset]);
/*< call tql2(nm,n,w,fv1,z,ierr) >*/
tql2_(nm, n, &w[1], &fv1[1], &z__[z_offset], ierr);
/*< if (ierr .ne. 0) go to 50 >*/
if (*ierr != 0) {
goto L50;
}
/*< call rebak(nm,n,b,fv2,n,z) >*/
rebak_(nm, n, &b[b_offset], &fv2[1], n, &z__[z_offset]);
/*< 50 return >*/
L50:
return 0;
/*< end >*/
} /* rsg_ */
/* Subroutine */ int rsgba_(integer *nm, integer *n, doublereal *a,
doublereal *b, doublereal *w, integer *matz, doublereal *z__,
doublereal *fv1, doublereal *fv2, integer *ierr)
{
/* System generated locals */
integer a_dim1, a_offset, b_dim1, b_offset, z_dim1, z_offset;
/* Local variables */
extern /* Subroutine */ int tred1_(integer *, integer *, doublereal *,
doublereal *, doublereal *, doublereal *), tred2_(integer *,
integer *, doublereal *, doublereal *, doublereal *, doublereal *)
, reduc2_(integer *, integer *, doublereal *, doublereal *,
doublereal *, integer *), rebakb_(integer *, integer *,
doublereal *, 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) */
/* FOR THE REAL SYMMETRIC GENERALIZED EIGENPROBLEM BAX = (LAMBDA)X.
*/
/* 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 MATRICES A AND B. */
/* A CONTAINS A REAL SYMMETRIC MATRIX. */
/* B CONTAINS A POSITIVE DEFINITE REAL SYMMETRIC 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. */
/* 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;
b_dim1 = *nm;
b_offset = b_dim1 + 1;
b -= b_offset;
a_dim1 = *nm;
a_offset = a_dim1 + 1;
a -= a_offset;
/* Function Body */
if (*n <= *nm) {
goto L10;
}
*ierr = *n * 10;
goto L50;
L10:
reduc2_(nm, n, &a[a_offset], &b[b_offset], &fv2[1], ierr);
if (*ierr != 0) {
goto L50;
}
if (*matz != 0) {
goto L20;
}
/* .......... FIND EIGENVALUES ONLY .......... */
tred1_(nm, n, &a[a_offset], &w[1], &fv1[1], &fv2[1]);
tqlrat_(n, &w[1], &fv2[1], ierr);
goto L50;
/* .......... FIND BOTH EIGENVALUES AND EIGENVECTORS .......... */
L20:
tred2_(nm, n, &a[a_offset], &w[1], &fv1[1], &z__[z_offset]);
tql2_(nm, n, &w[1], &fv1[1], &z__[z_offset], ierr);
if (*ierr != 0) {
goto L50;
}
rebakb_(nm, n, &b[b_offset], &fv2[1], n, &z__[z_offset]);
L50:
return 0;
} /* rsgba_ */