#include "blaswrap.h" /* schkec.f -- translated by f2c (version 20061008). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Table of constant values */ static integer c__1 = 1; static integer c__2 = 2; static integer c__3 = 3; /* Subroutine */ int schkec_(real *thresh, logical *tsterr, integer *nin, integer *nout) { /* Format strings */ static char fmt_9989[] = "(\002 Tests of the Nonsymmetric eigenproblem c" "ondition estim\002,\002ation routines\002,/\002 SLALN2, SLASY2, " "SLANV2, SLAEXC, STRS\002,\002YL, STREXC, STRSNA, STRSEN, SLAQT" "R\002,/)"; static char fmt_9988[] = "(\002 Relative machine precision (EPS) = \002," "e16.6,/\002 Safe \002,\002minimum (SFMIN) = \002,e16" ".6,/)"; static char fmt_9987[] = "(\002 Routines pass computational tests if tes" "t ratio is les\002,\002s than\002,f8.2,//)"; static char fmt_9999[] = "(\002 Error in SLALN2: RMAX =\002,e12.3,/\002 " "LMAX = \002,i8,\002 N\002,\002INFO=\002,2i8,\002 KNT=\002,i8)"; static char fmt_9998[] = "(\002 Error in SLASY2: RMAX =\002,e12.3,/\002 " "LMAX = \002,i8,\002 N\002,\002INFO=\002,i8,\002 KNT=\002,i8)"; static char fmt_9997[] = "(\002 Error in SLANV2: RMAX =\002,e12.3,/\002 " "LMAX = \002,i8,\002 N\002,\002INFO=\002,i8,\002 KNT=\002,i8)"; static char fmt_9996[] = "(\002 Error in SLAEXC: RMAX =\002,e12.3,/\002 " "LMAX = \002,i8,\002 N\002,\002INFO=\002,2i8,\002 KNT=\002,i8)"; static char fmt_9995[] = "(\002 Error in STRSYL: RMAX =\002,e12.3,/\002 " "LMAX = \002,i8,\002 N\002,\002INFO=\002,i8,\002 KNT=\002,i8)"; static char fmt_9994[] = "(\002 Error in STREXC: RMAX =\002,e12.3,/\002 " "LMAX = \002,i8,\002 N\002,\002INFO=\002,3i8,\002 KNT=\002,i8)"; static char fmt_9993[] = "(\002 Error in STRSNA: RMAX =\002,3e12.3,/\002" " LMAX = \002,3i8,\002 NINFO=\002,3i8,\002 KNT=\002,i8)"; static char fmt_9992[] = "(\002 Error in STRSEN: RMAX =\002,3e12.3,/\002" " LMAX = \002,3i8,\002 NINFO=\002,3i8,\002 KNT=\002,i8)"; static char fmt_9991[] = "(\002 Error in SLAQTR: RMAX =\002,e12.3,/\002 " "LMAX = \002,i8,\002 N\002,\002INFO=\002,i8,\002 KNT=\002,i8)"; static char fmt_9990[] = "(/1x,\002All tests for \002,a3,\002 routines p" "assed the thresh\002,\002old (\002,i6,\002 tests run)\002)"; /* Builtin functions Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_wsfe(cilist *), e_wsfe(void), do_fio(integer *, char *, ftnlen); /* Local variables */ static logical ok; static real eps; static char path[3]; extern /* Subroutine */ int sget31_(real *, integer *, integer *, integer *), sget32_(real *, integer *, integer *, integer *), sget33_( real *, integer *, integer *, integer *), sget34_(real *, integer *, integer *, integer *), sget35_(real *, integer *, integer *, integer *), sget36_(real *, integer *, integer *, integer *, integer *); static real sfmin; extern /* Subroutine */ int sget37_(real *, integer *, integer *, integer *, integer *), sget38_(real *, integer *, integer *, integer *, integer *), sget39_(real *, integer *, integer *, integer *); static integer klaln2, llaln2, nlaln2[2]; static real rlaln2; static integer klanv2, llanv2, nlanv2; static real rlanv2; static integer klasy2, llasy2, nlasy2; static real rlasy2; static integer klaexc, llaexc; extern doublereal slamch_(char *); static integer nlaexc[2]; static real rlaexc; extern /* Subroutine */ int serrec_(char *, integer *); static integer klaqtr, llaqtr, ktrexc, ltrexc, ktrsna, nlaqtr, ltrsna[3]; static real rlaqtr; static integer ktrsen; static real rtrexc; static integer ltrsen[3], ntrexc[3], ntrsen[3], ntrsna[3]; static real rtrsna[3], rtrsen[3]; static integer ntests, ktrsyl, ltrsyl, ntrsyl; static real rtrsyl; /* Fortran I/O blocks */ static cilist io___4 = { 0, 0, 0, fmt_9989, 0 }; static cilist io___5 = { 0, 0, 0, fmt_9988, 0 }; static cilist io___6 = { 0, 0, 0, fmt_9987, 0 }; static cilist io___12 = { 0, 0, 0, fmt_9999, 0 }; static cilist io___17 = { 0, 0, 0, fmt_9998, 0 }; static cilist io___22 = { 0, 0, 0, fmt_9997, 0 }; static cilist io___27 = { 0, 0, 0, fmt_9996, 0 }; static cilist io___32 = { 0, 0, 0, fmt_9995, 0 }; static cilist io___37 = { 0, 0, 0, fmt_9994, 0 }; static cilist io___42 = { 0, 0, 0, fmt_9993, 0 }; static cilist io___47 = { 0, 0, 0, fmt_9992, 0 }; static cilist io___52 = { 0, 0, 0, fmt_9991, 0 }; static cilist io___54 = { 0, 0, 0, fmt_9990, 0 }; /* -- LAPACK test routine (version 3.1) -- Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. November 2006 Purpose ======= SCHKEC tests eigen- condition estimation routines SLALN2, SLASY2, SLANV2, SLAQTR, SLAEXC, STRSYL, STREXC, STRSNA, STRSEN In all cases, the routine runs through a fixed set of numerical examples, subjects them to various tests, and compares the test results to a threshold THRESH. In addition, STREXC, STRSNA and STRSEN are tested by reading in precomputed examples from a file (on input unit NIN). Output is written to output unit NOUT. Arguments ========= THRESH (input) REAL Threshold for residual tests. A computed test ratio passes the threshold if it is less than THRESH. TSTERR (input) LOGICAL Flag that indicates whether error exits are to be tested. NIN (input) INTEGER The logical unit number for input. NOUT (input) INTEGER The logical unit number for output. ===================================================================== */ s_copy(path, "Single precision", (ftnlen)1, (ftnlen)16); s_copy(path + 1, "EC", (ftnlen)2, (ftnlen)2); eps = slamch_("P"); sfmin = slamch_("S"); /* Print header information */ io___4.ciunit = *nout; s_wsfe(&io___4); e_wsfe(); io___5.ciunit = *nout; s_wsfe(&io___5); do_fio(&c__1, (char *)&eps, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&sfmin, (ftnlen)sizeof(real)); e_wsfe(); io___6.ciunit = *nout; s_wsfe(&io___6); do_fio(&c__1, (char *)&(*thresh), (ftnlen)sizeof(real)); e_wsfe(); /* Test error exits if TSTERR is .TRUE. */ if (*tsterr) { serrec_(path, nout); } ok = TRUE_; sget31_(&rlaln2, &llaln2, nlaln2, &klaln2); if (rlaln2 > *thresh || nlaln2[0] != 0) { ok = FALSE_; io___12.ciunit = *nout; s_wsfe(&io___12); do_fio(&c__1, (char *)&rlaln2, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&llaln2, (ftnlen)sizeof(integer)); do_fio(&c__2, (char *)&nlaln2[0], (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&klaln2, (ftnlen)sizeof(integer)); e_wsfe(); } sget32_(&rlasy2, &llasy2, &nlasy2, &klasy2); if (rlasy2 > *thresh) { ok = FALSE_; io___17.ciunit = *nout; s_wsfe(&io___17); do_fio(&c__1, (char *)&rlasy2, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&llasy2, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&nlasy2, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&klasy2, (ftnlen)sizeof(integer)); e_wsfe(); } sget33_(&rlanv2, &llanv2, &nlanv2, &klanv2); if (rlanv2 > *thresh || nlanv2 != 0) { ok = FALSE_; io___22.ciunit = *nout; s_wsfe(&io___22); do_fio(&c__1, (char *)&rlanv2, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&llanv2, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&nlanv2, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&klanv2, (ftnlen)sizeof(integer)); e_wsfe(); } sget34_(&rlaexc, &llaexc, nlaexc, &klaexc); if (rlaexc > *thresh || nlaexc[1] != 0) { ok = FALSE_; io___27.ciunit = *nout; s_wsfe(&io___27); do_fio(&c__1, (char *)&rlaexc, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&llaexc, (ftnlen)sizeof(integer)); do_fio(&c__2, (char *)&nlaexc[0], (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&klaexc, (ftnlen)sizeof(integer)); e_wsfe(); } sget35_(&rtrsyl, <rsyl, &ntrsyl, &ktrsyl); if (rtrsyl > *thresh) { ok = FALSE_; io___32.ciunit = *nout; s_wsfe(&io___32); do_fio(&c__1, (char *)&rtrsyl, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)<rsyl, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&ntrsyl, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&ktrsyl, (ftnlen)sizeof(integer)); e_wsfe(); } sget36_(&rtrexc, <rexc, ntrexc, &ktrexc, nin); if (rtrexc > *thresh || ntrexc[2] > 0) { ok = FALSE_; io___37.ciunit = *nout; s_wsfe(&io___37); do_fio(&c__1, (char *)&rtrexc, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)<rexc, (ftnlen)sizeof(integer)); do_fio(&c__3, (char *)&ntrexc[0], (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&ktrexc, (ftnlen)sizeof(integer)); e_wsfe(); } sget37_(rtrsna, ltrsna, ntrsna, &ktrsna, nin); if (rtrsna[0] > *thresh || rtrsna[1] > *thresh || ntrsna[0] != 0 || ntrsna[1] != 0 || ntrsna[2] != 0) { ok = FALSE_; io___42.ciunit = *nout; s_wsfe(&io___42); do_fio(&c__3, (char *)&rtrsna[0], (ftnlen)sizeof(real)); do_fio(&c__3, (char *)<rsna[0], (ftnlen)sizeof(integer)); do_fio(&c__3, (char *)&ntrsna[0], (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&ktrsna, (ftnlen)sizeof(integer)); e_wsfe(); } sget38_(rtrsen, ltrsen, ntrsen, &ktrsen, nin); if (rtrsen[0] > *thresh || rtrsen[1] > *thresh || ntrsen[0] != 0 || ntrsen[1] != 0 || ntrsen[2] != 0) { ok = FALSE_; io___47.ciunit = *nout; s_wsfe(&io___47); do_fio(&c__3, (char *)&rtrsen[0], (ftnlen)sizeof(real)); do_fio(&c__3, (char *)<rsen[0], (ftnlen)sizeof(integer)); do_fio(&c__3, (char *)&ntrsen[0], (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&ktrsen, (ftnlen)sizeof(integer)); e_wsfe(); } sget39_(&rlaqtr, &llaqtr, &nlaqtr, &klaqtr); if (rlaqtr > *thresh) { ok = FALSE_; io___52.ciunit = *nout; s_wsfe(&io___52); do_fio(&c__1, (char *)&rlaqtr, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&llaqtr, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&nlaqtr, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&klaqtr, (ftnlen)sizeof(integer)); e_wsfe(); } ntests = klaln2 + klasy2 + klanv2 + klaexc + ktrsyl + ktrexc + ktrsna + ktrsen + klaqtr; if (ok) { io___54.ciunit = *nout; s_wsfe(&io___54); do_fio(&c__1, path, (ftnlen)3); do_fio(&c__1, (char *)&ntests, (ftnlen)sizeof(integer)); e_wsfe(); } return 0; /* End of SCHKEC */ } /* schkec_ */