swiftnav: derrql.c Source File

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