/* 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 sggsvd_(char *jobu, char *jobv, char *jobq, int *m, int *n, int *p, int *k, int *l, float *a, int *lda, float *b, int *ldb, float *alpha, float *beta, float *u, int * ldu, float *v, int *ldv, float *q, int *ldq, float *work, int *iwork, int *info) { /* System generated locals */ int a_dim1, a_offset, b_dim1, b_offset, q_dim1, q_offset, u_dim1, u_offset, v_dim1, v_offset, i__1, i__2; /* Local variables */ int i__, j; float ulp; int ibnd; float tola; int isub; float tolb, unfl, temp, smax; extern int lsame_(char *, char *); float anorm, bnorm; int wantq; extern int scopy_(int *, float *, int *, float *, int *); int wantu, wantv; extern double slamch_(char *), slange_(char *, int *, int *, float *, int *, float *); int ncycle; extern int xerbla_(char *, int *), stgsja_( char *, char *, char *, int *, int *, int *, int * , int *, float *, int *, float *, int *, float *, float *, float *, float *, float *, int *, float *, int *, float *, int *, float *, int *, int *), sggsvp_(char *, char *, char *, int *, int *, int *, float *, int *, float *, int *, float *, float *, int *, int *, float *, int *, float *, int *, float *, int * , int *, float *, float *, int *); /* -- LAPACK driver routine (version 3.2) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* .. Array Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* SGGSVD computes the generalized singular value decomposition (GSVD) */ /* of an M-by-N float matrix A and P-by-N float matrix B: */ /* U'*A*Q = D1*( 0 R ), V'*B*Q = D2*( 0 R ) */ /* where U, V and Q are orthogonal matrices, and Z' is the transpose */ /* of Z. Let K+L = the effective numerical rank of the matrix (A',B')', */ /* then R is a K+L-by-K+L nonsingular upper triangular matrix, D1 and */ /* D2 are M-by-(K+L) and P-by-(K+L) "diagonal" matrices and of the */ /* following structures, respectively: */ /* If M-K-L >= 0, */ /* K L */ /* D1 = K ( I 0 ) */ /* L ( 0 C ) */ /* M-K-L ( 0 0 ) */ /* K L */ /* D2 = L ( 0 S ) */ /* P-L ( 0 0 ) */ /* N-K-L K L */ /* ( 0 R ) = K ( 0 R11 R12 ) */ /* L ( 0 0 R22 ) */ /* where */ /* C = diag( ALPHA(K+1), ... , ALPHA(K+L) ), */ /* S = diag( BETA(K+1), ... , BETA(K+L) ), */ /* C**2 + S**2 = I. */ /* R is stored in A(1:K+L,N-K-L+1:N) on exit. */ /* If M-K-L < 0, */ /* K M-K K+L-M */ /* D1 = K ( I 0 0 ) */ /* M-K ( 0 C 0 ) */ /* K M-K K+L-M */ /* D2 = M-K ( 0 S 0 ) */ /* K+L-M ( 0 0 I ) */ /* P-L ( 0 0 0 ) */ /* N-K-L K M-K K+L-M */ /* ( 0 R ) = K ( 0 R11 R12 R13 ) */ /* M-K ( 0 0 R22 R23 ) */ /* K+L-M ( 0 0 0 R33 ) */ /* where */ /* C = diag( ALPHA(K+1), ... , ALPHA(M) ), */ /* S = diag( BETA(K+1), ... , BETA(M) ), */ /* C**2 + S**2 = I. */ /* (R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N), and R33 is stored */ /* ( 0 R22 R23 ) */ /* in B(M-K+1:L,N+M-K-L+1:N) on exit. */ /* The routine computes C, S, R, and optionally the orthogonal */ /* transformation matrices U, V and Q. */ /* In particular, if B is an N-by-N nonsingular matrix, then the GSVD of */ /* A and B implicitly gives the SVD of A*inv(B): */ /* A*inv(B) = U*(D1*inv(D2))*V'. */ /* If ( A',B')' has orthonormal columns, then the GSVD of A and B is */ /* also equal to the CS decomposition of A and B. Furthermore, the GSVD */ /* can be used to derive the solution of the eigenvalue problem: */ /* A'*A x = lambda* B'*B x. */ /* In some literature, the GSVD of A and B is presented in the form */ /* U'*A*X = ( 0 D1 ), V'*B*X = ( 0 D2 ) */ /* where U and V are orthogonal and X is nonsingular, D1 and D2 are */ /* ``diagonal''. The former GSVD form can be converted to the latter */ /* form by taking the nonsingular matrix X as */ /* X = Q*( I 0 ) */ /* ( 0 inv(R) ). */ /* Arguments */ /* ========= */ /* JOBU (input) CHARACTER*1 */ /* = 'U': Orthogonal matrix U is computed; */ /* = 'N': U is not computed. */ /* JOBV (input) CHARACTER*1 */ /* = 'V': Orthogonal matrix V is computed; */ /* = 'N': V is not computed. */ /* JOBQ (input) CHARACTER*1 */ /* = 'Q': Orthogonal matrix Q is computed; */ /* = 'N': Q is not computed. */ /* M (input) INTEGER */ /* The number of rows of the matrix A. M >= 0. */ /* N (input) INTEGER */ /* The number of columns of the matrices A and B. N >= 0. */ /* P (input) INTEGER */ /* The number of rows of the matrix B. P >= 0. */ /* K (output) INTEGER */ /* L (output) INTEGER */ /* On exit, K and L specify the dimension of the subblocks */ /* described in the Purpose section. */ /* K + L = effective numerical rank of (A',B')'. */ /* A (input/output) REAL array, dimension (LDA,N) */ /* On entry, the M-by-N matrix A. */ /* On exit, A contains the triangular matrix R, or part of R. */ /* See Purpose for details. */ /* LDA (input) INTEGER */ /* The leading dimension of the array A. LDA >= MAX(1,M). */ /* B (input/output) REAL array, dimension (LDB,N) */ /* On entry, the P-by-N matrix B. */ /* On exit, B contains the triangular matrix R if M-K-L < 0. */ /* See Purpose for details. */ /* LDB (input) INTEGER */ /* The leading dimension of the array B. LDB >= MAX(1,P). */ /* ALPHA (output) REAL array, dimension (N) */ /* BETA (output) REAL array, dimension (N) */ /* On exit, ALPHA and BETA contain the generalized singular */ /* value pairs of A and B; */ /* ALPHA(1:K) = 1, */ /* BETA(1:K) = 0, */ /* and if M-K-L >= 0, */ /* ALPHA(K+1:K+L) = C, */ /* BETA(K+1:K+L) = S, */ /* or if M-K-L < 0, */ /* ALPHA(K+1:M)=C, ALPHA(M+1:K+L)=0 */ /* BETA(K+1:M) =S, BETA(M+1:K+L) =1 */ /* and */ /* ALPHA(K+L+1:N) = 0 */ /* BETA(K+L+1:N) = 0 */ /* U (output) REAL array, dimension (LDU,M) */ /* If JOBU = 'U', U contains the M-by-M orthogonal matrix U. */ /* If JOBU = 'N', U is not referenced. */ /* LDU (input) INTEGER */ /* The leading dimension of the array U. LDU >= MAX(1,M) if */ /* JOBU = 'U'; LDU >= 1 otherwise. */ /* V (output) REAL array, dimension (LDV,P) */ /* If JOBV = 'V', V contains the P-by-P orthogonal matrix V. */ /* If JOBV = 'N', V is not referenced. */ /* LDV (input) INTEGER */ /* The leading dimension of the array V. LDV >= MAX(1,P) if */ /* JOBV = 'V'; LDV >= 1 otherwise. */ /* Q (output) REAL array, dimension (LDQ,N) */ /* If JOBQ = 'Q', Q contains the N-by-N orthogonal matrix Q. */ /* If JOBQ = 'N', Q is not referenced. */ /* LDQ (input) INTEGER */ /* The leading dimension of the array Q. LDQ >= MAX(1,N) if */ /* JOBQ = 'Q'; LDQ >= 1 otherwise. */ /* WORK (workspace) REAL array, */ /* dimension (MAX(3*N,M,P)+N) */ /* IWORK (workspace/output) INTEGER array, dimension (N) */ /* On exit, IWORK stores the sorting information. More */ /* precisely, the following loop will sort ALPHA */ /* for I = K+1, MIN(M,K+L) */ /* swap ALPHA(I) and ALPHA(IWORK(I)) */ /* endfor */ /* such that ALPHA(1) >= ALPHA(2) >= ... >= ALPHA(N). */ /* INFO (output) INTEGER */ /* = 0: successful exit */ /* < 0: if INFO = -i, the i-th argument had an illegal value. */ /* > 0: if INFO = 1, the Jacobi-type procedure failed to */ /* converge. For further details, see subroutine STGSJA. */ /* Internal Parameters */ /* =================== */ /* TOLA REAL */ /* TOLB REAL */ /* TOLA and TOLB are the thresholds to determine the effective */ /* rank of (A',B')'. Generally, they are set to */ /* TOLA = MAX(M,N)*norm(A)*MACHEPS, */ /* TOLB = MAX(P,N)*norm(B)*MACHEPS. */ /* The size of TOLA and TOLB may affect the size of backward */ /* errors of the decomposition. */ /* Further Details */ /* =============== */ /* 2-96 Based on modifications by */ /* Ming Gu and Huan Ren, Computer Science Division, University of */ /* California at Berkeley, USA */ /* ===================================================================== */ /* .. Local Scalars .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ /* Test the input parameters */ /* Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; b_dim1 = *ldb; b_offset = 1 + b_dim1; b -= b_offset; --alpha; --beta; u_dim1 = *ldu; u_offset = 1 + u_dim1; u -= u_offset; v_dim1 = *ldv; v_offset = 1 + v_dim1; v -= v_offset; q_dim1 = *ldq; q_offset = 1 + q_dim1; q -= q_offset; --work; --iwork; /* Function Body */ wantu = lsame_(jobu, "U"); wantv = lsame_(jobv, "V"); wantq = lsame_(jobq, "Q"); *info = 0; if (! (wantu || lsame_(jobu, "N"))) { *info = -1; } else if (! (wantv || lsame_(jobv, "N"))) { *info = -2; } else if (! (wantq || lsame_(jobq, "N"))) { *info = -3; } else if (*m < 0) { *info = -4; } else if (*n < 0) { *info = -5; } else if (*p < 0) { *info = -6; } else if (*lda < MAX(1,*m)) { *info = -10; } else if (*ldb < MAX(1,*p)) { *info = -12; } else if (*ldu < 1 || wantu && *ldu < *m) { *info = -16; } else if (*ldv < 1 || wantv && *ldv < *p) { *info = -18; } else if (*ldq < 1 || wantq && *ldq < *n) { *info = -20; } if (*info != 0) { i__1 = -(*info); xerbla_("SGGSVD", &i__1); return 0; } /* Compute the Frobenius norm of matrices A and B */ anorm = slange_("1", m, n, &a[a_offset], lda, &work[1]); bnorm = slange_("1", p, n, &b[b_offset], ldb, &work[1]); /* Get machine precision and set up threshold for determining */ /* the effective numerical rank of the matrices A and B. */ ulp = slamch_("Precision"); unfl = slamch_("Safe Minimum"); tola = MAX(*m,*n) * MAX(anorm,unfl) * ulp; tolb = MAX(*p,*n) * MAX(bnorm,unfl) * ulp; /* Preprocessing */ sggsvp_(jobu, jobv, jobq, m, p, n, &a[a_offset], lda, &b[b_offset], ldb, & tola, &tolb, k, l, &u[u_offset], ldu, &v[v_offset], ldv, &q[ q_offset], ldq, &iwork[1], &work[1], &work[*n + 1], info); /* Compute the GSVD of two upper "triangular" matrices */ stgsja_(jobu, jobv, jobq, m, p, n, k, l, &a[a_offset], lda, &b[b_offset], ldb, &tola, &tolb, &alpha[1], &beta[1], &u[u_offset], ldu, &v[ v_offset], ldv, &q[q_offset], ldq, &work[1], &ncycle, info); /* Sort the singular values and store the pivot indices in IWORK */ /* Copy ALPHA to WORK, then sort ALPHA in WORK */ scopy_(n, &alpha[1], &c__1, &work[1], &c__1); /* Computing MIN */ i__1 = *l, i__2 = *m - *k; ibnd = MIN(i__1,i__2); i__1 = ibnd; for (i__ = 1; i__ <= i__1; ++i__) { /* Scan for largest ALPHA(K+I) */ isub = i__; smax = work[*k + i__]; i__2 = ibnd; for (j = i__ + 1; j <= i__2; ++j) { temp = work[*k + j]; if (temp > smax) { isub = j; smax = temp; } /* L10: */ } if (isub != i__) { work[*k + isub] = work[*k + i__]; work[*k + i__] = smax; iwork[*k + i__] = *k + isub; } else { iwork[*k + i__] = *k + i__; } /* L20: */ } return 0; /* End of SGGSVD */ } /* sggsvd_ */
/*< >*/ /* Subroutine */ int sggsvd_(char *jobu, char *jobv, char *jobq, integer *m, integer *n, integer *p, integer *k, integer *l, real *a, integer *lda, real *b, integer *ldb, real *alpha, real *beta, real *u, integer * ldu, real *v, integer *ldv, real *q, integer *ldq, real *work, integer *iwork, integer *info, ftnlen jobu_len, ftnlen jobv_len, ftnlen jobq_len) { /* System generated locals */ integer a_dim1, a_offset, b_dim1, b_offset, q_dim1, q_offset, u_dim1, u_offset, v_dim1, v_offset, i__1, i__2; /* Local variables */ integer i__, j; real ulp; integer ibnd; real tola; integer isub; real tolb, unfl, temp, smax; extern logical lsame_(char *, char *, ftnlen, ftnlen); real anorm, bnorm; logical wantq; extern /* Subroutine */ int scopy_(integer *, real *, integer *, real *, integer *); logical wantu, wantv; extern doublereal slamch_(char *, ftnlen), slange_(char *, integer *, integer *, real *, integer *, real *, ftnlen); integer ncycle; extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen), 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 *, ftnlen, ftnlen, ftnlen), 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 *, ftnlen, ftnlen, ftnlen); (void)jobu_len; (void)jobv_len; (void)jobq_len; /* -- LAPACK driver routine (version 3.0) -- */ /* Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., */ /* Courant Institute, Argonne National Lab, and Rice University */ /* June 30, 1999 */ /* .. Scalar Arguments .. */ /*< CHARACTER JOBQ, JOBU, JOBV >*/ /*< INTEGER INFO, K, L, LDA, LDB, LDQ, LDU, LDV, M, N, P >*/ /* .. */ /* .. Array Arguments .. */ /*< INTEGER IWORK( * ) >*/ /*< >*/ /* .. */ /* Purpose */ /* ======= */ /* SGGSVD computes the generalized singular value decomposition (GSVD) */ /* of an M-by-N real matrix A and P-by-N real matrix B: */ /* U'*A*Q = D1*( 0 R ), V'*B*Q = D2*( 0 R ) */ /* where U, V and Q are orthogonal matrices, and Z' is the transpose */ /* of Z. Let K+L = the effective numerical rank of the matrix (A',B')', */ /* then R is a K+L-by-K+L nonsingular upper triangular matrix, D1 and */ /* D2 are M-by-(K+L) and P-by-(K+L) "diagonal" matrices and of the */ /* following structures, respectively: */ /* If M-K-L >= 0, */ /* K L */ /* D1 = K ( I 0 ) */ /* L ( 0 C ) */ /* M-K-L ( 0 0 ) */ /* K L */ /* D2 = L ( 0 S ) */ /* P-L ( 0 0 ) */ /* N-K-L K L */ /* ( 0 R ) = K ( 0 R11 R12 ) */ /* L ( 0 0 R22 ) */ /* where */ /* C = diag( ALPHA(K+1), ... , ALPHA(K+L) ), */ /* S = diag( BETA(K+1), ... , BETA(K+L) ), */ /* C**2 + S**2 = I. */ /* R is stored in A(1:K+L,N-K-L+1:N) on exit. */ /* If M-K-L < 0, */ /* K M-K K+L-M */ /* D1 = K ( I 0 0 ) */ /* M-K ( 0 C 0 ) */ /* K M-K K+L-M */ /* D2 = M-K ( 0 S 0 ) */ /* K+L-M ( 0 0 I ) */ /* P-L ( 0 0 0 ) */ /* N-K-L K M-K K+L-M */ /* ( 0 R ) = K ( 0 R11 R12 R13 ) */ /* M-K ( 0 0 R22 R23 ) */ /* K+L-M ( 0 0 0 R33 ) */ /* where */ /* C = diag( ALPHA(K+1), ... , ALPHA(M) ), */ /* S = diag( BETA(K+1), ... , BETA(M) ), */ /* C**2 + S**2 = I. */ /* (R11 R12 R13 ) is stored in A(1:M, N-K-L+1:N), and R33 is stored */ /* ( 0 R22 R23 ) */ /* in B(M-K+1:L,N+M-K-L+1:N) on exit. */ /* The routine computes C, S, R, and optionally the orthogonal */ /* transformation matrices U, V and Q. */ /* In particular, if B is an N-by-N nonsingular matrix, then the GSVD of */ /* A and B implicitly gives the SVD of A*inv(B): */ /* A*inv(B) = U*(D1*inv(D2))*V'. */ /* If ( A',B')' has orthonormal columns, then the GSVD of A and B is */ /* also equal to the CS decomposition of A and B. Furthermore, the GSVD */ /* can be used to derive the solution of the eigenvalue problem: */ /* A'*A x = lambda* B'*B x. */ /* In some literature, the GSVD of A and B is presented in the form */ /* U'*A*X = ( 0 D1 ), V'*B*X = ( 0 D2 ) */ /* where U and V are orthogonal and X is nonsingular, D1 and D2 are */ /* ``diagonal''. The former GSVD form can be converted to the latter */ /* form by taking the nonsingular matrix X as */ /* X = Q*( I 0 ) */ /* ( 0 inv(R) ). */ /* Arguments */ /* ========= */ /* JOBU (input) CHARACTER*1 */ /* = 'U': Orthogonal matrix U is computed; */ /* = 'N': U is not computed. */ /* JOBV (input) CHARACTER*1 */ /* = 'V': Orthogonal matrix V is computed; */ /* = 'N': V is not computed. */ /* JOBQ (input) CHARACTER*1 */ /* = 'Q': Orthogonal matrix Q is computed; */ /* = 'N': Q is not computed. */ /* M (input) INTEGER */ /* The number of rows of the matrix A. M >= 0. */ /* N (input) INTEGER */ /* The number of columns of the matrices A and B. N >= 0. */ /* P (input) INTEGER */ /* The number of rows of the matrix B. P >= 0. */ /* K (output) INTEGER */ /* L (output) INTEGER */ /* On exit, K and L specify the dimension of the subblocks */ /* described in the Purpose section. */ /* K + L = effective numerical rank of (A',B')'. */ /* A (input/output) REAL array, dimension (LDA,N) */ /* On entry, the M-by-N matrix A. */ /* On exit, A contains the triangular matrix R, or part of R. */ /* See Purpose for details. */ /* LDA (input) INTEGER */ /* The leading dimension of the array A. LDA >= max(1,M). */ /* B (input/output) REAL array, dimension (LDB,N) */ /* On entry, the P-by-N matrix B. */ /* On exit, B contains the triangular matrix R if M-K-L < 0. */ /* See Purpose for details. */ /* LDB (input) INTEGER */ /* The leading dimension of the array B. LDA >= max(1,P). */ /* ALPHA (output) REAL array, dimension (N) */ /* BETA (output) REAL array, dimension (N) */ /* On exit, ALPHA and BETA contain the generalized singular */ /* value pairs of A and B; */ /* ALPHA(1:K) = 1, */ /* BETA(1:K) = 0, */ /* and if M-K-L >= 0, */ /* ALPHA(K+1:K+L) = C, */ /* BETA(K+1:K+L) = S, */ /* or if M-K-L < 0, */ /* ALPHA(K+1:M)=C, ALPHA(M+1:K+L)=0 */ /* BETA(K+1:M) =S, BETA(M+1:K+L) =1 */ /* and */ /* ALPHA(K+L+1:N) = 0 */ /* BETA(K+L+1:N) = 0 */ /* U (output) REAL array, dimension (LDU,M) */ /* If JOBU = 'U', U contains the M-by-M orthogonal matrix U. */ /* If JOBU = 'N', U is not referenced. */ /* LDU (input) INTEGER */ /* The leading dimension of the array U. LDU >= max(1,M) if */ /* JOBU = 'U'; LDU >= 1 otherwise. */ /* V (output) REAL array, dimension (LDV,P) */ /* If JOBV = 'V', V contains the P-by-P orthogonal matrix V. */ /* If JOBV = 'N', V is not referenced. */ /* LDV (input) INTEGER */ /* The leading dimension of the array V. LDV >= max(1,P) if */ /* JOBV = 'V'; LDV >= 1 otherwise. */ /* Q (output) REAL array, dimension (LDQ,N) */ /* If JOBQ = 'Q', Q contains the N-by-N orthogonal matrix Q. */ /* If JOBQ = 'N', Q is not referenced. */ /* LDQ (input) INTEGER */ /* The leading dimension of the array Q. LDQ >= max(1,N) if */ /* JOBQ = 'Q'; LDQ >= 1 otherwise. */ /* WORK (workspace) REAL array, */ /* dimension (max(3*N,M,P)+N) */ /* IWORK (workspace/output) INTEGER array, dimension (N) */ /* On exit, IWORK stores the sorting information. More */ /* precisely, the following loop will sort ALPHA */ /* for I = K+1, min(M,K+L) */ /* swap ALPHA(I) and ALPHA(IWORK(I)) */ /* endfor */ /* such that ALPHA(1) >= ALPHA(2) >= ... >= ALPHA(N). */ /* INFO (output)INTEGER */ /* = 0: successful exit */ /* < 0: if INFO = -i, the i-th argument had an illegal value. */ /* > 0: if INFO = 1, the Jacobi-type procedure failed to */ /* converge. For further details, see subroutine STGSJA. */ /* Internal Parameters */ /* =================== */ /* TOLA REAL */ /* TOLB REAL */ /* TOLA and TOLB are the thresholds to determine the effective */ /* rank of (A',B')'. Generally, they are set to */ /* TOLA = MAX(M,N)*norm(A)*MACHEPS, */ /* TOLB = MAX(P,N)*norm(B)*MACHEPS. */ /* The size of TOLA and TOLB may affect the size of backward */ /* errors of the decomposition. */ /* Further Details */ /* =============== */ /* 2-96 Based on modifications by */ /* Ming Gu and Huan Ren, Computer Science Division, University of */ /* California at Berkeley, USA */ /* ===================================================================== */ /* .. Local Scalars .. */ /*< LOGICAL WANTQ, WANTU, WANTV >*/ /*< INTEGER I, IBND, ISUB, J, NCYCLE >*/ /*< REAL ANORM, BNORM, SMAX, TEMP, TOLA, TOLB, ULP, UNFL >*/ /* .. */ /* .. External Functions .. */ /*< LOGICAL LSAME >*/ /*< REAL SLAMCH, SLANGE >*/ /*< EXTERNAL LSAME, SLAMCH, SLANGE >*/ /* .. */ /* .. External Subroutines .. */ /*< EXTERNAL SCOPY, SGGSVP, STGSJA, XERBLA >*/ /* .. */ /* .. Intrinsic Functions .. */ /*< INTRINSIC MAX, MIN >*/ /* .. */ /* .. Executable Statements .. */ /* Test the input parameters */ /*< WANTU = LSAME( JOBU, 'U' ) >*/ /* Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; b_dim1 = *ldb; b_offset = 1 + b_dim1; b -= b_offset; --alpha; --beta; u_dim1 = *ldu; u_offset = 1 + u_dim1; u -= u_offset; v_dim1 = *ldv; v_offset = 1 + v_dim1; v -= v_offset; q_dim1 = *ldq; q_offset = 1 + q_dim1; q -= q_offset; --work; --iwork; /* Function Body */ wantu = lsame_(jobu, "U", (ftnlen)1, (ftnlen)1); /*< WANTV = LSAME( JOBV, 'V' ) >*/ wantv = lsame_(jobv, "V", (ftnlen)1, (ftnlen)1); /*< WANTQ = LSAME( JOBQ, 'Q' ) >*/ wantq = lsame_(jobq, "Q", (ftnlen)1, (ftnlen)1); /*< INFO = 0 >*/ *info = 0; /*< IF( .NOT.( WANTU .OR. LSAME( JOBU, 'N' ) ) ) THEN >*/ if (! (wantu || lsame_(jobu, "N", (ftnlen)1, (ftnlen)1))) { /*< INFO = -1 >*/ *info = -1; /*< ELSE IF( .NOT.( WANTV .OR. LSAME( JOBV, 'N' ) ) ) THEN >*/ } else if (! (wantv || lsame_(jobv, "N", (ftnlen)1, (ftnlen)1))) { /*< INFO = -2 >*/ *info = -2; /*< ELSE IF( .NOT.( WANTQ .OR. LSAME( JOBQ, 'N' ) ) ) THEN >*/ } else if (! (wantq || lsame_(jobq, "N", (ftnlen)1, (ftnlen)1))) { /*< INFO = -3 >*/ *info = -3; /*< ELSE IF( M.LT.0 ) THEN >*/ } else if (*m < 0) { /*< INFO = -4 >*/ *info = -4; /*< ELSE IF( N.LT.0 ) THEN >*/ } else if (*n < 0) { /*< INFO = -5 >*/ *info = -5; /*< ELSE IF( P.LT.0 ) THEN >*/ } else if (*p < 0) { /*< INFO = -6 >*/ *info = -6; /*< ELSE IF( LDA.LT.MAX( 1, M ) ) THEN >*/ } else if (*lda < max(1,*m)) { /*< INFO = -10 >*/ *info = -10; /*< ELSE IF( LDB.LT.MAX( 1, P ) ) THEN >*/ } else if (*ldb < max(1,*p)) { /*< INFO = -12 >*/ *info = -12; /*< ELSE IF( LDU.LT.1 .OR. ( WANTU .AND. LDU.LT.M ) ) THEN >*/ } else if (*ldu < 1 || (wantu && *ldu < *m)) { /*< INFO = -16 >*/ *info = -16; /*< ELSE IF( LDV.LT.1 .OR. ( WANTV .AND. LDV.LT.P ) ) THEN >*/ } else if (*ldv < 1 || (wantv && *ldv < *p)) { /*< INFO = -18 >*/ *info = -18; /*< ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.N ) ) THEN >*/ } else if (*ldq < 1 || (wantq && *ldq < *n)) { /*< INFO = -20 >*/ *info = -20; /*< END IF >*/ } /*< IF( INFO.NE.0 ) THEN >*/ if (*info != 0) { /*< CALL XERBLA( 'SGGSVD', -INFO ) >*/ i__1 = -(*info); xerbla_("SGGSVD", &i__1, (ftnlen)6); /*< RETURN >*/ return 0; /*< END IF >*/ } /* Compute the Frobenius norm of matrices A and B */ /*< ANORM = SLANGE( '1', M, N, A, LDA, WORK ) >*/ anorm = slange_("1", m, n, &a[a_offset], lda, &work[1], (ftnlen)1); /*< BNORM = SLANGE( '1', P, N, B, LDB, WORK ) >*/ bnorm = slange_("1", p, n, &b[b_offset], ldb, &work[1], (ftnlen)1); /* Get machine precision and set up threshold for determining */ /* the effective numerical rank of the matrices A and B. */ /*< ULP = SLAMCH( 'Precision' ) >*/ ulp = slamch_("Precision", (ftnlen)9); /*< UNFL = SLAMCH( 'Safe Minimum' ) >*/ unfl = slamch_("Safe Minimum", (ftnlen)12); /*< TOLA = MAX( M, N )*MAX( ANORM, UNFL )*ULP >*/ tola = max(*m,*n) * dmax(anorm,unfl) * ulp; /*< TOLB = MAX( P, N )*MAX( BNORM, UNFL )*ULP >*/ tolb = max(*p,*n) * dmax(bnorm,unfl) * ulp; /* Preprocessing */ /*< >*/ sggsvp_(jobu, jobv, jobq, m, p, n, &a[a_offset], lda, &b[b_offset], ldb, & tola, &tolb, k, l, &u[u_offset], ldu, &v[v_offset], ldv, &q[ q_offset], ldq, &iwork[1], &work[1], &work[*n + 1], info, (ftnlen) 1, (ftnlen)1, (ftnlen)1); /* Compute the GSVD of two upper "triangular" matrices */ /*< >*/ stgsja_(jobu, jobv, jobq, m, p, n, k, l, &a[a_offset], lda, &b[b_offset], ldb, &tola, &tolb, &alpha[1], &beta[1], &u[u_offset], ldu, &v[ v_offset], ldv, &q[q_offset], ldq, &work[1], &ncycle, info, ( ftnlen)1, (ftnlen)1, (ftnlen)1); /* Sort the singular values and store the pivot indices in IWORK */ /* Copy ALPHA to WORK, then sort ALPHA in WORK */ /*< CALL SCOPY( N, ALPHA, 1, WORK, 1 ) >*/ scopy_(n, &alpha[1], &c__1, &work[1], &c__1); /*< IBND = MIN( L, M-K ) >*/ /* Computing MIN */ i__1 = *l, i__2 = *m - *k; ibnd = min(i__1,i__2); /*< DO 20 I = 1, IBND >*/ i__1 = ibnd; for (i__ = 1; i__ <= i__1; ++i__) { /* Scan for largest ALPHA(K+I) */ /*< ISUB = I >*/ isub = i__; /*< SMAX = WORK( K+I ) >*/ smax = work[*k + i__]; /*< DO 10 J = I + 1, IBND >*/ i__2 = ibnd; for (j = i__ + 1; j <= i__2; ++j) { /*< TEMP = WORK( K+J ) >*/ temp = work[*k + j]; /*< IF( TEMP.GT.SMAX ) THEN >*/ if (temp > smax) { /*< ISUB = J >*/ isub = j; /*< SMAX = TEMP >*/ smax = temp; /*< END IF >*/ } /*< 10 CONTINUE >*/ /* L10: */ } /*< IF( ISUB.NE.I ) THEN >*/ if (isub != i__) { /*< WORK( K+ISUB ) = WORK( K+I ) >*/ work[*k + isub] = work[*k + i__]; /*< WORK( K+I ) = SMAX >*/ work[*k + i__] = smax; /*< IWORK( K+I ) = K + ISUB >*/ iwork[*k + i__] = *k + isub; /*< ELSE >*/ } else { /*< IWORK( K+I ) = K + I >*/ iwork[*k + i__] = *k + i__; /*< END IF >*/ } /*< 20 CONTINUE >*/ /* L20: */ } /*< RETURN >*/ return 0; /* End of SGGSVD */ /*< END >*/ } /* sggsvd_ */