cchkec.c
Go to the documentation of this file.
00001 /* cchkec.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__3 = 3;
00020 
00021 /* Subroutine */ int cchkec_(real *thresh, logical *tsterr, integer *nin, 
00022         integer *nout)
00023 {
00024     /* Format strings */
00025     static char fmt_9994[] = "(\002 Tests of the Nonsymmetric eigenproblem c"
00026             "ondition\002,\002 estimation routines\002,/\002 CTRSYL, CTREXC, "
00027             "CTRSNA, CTRSEN\002,/)";
00028     static char fmt_9993[] = "(\002 Relative machine precision (EPS) = \002,"
00029             "e16.6,/\002 Safe minimum (SFMIN)             = \002,e16.6,/)";
00030     static char fmt_9992[] = "(\002 Routines pass computational tests if tes"
00031             "t ratio is \002,\002less than\002,f8.2,//)";
00032     static char fmt_9999[] = "(\002 Error in CTRSYL: RMAX =\002,e12.3,/\002 "
00033             "LMAX = \002,i8,\002 NINFO=\002,i8,\002 KNT=\002,i8)";
00034     static char fmt_9998[] = "(\002 Error in CTREXC: RMAX =\002,e12.3,/\002 "
00035             "LMAX = \002,i8,\002 NINFO=\002,i8,\002 KNT=\002,i8)";
00036     static char fmt_9997[] = "(\002 Error in CTRSNA: RMAX =\002,3e12.3,/\002"
00037             " LMAX = \002,3i8,\002 NINFO=\002,3i8,\002 KNT=\002,i8)";
00038     static char fmt_9996[] = "(\002 Error in CTRSEN: RMAX =\002,3e12.3,/\002"
00039             " LMAX = \002,3i8,\002 NINFO=\002,3i8,\002 KNT=\002,i8)";
00040     static char fmt_9995[] = "(/1x,\002All tests for \002,a3,\002 routines p"
00041             "assed the threshold (\002,i6,\002 tests run)\002)";
00042 
00043     /* Builtin functions */
00044     /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
00045     integer s_wsfe(cilist *), e_wsfe(void), do_fio(integer *, char *, ftnlen);
00046 
00047     /* Local variables */
00048     logical ok;
00049     real eps;
00050     char path[3];
00051     extern /* Subroutine */ int cget35_(real *, integer *, integer *, integer 
00052             *, integer *), cget36_(real *, integer *, integer *, integer *, 
00053             integer *), cget37_(real *, integer *, integer *, integer *, 
00054             integer *), cget38_(real *, integer *, integer *, integer *, 
00055             integer *);
00056     real sfmin;
00057     extern /* Subroutine */ int cerrec_(char *, integer *);
00058     extern doublereal slamch_(char *);
00059     integer ktrexc, ltrexc, ktrsna, ntrexc, ltrsna[3], ntrsna[3], ktrsen;
00060     real rtrexc;
00061     integer ltrsen[3], ntrsen[3];
00062     real rtrsna[3], rtrsen[3];
00063     integer ntests, ktrsyl, ltrsyl, ntrsyl;
00064     real rtrsyl;
00065 
00066     /* Fortran I/O blocks */
00067     static cilist io___4 = { 0, 0, 0, fmt_9994, 0 };
00068     static cilist io___5 = { 0, 0, 0, fmt_9993, 0 };
00069     static cilist io___6 = { 0, 0, 0, fmt_9992, 0 };
00070     static cilist io___12 = { 0, 0, 0, fmt_9999, 0 };
00071     static cilist io___17 = { 0, 0, 0, fmt_9998, 0 };
00072     static cilist io___22 = { 0, 0, 0, fmt_9997, 0 };
00073     static cilist io___27 = { 0, 0, 0, fmt_9996, 0 };
00074     static cilist io___29 = { 0, 0, 0, fmt_9995, 0 };
00075 
00076 
00077 
00078 /*  -- LAPACK test routine (version 3.1) -- */
00079 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00080 /*     November 2006 */
00081 
00082 /*     .. Scalar Arguments .. */
00083 /*     .. */
00084 
00085 /*  Purpose */
00086 /*  ======= */
00087 
00088 /*  CCHKEC tests eigen- condition estimation routines */
00089 /*         CTRSYL, CTREXC, CTRSNA, CTRSEN */
00090 
00091 /*  In all cases, the routine runs through a fixed set of numerical */
00092 /*  examples, subjects them to various tests, and compares the test */
00093 /*  results to a threshold THRESH. In addition, CTRSNA and CTRSEN are */
00094 /*  tested by reading in precomputed examples from a file (on input unit */
00095 /*  NIN).  Output is written to output unit NOUT. */
00096 
00097 /*  Arguments */
00098 /*  ========= */
00099 
00100 /*  THRESH  (input) REAL */
00101 /*          Threshold for residual tests.  A computed test ratio passes */
00102 /*          the threshold if it is less than THRESH. */
00103 
00104 /*  TSTERR  (input) LOGICAL */
00105 /*          Flag that indicates whether error exits are to be tested. */
00106 
00107 /*  NIN     (input) INTEGER */
00108 /*          The logical unit number for input. */
00109 
00110 /*  NOUT    (input) INTEGER */
00111 /*          The logical unit number for output. */
00112 
00113 /*  ===================================================================== */
00114 
00115 /*     .. Local Scalars .. */
00116 /*     .. */
00117 /*     .. Local Arrays .. */
00118 /*     .. */
00119 /*     .. External Subroutines .. */
00120 /*     .. */
00121 /*     .. External Functions .. */
00122 /*     .. */
00123 /*     .. Executable Statements .. */
00124 
00125     s_copy(path, "Complex precision", (ftnlen)1, (ftnlen)17);
00126     s_copy(path + 1, "EC", (ftnlen)2, (ftnlen)2);
00127     eps = slamch_("P");
00128     sfmin = slamch_("S");
00129     io___4.ciunit = *nout;
00130     s_wsfe(&io___4);
00131     e_wsfe();
00132     io___5.ciunit = *nout;
00133     s_wsfe(&io___5);
00134     do_fio(&c__1, (char *)&eps, (ftnlen)sizeof(real));
00135     do_fio(&c__1, (char *)&sfmin, (ftnlen)sizeof(real));
00136     e_wsfe();
00137     io___6.ciunit = *nout;
00138     s_wsfe(&io___6);
00139     do_fio(&c__1, (char *)&(*thresh), (ftnlen)sizeof(real));
00140     e_wsfe();
00141 
00142 /*     Test error exits if TSTERR is .TRUE. */
00143 
00144     if (*tsterr) {
00145         cerrec_(path, nout);
00146     }
00147 
00148     ok = TRUE_;
00149     cget35_(&rtrsyl, &ltrsyl, &ntrsyl, &ktrsyl, nin);
00150     if (rtrsyl > *thresh) {
00151         ok = FALSE_;
00152         io___12.ciunit = *nout;
00153         s_wsfe(&io___12);
00154         do_fio(&c__1, (char *)&rtrsyl, (ftnlen)sizeof(real));
00155         do_fio(&c__1, (char *)&ltrsyl, (ftnlen)sizeof(integer));
00156         do_fio(&c__1, (char *)&ntrsyl, (ftnlen)sizeof(integer));
00157         do_fio(&c__1, (char *)&ktrsyl, (ftnlen)sizeof(integer));
00158         e_wsfe();
00159     }
00160 
00161     cget36_(&rtrexc, &ltrexc, &ntrexc, &ktrexc, nin);
00162     if (rtrexc > *thresh || ntrexc > 0) {
00163         ok = FALSE_;
00164         io___17.ciunit = *nout;
00165         s_wsfe(&io___17);
00166         do_fio(&c__1, (char *)&rtrexc, (ftnlen)sizeof(real));
00167         do_fio(&c__1, (char *)&ltrexc, (ftnlen)sizeof(integer));
00168         do_fio(&c__1, (char *)&ntrexc, (ftnlen)sizeof(integer));
00169         do_fio(&c__1, (char *)&ktrexc, (ftnlen)sizeof(integer));
00170         e_wsfe();
00171     }
00172 
00173     cget37_(rtrsna, ltrsna, ntrsna, &ktrsna, nin);
00174     if (rtrsna[0] > *thresh || rtrsna[1] > *thresh || ntrsna[0] != 0 || 
00175             ntrsna[1] != 0 || ntrsna[2] != 0) {
00176         ok = FALSE_;
00177         io___22.ciunit = *nout;
00178         s_wsfe(&io___22);
00179         do_fio(&c__3, (char *)&rtrsna[0], (ftnlen)sizeof(real));
00180         do_fio(&c__3, (char *)&ltrsna[0], (ftnlen)sizeof(integer));
00181         do_fio(&c__3, (char *)&ntrsna[0], (ftnlen)sizeof(integer));
00182         do_fio(&c__1, (char *)&ktrsna, (ftnlen)sizeof(integer));
00183         e_wsfe();
00184     }
00185 
00186     cget38_(rtrsen, ltrsen, ntrsen, &ktrsen, nin);
00187     if (rtrsen[0] > *thresh || rtrsen[1] > *thresh || ntrsen[0] != 0 || 
00188             ntrsen[1] != 0 || ntrsen[2] != 0) {
00189         ok = FALSE_;
00190         io___27.ciunit = *nout;
00191         s_wsfe(&io___27);
00192         do_fio(&c__3, (char *)&rtrsen[0], (ftnlen)sizeof(real));
00193         do_fio(&c__3, (char *)&ltrsen[0], (ftnlen)sizeof(integer));
00194         do_fio(&c__3, (char *)&ntrsen[0], (ftnlen)sizeof(integer));
00195         do_fio(&c__1, (char *)&ktrsen, (ftnlen)sizeof(integer));
00196         e_wsfe();
00197     }
00198 
00199     ntests = ktrsyl + ktrexc + ktrsna + ktrsen;
00200     if (ok) {
00201         io___29.ciunit = *nout;
00202         s_wsfe(&io___29);
00203         do_fio(&c__1, path, (ftnlen)3);
00204         do_fio(&c__1, (char *)&ntests, (ftnlen)sizeof(integer));
00205         e_wsfe();
00206     }
00207 
00208     return 0;
00209 
00210 /*     End of CCHKEC */
00211 
00212 } /* cchkec_ */


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