swiftnav: serrbd.c Source File

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