/* Subroutine */ int serrec_(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 ex\002,\002its ***\002)"; /* Builtin functions */ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); /* Local variables */ real a[16] /* was [4][4] */, b[16] /* was [4][4] */, c__[16] /* was [4][4] */; integer i__, j, m; real s[4], wi[4]; integer nt; real wr[4]; logical sel[4]; real sep[4]; integer info, ifst, ilst; real work[4], scale; integer iwork[4]; extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical *, logical *), strexc_(char *, integer *, real *, integer *, real *, integer *, integer *, integer *, real *, integer *), strsna_(char *, char *, logical *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *, integer *), strsen_(char *, char *, logical *, integer *, real *, integer *, real *, integer *, real *, real *, integer *, real *, real *, real *, integer *, integer *, integer *, integer * ), strsyl_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer * , real *, integer *); /* Fortran I/O blocks */ static cilist io___19 = { 0, 0, 0, fmt_9999, 0 }; static cilist io___20 = { 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 */ /* ======= */ /* SERREC tests the error exits for the routines for eigen- condition */ /* estimation for REAL matrices: */ /* STRSYL, STREXC, STRSNA and STRSEN. */ /* 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 Subroutines .. */ /* .. */ /* .. Scalars in Common .. */ /* .. */ /* .. Common blocks .. */ /* .. */ /* .. Executable Statements .. */ infoc_1.nout = *nunit; infoc_1.ok = TRUE_; nt = 0; /* Initialize A, B and SEL */ for (j = 1; j <= 4; ++j) { for (i__ = 1; i__ <= 4; ++i__) { a[i__ + (j << 2) - 5] = 0.f; b[i__ + (j << 2) - 5] = 0.f; /* L10: */ } /* L20: */ } for (i__ = 1; i__ <= 4; ++i__) { a[i__ + (i__ << 2) - 5] = 1.f; sel[i__ - 1] = TRUE_; /* L30: */ } /* Test STRSYL */ s_copy(srnamc_1.srnamt, "STRSYL", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; strsyl_("X", "N", &c__1, &c__0, &c__0, a, &c__1, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; strsyl_("N", "X", &c__1, &c__0, &c__0, a, &c__1, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; strsyl_("N", "N", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; strsyl_("N", "N", &c__1, &c_n1, &c__0, a, &c__1, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; strsyl_("N", "N", &c__1, &c__0, &c_n1, a, &c__1, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; strsyl_("N", "N", &c__1, &c__2, &c__0, a, &c__1, b, &c__1, c__, &c__2, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; strsyl_("N", "N", &c__1, &c__0, &c__2, a, &c__1, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; strsyl_("N", "N", &c__1, &c__2, &c__0, a, &c__2, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 8; /* Test STREXC */ s_copy(srnamc_1.srnamt, "STREXC", (ftnlen)32, (ftnlen)6); ifst = 1; ilst = 1; infoc_1.infot = 1; strexc_("X", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; strexc_("N", &c__0, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; ilst = 2; strexc_("N", &c__2, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; strexc_("V", &c__2, a, &c__2, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; ifst = 0; ilst = 1; strexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; ifst = 2; strexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; ifst = 1; ilst = 0; strexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; ilst = 2; strexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 8; /* Test STRSNA */ s_copy(srnamc_1.srnamt, "STRSNA", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; strsna_("X", "A", sel, &c__0, a, &c__1, b, &c__1, c__, &c__1, s, sep, & c__1, &m, work, &c__1, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; strsna_("B", "X", sel, &c__0, a, &c__1, b, &c__1, c__, &c__1, s, sep, & c__1, &m, work, &c__1, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; strsna_("B", "A", sel, &c_n1, a, &c__1, b, &c__1, c__, &c__1, s, sep, & c__1, &m, work, &c__1, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; strsna_("V", "A", sel, &c__2, a, &c__1, b, &c__1, c__, &c__1, s, sep, & c__2, &m, work, &c__2, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; strsna_("B", "A", sel, &c__2, a, &c__2, b, &c__1, c__, &c__2, s, sep, & c__2, &m, work, &c__2, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; strsna_("B", "A", sel, &c__2, a, &c__2, b, &c__2, c__, &c__1, s, sep, & c__2, &m, work, &c__2, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; strsna_("B", "A", sel, &c__1, a, &c__1, b, &c__1, c__, &c__1, s, sep, & c__0, &m, work, &c__1, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; strsna_("B", "S", sel, &c__2, a, &c__2, b, &c__2, c__, &c__2, s, sep, & c__1, &m, work, &c__2, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 16; strsna_("B", "A", sel, &c__2, a, &c__2, b, &c__2, c__, &c__2, s, sep, & c__2, &m, work, &c__1, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 9; /* Test STRSEN */ sel[0] = FALSE_; s_copy(srnamc_1.srnamt, "STRSEN", (ftnlen)32, (ftnlen)6); infoc_1.infot = 1; strsen_("X", "N", sel, &c__0, a, &c__1, b, &c__1, wr, wi, &m, s, sep, work, &c__1, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; strsen_("N", "X", sel, &c__0, a, &c__1, b, &c__1, wr, wi, &m, s, sep, work, &c__1, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; strsen_("N", "N", sel, &c_n1, a, &c__1, b, &c__1, wr, wi, &m, s, sep, work, &c__1, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; strsen_("N", "N", sel, &c__2, a, &c__1, b, &c__1, wr, wi, &m, s, sep, work, &c__2, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; strsen_("N", "V", sel, &c__2, a, &c__2, b, &c__1, wr, wi, &m, s, sep, work, &c__1, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; strsen_("N", "V", sel, &c__2, a, &c__2, b, &c__2, wr, wi, &m, s, sep, work, &c__0, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; strsen_("E", "V", sel, &c__3, a, &c__3, b, &c__3, wr, wi, &m, s, sep, work, &c__1, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; strsen_("V", "V", sel, &c__3, a, &c__3, b, &c__3, wr, wi, &m, s, sep, work, &c__3, iwork, &c__2, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 17; strsen_("E", "V", sel, &c__2, a, &c__2, b, &c__2, wr, wi, &m, s, sep, work, &c__1, iwork, &c__0, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 17; strsen_("V", "V", sel, &c__3, a, &c__3, b, &c__3, wr, wi, &m, s, sep, work, &c__4, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 10; /* Print a summary line. */ if (infoc_1.ok) { io___19.ciunit = infoc_1.nout; s_wsfe(&io___19); do_fio(&c__1, path, (ftnlen)3); do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer)); e_wsfe(); } else { io___20.ciunit = infoc_1.nout; s_wsfe(&io___20); do_fio(&c__1, path, (ftnlen)3); e_wsfe(); } return 0; /* End of SERREC */ } /* serrec_ */
/* Subroutine */ int sget37_(real *rmax, integer *lmax, integer *ninfo, integer *knt, integer *nin) { /* System generated locals */ integer i__1, i__2; real r__1, r__2; /* Local variables */ integer i__, j, m, n; real s[20], t[400] /* was [20][20] */, v, le[400] /* was [20][20] */, re[400] /* was [20][20] */, wi[20], wr[20], val[3], dum[1], eps, sep[20], sin__[20], tol, tmp[400] /* was [20][20] */; integer ifnd, icmp, iscl, info, lcmp[3], kmin; real wiin[20], vmax, tnrm, wrin[20], work[1200], vmul, stmp[20]; extern /* Subroutine */ int sscal_(integer *, real *, real *, integer *); real sepin[20], vimin, tolin, vrmin; integer iwork[40]; extern /* Subroutine */ int scopy_(integer *, real *, integer *, real *, integer *); real witmp[20], wrtmp[20]; extern /* Subroutine */ int slabad_(real *, real *); extern doublereal slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ int sgehrd_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *); logical select[20]; real bignum; extern /* Subroutine */ int slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *), shseqr_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real * , real *, integer *, real *, integer *, integer *) , strevc_(char *, char *, logical *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *, integer *, real *, integer *); real septmp[20]; extern /* Subroutine */ int strsna_(char *, char *, logical *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *, integer *); real smlnum; /* Fortran I/O blocks */ static cilist io___5 = { 0, 0, 0, 0, 0 }; static cilist io___8 = { 0, 0, 0, 0, 0 }; static cilist io___11 = { 0, 0, 0, 0, 0 }; /* -- LAPACK test routine (version 3.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* .. Array Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* SGET37 tests STRSNA, a routine for estimating condition numbers of */ /* eigenvalues and/or right eigenvectors of a matrix. */ /* The test matrices are read from a file with logical unit number NIN. */ /* Arguments */ /* ========== */ /* RMAX (output) REAL array, dimension (3) */ /* Value of the largest test ratio. */ /* RMAX(1) = largest ratio comparing different calls to STRSNA */ /* RMAX(2) = largest error in reciprocal condition */ /* numbers taking their conditioning into account */ /* RMAX(3) = largest error in reciprocal condition */ /* numbers not taking their conditioning into */ /* account (may be larger than RMAX(2)) */ /* LMAX (output) INTEGER array, dimension (3) */ /* LMAX(i) is example number where largest test ratio */ /* RMAX(i) is achieved. Also: */ /* If SGEHRD returns INFO nonzero on example i, LMAX(1)=i */ /* If SHSEQR returns INFO nonzero on example i, LMAX(2)=i */ /* If STRSNA returns INFO nonzero on example i, LMAX(3)=i */ /* NINFO (output) INTEGER array, dimension (3) */ /* NINFO(1) = No. of times SGEHRD returned INFO nonzero */ /* NINFO(2) = No. of times SHSEQR returned INFO nonzero */ /* NINFO(3) = No. of times STRSNA returned INFO nonzero */ /* KNT (output) INTEGER */ /* Total number of examples tested. */ /* NIN (input) INTEGER */ /* Input logical unit number */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ /* Parameter adjustments */ --ninfo; --lmax; --rmax; /* Function Body */ eps = slamch_("P"); smlnum = slamch_("S") / eps; bignum = 1.f / smlnum; slabad_(&smlnum, &bignum); /* EPSIN = 2**(-24) = precision to which input data computed */ eps = dmax(eps,5.9605e-8f); rmax[1] = 0.f; rmax[2] = 0.f; rmax[3] = 0.f; lmax[1] = 0; lmax[2] = 0; lmax[3] = 0; *knt = 0; ninfo[1] = 0; ninfo[2] = 0; ninfo[3] = 0; val[0] = sqrt(smlnum); val[1] = 1.f; val[2] = sqrt(bignum); /* Read input data until N=0. Assume input eigenvalues are sorted */ /* lexicographically (increasing by real part, then decreasing by */ /* imaginary part) */ L10: io___5.ciunit = *nin; s_rsle(&io___5); do_lio(&c__3, &c__1, (char *)&n, (ftnlen)sizeof(integer)); e_rsle(); if (n == 0) { return 0; } i__1 = n; for (i__ = 1; i__ <= i__1; ++i__) { io___8.ciunit = *nin; s_rsle(&io___8); i__2 = n; for (j = 1; j <= i__2; ++j) { do_lio(&c__4, &c__1, (char *)&tmp[i__ + j * 20 - 21], (ftnlen) sizeof(real)); } e_rsle(); /* L20: */ } i__1 = n; for (i__ = 1; i__ <= i__1; ++i__) { io___11.ciunit = *nin; s_rsle(&io___11); do_lio(&c__4, &c__1, (char *)&wrin[i__ - 1], (ftnlen)sizeof(real)); do_lio(&c__4, &c__1, (char *)&wiin[i__ - 1], (ftnlen)sizeof(real)); do_lio(&c__4, &c__1, (char *)&sin__[i__ - 1], (ftnlen)sizeof(real)); do_lio(&c__4, &c__1, (char *)&sepin[i__ - 1], (ftnlen)sizeof(real)); e_rsle(); /* L30: */ } tnrm = slange_("M", &n, &n, tmp, &c__20, work); /* Begin test */ for (iscl = 1; iscl <= 3; ++iscl) { /* Scale input matrix */ ++(*knt); slacpy_("F", &n, &n, tmp, &c__20, t, &c__20); vmul = val[iscl - 1]; i__1 = n; for (i__ = 1; i__ <= i__1; ++i__) { sscal_(&n, &vmul, &t[i__ * 20 - 20], &c__1); /* L40: */ } if (tnrm == 0.f) { vmul = 1.f; } /* Compute eigenvalues and eigenvectors */ i__1 = 1200 - n; sgehrd_(&n, &c__1, &n, t, &c__20, work, &work[n], &i__1, &info); if (info != 0) { lmax[1] = *knt; ++ninfo[1]; goto L240; } i__1 = n - 2; for (j = 1; j <= i__1; ++j) { i__2 = n; for (i__ = j + 2; i__ <= i__2; ++i__) { t[i__ + j * 20 - 21] = 0.f; /* L50: */ } /* L60: */ } /* Compute Schur form */ shseqr_("S", "N", &n, &c__1, &n, t, &c__20, wr, wi, dum, &c__1, work, &c__1200, &info); if (info != 0) { lmax[2] = *knt; ++ninfo[2]; goto L240; } /* Compute eigenvectors */ strevc_("Both", "All", select, &n, t, &c__20, le, &c__20, re, &c__20, &n, &m, work, &info); /* Compute condition numbers */ strsna_("Both", "All", select, &n, t, &c__20, le, &c__20, re, &c__20, s, sep, &n, &m, work, &n, iwork, &info); if (info != 0) { lmax[3] = *knt; ++ninfo[3]; goto L240; } /* Sort eigenvalues and condition numbers lexicographically */ /* to compare with inputs */ scopy_(&n, wr, &c__1, wrtmp, &c__1); scopy_(&n, wi, &c__1, witmp, &c__1); scopy_(&n, s, &c__1, stmp, &c__1); scopy_(&n, sep, &c__1, septmp, &c__1); r__1 = 1.f / vmul; sscal_(&n, &r__1, septmp, &c__1); i__1 = n - 1; for (i__ = 1; i__ <= i__1; ++i__) { kmin = i__; vrmin = wrtmp[i__ - 1]; vimin = witmp[i__ - 1]; i__2 = n; for (j = i__ + 1; j <= i__2; ++j) { if (wrtmp[j - 1] < vrmin) { kmin = j; vrmin = wrtmp[j - 1]; vimin = witmp[j - 1]; } /* L70: */ } wrtmp[kmin - 1] = wrtmp[i__ - 1]; witmp[kmin - 1] = witmp[i__ - 1]; wrtmp[i__ - 1] = vrmin; witmp[i__ - 1] = vimin; vrmin = stmp[kmin - 1]; stmp[kmin - 1] = stmp[i__ - 1]; stmp[i__ - 1] = vrmin; vrmin = septmp[kmin - 1]; septmp[kmin - 1] = septmp[i__ - 1]; septmp[i__ - 1] = vrmin; /* L80: */ } /* Compare condition numbers for eigenvalues */ /* taking their condition numbers into account */ /* Computing MAX */ r__1 = (real) n * 2.f * eps * tnrm; v = dmax(r__1,smlnum); if (tnrm == 0.f) { v = 1.f; } i__1 = n; for (i__ = 1; i__ <= i__1; ++i__) { if (v > septmp[i__ - 1]) { tol = 1.f; } else { tol = v / septmp[i__ - 1]; } if (v > sepin[i__ - 1]) { tolin = 1.f; } else { tolin = v / sepin[i__ - 1]; } /* Computing MAX */ r__1 = tol, r__2 = smlnum / eps; tol = dmax(r__1,r__2); /* Computing MAX */ r__1 = tolin, r__2 = smlnum / eps; tolin = dmax(r__1,r__2); if (eps * (sin__[i__ - 1] - tolin) > stmp[i__ - 1] + tol) { vmax = 1.f / eps; } else if (sin__[i__ - 1] - tolin > stmp[i__ - 1] + tol) { vmax = (sin__[i__ - 1] - tolin) / (stmp[i__ - 1] + tol); } else if (sin__[i__ - 1] + tolin < eps * (stmp[i__ - 1] - tol)) { vmax = 1.f / eps; } else if (sin__[i__ - 1] + tolin < stmp[i__ - 1] - tol) { vmax = (stmp[i__ - 1] - tol) / (sin__[i__ - 1] + tolin); } else { vmax = 1.f; } if (vmax > rmax[2]) { rmax[2] = vmax; if (ninfo[2] == 0) { lmax[2] = *knt; } } /* L90: */ } /* Compare condition numbers for eigenvectors */ /* taking their condition numbers into account */ i__1 = n; for (i__ = 1; i__ <= i__1; ++i__) { if (v > septmp[i__ - 1] * stmp[i__ - 1]) { tol = septmp[i__ - 1]; } else { tol = v / stmp[i__ - 1]; } if (v > sepin[i__ - 1] * sin__[i__ - 1]) { tolin = sepin[i__ - 1]; } else { tolin = v / sin__[i__ - 1]; } /* Computing MAX */ r__1 = tol, r__2 = smlnum / eps; tol = dmax(r__1,r__2); /* Computing MAX */ r__1 = tolin, r__2 = smlnum / eps; tolin = dmax(r__1,r__2); if (eps * (sepin[i__ - 1] - tolin) > septmp[i__ - 1] + tol) { vmax = 1.f / eps; } else if (sepin[i__ - 1] - tolin > septmp[i__ - 1] + tol) { vmax = (sepin[i__ - 1] - tolin) / (septmp[i__ - 1] + tol); } else if (sepin[i__ - 1] + tolin < eps * (septmp[i__ - 1] - tol)) { vmax = 1.f / eps; } else if (sepin[i__ - 1] + tolin < septmp[i__ - 1] - tol) { vmax = (septmp[i__ - 1] - tol) / (sepin[i__ - 1] + tolin); } else { vmax = 1.f; } if (vmax > rmax[2]) { rmax[2] = vmax; if (ninfo[2] == 0) { lmax[2] = *knt; } } /* L100: */ } /* Compare condition numbers for eigenvalues */ /* without taking their condition numbers into account */ i__1 = n; for (i__ = 1; i__ <= i__1; ++i__) { if (sin__[i__ - 1] <= (real) (n << 1) * eps && stmp[i__ - 1] <= ( real) (n << 1) * eps) { vmax = 1.f; } else if (eps * sin__[i__ - 1] > stmp[i__ - 1]) { vmax = 1.f / eps; } else if (sin__[i__ - 1] > stmp[i__ - 1]) { vmax = sin__[i__ - 1] / stmp[i__ - 1]; } else if (sin__[i__ - 1] < eps * stmp[i__ - 1]) { vmax = 1.f / eps; } else if (sin__[i__ - 1] < stmp[i__ - 1]) { vmax = stmp[i__ - 1] / sin__[i__ - 1]; } else { vmax = 1.f; } if (vmax > rmax[3]) { rmax[3] = vmax; if (ninfo[3] == 0) { lmax[3] = *knt; } } /* L110: */ } /* Compare condition numbers for eigenvectors */ /* without taking their condition numbers into account */ i__1 = n; for (i__ = 1; i__ <= i__1; ++i__) { if (sepin[i__ - 1] <= v && septmp[i__ - 1] <= v) { vmax = 1.f; } else if (eps * sepin[i__ - 1] > septmp[i__ - 1]) { vmax = 1.f / eps; } else if (sepin[i__ - 1] > septmp[i__ - 1]) { vmax = sepin[i__ - 1] / septmp[i__ - 1]; } else if (sepin[i__ - 1] < eps * septmp[i__ - 1]) { vmax = 1.f / eps; } else if (sepin[i__ - 1] < septmp[i__ - 1]) { vmax = septmp[i__ - 1] / sepin[i__ - 1]; } else { vmax = 1.f; } if (vmax > rmax[3]) { rmax[3] = vmax; if (ninfo[3] == 0) { lmax[3] = *knt; } } /* L120: */ } /* Compute eigenvalue condition numbers only and compare */ vmax = 0.f; dum[0] = -1.f; scopy_(&n, dum, &c__0, stmp, &c__1); scopy_(&n, dum, &c__0, septmp, &c__1); strsna_("Eigcond", "All", select, &n, t, &c__20, le, &c__20, re, & c__20, stmp, septmp, &n, &m, work, &n, iwork, &info); if (info != 0) { lmax[3] = *knt; ++ninfo[3]; goto L240; } i__1 = n; for (i__ = 1; i__ <= i__1; ++i__) { if (stmp[i__ - 1] != s[i__ - 1]) { vmax = 1.f / eps; } if (septmp[i__ - 1] != dum[0]) { vmax = 1.f / eps; } /* L130: */ } /* Compute eigenvector condition numbers only and compare */ scopy_(&n, dum, &c__0, stmp, &c__1); scopy_(&n, dum, &c__0, septmp, &c__1); strsna_("Veccond", "All", select, &n, t, &c__20, le, &c__20, re, & c__20, stmp, septmp, &n, &m, work, &n, iwork, &info); if (info != 0) { lmax[3] = *knt; ++ninfo[3]; goto L240; } i__1 = n; for (i__ = 1; i__ <= i__1; ++i__) { if (stmp[i__ - 1] != dum[0]) { vmax = 1.f / eps; } if (septmp[i__ - 1] != sep[i__ - 1]) { vmax = 1.f / eps; } /* L140: */ } /* Compute all condition numbers using SELECT and compare */ i__1 = n; for (i__ = 1; i__ <= i__1; ++i__) { select[i__ - 1] = TRUE_; /* L150: */ } scopy_(&n, dum, &c__0, stmp, &c__1); scopy_(&n, dum, &c__0, septmp, &c__1); strsna_("Bothcond", "Some", select, &n, t, &c__20, le, &c__20, re, & c__20, stmp, septmp, &n, &m, work, &n, iwork, &info); if (info != 0) { lmax[3] = *knt; ++ninfo[3]; goto L240; } i__1 = n; for (i__ = 1; i__ <= i__1; ++i__) { if (septmp[i__ - 1] != sep[i__ - 1]) { vmax = 1.f / eps; } if (stmp[i__ - 1] != s[i__ - 1]) { vmax = 1.f / eps; } /* L160: */ } /* Compute eigenvalue condition numbers using SELECT and compare */ scopy_(&n, dum, &c__0, stmp, &c__1); scopy_(&n, dum, &c__0, septmp, &c__1); strsna_("Eigcond", "Some", select, &n, t, &c__20, le, &c__20, re, & c__20, stmp, septmp, &n, &m, work, &n, iwork, &info); if (info != 0) { lmax[3] = *knt; ++ninfo[3]; goto L240; } i__1 = n; for (i__ = 1; i__ <= i__1; ++i__) { if (stmp[i__ - 1] != s[i__ - 1]) { vmax = 1.f / eps; } if (septmp[i__ - 1] != dum[0]) { vmax = 1.f / eps; } /* L170: */ } /* Compute eigenvector condition numbers using SELECT and compare */ scopy_(&n, dum, &c__0, stmp, &c__1); scopy_(&n, dum, &c__0, septmp, &c__1); strsna_("Veccond", "Some", select, &n, t, &c__20, le, &c__20, re, & c__20, stmp, septmp, &n, &m, work, &n, iwork, &info); if (info != 0) { lmax[3] = *knt; ++ninfo[3]; goto L240; } i__1 = n; for (i__ = 1; i__ <= i__1; ++i__) { if (stmp[i__ - 1] != dum[0]) { vmax = 1.f / eps; } if (septmp[i__ - 1] != sep[i__ - 1]) { vmax = 1.f / eps; } /* L180: */ } if (vmax > rmax[1]) { rmax[1] = vmax; if (ninfo[1] == 0) { lmax[1] = *knt; } } /* Select first real and first complex eigenvalue */ if (wi[0] == 0.f) { lcmp[0] = 1; ifnd = 0; i__1 = n; for (i__ = 2; i__ <= i__1; ++i__) { if (ifnd == 1 || wi[i__ - 1] == 0.f) { select[i__ - 1] = FALSE_; } else { ifnd = 1; lcmp[1] = i__; lcmp[2] = i__ + 1; scopy_(&n, &re[i__ * 20 - 20], &c__1, &re[20], &c__1); scopy_(&n, &re[(i__ + 1) * 20 - 20], &c__1, &re[40], & c__1); scopy_(&n, &le[i__ * 20 - 20], &c__1, &le[20], &c__1); scopy_(&n, &le[(i__ + 1) * 20 - 20], &c__1, &le[40], & c__1); } /* L190: */ } if (ifnd == 0) { icmp = 1; } else { icmp = 3; } } else { lcmp[0] = 1; lcmp[1] = 2; ifnd = 0; i__1 = n; for (i__ = 3; i__ <= i__1; ++i__) { if (ifnd == 1 || wi[i__ - 1] != 0.f) { select[i__ - 1] = FALSE_; } else { lcmp[2] = i__; ifnd = 1; scopy_(&n, &re[i__ * 20 - 20], &c__1, &re[40], &c__1); scopy_(&n, &le[i__ * 20 - 20], &c__1, &le[40], &c__1); } /* L200: */ } if (ifnd == 0) { icmp = 2; } else { icmp = 3; } } /* Compute all selected condition numbers */ scopy_(&icmp, dum, &c__0, stmp, &c__1); scopy_(&icmp, dum, &c__0, septmp, &c__1); strsna_("Bothcond", "Some", select, &n, t, &c__20, le, &c__20, re, & c__20, stmp, septmp, &n, &m, work, &n, iwork, &info); if (info != 0) { lmax[3] = *knt; ++ninfo[3]; goto L240; } i__1 = icmp; for (i__ = 1; i__ <= i__1; ++i__) { j = lcmp[i__ - 1]; if (septmp[i__ - 1] != sep[j - 1]) { vmax = 1.f / eps; } if (stmp[i__ - 1] != s[j - 1]) { vmax = 1.f / eps; } /* L210: */ } /* Compute selected eigenvalue condition numbers */ scopy_(&icmp, dum, &c__0, stmp, &c__1); scopy_(&icmp, dum, &c__0, septmp, &c__1); strsna_("Eigcond", "Some", select, &n, t, &c__20, le, &c__20, re, & c__20, stmp, septmp, &n, &m, work, &n, iwork, &info); if (info != 0) { lmax[3] = *knt; ++ninfo[3]; goto L240; } i__1 = icmp; for (i__ = 1; i__ <= i__1; ++i__) { j = lcmp[i__ - 1]; if (stmp[i__ - 1] != s[j - 1]) { vmax = 1.f / eps; } if (septmp[i__ - 1] != dum[0]) { vmax = 1.f / eps; } /* L220: */ } /* Compute selected eigenvector condition numbers */ scopy_(&icmp, dum, &c__0, stmp, &c__1); scopy_(&icmp, dum, &c__0, septmp, &c__1); strsna_("Veccond", "Some", select, &n, t, &c__20, le, &c__20, re, & c__20, stmp, septmp, &n, &m, work, &n, iwork, &info); if (info != 0) { lmax[3] = *knt; ++ninfo[3]; goto L240; } i__1 = icmp; for (i__ = 1; i__ <= i__1; ++i__) { j = lcmp[i__ - 1]; if (stmp[i__ - 1] != dum[0]) { vmax = 1.f / eps; } if (septmp[i__ - 1] != sep[j - 1]) { vmax = 1.f / eps; } /* L230: */ } if (vmax > rmax[1]) { rmax[1] = vmax; if (ninfo[1] == 0) { lmax[1] = *knt; } } L240: ; } goto L10; /* End of SGET37 */ } /* sget37_ */
/* Subroutine */ int sgeevx_(char *balanc, char *jobvl, char *jobvr, char * sense, integer *n, real *a, integer *lda, real *wr, real *wi, real * vl, integer *ldvl, real *vr, integer *ldvr, integer *ilo, integer * ihi, real *scale, real *abnrm, real *rconde, real *rcondv, real *work, integer *lwork, integer *iwork, integer *info) { /* System generated locals */ integer a_dim1, a_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, i__2, i__3; real r__1, r__2; /* Builtin functions */ double sqrt(doublereal); /* Local variables */ integer i__, k; real r__, cs, sn; char job[1]; real scl, dum[1], eps; char side[1]; real anrm; integer ierr, itau, iwrk, nout; extern /* Subroutine */ int srot_(integer *, real *, integer *, real *, integer *, real *, real *); extern doublereal snrm2_(integer *, real *, integer *); integer icond; extern logical lsame_(char *, char *); extern /* Subroutine */ int sscal_(integer *, real *, real *, integer *); extern doublereal slapy2_(real *, real *); extern /* Subroutine */ int slabad_(real *, real *); logical scalea; real cscale; extern /* Subroutine */ int sgebak_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, integer *), sgebal_(char *, integer *, real *, integer *, integer *, integer *, real *, integer *); extern doublereal slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *); extern /* Subroutine */ int sgehrd_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *), xerbla_(char *, integer *); extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *); logical select[1]; real bignum; extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *); extern integer isamax_(integer *, real *, integer *); extern /* Subroutine */ int slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *), slartg_(real *, real *, real *, real *, real *), sorghr_(integer *, integer *, integer *, real *, integer *, real *, real *, integer *, integer *), shseqr_( char *, char *, integer *, integer *, integer *, real *, integer * , real *, real *, real *, integer *, real *, integer *, integer *), strevc_(char *, char *, logical *, integer *, real *, integer *, real *, integer *, real *, integer *, integer * , integer *, real *, integer *); integer minwrk, maxwrk; extern /* Subroutine */ int strsna_(char *, char *, logical *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *, integer *); logical wantvl, wntsnb; integer hswork; logical wntsne; real smlnum; logical lquery, wantvr, wntsnn, wntsnv; /* -- LAPACK driver routine (version 3.1) -- */ /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */ /* November 2006 */ /* .. Scalar Arguments .. */ /* .. */ /* .. Array Arguments .. */ /* .. */ /* Purpose */ /* ======= */ /* SGEEVX computes for an N-by-N real nonsymmetric matrix A, the */ /* eigenvalues and, optionally, the left and/or right eigenvectors. */ /* Optionally also, it computes a balancing transformation to improve */ /* the conditioning of the eigenvalues and eigenvectors (ILO, IHI, */ /* SCALE, and ABNRM), reciprocal condition numbers for the eigenvalues */ /* (RCONDE), and reciprocal condition numbers for the right */ /* eigenvectors (RCONDV). */ /* The right eigenvector v(j) of A satisfies */ /* A * v(j) = lambda(j) * v(j) */ /* where lambda(j) is its eigenvalue. */ /* The left eigenvector u(j) of A satisfies */ /* u(j)**H * A = lambda(j) * u(j)**H */ /* where u(j)**H denotes the conjugate transpose of u(j). */ /* The computed eigenvectors are normalized to have Euclidean norm */ /* equal to 1 and largest component real. */ /* Balancing a matrix means permuting the rows and columns to make it */ /* more nearly upper triangular, and applying a diagonal similarity */ /* transformation D * A * D**(-1), where D is a diagonal matrix, to */ /* make its rows and columns closer in norm and the condition numbers */ /* of its eigenvalues and eigenvectors smaller. 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.10.2 of the LAPACK */ /* Users' Guide. */ /* Arguments */ /* ========= */ /* BALANC (input) CHARACTER*1 */ /* Indicates how the input matrix should be diagonally scaled */ /* and/or permuted to improve the conditioning of its */ /* eigenvalues. */ /* = 'N': Do not diagonally scale or permute; */ /* = 'P': Perform permutations to make the matrix more nearly */ /* upper triangular. Do not diagonally scale; */ /* = 'S': Diagonally scale the matrix, i.e. replace A by */ /* D*A*D**(-1), where D is a diagonal matrix chosen */ /* to make the rows and columns of A more equal in */ /* norm. Do not permute; */ /* = 'B': Both diagonally scale and permute A. */ /* Computed reciprocal condition numbers will be for the matrix */ /* after balancing and/or permuting. Permuting does not change */ /* condition numbers (in exact arithmetic), but balancing does. */ /* JOBVL (input) CHARACTER*1 */ /* = 'N': left eigenvectors of A are not computed; */ /* = 'V': left eigenvectors of A are computed. */ /* If SENSE = 'E' or 'B', JOBVL must = 'V'. */ /* JOBVR (input) CHARACTER*1 */ /* = 'N': right eigenvectors of A are not computed; */ /* = 'V': right eigenvectors of A are computed. */ /* If SENSE = 'E' or 'B', JOBVR must = 'V'. */ /* SENSE (input) CHARACTER*1 */ /* Determines which reciprocal condition numbers are computed. */ /* = 'N': None are computed; */ /* = 'E': Computed for eigenvalues only; */ /* = 'V': Computed for right eigenvectors only; */ /* = 'B': Computed for eigenvalues and right eigenvectors. */ /* If SENSE = 'E' or 'B', both left and right eigenvectors */ /* must also be computed (JOBVL = 'V' and JOBVR = 'V'). */ /* N (input) INTEGER */ /* The order of the matrix A. N >= 0. */ /* A (input/output) REAL array, dimension (LDA,N) */ /* On entry, the N-by-N matrix A. */ /* On exit, A has been overwritten. If JOBVL = 'V' or */ /* JOBVR = 'V', A contains the real Schur form of the balanced */ /* version of the input matrix A. */ /* LDA (input) INTEGER */ /* The leading dimension of the array A. LDA >= max(1,N). */ /* WR (output) REAL array, dimension (N) */ /* WI (output) REAL array, dimension (N) */ /* WR and WI contain the real and imaginary parts, */ /* respectively, of the computed eigenvalues. Complex */ /* conjugate pairs of eigenvalues will appear consecutively */ /* with the eigenvalue having the positive imaginary part */ /* first. */ /* 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 JOBVL = 'N', VL is not referenced. */ /* If the j-th eigenvalue is real, then u(j) = VL(:,j), */ /* the j-th column of VL. */ /* If the j-th and (j+1)-st 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). */ /* LDVL (input) INTEGER */ /* The leading dimension of the array VL. LDVL >= 1; 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 JOBVR = 'N', VR is not referenced. */ /* If the j-th eigenvalue is real, then v(j) = VR(:,j), */ /* the j-th column of VR. */ /* If the j-th and (j+1)-st 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). */ /* LDVR (input) INTEGER */ /* The leading dimension of the array VR. LDVR >= 1, and if */ /* JOBVR = 'V', LDVR >= N. */ /* ILO (output) INTEGER */ /* IHI (output) INTEGER */ /* ILO and IHI are integer values determined when A was */ /* balanced. The balanced A(i,j) = 0 if I > J and */ /* J = 1,...,ILO-1 or I = IHI+1,...,N. */ /* SCALE (output) REAL array, dimension (N) */ /* Details of the permutations and scaling factors applied */ /* when balancing A. If P(j) is the index of the row and column */ /* interchanged with row and column j, and D(j) is the scaling */ /* factor applied to row and column j, then */ /* SCALE(J) = P(J), for J = 1,...,ILO-1 */ /* = D(J), for J = ILO,...,IHI */ /* = P(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 (the maximum */ /* of the sum of absolute values of elements of any column). */ /* RCONDE (output) REAL array, dimension (N) */ /* RCONDE(j) is the reciprocal condition number of the j-th */ /* eigenvalue. */ /* RCONDV (output) REAL array, dimension (N) */ /* RCONDV(j) is the reciprocal condition number of the j-th */ /* right eigenvector. */ /* 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. If SENSE = 'N' or 'E', */ /* LWORK >= max(1,2*N), and if JOBVL = 'V' or JOBVR = 'V', */ /* LWORK >= 3*N. If SENSE = 'V' or 'B', LWORK >= N*(N+6). */ /* For good performance, LWORK must generally be larger. */ /* 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 (2*N-2) */ /* If SENSE = 'N' or 'E', not referenced. */ /* INFO (output) INTEGER */ /* = 0: successful exit */ /* < 0: if INFO = -i, the i-th argument had an illegal value. */ /* > 0: if INFO = i, the QR algorithm failed to compute all the */ /* eigenvalues, and no eigenvectors or condition numbers */ /* have been computed; elements 1:ILO-1 and i+1:N of WR */ /* and WI contain eigenvalues which have converged. */ /* ===================================================================== */ /* .. Parameters .. */ /* .. */ /* .. Local Scalars .. */ /* .. */ /* .. Local Arrays .. */ /* .. */ /* .. External Subroutines .. */ /* .. */ /* .. External Functions .. */ /* .. */ /* .. Intrinsic Functions .. */ /* .. */ /* .. Executable Statements .. */ /* Test the input arguments */ /* Parameter adjustments */ a_dim1 = *lda; a_offset = 1 + a_dim1; a -= a_offset; --wr; --wi; vl_dim1 = *ldvl; vl_offset = 1 + vl_dim1; vl -= vl_offset; vr_dim1 = *ldvr; vr_offset = 1 + vr_dim1; vr -= vr_offset; --scale; --rconde; --rcondv; --work; --iwork; /* Function Body */ *info = 0; lquery = *lwork == -1; wantvl = lsame_(jobvl, "V"); wantvr = lsame_(jobvr, "V"); wntsnn = lsame_(sense, "N"); wntsne = lsame_(sense, "E"); wntsnv = lsame_(sense, "V"); wntsnb = lsame_(sense, "B"); if (! (lsame_(balanc, "N") || lsame_(balanc, "S") || lsame_(balanc, "P") || lsame_(balanc, "B"))) { *info = -1; } else if (! wantvl && ! lsame_(jobvl, "N")) { *info = -2; } else if (! wantvr && ! lsame_(jobvr, "N")) { *info = -3; } else if (! (wntsnn || wntsne || wntsnb || wntsnv) || (wntsne || wntsnb) && ! (wantvl && wantvr)) { *info = -4; } else if (*n < 0) { *info = -5; } else if (*lda < max(1,*n)) { *info = -7; } else if (*ldvl < 1 || wantvl && *ldvl < *n) { *info = -11; } else if (*ldvr < 1 || wantvr && *ldvr < *n) { *info = -13; } /* 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. */ /* HSWORK refers to the workspace preferred by SHSEQR, as */ /* calculated below. HSWORK is computed assuming ILO=1 and IHI=N, */ /* the worst case.) */ if (*info == 0) { if (*n == 0) { minwrk = 1; maxwrk = 1; } else { maxwrk = *n + *n * ilaenv_(&c__1, "SGEHRD", " ", n, &c__1, n, & c__0); if (wantvl) { shseqr_("S", "V", n, &c__1, n, &a[a_offset], lda, &wr[1], &wi[ 1], &vl[vl_offset], ldvl, &work[1], &c_n1, info); } else if (wantvr) { shseqr_("S", "V", n, &c__1, n, &a[a_offset], lda, &wr[1], &wi[ 1], &vr[vr_offset], ldvr, &work[1], &c_n1, info); } else { if (wntsnn) { shseqr_("E", "N", n, &c__1, n, &a[a_offset], lda, &wr[1], &wi[1], &vr[vr_offset], ldvr, &work[1], &c_n1, info); } else { shseqr_("S", "N", n, &c__1, n, &a[a_offset], lda, &wr[1], &wi[1], &vr[vr_offset], ldvr, &work[1], &c_n1, info); } } hswork = work[1]; if (! wantvl && ! wantvr) { minwrk = *n << 1; if (! wntsnn) { /* Computing MAX */ i__1 = minwrk, i__2 = *n * *n + *n * 6; minwrk = max(i__1,i__2); } maxwrk = max(maxwrk,hswork); if (! wntsnn) { /* Computing MAX */ i__1 = maxwrk, i__2 = *n * *n + *n * 6; maxwrk = max(i__1,i__2); } } else { minwrk = *n * 3; if (! wntsnn && ! wntsne) { /* Computing MAX */ i__1 = minwrk, i__2 = *n * *n + *n * 6; minwrk = max(i__1,i__2); } maxwrk = max(maxwrk,hswork); /* Computing MAX */ i__1 = maxwrk, i__2 = *n + (*n - 1) * ilaenv_(&c__1, "SORGHR", " ", n, &c__1, n, &c_n1); maxwrk = max(i__1,i__2); if (! wntsnn && ! wntsne) { /* Computing MAX */ i__1 = maxwrk, i__2 = *n * *n + *n * 6; maxwrk = max(i__1,i__2); } /* Computing MAX */ i__1 = maxwrk, i__2 = *n * 3; maxwrk = max(i__1,i__2); } maxwrk = max(maxwrk,minwrk); } work[1] = (real) maxwrk; if (*lwork < minwrk && ! lquery) { *info = -21; } } if (*info != 0) { i__1 = -(*info); xerbla_("SGEEVX", &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] */ icond = 0; anrm = slange_("M", n, n, &a[a_offset], lda, dum); scalea = FALSE_; if (anrm > 0.f && anrm < smlnum) { scalea = TRUE_; cscale = smlnum; } else if (anrm > bignum) { scalea = TRUE_; cscale = bignum; } if (scalea) { slascl_("G", &c__0, &c__0, &anrm, &cscale, n, n, &a[a_offset], lda, & ierr); } /* Balance the matrix and compute ABNRM */ sgebal_(balanc, n, &a[a_offset], lda, ilo, ihi, &scale[1], &ierr); *abnrm = slange_("1", n, n, &a[a_offset], lda, dum); if (scalea) { dum[0] = *abnrm; slascl_("G", &c__0, &c__0, &cscale, &anrm, &c__1, &c__1, dum, &c__1, & ierr); *abnrm = dum[0]; } /* Reduce to upper Hessenberg form */ /* (Workspace: need 2*N, prefer N+N*NB) */ itau = 1; iwrk = itau + *n; i__1 = *lwork - iwrk + 1; sgehrd_(n, ilo, ihi, &a[a_offset], lda, &work[itau], &work[iwrk], &i__1, & ierr); if (wantvl) { /* Want left eigenvectors */ /* Copy Householder vectors to VL */ *(unsigned char *)side = 'L'; slacpy_("L", n, n, &a[a_offset], lda, &vl[vl_offset], ldvl) ; /* Generate orthogonal matrix in VL */ /* (Workspace: need 2*N-1, prefer N+(N-1)*NB) */ i__1 = *lwork - iwrk + 1; sorghr_(n, ilo, ihi, &vl[vl_offset], ldvl, &work[itau], &work[iwrk], & i__1, &ierr); /* Perform QR iteration, accumulating Schur vectors in VL */ /* (Workspace: need 1, prefer HSWORK (see comments) ) */ iwrk = itau; i__1 = *lwork - iwrk + 1; shseqr_("S", "V", n, ilo, ihi, &a[a_offset], lda, &wr[1], &wi[1], &vl[ vl_offset], ldvl, &work[iwrk], &i__1, info); if (wantvr) { /* Want left and right eigenvectors */ /* Copy Schur vectors to VR */ *(unsigned char *)side = 'B'; slacpy_("F", n, n, &vl[vl_offset], ldvl, &vr[vr_offset], ldvr); } } else if (wantvr) { /* Want right eigenvectors */ /* Copy Householder vectors to VR */ *(unsigned char *)side = 'R'; slacpy_("L", n, n, &a[a_offset], lda, &vr[vr_offset], ldvr) ; /* Generate orthogonal matrix in VR */ /* (Workspace: need 2*N-1, prefer N+(N-1)*NB) */ i__1 = *lwork - iwrk + 1; sorghr_(n, ilo, ihi, &vr[vr_offset], ldvr, &work[itau], &work[iwrk], & i__1, &ierr); /* Perform QR iteration, accumulating Schur vectors in VR */ /* (Workspace: need 1, prefer HSWORK (see comments) ) */ iwrk = itau; i__1 = *lwork - iwrk + 1; shseqr_("S", "V", n, ilo, ihi, &a[a_offset], lda, &wr[1], &wi[1], &vr[ vr_offset], ldvr, &work[iwrk], &i__1, info); } else { /* Compute eigenvalues only */ /* If condition numbers desired, compute Schur form */ if (wntsnn) { *(unsigned char *)job = 'E'; } else { *(unsigned char *)job = 'S'; } /* (Workspace: need 1, prefer HSWORK (see comments) ) */ iwrk = itau; i__1 = *lwork - iwrk + 1; shseqr_(job, "N", n, ilo, ihi, &a[a_offset], lda, &wr[1], &wi[1], &vr[ vr_offset], ldvr, &work[iwrk], &i__1, info); } /* If INFO > 0 from SHSEQR, then quit */ if (*info > 0) { goto L50; } if (wantvl || wantvr) { /* Compute left and/or right eigenvectors */ /* (Workspace: need 3*N) */ strevc_(side, "B", select, n, &a[a_offset], lda, &vl[vl_offset], ldvl, &vr[vr_offset], ldvr, n, &nout, &work[iwrk], &ierr); } /* Compute condition numbers if desired */ /* (Workspace: need N*N+6*N unless SENSE = 'E') */ if (! wntsnn) { strsna_(sense, "A", select, n, &a[a_offset], lda, &vl[vl_offset], ldvl, &vr[vr_offset], ldvr, &rconde[1], &rcondv[1], n, &nout, &work[iwrk], n, &iwork[1], &icond); } if (wantvl) { /* Undo balancing of left eigenvectors */ sgebak_(balanc, "L", n, ilo, ihi, &scale[1], n, &vl[vl_offset], ldvl, &ierr); /* Normalize left eigenvectors and make largest component real */ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { if (wi[i__] == 0.f) { scl = 1.f / snrm2_(n, &vl[i__ * vl_dim1 + 1], &c__1); sscal_(n, &scl, &vl[i__ * vl_dim1 + 1], &c__1); } else if (wi[i__] > 0.f) { r__1 = snrm2_(n, &vl[i__ * vl_dim1 + 1], &c__1); r__2 = snrm2_(n, &vl[(i__ + 1) * vl_dim1 + 1], &c__1); scl = 1.f / slapy2_(&r__1, &r__2); sscal_(n, &scl, &vl[i__ * vl_dim1 + 1], &c__1); sscal_(n, &scl, &vl[(i__ + 1) * vl_dim1 + 1], &c__1); i__2 = *n; for (k = 1; k <= i__2; ++k) { /* Computing 2nd power */ r__1 = vl[k + i__ * vl_dim1]; /* Computing 2nd power */ r__2 = vl[k + (i__ + 1) * vl_dim1]; work[k] = r__1 * r__1 + r__2 * r__2; /* L10: */ } k = isamax_(n, &work[1], &c__1); slartg_(&vl[k + i__ * vl_dim1], &vl[k + (i__ + 1) * vl_dim1], &cs, &sn, &r__); srot_(n, &vl[i__ * vl_dim1 + 1], &c__1, &vl[(i__ + 1) * vl_dim1 + 1], &c__1, &cs, &sn); vl[k + (i__ + 1) * vl_dim1] = 0.f; } /* L20: */ } } if (wantvr) { /* Undo balancing of right eigenvectors */ sgebak_(balanc, "R", n, ilo, ihi, &scale[1], n, &vr[vr_offset], ldvr, &ierr); /* Normalize right eigenvectors and make largest component real */ i__1 = *n; for (i__ = 1; i__ <= i__1; ++i__) { if (wi[i__] == 0.f) { scl = 1.f / snrm2_(n, &vr[i__ * vr_dim1 + 1], &c__1); sscal_(n, &scl, &vr[i__ * vr_dim1 + 1], &c__1); } else if (wi[i__] > 0.f) { r__1 = snrm2_(n, &vr[i__ * vr_dim1 + 1], &c__1); r__2 = snrm2_(n, &vr[(i__ + 1) * vr_dim1 + 1], &c__1); scl = 1.f / slapy2_(&r__1, &r__2); sscal_(n, &scl, &vr[i__ * vr_dim1 + 1], &c__1); sscal_(n, &scl, &vr[(i__ + 1) * vr_dim1 + 1], &c__1); i__2 = *n; for (k = 1; k <= i__2; ++k) { /* Computing 2nd power */ r__1 = vr[k + i__ * vr_dim1]; /* Computing 2nd power */ r__2 = vr[k + (i__ + 1) * vr_dim1]; work[k] = r__1 * r__1 + r__2 * r__2; /* L30: */ } k = isamax_(n, &work[1], &c__1); slartg_(&vr[k + i__ * vr_dim1], &vr[k + (i__ + 1) * vr_dim1], &cs, &sn, &r__); srot_(n, &vr[i__ * vr_dim1 + 1], &c__1, &vr[(i__ + 1) * vr_dim1 + 1], &c__1, &cs, &sn); vr[k + (i__ + 1) * vr_dim1] = 0.f; } /* L40: */ } } /* Undo scaling if necessary */ L50: if (scalea) { i__1 = *n - *info; /* Computing MAX */ i__3 = *n - *info; i__2 = max(i__3,1); slascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wr[*info + 1], &i__2, &ierr); i__1 = *n - *info; /* Computing MAX */ i__3 = *n - *info; i__2 = max(i__3,1); slascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wi[*info + 1], &i__2, &ierr); if (*info == 0) { if ((wntsnv || wntsnb) && icond == 0) { slascl_("G", &c__0, &c__0, &cscale, &anrm, n, &c__1, &rcondv[ 1], n, &ierr); } } else { i__1 = *ilo - 1; slascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wr[1], n, &ierr); i__1 = *ilo - 1; slascl_("G", &c__0, &c__0, &cscale, &anrm, &i__1, &c__1, &wi[1], n, &ierr); } } work[1] = (real) maxwrk; return 0; /* End of SGEEVX */ } /* sgeevx_ */
/* Subroutine */ int serrec_(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 ex\002,\002its ***\002)"; /* Builtin functions Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); /* Local variables */ static integer info, ifst, ilst; static real work[4], a[16] /* was [4][4] */, b[16] /* was [4][4] */, c__[ 16] /* was [4][4] */; static integer i__, j, m; static real s[4], scale; static integer iwork[4]; static real wi[4]; static integer nt; static real wr[4]; extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical *, logical *), strexc_(char *, integer *, real *, integer *, real *, integer *, integer *, integer *, real *, integer *), strsna_(char *, char *, logical *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *, integer *), strsen_(char *, char *, logical *, integer *, real *, integer *, real *, integer *, real *, real *, integer *, real *, real *, real *, integer *, integer *, integer *, integer * ), strsyl_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer * , real *, integer *); static logical sel[4]; static real sep[4]; /* Fortran I/O blocks */ static cilist io___19 = { 0, 0, 0, fmt_9999, 0 }; static cilist io___20 = { 0, 0, 0, fmt_9998, 0 }; #define a_ref(a_1,a_2) a[(a_2)*4 + a_1 - 5] #define b_ref(a_1,a_2) b[(a_2)*4 + a_1 - 5] /* -- LAPACK test routine (version 3.0) -- Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., Courant Institute, Argonne National Lab, and Rice University June 30, 1999 Purpose ======= SERREC tests the error exits for the routines for eigen- condition estimation for REAL matrices: STRSYL, STREXC, STRSNA and STRSEN. Arguments ========= PATH (input) CHARACTER*3 The LAPACK path name for the routines to be tested. NUNIT (input) INTEGER The unit number for output. ===================================================================== */ infoc_1.nout = *nunit; infoc_1.ok = TRUE_; nt = 0; /* Initialize A, B and SEL */ for (j = 1; j <= 4; ++j) { for (i__ = 1; i__ <= 4; ++i__) { a_ref(i__, j) = 0.f; b_ref(i__, j) = 0.f; /* L10: */ } /* L20: */ } for (i__ = 1; i__ <= 4; ++i__) { a_ref(i__, i__) = 1.f; sel[i__ - 1] = TRUE_; /* L30: */ } /* Test STRSYL */ s_copy(srnamc_1.srnamt, "STRSYL", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; strsyl_("X", "N", &c__1, &c__0, &c__0, a, &c__1, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; strsyl_("N", "X", &c__1, &c__0, &c__0, a, &c__1, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 3; strsyl_("N", "N", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; strsyl_("N", "N", &c__1, &c_n1, &c__0, a, &c__1, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 5; strsyl_("N", "N", &c__1, &c__0, &c_n1, a, &c__1, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; strsyl_("N", "N", &c__1, &c__2, &c__0, a, &c__1, b, &c__1, c__, &c__2, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 9; strsyl_("N", "N", &c__1, &c__0, &c__2, a, &c__1, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 11; strsyl_("N", "N", &c__1, &c__2, &c__0, a, &c__2, b, &c__1, c__, &c__1, & scale, &info); chkxer_("STRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 8; /* Test STREXC */ s_copy(srnamc_1.srnamt, "STREXC", (ftnlen)6, (ftnlen)6); ifst = 1; ilst = 1; infoc_1.infot = 1; strexc_("X", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; strexc_("N", &c__0, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; ilst = 2; strexc_("N", &c__2, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; strexc_("V", &c__2, a, &c__2, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; ifst = 0; ilst = 1; strexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 7; ifst = 2; strexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; ifst = 1; ilst = 0; strexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; ilst = 2; strexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, work, &info); chkxer_("STREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 8; /* Test STRSNA */ s_copy(srnamc_1.srnamt, "STRSNA", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; strsna_("X", "A", sel, &c__0, a, &c__1, b, &c__1, c__, &c__1, s, sep, & c__1, &m, work, &c__1, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; strsna_("B", "X", sel, &c__0, a, &c__1, b, &c__1, c__, &c__1, s, sep, & c__1, &m, work, &c__1, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; strsna_("B", "A", sel, &c_n1, a, &c__1, b, &c__1, c__, &c__1, s, sep, & c__1, &m, work, &c__1, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; strsna_("V", "A", sel, &c__2, a, &c__1, b, &c__1, c__, &c__1, s, sep, & c__2, &m, work, &c__2, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; strsna_("B", "A", sel, &c__2, a, &c__2, b, &c__1, c__, &c__2, s, sep, & c__2, &m, work, &c__2, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 10; strsna_("B", "A", sel, &c__2, a, &c__2, b, &c__2, c__, &c__1, s, sep, & c__2, &m, work, &c__2, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; strsna_("B", "A", sel, &c__1, a, &c__1, b, &c__1, c__, &c__1, s, sep, & c__0, &m, work, &c__1, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 13; strsna_("B", "S", sel, &c__2, a, &c__2, b, &c__2, c__, &c__2, s, sep, & c__1, &m, work, &c__2, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 16; strsna_("B", "A", sel, &c__2, a, &c__2, b, &c__2, c__, &c__2, s, sep, & c__2, &m, work, &c__1, iwork, &info); chkxer_("STRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 9; /* Test STRSEN */ sel[0] = FALSE_; s_copy(srnamc_1.srnamt, "STRSEN", (ftnlen)6, (ftnlen)6); infoc_1.infot = 1; strsen_("X", "N", sel, &c__0, a, &c__1, b, &c__1, wr, wi, &m, s, sep, work, &c__1, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 2; strsen_("N", "X", sel, &c__0, a, &c__1, b, &c__1, wr, wi, &m, s, sep, work, &c__1, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 4; strsen_("N", "N", sel, &c_n1, a, &c__1, b, &c__1, wr, wi, &m, s, sep, work, &c__1, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 6; strsen_("N", "N", sel, &c__2, a, &c__1, b, &c__1, wr, wi, &m, s, sep, work, &c__2, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 8; strsen_("N", "V", sel, &c__2, a, &c__2, b, &c__1, wr, wi, &m, s, sep, work, &c__1, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; strsen_("N", "V", sel, &c__2, a, &c__2, b, &c__2, wr, wi, &m, s, sep, work, &c__0, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; strsen_("E", "V", sel, &c__3, a, &c__3, b, &c__3, wr, wi, &m, s, sep, work, &c__1, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 15; strsen_("V", "V", sel, &c__3, a, &c__3, b, &c__3, wr, wi, &m, s, sep, work, &c__3, iwork, &c__2, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 17; strsen_("E", "V", sel, &c__2, a, &c__2, b, &c__2, wr, wi, &m, s, sep, work, &c__1, iwork, &c__0, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); infoc_1.infot = 17; strsen_("V", "V", sel, &c__3, a, &c__3, b, &c__3, wr, wi, &m, s, sep, work, &c__4, iwork, &c__1, &info); chkxer_("STRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, & infoc_1.ok); nt += 10; /* Print a summary line. */ if (infoc_1.ok) { io___19.ciunit = infoc_1.nout; s_wsfe(&io___19); do_fio(&c__1, path, (ftnlen)3); do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer)); e_wsfe(); } else { io___20.ciunit = infoc_1.nout; s_wsfe(&io___20); do_fio(&c__1, path, (ftnlen)3); e_wsfe(); } return 0; /* End of SERREC */ } /* serrec_ */