swiftnav: zerrbd.c Source File

Go to the documentation of this file.
00001 /* zerrbd.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 zerrbd_(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,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     /* System generated locals */
00047     integer i__1;
00048     doublereal d__1;
00049 
00050     /* Builtin functions */
00051     integer s_wsle(cilist *), e_wsle(void);
00052     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00053     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00054 
00055     /* Local variables */
00056     doublecomplex a[16] /* was [4][4] */;
00057     doublereal d__[4], e[4];
00058     integer i__, j;
00059     doublecomplex u[16] /* was [4][4] */, v[16] /* was [4][4] */, w[4];
00060     char c2[2];
00061     integer nt;
00062     doublecomplex tp[4], tq[4];
00063     doublereal rw[16];
00064     integer info;
00065     extern /* Subroutine */ int zgebrd_(integer *, integer *, doublecomplex *, 
00066              integer *, doublereal *, doublereal *, doublecomplex *, 
00067             doublecomplex *, doublecomplex *, integer *, integer *);
00068     extern logical lsamen_(integer *, char *, char *);
00069     extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical 
00070             *, logical *), zbdsqr_(char *, integer *, integer *, 
00071             integer *, integer *, doublereal *, doublereal *, doublecomplex *, 
00072              integer *, doublecomplex *, integer *, doublecomplex *, integer *
00073 , doublereal *, integer *), zungbr_(char *, integer *, 
00074             integer *, integer *, doublecomplex *, integer *, doublecomplex *, 
00075              doublecomplex *, integer *, integer *), zunmbr_(char *, 
00076             char *, char *, integer *, integer *, integer *, doublecomplex *, 
00077             integer *, doublecomplex *, doublecomplex *, integer *, 
00078             doublecomplex *, integer *, integer *);
00079 
00080     /* Fortran I/O blocks */
00081     static cilist io___1 = { 0, 0, 0, 0, 0 };
00082     static cilist io___16 = { 0, 0, 0, fmt_9999, 0 };
00083     static cilist io___17 = { 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 /*  ZERRBD tests the error exits for ZGEBRD, ZUNGBR, ZUNMBR, and ZBDSQR. */
00098 
00099 /*  Arguments */
00100 /*  ========= */
00101 
00102 /*  PATH    (input) CHARACTER*3 */
00103 /*          The LAPACK path name for the routines to be tested. */
00104 
00105 /*  NUNIT   (input) INTEGER */
00106 /*          The unit number for output. */
00107 
00108 /*  ===================================================================== */
00109 
00110 /*     .. Parameters .. */
00111 /*     .. */
00112 /*     .. Local Scalars .. */
00113 /*     .. */
00114 /*     .. Local Arrays .. */
00115 /*     .. */
00116 /*     .. External Functions .. */
00117 /*     .. */
00118 /*     .. External Subroutines .. */
00119 /*     .. */
00120 /*     .. Scalars in Common .. */
00121 /*     .. */
00122 /*     .. Common blocks .. */
00123 /*     .. */
00124 /*     .. Intrinsic Functions .. */
00125 /*     .. */
00126 /*     .. Executable Statements .. */
00127 
00128     infoc_1.nout = *nunit;
00129     io___1.ciunit = infoc_1.nout;
00130     s_wsle(&io___1);
00131     e_wsle();
00132     s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
00133 
00134 /*     Set the variables to innocuous values. */
00135 
00136     for (j = 1; j <= 4; ++j) {
00137         for (i__ = 1; i__ <= 4; ++i__) {
00138             i__1 = i__ + (j << 2) - 5;
00139             d__1 = 1. / (doublereal) (i__ + j);
00140             a[i__1].r = d__1, a[i__1].i = 0.;
00141 /* L10: */
00142         }
00143 /* L20: */
00144     }
00145     infoc_1.ok = TRUE_;
00146     nt = 0;
00147 
00148 /*     Test error exits of the SVD routines. */
00149 
00150     if (lsamen_(&c__2, c2, "BD")) {
00151 
00152 /*        ZGEBRD */
00153 
00154         s_copy(srnamc_1.srnamt, "ZGEBRD", (ftnlen)32, (ftnlen)6);
00155         infoc_1.infot = 1;
00156         zgebrd_(&c_n1, &c__0, a, &c__1, d__, e, tq, tp, w, &c__1, &info);
00157         chkxer_("ZGEBRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00158                 infoc_1.ok);
00159         infoc_1.infot = 2;
00160         zgebrd_(&c__0, &c_n1, a, &c__1, d__, e, tq, tp, w, &c__1, &info);
00161         chkxer_("ZGEBRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00162                 infoc_1.ok);
00163         infoc_1.infot = 4;
00164         zgebrd_(&c__2, &c__1, a, &c__1, d__, e, tq, tp, w, &c__2, &info);
00165         chkxer_("ZGEBRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00166                 infoc_1.ok);
00167         infoc_1.infot = 10;
00168         zgebrd_(&c__2, &c__1, a, &c__2, d__, e, tq, tp, w, &c__1, &info);
00169         chkxer_("ZGEBRD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00170                 infoc_1.ok);
00171         nt += 4;
00172 
00173 /*        ZUNGBR */
00174 
00175         s_copy(srnamc_1.srnamt, "ZUNGBR", (ftnlen)32, (ftnlen)6);
00176         infoc_1.infot = 1;
00177         zungbr_("/", &c__0, &c__0, &c__0, a, &c__1, tq, w, &c__1, &info);
00178         chkxer_("ZUNGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00179                 infoc_1.ok);
00180         infoc_1.infot = 2;
00181         zungbr_("Q", &c_n1, &c__0, &c__0, a, &c__1, tq, w, &c__1, &info);
00182         chkxer_("ZUNGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00183                 infoc_1.ok);
00184         infoc_1.infot = 3;
00185         zungbr_("Q", &c__0, &c_n1, &c__0, a, &c__1, tq, w, &c__1, &info);
00186         chkxer_("ZUNGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00187                 infoc_1.ok);
00188         infoc_1.infot = 3;
00189         zungbr_("Q", &c__0, &c__1, &c__0, a, &c__1, tq, w, &c__1, &info);
00190         chkxer_("ZUNGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00191                 infoc_1.ok);
00192         infoc_1.infot = 3;
00193         zungbr_("Q", &c__1, &c__0, &c__1, a, &c__1, tq, w, &c__1, &info);
00194         chkxer_("ZUNGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00195                 infoc_1.ok);
00196         infoc_1.infot = 3;
00197         zungbr_("P", &c__1, &c__0, &c__0, a, &c__1, tq, w, &c__1, &info);
00198         chkxer_("ZUNGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00199                 infoc_1.ok);
00200         infoc_1.infot = 3;
00201         zungbr_("P", &c__0, &c__1, &c__1, a, &c__1, tq, w, &c__1, &info);
00202         chkxer_("ZUNGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00203                 infoc_1.ok);
00204         infoc_1.infot = 4;
00205         zungbr_("Q", &c__0, &c__0, &c_n1, a, &c__1, tq, w, &c__1, &info);
00206         chkxer_("ZUNGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00207                 infoc_1.ok);
00208         infoc_1.infot = 6;
00209         zungbr_("Q", &c__2, &c__1, &c__1, a, &c__1, tq, w, &c__1, &info);
00210         chkxer_("ZUNGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00211                 infoc_1.ok);
00212         infoc_1.infot = 9;
00213         zungbr_("Q", &c__2, &c__2, &c__1, a, &c__2, tq, w, &c__1, &info);
00214         chkxer_("ZUNGBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00215                 infoc_1.ok);
00216         nt += 10;
00217 
00218 /*        ZUNMBR */
00219 
00220         s_copy(srnamc_1.srnamt, "ZUNMBR", (ftnlen)32, (ftnlen)6);
00221         infoc_1.infot = 1;
00222         zunmbr_("/", "L", "T", &c__0, &c__0, &c__0, a, &c__1, tq, u, &c__1, w, 
00223                  &c__1, &info);
00224         chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00225                 infoc_1.ok);
00226         infoc_1.infot = 2;
00227         zunmbr_("Q", "/", "T", &c__0, &c__0, &c__0, a, &c__1, tq, u, &c__1, w, 
00228                  &c__1, &info);
00229         chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00230                 infoc_1.ok);
00231         infoc_1.infot = 3;
00232         zunmbr_("Q", "L", "/", &c__0, &c__0, &c__0, a, &c__1, tq, u, &c__1, w, 
00233                  &c__1, &info);
00234         chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00235                 infoc_1.ok);
00236         infoc_1.infot = 4;
00237         zunmbr_("Q", "L", "C", &c_n1, &c__0, &c__0, a, &c__1, tq, u, &c__1, w, 
00238                  &c__1, &info);
00239         chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00240                 infoc_1.ok);
00241         infoc_1.infot = 5;
00242         zunmbr_("Q", "L", "C", &c__0, &c_n1, &c__0, a, &c__1, tq, u, &c__1, w, 
00243                  &c__1, &info);
00244         chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00245                 infoc_1.ok);
00246         infoc_1.infot = 6;
00247         zunmbr_("Q", "L", "C", &c__0, &c__0, &c_n1, a, &c__1, tq, u, &c__1, w, 
00248                  &c__1, &info);
00249         chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00250                 infoc_1.ok);
00251         infoc_1.infot = 8;
00252         zunmbr_("Q", "L", "C", &c__2, &c__0, &c__0, a, &c__1, tq, u, &c__2, w, 
00253                  &c__1, &info);
00254         chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00255                 infoc_1.ok);
00256         infoc_1.infot = 8;
00257         zunmbr_("Q", "R", "C", &c__0, &c__2, &c__0, a, &c__1, tq, u, &c__1, w, 
00258                  &c__1, &info);
00259         chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00260                 infoc_1.ok);
00261         infoc_1.infot = 8;
00262         zunmbr_("P", "L", "C", &c__2, &c__0, &c__2, a, &c__1, tq, u, &c__2, w, 
00263                  &c__1, &info);
00264         chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00265                 infoc_1.ok);
00266         infoc_1.infot = 8;
00267         zunmbr_("P", "R", "C", &c__0, &c__2, &c__2, a, &c__1, tq, u, &c__1, w, 
00268                  &c__1, &info);
00269         chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00270                 infoc_1.ok);
00271         infoc_1.infot = 11;
00272         zunmbr_("Q", "R", "C", &c__2, &c__0, &c__0, a, &c__1, tq, u, &c__1, w, 
00273                  &c__1, &info);
00274         chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00275                 infoc_1.ok);
00276         infoc_1.infot = 13;
00277         zunmbr_("Q", "L", "C", &c__0, &c__2, &c__0, a, &c__1, tq, u, &c__1, w, 
00278                  &c__0, &info);
00279         chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00280                 infoc_1.ok);
00281         infoc_1.infot = 13;
00282         zunmbr_("Q", "R", "C", &c__2, &c__0, &c__0, a, &c__1, tq, u, &c__2, w, 
00283                  &c__0, &info);
00284         chkxer_("ZUNMBR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00285                 infoc_1.ok);
00286         nt += 13;
00287 
00288 /*        ZBDSQR */
00289 
00290         s_copy(srnamc_1.srnamt, "ZBDSQR", (ftnlen)32, (ftnlen)6);
00291         infoc_1.infot = 1;
00292         zbdsqr_("/", &c__0, &c__0, &c__0, &c__0, d__, e, v, &c__1, u, &c__1, 
00293                 a, &c__1, rw, &info);
00294         chkxer_("ZBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00295                 infoc_1.ok);
00296         infoc_1.infot = 2;
00297         zbdsqr_("U", &c_n1, &c__0, &c__0, &c__0, d__, e, v, &c__1, u, &c__1, 
00298                 a, &c__1, rw, &info);
00299         chkxer_("ZBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00300                 infoc_1.ok);
00301         infoc_1.infot = 3;
00302         zbdsqr_("U", &c__0, &c_n1, &c__0, &c__0, d__, e, v, &c__1, u, &c__1, 
00303                 a, &c__1, rw, &info);
00304         chkxer_("ZBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00305                 infoc_1.ok);
00306         infoc_1.infot = 4;
00307         zbdsqr_("U", &c__0, &c__0, &c_n1, &c__0, d__, e, v, &c__1, u, &c__1, 
00308                 a, &c__1, rw, &info);
00309         chkxer_("ZBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00310                 infoc_1.ok);
00311         infoc_1.infot = 5;
00312         zbdsqr_("U", &c__0, &c__0, &c__0, &c_n1, d__, e, v, &c__1, u, &c__1, 
00313                 a, &c__1, rw, &info);
00314         chkxer_("ZBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00315                 infoc_1.ok);
00316         infoc_1.infot = 9;
00317         zbdsqr_("U", &c__2, &c__1, &c__0, &c__0, d__, e, v, &c__1, u, &c__1, 
00318                 a, &c__1, rw, &info);
00319         chkxer_("ZBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00320                 infoc_1.ok);
00321         infoc_1.infot = 11;
00322         zbdsqr_("U", &c__0, &c__0, &c__2, &c__0, d__, e, v, &c__1, u, &c__1, 
00323                 a, &c__1, rw, &info);
00324         chkxer_("ZBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00325                 infoc_1.ok);
00326         infoc_1.infot = 13;
00327         zbdsqr_("U", &c__2, &c__0, &c__0, &c__1, d__, e, v, &c__1, u, &c__1, 
00328                 a, &c__1, rw, &info);
00329         chkxer_("ZBDSQR", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00330                 infoc_1.ok);
00331         nt += 8;
00332     }
00333 
00334 /*     Print a summary line. */
00335 
00336     if (infoc_1.ok) {
00337         io___16.ciunit = infoc_1.nout;
00338         s_wsfe(&io___16);
00339         do_fio(&c__1, path, (ftnlen)3);
00340         do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer));
00341         e_wsfe();
00342     } else {
00343         io___17.ciunit = infoc_1.nout;
00344         s_wsfe(&io___17);
00345         do_fio(&c__1, path, (ftnlen)3);
00346         e_wsfe();
00347     }
00348 
00349 
00350     return 0;
00351 
00352 /*     End of ZERRBD */
00353 
00354 } /* zerrbd_ */