zerrec.c
Go to the documentation of this file.
00001 /* zerrec.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__1 = 1;
00034 static integer c__0 = 0;
00035 static integer c_n1 = -1;
00036 static integer c__2 = 2;
00037 static integer c__3 = 3;
00038 
00039 /* Subroutine */ int zerrec_(char *path, integer *nunit)
00040 {
00041     /* Format strings */
00042     static char fmt_9999[] = "(1x,a3,\002 routines passed the tests of the e"
00043             "rror exits (\002,i3,\002 tests done)\002)";
00044     static char fmt_9998[] = "(\002 *** \002,a3,\002 routines failed the tes"
00045             "ts of the error \002,\002exits ***\002)";
00046 
00047     /* System generated locals */
00048     integer i__1;
00049 
00050     /* Builtin functions */
00051     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00052     integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00053 
00054     /* Local variables */
00055     doublecomplex a[16] /* was [4][4] */, b[16] /* was [4][4] */, c__[16]       
00056             /* was [4][4] */;
00057     integer i__, j, m;
00058     doublereal s[4];
00059     doublecomplex x[4];
00060     integer nt;
00061     doublereal rw[24];
00062     logical sel[4];
00063     doublereal sep[4];
00064     integer info, ifst, ilst;
00065     doublecomplex work[24];
00066     doublereal scale;
00067     extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical 
00068             *, logical *), ztrexc_(char *, integer *, doublecomplex *, 
00069              integer *, doublecomplex *, integer *, integer *, integer *, 
00070             integer *), ztrsna_(char *, char *, logical *, integer *, 
00071             doublecomplex *, integer *, doublecomplex *, integer *, 
00072             doublecomplex *, integer *, doublereal *, doublereal *, integer *, 
00073              integer *, doublecomplex *, integer *, doublereal *, integer *), ztrsen_(char *, char *, logical *, integer *, 
00074             doublecomplex *, integer *, doublecomplex *, integer *, 
00075             doublecomplex *, integer *, doublereal *, doublereal *, 
00076             doublecomplex *, integer *, integer *), ztrsyl_(
00077             char *, char *, integer *, integer *, integer *, doublecomplex *, 
00078             integer *, doublecomplex *, integer *, doublecomplex *, integer *, 
00079              doublereal *, integer *);
00080 
00081     /* Fortran I/O blocks */
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 /*  ZERREC tests the error exits for the routines for eigen- condition */
00098 /*  estimation for DOUBLE PRECISION matrices: */
00099 /*     ZTRSYL, CTREXC, CTRSNA and CTRSEN. */
00100 
00101 /*  Arguments */
00102 /*  ========= */
00103 
00104 /*  PATH    (input) CHARACTER*3 */
00105 /*          The LAPACK path name for the routines to be tested. */
00106 
00107 /*  NUNIT   (input) INTEGER */
00108 /*          The unit number for output. */
00109 
00110 /*  ===================================================================== */
00111 
00112 /*     .. Parameters .. */
00113 /*     .. */
00114 /*     .. Local Scalars .. */
00115 /*     .. */
00116 /*     .. Local Arrays .. */
00117 /*     .. */
00118 /*     .. External Subroutines .. */
00119 /*     .. */
00120 /*     .. Scalars in Common .. */
00121 /*     .. */
00122 /*     .. Common blocks .. */
00123 /*     .. */
00124 /*     .. Executable Statements .. */
00125 
00126     infoc_1.nout = *nunit;
00127     infoc_1.ok = TRUE_;
00128     nt = 0;
00129 
00130 /*     Initialize A, B and SEL */
00131 
00132     for (j = 1; j <= 4; ++j) {
00133         for (i__ = 1; i__ <= 4; ++i__) {
00134             i__1 = i__ + (j << 2) - 5;
00135             a[i__1].r = 0., a[i__1].i = 0.;
00136             i__1 = i__ + (j << 2) - 5;
00137             b[i__1].r = 0., b[i__1].i = 0.;
00138 /* L10: */
00139         }
00140 /* L20: */
00141     }
00142     for (i__ = 1; i__ <= 4; ++i__) {
00143         i__1 = i__ + (i__ << 2) - 5;
00144         a[i__1].r = 1., a[i__1].i = 0.;
00145         sel[i__ - 1] = TRUE_;
00146 /* L30: */
00147     }
00148 
00149 /*     Test ZTRSYL */
00150 
00151     s_copy(srnamc_1.srnamt, "ZTRSYL", (ftnlen)32, (ftnlen)6);
00152     infoc_1.infot = 1;
00153     ztrsyl_("X", "N", &c__1, &c__0, &c__0, a, &c__1, b, &c__1, c__, &c__1, &
00154             scale, &info);
00155     chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00156             infoc_1.ok);
00157     infoc_1.infot = 2;
00158     ztrsyl_("N", "X", &c__1, &c__0, &c__0, a, &c__1, b, &c__1, c__, &c__1, &
00159             scale, &info);
00160     chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00161             infoc_1.ok);
00162     infoc_1.infot = 3;
00163     ztrsyl_("N", "N", &c__0, &c__0, &c__0, a, &c__1, b, &c__1, c__, &c__1, &
00164             scale, &info);
00165     chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00166             infoc_1.ok);
00167     infoc_1.infot = 4;
00168     ztrsyl_("N", "N", &c__1, &c_n1, &c__0, a, &c__1, b, &c__1, c__, &c__1, &
00169             scale, &info);
00170     chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00171             infoc_1.ok);
00172     infoc_1.infot = 5;
00173     ztrsyl_("N", "N", &c__1, &c__0, &c_n1, a, &c__1, b, &c__1, c__, &c__1, &
00174             scale, &info);
00175     chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00176             infoc_1.ok);
00177     infoc_1.infot = 7;
00178     ztrsyl_("N", "N", &c__1, &c__2, &c__0, a, &c__1, b, &c__1, c__, &c__2, &
00179             scale, &info);
00180     chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00181             infoc_1.ok);
00182     infoc_1.infot = 9;
00183     ztrsyl_("N", "N", &c__1, &c__0, &c__2, a, &c__1, b, &c__1, c__, &c__1, &
00184             scale, &info);
00185     chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00186             infoc_1.ok);
00187     infoc_1.infot = 11;
00188     ztrsyl_("N", "N", &c__1, &c__2, &c__0, a, &c__2, b, &c__1, c__, &c__1, &
00189             scale, &info);
00190     chkxer_("ZTRSYL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00191             infoc_1.ok);
00192     nt += 8;
00193 
00194 /*     Test ZTREXC */
00195 
00196     s_copy(srnamc_1.srnamt, "ZTREXC", (ftnlen)32, (ftnlen)6);
00197     ifst = 1;
00198     ilst = 1;
00199     infoc_1.infot = 1;
00200     ztrexc_("X", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, &info);
00201     chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00202             infoc_1.ok);
00203     infoc_1.infot = 7;
00204     ztrexc_("N", &c__0, a, &c__1, b, &c__1, &ifst, &ilst, &info);
00205     chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00206             infoc_1.ok);
00207     infoc_1.infot = 4;
00208     ilst = 2;
00209     ztrexc_("N", &c__2, a, &c__1, b, &c__1, &ifst, &ilst, &info);
00210     chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00211             infoc_1.ok);
00212     infoc_1.infot = 6;
00213     ztrexc_("V", &c__2, a, &c__2, b, &c__1, &ifst, &ilst, &info);
00214     chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00215             infoc_1.ok);
00216     infoc_1.infot = 7;
00217     ifst = 0;
00218     ilst = 1;
00219     ztrexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, &info);
00220     chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00221             infoc_1.ok);
00222     infoc_1.infot = 7;
00223     ifst = 2;
00224     ztrexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, &info);
00225     chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00226             infoc_1.ok);
00227     infoc_1.infot = 8;
00228     ifst = 1;
00229     ilst = 0;
00230     ztrexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, &info);
00231     chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00232             infoc_1.ok);
00233     infoc_1.infot = 8;
00234     ilst = 2;
00235     ztrexc_("V", &c__1, a, &c__1, b, &c__1, &ifst, &ilst, &info);
00236     chkxer_("ZTREXC", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00237             infoc_1.ok);
00238     nt += 8;
00239 
00240 /*     Test ZTRSNA */
00241 
00242     s_copy(srnamc_1.srnamt, "ZTRSNA", (ftnlen)32, (ftnlen)6);
00243     infoc_1.infot = 1;
00244     ztrsna_("X", "A", sel, &c__0, a, &c__1, b, &c__1, c__, &c__1, s, sep, &
00245             c__1, &m, work, &c__1, rw, &info);
00246     chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00247             infoc_1.ok);
00248     infoc_1.infot = 2;
00249     ztrsna_("B", "X", sel, &c__0, a, &c__1, b, &c__1, c__, &c__1, s, sep, &
00250             c__1, &m, work, &c__1, rw, &info);
00251     chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00252             infoc_1.ok);
00253     infoc_1.infot = 4;
00254     ztrsna_("B", "A", sel, &c_n1, a, &c__1, b, &c__1, c__, &c__1, s, sep, &
00255             c__1, &m, work, &c__1, rw, &info);
00256     chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00257             infoc_1.ok);
00258     infoc_1.infot = 6;
00259     ztrsna_("V", "A", sel, &c__2, a, &c__1, b, &c__1, c__, &c__1, s, sep, &
00260             c__2, &m, work, &c__2, rw, &info);
00261     chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00262             infoc_1.ok);
00263     infoc_1.infot = 8;
00264     ztrsna_("B", "A", sel, &c__2, a, &c__2, b, &c__1, c__, &c__2, s, sep, &
00265             c__2, &m, work, &c__2, rw, &info);
00266     chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00267             infoc_1.ok);
00268     infoc_1.infot = 10;
00269     ztrsna_("B", "A", sel, &c__2, a, &c__2, b, &c__2, c__, &c__1, s, sep, &
00270             c__2, &m, work, &c__2, rw, &info);
00271     chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00272             infoc_1.ok);
00273     infoc_1.infot = 13;
00274     ztrsna_("B", "A", sel, &c__1, a, &c__1, b, &c__1, c__, &c__1, s, sep, &
00275             c__0, &m, work, &c__1, rw, &info);
00276     chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00277             infoc_1.ok);
00278     infoc_1.infot = 13;
00279     ztrsna_("B", "S", sel, &c__2, a, &c__2, b, &c__2, c__, &c__2, s, sep, &
00280             c__1, &m, work, &c__1, rw, &info);
00281     chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00282             infoc_1.ok);
00283     infoc_1.infot = 16;
00284     ztrsna_("B", "A", sel, &c__2, a, &c__2, b, &c__2, c__, &c__2, s, sep, &
00285             c__2, &m, work, &c__1, rw, &info);
00286     chkxer_("ZTRSNA", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00287             infoc_1.ok);
00288     nt += 9;
00289 
00290 /*     Test ZTRSEN */
00291 
00292     sel[0] = FALSE_;
00293     s_copy(srnamc_1.srnamt, "ZTRSEN", (ftnlen)32, (ftnlen)6);
00294     infoc_1.infot = 1;
00295     ztrsen_("X", "N", sel, &c__0, a, &c__1, b, &c__1, x, &m, s, sep, work, &
00296             c__1, &info);
00297     chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00298             infoc_1.ok);
00299     infoc_1.infot = 2;
00300     ztrsen_("N", "X", sel, &c__0, a, &c__1, b, &c__1, x, &m, s, sep, work, &
00301             c__1, &info);
00302     chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00303             infoc_1.ok);
00304     infoc_1.infot = 4;
00305     ztrsen_("N", "N", sel, &c_n1, a, &c__1, b, &c__1, x, &m, s, sep, work, &
00306             c__1, &info);
00307     chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00308             infoc_1.ok);
00309     infoc_1.infot = 6;
00310     ztrsen_("N", "N", sel, &c__2, a, &c__1, b, &c__1, x, &m, s, sep, work, &
00311             c__2, &info);
00312     chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00313             infoc_1.ok);
00314     infoc_1.infot = 8;
00315     ztrsen_("N", "V", sel, &c__2, a, &c__2, b, &c__1, x, &m, s, sep, work, &
00316             c__1, &info);
00317     chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00318             infoc_1.ok);
00319     infoc_1.infot = 14;
00320     ztrsen_("N", "V", sel, &c__2, a, &c__2, b, &c__2, x, &m, s, sep, work, &
00321             c__0, &info);
00322     chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00323             infoc_1.ok);
00324     infoc_1.infot = 14;
00325     ztrsen_("E", "V", sel, &c__3, a, &c__3, b, &c__3, x, &m, s, sep, work, &
00326             c__1, &info);
00327     chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00328             infoc_1.ok);
00329     infoc_1.infot = 14;
00330     ztrsen_("V", "V", sel, &c__3, a, &c__3, b, &c__3, x, &m, s, sep, work, &
00331             c__3, &info);
00332     chkxer_("ZTRSEN", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00333             infoc_1.ok);
00334     nt += 8;
00335 
00336 /*     Print a summary line. */
00337 
00338     if (infoc_1.ok) {
00339         io___18.ciunit = infoc_1.nout;
00340         s_wsfe(&io___18);
00341         do_fio(&c__1, path, (ftnlen)3);
00342         do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer));
00343         e_wsfe();
00344     } else {
00345         io___19.ciunit = infoc_1.nout;
00346         s_wsfe(&io___19);
00347         do_fio(&c__1, path, (ftnlen)3);
00348         e_wsfe();
00349     }
00350 
00351     return 0;
00352 
00353 /*     End of ZERREC */
00354 
00355 } /* zerrec_ */

swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:56:24