00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015
00016
00017
00018 static integer c__1 = 1;
00019 static integer c__2 = 2;
00020 static integer c__3 = 3;
00021
00022 int dchkec_(doublereal *thresh, logical *tsterr, integer *
00023 nin, integer *nout)
00024 {
00025
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
00057 int s_copy(char *, char *, ftnlen, ftnlen);
00058 integer s_wsfe(cilist *), e_wsfe(void), do_fio(integer *, char *, ftnlen);
00059
00060
00061 logical ok;
00062 doublereal eps;
00063 char path[3];
00064 extern 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 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
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
00111
00112
00113
00114
00115
00116
00117
00118
00119
00120
00121
00122
00123
00124
00125
00126
00127
00128
00129
00130
00131
00132
00133
00134
00135
00136
00137
00138
00139
00140
00141
00142
00143
00144
00145
00146
00147
00148
00149
00150
00151
00152
00153
00154
00155
00156
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
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
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, <rsyl, &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 *)<rsyl, (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, <rexc, 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 *)<rexc, (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 *)<rsna[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 *)<rsen[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
00308
00309 }