swiftnav: cerrbd.c Source File

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