示例#1
0
文件: zchkqr.c 项目: kstraube/hysim
/* Subroutine */ int zchkqr_(logical *dotype, integer *nm, integer *mval, 
	integer *nn, integer *nval, integer *nnb, integer *nbval, integer *
	nxval, integer *nrhs, doublereal *thresh, logical *tsterr, integer *
	nmax, doublecomplex *a, doublecomplex *af, doublecomplex *aq, 
	doublecomplex *ar, doublecomplex *ac, doublecomplex *b, doublecomplex 
	*x, doublecomplex *xact, doublecomplex *tau, doublecomplex *work, 
	doublereal *rwork, integer *iwork, integer *nout)
{
    /* Initialized data */

    static integer iseedy[4] = { 1988,1989,1990,1991 };

    /* Format strings */
    static char fmt_9999[] = "(\002 M=\002,i5,\002, N=\002,i5,\002, K=\002,i"
	    "5,\002, NB=\002,i4,\002, NX=\002,i5,\002, type \002,i2,\002, tes"
	    "t(\002,i2,\002)=\002,g12.5)";

    /* System generated locals */
    integer i__1, i__2, i__3, i__4, i__5;

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

    /* Local variables */
    integer i__, k, m, n, nb, ik, im, in, kl, nk, ku, nt, nx, lda, inb, mode, 
	    imat, info;
    char path[3];
    integer kval[4];
    char dist[1], type__[1];
    integer nrun;
    extern /* Subroutine */ int alahd_(integer *, char *);
    integer nfail, iseed[4];
    extern /* Subroutine */ int zget02_(char *, integer *, integer *, integer 
	    *, doublecomplex *, integer *, doublecomplex *, integer *, 
	    doublecomplex *, integer *, doublereal *, doublereal *);
    doublereal anorm;
    integer minmn, nerrs, lwork;
    extern /* Subroutine */ int zqrt01_(integer *, integer *, doublecomplex *, 
	     doublecomplex *, doublecomplex *, doublecomplex *, integer *, 
	    doublecomplex *, doublecomplex *, integer *, doublereal *, 
	    doublereal *), zqrt02_(integer *, integer *, integer *, 
	    doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, integer *, doublecomplex *, doublecomplex *, integer *, 
	    doublereal *, doublereal *), zqrt03_(integer *, integer *, 
	    integer *, doublecomplex *, doublecomplex *, doublecomplex *, 
	    doublecomplex *, integer *, doublecomplex *, doublecomplex *, 
	    integer *, doublereal *, doublereal *), zlatb4_(char *, integer *, 
	     integer *, integer *, char *, integer *, integer *, doublereal *, 
	     integer *, doublereal *, char *), 
	    alaerh_(char *, char *, integer *, integer *, char *, integer *, 
	    integer *, integer *, integer *, integer *, integer *, integer *, 
	    integer *, integer *), alasum_(char *, 
	    integer *, integer *, integer *, integer *);
    doublereal cndnum;
    extern /* Subroutine */ int xlaenv_(integer *, integer *), zlacpy_(char *, 
	     integer *, integer *, doublecomplex *, integer *, doublecomplex *
, integer *), zlarhs_(char *, char *, char *, char *, 
	    integer *, integer *, integer *, integer *, integer *, 
	    doublecomplex *, integer *, doublecomplex *, integer *, 
	    doublecomplex *, integer *, integer *, integer *), zlatms_(integer *, integer *, char *, integer *, 
	    char *, doublereal *, integer *, doublereal *, doublereal *, 
	    integer *, integer *, char *, doublecomplex *, integer *, 
	    doublecomplex *, integer *), zgeqrs_(
	    integer *, integer *, integer *, doublecomplex *, integer *, 
	    doublecomplex *, doublecomplex *, integer *, doublecomplex *, 
	    integer *, integer *);
    doublereal result[7];
    extern /* Subroutine */ int zerrqr_(char *, integer *);

    /* Fortran I/O blocks */
    static cilist io___33 = { 0, 0, 0, fmt_9999, 0 };



/*  -- LAPACK test routine (version 3.1) -- */
/*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/*     November 2006 */

/*     .. Scalar Arguments .. */
/*     .. */
/*     .. Array Arguments .. */
/*     .. */

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

/*  ZCHKQR tests ZGEQRF, ZUNGQR and CUNMQR. */

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

/*  DOTYPE  (input) LOGICAL array, dimension (NTYPES) */
/*          The matrix types to be used for testing.  Matrices of type j */
/*          (for 1 <= j <= NTYPES) are used for testing if DOTYPE(j) = */
/*          .TRUE.; if DOTYPE(j) = .FALSE., then type j is not used. */

/*  NM      (input) INTEGER */
/*          The number of values of M contained in the vector MVAL. */

/*  MVAL    (input) INTEGER array, dimension (NM) */
/*          The values of the matrix row dimension M. */

/*  NN      (input) INTEGER */
/*          The number of values of N contained in the vector NVAL. */

/*  NVAL    (input) INTEGER array, dimension (NN) */
/*          The values of the matrix column dimension N. */

/*  NNB     (input) INTEGER */
/*          The number of values of NB and NX contained in the */
/*          vectors NBVAL and NXVAL.  The blocking parameters are used */
/*          in pairs (NB,NX). */

/*  NBVAL   (input) INTEGER array, dimension (NNB) */
/*          The values of the blocksize NB. */

/*  NXVAL   (input) INTEGER array, dimension (NNB) */
/*          The values of the crossover point NX. */

/*  NRHS    (input) INTEGER */
/*          The number of right hand side vectors to be generated for */
/*          each linear system. */

/*  THRESH  (input) DOUBLE PRECISION */
/*          The threshold value for the test ratios.  A result is */
/*          included in the output file if RESULT >= THRESH.  To have */
/*          every test ratio printed, use THRESH = 0. */

/*  TSTERR  (input) LOGICAL */
/*          Flag that indicates whether error exits are to be tested. */

/*  NMAX    (input) INTEGER */
/*          The maximum value permitted for M or N, used in dimensioning */
/*          the work arrays. */

/*  A       (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) */

/*  AF      (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) */

/*  AQ      (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) */

/*  AR      (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) */

/*  AC      (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) */

/*  B       (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) */

/*  X       (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) */

/*  XACT    (workspace) COMPLEX*16 array, dimension (NMAX*NRHS) */

/*  TAU     (workspace) COMPLEX*16 array, dimension (NMAX) */

/*  WORK    (workspace) COMPLEX*16 array, dimension (NMAX*NMAX) */

/*  RWORK   (workspace) DOUBLE PRECISION array, dimension (NMAX) */

/*  IWORK   (workspace) INTEGER array, dimension (NMAX) */

/*  NOUT    (input) INTEGER */
/*          The unit number for output. */

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

/*     .. Parameters .. */
/*     .. */
/*     .. Local Scalars .. */
/*     .. */
/*     .. Local Arrays .. */
/*     .. */
/*     .. External Subroutines .. */
/*     .. */
/*     .. Intrinsic Functions .. */
/*     .. */
/*     .. Scalars in Common .. */
/*     .. */
/*     .. Common blocks .. */
/*     .. */
/*     .. Data statements .. */
    /* Parameter adjustments */
    --iwork;
    --rwork;
    --work;
    --tau;
    --xact;
    --x;
    --b;
    --ac;
    --ar;
    --aq;
    --af;
    --a;
    --nxval;
    --nbval;
    --nval;
    --mval;
    --dotype;

    /* Function Body */
/*     .. */
/*     .. Executable Statements .. */

/*     Initialize constants and the random number seed. */

    s_copy(path, "Zomplex precision", (ftnlen)1, (ftnlen)17);
    s_copy(path + 1, "QR", (ftnlen)2, (ftnlen)2);
    nrun = 0;
    nfail = 0;
    nerrs = 0;
    for (i__ = 1; i__ <= 4; ++i__) {
	iseed[i__ - 1] = iseedy[i__ - 1];
/* L10: */
    }

/*     Test the error exits */

    if (*tsterr) {
	zerrqr_(path, nout);
    }
    infoc_1.infot = 0;
    xlaenv_(&c__2, &c__2);

    lda = *nmax;
    lwork = *nmax * max(*nmax,*nrhs);

/*     Do for each value of M in MVAL. */

    i__1 = *nm;
    for (im = 1; im <= i__1; ++im) {
	m = mval[im];

/*        Do for each value of N in NVAL. */

	i__2 = *nn;
	for (in = 1; in <= i__2; ++in) {
	    n = nval[in];
	    minmn = min(m,n);
	    for (imat = 1; imat <= 8; ++imat) {

/*              Do the tests only if DOTYPE( IMAT ) is true. */

		if (! dotype[imat]) {
		    goto L50;
		}

/*              Set up parameters with ZLATB4 and generate a test matrix */
/*              with ZLATMS. */

		zlatb4_(path, &imat, &m, &n, type__, &kl, &ku, &anorm, &mode, 
			&cndnum, dist);

		s_copy(srnamc_1.srnamt, "ZLATMS", (ftnlen)6, (ftnlen)6);
		zlatms_(&m, &n, dist, iseed, type__, &rwork[1], &mode, &
			cndnum, &anorm, &kl, &ku, "No packing", &a[1], &lda, &
			work[1], &info);

/*              Check error code from ZLATMS. */

		if (info != 0) {
		    alaerh_(path, "ZLATMS", &info, &c__0, " ", &m, &n, &c_n1, 
			    &c_n1, &c_n1, &imat, &nfail, &nerrs, nout);
		    goto L50;
		}

/*              Set some values for K: the first value must be MINMN, */
/*              corresponding to the call of ZQRT01; other values are */
/*              used in the calls of ZQRT02, and must not exceed MINMN. */

		kval[0] = minmn;
		kval[1] = 0;
		kval[2] = 1;
		kval[3] = minmn / 2;
		if (minmn == 0) {
		    nk = 1;
		} else if (minmn == 1) {
		    nk = 2;
		} else if (minmn <= 3) {
		    nk = 3;
		} else {
		    nk = 4;
		}

/*              Do for each value of K in KVAL */

		i__3 = nk;
		for (ik = 1; ik <= i__3; ++ik) {
		    k = kval[ik - 1];

/*                 Do for each pair of values (NB,NX) in NBVAL and NXVAL. */

		    i__4 = *nnb;
		    for (inb = 1; inb <= i__4; ++inb) {
			nb = nbval[inb];
			xlaenv_(&c__1, &nb);
			nx = nxval[inb];
			xlaenv_(&c__3, &nx);
			nt = 2;
			if (ik == 1) {

/*                       Test ZGEQRF */

			    zqrt01_(&m, &n, &a[1], &af[1], &aq[1], &ar[1], &
				    lda, &tau[1], &work[1], &lwork, &rwork[1], 
				     result);
			} else if (m >= n) {

/*                       Test ZUNGQR, using factorization */
/*                       returned by ZQRT01 */

			    zqrt02_(&m, &n, &k, &a[1], &af[1], &aq[1], &ar[1], 
				     &lda, &tau[1], &work[1], &lwork, &rwork[
				    1], result);
			} else {
			    result[0] = 0.;
			    result[1] = 0.;
			}
			if (m >= k) {

/*                       Test ZUNMQR, using factorization returned */
/*                       by ZQRT01 */

			    zqrt03_(&m, &n, &k, &af[1], &ac[1], &ar[1], &aq[1]
, &lda, &tau[1], &work[1], &lwork, &rwork[
				    1], &result[2]);
			    nt += 4;

/*                       If M>=N and K=N, call ZGEQRS to solve a system */
/*                       with NRHS right hand sides and compute the */
/*                       residual. */

			    if (k == n && inb == 1) {

/*                          Generate a solution and set the right */
/*                          hand side. */

				s_copy(srnamc_1.srnamt, "ZLARHS", (ftnlen)6, (
					ftnlen)6);
				zlarhs_(path, "New", "Full", "No transpose", &
					m, &n, &c__0, &c__0, nrhs, &a[1], &
					lda, &xact[1], &lda, &b[1], &lda, 
					iseed, &info);

				zlacpy_("Full", &m, nrhs, &b[1], &lda, &x[1], 
					&lda);
				s_copy(srnamc_1.srnamt, "ZGEQRS", (ftnlen)6, (
					ftnlen)6);
				zgeqrs_(&m, &n, nrhs, &af[1], &lda, &tau[1], &
					x[1], &lda, &work[1], &lwork, &info);

/*                          Check error code from ZGEQRS. */

				if (info != 0) {
				    alaerh_(path, "ZGEQRS", &info, &c__0, 
					    " ", &m, &n, nrhs, &c_n1, &nb, &
					    imat, &nfail, &nerrs, nout);
				}

				zget02_("No transpose", &m, &n, nrhs, &a[1], &
					lda, &x[1], &lda, &b[1], &lda, &rwork[
					1], &result[6]);
				++nt;
			    } else {
				result[6] = 0.;
			    }
			} else {
			    result[2] = 0.;
			    result[3] = 0.;
			    result[4] = 0.;
			    result[5] = 0.;
			}

/*                    Print information about the tests that did not */
/*                    pass the threshold. */

			i__5 = nt;
			for (i__ = 1; i__ <= i__5; ++i__) {
			    if (result[i__ - 1] >= *thresh) {
				if (nfail == 0 && nerrs == 0) {
				    alahd_(nout, path);
				}
				io___33.ciunit = *nout;
				s_wsfe(&io___33);
				do_fio(&c__1, (char *)&m, (ftnlen)sizeof(
					integer));
				do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
					integer));
				do_fio(&c__1, (char *)&k, (ftnlen)sizeof(
					integer));
				do_fio(&c__1, (char *)&nb, (ftnlen)sizeof(
					integer));
				do_fio(&c__1, (char *)&nx, (ftnlen)sizeof(
					integer));
				do_fio(&c__1, (char *)&imat, (ftnlen)sizeof(
					integer));
				do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(
					integer));
				do_fio(&c__1, (char *)&result[i__ - 1], (
					ftnlen)sizeof(doublereal));
				e_wsfe();
				++nfail;
			    }
/* L20: */
			}
			nrun += nt;
/* L30: */
		    }
/* L40: */
		}
L50:
		;
	    }
