Exemple #1
0
/* Subroutine */ int zerrec_(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)";

    /* System generated locals */
    integer i__1;

    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);

    /* Local variables */
    doublecomplex a[16]	/* was [4][4] */, b[16]	/* was [4][4] */, c__[16]	
	    /* was [4][4] */;
    integer i__, j, m;
    doublereal s[4];
    doublecomplex x[4];
    integer nt;
    doublereal rw[24];
    logical sel[4];
    doublereal sep[4];
    integer info, ifst, ilst;
    doublecomplex work[24];
    doublereal scale;
    extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical 
	    *, logical *), ztrexc_(char *, integer *, doublecomplex *, 
	     integer *, doublecomplex *, integer *, integer *, integer *, 
	    integer *), ztrsna_(char *, char *, logical *, integer *, 
	    doublecomplex *, integer *, doublecomplex *, integer *, 
	    doublecomplex *, integer *, doublereal *, doublereal *, integer *, 
	     integer *, doublecomplex *, integer *, doublereal *, integer *), ztrsen_(char *, char *, logical *, integer *, 
	    doublecomplex *, integer *, doublecomplex *, integer *, 
	    doublecomplex *, integer *, doublereal *, doublereal *, 
	    doublecomplex *, integer *, integer *), ztrsyl_(
	    char *, char *, integer *, integer *, integer *, doublecomplex *, 
	    integer *, doublecomplex *, integer *, doublecomplex *, integer *, 
	     doublereal *, integer *);

    /* Fortran I/O blocks */
    static cilist io___18 = { 0, 0, 0, fmt_9999, 0 };
    static cilist io___19 = { 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 */
/*  ======= */

/*  ZERREC tests the error exits for the routines for eigen- condition */
/*  estimation for DOUBLE PRECISION matrices: */
/*     ZTRSYL, CTREXC, CTRSNA and CTRSEN. */

/*  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__) {
	    i__1 = i__ + (j << 2) - 5;
	    a[i__1].r = 0., a[i__1].i = 0.;
	    i__1 = i__ + (j << 2) - 5;
	    b[i__1].r = 0., b[i__1].i = 0.;
/* L10: */
	}
/* L20: */
    }
    for (i__ = 1; i__ <= 4; ++i__) {
	i__1 = i__ + (i__ << 2) - 5;
	a[i__1].r = 1., a[i__1].i = 0.;
	sel[i__ - 1] = TRUE_;
/* L30: */
    }

/*     Test ZTRSYL */

    s_copy(srnamc_1.srnamt, "ZTRSYL", (ftnlen)32, (ftnlen)6);
    infoc_1.infot = 1;
    ztrsyl_("X", "N", &c__1, &c__0, &c__0, a, &c__1, b, &c__1, c__, &c__1, &
	    scale, &info);
    chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 2;
    ztrsyl_("N", "X", &c__1, &c__0, &c__0, a, &c__1, b, &c__1, c__, &c__1, &
	    scale, &info);
    chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 3;
    ztrsyl_("N", "N", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, c__, &c__1, &
	    scale, &info);
    chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 4;
    ztrsyl_("N", "N", &c__1, &c_n1, &c__0, a, &c__1, b, &c__1, c__, &c__1, &
	    scale, &info);
    chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 5;
    ztrsyl_("N", "N", &c__1, &c__0, &c_n1, a, &c__1, b, &c__1, c__, &c__1, &
	    scale, &info);
    chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 7;
    ztrsyl_("N", "N", &c__1, &c__2, &c__0, a, &c__1, b, &c__1, c__, &c__2, &
	    scale, &info);
    chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 9;
    ztrsyl_("N", "N", &c__1, &c__0, &c__2, a, &c__1, b, &c__1, c__, &c__1, &
	    scale, &info);
    chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 11;
    ztrsyl_("N", "N", &c__1, &c__2, &c__0, a, &c__2, b, &c__1, c__, &c__1, &
	    scale, &info);
    chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    nt += 8;

/*     Test ZTREXC */

    s_copy(srnamc_1.srnamt, "ZTREXC", (ftnlen)32, (ftnlen)6);
    ifst = 1;
    ilst = 1;
    infoc_1.infot = 1;
    ztrexc_("X", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, &info);
    chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 7;
    ztrexc_("N", &c__0, a, &c__1, b, &c__1, &ifst, &ilst, &info);
    chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 4;
    ilst = 2;
    ztrexc_("N", &c__2, a, &c__1, b, &c__1, &ifst, &ilst, &info);
    chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 6;
    ztrexc_("V", &c__2, a, &c__2, b, &c__1, &ifst, &ilst, &info);
    chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 7;
    ifst = 0;
    ilst = 1;
    ztrexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, &info);
    chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 7;
    ifst = 2;
    ztrexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, &info);
    chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 8;
    ifst = 1;
    ilst = 0;
    ztrexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, &info);
    chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 8;
    ilst = 2;
    ztrexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, &info);
    chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    nt += 8;

