swiftnav: serrrq.c Source File

Go to the documentation of this file.
00001 /* serrrq.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 serrrq_(char *path, integer *nunit)
00039 {
00040     /* Builtin functions */
00041     integer s_wsle(cilist *), e_wsle(void);
00042     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00043 
00044     /* Local variables */
00045     real a[4]   /* was [2][2] */, b[2];
00046     integer i__, j;
00047     real w[2], x[2], af[4]      /* was [2][2] */;
00048     integer info;
00049     extern /* Subroutine */ int sgerq2_(integer *, integer *, real *, integer 
00050             *, real *, real *, integer *), sorgr2_(integer *, integer *, 
00051             integer *, real *, integer *, real *, real *, integer *), sormr2_(
00052             char *, char *, integer *, integer *, integer *, real *, integer *
00053 , real *, real *, integer *, real *, integer *), 
00054             alaesm_(char *, logical *, integer *), chkxer_(char *, 
00055             integer *, integer *, logical *, logical *), sgerqf_(
00056             integer *, integer *, real *, integer *, real *, real *, integer *
00057 , integer *), sgerqs_(integer *, integer *, integer *, real *, 
00058             integer *, real *, real *, integer *, real *, integer *, integer *
00059 ), sorgrq_(integer *, integer *, integer *, real *, integer *, 
00060             real *, real *, integer *, integer *), sormrq_(char *, char *, 
00061             integer *, integer *, integer *, real *, integer *, real *, real *
00062 , integer *, real *, integer *, integer *);
00063 
00064     /* Fortran I/O blocks */
00065     static cilist io___1 = { 0, 0, 0, 0, 0 };
00066 
00067 
00068 
00069 /*  -- LAPACK test routine (version 3.1) -- */
00070 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00071 /*     November 2006 */
00072 
00073 /*     .. Scalar Arguments .. */
00074 /*     .. */
00075 
00076 /*  Purpose */
00077 /*  ======= */
00078 
00079 /*  SERRRQ tests the error exits for the REAL routines */
00080 /*  that use the RQ decomposition of a general matrix. */
00081 
00082 /*  Arguments */
00083 /*  ========= */
00084 
00085 /*  PATH    (input) CHARACTER*3 */
00086 /*          The LAPACK path name for the routines to be tested. */
00087 
00088 /*  NUNIT   (input) INTEGER */
00089 /*          The unit number for output. */
00090 
00091 /*  ===================================================================== */
00092 
00093 /*     .. Parameters .. */
00094 /*     .. */
00095 /*     .. Local Scalars .. */
00096 /*     .. */
00097 /*     .. Local Arrays .. */
00098 /*     .. */
00099 /*     .. External Subroutines .. */
00100 /*     .. */
00101 /*     .. Scalars in Common .. */
00102 /*     .. */
00103 /*     .. Common blocks .. */
00104 /*     .. */
00105 /*     .. Intrinsic Functions .. */
00106 /*     .. */
00107 /*     .. Executable Statements .. */
00108 
00109     infoc_1.nout = *nunit;
00110     io___1.ciunit = infoc_1.nout;
00111     s_wsle(&io___1);
00112     e_wsle();
00113 
00114 /*     Set the variables to innocuous values. */
00115 
00116     for (j = 1; j <= 2; ++j) {
00117         for (i__ = 1; i__ <= 2; ++i__) {
00118             a[i__ + (j << 1) - 3] = 1.f / (real) (i__ + j);
00119             af[i__ + (j << 1) - 3] = 1.f / (real) (i__ + j);
00120 /* L10: */
00121         }
00122         b[j - 1] = 0.f;
00123         w[j - 1] = 0.f;
00124         x[j - 1] = 0.f;
00125 /* L20: */
00126     }
00127     infoc_1.ok = TRUE_;
00128 
00129 /*     Error exits for RQ factorization */
00130 
00131 /*     SGERQF */
00132 
00133     s_copy(srnamc_1.srnamt, "SGERQF", (ftnlen)32, (ftnlen)6);
00134     infoc_1.infot = 1;
00135     sgerqf_(&c_n1, &c__0, a, &c__1, b, w, &c__1, &info);
00136     chkxer_("SGERQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00137             infoc_1.ok);
00138     infoc_1.infot = 2;
00139     sgerqf_(&c__0, &c_n1, a, &c__1, b, w, &c__1, &info);
00140     chkxer_("SGERQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00141             infoc_1.ok);
00142     infoc_1.infot = 4;
00143     sgerqf_(&c__2, &c__1, a, &c__1, b, w, &c__2, &info);
00144     chkxer_("SGERQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00145             infoc_1.ok);
00146     infoc_1.infot = 7;
00147     sgerqf_(&c__2, &c__1, a, &c__2, b, w, &c__1, &info);
00148     chkxer_("SGERQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00149             infoc_1.ok);
00150 
00151 /*     SGERQ2 */
00152 
00153     s_copy(srnamc_1.srnamt, "SGERQ2", (ftnlen)32, (ftnlen)6);
00154     infoc_1.infot = 1;
00155     sgerq2_(&c_n1, &c__0, a, &c__1, b, w, &info);
00156     chkxer_("SGERQ2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00157             infoc_1.ok);
00158     infoc_1.infot = 2;
00159     sgerq2_(&c__0, &c_n1, a, &c__1, b, w, &info);
00160     chkxer_("SGERQ2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00161             infoc_1.ok);
00162     infoc_1.infot = 4;
00163     sgerq2_(&c__2, &c__1, a, &c__1, b, w, &info);
00164     chkxer_("SGERQ2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00165             infoc_1.ok);
00166 
00167 /*     SGERQS */
00168 
00169     s_copy(srnamc_1.srnamt, "SGERQS", (ftnlen)32, (ftnlen)6);
00170     infoc_1.infot = 1;
00171     sgerqs_(&c_n1, &c__0, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info);
00172     chkxer_("SGERQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00173             infoc_1.ok);
00174     infoc_1.infot = 2;
00175     sgerqs_(&c__0, &c_n1, &c__0, a, &c__1, x, b, &c__1, w, &c__1, &info);
00176     chkxer_("SGERQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00177             infoc_1.ok);
00178     infoc_1.infot = 2;
00179     sgerqs_(&c__2, &c__1, &c__0, a, &c__2, x, b, &c__1, w, &c__1, &info);
00180     chkxer_("SGERQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00181             infoc_1.ok);
00182     infoc_1.infot = 3;
00183     sgerqs_(&c__0, &c__0, &c_n1, a, &c__1, x, b, &c__1, w, &c__1, &info);
00184     chkxer_("SGERQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00185             infoc_1.ok);
00186     infoc_1.infot = 5;
00187     sgerqs_(&c__2, &c__2, &c__0, a, &c__1, x, b, &c__2, w, &c__1, &info);
00188     chkxer_("SGERQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00189             infoc_1.ok);
00190     infoc_1.infot = 8;
00191     sgerqs_(&c__2, &c__2, &c__0, a, &c__2, x, b, &c__1, w, &c__1, &info);
00192     chkxer_("SGERQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00193             infoc_1.ok);
00194     infoc_1.infot = 10;
00195     sgerqs_(&c__1, &c__1, &c__2, a, &c__1, x, b, &c__1, w, &c__1, &info);
00196     chkxer_("SGERQS", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00197             infoc_1.ok);
00198 
00199 /*     SORGRQ */
00200 
00201     s_copy(srnamc_1.srnamt, "SORGRQ", (ftnlen)32, (ftnlen)6);
00202     infoc_1.infot = 1;
00203     sorgrq_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &c__1, &info);
00204     chkxer_("SORGRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00205             infoc_1.ok);
00206     infoc_1.infot = 2;
00207     sorgrq_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &c__1, &info);
00208     chkxer_("SORGRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00209             infoc_1.ok);
00210     infoc_1.infot = 2;
00211     sorgrq_(&c__2, &c__1, &c__0, a, &c__2, x, w, &c__2, &info);
00212     chkxer_("SORGRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00213             infoc_1.ok);
00214     infoc_1.infot = 3;
00215     sorgrq_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &c__1, &info);
00216     chkxer_("SORGRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00217             infoc_1.ok);
00218     infoc_1.infot = 3;
00219     sorgrq_(&c__1, &c__2, &c__2, a, &c__1, x, w, &c__1, &info);
00220     chkxer_("SORGRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00221             infoc_1.ok);
00222     infoc_1.infot = 5;
00223     sorgrq_(&c__2, &c__2, &c__0, a, &c__1, x, w, &c__2, &info);
00224     chkxer_("SORGRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00225             infoc_1.ok);
00226     infoc_1.infot = 8;
00227     sorgrq_(&c__2, &c__2, &c__0, a, &c__2, x, w, &c__1, &info);
00228     chkxer_("SORGRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00229             infoc_1.ok);
00230 
00231 /*     SORGR2 */
00232 
00233     s_copy(srnamc_1.srnamt, "SORGR2", (ftnlen)32, (ftnlen)6);
00234     infoc_1.infot = 1;
00235     sorgr2_(&c_n1, &c__0, &c__0, a, &c__1, x, w, &info);
00236     chkxer_("SORGR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00237             infoc_1.ok);
00238     infoc_1.infot = 2;
00239     sorgr2_(&c__0, &c_n1, &c__0, a, &c__1, x, w, &info);
00240     chkxer_("SORGR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00241             infoc_1.ok);
00242     infoc_1.infot = 2;
00243     sorgr2_(&c__2, &c__1, &c__0, a, &c__2, x, w, &info);
00244     chkxer_("SORGR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00245             infoc_1.ok);
00246     infoc_1.infot = 3;
00247     sorgr2_(&c__0, &c__0, &c_n1, a, &c__1, x, w, &info);
00248     chkxer_("SORGR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00249             infoc_1.ok);
00250     infoc_1.infot = 3;
00251     sorgr2_(&c__1, &c__2, &c__2, a, &c__2, x, w, &info);
00252     chkxer_("SORGR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00253             infoc_1.ok);
00254     infoc_1.infot = 5;
00255     sorgr2_(&c__2, &c__2, &c__0, a, &c__1, x, w, &info);
00256     chkxer_("SORGR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00257             infoc_1.ok);
00258 
00259 /*     SORMRQ */
00260 
00261     s_copy(srnamc_1.srnamt, "SORMRQ", (ftnlen)32, (ftnlen)6);
00262     infoc_1.infot = 1;
00263     sormrq_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
00264             info);
00265     chkxer_("SORMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00266             infoc_1.ok);
00267     infoc_1.infot = 2;
00268     sormrq_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
00269             info);
00270     chkxer_("SORMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00271             infoc_1.ok);
00272     infoc_1.infot = 3;
00273     sormrq_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
00274             info);
00275     chkxer_("SORMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00276             infoc_1.ok);
00277     infoc_1.infot = 4;
00278     sormrq_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
00279             info);
00280     chkxer_("SORMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00281             infoc_1.ok);
00282     infoc_1.infot = 5;
00283     sormrq_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &c__1, &
00284             info);
00285     chkxer_("SORMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00286             infoc_1.ok);
00287     infoc_1.infot = 5;
00288     sormrq_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &c__1, &
00289             info);
00290     chkxer_("SORMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00291             infoc_1.ok);
00292     infoc_1.infot = 5;
00293     sormrq_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &c__1, &
00294             info);
00295     chkxer_("SORMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00296             infoc_1.ok);
00297     infoc_1.infot = 7;
00298     sormrq_("L", "N", &c__2, &c__1, &c__2, a, &c__1, x, af, &c__2, w, &c__1, &
00299             info);
00300     chkxer_("SORMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00301             infoc_1.ok);
00302     infoc_1.infot = 7;
00303     sormrq_("R", "N", &c__1, &c__2, &c__2, a, &c__1, x, af, &c__1, w, &c__1, &
00304             info);
00305     chkxer_("SORMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00306             infoc_1.ok);
00307     infoc_1.infot = 10;
00308     sormrq_("L", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
00309             info);
00310     chkxer_("SORMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00311             infoc_1.ok);
00312     infoc_1.infot = 12;
00313     sormrq_("L", "N", &c__1, &c__2, &c__0, a, &c__1, x, af, &c__1, w, &c__1, &
00314             info);
00315     chkxer_("SORMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00316             infoc_1.ok);
00317     infoc_1.infot = 12;
00318     sormrq_("R", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__2, w, &c__1, &
00319             info);
00320     chkxer_("SORMRQ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00321             infoc_1.ok);
00322 
00323 /*     SORMR2 */
00324 
00325     s_copy(srnamc_1.srnamt, "SORMR2", (ftnlen)32, (ftnlen)6);
00326     infoc_1.infot = 1;
00327     sormr2_("/", "N", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info);
00328     chkxer_("SORMR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00329             infoc_1.ok);
00330     infoc_1.infot = 2;
00331     sormr2_("L", "/", &c__0, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info);
00332     chkxer_("SORMR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00333             infoc_1.ok);
00334     infoc_1.infot = 3;
00335     sormr2_("L", "N", &c_n1, &c__0, &c__0, a, &c__1, x, af, &c__1, w, &info);
00336     chkxer_("SORMR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00337             infoc_1.ok);
00338     infoc_1.infot = 4;
00339     sormr2_("L", "N", &c__0, &c_n1, &c__0, a, &c__1, x, af, &c__1, w, &info);
00340     chkxer_("SORMR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00341             infoc_1.ok);
00342     infoc_1.infot = 5;
00343     sormr2_("L", "N", &c__0, &c__0, &c_n1, a, &c__1, x, af, &c__1, w, &info);
00344     chkxer_("SORMR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00345             infoc_1.ok);
00346     infoc_1.infot = 5;
00347     sormr2_("L", "N", &c__0, &c__1, &c__1, a, &c__1, x, af, &c__1, w, &info);
00348     chkxer_("SORMR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00349             infoc_1.ok);
00350     infoc_1.infot = 5;
00351     sormr2_("R", "N", &c__1, &c__0, &c__1, a, &c__1, x, af, &c__1, w, &info);
00352     chkxer_("SORMR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00353             infoc_1.ok);
00354     infoc_1.infot = 7;
00355     sormr2_("L", "N", &c__2, &c__1, &c__2, a, &c__1, x, af, &c__2, w, &info);
00356     chkxer_("SORMR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00357             infoc_1.ok);
00358     infoc_1.infot = 7;
00359     sormr2_("R", "N", &c__1, &c__2, &c__2, a, &c__1, x, af, &c__1, w, &info);
00360     chkxer_("SORMR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00361             infoc_1.ok);
00362     infoc_1.infot = 10;
00363     sormr2_("L", "N", &c__2, &c__1, &c__0, a, &c__1, x, af, &c__1, w, &info);
00364     chkxer_("SORMR2", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00365             infoc_1.ok);
00366 
00367 /*     Print a summary line. */
00368 
00369     alaesm_(path, &infoc_1.ok, &infoc_1.nout);
00370 
00371     return 0;
00372 
00373 /*     End of SERRRQ */
00374 
00375 } /* serrrq_ */