/* L60: */
	}
/* L70: */
    }

/*     Print a summary of the results. */

    alasum_(path, nout, &nfail, &nrun, &nerrs);

    return 0;

/*     End of ZCHKQR */

} /* zchkqr_ */
示例#2
0
文件: zerrqr.c 项目: zangel/uquad
/* Subroutine */ int zerrqr_(char *path, integer *nunit)
{
    /* System generated locals */
    integer i__1;
    doublereal d__1, d__2;
    doublecomplex z__1;

    /* Builtin functions */
    integer s_wsle(cilist *), e_wsle(void);
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);

    /* Local variables */
    static integer info;
    static doublecomplex a[4]	/* was [2][2] */, b[2];
    static integer i__, j;
    static doublecomplex w[2], x[2], af[4]	/* was [2][2] */;
    extern /* Subroutine */ int zgeqr2_(integer *, integer *, doublecomplex *,
                                        integer *, doublecomplex *, doublecomplex *, integer *), zung2r_(
                                            integer *, integer *, integer *, doublecomplex *, integer *,
                                            doublecomplex *, doublecomplex *, integer *), zunm2r_(char *,
                                                    char *, integer *, integer *, integer *, doublecomplex *, integer
                                                    *, doublecomplex *, doublecomplex *, integer *, doublecomplex *,
                                                    integer *), alaesm_(char *, logical *, integer *), chkxer_(char *, integer *, integer *, logical *, logical
                                                            *), zgeqrf_(integer *, integer *, doublecomplex *,
                                                                    integer *, doublecomplex *, doublecomplex *, integer *, integer *)
    , zgeqrs_(integer *, integer *, integer *, doublecomplex *,
              integer *, doublecomplex *, doublecomplex *, integer *,
              doublecomplex *, integer *, integer *), zungqr_(integer *,
                      integer *, integer *, doublecomplex *, integer *, doublecomplex *,
                      doublecomplex *, integer *, integer *), zunmqr_(char *, char *,
                              integer *, integer *, integer *, doublecomplex *, integer *,
                              doublecomplex *, doublecomplex *, integer *, doublecomplex *,
                              integer *, integer *);

    /* Fortran I/O blocks */
    static cilist io___1 = { 0, 0, 0, 0, 0 };