/*     Test ZTRSNA */

    s_copy(srnamc_1.srnamt, "ZTRSNA", (ftnlen)32, (ftnlen)6);
    infoc_1.infot = 1;
    ztrsna_("X", "A", sel, &c__0, a, &c__1, b, &c__1, c__, &c__1, s, sep, &
	    c__1, &m, work, &c__1, rw, &info);
    chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 2;
    ztrsna_("B", "X", sel, &c__0, a, &c__1, b, &c__1, c__, &c__1, s, sep, &
	    c__1, &m, work, &c__1, rw, &info);
    chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 4;
    ztrsna_("B", "A", sel, &c_n1, a, &c__1, b, &c__1, c__, &c__1, s, sep, &
	    c__1, &m, work, &c__1, rw, &info);
    chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 6;
    ztrsna_("V", "A", sel, &c__2, a, &c__1, b, &c__1, c__, &c__1, s, sep, &
	    c__2, &m, work, &c__2, rw, &info);
    chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 8;
    ztrsna_("B", "A", sel, &c__2, a, &c__2, b, &c__1, c__, &c__2, s, sep, &
	    c__2, &m, work, &c__2, rw, &info);
    chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 10;
    ztrsna_("B", "A", sel, &c__2, a, &c__2, b, &c__2, c__, &c__1, s, sep, &
	    c__2, &m, work, &c__2, rw, &info);
    chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 13;
    ztrsna_("B", "A", sel, &c__1, a, &c__1, b, &c__1, c__, &c__1, s, sep, &
	    c__0, &m, work, &c__1, rw, &info);
    chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 13;
    ztrsna_("B", "S", sel, &c__2, a, &c__2, b, &c__2, c__, &c__2, s, sep, &
	    c__1, &m, work, &c__1, rw, &info);
    chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 16;
    ztrsna_("B", "A", sel, &c__2, a, &c__2, b, &c__2, c__, &c__2, s, sep, &
	    c__2, &m, work, &c__1, rw, &info);
    chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    nt += 9;

/*     Test ZTRSEN */

    sel[0] = FALSE_;
    s_copy(srnamc_1.srnamt, "ZTRSEN", (ftnlen)32, (ftnlen)6);
    infoc_1.infot = 1;
    ztrsen_("X", "N", sel, &c__0, a, &c__1, b, &c__1, x, &m, s, sep, work, &
	    c__1, &info);
    chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 2;
    ztrsen_("N", "X", sel, &c__0, a, &c__1, b, &c__1, x, &m, s, sep, work, &
	    c__1, &info);
    chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 4;
    ztrsen_("N", "N", sel, &c_n1, a, &c__1, b, &c__1, x, &m, s, sep, work, &
	    c__1, &info);
    chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 6;
    ztrsen_("N", "N", sel, &c__2, a, &c__1, b, &c__1, x, &m, s, sep, work, &
	    c__2, &info);
    chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 8;
    ztrsen_("N", "V", sel, &c__2, a, &c__2, b, &c__1, x, &m, s, sep, work, &
	    c__1, &info);
    chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 14;
    ztrsen_("N", "V", sel, &c__2, a, &c__2, b, &c__2, x, &m, s, sep, work, &
	    c__0, &info);
    chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 14;
    ztrsen_("E", "V", sel, &c__3, a, &c__3, b, &c__3, x, &m, s, sep, work, &
	    c__1, &info);
    chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 14;
    ztrsen_("V", "V", sel, &c__3, a, &c__3, b, &c__3, x, &m, s, sep, work, &
	    c__3, &info);
    chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    nt += 8;

/*     Print a summary line. */

    if (infoc_1.ok) {
	io___18.ciunit = infoc_1.nout;
	s_wsfe(&io___18);
	do_fio(&c__1, path, (ftnlen)3);
	do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer));
	e_wsfe();
    } else {
	io___19.ciunit = infoc_1.nout;
	s_wsfe(&io___19);
	do_fio(&c__1, path, (ftnlen)3);
	e_wsfe();
    }

    return 0;

