swiftnav: derrbd.c Source File

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