swiftnav: derrrq.c Source File

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