/*     End of ZERREC */

} /* zerrec_ */
Exemple #2
0
/* Subroutine */
int ztrsen_(char *job, char *compq, logical *select, integer *n, doublecomplex *t, integer *ldt, doublecomplex *q, integer *ldq, doublecomplex *w, integer *m, doublereal *s, doublereal *sep, doublecomplex *work, integer *lwork, integer *info)
{
    /* System generated locals */
    integer q_dim1, q_offset, t_dim1, t_offset, i__1, i__2, i__3;
    /* Builtin functions */
    double sqrt(doublereal);
    /* Local variables */
    integer k, n1, n2, nn, ks;
    doublereal est;
    integer kase, ierr;
    doublereal scale;
    extern logical lsame_(char *, char *);
    integer isave[3], lwmin;
    logical wantq, wants;
    doublereal rnorm, rwork[1];
    extern /* Subroutine */
    int zlacn2_(integer *, doublecomplex *, doublecomplex *, doublereal *, integer *, integer *), xerbla_( char *, integer *);
    extern doublereal zlange_(char *, integer *, integer *, doublecomplex *, integer *, doublereal *);
    logical wantbh;
    extern /* Subroutine */
    int zlacpy_(char *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *);
    logical wantsp;
    extern /* Subroutine */
    int ztrexc_(char *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, integer *, integer *, integer *);
    logical lquery;
    extern /* Subroutine */
    int ztrsyl_(char *, char *, integer *, integer *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublecomplex *, integer *, doublereal *, integer *);
    /* -- LAPACK computational routine (version 3.4.0) -- */
    /* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
    /* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
    /* November 2011 */
    /* .. Scalar Arguments .. */
    /* .. */
    /* .. Array Arguments .. */
    /* .. */
    /* ===================================================================== */
    /* .. Parameters .. */
    /* .. */
    /* .. Local Scalars .. */
    /* .. */
    /* .. Local Arrays .. */
    /* .. */
    /* .. External Functions .. */
    /* .. */
    /* .. External Subroutines .. */
    /* .. */
    /* .. Intrinsic Functions .. */
    /* .. */
    /* .. Executable Statements .. */
    /* Decode and test the input parameters. */
    /* Parameter adjustments */
    --select;
    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;
    q_dim1 = *ldq;
    q_offset = 1 + q_dim1;
    q -= q_offset;
    --w;
    --work;
    /* Function Body */
    wantbh = lsame_(job, "B");
    wants = lsame_(job, "E") || wantbh;
    wantsp = lsame_(job, "V") || wantbh;
    wantq = lsame_(compq, "V");
    /* Set M to the number of selected eigenvalues. */
    *m = 0;
    i__1 = *n;
    for (k = 1;
            k <= i__1;
            ++k)
    {
        if (select[k])
        {
            ++(*m);
        }
        /* L10: */
    }
    n1 = *m;
    n2 = *n - *m;
    nn = n1 * n2;
    *info = 0;
    lquery = *lwork == -1;
    if (wantsp)
    {
        /* Computing MAX */
        i__1 = 1;
        i__2 = nn << 1; // , expr subst
        lwmin = max(i__1,i__2);
    }
    else if (lsame_(job, "N"))
    {
        lwmin = 1;
    }
    else if (lsame_(job, "E"))
    {
        lwmin = max(1,nn);
    }
    if (! lsame_(job, "N") && ! wants && ! wantsp)
    {
        *info = -1;
    }
    else if (! lsame_(compq, "N") && ! wantq)
    {
        *info = -2;
    }
    else if (*n < 0)
    {
        *info = -4;
    }
    else if (*ldt < max(1,*n))
    {
        *info = -6;
    }
    else if (*ldq < 1 || wantq && *ldq < *n)
    {
        *info = -8;
    }
    else if (*lwork < lwmin && ! lquery)
    {
        *info = -14;
    }
    if (*info == 0)
    {
        work[1].r = (doublereal) lwmin;
        work[1].i = 0.; // , expr subst
    }
    if (*info != 0)
    {
        i__1 = -(*info);
        xerbla_("ZTRSEN", &i__1);
        return 0;
    }
    else if (lquery)
    {
        return 0;
    }
    /* Quick return if possible */
    if (*m == *n || *m == 0)
    {
        if (wants)
        {
            *s = 1.;
        }
        if (wantsp)
        {
            *sep = zlange_("1", n, n, &t[t_offset], ldt, rwork);
        }
        goto L40;
    }
    /* Collect the selected eigenvalues at the top left corner of T. */
    ks = 0;
    i__1 = *n;
    for (k = 1;
            k <= i__1;
            ++k)
    {
        if (select[k])
        {
            ++ks;
            /* Swap the K-th eigenvalue to position KS. */
            if (k != ks)
            {
                ztrexc_(compq, n, &t[t_offset], ldt, &q[q_offset], ldq, &k, & ks, &ierr);
            }
        }
        /* L20: */
    }
    if (wants)
    {
        /* Solve the Sylvester equation for R: */
        /* T11*R - R*T22 = scale*T12 */
        zlacpy_("F", &n1, &n2, &t[(n1 + 1) * t_dim1 + 1], ldt, &work[1], &n1);
        ztrsyl_("N", "N", &c_n1, &n1, &n2, &t[t_offset], ldt, &t[n1 + 1 + (n1 + 1) * t_dim1], ldt, &work[1], &n1, &scale, &ierr);
        /* Estimate the reciprocal of the condition number of the cluster */
        /* of eigenvalues. */
        rnorm = zlange_("F", &n1, &n2, &work[1], &n1, rwork);
        if (rnorm == 0.)
        {
            *s = 1.;
        }
        else
        {
            *s = scale / (sqrt(scale * scale / rnorm + rnorm) * sqrt(rnorm));
        }
    }
    if (wantsp)
    {
        /* Estimate sep(T11,T22). */
        est = 0.;
        kase = 0;
L30:
        zlacn2_(&nn, &work[nn + 1], &work[1], &est, &kase, isave);
        if (kase != 0)
        {
            if (kase == 1)
            {
                /* Solve T11*R - R*T22 = scale*X. */
                ztrsyl_("N", "N", &c_n1, &n1, &n2, &t[t_offset], ldt, &t[n1 + 1 + (n1 + 1) * t_dim1], ldt, &work[1], &n1, &scale, & ierr);
            }
            else
            {
                /* Solve T11**H*R - R*T22**H = scale*X. */
                ztrsyl_("C", "C", &c_n1, &n1, &n2, &t[t_offset], ldt, &t[n1 + 1 + (n1 + 1) * t_dim1], ldt, &work[1], &n1, &scale, & ierr);
            }
            goto L30;
        }
        *sep = scale / est;
    }
L40: /* Copy reordered eigenvalues to W. */
    i__1 = *n;
    for (k = 1;
            k <= i__1;
            ++k)
    {
        i__2 = k;
        i__3 = k + k * t_dim1;
        w[i__2].r = t[i__3].r;
        w[i__2].i = t[i__3].i; // , expr subst
        /* L50: */
    }
    work[1].r = (doublereal) lwmin;
    work[1].i = 0.; // , expr subst
    return 0;
    /* End of ZTRSEN */
}
Exemple #3
0
/* Subroutine */ int ztrsen_(char *job, char *compq, logical *select, integer
                             *n, doublecomplex *t, integer *ldt, doublecomplex *q, integer *ldq,
                             doublecomplex *w, integer *m, doublereal *s, doublereal *sep,
                             doublecomplex *work, integer *lwork, integer *info, ftnlen job_len,
                             ftnlen compq_len)
{
    /* System generated locals */
    integer q_dim1, q_offset, t_dim1, t_offset, i__1, i__2, i__3;

    /* Builtin functions */
    double sqrt(doublereal);

    /* Local variables */
    static integer k, n1, n2, nn, ks;
    static doublereal est;
    static integer kase, ierr;
    static doublereal scale;
    extern logical lsame_(char *, char *, ftnlen, ftnlen);
    static integer lwmin;
    static logical wantq, wants;
    static doublereal rnorm, rwork[1];
    extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
    extern doublereal zlange_(char *, integer *, integer *, doublecomplex *,
                              integer *, doublereal *, ftnlen);
    static logical wantbh;
    extern /* Subroutine */ int zlacon_(integer *, doublecomplex *,
                                        doublecomplex *, doublereal *, integer *), zlacpy_(char *,
                                                integer *, integer *, doublecomplex *, integer *, doublecomplex *,
                                                integer *, ftnlen);
    static logical wantsp;
    extern /* Subroutine */ int ztrexc_(char *, integer *, doublecomplex *,
                                        integer *, doublecomplex *, integer *, integer *, integer *,
                                        integer *, ftnlen);
    static logical lquery;
    extern /* Subroutine */ int ztrsyl_(char *, char *, integer *, integer *,
                                        integer *, doublecomplex *, integer *, doublecomplex *, integer *,
                                        doublecomplex *, integer *, doublereal *, integer *, ftnlen,
                                        ftnlen);


    /*  -- LAPACK 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 .. */
    /*     .. */
    /*     .. Array Arguments .. */
    /*     .. */

    /*  Purpose */
    /*  ======= */

    /*  ZTRSEN reorders the Schur factorization of a complex matrix */
    /*  A = Q*T*Q**H, so that a selected cluster of eigenvalues appears in */
    /*  the leading positions on the diagonal of the upper triangular matrix */
    /*  T, and the leading columns of Q form an orthonormal basis of the */
    /*  corresponding right invariant subspace. */

    /*  Optionally the routine computes the reciprocal condition numbers of */
    /*  the cluster of eigenvalues and/or the invariant subspace. */

    /*  Arguments */
    /*  ========= */

    /*  JOB     (input) CHARACTER*1 */
    /*          Specifies whether condition numbers are required for the */
    /*          cluster of eigenvalues (S) or the invariant subspace (SEP): */
    /*          = 'N': none; */
    /*          = 'E': for eigenvalues only (S); */
    /*          = 'V': for invariant subspace only (SEP); */
    /*          = 'B': for both eigenvalues and invariant subspace (S and */
    /*                 SEP). */

    /*  COMPQ   (input) CHARACTER*1 */
    /*          = 'V': update the matrix Q of Schur vectors; */
    /*          = 'N': do not update Q. */

    /*  SELECT  (input) LOGICAL array, dimension (N) */
    /*          SELECT specifies the eigenvalues in the selected cluster. To */
    /*          select the j-th eigenvalue, SELECT(j) must be set to .TRUE.. */

    /*  N       (input) INTEGER */
    /*          The order of the matrix T. N >= 0. */

    /*  T       (input/output) COMPLEX*16 array, dimension (LDT,N) */
    /*          On entry, the upper triangular matrix T. */
    /*          On exit, T is overwritten by the reordered matrix T, with the */
    /*          selected eigenvalues as the leading diagonal elements. */

    /*  LDT     (input) INTEGER */
    /*          The leading dimension of the array T. LDT >= max(1,N). */

    /*  Q       (input/output) COMPLEX*16 array, dimension (LDQ,N) */
    /*          On entry, if COMPQ = 'V', the matrix Q of Schur vectors. */
    /*          On exit, if COMPQ = 'V', Q has been postmultiplied by the */
    /*          unitary transformation matrix which reorders T; the leading M */
    /*          columns of Q form an orthonormal basis for the specified */
    /*          invariant subspace. */
    /*          If COMPQ = 'N', Q is not referenced. */

    /*  LDQ     (input) INTEGER */
    /*          The leading dimension of the array Q. */
    /*          LDQ >= 1; and if COMPQ = 'V', LDQ >= N. */

    /*  W       (output) COMPLEX*16 array, dimension (N) */
    /*          The reordered eigenvalues of T, in the same order as they */
    /*          appear on the diagonal of T. */

    /*  M       (output) INTEGER */
    /*          The dimension of the specified invariant subspace. */
    /*          0 <= M <= N. */

    /*  S       (output) DOUBLE PRECISION */
    /*          If JOB = 'E' or 'B', S is a lower bound on the reciprocal */
    /*          condition number for the selected cluster of eigenvalues. */
    /*          S cannot underestimate the true reciprocal condition number */
    /*          by more than a factor of sqrt(N). If M = 0 or N, S = 1. */
    /*          If JOB = 'N' or 'V', S is not referenced. */

    /*  SEP     (output) DOUBLE PRECISION */
    /*          If JOB = 'V' or 'B', SEP is the estimated reciprocal */
    /*          condition number of the specified invariant subspace. If */
    /*          M = 0 or N, SEP = norm(T). */
    /*          If JOB = 'N' or 'E', SEP is not referenced. */

    /*  WORK    (workspace/output) COMPLEX*16 array, dimension (LWORK) */
    /*          If JOB = 'N', WORK is not referenced.  Otherwise, */
    /*          on exit, if INFO = 0, WORK(1) returns the optimal LWORK. */

    /*  LWORK   (input) INTEGER */
    /*          The dimension of the array WORK. */
    /*          If JOB = 'N', LWORK >= 1; */
    /*          if JOB = 'E', LWORK = M*(N-M); */
    /*          if JOB = 'V' or 'B', LWORK >= 2*M*(N-M). */

    /*          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. */

    /*  INFO    (output) INTEGER */
    /*          = 0:  successful exit */
    /*          < 0:  if INFO = -i, the i-th argument had an illegal value */

    /*  Further Details */
    /*  =============== */

    /*  ZTRSEN first collects the selected eigenvalues by computing a unitary */
    /*  transformation Z to move them to the top left corner of T. In other */
    /*  words, the selected eigenvalues are the eigenvalues of T11 in: */

    /*                Z'*T*Z = ( T11 T12 ) n1 */
    /*                         (  0  T22 ) n2 */
    /*                            n1  n2 */

    /*  where N = n1+n2 and Z' means the conjugate transpose of Z. The first */
    /*  n1 columns of Z span the specified invariant subspace of T. */

    /*  If T has been obtained from the Schur factorization of a matrix */
    /*  A = Q*T*Q', then the reordered Schur factorization of A is given by */
    /*  A = (Q*Z)*(Z'*T*Z)*(Q*Z)', and the first n1 columns of Q*Z span the */
    /*  corresponding invariant subspace of A. */

    /*  The reciprocal condition number of the average of the eigenvalues of */
    /*  T11 may be returned in S. S lies between 0 (very badly conditioned) */
    /*  and 1 (very well conditioned). It is computed as follows. First we */
    /*  compute R so that */

    /*                         P = ( I  R ) n1 */
    /*                             ( 0  0 ) n2 */
    /*                               n1 n2 */

    /*  is the projector on the invariant subspace associated with T11. */
    /*  R is the solution of the Sylvester equation: */

    /*                        T11*R - R*T22 = T12. */

    /*  Let F-norm(M) denote the Frobenius-norm of M and 2-norm(M) denote */
    /*  the two-norm of M. Then S is computed as the lower bound */

    /*                      (1 + F-norm(R)**2)**(-1/2) */

    /*  on the reciprocal of 2-norm(P), the true reciprocal condition number. */
    /*  S cannot underestimate 1 / 2-norm(P) by more than a factor of */
    /*  sqrt(N). */

    /*  An approximate error bound for the computed average of the */
    /*  eigenvalues of T11 is */

    /*                         EPS * norm(T) / S */

    /*  where EPS is the machine precision. */

    /*  The reciprocal condition number of the right invariant subspace */
    /*  spanned by the first n1 columns of Z (or of Q*Z) is returned in SEP. */
    /*  SEP is defined as the separation of T11 and T22: */

    /*                     sep( T11, T22 ) = sigma-min( C ) */

    /*  where sigma-min(C) is the smallest singular value of the */
    /*  n1*n2-by-n1*n2 matrix */

    /*     C  = kprod( I(n2), T11 ) - kprod( transpose(T22), I(n1) ) */

    /*  I(m) is an m by m identity matrix, and kprod denotes the Kronecker */
    /*  product. We estimate sigma-min(C) by the reciprocal of an estimate of */
    /*  the 1-norm of inverse(C). The true reciprocal 1-norm of inverse(C) */
    /*  cannot differ from sigma-min(C) by more than a factor of sqrt(n1*n2). */

    /*  When SEP is small, small changes in T can cause large changes in */
    /*  the invariant subspace. An approximate bound on the maximum angular */
    /*  error in the computed right invariant subspace is */

    /*                      EPS * norm(T) / SEP */

    /*  ===================================================================== */

    /*     .. Parameters .. */
    /*     .. */
    /*     .. Local Scalars .. */
    /*     .. */
    /*     .. Local Arrays .. */
    /*     .. */
    /*     .. External Functions .. */
    /*     .. */
    /*     .. External Subroutines .. */
    /*     .. */
    /*     .. Intrinsic Functions .. */
    /*     .. */
    /*     .. Executable Statements .. */

    /*     Decode and test the input parameters. */

    /* Parameter adjustments */
    --select;
    t_dim1 = *ldt;
    t_offset = 1 + t_dim1;
    t -= t_offset;
    q_dim1 = *ldq;
    q_offset = 1 + q_dim1;
    q -= q_offset;
    --w;
    --work;

    /* Function Body */
    wantbh = lsame_(job, "B", (ftnlen)1, (ftnlen)1);
    wants = lsame_(job, "E", (ftnlen)1, (ftnlen)1) || wantbh;
    wantsp = lsame_(job, "V", (ftnlen)1, (ftnlen)1) || wantbh;
    wantq = lsame_(compq, "V", (ftnlen)1, (ftnlen)1);

    /*     Set M to the number of selected eigenvalues. */

    *m = 0;
    i__1 = *n;
    for (k = 1; k <= i__1; ++k) {
        if (select[k]) {
            ++(*m);
        }
        /* L10: */
    }

    n1 = *m;
    n2 = *n - *m;
    nn = n1 * n2;

    *info = 0;
    lquery = *lwork == -1;

    if (wantsp) {
        /* Computing MAX */
        i__1 = 1, i__2 = nn << 1;
        lwmin = max(i__1,i__2);
    } else if (lsame_(job, "N", (ftnlen)1, (ftnlen)1)) {
        lwmin = 1;
    } else if (lsame_(job, "E", (ftnlen)1, (ftnlen)1)) {
        lwmin = max(1,nn);
    }

    if (! lsame_(job, "N", (ftnlen)1, (ftnlen)1) && ! wants && ! wantsp) {
        *info = -1;
    } else if (! lsame_(compq, "N", (ftnlen)1, (ftnlen)1) && ! wantq) {
        *info = -2;
    } else if (*n < 0) {
        *info = -4;
    } else if (*ldt < max(1,*n)) {
        *info = -6;
    } else if (*ldq < 1 || wantq && *ldq < *n) {
        *info = -8;
    } else if (*lwork < lwmin && ! lquery) {
        *info = -14;
    }

    if (*info == 0) {
        work[1].r = (doublereal) lwmin, work[1].i = 0.;
    }

    if (*info != 0) {
        i__1 = -(*info);
        xerbla_("ZTRSEN", &i__1, (ftnlen)6);
        return 0;
    } else if (lquery) {
        return 0;
    }

    /*     Quick return if possible */

    if (*m == *n || *m == 0) {
        if (wants) {
            *s = 1.;
        }
        if (wantsp) {
            *sep = zlange_("1", n, n, &t[t_offset], ldt, rwork, (ftnlen)1);
        }
        goto L40;
    }

    /*     Collect the selected eigenvalues at the top left corner of T. */

    ks = 0;
    i__1 = *n;
    for (k = 1; k <= i__1; ++k) {
        if (select[k]) {
            ++ks;

            /*           Swap the K-th eigenvalue to position KS. */

            if (k != ks) {
                ztrexc_(compq, n, &t[t_offset], ldt, &q[q_offset], ldq, &k, &
                        ks, &ierr, (ftnlen)1);
            }
        }
        /* L20: */
    }

    if (wants) {

        /*        Solve the Sylvester equation for R: */

        /*           T11*R - R*T22 = scale*T12 */

        zlacpy_("F", &n1, &n2, &t[(n1 + 1) * t_dim1 + 1], ldt, &work[1], &n1,
                (ftnlen)1);
        ztrsyl_("N", "N", &c_n1, &n1, &n2, &t[t_offset], ldt, &t[n1 + 1 + (n1
                + 1) * t_dim1], ldt, &work[1], &n1, &scale, &ierr, (ftnlen)1,
                (ftnlen)1);

        /*        Estimate the reciprocal of the condition number of the cluster */
        /*        of eigenvalues. */

        rnorm = zlange_("F", &n1, &n2, &work[1], &n1, rwork, (ftnlen)1);
        if (rnorm == 0.) {
            *s = 1.;
        } else {
            *s = scale / (sqrt(scale * scale / rnorm + rnorm) * sqrt(rnorm));
        }
    }

    if (wantsp) {

        /*        Estimate sep(T11,T22). */

        est = 0.;
        kase = 0;
L30:
        zlacon_(&nn, &work[nn + 1], &work[1], &est, &kase);
        if (kase != 0) {
            if (kase == 1) {

                /*              Solve T11*R - R*T22 = scale*X. */

                ztrsyl_("N", "N", &c_n1, &n1, &n2, &t[t_offset], ldt, &t[n1 +
                        1 + (n1 + 1) * t_dim1], ldt, &work[1], &n1, &scale, &
                        ierr, (ftnlen)1, (ftnlen)1);
            } else {

                /*              Solve T11'*R - R*T22' = scale*X. */

                ztrsyl_("C", "C", &c_n1, &n1, &n2, &t[t_offset], ldt, &t[n1 +
                        1 + (n1 + 1) * t_dim1], ldt, &work[1], &n1, &scale, &
                        ierr, (ftnlen)1, (ftnlen)1);
            }
            goto L30;
        }

        *sep = scale / est;
    }

L40:

    /*     Copy reordered eigenvalues to W. */

    i__1 = *n;
    for (k = 1; k <= i__1; ++k) {
        i__2 = k;
        i__3 = k + k * t_dim1;
        w[i__2].r = t[i__3].r, w[i__2].i = t[i__3].i;
        /* L50: */
    }

    work[1].r = (doublereal) lwmin, work[1].i = 0.;

    return 0;

    /*     End of ZTRSEN */

} /* ztrsen_ */
Exemple #4
0
/* Subroutine */ int zerrec_(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)";

    /* System generated locals */
    integer i__1;

    /* 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 doublecomplex work[24], a[16]	/* was [4][4] */, b[16]	/* 
	    was [4][4] */, c__[16]	/* was [4][4] */;
    static integer i__, j, m;
    static doublereal s[4], scale;
    static doublecomplex x[4];
    static integer nt;
    static doublereal rw[24];
    extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical 
	    *, logical *), ztrexc_(char *, integer *, doublecomplex *,
	     integer *, doublecomplex *, integer *, integer *, integer *, 
	    integer *), ztrsna_(char *, char *, logical *, integer *, 
	    doublecomplex *, integer *, doublecomplex *, integer *, 
	    doublecomplex *, integer *, doublereal *, doublereal *, integer *,
	     integer *, doublecomplex *, integer *, doublereal *, integer *), ztrsen_(char *, char *, logical *, integer *, 
	    doublecomplex *, integer *, doublecomplex *, integer *, 
	    doublecomplex *, integer *, doublereal *, doublereal *, 
	    doublecomplex *, integer *, integer *), ztrsyl_(
	    char *, char *, integer *, integer *, integer *, doublecomplex *, 
	    integer *, doublecomplex *, integer *, doublecomplex *, integer *,
	     doublereal *, integer *);
    static logical sel[4];
    static doublereal sep[4];

    /* Fortran I/O blocks */
    static cilist io___18 = { 0, 0, 0, fmt_9999, 0 };
    static cilist io___19 = { 0, 0, 0, fmt_9998, 0 };



