/* Subroutine */ int serrgg_(char *path, integer *nunit) { /* Format strings */ static char fmt_9999[] = "(1x,a3,\002 routines passed the tests of the e" "rror exits (\002,i3,\002 tests done)\002)"; static char fmt_9998[] = "(\002 *** \002,a3,\002 routines failed the tes" "ts of the error \002,\002exits ***\002)"; /* Builtin functions */ integer s_wsle(cilist *), e_wsle(void); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); /* Local variables */ real a[9] /* was [3][3] */, b[9] /* was [3][3] */; integer i__, j, m; real q[9] /* was [3][3] */, u[9] /* was [3][3] */, v[9] /* was [3][3] */, w[18], z__[9] /* was [3][3] */; char c2[2]; real r1[3], r2[3], r3[3]; logical bw[3]; real ls[3]; integer iw[3], nt; real rs[3], dif, rce[2]; logical sel[3]; real tau[3], rcv[2]; integer info, sdim; real anrm, bnrm, tola, tolb; integer ifst, ilst; real scale; extern /* Subroutine */ int sgges_(char *, char *, char *, L_fp, integer * , real *, integer *, real *, integer *, integer *, real *, real *, real *, real *, integer *, real *, integer *, real *, integer *, logical *, integer *), sggev_(char *, char *, integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, integer *, real *, integer *, real *, integer *, integer *); integer ncycle; extern /* Subroutine */ int sgghrd_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer * , real *, integer *, integer *); extern logical lsamen_(integer *, char *, char *); extern /* Subroutine */ int sggglm_(integer *, integer *, integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, integer *, integer *), chkxer_(char *, integer *, integer *, logical *, logical *), sgglse_(integer *, integer *, integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, integer *, integer *), sggqrf_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real * , real *, integer *, integer *), sggrqf_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, real *, integer *, integer *), stgevc_(char *, char *, logical *, integer *, real *, integer *, real *, integer *, real *, integer * , real *, integer *, integer *, integer *, real *, integer *); extern logical slctes_(); extern /* Subroutine */ int sggsvd_(char *, char *, char *, integer *, integer *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, real *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *), stgexc_(logical *, logical *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *, integer *, real *, integer *, integer *), sggesx_(char *, char *, char *, L_fp, char *, integer *, real *, integer *, real *, integer *, integer *, real *, real *, real *, real *, integer *, real *, integer *, real *, real *, real *, integer *, integer *, integer *, logical *, integer *), shgeqz_(char *, char *, char *, integer * , integer *, integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, integer *, real *, integer *, real *, integer *, integer *), stgsja_( char *, char *, char *, integer *, integer *, integer *, integer * , integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *), sggevx_(char *, char *, char *, char *, integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, integer *, real *, integer *, integer *, integer *, real *, real * , real *, real *, real *, real *, real *, integer *, integer *, logical *, integer *), stgsen_( integer *, logical *, logical *, logical *, integer *, real *, integer *, real *, integer *, real *, real *, real *, real *, integer *, real *, integer *, integer *, real *, real *, real *, real *, integer *, integer *, integer *, integer *), stgsna_(char *, char *, logical *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *, integer *); integer dummyk, dummyl; extern /* Subroutine */ int sggsvp_(char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real * , real *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *, real *, real *, integer * ); extern logical slctsx_(); extern /* Subroutine */ int stgsyl_(char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer *, real * , integer *, real *, integer *, real *, integer *, real *, real *, real *, integer *, integer *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, 0, 0 }; static cilist io___38 = { 0, 0, 0, fmt_9999, 0 }; static cilist io___39 = { 0, 0, 0, fmt_9998, 0 }; /* -- LAPACK test routine (version 3.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* SERRGG tests the error exits for SGGES, SGGESX, SGGEV, SGGEVX, */ /* SGGGLM, SGGHRD, SGGLSE, SGGQRF, SGGRQF, SGGSVD, SGGSVP, SHGEQZ, */ /* STGEVC, STGEXC, STGSEN, STGSJA, STGSNA, and STGSYL. */ /* Arguments */ /* ========= */ /* PATH (input) CHARACTER*3 */ /* The LAPACK path name for the routines to be tested. */ /* NUNIT (input) INTEGER */ /* The unit number for output. */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. Scalars in Common .. */ /* .. */ /* .. Common blocks .. */ /* .. */ /* .. Executable Statements .. */ infoc_1.nout = *nunit; io___1.ciunit = infoc_1.nout; s_wsle(&io___1); e_wsle(); s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2); /* Set the variables to innocuous values. */ for (j = 1; j <= 3; ++j) { sel[j - 1] = TRUE_; for (i__ = 1; i__ <= 3; ++i__) { a[i__ + j * 3 - 4] = 0.f; b[i__ + j * 3 - 4] = 0.f; /* L10: */ } /* L20: */ } for (i__ = 1; i__ <= 3; ++i__) { a[i__ + i__ * 3 - 4] = 1.f; b[i__ + i__ * 3 - 4] = 1.f; /* L30: */ } infoc_1.ok = TRUE_; tola = 1.f; tolb = 1.f; ifst = 1; ilst = 1; nt = 0; /* Test error exits for the GG path. */ if (lsamen_(&c__2, c2, "GG")) { /* SGGHRD */ s_copy(srnamc_1.srnamt, "SGGHRD", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgghrd_("/", "N", &c__0, &c__1, &c__0, a, &c__1, b, &c__1, q, &c__1, z__, &c__1, &info); chkxer_("SGGHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgghrd_("N", "/", &c__0, &c__1, &c__0, a, &c__1, b, &c__1, q, &c__1, z__, &c__1, &info); chkxer_("SGGHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgghrd_("N", "N", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, q, &c__1, z__, &c__1, &info); chkxer_("SGGHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sgghrd_("N", "N", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, q, &c__1, z__, &c__1, &info); chkxer_("SGGHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sgghrd_("N", "N", &c__0, &c__1, &c__1, a, &c__1, b, &c__1, q, &c__1, z__, &c__1, &info); chkxer_("SGGHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sgghrd_("N", "N", &c__2, &c__1, &c__1, a, &c__1, b, &c__2, q, &c__1, z__, &c__1, &info); chkxer_("SGGHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; sgghrd_("N", "N", &c__2, &c__1, &c__1, a, &c__2, b, &c__1, q, &c__1, z__, &c__1, &info); chkxer_("SGGHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; sgghrd_("V", "N", &c__2, &c__1, &c__1, a, &c__2, b, &c__2, q, &c__1, z__, &c__1, &info); chkxer_("SGGHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; sgghrd_("N", "V", &c__2, &c__1, &c__1, a, &c__2, b, &c__2, q, &c__1, z__, &c__1, &info); chkxer_("SGGHRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 9; /* SHGEQZ */ s_copy(srnamc_1.srnamt, "SHGEQZ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; shgeqz_("/", "N", "N", &c__0, &c__1, &c__0, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, z__, &c__1, w, &c__18, &info); chkxer_("SHGEQZ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; shgeqz_("E", "/", "N", &c__0, &c__1, &c__0, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, z__, &c__1, w, &c__18, &info); chkxer_("SHGEQZ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; shgeqz_("E", "N", "/", &c__0, &c__1, &c__0, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, z__, &c__1, w, &c__18, &info); chkxer_("SHGEQZ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; shgeqz_("E", "N", "N", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, z__, &c__1, w, &c__18, &info); chkxer_("SHGEQZ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; shgeqz_("E", "N", "N", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, z__, &c__1, w, &c__18, &info); chkxer_("SHGEQZ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; shgeqz_("E", "N", "N", &c__0, &c__1, &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, z__, &c__1, w, &c__18, &info); chkxer_("SHGEQZ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; shgeqz_("E", "N", "N", &c__2, &c__1, &c__1, a, &c__1, b, &c__2, r1, r2, r3, q, &c__1, z__, &c__1, w, &c__18, &info); chkxer_("SHGEQZ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; shgeqz_("E", "N", "N", &c__2, &c__1, &c__1, a, &c__2, b, &c__1, r1, r2, r3, q, &c__1, z__, &c__1, w, &c__18, &info); chkxer_("SHGEQZ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; shgeqz_("E", "V", "N", &c__2, &c__1, &c__1, a, &c__2, b, &c__2, r1, r2, r3, q, &c__1, z__, &c__1, w, &c__18, &info); chkxer_("SHGEQZ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 17; shgeqz_("E", "N", "V", &c__2, &c__1, &c__1, a, &c__2, b, &c__2, r1, r2, r3, q, &c__1, z__, &c__1, w, &c__18, &info); chkxer_("SHGEQZ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 10; /* STGEVC */ s_copy(srnamc_1.srnamt, "STGEVC", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; stgevc_("/", "A", sel, &c__0, a, &c__1, b, &c__1, q, &c__1, z__, & c__1, &c__0, &m, w, &info); chkxer_("STGEVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; stgevc_("R", "/", sel, &c__0, a, &c__1, b, &c__1, q, &c__1, z__, & c__1, &c__0, &m, w, &info); chkxer_("STGEVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; stgevc_("R", "A", sel, &c_n1, a, &c__1, b, &c__1, q, &c__1, z__, & c__1, &c__0, &m, w, &info); chkxer_("STGEVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; stgevc_("R", "A", sel, &c__2, a, &c__1, b, &c__2, q, &c__1, z__, & c__2, &c__0, &m, w, &info); chkxer_("STGEVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; stgevc_("R", "A", sel, &c__2, a, &c__2, b, &c__1, q, &c__1, z__, & c__2, &c__0, &m, w, &info); chkxer_("STGEVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; stgevc_("L", "A", sel, &c__2, a, &c__2, b, &c__2, q, &c__1, z__, & c__1, &c__0, &m, w, &info); chkxer_("STGEVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; stgevc_("R", "A", sel, &c__2, a, &c__2, b, &c__2, q, &c__1, z__, & c__1, &c__0, &m, w, &info); chkxer_("STGEVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; stgevc_("R", "A", sel, &c__2, a, &c__2, b, &c__2, q, &c__1, z__, & c__2, &c__1, &m, w, &info); chkxer_("STGEVC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 8; /* Test error exits for the GSV path. */ } else if (lsamen_(&c__3, path, "GSV")) { /* SGGSVD */ s_copy(srnamc_1.srnamt, "SGGSVD", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sggsvd_("/", "N", "N", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, & c__1, b, &c__1, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, & info); chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sggsvd_("N", "/", "N", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, & c__1, b, &c__1, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, & info); chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sggsvd_("N", "N", "/", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, & c__1, b, &c__1, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, & info); chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sggsvd_("N", "N", "N", &c_n1, &c__0, &c__0, &dummyk, &dummyl, a, & c__1, b, &c__1, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, & info); chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sggsvd_("N", "N", "N", &c__0, &c_n1, &c__0, &dummyk, &dummyl, a, & c__1, b, &c__1, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, & info); chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; sggsvd_("N", "N", "N", &c__0, &c__0, &c_n1, &dummyk, &dummyl, a, & c__1, b, &c__1, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, & info); chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; sggsvd_("N", "N", "N", &c__2, &c__1, &c__1, &dummyk, &dummyl, a, & c__1, b, &c__1, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, & info); chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; sggsvd_("N", "N", "N", &c__1, &c__1, &c__2, &dummyk, &dummyl, a, & c__1, b, &c__1, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, & info); chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 16; sggsvd_("U", "N", "N", &c__2, &c__2, &c__2, &dummyk, &dummyl, a, & c__2, b, &c__2, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, & info); chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 18; sggsvd_("N", "V", "N", &c__1, &c__1, &c__2, &dummyk, &dummyl, a, & c__1, b, &c__2, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, & info); chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 20; sggsvd_("N", "N", "Q", &c__1, &c__2, &c__1, &dummyk, &dummyl, a, & c__1, b, &c__1, r1, r2, u, &c__1, v, &c__1, q, &c__1, w, iw, & info); chkxer_("SGGSVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 11; /* SGGSVP */ s_copy(srnamc_1.srnamt, "SGGSVP", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sggsvp_("/", "N", "N", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, &tola, &tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw, tau, w, &info); chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sggsvp_("N", "/", "N", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, &tola, &tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw, tau, w, &info); chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sggsvp_("N", "N", "/", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, &tola, &tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw, tau, w, &info); chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sggsvp_("N", "N", "N", &c_n1, &c__0, &c__0, a, &c__1, b, &c__1, &tola, &tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw, tau, w, &info); chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sggsvp_("N", "N", "N", &c__0, &c_n1, &c__0, a, &c__1, b, &c__1, &tola, &tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw, tau, w, &info); chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; sggsvp_("N", "N", "N", &c__0, &c__0, &c_n1, a, &c__1, b, &c__1, &tola, &tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw, tau, w, &info); chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; sggsvp_("N", "N", "N", &c__2, &c__1, &c__1, a, &c__1, b, &c__1, &tola, &tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw, tau, w, &info); chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; sggsvp_("N", "N", "N", &c__1, &c__2, &c__1, a, &c__1, b, &c__1, &tola, &tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw, tau, w, &info); chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 16; sggsvp_("U", "N", "N", &c__2, &c__2, &c__2, a, &c__2, b, &c__2, &tola, &tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw, tau, w, &info); chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 18; sggsvp_("N", "V", "N", &c__1, &c__2, &c__1, a, &c__1, b, &c__2, &tola, &tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw, tau, w, &info); chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 20; sggsvp_("N", "N", "Q", &c__1, &c__1, &c__2, a, &c__1, b, &c__1, &tola, &tolb, &dummyk, &dummyl, u, &c__1, v, &c__1, q, &c__1, iw, tau, w, &info); chkxer_("SGGSVP", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 11; /* STGSJA */ s_copy(srnamc_1.srnamt, "STGSJA", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; stgsja_("/", "N", "N", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, & c__1, b, &c__1, &tola, &tolb, r1, r2, u, &c__1, v, &c__1, q, & c__1, w, &ncycle, &info); chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; stgsja_("N", "/", "N", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, & c__1, b, &c__1, &tola, &tolb, r1, r2, u, &c__1, v, &c__1, q, & c__1, w, &ncycle, &info); chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; stgsja_("N", "N", "/", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, & c__1, b, &c__1, &tola, &tolb, r1, r2, u, &c__1, v, &c__1, q, & c__1, w, &ncycle, &info); chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; stgsja_("N", "N", "N", &c_n1, &c__0, &c__0, &dummyk, &dummyl, a, & c__1, b, &c__1, &tola, &tolb, r1, r2, u, &c__1, v, &c__1, q, & c__1, w, &ncycle, &info); chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; stgsja_("N", "N", "N", &c__0, &c_n1, &c__0, &dummyk, &dummyl, a, & c__1, b, &c__1, &tola, &tolb, r1, r2, u, &c__1, v, &c__1, q, & c__1, w, &ncycle, &info); chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; stgsja_("N", "N", "N", &c__0, &c__0, &c_n1, &dummyk, &dummyl, a, & c__1, b, &c__1, &tola, &tolb, r1, r2, u, &c__1, v, &c__1, q, & c__1, w, &ncycle, &info); chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; stgsja_("N", "N", "N", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, & c__0, b, &c__1, &tola, &tolb, r1, r2, u, &c__1, v, &c__1, q, & c__1, w, &ncycle, &info); chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; stgsja_("N", "N", "N", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, & c__1, b, &c__0, &tola, &tolb, r1, r2, u, &c__1, v, &c__1, q, & c__1, w, &ncycle, &info); chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 18; stgsja_("U", "N", "N", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, & c__1, b, &c__1, &tola, &tolb, r1, r2, u, &c__0, v, &c__1, q, & c__1, w, &ncycle, &info); chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 20; stgsja_("N", "V", "N", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, & c__1, b, &c__1, &tola, &tolb, r1, r2, u, &c__1, v, &c__0, q, & c__1, w, &ncycle, &info); chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 22; stgsja_("N", "N", "Q", &c__0, &c__0, &c__0, &dummyk, &dummyl, a, & c__1, b, &c__1, &tola, &tolb, r1, r2, u, &c__1, v, &c__1, q, & c__0, w, &ncycle, &info); chkxer_("STGSJA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 11; /* Test error exits for the GLM path. */ } else if (lsamen_(&c__3, path, "GLM")) { /* SGGGLM */ s_copy(srnamc_1.srnamt, "SGGGLM", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sggglm_(&c_n1, &c__0, &c__0, a, &c__1, b, &c__1, r1, r2, r3, w, & c__18, &info); chkxer_("SGGGLM", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sggglm_(&c__0, &c_n1, &c__0, a, &c__1, b, &c__1, r1, r2, r3, w, & c__18, &info); chkxer_("SGGGLM", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sggglm_(&c__0, &c__1, &c__0, a, &c__1, b, &c__1, r1, r2, r3, w, & c__18, &info); chkxer_("SGGGLM", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sggglm_(&c__0, &c__0, &c_n1, a, &c__1, b, &c__1, r1, r2, r3, w, & c__18, &info); chkxer_("SGGGLM", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sggglm_(&c__1, &c__0, &c__0, a, &c__1, b, &c__1, r1, r2, r3, w, & c__18, &info); chkxer_("SGGGLM", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sggglm_(&c__0, &c__0, &c__0, a, &c__0, b, &c__1, r1, r2, r3, w, & c__18, &info); chkxer_("SGGGLM", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sggglm_(&c__0, &c__0, &c__0, a, &c__1, b, &c__0, r1, r2, r3, w, & c__18, &info); chkxer_("SGGGLM", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; sggglm_(&c__1, &c__1, &c__1, a, &c__1, b, &c__1, r1, r2, r3, w, &c__1, &info); chkxer_("SGGGLM", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 8; /* Test error exits for the LSE path. */ } else if (lsamen_(&c__3, path, "LSE")) { /* SGGLSE */ s_copy(srnamc_1.srnamt, "SGGLSE", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgglse_(&c_n1, &c__0, &c__0, a, &c__1, b, &c__1, r1, r2, r3, w, & c__18, &info); chkxer_("SGGLSE", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgglse_(&c__0, &c_n1, &c__0, a, &c__1, b, &c__1, r1, r2, r3, w, & c__18, &info); chkxer_("SGGLSE", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgglse_(&c__0, &c__0, &c_n1, a, &c__1, b, &c__1, r1, r2, r3, w, & c__18, &info); chkxer_("SGGLSE", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgglse_(&c__0, &c__0, &c__1, a, &c__1, b, &c__1, r1, r2, r3, w, & c__18, &info); chkxer_("SGGLSE", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgglse_(&c__0, &c__1, &c__0, a, &c__1, b, &c__1, r1, r2, r3, w, & c__18, &info); chkxer_("SGGLSE", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sgglse_(&c__0, &c__0, &c__0, a, &c__0, b, &c__1, r1, r2, r3, w, & c__18, &info); chkxer_("SGGLSE", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sgglse_(&c__0, &c__0, &c__0, a, &c__1, b, &c__0, r1, r2, r3, w, & c__18, &info); chkxer_("SGGLSE", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; sgglse_(&c__1, &c__1, &c__1, a, &c__1, b, &c__1, r1, r2, r3, w, &c__1, &info); chkxer_("SGGLSE", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 8; /* Test error exits for the GQR path. */ } else if (lsamen_(&c__3, path, "GQR")) { /* SGGQRF */ s_copy(srnamc_1.srnamt, "SGGQRF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sggqrf_(&c_n1, &c__0, &c__0, a, &c__1, r1, b, &c__1, r2, w, &c__18, & info); chkxer_("SGGQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sggqrf_(&c__0, &c_n1, &c__0, a, &c__1, r1, b, &c__1, r2, w, &c__18, & info); chkxer_("SGGQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sggqrf_(&c__0, &c__0, &c_n1, a, &c__1, r1, b, &c__1, r2, w, &c__18, & info); chkxer_("SGGQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sggqrf_(&c__0, &c__0, &c__0, a, &c__0, r1, b, &c__1, r2, w, &c__18, & info); chkxer_("SGGQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; sggqrf_(&c__0, &c__0, &c__0, a, &c__1, r1, b, &c__0, r2, w, &c__18, & info); chkxer_("SGGQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; sggqrf_(&c__1, &c__1, &c__2, a, &c__1, r1, b, &c__1, r2, w, &c__1, & info); chkxer_("SGGQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 6; /* SGGRQF */ s_copy(srnamc_1.srnamt, "SGGRQF", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sggrqf_(&c_n1, &c__0, &c__0, a, &c__1, r1, b, &c__1, r2, w, &c__18, & info); chkxer_("SGGRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sggrqf_(&c__0, &c_n1, &c__0, a, &c__1, r1, b, &c__1, r2, w, &c__18, & info); chkxer_("SGGRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sggrqf_(&c__0, &c__0, &c_n1, a, &c__1, r1, b, &c__1, r2, w, &c__18, & info); chkxer_("SGGRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sggrqf_(&c__0, &c__0, &c__0, a, &c__0, r1, b, &c__1, r2, w, &c__18, & info); chkxer_("SGGRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; sggrqf_(&c__0, &c__0, &c__0, a, &c__1, r1, b, &c__0, r2, w, &c__18, & info); chkxer_("SGGRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; sggrqf_(&c__1, &c__1, &c__2, a, &c__1, r1, b, &c__1, r2, w, &c__1, & info); chkxer_("SGGRQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 6; /* Test error exits for the SGS, SGV, SGX, and SXV paths. */ } else if (lsamen_(&c__3, path, "SGS") || lsamen_(& c__3, path, "SGV") || lsamen_(&c__3, path, "SGX") || lsamen_(&c__3, path, "SXV")) { /* SGGES */ s_copy(srnamc_1.srnamt, "SGGES ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sgges_("/", "N", "S", (L_fp)slctes_, &c__1, a, &c__1, b, &c__1, &sdim, r1, r2, r3, q, &c__1, u, &c__1, w, &c__1, bw, &info); chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sgges_("N", "/", "S", (L_fp)slctes_, &c__1, a, &c__1, b, &c__1, &sdim, r1, r2, r3, q, &c__1, u, &c__1, w, &c__1, bw, &info); chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sgges_("N", "V", "/", (L_fp)slctes_, &c__1, a, &c__1, b, &c__1, &sdim, r1, r2, r3, q, &c__1, u, &c__1, w, &c__1, bw, &info); chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sgges_("N", "V", "S", (L_fp)slctes_, &c_n1, a, &c__1, b, &c__1, &sdim, r1, r2, r3, q, &c__1, u, &c__1, w, &c__1, bw, &info); chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sgges_("N", "V", "S", (L_fp)slctes_, &c__1, a, &c__0, b, &c__1, &sdim, r1, r2, r3, q, &c__1, u, &c__1, w, &c__1, bw, &info); chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; sgges_("N", "V", "S", (L_fp)slctes_, &c__1, a, &c__1, b, &c__0, &sdim, r1, r2, r3, q, &c__1, u, &c__1, w, &c__1, bw, &info); chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; sgges_("N", "V", "S", (L_fp)slctes_, &c__1, a, &c__1, b, &c__1, &sdim, r1, r2, r3, q, &c__0, u, &c__1, w, &c__1, bw, &info); chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; sgges_("V", "V", "S", (L_fp)slctes_, &c__2, a, &c__2, b, &c__2, &sdim, r1, r2, r3, q, &c__1, u, &c__2, w, &c__1, bw, &info); chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 17; sgges_("N", "V", "S", (L_fp)slctes_, &c__1, a, &c__1, b, &c__1, &sdim, r1, r2, r3, q, &c__1, u, &c__0, w, &c__1, bw, &info); chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 17; sgges_("V", "V", "S", (L_fp)slctes_, &c__2, a, &c__2, b, &c__2, &sdim, r1, r2, r3, q, &c__2, u, &c__1, w, &c__1, bw, &info); chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 19; sgges_("V", "V", "S", (L_fp)slctes_, &c__2, a, &c__2, b, &c__2, &sdim, r1, r2, r3, q, &c__2, u, &c__2, w, &c__1, bw, &info); chkxer_("SGGES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 11; /* SGGESX */ s_copy(srnamc_1.srnamt, "SGGESX", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sggesx_("/", "N", "S", (L_fp)slctsx_, "N", &c__1, a, &c__1, b, &c__1, &sdim, r1, r2, r3, q, &c__1, u, &c__1, rce, rcv, w, &c__1, iw, &c__1, bw, &info) ; chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sggesx_("N", "/", "S", (L_fp)slctsx_, "N", &c__1, a, &c__1, b, &c__1, &sdim, r1, r2, r3, q, &c__1, u, &c__1, rce, rcv, w, &c__1, iw, &c__1, bw, &info) ; chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sggesx_("V", "V", "/", (L_fp)slctsx_, "N", &c__1, a, &c__1, b, &c__1, &sdim, r1, r2, r3, q, &c__1, u, &c__1, rce, rcv, w, &c__1, iw, &c__1, bw, &info) ; chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sggesx_("V", "V", "S", (L_fp)slctsx_, "/", &c__1, a, &c__1, b, &c__1, &sdim, r1, r2, r3, q, &c__1, u, &c__1, rce, rcv, w, &c__1, iw, &c__1, bw, &info) ; chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; sggesx_("V", "V", "S", (L_fp)slctsx_, "B", &c_n1, a, &c__1, b, &c__1, &sdim, r1, r2, r3, q, &c__1, u, &c__1, rce, rcv, w, &c__1, iw, &c__1, bw, &info) ; chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; sggesx_("V", "V", "S", (L_fp)slctsx_, "B", &c__1, a, &c__0, b, &c__1, &sdim, r1, r2, r3, q, &c__1, u, &c__1, rce, rcv, w, &c__1, iw, &c__1, bw, &info) ; chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; sggesx_("V", "V", "S", (L_fp)slctsx_, "B", &c__1, a, &c__1, b, &c__0, &sdim, r1, r2, r3, q, &c__1, u, &c__1, rce, rcv, w, &c__1, iw, &c__1, bw, &info) ; chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 16; sggesx_("V", "V", "S", (L_fp)slctsx_, "B", &c__1, a, &c__1, b, &c__1, &sdim, r1, r2, r3, q, &c__0, u, &c__1, rce, rcv, w, &c__1, iw, &c__1, bw, &info) ; chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 16; sggesx_("V", "V", "S", (L_fp)slctsx_, "B", &c__2, a, &c__2, b, &c__2, &sdim, r1, r2, r3, q, &c__1, u, &c__1, rce, rcv, w, &c__1, iw, &c__1, bw, &info) ; chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 18; sggesx_("V", "V", "S", (L_fp)slctsx_, "B", &c__1, a, &c__1, b, &c__1, &sdim, r1, r2, r3, q, &c__1, u, &c__0, rce, rcv, w, &c__1, iw, &c__1, bw, &info) ; chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 18; sggesx_("V", "V", "S", (L_fp)slctsx_, "B", &c__2, a, &c__2, b, &c__2, &sdim, r1, r2, r3, q, &c__2, u, &c__1, rce, rcv, w, &c__1, iw, &c__1, bw, &info) ; chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 22; sggesx_("V", "V", "S", (L_fp)slctsx_, "B", &c__2, a, &c__2, b, &c__2, &sdim, r1, r2, r3, q, &c__2, u, &c__2, rce, rcv, w, &c__1, iw, &c__1, bw, &info) ; chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 24; sggesx_("V", "V", "S", (L_fp)slctsx_, "V", &c__1, a, &c__1, b, &c__1, &sdim, r1, r2, r3, q, &c__1, u, &c__1, rce, rcv, w, &c__32, iw, &c__0, bw, &info); chkxer_("SGGESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 13; /* SGGEV */ s_copy(srnamc_1.srnamt, "SGGEV ", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sggev_("/", "N", &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, u, & c__1, w, &c__1, &info); chkxer_("SGGEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sggev_("N", "/", &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, u, & c__1, w, &c__1, &info); chkxer_("SGGEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sggev_("V", "V", &c_n1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, u, & c__1, w, &c__1, &info); chkxer_("SGGEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sggev_("V", "V", &c__1, a, &c__0, b, &c__1, r1, r2, r3, q, &c__1, u, & c__1, w, &c__1, &info); chkxer_("SGGEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sggev_("V", "V", &c__1, a, &c__1, b, &c__0, r1, r2, r3, q, &c__1, u, & c__1, w, &c__1, &info); chkxer_("SGGEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; sggev_("N", "V", &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__0, u, & c__1, w, &c__1, &info); chkxer_("SGGEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; sggev_("V", "V", &c__2, a, &c__2, b, &c__2, r1, r2, r3, q, &c__1, u, & c__2, w, &c__1, &info); chkxer_("SGGEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 14; sggev_("V", "N", &c__2, a, &c__2, b, &c__2, r1, r2, r3, q, &c__2, u, & c__0, w, &c__1, &info); chkxer_("SGGEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 14; sggev_("V", "V", &c__2, a, &c__2, b, &c__2, r1, r2, r3, q, &c__2, u, & c__1, w, &c__1, &info); chkxer_("SGGEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 16; sggev_("V", "V", &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, u, & c__1, w, &c__1, &info); chkxer_("SGGEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 10; /* SGGEVX */ s_copy(srnamc_1.srnamt, "SGGEVX", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; sggevx_("/", "N", "N", "N", &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, u, &c__1, &c__1, &c__1, ls, rs, &anrm, &bnrm, rce, rcv, w, &c__1, iw, bw, &info); chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; sggevx_("N", "/", "N", "N", &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, u, &c__1, &c__1, &c__1, ls, rs, &anrm, &bnrm, rce, rcv, w, &c__1, iw, bw, &info); chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; sggevx_("N", "N", "/", "N", &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, u, &c__1, &c__1, &c__1, ls, rs, &anrm, &bnrm, rce, rcv, w, &c__1, iw, bw, &info); chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; sggevx_("N", "N", "N", "/", &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, u, &c__1, &c__1, &c__1, ls, rs, &anrm, &bnrm, rce, rcv, w, &c__1, iw, bw, &info); chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; sggevx_("N", "N", "N", "N", &c_n1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, u, &c__1, &c__1, &c__1, ls, rs, &anrm, &bnrm, rce, rcv, w, &c__1, iw, bw, &info); chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; sggevx_("N", "N", "N", "N", &c__1, a, &c__0, b, &c__1, r1, r2, r3, q, &c__1, u, &c__1, &c__1, &c__1, ls, rs, &anrm, &bnrm, rce, rcv, w, &c__1, iw, bw, &info); chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; sggevx_("N", "N", "N", "N", &c__1, a, &c__1, b, &c__0, r1, r2, r3, q, &c__1, u, &c__1, &c__1, &c__1, ls, rs, &anrm, &bnrm, rce, rcv, w, &c__1, iw, bw, &info); chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 14; sggevx_("N", "N", "N", "N", &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__0, u, &c__1, &c__1, &c__1, ls, rs, &anrm, &bnrm, rce, rcv, w, &c__1, iw, bw, &info); chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 14; sggevx_("N", "V", "N", "N", &c__2, a, &c__2, b, &c__2, r1, r2, r3, q, &c__1, u, &c__2, &c__1, &c__2, ls, rs, &anrm, &bnrm, rce, rcv, w, &c__1, iw, bw, &info); chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 16; sggevx_("N", "N", "N", "N", &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, u, &c__0, &c__1, &c__1, ls, rs, &anrm, &bnrm, rce, rcv, w, &c__1, iw, bw, &info); chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 16; sggevx_("N", "N", "V", "N", &c__2, a, &c__2, b, &c__2, r1, r2, r3, q, &c__2, u, &c__1, &c__1, &c__2, ls, rs, &anrm, &bnrm, rce, rcv, w, &c__1, iw, bw, &info); chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 26; sggevx_("N", "N", "V", "N", &c__2, a, &c__2, b, &c__2, r1, r2, r3, q, &c__2, u, &c__2, &c__1, &c__2, ls, rs, &anrm, &bnrm, rce, rcv, w, &c__1, iw, bw, &info); chkxer_("SGGEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 12; /* STGEXC */ s_copy(srnamc_1.srnamt, "STGEXC", (ftnlen)32, (ftnlen)6); infoc_1.infot = 3; stgexc_(&c_true, &c_true, &c_n1, a, &c__1, b, &c__1, q, &c__1, z__, & c__1, &ifst, &ilst, w, &c__1, &info); chkxer_("STGEXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; stgexc_(&c_true, &c_true, &c__1, a, &c__0, b, &c__1, q, &c__1, z__, & c__1, &ifst, &ilst, w, &c__1, &info); chkxer_("STGEXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; stgexc_(&c_true, &c_true, &c__1, a, &c__1, b, &c__0, q, &c__1, z__, & c__1, &ifst, &ilst, w, &c__1, &info); chkxer_("STGEXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; stgexc_(&c_false, &c_true, &c__1, a, &c__1, b, &c__1, q, &c__0, z__, & c__1, &ifst, &ilst, w, &c__1, &info); chkxer_("STGEXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; stgexc_(&c_true, &c_true, &c__1, a, &c__1, b, &c__1, q, &c__0, z__, & c__1, &ifst, &ilst, w, &c__1, &info); chkxer_("STGEXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; stgexc_(&c_true, &c_false, &c__1, a, &c__1, b, &c__1, q, &c__1, z__, & c__0, &ifst, &ilst, w, &c__1, &info); chkxer_("STGEXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; stgexc_(&c_true, &c_true, &c__1, a, &c__1, b, &c__1, q, &c__1, z__, & c__0, &ifst, &ilst, w, &c__1, &info); chkxer_("STGEXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; stgexc_(&c_true, &c_true, &c__1, a, &c__1, b, &c__1, q, &c__1, z__, & c__1, &ifst, &ilst, w, &c__0, &info); chkxer_("STGEXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 8; /* STGSEN */ s_copy(srnamc_1.srnamt, "STGSEN", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; stgsen_(&c_n1, &c_true, &c_true, sel, &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, z__, &c__1, &m, &tola, &tolb, rcv, w, &c__1, iw, &c__1, &info); chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; stgsen_(&c__1, &c_true, &c_true, sel, &c_n1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, z__, &c__1, &m, &tola, &tolb, rcv, w, &c__1, iw, &c__1, &info); chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; stgsen_(&c__1, &c_true, &c_true, sel, &c__1, a, &c__0, b, &c__1, r1, r2, r3, q, &c__1, z__, &c__1, &m, &tola, &tolb, rcv, w, &c__1, iw, &c__1, &info); chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; stgsen_(&c__1, &c_true, &c_true, sel, &c__1, a, &c__1, b, &c__0, r1, r2, r3, q, &c__1, z__, &c__1, &m, &tola, &tolb, rcv, w, &c__1, iw, &c__1, &info); chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 14; stgsen_(&c__1, &c_true, &c_true, sel, &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__0, z__, &c__1, &m, &tola, &tolb, rcv, w, &c__1, iw, &c__1, &info); chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 16; stgsen_(&c__1, &c_true, &c_true, sel, &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, z__, &c__0, &m, &tola, &tolb, rcv, w, &c__1, iw, &c__1, &info); chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 22; stgsen_(&c__0, &c_true, &c_true, sel, &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, z__, &c__1, &m, &tola, &tolb, rcv, w, &c__1, iw, &c__1, &info); chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 22; stgsen_(&c__1, &c_true, &c_true, sel, &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, z__, &c__1, &m, &tola, &tolb, rcv, w, &c__1, iw, &c__1, &info); chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 22; stgsen_(&c__2, &c_true, &c_true, sel, &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, z__, &c__1, &m, &tola, &tolb, rcv, w, &c__1, iw, &c__1, &info); chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 24; stgsen_(&c__0, &c_true, &c_true, sel, &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, z__, &c__1, &m, &tola, &tolb, rcv, w, & c__20, iw, &c__0, &info); chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 24; stgsen_(&c__1, &c_true, &c_true, sel, &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, z__, &c__1, &m, &tola, &tolb, rcv, w, & c__20, iw, &c__0, &info); chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 24; stgsen_(&c__2, &c_true, &c_true, sel, &c__1, a, &c__1, b, &c__1, r1, r2, r3, q, &c__1, z__, &c__1, &m, &tola, &tolb, rcv, w, & c__20, iw, &c__1, &info); chkxer_("STGSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 12; /* STGSNA */ s_copy(srnamc_1.srnamt, "STGSNA", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; stgsna_("/", "A", sel, &c__1, a, &c__1, b, &c__1, q, &c__1, u, &c__1, r1, r2, &c__1, &m, w, &c__1, iw, &info); chkxer_("STGSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; stgsna_("B", "/", sel, &c__1, a, &c__1, b, &c__1, q, &c__1, u, &c__1, r1, r2, &c__1, &m, w, &c__1, iw, &info); chkxer_("STGSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; stgsna_("B", "A", sel, &c_n1, a, &c__1, b, &c__1, q, &c__1, u, &c__1, r1, r2, &c__1, &m, w, &c__1, iw, &info); chkxer_("STGSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; stgsna_("B", "A", sel, &c__1, a, &c__0, b, &c__1, q, &c__1, u, &c__1, r1, r2, &c__1, &m, w, &c__1, iw, &info); chkxer_("STGSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; stgsna_("B", "A", sel, &c__1, a, &c__1, b, &c__0, q, &c__1, u, &c__1, r1, r2, &c__1, &m, w, &c__1, iw, &info); chkxer_("STGSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; stgsna_("E", "A", sel, &c__1, a, &c__1, b, &c__1, q, &c__0, u, &c__1, r1, r2, &c__1, &m, w, &c__1, iw, &info); chkxer_("STGSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; stgsna_("E", "A", sel, &c__1, a, &c__1, b, &c__1, q, &c__1, u, &c__0, r1, r2, &c__1, &m, w, &c__1, iw, &info); chkxer_("STGSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; stgsna_("E", "A", sel, &c__1, a, &c__1, b, &c__1, q, &c__1, u, &c__1, r1, r2, &c__0, &m, w, &c__1, iw, &info); chkxer_("STGSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 18; stgsna_("E", "A", sel, &c__1, a, &c__1, b, &c__1, q, &c__1, u, &c__1, r1, r2, &c__1, &m, w, &c__0, iw, &info); chkxer_("STGSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 9; /* STGSYL */ s_copy(srnamc_1.srnamt, "STGSYL", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; stgsyl_("/", &c__0, &c__1, &c__1, a, &c__1, b, &c__1, q, &c__1, u, & c__1, v, &c__1, z__, &c__1, &scale, &dif, w, &c__1, iw, &info); chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; stgsyl_("N", &c_n1, &c__1, &c__1, a, &c__1, b, &c__1, q, &c__1, u, & c__1, v, &c__1, z__, &c__1, &scale, &dif, w, &c__1, iw, &info); chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; stgsyl_("N", &c__0, &c__0, &c__1, a, &c__1, b, &c__1, q, &c__1, u, & c__1, v, &c__1, z__, &c__1, &scale, &dif, w, &c__1, iw, &info); chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; stgsyl_("N", &c__0, &c__1, &c__0, a, &c__1, b, &c__1, q, &c__1, u, & c__1, v, &c__1, z__, &c__1, &scale, &dif, w, &c__1, iw, &info); chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; stgsyl_("N", &c__0, &c__1, &c__1, a, &c__0, b, &c__1, q, &c__1, u, & c__1, v, &c__1, z__, &c__1, &scale, &dif, w, &c__1, iw, &info); chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; stgsyl_("N", &c__0, &c__1, &c__1, a, &c__1, b, &c__0, q, &c__1, u, & c__1, v, &c__1, z__, &c__1, &scale, &dif, w, &c__1, iw, &info); chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; stgsyl_("N", &c__0, &c__1, &c__1, a, &c__1, b, &c__1, q, &c__0, u, & c__1, v, &c__1, z__, &c__1, &scale, &dif, w, &c__1, iw, &info); chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 12; stgsyl_("N", &c__0, &c__1, &c__1, a, &c__1, b, &c__1, q, &c__1, u, & c__0, v, &c__1, z__, &c__1, &scale, &dif, w, &c__1, iw, &info); chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 14; stgsyl_("N", &c__0, &c__1, &c__1, a, &c__1, b, &c__1, q, &c__1, u, & c__1, v, &c__0, z__, &c__1, &scale, &dif, w, &c__1, iw, &info); chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 16; stgsyl_("N", &c__0, &c__1, &c__1, a, &c__1, b, &c__1, q, &c__1, u, & c__1, v, &c__1, z__, &c__0, &scale, &dif, w, &c__1, iw, &info); chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 20; stgsyl_("N", &c__1, &c__1, &c__1, a, &c__1, b, &c__1, q, &c__1, u, & c__1, v, &c__1, z__, &c__1, &scale, &dif, w, &c__1, iw, &info); chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 20; stgsyl_("N", &c__2, &c__1, &c__1, a, &c__1, b, &c__1, q, &c__1, u, & c__1, v, &c__1, z__, &c__1, &scale, &dif, w, &c__1, iw, &info); chkxer_("STGSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 12; } /* Print a summary line. */ if (infoc_1.ok) { io___38.ciunit = infoc_1.nout; s_wsfe(&io___38); do_fio(&c__1, path, (ftnlen)3); do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer)); e_wsfe(); } else { io___39.ciunit = infoc_1.nout; s_wsfe(&io___39); do_fio(&c__1, path, (ftnlen)3); e_wsfe(); } return 0; /* End of SERRGG */ } /* serrgg_ */
int sggevx_(char *balanc, char *jobvl, char *jobvr, char * sense, int *n, float *a, int *lda, float *b, int *ldb, float *alphar, float *alphai, float *beta, float *vl, int *ldvl, float *vr, int *ldvr, int *ilo, int *ihi, float *lscale, float *rscale, float *abnrm, float *bbnrm, float *rconde, float *rcondv, float *work, int *lwork, int *iwork, int *bwork, int *info) { /* System generated locals */ int a_dim1, a_offset, b_dim1, b_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, i__2; float r__1, r__2, r__3, r__4; /* Builtin functions */ double sqrt(double); /* Local variables */ int i__, j, m, jc, in, mm, jr; float eps; int ilv, pair; float anrm, bnrm; int ierr, itau; float temp; int ilvl, ilvr; int iwrk, iwrk1; extern int lsame_(char *, char *); int icols; int noscl; int irows; extern int slabad_(float *, float *), sggbak_(char *, char *, int *, int *, int *, float *, float *, int *, float *, int *, int *), sggbal_(char *, int *, float *, int *, float *, int *, int *, int *, float *, float *, float *, int *); int ilascl, ilbscl; extern double slamch_(char *); extern int xerbla_(char *, int *), sgghrd_( char *, char *, int *, int *, int *, float *, int * , float *, int *, float *, int *, float *, int *, int *); int ldumma[1]; char chtemp[1]; float bignum; extern int slascl_(char *, int *, int *, float *, float *, int *, int *, float *, int *, int *); extern int ilaenv_(int *, char *, char *, int *, int *, int *, int *); extern double slange_(char *, int *, int *, float *, int *, float *); int ijobvl; extern int sgeqrf_(int *, int *, float *, int *, float *, float *, int *, int *); int ijobvr; extern int slacpy_(char *, int *, int *, float *, int *, float *, int *); int wantsb; extern int slaset_(char *, int *, int *, float *, float *, float *, int *); float anrmto; int wantse; float bnrmto; extern int shgeqz_(char *, char *, char *, int *, int *, int *, float *, int *, float *, int *, float * , float *, float *, float *, int *, float *, int *, float *, int *, int *), stgevc_(char *, char *, int *, int *, float *, int *, float *, int * , float *, int *, float *, int *, int *, int *, float *, int *), stgsna_(char *, char *, int *, int *, float *, int *, float *, int *, float * , int *, float *, int *, float *, float *, int *, int *, float *, int *, int *, int *); int minwrk, maxwrk; int wantsn; float smlnum; extern int sorgqr_(int *, int *, int *, float *, int *, float *, float *, int *, int *); int lquery, wantsv; extern int sormqr_(char *, char *, int *, int *, int *, float *, int *, float *, float *, int *, float *, int *, int *); /* -- LAPACK driver routine (version 3.2) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* .. Array Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* SGGEVX computes for a pair of N-by-N float nonsymmetric matrices (A,B) */ /* the generalized eigenvalues, and optionally, the left and/or right */ /* generalized eigenvectors. */ /* Optionally also, it computes a balancing transformation to improve */ /* the conditioning of the eigenvalues and eigenvectors (ILO, IHI, */ /* LSCALE, RSCALE, ABNRM, and BBNRM), reciprocal condition numbers for */ /* the eigenvalues (RCONDE), and reciprocal condition numbers for the */ /* right eigenvectors (RCONDV). */ /* A generalized eigenvalue for a pair of matrices (A,B) is a scalar */ /* lambda or a ratio alpha/beta = lambda, such that A - lambda*B is */ /* singular. It is usually represented as the pair (alpha,beta), as */ /* there is a reasonable interpretation for beta=0, and even for both */ /* being zero. */ /* The right eigenvector v(j) corresponding to the eigenvalue lambda(j) */ /* of (A,B) satisfies */ /* A * v(j) = lambda(j) * B * v(j) . */ /* The left eigenvector u(j) corresponding to the eigenvalue lambda(j) */ /* of (A,B) satisfies */ /* u(j)**H * A = lambda(j) * u(j)**H * B. */ /* where u(j)**H is the conjugate-transpose of u(j). */ /* Arguments */ /* ========= */ /* BALANC (input) CHARACTER*1 */ /* Specifies the balance option to be performed. */ /* = 'N': do not diagonally scale or permute; */ /* = 'P': permute only; */ /* = 'S': scale only; */ /* = 'B': both permute and scale. */ /* Computed reciprocal condition numbers will be for the */ /* matrices after permuting and/or balancing. Permuting does */ /* not change condition numbers (in exact arithmetic), but */ /* balancing does. */ /* JOBVL (input) CHARACTER*1 */ /* = 'N': do not compute the left generalized eigenvectors; */ /* = 'V': compute the left generalized eigenvectors. */ /* JOBVR (input) CHARACTER*1 */ /* = 'N': do not compute the right generalized eigenvectors; */ /* = 'V': compute the right generalized eigenvectors. */ /* SENSE (input) CHARACTER*1 */ /* Determines which reciprocal condition numbers are computed. */ /* = 'N': none are computed; */ /* = 'E': computed for eigenvalues only; */ /* = 'V': computed for eigenvectors only; */ /* = 'B': computed for eigenvalues and eigenvectors. */ /* N (input) INTEGER */ /* The order of the matrices A, B, VL, and VR. N >= 0. */ /* A (input/output) REAL array, dimension (LDA, N) */ /* On entry, the matrix A in the pair (A,B). */ /* On exit, A has been overwritten. If JOBVL='V' or JOBVR='V' */ /* or both, then A contains the first part of the float Schur */ /* form of the "balanced" versions of the input A and B. */ /* LDA (input) INTEGER */ /* The leading dimension of A. LDA >= MAX(1,N). */ /* B (input/output) REAL array, dimension (LDB, N) */ /* On entry, the matrix B in the pair (A,B). */ /* On exit, B has been overwritten. If JOBVL='V' or JOBVR='V' */ /* or both, then B contains the second part of the float Schur */ /* form of the "balanced" versions of the input A and B. */ /* LDB (input) INTEGER */ /* The leading dimension of B. LDB >= MAX(1,N). */ /* ALPHAR (output) REAL array, dimension (N) */ /* ALPHAI (output) REAL array, dimension (N) */ /* BETA (output) REAL array, dimension (N) */ /* On exit, (ALPHAR(j) + ALPHAI(j)*i)/BETA(j), j=1,...,N, will */ /* be the generalized eigenvalues. If ALPHAI(j) is zero, then */ /* the j-th eigenvalue is float; if positive, then the j-th and */ /* (j+1)-st eigenvalues are a complex conjugate pair, with */ /* ALPHAI(j+1) negative. */ /* Note: the quotients ALPHAR(j)/BETA(j) and ALPHAI(j)/BETA(j) */ /* may easily over- or underflow, and BETA(j) may even be zero. */ /* Thus, the user should avoid naively computing the ratio */ /* ALPHA/BETA. However, ALPHAR and ALPHAI will be always less */ /* than and usually comparable with norm(A) in magnitude, and */ /* BETA always less than and usually comparable with norm(B). */ /* VL (output) REAL array, dimension (LDVL,N) */ /* If JOBVL = 'V', the left eigenvectors u(j) are stored one */ /* after another in the columns of VL, in the same order as */ /* their eigenvalues. If the j-th eigenvalue is float, then */ /* u(j) = VL(:,j), the j-th column of VL. If the j-th and */ /* (j+1)-th eigenvalues form a complex conjugate pair, then */ /* u(j) = VL(:,j)+i*VL(:,j+1) and u(j+1) = VL(:,j)-i*VL(:,j+1). */ /* Each eigenvector will be scaled so the largest component have */ /* ABS(float part) + ABS(imag. part) = 1. */ /* Not referenced if JOBVL = 'N'. */ /* LDVL (input) INTEGER */ /* The leading dimension of the matrix VL. LDVL >= 1, and */ /* if JOBVL = 'V', LDVL >= N. */ /* VR (output) REAL array, dimension (LDVR,N) */ /* If JOBVR = 'V', the right eigenvectors v(j) are stored one */ /* after another in the columns of VR, in the same order as */ /* their eigenvalues. If the j-th eigenvalue is float, then */ /* v(j) = VR(:,j), the j-th column of VR. If the j-th and */ /* (j+1)-th eigenvalues form a complex conjugate pair, then */ /* v(j) = VR(:,j)+i*VR(:,j+1) and v(j+1) = VR(:,j)-i*VR(:,j+1). */ /* Each eigenvector will be scaled so the largest component have */ /* ABS(float part) + ABS(imag. part) = 1. */ /* Not referenced if JOBVR = 'N'. */ /* LDVR (input) INTEGER */ /* The leading dimension of the matrix VR. LDVR >= 1, and */ /* if JOBVR = 'V', LDVR >= N. */ /* ILO (output) INTEGER */ /* IHI (output) INTEGER */ /* ILO and IHI are int values such that on exit */ /* A(i,j) = 0 and B(i,j) = 0 if i > j and */ /* j = 1,...,ILO-1 or i = IHI+1,...,N. */ /* If BALANC = 'N' or 'S', ILO = 1 and IHI = N. */ /* LSCALE (output) REAL array, dimension (N) */ /* Details of the permutations and scaling factors applied */ /* to the left side of A and B. If PL(j) is the index of the */ /* row interchanged with row j, and DL(j) is the scaling */ /* factor applied to row j, then */ /* LSCALE(j) = PL(j) for j = 1,...,ILO-1 */ /* = DL(j) for j = ILO,...,IHI */ /* = PL(j) for j = IHI+1,...,N. */ /* The order in which the interchanges are made is N to IHI+1, */ /* then 1 to ILO-1. */ /* RSCALE (output) REAL array, dimension (N) */ /* Details of the permutations and scaling factors applied */ /* to the right side of A and B. If PR(j) is the index of the */ /* column interchanged with column j, and DR(j) is the scaling */ /* factor applied to column j, then */ /* RSCALE(j) = PR(j) for j = 1,...,ILO-1 */ /* = DR(j) for j = ILO,...,IHI */ /* = PR(j) for j = IHI+1,...,N */ /* The order in which the interchanges are made is N to IHI+1, */ /* then 1 to ILO-1. */ /* ABNRM (output) REAL */ /* The one-norm of the balanced matrix A. */ /* BBNRM (output) REAL */ /* The one-norm of the balanced matrix B. */ /* RCONDE (output) REAL array, dimension (N) */ /* If SENSE = 'E' or 'B', the reciprocal condition numbers of */ /* the eigenvalues, stored in consecutive elements of the array. */ /* For a complex conjugate pair of eigenvalues two consecutive */ /* elements of RCONDE are set to the same value. Thus RCONDE(j), */ /* RCONDV(j), and the j-th columns of VL and VR all correspond */ /* to the j-th eigenpair. */ /* If SENSE = 'N' or 'V', RCONDE is not referenced. */ /* RCONDV (output) REAL array, dimension (N) */ /* If SENSE = 'V' or 'B', the estimated reciprocal condition */ /* numbers of the eigenvectors, stored in consecutive elements */ /* of the array. For a complex eigenvector two consecutive */ /* elements of RCONDV are set to the same value. If the */ /* eigenvalues cannot be reordered to compute RCONDV(j), */ /* RCONDV(j) is set to 0; this can only occur when the true */ /* value would be very small anyway. */ /* If SENSE = 'N' or 'E', RCONDV is not referenced. */ /* WORK (workspace/output) REAL array, dimension (MAX(1,LWORK)) */ /* On exit, if INFO = 0, WORK(1) returns the optimal LWORK. */ /* LWORK (input) INTEGER */ /* The dimension of the array WORK. LWORK >= MAX(1,2*N). */ /* If BALANC = 'S' or 'B', or JOBVL = 'V', or JOBVR = 'V', */ /* LWORK >= MAX(1,6*N). */ /* If SENSE = 'E', LWORK >= MAX(1,10*N). */ /* If SENSE = 'V' or 'B', LWORK >= 2*N*N+8*N+16. */ /* If LWORK = -1, then a workspace query is assumed; the routine */ /* only calculates the optimal size of the WORK array, returns */ /* this value as the first entry of the WORK array, and no error */ /* message related to LWORK is issued by XERBLA. */ /* IWORK (workspace) INTEGER array, dimension (N+6) */ /* If SENSE = 'E', IWORK is not referenced. */ /* BWORK (workspace) LOGICAL array, dimension (N) */ /* If SENSE = 'N', BWORK is not referenced. */ /* INFO (output) INTEGER */ /* = 0: successful exit */ /* < 0: if INFO = -i, the i-th argument had an illegal value. */ /* = 1,...,N: */ /* The QZ iteration failed. No eigenvectors have been */ /* calculated, but ALPHAR(j), ALPHAI(j), and BETA(j) */ /* should be correct for j=INFO+1,...,N. */ /* > N: =N+1: other than QZ iteration failed in SHGEQZ. */ /* =N+2: error return from STGEVC. */ /* Further Details */ /* =============== */ /* Balancing a matrix pair (A,B) includes, first, permuting rows and */ /* columns to isolate eigenvalues, second, applying diagonal similarity */ /* transformation to the rows and columns to make the rows and columns */ /* as close in norm as possible. The computed reciprocal condition */ /* numbers correspond to the balanced matrix. Permuting rows and columns */ /* will not change the condition numbers (in exact arithmetic) but */ /* diagonal scaling will. For further explanation of balancing, see */ /* section 4.11.1.2 of LAPACK Users' Guide. */ /* An approximate error bound on the chordal distance between the i-th */ /* computed generalized eigenvalue w and the corresponding exact */ /* eigenvalue lambda is */ /* chord(w, lambda) <= EPS * norm(ABNRM, BBNRM) / RCONDE(I) */ /* An approximate error bound for the angle between the i-th computed */ /* eigenvector VL(i) or VR(i) is given by */ /* EPS * norm(ABNRM, BBNRM) / DIF(i). */ /* For further explanation of the reciprocal condition numbers RCONDE */ /* and RCONDV, see section 4.11 of LAPACK User's Guide. */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ /* Decode the input arguments */ /* Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; b_dim1 = *ldb; b_offset = 1 + b_dim1; b -= b_offset; --alphar; --alphai; --beta; vl_dim1 = *ldvl; vl_offset = 1 + vl_dim1; vl -= vl_offset; vr_dim1 = *ldvr; vr_offset = 1 + vr_dim1; vr -= vr_offset; --lscale; --rscale; --rconde; --rcondv; --work; --iwork; --bwork; /* Function Body */ if (lsame_(jobvl, "N")) { ijobvl = 1; ilvl = FALSE; } else if (lsame_(jobvl, "V")) { ijobvl = 2; ilvl = TRUE; } else { ijobvl = -1; ilvl = FALSE; } if (lsame_(jobvr, "N")) { ijobvr = 1; ilvr = FALSE; } else if (lsame_(jobvr, "V")) { ijobvr = 2; ilvr = TRUE; } else { ijobvr = -1; ilvr = FALSE; } ilv = ilvl || ilvr; noscl = lsame_(balanc, "N") || lsame_(balanc, "P"); wantsn = lsame_(sense, "N"); wantse = lsame_(sense, "E"); wantsv = lsame_(sense, "V"); wantsb = lsame_(sense, "B"); /* Test the input arguments */ *info = 0; lquery = *lwork == -1; if (! (noscl || lsame_(balanc, "S") || lsame_( balanc, "B"))) { *info = -1; } else if (ijobvl <= 0) { *info = -2; } else if (ijobvr <= 0) { *info = -3; } else if (! (wantsn || wantse || wantsb || wantsv)) { *info = -4; } else if (*n < 0) { *info = -5; } else if (*lda < MAX(1,*n)) { *info = -7; } else if (*ldb < MAX(1,*n)) { *info = -9; } else if (*ldvl < 1 || ilvl && *ldvl < *n) { *info = -14; } else if (*ldvr < 1 || ilvr && *ldvr < *n) { *info = -16; } /* Compute workspace */ /* (Note: Comments in the code beginning "Workspace:" describe the */ /* minimal amount of workspace needed at that point in the code, */ /* as well as the preferred amount for good performance. */ /* NB refers to the optimal block size for the immediately */ /* following subroutine, as returned by ILAENV. The workspace is */ /* computed assuming ILO = 1 and IHI = N, the worst case.) */ if (*info == 0) { if (*n == 0) { minwrk = 1; maxwrk = 1; } else { if (noscl && ! ilv) { minwrk = *n << 1; } else { minwrk = *n * 6; } if (wantse) { minwrk = *n * 10; } else if (wantsv || wantsb) { minwrk = (*n << 1) * (*n + 4) + 16; } maxwrk = minwrk; /* Computing MAX */ i__1 = maxwrk, i__2 = *n + *n * ilaenv_(&c__1, "SGEQRF", " ", n, & c__1, n, &c__0); maxwrk = MAX(i__1,i__2); /* Computing MAX */ i__1 = maxwrk, i__2 = *n + *n * ilaenv_(&c__1, "SORMQR", " ", n, & c__1, n, &c__0); maxwrk = MAX(i__1,i__2); if (ilvl) { /* Computing MAX */ i__1 = maxwrk, i__2 = *n + *n * ilaenv_(&c__1, "SORGQR", " ", n, &c__1, n, &c__0); maxwrk = MAX(i__1,i__2); } } work[1] = (float) maxwrk; if (*lwork < minwrk && ! lquery) { *info = -26; } } if (*info != 0) { i__1 = -(*info); xerbla_("SGGEVX", &i__1); return 0; } else if (lquery) { return 0; } /* Quick return if possible */ if (*n == 0) { return 0; } /* Get machine constants */ eps = slamch_("P"); smlnum = slamch_("S"); bignum = 1.f / smlnum; slabad_(&smlnum, &bignum); smlnum = sqrt(smlnum) / eps; bignum = 1.f / smlnum; /* Scale A if max element outside range [SMLNUM,BIGNUM] */ anrm = slange_("M", n, n, &a[a_offset], lda, &work[1]); ilascl = FALSE; if (anrm > 0.f && anrm < smlnum) { anrmto = smlnum; ilascl = TRUE; } else if (anrm > bignum) { anrmto = bignum; ilascl = TRUE; } if (ilascl) { slascl_("G", &c__0, &c__0, &anrm, &anrmto, n, n, &a[a_offset], lda, & ierr); } /* Scale B if max element outside range [SMLNUM,BIGNUM] */ bnrm = slange_("M", n, n, &b[b_offset], ldb, &work[1]); ilbscl = FALSE; if (bnrm > 0.f && bnrm < smlnum) { bnrmto = smlnum; ilbscl = TRUE; } else if (bnrm > bignum) { bnrmto = bignum; ilbscl = TRUE; } if (ilbscl) { slascl_("G", &c__0, &c__0, &bnrm, &bnrmto, n, n, &b[b_offset], ldb, & ierr); } /* Permute and/or balance the matrix pair (A,B) */ /* (Workspace: need 6*N if BALANC = 'S' or 'B', 1 otherwise) */ sggbal_(balanc, n, &a[a_offset], lda, &b[b_offset], ldb, ilo, ihi, & lscale[1], &rscale[1], &work[1], &ierr); /* Compute ABNRM and BBNRM */ *abnrm = slange_("1", n, n, &a[a_offset], lda, &work[1]); if (ilascl) { work[1] = *abnrm; slascl_("G", &c__0, &c__0, &anrmto, &anrm, &c__1, &c__1, &work[1], & c__1, &ierr); *abnrm = work[1]; } *bbnrm = slange_("1", n, n, &b[b_offset], ldb, &work[1]); if (ilbscl) { work[1] = *bbnrm; slascl_("G", &c__0, &c__0, &bnrmto, &bnrm, &c__1, &c__1, &work[1], & c__1, &ierr); *bbnrm = work[1]; } /* Reduce B to triangular form (QR decomposition of B) */ /* (Workspace: need N, prefer N*NB ) */ irows = *ihi + 1 - *ilo; if (ilv || ! wantsn) { icols = *n + 1 - *ilo; } else { icols = irows; } itau = 1; iwrk = itau + irows; i__1 = *lwork + 1 - iwrk; sgeqrf_(&irows, &icols, &b[*ilo + *ilo * b_dim1], ldb, &work[itau], &work[ iwrk], &i__1, &ierr); /* Apply the orthogonal transformation to A */ /* (Workspace: need N, prefer N*NB) */ i__1 = *lwork + 1 - iwrk; sormqr_("L", "T", &irows, &icols, &irows, &b[*ilo + *ilo * b_dim1], ldb, & work[itau], &a[*ilo + *ilo * a_dim1], lda, &work[iwrk], &i__1, & ierr); /* Initialize VL and/or VR */ /* (Workspace: need N, prefer N*NB) */ if (ilvl) { slaset_("Full", n, n, &c_b57, &c_b58, &vl[vl_offset], ldvl) ; if (irows > 1) { i__1 = irows - 1; i__2 = irows - 1; slacpy_("L", &i__1, &i__2, &b[*ilo + 1 + *ilo * b_dim1], ldb, &vl[ *ilo + 1 + *ilo * vl_dim1], ldvl); } i__1 = *lwork + 1 - iwrk; sorgqr_(&irows, &irows, &irows, &vl[*ilo + *ilo * vl_dim1], ldvl, & work[itau], &work[iwrk], &i__1, &ierr); } if (ilvr) { slaset_("Full", n, n, &c_b57, &c_b58, &vr[vr_offset], ldvr) ; } /* Reduce to generalized Hessenberg form */ /* (Workspace: none needed) */ if (ilv || ! wantsn) { /* Eigenvectors requested -- work on whole matrix. */ sgghrd_(jobvl, jobvr, n, ilo, ihi, &a[a_offset], lda, &b[b_offset], ldb, &vl[vl_offset], ldvl, &vr[vr_offset], ldvr, &ierr); } else { sgghrd_("N", "N", &irows, &c__1, &irows, &a[*ilo + *ilo * a_dim1], lda, &b[*ilo + *ilo * b_dim1], ldb, &vl[vl_offset], ldvl, &vr[ vr_offset], ldvr, &ierr); } /* Perform QZ algorithm (Compute eigenvalues, and optionally, the */ /* Schur forms and Schur vectors) */ /* (Workspace: need N) */ if (ilv || ! wantsn) { *(unsigned char *)chtemp = 'S'; } else { *(unsigned char *)chtemp = 'E'; } shgeqz_(chtemp, jobvl, jobvr, n, ilo, ihi, &a[a_offset], lda, &b[b_offset] , ldb, &alphar[1], &alphai[1], &beta[1], &vl[vl_offset], ldvl, & vr[vr_offset], ldvr, &work[1], lwork, &ierr); if (ierr != 0) { if (ierr > 0 && ierr <= *n) { *info = ierr; } else if (ierr > *n && ierr <= *n << 1) { *info = ierr - *n; } else { *info = *n + 1; } goto L130; } /* Compute Eigenvectors and estimate condition numbers if desired */ /* (Workspace: STGEVC: need 6*N */ /* STGSNA: need 2*N*(N+2)+16 if SENSE = 'V' or 'B', */ /* need N otherwise ) */ if (ilv || ! wantsn) { if (ilv) { if (ilvl) { if (ilvr) { *(unsigned char *)chtemp = 'B'; } else { *(unsigned char *)chtemp = 'L'; } } else { *(unsigned char *)chtemp = 'R'; } stgevc_(chtemp, "B", ldumma, n, &a[a_offset], lda, &b[b_offset], ldb, &vl[vl_offset], ldvl, &vr[vr_offset], ldvr, n, &in, & work[1], &ierr); if (ierr != 0) { *info = *n + 2; goto L130; } } if (! wantsn) { /* compute eigenvectors (STGEVC) and estimate condition */ /* numbers (STGSNA). Note that the definition of the condition */ /* number is not invariant under transformation (u,v) to */ /* (Q*u, Z*v), where (u,v) are eigenvectors of the generalized */ /* Schur form (S,T), Q and Z are orthogonal matrices. In order */ /* to avoid using extra 2*N*N workspace, we have to recalculate */ /* eigenvectors and estimate one condition numbers at a time. */ pair = FALSE; i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { if (pair) { pair = FALSE; goto L20; } mm = 1; if (i__ < *n) { if (a[i__ + 1 + i__ * a_dim1] != 0.f) { pair = TRUE; mm = 2; } } i__2 = *n; for (j = 1; j <= i__2; ++j) { bwork[j] = FALSE; /* L10: */ } if (mm == 1) { bwork[i__] = TRUE; } else if (mm == 2) { bwork[i__] = TRUE; bwork[i__ + 1] = TRUE; } iwrk = mm * *n + 1; iwrk1 = iwrk + mm * *n; /* Compute a pair of left and right eigenvectors. */ /* (compute workspace: need up to 4*N + 6*N) */ if (wantse || wantsb) { stgevc_("B", "S", &bwork[1], n, &a[a_offset], lda, &b[ b_offset], ldb, &work[1], n, &work[iwrk], n, &mm, &m, &work[iwrk1], &ierr); if (ierr != 0) { *info = *n + 2; goto L130; } } i__2 = *lwork - iwrk1 + 1; stgsna_(sense, "S", &bwork[1], n, &a[a_offset], lda, &b[ b_offset], ldb, &work[1], n, &work[iwrk], n, &rconde[ i__], &rcondv[i__], &mm, &m, &work[iwrk1], &i__2, & iwork[1], &ierr); L20: ; } } } /* Undo balancing on VL and VR and normalization */ /* (Workspace: none needed) */ if (ilvl) { sggbak_(balanc, "L", n, ilo, ihi, &lscale[1], &rscale[1], n, &vl[ vl_offset], ldvl, &ierr); i__1 = *n; for (jc = 1; jc <= i__1; ++jc) { if (alphai[jc] < 0.f) { goto L70; } temp = 0.f; if (alphai[jc] == 0.f) { i__2 = *n; for (jr = 1; jr <= i__2; ++jr) { /* Computing MAX */ r__2 = temp, r__3 = (r__1 = vl[jr + jc * vl_dim1], ABS( r__1)); temp = MAX(r__2,r__3); /* L30: */ } } else { i__2 = *n; for (jr = 1; jr <= i__2; ++jr) { /* Computing MAX */ r__3 = temp, r__4 = (r__1 = vl[jr + jc * vl_dim1], ABS( r__1)) + (r__2 = vl[jr + (jc + 1) * vl_dim1], ABS(r__2)); temp = MAX(r__3,r__4); /* L40: */ } } if (temp < smlnum) { goto L70; } temp = 1.f / temp; if (alphai[jc] == 0.f) { i__2 = *n; for (jr = 1; jr <= i__2; ++jr) { vl[jr + jc * vl_dim1] *= temp; /* L50: */ } } else { i__2 = *n; for (jr = 1; jr <= i__2; ++jr) { vl[jr + jc * vl_dim1] *= temp; vl[jr + (jc + 1) * vl_dim1] *= temp; /* L60: */ } } L70: ; } } if (ilvr) { sggbak_(balanc, "R", n, ilo, ihi, &lscale[1], &rscale[1], n, &vr[ vr_offset], ldvr, &ierr); i__1 = *n; for (jc = 1; jc <= i__1; ++jc) { if (alphai[jc] < 0.f) { goto L120; } temp = 0.f; if (alphai[jc] == 0.f) { i__2 = *n; for (jr = 1; jr <= i__2; ++jr) { /* Computing MAX */ r__2 = temp, r__3 = (r__1 = vr[jr + jc * vr_dim1], ABS( r__1)); temp = MAX(r__2,r__3); /* L80: */ } } else { i__2 = *n; for (jr = 1; jr <= i__2; ++jr) { /* Computing MAX */ r__3 = temp, r__4 = (r__1 = vr[jr + jc * vr_dim1], ABS( r__1)) + (r__2 = vr[jr + (jc + 1) * vr_dim1], ABS(r__2)); temp = MAX(r__3,r__4); /* L90: */ } } if (temp < smlnum) { goto L120; } temp = 1.f / temp; if (alphai[jc] == 0.f) { i__2 = *n; for (jr = 1; jr <= i__2; ++jr) { vr[jr + jc * vr_dim1] *= temp; /* L100: */ } } else { i__2 = *n; for (jr = 1; jr <= i__2; ++jr) { vr[jr + jc * vr_dim1] *= temp; vr[jr + (jc + 1) * vr_dim1] *= temp; /* L110: */ } } L120: ; } } /* Undo scaling if necessary */ if (ilascl) { slascl_("G", &c__0, &c__0, &anrmto, &anrm, n, &c__1, &alphar[1], n, & ierr); slascl_("G", &c__0, &c__0, &anrmto, &anrm, n, &c__1, &alphai[1], n, & ierr); } if (ilbscl) { slascl_("G", &c__0, &c__0, &bnrmto, &bnrm, n, &c__1, &beta[1], n, & ierr); } L130: work[1] = (float) maxwrk; return 0; /* End of SGGEVX */ } /* sggevx_ */
/* Subroutine */ int sggevx_(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, real *a, integer *lda, real *b, integer *ldb, real *alphar, real *alphai, real *beta, real *vl, integer *ldvl, real *vr, integer *ldvr, integer *ilo, integer *ihi, real *lscale, real *rscale, real *abnrm, real *bbnrm, real *rconde, real *rcondv, real *work, integer *lwork, integer *iwork, logical *bwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, i__2; real r__1, r__2, r__3, r__4; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__, j, m, jc, in, mm, jr; real eps; logical ilv, pair; real anrm, bnrm; integer ierr, itau; real temp; logical ilvl, ilvr; integer iwrk, iwrk1; extern logical lsame_(char *, char *); integer icols; logical noscl; integer irows; extern /* Subroutine */ int slabad_(real *, real *), sggbak_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, integer *), sggbal_(char *, integer *, real *, integer *, real *, integer *, integer *, integer *, real *, real *, real *, integer *); logical ilascl, ilbscl; extern real slamch_(char *); extern /* Subroutine */ int xerbla_(char *, integer *), sgghrd_( char *, char *, integer *, integer *, integer *, real *, integer * , real *, integer *, real *, integer *, real *, integer *, integer *); logical ldumma[1]; char chtemp[1]; real bignum; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); extern real slange_(char *, integer *, integer *, real *, integer *, real *); integer ijobvl; extern /* Subroutine */ int sgeqrf_(integer *, integer *, real *, integer *, real *, real *, integer *, integer *); integer ijobvr; extern /* Subroutine */ int slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *); logical wantsb; extern /* Subroutine */ int slaset_(char *, integer *, integer *, real *, real *, real *, integer *); real anrmto; logical wantse; real bnrmto; extern /* Subroutine */ int shgeqz_(char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real * , real *, real *, real *, integer *, real *, integer *, real *, integer *, integer *), stgevc_(char *, char *, logical *, integer *, real *, integer *, real *, integer * , real *, integer *, real *, integer *, integer *, integer *, real *, integer *), stgsna_(char *, char *, logical *, integer *, real *, integer *, real *, integer *, real * , integer *, real *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *, integer *); integer minwrk, maxwrk; logical wantsn; real smlnum; extern /* Subroutine */ int sorgqr_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *); logical lquery, wantsv; extern /* Subroutine */ int sormqr_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *, integer *); /* -- LAPACK driver routine (version 3.4.1) -- */ /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */ /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */ /* April 2012 */ /* .. Scalar Arguments .. */ /* .. */ /* .. Array Arguments .. */ /* .. */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ /* Decode the input arguments */ /* Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; b_dim1 = *ldb; b_offset = 1 + b_dim1; b -= b_offset; --alphar; --alphai; --beta; vl_dim1 = *ldvl; vl_offset = 1 + vl_dim1; vl -= vl_offset; vr_dim1 = *ldvr; vr_offset = 1 + vr_dim1; vr -= vr_offset; --lscale; --rscale; --rconde; --rcondv; --work; --iwork; --bwork; /* Function Body */ if (lsame_(jobvl, "N")) { ijobvl = 1; ilvl = FALSE_; } else if (lsame_(jobvl, "V")) { ijobvl = 2; ilvl = TRUE_; } else { ijobvl = -1; ilvl = FALSE_; } if (lsame_(jobvr, "N")) { ijobvr = 1; ilvr = FALSE_; } else if (lsame_(jobvr, "V")) { ijobvr = 2; ilvr = TRUE_; } else { ijobvr = -1; ilvr = FALSE_; } ilv = ilvl || ilvr; noscl = lsame_(balanc, "N") || lsame_(balanc, "P"); wantsn = lsame_(sense, "N"); wantse = lsame_(sense, "E"); wantsv = lsame_(sense, "V"); wantsb = lsame_(sense, "B"); /* Test the input arguments */ *info = 0; lquery = *lwork == -1; if (! (noscl || lsame_(balanc, "S") || lsame_( balanc, "B"))) { *info = -1; } else if (ijobvl <= 0) { *info = -2; } else if (ijobvr <= 0) { *info = -3; } else if (! (wantsn || wantse || wantsb || wantsv)) { *info = -4; } else if (*n < 0) { *info = -5; } else if (*lda < max(1,*n)) { *info = -7; } else if (*ldb < max(1,*n)) { *info = -9; } else if (*ldvl < 1 || ilvl && *ldvl < *n) { *info = -14; } else if (*ldvr < 1 || ilvr && *ldvr < *n) { *info = -16; } /* Compute workspace */ /* (Note: Comments in the code beginning "Workspace:" describe the */ /* minimal amount of workspace needed at that point in the code, */ /* as well as the preferred amount for good performance. */ /* NB refers to the optimal block size for the immediately */ /* following subroutine, as returned by ILAENV. The workspace is */ /* computed assuming ILO = 1 and IHI = N, the worst case.) */ if (*info == 0) { if (*n == 0) { minwrk = 1; maxwrk = 1; } else { if (noscl && ! ilv) { minwrk = *n << 1; } else { minwrk = *n * 6; } if (wantse) { minwrk = *n * 10; } else if (wantsv || wantsb) { minwrk = (*n << 1) * (*n + 4) + 16; } maxwrk = minwrk; /* Computing MAX */ i__1 = maxwrk; i__2 = *n + *n * ilaenv_(&c__1, "SGEQRF", " ", n, & c__1, n, &c__0); // , expr subst maxwrk = max(i__1,i__2); /* Computing MAX */ i__1 = maxwrk; i__2 = *n + *n * ilaenv_(&c__1, "SORMQR", " ", n, & c__1, n, &c__0); // , expr subst maxwrk = max(i__1,i__2); if (ilvl) { /* Computing MAX */ i__1 = maxwrk; i__2 = *n + *n * ilaenv_(&c__1, "SORGQR", " ", n, &c__1, n, &c__0); // , expr subst maxwrk = max(i__1,i__2); } } work[1] = (real) maxwrk; if (*lwork < minwrk && ! lquery) { *info = -26; } } if (*info != 0) { i__1 = -(*info); xerbla_("SGGEVX", &i__1); return 0; } else if (lquery) { return 0; } /* Quick return if possible */ if (*n == 0) { return 0; } /* Get machine constants */ eps = slamch_("P"); smlnum = slamch_("S"); bignum = 1.f / smlnum; slabad_(&smlnum, &bignum); smlnum = sqrt(smlnum) / eps; bignum = 1.f / smlnum; /* Scale A if max element outside range [SMLNUM,BIGNUM] */ anrm = slange_("M", n, n, &a[a_offset], lda, &work[1]); ilascl = FALSE_; if (anrm > 0.f && anrm < smlnum) { anrmto = smlnum; ilascl = TRUE_; } else if (anrm > bignum) { anrmto = bignum; ilascl = TRUE_; } if (ilascl) { slascl_("G", &c__0, &c__0, &anrm, &anrmto, n, n, &a[a_offset], lda, & ierr); } /* Scale B if max element outside range [SMLNUM,BIGNUM] */ bnrm = slange_("M", n, n, &b[b_offset], ldb, &work[1]); ilbscl = FALSE_; if (bnrm > 0.f && bnrm < smlnum) { bnrmto = smlnum; ilbscl = TRUE_; } else if (bnrm > bignum) { bnrmto = bignum; ilbscl = TRUE_; } if (ilbscl) { slascl_("G", &c__0, &c__0, &bnrm, &bnrmto, n, n, &b[b_offset], ldb, & ierr); } /* Permute and/or balance the matrix pair (A,B) */ /* (Workspace: need 6*N if BALANC = 'S' or 'B', 1 otherwise) */ sggbal_(balanc, n, &a[a_offset], lda, &b[b_offset], ldb, ilo, ihi, & lscale[1], &rscale[1], &work[1], &ierr); /* Compute ABNRM and BBNRM */ *abnrm = slange_("1", n, n, &a[a_offset], lda, &work[1]); if (ilascl) { work[1] = *abnrm; slascl_("G", &c__0, &c__0, &anrmto, &anrm, &c__1, &c__1, &work[1], & c__1, &ierr); *abnrm = work[1]; } *bbnrm = slange_("1", n, n, &b[b_offset], ldb, &work[1]); if (ilbscl) { work[1] = *bbnrm; slascl_("G", &c__0, &c__0, &bnrmto, &bnrm, &c__1, &c__1, &work[1], & c__1, &ierr); *bbnrm = work[1]; } /* Reduce B to triangular form (QR decomposition of B) */ /* (Workspace: need N, prefer N*NB ) */ irows = *ihi + 1 - *ilo; if (ilv || ! wantsn) { icols = *n + 1 - *ilo; } else { icols = irows; } itau = 1; iwrk = itau + irows; i__1 = *lwork + 1 - iwrk; sgeqrf_(&irows, &icols, &b[*ilo + *ilo * b_dim1], ldb, &work[itau], &work[ iwrk], &i__1, &ierr); /* Apply the orthogonal transformation to A */ /* (Workspace: need N, prefer N*NB) */ i__1 = *lwork + 1 - iwrk; sormqr_("L", "T", &irows, &icols, &irows, &b[*ilo + *ilo * b_dim1], ldb, & work[itau], &a[*ilo + *ilo * a_dim1], lda, &work[iwrk], &i__1, & ierr); /* Initialize VL and/or VR */ /* (Workspace: need N, prefer N*NB) */ if (ilvl) { slaset_("Full", n, n, &c_b57, &c_b58, &vl[vl_offset], ldvl) ; if (irows > 1) { i__1 = irows - 1; i__2 = irows - 1; slacpy_("L", &i__1, &i__2, &b[*ilo + 1 + *ilo * b_dim1], ldb, &vl[ *ilo + 1 + *ilo * vl_dim1], ldvl); } i__1 = *lwork + 1 - iwrk; sorgqr_(&irows, &irows, &irows, &vl[*ilo + *ilo * vl_dim1], ldvl, & work[itau], &work[iwrk], &i__1, &ierr); } if (ilvr) { slaset_("Full", n, n, &c_b57, &c_b58, &vr[vr_offset], ldvr) ; } /* Reduce to generalized Hessenberg form */ /* (Workspace: none needed) */ if (ilv || ! wantsn) { /* Eigenvectors requested -- work on whole matrix. */ sgghrd_(jobvl, jobvr, n, ilo, ihi, &a[a_offset], lda, &b[b_offset], ldb, &vl[vl_offset], ldvl, &vr[vr_offset], ldvr, &ierr); } else { sgghrd_("N", "N", &irows, &c__1, &irows, &a[*ilo + *ilo * a_dim1], lda, &b[*ilo + *ilo * b_dim1], ldb, &vl[vl_offset], ldvl, &vr[ vr_offset], ldvr, &ierr); } /* Perform QZ algorithm (Compute eigenvalues, and optionally, the */ /* Schur forms and Schur vectors) */ /* (Workspace: need N) */ if (ilv || ! wantsn) { *(unsigned char *)chtemp = 'S'; } else { *(unsigned char *)chtemp = 'E'; } shgeqz_(chtemp, jobvl, jobvr, n, ilo, ihi, &a[a_offset], lda, &b[b_offset] , ldb, &alphar[1], &alphai[1], &beta[1], &vl[vl_offset], ldvl, & vr[vr_offset], ldvr, &work[1], lwork, &ierr); if (ierr != 0) { if (ierr > 0 && ierr <= *n) { *info = ierr; } else if (ierr > *n && ierr <= *n << 1) { *info = ierr - *n; } else { *info = *n + 1; } goto L130; } /* Compute Eigenvectors and estimate condition numbers if desired */ /* (Workspace: STGEVC: need 6*N */ /* STGSNA: need 2*N*(N+2)+16 if SENSE = 'V' or 'B', */ /* need N otherwise ) */ if (ilv || ! wantsn) { if (ilv) { if (ilvl) { if (ilvr) { *(unsigned char *)chtemp = 'B'; } else { *(unsigned char *)chtemp = 'L'; } } else { *(unsigned char *)chtemp = 'R'; } stgevc_(chtemp, "B", ldumma, n, &a[a_offset], lda, &b[b_offset], ldb, &vl[vl_offset], ldvl, &vr[vr_offset], ldvr, n, &in, & work[1], &ierr); if (ierr != 0) { *info = *n + 2; goto L130; } } if (! wantsn) { /* compute eigenvectors (STGEVC) and estimate condition */ /* numbers (STGSNA). Note that the definition of the condition */ /* number is not invariant under transformation (u,v) to */ /* (Q*u, Z*v), where (u,v) are eigenvectors of the generalized */ /* Schur form (S,T), Q and Z are orthogonal matrices. In order */ /* to avoid using extra 2*N*N workspace, we have to recalculate */ /* eigenvectors and estimate one condition numbers at a time. */ pair = FALSE_; i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { if (pair) { pair = FALSE_; goto L20; } mm = 1; if (i__ < *n) { if (a[i__ + 1 + i__ * a_dim1] != 0.f) { pair = TRUE_; mm = 2; } } i__2 = *n; for (j = 1; j <= i__2; ++j) { bwork[j] = FALSE_; /* L10: */ } if (mm == 1) { bwork[i__] = TRUE_; } else if (mm == 2) { bwork[i__] = TRUE_; bwork[i__ + 1] = TRUE_; } iwrk = mm * *n + 1; iwrk1 = iwrk + mm * *n; /* Compute a pair of left and right eigenvectors. */ /* (compute workspace: need up to 4*N + 6*N) */ if (wantse || wantsb) { stgevc_("B", "S", &bwork[1], n, &a[a_offset], lda, &b[ b_offset], ldb, &work[1], n, &work[iwrk], n, &mm, &m, &work[iwrk1], &ierr); if (ierr != 0) { *info = *n + 2; goto L130; } } i__2 = *lwork - iwrk1 + 1; stgsna_(sense, "S", &bwork[1], n, &a[a_offset], lda, &b[ b_offset], ldb, &work[1], n, &work[iwrk], n, &rconde[ i__], &rcondv[i__], &mm, &m, &work[iwrk1], &i__2, & iwork[1], &ierr); L20: ; } } } /* Undo balancing on VL and VR and normalization */ /* (Workspace: none needed) */ if (ilvl) { sggbak_(balanc, "L", n, ilo, ihi, &lscale[1], &rscale[1], n, &vl[ vl_offset], ldvl, &ierr); i__1 = *n; for (jc = 1; jc <= i__1; ++jc) { if (alphai[jc] < 0.f) { goto L70; } temp = 0.f; if (alphai[jc] == 0.f) { i__2 = *n; for (jr = 1; jr <= i__2; ++jr) { /* Computing MAX */ r__2 = temp; r__3 = (r__1 = vl[jr + jc * vl_dim1], abs( r__1)); // , expr subst temp = max(r__2,r__3); /* L30: */ } } else { i__2 = *n; for (jr = 1; jr <= i__2; ++jr) { /* Computing MAX */ r__3 = temp; r__4 = (r__1 = vl[jr + jc * vl_dim1], abs( r__1)) + (r__2 = vl[jr + (jc + 1) * vl_dim1], abs( r__2)); // , expr subst temp = max(r__3,r__4); /* L40: */ } } if (temp < smlnum) { goto L70; } temp = 1.f / temp; if (alphai[jc] == 0.f) { i__2 = *n; for (jr = 1; jr <= i__2; ++jr) { vl[jr + jc * vl_dim1] *= temp; /* L50: */ } } else { i__2 = *n; for (jr = 1; jr <= i__2; ++jr) { vl[jr + jc * vl_dim1] *= temp; vl[jr + (jc + 1) * vl_dim1] *= temp; /* L60: */ } } L70: ; } } if (ilvr) { sggbak_(balanc, "R", n, ilo, ihi, &lscale[1], &rscale[1], n, &vr[ vr_offset], ldvr, &ierr); i__1 = *n; for (jc = 1; jc <= i__1; ++jc) { if (alphai[jc] < 0.f) { goto L120; } temp = 0.f; if (alphai[jc] == 0.f) { i__2 = *n; for (jr = 1; jr <= i__2; ++jr) { /* Computing MAX */ r__2 = temp; r__3 = (r__1 = vr[jr + jc * vr_dim1], abs( r__1)); // , expr subst temp = max(r__2,r__3); /* L80: */ } } else { i__2 = *n; for (jr = 1; jr <= i__2; ++jr) { /* Computing MAX */ r__3 = temp; r__4 = (r__1 = vr[jr + jc * vr_dim1], abs( r__1)) + (r__2 = vr[jr + (jc + 1) * vr_dim1], abs( r__2)); // , expr subst temp = max(r__3,r__4); /* L90: */ } } if (temp < smlnum) { goto L120; } temp = 1.f / temp; if (alphai[jc] == 0.f) { i__2 = *n; for (jr = 1; jr <= i__2; ++jr) { vr[jr + jc * vr_dim1] *= temp; /* L100: */ } } else { i__2 = *n; for (jr = 1; jr <= i__2; ++jr) { vr[jr + jc * vr_dim1] *= temp; vr[jr + (jc + 1) * vr_dim1] *= temp; /* L110: */ } } L120: ; } } /* Undo scaling if necessary */ L130: if (ilascl) { slascl_("G", &c__0, &c__0, &anrmto, &anrm, n, &c__1, &alphar[1], n, & ierr); slascl_("G", &c__0, &c__0, &anrmto, &anrm, n, &c__1, &alphai[1], n, & ierr); } if (ilbscl) { slascl_("G", &c__0, &c__0, &bnrmto, &bnrm, n, &c__1, &beta[1], n, & ierr); } work[1] = (real) maxwrk; return 0; /* End of SGGEVX */ }