dchkec.c
Go to the documentation of this file.
00001 /* dchkec.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 /* Table of constant values */
00017 
00018 static integer c__1 = 1;
00019 static integer c__2 = 2;
00020 static integer c__3 = 3;
00021 
00022 /* Subroutine */ int dchkec_(doublereal *thresh, logical *tsterr, integer *
00023         nin, integer *nout)
00024 {
00025     /* Format strings */
00026     static char fmt_9989[] = "(\002 Tests of the Nonsymmetric eigenproblem c"
00027             "ondition estim\002,\002ation routines\002,/\002 DLALN2, DLASY2, "
00028             "DLANV2, DLAEXC, DTRS\002,\002YL, DTREXC, DTRSNA, DTRSEN, DLAQT"
00029             "R\002,/)";
00030     static char fmt_9988[] = "(\002 Relative machine precision (EPS) = \002,"
00031             "d16.6,/\002 Safe \002,\002minimum (SFMIN)             = \002,d16"
00032             ".6,/)";
00033     static char fmt_9987[] = "(\002 Routines pass computational tests if tes"
00034             "t ratio is les\002,\002s than\002,f8.2,//)";
00035     static char fmt_9999[] = "(\002 Error in DLALN2: RMAX =\002,d12.3,/\002 "
00036             "LMAX = \002,i8,\002 N\002,\002INFO=\002,2i8,\002 KNT=\002,i8)";
00037     static char fmt_9998[] = "(\002 Error in DLASY2: RMAX =\002,d12.3,/\002 "
00038             "LMAX = \002,i8,\002 N\002,\002INFO=\002,i8,\002 KNT=\002,i8)";
00039     static char fmt_9997[] = "(\002 Error in DLANV2: RMAX =\002,d12.3,/\002 "
00040             "LMAX = \002,i8,\002 N\002,\002INFO=\002,i8,\002 KNT=\002,i8)";
00041     static char fmt_9996[] = "(\002 Error in DLAEXC: RMAX =\002,d12.3,/\002 "
00042             "LMAX = \002,i8,\002 N\002,\002INFO=\002,2i8,\002 KNT=\002,i8)";
00043     static char fmt_9995[] = "(\002 Error in DTRSYL: RMAX =\002,d12.3,/\002 "
00044             "LMAX = \002,i8,\002 N\002,\002INFO=\002,i8,\002 KNT=\002,i8)";
00045     static char fmt_9994[] = "(\002 Error in DTREXC: RMAX =\002,d12.3,/\002 "
00046             "LMAX = \002,i8,\002 N\002,\002INFO=\002,3i8,\002 KNT=\002,i8)";
00047     static char fmt_9993[] = "(\002 Error in DTRSNA: RMAX =\002,3d12.3,/\002"
00048             " LMAX = \002,3i8,\002 NINFO=\002,3i8,\002 KNT=\002,i8)";
00049     static char fmt_9992[] = "(\002 Error in DTRSEN: RMAX =\002,3d12.3,/\002"
00050             " LMAX = \002,3i8,\002 NINFO=\002,3i8,\002 KNT=\002,i8)";
00051     static char fmt_9991[] = "(\002 Error in DLAQTR: RMAX =\002,d12.3,/\002 "
00052             "LMAX = \002,i8,\002 N\002,\002INFO=\002,i8,\002 KNT=\002,i8)";
00053     static char fmt_9990[] = "(/1x,\002All tests for \002,a3,\002 routines p"
00054             "assed the thresh\002,\002old (\002,i6,\002 tests run)\002)";
00055 
00056     /* Builtin functions */
00057     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00058     integer s_wsfe(cilist *), e_wsfe(void), do_fio(integer *, char *, ftnlen);
00059 
00060     /* Local variables */
00061     logical ok;
00062     doublereal eps;
00063     char path[3];
00064     extern /* Subroutine */ int dget31_(doublereal *, integer *, integer *, 
00065             integer *), dget32_(doublereal *, integer *, integer *, integer *)
00066             , dget33_(doublereal *, integer *, integer *, integer *), dget34_(
00067             doublereal *, integer *, integer *, integer *), dget35_(
00068             doublereal *, integer *, integer *, integer *), dget36_(
00069             doublereal *, integer *, integer *, integer *, integer *), 
00070             dget37_(doublereal *, integer *, integer *, integer *, integer *),
00071              dget38_(doublereal *, integer *, integer *, integer *, integer *)
00072             , dget39_(doublereal *, integer *, integer *, integer *);
00073     doublereal sfmin;
00074     integer klaln2, llaln2, nlaln2[2];
00075     doublereal rlaln2;
00076     integer klanv2, llanv2, nlanv2;
00077     doublereal rlanv2;
00078     integer klasy2, llasy2, nlasy2;
00079     doublereal rlasy2;
00080     extern doublereal dlamch_(char *);
00081     extern /* Subroutine */ int derrec_(char *, integer *);
00082     integer klaexc, llaexc, nlaexc[2];
00083     doublereal rlaexc;
00084     integer klaqtr, llaqtr, ktrexc, ltrexc, ktrsna, nlaqtr, ltrsna[3];
00085     doublereal rlaqtr;
00086     integer ktrsen;
00087     doublereal rtrexc;
00088     integer ltrsen[3], ntrexc[3], ntrsen[3], ntrsna[3];
00089     doublereal rtrsna[3], rtrsen[3];
00090     integer ntests, ktrsyl, ltrsyl, ntrsyl;
00091     doublereal rtrsyl;
00092 
00093     /* Fortran I/O blocks */
00094     static cilist io___4 = { 0, 0, 0, fmt_9989, 0 };
00095     static cilist io___5 = { 0, 0, 0, fmt_9988, 0 };
00096     static cilist io___6 = { 0, 0, 0, fmt_9987, 0 };
00097     static cilist io___12 = { 0, 0, 0, fmt_9999, 0 };
00098     static cilist io___17 = { 0, 0, 0, fmt_9998, 0 };
00099     static cilist io___22 = { 0, 0, 0, fmt_9997, 0 };
00100     static cilist io___27 = { 0, 0, 0, fmt_9996, 0 };
00101     static cilist io___32 = { 0, 0, 0, fmt_9995, 0 };
00102     static cilist io___37 = { 0, 0, 0, fmt_9994, 0 };
00103     static cilist io___42 = { 0, 0, 0, fmt_9993, 0 };
00104     static cilist io___47 = { 0, 0, 0, fmt_9992, 0 };
00105     static cilist io___52 = { 0, 0, 0, fmt_9991, 0 };
00106     static cilist io___54 = { 0, 0, 0, fmt_9990, 0 };
00107 
00108 
00109 
00110 /*  -- LAPACK test routine (version 3.1) -- */
00111 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00112 /*     November 2006 */
00113 
00114 /*     .. Scalar Arguments .. */
00115 /*     .. */
00116 
00117 /*  Purpose */
00118 /*  ======= */
00119 
00120 /*  DCHKEC tests eigen- condition estimation routines */
00121 /*         DLALN2, DLASY2, DLANV2, DLAQTR, DLAEXC, */
00122 /*         DTRSYL, DTREXC, DTRSNA, DTRSEN */
00123 
00124 /*  In all cases, the routine runs through a fixed set of numerical */
00125 /*  examples, subjects them to various tests, and compares the test */
00126 /*  results to a threshold THRESH. In addition, DTREXC, DTRSNA and DTRSEN */
00127 /*  are tested by reading in precomputed examples from a file (on input */
00128 /*  unit NIN).  Output is written to output unit NOUT. */
00129 
00130 /*  Arguments */
00131 /*  ========= */
00132 
00133 /*  THRESH  (input) DOUBLE PRECISION */
00134 /*          Threshold for residual tests.  A computed test ratio passes */
00135 /*          the threshold if it is less than THRESH. */
00136 
00137 /*  TSTERR  (input) LOGICAL */
00138 /*          Flag that indicates whether error exits are to be tested. */
00139 
00140 /*  NIN     (input) INTEGER */
00141 /*          The logical unit number for input. */
00142 
00143 /*  NOUT    (input) INTEGER */
00144 /*          The logical unit number for output. */
00145 
00146 /*  ===================================================================== */
00147 
00148 /*     .. Local Scalars .. */
00149 /*     .. */
00150 /*     .. Local Arrays .. */
00151 /*     .. */
00152 /*     .. External Subroutines .. */
00153 /*     .. */
00154 /*     .. External Functions .. */
00155 /*     .. */
00156 /*     .. Executable Statements .. */
00157 
00158     s_copy(path, "Double precision", (ftnlen)1, (ftnlen)16);
00159     s_copy(path + 1, "EC", (ftnlen)2, (ftnlen)2);
00160     eps = dlamch_("P");
00161     sfmin = dlamch_("S");
00162 
00163 /*     Print header information */
00164 
00165     io___4.ciunit = *nout;
00166     s_wsfe(&io___4);
00167     e_wsfe();
00168     io___5.ciunit = *nout;
00169     s_wsfe(&io___5);
00170     do_fio(&c__1, (char *)&eps, (ftnlen)sizeof(doublereal));
00171     do_fio(&c__1, (char *)&sfmin, (ftnlen)sizeof(doublereal));
00172     e_wsfe();
00173     io___6.ciunit = *nout;
00174     s_wsfe(&io___6);
00175     do_fio(&c__1, (char *)&(*thresh), (ftnlen)sizeof(doublereal));
00176     e_wsfe();
00177 
00178 /*     Test error exits if TSTERR is .TRUE. */
00179 
00180     if (*tsterr) {
00181         derrec_(path, nout);
00182     }
00183 
00184     ok = TRUE_;
00185     dget31_(&rlaln2, &llaln2, nlaln2, &klaln2);
00186     if (rlaln2 > *thresh || nlaln2[0] != 0) {
00187         ok = FALSE_;
00188         io___12.ciunit = *nout;
00189         s_wsfe(&io___12);
00190         do_fio(&c__1, (char *)&rlaln2, (ftnlen)sizeof(doublereal));
00191         do_fio(&c__1, (char *)&llaln2, (ftnlen)sizeof(integer));
00192         do_fio(&c__2, (char *)&nlaln2[0], (ftnlen)sizeof(integer));
00193         do_fio(&c__1, (char *)&klaln2, (ftnlen)sizeof(integer));
00194         e_wsfe();
00195     }
00196 
00197     dget32_(&rlasy2, &llasy2, &nlasy2, &klasy2);
00198     if (rlasy2 > *thresh) {
00199         ok = FALSE_;
00200         io___17.ciunit = *nout;
00201         s_wsfe(&io___17);
00202         do_fio(&c__1, (char *)&rlasy2, (ftnlen)sizeof(doublereal));
00203         do_fio(&c__1, (char *)&llasy2, (ftnlen)sizeof(integer));
00204         do_fio(&c__1, (char *)&nlasy2, (ftnlen)sizeof(integer));
00205         do_fio(&c__1, (char *)&klasy2, (ftnlen)sizeof(integer));
00206         e_wsfe();
00207     }
00208 
00209     dget33_(&rlanv2, &llanv2, &nlanv2, &klanv2);
00210     if (rlanv2 > *thresh || nlanv2 != 0) {
00211         ok = FALSE_;
00212         io___22.ciunit = *nout;
00213         s_wsfe(&io___22);
00214         do_fio(&c__1, (char *)&rlanv2, (ftnlen)sizeof(doublereal));
00215         do_fio(&c__1, (char *)&llanv2, (ftnlen)sizeof(integer));
00216         do_fio(&c__1, (char *)&nlanv2, (ftnlen)sizeof(integer));
00217         do_fio(&c__1, (char *)&klanv2, (ftnlen)sizeof(integer));
00218         e_wsfe();
00219     }
00220 
00221     dget34_(&rlaexc, &llaexc, nlaexc, &klaexc);
00222     if (rlaexc > *thresh || nlaexc[1] != 0) {
00223         ok = FALSE_;
00224         io___27.ciunit = *nout;
00225         s_wsfe(&io___27);
00226         do_fio(&c__1, (char *)&rlaexc, (ftnlen)sizeof(doublereal));
00227         do_fio(&c__1, (char *)&llaexc, (ftnlen)sizeof(integer));
00228         do_fio(&c__2, (char *)&nlaexc[0], (ftnlen)sizeof(integer));
00229         do_fio(&c__1, (char *)&klaexc, (ftnlen)sizeof(integer));
00230         e_wsfe();
00231     }
00232 
00233     dget35_(&rtrsyl, &ltrsyl, &ntrsyl, &ktrsyl);
00234     if (rtrsyl > *thresh) {
00235         ok = FALSE_;
00236         io___32.ciunit = *nout;
00237         s_wsfe(&io___32);
00238         do_fio(&c__1, (char *)&rtrsyl, (ftnlen)sizeof(doublereal));
00239         do_fio(&c__1, (char *)&ltrsyl, (ftnlen)sizeof(integer));
00240         do_fio(&c__1, (char *)&ntrsyl, (ftnlen)sizeof(integer));
00241         do_fio(&c__1, (char *)&ktrsyl, (ftnlen)sizeof(integer));
00242         e_wsfe();
00243     }
00244 
00245     dget36_(&rtrexc, &ltrexc, ntrexc, &ktrexc, nin);
00246     if (rtrexc > *thresh || ntrexc[2] > 0) {
00247         ok = FALSE_;
00248         io___37.ciunit = *nout;
00249         s_wsfe(&io___37);
00250         do_fio(&c__1, (char *)&rtrexc, (ftnlen)sizeof(doublereal));
00251         do_fio(&c__1, (char *)&ltrexc, (ftnlen)sizeof(integer));
00252         do_fio(&c__3, (char *)&ntrexc[0], (ftnlen)sizeof(integer));
00253         do_fio(&c__1, (char *)&ktrexc, (ftnlen)sizeof(integer));
00254         e_wsfe();
00255     }
00256 
00257     dget37_(rtrsna, ltrsna, ntrsna, &ktrsna, nin);
00258     if (rtrsna[0] > *thresh || rtrsna[1] > *thresh || ntrsna[0] != 0 || 
00259             ntrsna[1] != 0 || ntrsna[2] != 0) {
00260         ok = FALSE_;
00261         io___42.ciunit = *nout;
00262         s_wsfe(&io___42);
00263         do_fio(&c__3, (char *)&rtrsna[0], (ftnlen)sizeof(doublereal));
00264         do_fio(&c__3, (char *)&ltrsna[0], (ftnlen)sizeof(integer));
00265         do_fio(&c__3, (char *)&ntrsna[0], (ftnlen)sizeof(integer));
00266         do_fio(&c__1, (char *)&ktrsna, (ftnlen)sizeof(integer));
00267         e_wsfe();
00268     }
00269 
00270     dget38_(rtrsen, ltrsen, ntrsen, &ktrsen, nin);
00271     if (rtrsen[0] > *thresh || rtrsen[1] > *thresh || ntrsen[0] != 0 || 
00272             ntrsen[1] != 0 || ntrsen[2] != 0) {
00273         ok = FALSE_;
00274         io___47.ciunit = *nout;
00275         s_wsfe(&io___47);
00276         do_fio(&c__3, (char *)&rtrsen[0], (ftnlen)sizeof(doublereal));
00277         do_fio(&c__3, (char *)&ltrsen[0], (ftnlen)sizeof(integer));
00278         do_fio(&c__3, (char *)&ntrsen[0], (ftnlen)sizeof(integer));
00279         do_fio(&c__1, (char *)&ktrsen, (ftnlen)sizeof(integer));
00280         e_wsfe();
00281     }
00282 
00283     dget39_(&rlaqtr, &llaqtr, &nlaqtr, &klaqtr);
00284     if (rlaqtr > *thresh) {
00285         ok = FALSE_;
00286         io___52.ciunit = *nout;
00287         s_wsfe(&io___52);
00288         do_fio(&c__1, (char *)&rlaqtr, (ftnlen)sizeof(doublereal));
00289         do_fio(&c__1, (char *)&llaqtr, (ftnlen)sizeof(integer));
00290         do_fio(&c__1, (char *)&nlaqtr, (ftnlen)sizeof(integer));
00291         do_fio(&c__1, (char *)&klaqtr, (ftnlen)sizeof(integer));
00292         e_wsfe();
00293     }
00294 
00295     ntests = klaln2 + klasy2 + klanv2 + klaexc + ktrsyl + ktrexc + ktrsna + 
00296             ktrsen + klaqtr;
00297     if (ok) {
00298         io___54.ciunit = *nout;
00299         s_wsfe(&io___54);
00300         do_fio(&c__1, path, (ftnlen)3);
00301         do_fio(&c__1, (char *)&ntests, (ftnlen)sizeof(integer));
00302         e_wsfe();
00303     }
00304 
00305     return 0;
00306 
00307 /*     End of DCHKEC */
00308 
00309 } /* dchkec_ */

swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:37