#define a_subscr(a_1,a_2) (a_2)*4 + a_1 - 5
#define a_ref(a_1,a_2) a[a_subscr(a_1,a_2)]
#define b_subscr(a_1,a_2) (a_2)*4 + a_1 - 5
#define b_ref(a_1,a_2) b[b_subscr(a_1,a_2)]


/*  -- 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   
    =======   

    ZERREC tests the error exits for the routines for eigen- condition   
    estimation for DOUBLE PRECISION matrices:   
       ZTRSYL, CTREXC, CTRSNA and CTRSEN.   

    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__) {
	    i__1 = a_subscr(i__, j);
	    a[i__1].r = 0., a[i__1].i = 0.;
	    i__1 = b_subscr(i__, j);
	    b[i__1].r = 0., b[i__1].i = 0.;
/* L10: */
	}
/* L20: */
    }
    for (i__ = 1; i__ <= 4; ++i__) {
	i__1 = a_subscr(i__, i__);
	a[i__1].r = 1., a[i__1].i = 0.;
	sel[i__ - 1] = TRUE_;
/* L30: */
    }

/*     Test ZTRSYL */

    s_copy(srnamc_1.srnamt, "ZTRSYL", (ftnlen)6, (ftnlen)6);
    infoc_1.infot = 1;
    ztrsyl_("X", "N", &c__1, &c__0, &c__0, a, &c__1, b, &c__1, c__, &c__1, &
	    scale, &info);
    chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 2;
    ztrsyl_("N", "X", &c__1, &c__0, &c__0, a, &c__1, b, &c__1, c__, &c__1, &
	    scale, &info);
    chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 3;
    ztrsyl_("N", "N", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, c__, &c__1, &
	    scale, &info);
    chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 4;
    ztrsyl_("N", "N", &c__1, &c_n1, &c__0, a, &c__1, b, &c__1, c__, &c__1, &
	    scale, &info);
    chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 5;
    ztrsyl_("N", "N", &c__1, &c__0, &c_n1, a, &c__1, b, &c__1, c__, &c__1, &
	    scale, &info);
    chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 7;
    ztrsyl_("N", "N", &c__1, &c__2, &c__0, a, &c__1, b, &c__1, c__, &c__2, &
	    scale, &info);
    chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 9;
    ztrsyl_("N", "N", &c__1, &c__0, &c__2, a, &c__1, b, &c__1, c__, &c__1, &
	    scale, &info);
    chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 11;
    ztrsyl_("N", "N", &c__1, &c__2, &c__0, a, &c__2, b, &c__1, c__, &c__1, &
	    scale, &info);
    chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    nt += 8;

