swiftnav: zerrqr.c Source File

Go to the documentation of this file.
00001 /* zerrqr.f -- translated by f2c (version 20061008).
00002    You must link the resulting object file with libf2c:
00003         on Microsoft Windows system, link with libf2c.lib;
00004         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
00005         or, if you install libf2c.a in a standard place, with -lf2c -lm
00006         -- in that order, at the end of the command line, as in
00007                 cc *.o -lf2c -lm
00008         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
00009 
00010                 http://www.netlib.org/f2c/libf2c.zip
00011 */
00012 
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015 
00016 /* Common Block Declarations */
00017 
00018 struct {
00019     integer infot, nout;
00020     logical ok, lerr;
00021 } infoc_;
00022 
00023 #define infoc_1 infoc_
00024 
00025 struct {
00026     char srnamt[32];
00027 } srnamc_;
00028 
00029 #define srnamc_1 srnamc_
00030 
00031 /* Table of constant values */
00032 
00033 static integer c_n1 = -1;
00034 static integer c__0 = 0;
00035 static integer c__1 = 1;
00036 static integer c__2 = 2;
00037 
00038 /* Subroutine */ int zerrqr_(char *path, integer *nunit)
00039 {
00040     /* System generated locals */
00041     integer i__1;
00042     doublereal d__1, d__2;
00043     doublecomplex z__1;
00044 
00045     /* Builtin functions */
00046     integer s_wsle(cilist *), e_wsle(void);
00047     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00048 
00049     /* Local variables */
00050     doublecomplex a[4]  /* was [2][2] */, b[2];
00051     integer i__, j;
00052     doublecomplex w[2], x[2], af[4]     /* was [2][2] */;
00053     integer info;
00054     extern /* Subroutine */ int zgeqr2_(integer *, integer *, doublecomplex *, 
00055              integer *, doublecomplex *, doublecomplex *, integer *), zung2r_(
00056             integer *, integer *, integer *, doublecomplex *, integer *, 
00057             doublecomplex *, doublecomplex *, integer *), zunm2r_(char *, 
00058             char *, integer *, integer *, integer *, doublecomplex *, integer 
00059             *, doublecomplex *, doublecomplex *, integer *, doublecomplex *, 
00060             integer *), alaesm_(char *, logical *, integer *), chkxer_(char *, integer *, integer *, logical *, logical 
00061             *), zgeqrf_(integer *, integer *, doublecomplex *, 
00062             integer *, doublecomplex *, doublecomplex *, integer *, integer *)
00063             , zgeqrs_(integer *, integer *, integer *, doublecomplex *, 
00064             integer *, doublecomplex *, doublecomplex *, integer *, 
00065             doublecomplex *, integer *, integer *), zungqr_(integer *, 
00066             integer *, integer *, doublecomplex *, integer *, doublecomplex *, 
00067              doublecomplex *, integer *, integer *), zunmqr_(char *, char *, 
00068             integer *, integer *, integer *, doublecomplex *, integer *, 
00069             doublecomplex *, doublecomplex *, integer *, doublecomplex *, 
00070             integer *, integer *);
00071 
00072     /* Fortran I/O blocks */
00073     static cilist io___1 = { 0, 0, 0, 0, 0 };
00074 
00075 
00076 
00077 /*  -- LAPACK test routine (version 3.1) -- */
00078 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00079 /*     November 2006 */
00080 
00081 /*     .. Scalar Arguments .. */
00082 /*     .. */
00083 
00084 /*  Purpose */
00085 /*  ======= */
00086 
00087 /*  ZERRQR tests the error exits for the COMPLEX*16 routines */
00088 /*  that use the QR decomposition of a general matrix. */
00089 
00090 /*  Arguments */
00091 /*  ========= */
00092 
00093 /*  PATH    (input) CHARACTER*3 */
00094 /*          The LAPACK path name for the routines to be tested. */
00095 
00096 /*  NUNIT   (input) INTEGER */
00097 /*          The unit number for output. */
00098 
00099 /*  ===================================================================== */
00100 
00101 /*     .. Parameters .. */
00102 /*     .. */
00103 /*     .. Local Scalars .. */
00104 /*     .. */
00105 /*     .. Local Arrays .. */
00106 /*     .. */
00107 /*     .. External Subroutines .. */
00108 /*     .. */
00109 /*     .. Scalars in Common .. */
00110 /*     .. */
00111 /*     .. Common blocks .. */
00112 /*     .. */
00113 /*     .. Intrinsic Functions .. */
00114 /*     .. */
00115 /*     .. Executable Statements .. */
00116 
00117     infoc_1.nout = *nunit;
00118     io___1.ciunit = infoc_1.nout;
00119     s_wsle(&io___1);
00120     e_wsle();
00121 
00122 /*     Set the variables to innocuous values. */
00123 
00124     for (j = 1; j <= 2; ++j) {
00125         for (i__ = 1; i__ <= 2; ++i__) {
00126             i__1 = i__ + (j << 1) - 3;
00127             d__1 = 1. / (doublereal) (i__ + j);
00128             d__2 = -1. / (doublereal) (i__ + j);
00129             z__1.r = d__1, z__1.i = d__2;
00130             a[i__1].r = z__1.r, a[i__1].i = z__1.i;
00131             i__1 = i__ + (j << 1) - 3;
00132             d__1 = 1. / (doublereal) (i__ + j);
00133             d__2 = -1. / (doublereal) (i__ + j);
00134             z__1.r = d__1, z__1.i = d__2;
00135             af[i__1].r = z__1.r, af[i__1].i = z__1.i;
00136 /* L10: */
00137         }
00138         i__1 = j - 1;
00139         b[i__1].r = 0., b[i__1].i = 0.;
00140         i__1 = j - 1;
00141         w[i__1].r = 0., w[i__1].i = 0.;
00142         i__1 = j - 1;
00143         x[i__1].r = 0., x[i__1].i = 0.;
00144 /* L20: */
00145     }
00146     infoc_1.ok = TRUE_;
00147 
00148 /*     Error exits for QR factorization */
00149 
00150 /*     ZGEQRF */
00151 
00152     s_copy(srnamc_1.srnamt, "ZGEQRF", (ftnlen)32, (ftnlen)6);
00153     infoc_1.infot = 1;
00154     zgeqrf_(&c_n1, &c__0, a, &c__1, b, w, &c__1, &info);
00155     chkxer_("ZGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00156             infoc_1.ok);
00157     infoc_1.infot = 2;
00158     zgeqrf_(&c__0, &c_n1, a, &c__1, b, w, &c__1, &info);
00159     chkxer_("ZGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00160             infoc_1.ok);
00161     infoc_1.infot = 4;
00162     zgeqrf_(&c__2, &c__1, a, &c__1, b, w, &c__1, &info);
00163     chkxer_("ZGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00164             infoc_1.ok);
00165     infoc_1.infot = 7;
00166     zgeqrf_(&c__1, &c__2, a, &c__1, b, w, &c__1, &info);
00167     chkxer_("ZGEQRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00168             infoc_1.ok);
00169 
00170 /*     ZGEQR2 */
00171 
00172     s_copy(srnamc_1.srnamt, "ZGEQR2", (ftnlen)32, (ftnlen)6);
00173     infoc_1.infot = 1;
00174     zgeqr2_(&c_n1, &c__0, a, &c__1, b, w, &info);
00175     chkxer_("ZGEQR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00176             infoc_1.ok);
00177     infoc_1.infot = 2;
00178     zgeqr2_(&c__0, &c_n1, a, &c__1, b, w, &info);
00179     chkxer_("ZGEQR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00180             infoc_1.ok);
00181     infoc_1.infot = 4;
00182     zgeqr2_(&c__2, &c__1, a, &c__1, b, w, &info);
00183     chkxer_("ZGEQR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00184             infoc_1.ok);
00185 
00186 /*     ZGEQRS */
00187 
00188     s_copy(srnamc_1.srnamt, "ZGEQRS", (ftnlen)32, (ftnlen)6);
00189     infoc_1.infot = 1;
00190     zgeqrs_(&c_n1, &c__0, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info);
00191     chkxer_("ZGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00192             infoc_1.ok);
00193     infoc_1.infot = 2;
00194     zgeqrs_(&c__0, &c_n1, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info);
00195     chkxer_("ZGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00196             infoc_1.ok);
00197     infoc_1.infot = 2;
00198     zgeqrs_(&c__1, &c__2, &c__0, a, &c__2, x, b, &c__2, w, &c__1, &info);
00199     chkxer_("ZGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00200             infoc_1.ok);
00201     infoc_1.infot = 3;
00202     zgeqrs_(&c__0, &c__0, &c_n1, a, &c__1, x, b, &c__1, w, &c__1, &info);
00203     chkxer_("ZGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00204             infoc_1.ok);
00205     infoc_1.infot = 5;
00206     zgeqrs_(&c__2, &c__1, &c__0, a, &c__1, x, b, &c__2, w, &c__1, &info);
00207     chkxer_("ZGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00208             infoc_1.ok);
00209     infoc_1.infot = 8;
00210     zgeqrs_(&c__2, &c__1, &c__0, a, &c__2, x, b, &c__1, w, &c__1, &info);
00211     chkxer_("ZGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00212             infoc_1.ok);
00213     infoc_1.infot = 10;
00214     zgeqrs_(&c__1, &c__1, &c__2, a, &c__1, x, b, &c__1, w, &c__1, &info);
00215     chkxer_("ZGEQRS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00216             infoc_1.ok);
00217 
00218 /*     ZUNGQR */
00219 
00220     s_copy(srnamc_1.srnamt, "ZUNGQR", (ftnlen)32, (ftnlen)6);
00221     infoc_1.infot = 1;
00222     zungqr_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &c__1, &info);
00223     chkxer_("ZUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00224             infoc_1.ok);
00225     infoc_1.infot = 2;
00226     zungqr_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &c__1, &info);
00227     chkxer_("ZUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00228             infoc_1.ok);
00229     infoc_1.infot = 2;
00230     zungqr_(&c__1, &c__2, &c__0, a, &c__1, x, w, &c__2, &info);
00231     chkxer_("ZUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00232             infoc_1.ok);
00233     infoc_1.infot = 3;
00234     zungqr_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &c__1, &info);
00235     chkxer_("ZUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00236             infoc_1.ok);
00237     infoc_1.infot = 3;
00238     zungqr_(&c__1, &c__1, &c__2, a, &c__1, x, w, &c__1, &info);
00239     chkxer_("ZUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00240             infoc_1.ok);
00241     infoc_1.infot = 5;
00242     zungqr_(&c__2, &c__2, &c__0, a, &c__1, x, w, &c__2, &info);
00243     chkxer_("ZUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00244             infoc_1.ok);
00245     infoc_1.infot = 8;
00246     zungqr_(&c__2, &c__2, &c__0, a, &c__2, x, w, &c__1, &info);
00247     chkxer_("ZUNGQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00248             infoc_1.ok);
00249 
00250 /*     ZUNG2R */
00251 
00252     s_copy(srnamc_1.srnamt, "ZUNG2R", (ftnlen)32, (ftnlen)6);
00253     infoc_1.infot = 1;
00254     zung2r_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &info);
00255     chkxer_("ZUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00256             infoc_1.ok);
00257     infoc_1.infot = 2;
00258     zung2r_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &info);
00259     chkxer_("ZUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00260             infoc_1.ok);
00261     infoc_1.infot = 2;
00262     zung2r_(&c__1, &c__2, &c__0, a, &c__1, x, w, &info);
00263     chkxer_("ZUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00264             infoc_1.ok);
00265     infoc_1.infot = 3;
00266     zung2r_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &info);
00267     chkxer_("ZUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00268             infoc_1.ok);
00269     infoc_1.infot = 3;
00270     zung2r_(&c__2, &c__1, &c__2, a, &c__2, x, w, &info);
00271     chkxer_("ZUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00272             infoc_1.ok);
00273     infoc_1.infot = 5;
00274     zung2r_(&c__2, &c__1, &c__0, a, &c__1, x, w, &info);
00275     chkxer_("ZUNG2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00276             infoc_1.ok);
00277 
00278 /*     ZUNMQR */
00279 
00280     s_copy(srnamc_1.srnamt, "ZUNMQR", (ftnlen)32, (ftnlen)6);
00281     infoc_1.infot = 1;
00282     zunmqr_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
00283             info);
00284     chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00285             infoc_1.ok);
00286     infoc_1.infot = 2;
00287     zunmqr_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
00288             info);
00289     chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00290             infoc_1.ok);
00291     infoc_1.infot = 3;
00292     zunmqr_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
00293             info);
00294     chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00295             infoc_1.ok);
00296     infoc_1.infot = 4;
00297     zunmqr_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
00298             info);
00299     chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00300             infoc_1.ok);
00301     infoc_1.infot = 5;
00302     zunmqr_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &c__1, &
00303             info);
00304     chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00305             infoc_1.ok);
00306     infoc_1.infot = 5;
00307     zunmqr_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &c__1, &
00308             info);
00309     chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00310             infoc_1.ok);
00311     infoc_1.infot = 5;
00312     zunmqr_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &c__1, &
00313             info);
00314     chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00315             infoc_1.ok);
00316     infoc_1.infot = 7;
00317     zunmqr_("L", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, &
00318             info);
00319     chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00320             infoc_1.ok);
00321     infoc_1.infot = 7;
00322     zunmqr_("R", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
00323             info);
00324     chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00325             infoc_1.ok);
00326     infoc_1.infot = 10;
00327     zunmqr_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &c__1, &
00328             info);
00329     chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00330             infoc_1.ok);
00331     infoc_1.infot = 12;
00332     zunmqr_("L", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
00333             info);
00334     chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00335             infoc_1.ok);
00336     infoc_1.infot = 12;
00337     zunmqr_("R", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, &
00338             info);
00339     chkxer_("ZUNMQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00340             infoc_1.ok);
00341 
00342 /*     ZUNM2R */
00343 
00344     s_copy(srnamc_1.srnamt, "ZUNM2R", (ftnlen)32, (ftnlen)6);
00345     infoc_1.infot = 1;
00346     zunm2r_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info);
00347     chkxer_("ZUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00348             infoc_1.ok);
00349     infoc_1.infot = 2;
00350     zunm2r_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info);
00351     chkxer_("ZUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00352             infoc_1.ok);
00353     infoc_1.infot = 3;
00354     zunm2r_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info);
00355     chkxer_("ZUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00356             infoc_1.ok);
00357     infoc_1.infot = 4;
00358     zunm2r_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &info);
00359     chkxer_("ZUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00360             infoc_1.ok);
00361     infoc_1.infot = 5;
00362     zunm2r_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &info);
00363     chkxer_("ZUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00364             infoc_1.ok);
00365     infoc_1.infot = 5;
00366     zunm2r_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &info);
00367     chkxer_("ZUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00368             infoc_1.ok);
00369     infoc_1.infot = 5;
00370     zunm2r_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &info);
00371     chkxer_("ZUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00372             infoc_1.ok);
00373     infoc_1.infot = 7;
00374     zunm2r_("L", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &info);
00375     chkxer_("ZUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00376             infoc_1.ok);
00377     infoc_1.infot = 7;
00378     zunm2r_("R", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &info);
00379     chkxer_("ZUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00380             infoc_1.ok);
00381     infoc_1.infot = 10;
00382     zunm2r_("L", "N", &c__2, &c__1, &c__0, a, &c__2, x, af, &c__1, w, &info);
00383     chkxer_("ZUNM2R", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00384             infoc_1.ok);
00385 
00386 /*     Print a summary line. */
00387 
00388     alaesm_(path, &infoc_1.ok, &infoc_1.nout);
00389 
00390     return 0;
00391 
00392 /*     End of ZERRQR */
00393 
00394 } /* zerrqr_ */