swiftnav: cerrrq.c Source File

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