/*     Test ZTREXC */

    s_copy(srnamc_1.srnamt, "ZTREXC", (ftnlen)6, (ftnlen)6);
    ifst = 1;
    ilst = 1;
    infoc_1.infot = 1;
    ztrexc_("X", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, &info);
    chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 7;
    ztrexc_("N", &c__0, a, &c__1, b, &c__1, &ifst, &ilst, &info);
    chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 4;
    ilst = 2;
    ztrexc_("N", &c__2, a, &c__1, b, &c__1, &ifst, &ilst, &info);
    chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 6;
    ztrexc_("V", &c__2, a, &c__2, b, &c__1, &ifst, &ilst, &info);
    chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 7;
    ifst = 0;
    ilst = 1;
    ztrexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, &info);
    chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 7;
    ifst = 2;
    ztrexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, &info);
    chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 8;
    ifst = 1;
    ilst = 0;
    ztrexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, &info);
    chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 8;
    ilst = 2;
    ztrexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, &info);
    chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    nt += 8;

/*     Test ZTRSNA */

    s_copy(srnamc_1.srnamt, "ZTRSNA", (ftnlen)6, (ftnlen)6);
    infoc_1.infot = 1;
    ztrsna_("X", "A", sel, &c__0, a, &c__1, b, &c__1, c__, &c__1, s, sep, &
	    c__1, &m, work, &c__1, rw, &info);
    chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 2;
    ztrsna_("B", "X", sel, &c__0, a, &c__1, b, &c__1, c__, &c__1, s, sep, &
	    c__1, &m, work, &c__1, rw, &info);
    chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 4;
    ztrsna_("B", "A", sel, &c_n1, a, &c__1, b, &c__1, c__, &c__1, s, sep, &
	    c__1, &m, work, &c__1, rw, &info);
    chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 6;
    ztrsna_("V", "A", sel, &c__2, a, &c__1, b, &c__1, c__, &c__1, s, sep, &
	    c__2, &m, work, &c__2, rw, &info);
    chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 8;
    ztrsna_("B", "A", sel, &c__2, a, &c__2, b, &c__1, c__, &c__2, s, sep, &
	    c__2, &m, work, &c__2, rw, &info);
    chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 10;
    ztrsna_("B", "A", sel, &c__2, a, &c__2, b, &c__2, c__, &c__1, s, sep, &
	    c__2, &m, work, &c__2, rw, &info);
    chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 13;
    ztrsna_("B", "A", sel, &c__1, a, &c__1, b, &c__1, c__, &c__1, s, sep, &
	    c__0, &m, work, &c__1, rw, &info);
    chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 13;
    ztrsna_("B", "S", sel, &c__2, a, &c__2, b, &c__2, c__, &c__2, s, sep, &
	    c__1, &m, work, &c__1, rw, &info);
    chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 16;
    ztrsna_("B", "A", sel, &c__2, a, &c__2, b, &c__2, c__, &c__2, s, sep, &
	    c__2, &m, work, &c__1, rw, &info);
    chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    nt += 9;

