swiftnav: serrql.c Source File

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