swiftnav: zerrrq.c Source File

Go to the documentation of this file.
00001 /* zerrrq.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 zerrrq_(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 zgerq2_(integer *, integer *, doublecomplex *, 
00055              integer *, doublecomplex *, doublecomplex *, integer *), zungr2_(
00056             integer *, integer *, integer *, doublecomplex *, integer *, 
00057             doublecomplex *, doublecomplex *, integer *), zunmr2_(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             *), zgerqf_(integer *, integer *, doublecomplex *, 
00062             integer *, doublecomplex *, doublecomplex *, integer *, integer *)
00063             , zgerqs_(integer *, integer *, integer *, doublecomplex *, 
00064             integer *, doublecomplex *, doublecomplex *, integer *, 
00065             doublecomplex *, integer *, integer *), zungrq_(integer *, 
00066             integer *, integer *, doublecomplex *, integer *, doublecomplex *, 
00067              doublecomplex *, integer *, integer *), zunmrq_(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 /*  ZERRRQ tests the error exits for the COMPLEX*16 routines */
00088 /*  that use the RQ 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 RQ factorization */
00149 
00150 /*     ZGERQF */
00151 
00152     s_copy(srnamc_1.srnamt, "ZGERQF", (ftnlen)32, (ftnlen)6);
00153     infoc_1.infot = 1;
00154     zgerqf_(&c_n1, &c__0, a, &c__1, b, w, &c__1, &info);
00155     chkxer_("ZGERQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00156             infoc_1.ok);
00157     infoc_1.infot = 2;
00158     zgerqf_(&c__0, &c_n1, a, &c__1, b, w, &c__1, &info);
00159     chkxer_("ZGERQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00160             infoc_1.ok);
00161     infoc_1.infot = 4;
00162     zgerqf_(&c__2, &c__1, a, &c__1, b, w, &c__2, &info);
00163     chkxer_("ZGERQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00164             infoc_1.ok);
00165     infoc_1.infot = 7;
00166     zgerqf_(&c__2, &c__1, a, &c__2, b, w, &c__1, &info);
00167     chkxer_("ZGERQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00168             infoc_1.ok);
00169 
00170 /*     ZGERQ2 */
00171 
00172     s_copy(srnamc_1.srnamt, "ZGERQ2", (ftnlen)32, (ftnlen)6);
00173     infoc_1.infot = 1;
00174     zgerq2_(&c_n1, &c__0, a, &c__1, b, w, &info);
00175     chkxer_("ZGERQ2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00176             infoc_1.ok);
00177     infoc_1.infot = 2;
00178     zgerq2_(&c__0, &c_n1, a, &c__1, b, w, &info);
00179     chkxer_("ZGERQ2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00180             infoc_1.ok);
00181     infoc_1.infot = 4;
00182     zgerq2_(&c__2, &c__1, a, &c__1, b, w, &info);
00183     chkxer_("ZGERQ2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00184             infoc_1.ok);
00185 
00186 /*     ZGERQS */
00187 
00188     s_copy(srnamc_1.srnamt, "ZGERQS", (ftnlen)32, (ftnlen)6);
00189     infoc_1.infot = 1;
00190     zgerqs_(&c_n1, &c__0, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info);
00191     chkxer_("ZGERQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00192             infoc_1.ok);
00193     infoc_1.infot = 2;
00194     zgerqs_(&c__0, &c_n1, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info);
00195     chkxer_("ZGERQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00196             infoc_1.ok);
00197     infoc_1.infot = 2;
00198     zgerqs_(&c__2, &c__1, &c__0, a, &c__2, x, b, &c__1, w, &c__1, &info);
00199     chkxer_("ZGERQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00200             infoc_1.ok);
00201     infoc_1.infot = 3;
00202     zgerqs_(&c__0, &c__0, &c_n1, a, &c__1, x, b, &c__1, w, &c__1, &info);
00203     chkxer_("ZGERQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00204             infoc_1.ok);
00205     infoc_1.infot = 5;
00206     zgerqs_(&c__2, &c__2, &c__0, a, &c__1, x, b, &c__2, w, &c__1, &info);
00207     chkxer_("ZGERQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00208             infoc_1.ok);
00209     infoc_1.infot = 8;
00210     zgerqs_(&c__2, &c__2, &c__0, a, &c__2, x, b, &c__1, w, &c__1, &info);
00211     chkxer_("ZGERQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00212             infoc_1.ok);
00213     infoc_1.infot = 10;
00214     zgerqs_(&c__1, &c__1, &c__2, a, &c__1, x, b, &c__1, w, &c__1, &info);
00215     chkxer_("ZGERQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00216             infoc_1.ok);
00217 
00218 /*     ZUNGRQ */
00219 
00220     s_copy(srnamc_1.srnamt, "ZUNGRQ", (ftnlen)32, (ftnlen)6);
00221     infoc_1.infot = 1;
00222     zungrq_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &c__1, &info);
00223     chkxer_("ZUNGRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00224             infoc_1.ok);
00225     infoc_1.infot = 2;
00226     zungrq_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &c__1, &info);
00227     chkxer_("ZUNGRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00228             infoc_1.ok);
00229     infoc_1.infot = 2;
00230     zungrq_(&c__2, &c__1, &c__0, a, &c__2, x, w, &c__2, &info);
00231     chkxer_("ZUNGRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00232             infoc_1.ok);
00233     infoc_1.infot = 3;
00234     zungrq_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &c__1, &info);
00235     chkxer_("ZUNGRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00236             infoc_1.ok);
00237     infoc_1.infot = 3;
00238     zungrq_(&c__1, &c__2, &c__2, a, &c__1, x, w, &c__1, &info);
00239     chkxer_("ZUNGRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00240             infoc_1.ok);
00241     infoc_1.infot = 5;
00242     zungrq_(&c__2, &c__2, &c__0, a, &c__1, x, w, &c__2, &info);
00243     chkxer_("ZUNGRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00244             infoc_1.ok);
00245     infoc_1.infot = 8;
00246     zungrq_(&c__2, &c__2, &c__0, a, &c__2, x, w, &c__1, &info);
00247     chkxer_("ZUNGRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00248             infoc_1.ok);
00249 
00250 /*     ZUNGR2 */
00251 
00252     s_copy(srnamc_1.srnamt, "ZUNGR2", (ftnlen)32, (ftnlen)6);
00253     infoc_1.infot = 1;
00254     zungr2_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &info);
00255     chkxer_("ZUNGR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00256             infoc_1.ok);
00257     infoc_1.infot = 2;
00258     zungr2_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &info);
00259     chkxer_("ZUNGR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00260             infoc_1.ok);
00261     infoc_1.infot = 2;
00262     zungr2_(&c__2, &c__1, &c__0, a, &c__2, x, w, &info);
00263     chkxer_("ZUNGR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00264             infoc_1.ok);
00265     infoc_1.infot = 3;
00266     zungr2_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &info);
00267     chkxer_("ZUNGR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00268             infoc_1.ok);
00269     infoc_1.infot = 3;
00270     zungr2_(&c__1, &c__2, &c__2, a, &c__2, x, w, &info);
00271     chkxer_("ZUNGR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00272             infoc_1.ok);
00273     infoc_1.infot = 5;
00274     zungr2_(&c__2, &c__2, &c__0, a, &c__1, x, w, &info);
00275     chkxer_("ZUNGR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00276             infoc_1.ok);
00277 
00278 /*     ZUNMRQ */
00279 
00280     s_copy(srnamc_1.srnamt, "ZUNMRQ", (ftnlen)32, (ftnlen)6);
00281     infoc_1.infot = 1;
00282     zunmrq_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
00283             info);
00284     chkxer_("ZUNMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00285             infoc_1.ok);
00286     infoc_1.infot = 2;
00287     zunmrq_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
00288             info);
00289     chkxer_("ZUNMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00290             infoc_1.ok);
00291     infoc_1.infot = 3;
00292     zunmrq_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
00293             info);
00294     chkxer_("ZUNMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00295             infoc_1.ok);
00296     infoc_1.infot = 4;
00297     zunmrq_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
00298             info);
00299     chkxer_("ZUNMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00300             infoc_1.ok);
00301     infoc_1.infot = 5;
00302     zunmrq_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &c__1, &
00303             info);
00304     chkxer_("ZUNMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00305             infoc_1.ok);
00306     infoc_1.infot = 5;
00307     zunmrq_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &c__1, &
00308             info);
00309     chkxer_("ZUNMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00310             infoc_1.ok);
00311     infoc_1.infot = 5;
00312     zunmrq_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &c__1, &
00313             info);
00314     chkxer_("ZUNMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00315             infoc_1.ok);
00316     infoc_1.infot = 7;
00317     zunmrq_("L", "N", &c__2, &c__1, &c__2, a, &c__1, x, af, &c__2, w, &c__1, &
00318             info);
00319     chkxer_("ZUNMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00320             infoc_1.ok);
00321     infoc_1.infot = 7;
00322     zunmrq_("R", "N", &c__1, &c__2, &c__2, a, &c__1, x, af, &c__1, w, &c__1, &
00323             info);
00324     chkxer_("ZUNMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00325             infoc_1.ok);
00326     infoc_1.infot = 10;
00327     zunmrq_("L", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
00328             info);
00329     chkxer_("ZUNMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00330             infoc_1.ok);
00331     infoc_1.infot = 12;
00332     zunmrq_("L", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
00333             info);
00334     chkxer_("ZUNMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00335             infoc_1.ok);
00336     infoc_1.infot = 12;
00337     zunmrq_("R", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, &
00338             info);
00339     chkxer_("ZUNMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00340             infoc_1.ok);
00341 
00342 /*     ZUNMR2 */
00343 
00344     s_copy(srnamc_1.srnamt, "ZUNMR2", (ftnlen)32, (ftnlen)6);
00345     infoc_1.infot = 1;
00346     zunmr2_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info);
00347     chkxer_("ZUNMR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00348             infoc_1.ok);
00349     infoc_1.infot = 2;
00350     zunmr2_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info);
00351     chkxer_("ZUNMR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00352             infoc_1.ok);
00353     infoc_1.infot = 3;
00354     zunmr2_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info);
00355     chkxer_("ZUNMR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00356             infoc_1.ok);
00357     infoc_1.infot = 4;
00358     zunmr2_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &info);
00359     chkxer_("ZUNMR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00360             infoc_1.ok);
00361     infoc_1.infot = 5;
00362     zunmr2_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &info);
00363     chkxer_("ZUNMR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00364             infoc_1.ok);
00365     infoc_1.infot = 5;
00366     zunmr2_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &info);
00367     chkxer_("ZUNMR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00368             infoc_1.ok);
00369     infoc_1.infot = 5;
00370     zunmr2_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &info);
00371     chkxer_("ZUNMR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00372             infoc_1.ok);
00373     infoc_1.infot = 7;
00374     zunmr2_("L", "N", &c__2, &c__1, &c__2, a, &c__1, x, af, &c__2, w, &info);
00375     chkxer_("ZUNMR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00376             infoc_1.ok);
00377     infoc_1.infot = 7;
00378     zunmr2_("R", "N", &c__1, &c__2, &c__2, a, &c__1, x, af, &c__1, w, &info);
00379     chkxer_("ZUNMR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00380             infoc_1.ok);
00381     infoc_1.infot = 10;
00382     zunmr2_("L", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__1, w, &info);
00383     chkxer_("ZUNMR2", &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 ZERRRQ */
00393 
00394 } /* zerrrq_ */