/*     Test ZTRSEN */

    sel[0] = FALSE_;
    s_copy(srnamc_1.srnamt, "ZTRSEN", (ftnlen)6, (ftnlen)6);
    infoc_1.infot = 1;
    ztrsen_("X", "N", sel, &c__0, a, &c__1, b, &c__1, x, &m, s, sep, work, &
	    c__1, &info);
    chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 2;
    ztrsen_("N", "X", sel, &c__0, a, &c__1, b, &c__1, x, &m, s, sep, work, &
	    c__1, &info);
    chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 4;
    ztrsen_("N", "N", sel, &c_n1, a, &c__1, b, &c__1, x, &m, s, sep, work, &
	    c__1, &info);
    chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 6;
    ztrsen_("N", "N", sel, &c__2, a, &c__1, b, &c__1, x, &m, s, sep, work, &
	    c__2, &info);
    chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 8;
    ztrsen_("N", "V", sel, &c__2, a, &c__2, b, &c__1, x, &m, s, sep, work, &
	    c__1, &info);
    chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 14;
    ztrsen_("N", "V", sel, &c__2, a, &c__2, b, &c__2, x, &m, s, sep, work, &
	    c__0, &info);
    chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 14;
    ztrsen_("E", "V", sel, &c__3, a, &c__3, b, &c__3, x, &m, s, sep, work, &
	    c__1, &info);
    chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    infoc_1.infot = 14;
    ztrsen_("V", "V", sel, &c__3, a, &c__3, b, &c__3, x, &m, s, sep, work, &
	    c__3, &info);
    chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
	    infoc_1.ok);
    nt += 8;

/*     Print a summary line. */

    if (infoc_1.ok) {
	io___18.ciunit = infoc_1.nout;
	s_wsfe(&io___18);
	do_fio(&c__1, path, (ftnlen)3);
	do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer));
	e_wsfe();
    } else {
	io___19.ciunit = infoc_1.nout;
	s_wsfe(&io___19);
	do_fio(&c__1, path, (ftnlen)3);
	e_wsfe();
    }

    return 0;

/*     End of ZERREC */

} /* zerrec_ */