#define a_subscr(a_1,a_2) (a_2)*2 + a_1 - 3
#define a_ref(a_1,a_2) a[a_subscr(a_1,a_2)]
#define af_subscr(a_1,a_2) (a_2)*2 + a_1 - 3
#define af_ref(a_1,a_2) af[af_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
           February 29, 1992


        Purpose
        =======

        ZERRQR tests the error exits for the COMPLEX*16 routines
        that use the QR decomposition of a general matrix.

        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;
    io___1.ciunit = infoc_1.nout;
    s_wsle(&io___1);
    e_wsle();

    /*     Set the variables to innocuous values. */

    for (j = 1; j <= 2; ++j) {
        for (i__ = 1; i__ <= 2; ++i__) {
            i__1 = a_subscr(i__, j);
            d__1 = 1. / (doublereal) (i__ + j);
            d__2 = -1. / (doublereal) (i__ + j);
            z__1.r = d__1, z__1.i = d__2;
            a[i__1].r = z__1.r, a[i__1].i = z__1.i;
            i__1 = af_subscr(i__, j);
            d__1 = 1. / (doublereal) (i__ + j);
            d__2 = -1. / (doublereal) (i__ + j);
            z__1.r = d__1, z__1.i = d__2;
            af[i__1].r = z__1.r, af[i__1].i = z__1.i;
            /* L10: */
        }
        i__1 = j - 1;
        b[i__1].r = 0., b[i__1].i = 0.;
        i__1 = j - 1;
        w[i__1].r = 0., w[i__1].i = 0.;
        i__1 = j - 1;
        x[i__1].r = 0., x[i__1].i = 0.;
        /* L20: */
    }
    infoc_1.ok = TRUE_;

    /*     Error exits for QR factorization

           ZGEQRF */

    s_copy(srnamc_1.srnamt, "ZGEQRF", (ftnlen)6, (ftnlen)6);
    infoc_1.infot = 1;
    zgeqrf_(&c_n1, &c__0, a, &c__1, b, w, &c__1, &info);
    chkxer_("ZGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 2;
    zgeqrf_(&c__0, &c_n1, a, &c__1, b, w, &c__1, &info);
    chkxer_("ZGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 4;
    zgeqrf_(&c__2, &c__1, a, &c__1, b, w, &c__1, &info);
    chkxer_("ZGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 7;
    zgeqrf_(&c__1, &c__2, a, &c__1, b, w, &c__1, &info);
    chkxer_("ZGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);

    /*     ZGEQR2 */

    s_copy(srnamc_1.srnamt, "ZGEQR2", (ftnlen)6, (ftnlen)6);
    infoc_1.infot = 1;
    zgeqr2_(&c_n1, &c__0, a, &c__1, b, w, &info);
    chkxer_("ZGEQR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 2;
    zgeqr2_(&c__0, &c_n1, a, &c__1, b, w, &info);
    chkxer_("ZGEQR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 4;
    zgeqr2_(&c__2, &c__1, a, &c__1, b, w, &info);
    chkxer_("ZGEQR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);

    /*     ZGEQRS */

    s_copy(srnamc_1.srnamt, "ZGEQRS", (ftnlen)6, (ftnlen)6);
    infoc_1.infot = 1;
    zgeqrs_(&c_n1, &c__0, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info);
    chkxer_("ZGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 2;
    zgeqrs_(&c__0, &c_n1, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info);
    chkxer_("ZGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 2;
    zgeqrs_(&c__1, &c__2, &c__0, a, &c__2, x, b, &c__2, w, &c__1, &info);
    chkxer_("ZGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 3;
    zgeqrs_(&c__0, &c__0, &c_n1, a, &c__1, x, b, &c__1, w, &c__1, &info);
    chkxer_("ZGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 5;
    zgeqrs_(&c__2, &c__1, &c__0, a, &c__1, x, b, &c__2, w, &c__1, &info);
    chkxer_("ZGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 8;
    zgeqrs_(&c__2, &c__1, &c__0, a, &c__2, x, b, &c__1, w, &c__1, &info);
    chkxer_("ZGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 10;
    zgeqrs_(&c__1, &c__1, &c__2, a, &c__1, x, b, &c__1, w, &c__1, &info);
    chkxer_("ZGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);

    /*     ZUNGQR */

    s_copy(srnamc_1.srnamt, "ZUNGQR", (ftnlen)6, (ftnlen)6);
    infoc_1.infot = 1;
    zungqr_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &c__1, &info);
    chkxer_("ZUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 2;
    zungqr_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &c__1, &info);
    chkxer_("ZUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 2;
    zungqr_(&c__1, &c__2, &c__0, a, &c__1, x, w, &c__2, &info);
    chkxer_("ZUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 3;
    zungqr_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &c__1, &info);
    chkxer_("ZUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 3;
    zungqr_(&c__1, &c__1, &c__2, a, &c__1, x, w, &c__1, &info);
    chkxer_("ZUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 5;
    zungqr_(&c__2, &c__2, &c__0, a, &c__1, x, w, &c__2, &info);
    chkxer_("ZUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 8;
    zungqr_(&c__2, &c__2, &c__0, a, &c__2, x, w, &c__1, &info);
    chkxer_("ZUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);

    /*     ZUNG2R */

    s_copy(srnamc_1.srnamt, "ZUNG2R", (ftnlen)6, (ftnlen)6);
    infoc_1.infot = 1;
    zung2r_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &info);
    chkxer_("ZUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 2;
    zung2r_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &info);
    chkxer_("ZUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 2;
    zung2r_(&c__1, &c__2, &c__0, a, &c__1, x, w, &info);
    chkxer_("ZUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 3;
    zung2r_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &info);
    chkxer_("ZUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 3;
    zung2r_(&c__2, &c__1, &c__2, a, &c__2, x, w, &info);
    chkxer_("ZUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 5;
    zung2r_(&c__2, &c__1, &c__0, a, &c__1, x, w, &info);
    chkxer_("ZUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);

    /*     ZUNMQR */

    s_copy(srnamc_1.srnamt, "ZUNMQR", (ftnlen)6, (ftnlen)6);
    infoc_1.infot = 1;
    zunmqr_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
            info);
    chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 2;
    zunmqr_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
            info);
    chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 3;
    zunmqr_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
            info);
    chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 4;
    zunmqr_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
            info);
    chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 5;
    zunmqr_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &c__1, &
            info);
    chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 5;
    zunmqr_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &c__1, &
            info);
    chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 5;
    zunmqr_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &c__1, &
            info);
    chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 7;
    zunmqr_("L", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, &
            info);
    chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 7;
    zunmqr_("R", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
            info);
    chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 10;
    zunmqr_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &c__1, &
            info);
    chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 12;
    zunmqr_("L", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
            info);
    chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 12;
    zunmqr_("R", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, &
            info);
    chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);

    /*     ZUNM2R */

    s_copy(srnamc_1.srnamt, "ZUNM2R", (ftnlen)6, (ftnlen)6);
    infoc_1.infot = 1;
    zunm2r_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info);
    chkxer_("ZUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 2;
    zunm2r_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info);
    chkxer_("ZUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 3;
    zunm2r_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info);
    chkxer_("ZUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 4;
    zunm2r_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &info);
    chkxer_("ZUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 5;
    zunm2r_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &info);
    chkxer_("ZUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 5;
    zunm2r_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &info);
    chkxer_("ZUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 5;
    zunm2r_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &info);
    chkxer_("ZUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 7;
    zunm2r_("L", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &info);
    chkxer_("ZUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 7;
    zunm2r_("R", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &info);
    chkxer_("ZUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);
    infoc_1.infot = 10;
    zunm2r_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &info);
    chkxer_("ZUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
            infoc_1.ok);

    /*     Print a summary line. */

    alaesm_(path, &infoc_1.ok, &infoc_1.nout);

    return 0;

    /*     End of ZERRQR */

} /* zerrqr_ */