00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015
00016
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 struct {
00032 integer selopt, seldim;
00033 logical selval[20];
00034 real selwr[20], selwi[20];
00035 } sslct_;
00036
00037 #define sslct_1 sslct_
00038
00039
00040
00041 static integer c__2 = 2;
00042 static integer c__0 = 0;
00043 static integer c__1 = 1;
00044 static integer c_n1 = -1;
00045 static integer c__4 = 4;
00046 static integer c__5 = 5;
00047
00048 int cerred_(char *path, integer *nunit)
00049 {
00050
00051 static char fmt_9999[] = "(1x,a,\002 passed the tests of the error exits"
00052 " (\002,i3,\002 tests done)\002)";
00053 static char fmt_9998[] = "(\002 *** \002,a,\002 failed the tests of the "
00054 "error exits ***\002)";
00055
00056
00057 integer i__1;
00058
00059
00060 integer s_wsle(cilist *), e_wsle(void);
00061 int s_copy(char *, char *, ftnlen, ftnlen);
00062 integer s_wsfe(cilist *), i_len_trim(char *, ftnlen), do_fio(integer *,
00063 char *, ftnlen), e_wsfe(void);
00064
00065
00066 complex a[16] ;
00067 logical b[4];
00068 integer i__, j;
00069 real s[4];
00070 complex u[16] , w[16], x[4];
00071 char c2[2];
00072 real r1[4], r2[4];
00073 integer iw[16], nt;
00074 complex vl[16] , vr[16] ;
00075 real rw[20];
00076 complex vt[16] ;
00077 integer ihi, ilo, info, sdim;
00078 extern int cgees_(char *, char *, L_fp, integer *,
00079 complex *, integer *, integer *, complex *, complex *, integer *,
00080 complex *, integer *, real *, logical *, integer *), cgeev_(char *, char *, integer *, complex *, integer *,
00081 complex *, complex *, integer *, complex *, integer *, complex *,
00082 integer *, real *, integer *);
00083 real abnrm;
00084 extern int cgesdd_(char *, integer *, integer *, complex
00085 *, integer *, real *, complex *, integer *, complex *, integer *,
00086 complex *, integer *, real *, integer *, integer *),
00087 cgesvd_(char *, char *, integer *, integer *, complex *, integer *
00088 , real *, complex *, integer *, complex *, integer *, complex *,
00089 integer *, real *, integer *);
00090 extern logical cslect_();
00091 extern int cgeesx_(char *, char *, L_fp, char *, integer
00092 *, complex *, integer *, integer *, complex *, complex *, integer
00093 *, real *, real *, complex *, integer *, real *, logical *,
00094 integer *);
00095 extern logical lsamen_(integer *, char *, char *);
00096 extern int cgeevx_(char *, char *, char *, char *,
00097 integer *, complex *, integer *, complex *, complex *, integer *,
00098 complex *, integer *, integer *, integer *, real *, real *, real *
00099 , real *, complex *, integer *, real *, integer *), chkxer_(char *, integer *, integer *, logical *,
00100 logical *);
00101
00102
00103 static cilist io___1 = { 0, 0, 0, 0, 0 };
00104 static cilist io___23 = { 0, 0, 0, fmt_9999, 0 };
00105 static cilist io___24 = { 0, 0, 0, fmt_9998, 0 };
00106 static cilist io___26 = { 0, 0, 0, fmt_9999, 0 };
00107 static cilist io___27 = { 0, 0, 0, fmt_9998, 0 };
00108 static cilist io___28 = { 0, 0, 0, fmt_9999, 0 };
00109 static cilist io___29 = { 0, 0, 0, fmt_9998, 0 };
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
00159
00160
00161
00162
00163
00164
00165
00166
00167 infoc_1.nout = *nunit;
00168 io___1.ciunit = infoc_1.nout;
00169 s_wsle(&io___1);
00170 e_wsle();
00171 s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
00172
00173
00174
00175 for (j = 1; j <= 4; ++j) {
00176 for (i__ = 1; i__ <= 4; ++i__) {
00177 i__1 = i__ + (j << 2) - 5;
00178 a[i__1].r = 0.f, a[i__1].i = 0.f;
00179
00180 }
00181
00182 }
00183 for (i__ = 1; i__ <= 4; ++i__) {
00184 i__1 = i__ + (i__ << 2) - 5;
00185 a[i__1].r = 1.f, a[i__1].i = 0.f;
00186
00187 }
00188 infoc_1.ok = TRUE_;
00189 nt = 0;
00190
00191 if (lsamen_(&c__2, c2, "EV")) {
00192
00193
00194
00195 s_copy(srnamc_1.srnamt, "CGEEV ", (ftnlen)32, (ftnlen)6);
00196 infoc_1.infot = 1;
00197 cgeev_("X", "N", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1, w, &c__1,
00198 rw, &info);
00199 chkxer_("CGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00200 infoc_1.ok);
00201 infoc_1.infot = 2;
00202 cgeev_("N", "X", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1, w, &c__1,
00203 rw, &info);
00204 chkxer_("CGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00205 infoc_1.ok);
00206 infoc_1.infot = 3;
00207 cgeev_("N", "N", &c_n1, a, &c__1, x, vl, &c__1, vr, &c__1, w, &c__1,
00208 rw, &info);
00209 chkxer_("CGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00210 infoc_1.ok);
00211 infoc_1.infot = 5;
00212 cgeev_("N", "N", &c__2, a, &c__1, x, vl, &c__1, vr, &c__1, w, &c__4,
00213 rw, &info);
00214 chkxer_("CGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00215 infoc_1.ok);
00216 infoc_1.infot = 8;
00217 cgeev_("V", "N", &c__2, a, &c__2, x, vl, &c__1, vr, &c__1, w, &c__4,
00218 rw, &info);
00219 chkxer_("CGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00220 infoc_1.ok);
00221 infoc_1.infot = 10;
00222 cgeev_("N", "V", &c__2, a, &c__2, x, vl, &c__1, vr, &c__1, w, &c__4,
00223 rw, &info);
00224 chkxer_("CGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00225 infoc_1.ok);
00226 infoc_1.infot = 12;
00227 cgeev_("V", "V", &c__1, a, &c__1, x, vl, &c__1, vr, &c__1, w, &c__1,
00228 rw, &info);
00229 chkxer_("CGEEV ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00230 infoc_1.ok);
00231 nt += 7;
00232
00233 } else if (lsamen_(&c__2, c2, "ES")) {
00234
00235
00236
00237 s_copy(srnamc_1.srnamt, "CGEES ", (ftnlen)32, (ftnlen)6);
00238 infoc_1.infot = 1;
00239 cgees_("X", "N", (L_fp)cslect_, &c__0, a, &c__1, &sdim, x, vl, &c__1,
00240 w, &c__1, rw, b, &info);
00241 chkxer_("CGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00242 infoc_1.ok);
00243 infoc_1.infot = 2;
00244 cgees_("N", "X", (L_fp)cslect_, &c__0, a, &c__1, &sdim, x, vl, &c__1,
00245 w, &c__1, rw, b, &info);
00246 chkxer_("CGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00247 infoc_1.ok);
00248 infoc_1.infot = 4;
00249 cgees_("N", "S", (L_fp)cslect_, &c_n1, a, &c__1, &sdim, x, vl, &c__1,
00250 w, &c__1, rw, b, &info);
00251 chkxer_("CGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00252 infoc_1.ok);
00253 infoc_1.infot = 6;
00254 cgees_("N", "S", (L_fp)cslect_, &c__2, a, &c__1, &sdim, x, vl, &c__1,
00255 w, &c__4, rw, b, &info);
00256 chkxer_("CGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00257 infoc_1.ok);
00258 infoc_1.infot = 10;
00259 cgees_("V", "S", (L_fp)cslect_, &c__2, a, &c__2, &sdim, x, vl, &c__1,
00260 w, &c__4, rw, b, &info);
00261 chkxer_("CGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00262 infoc_1.ok);
00263 infoc_1.infot = 12;
00264 cgees_("N", "S", (L_fp)cslect_, &c__1, a, &c__1, &sdim, x, vl, &c__1,
00265 w, &c__1, rw, b, &info);
00266 chkxer_("CGEES ", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00267 infoc_1.ok);
00268 nt += 6;
00269
00270 } else if (lsamen_(&c__2, c2, "VX")) {
00271
00272
00273
00274 s_copy(srnamc_1.srnamt, "CGEEVX", (ftnlen)32, (ftnlen)6);
00275 infoc_1.infot = 1;
00276 cgeevx_("X", "N", "N", "N", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1,
00277 &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info);
00278 chkxer_("CGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00279 infoc_1.ok);
00280 infoc_1.infot = 2;
00281 cgeevx_("N", "X", "N", "N", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1,
00282 &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info);
00283 chkxer_("CGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00284 infoc_1.ok);
00285 infoc_1.infot = 3;
00286 cgeevx_("N", "N", "X", "N", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1,
00287 &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info);
00288 chkxer_("CGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00289 infoc_1.ok);
00290 infoc_1.infot = 4;
00291 cgeevx_("N", "N", "N", "X", &c__0, a, &c__1, x, vl, &c__1, vr, &c__1,
00292 &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info);
00293 chkxer_("CGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00294 infoc_1.ok);
00295 infoc_1.infot = 5;
00296 cgeevx_("N", "N", "N", "N", &c_n1, a, &c__1, x, vl, &c__1, vr, &c__1,
00297 &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info);
00298 chkxer_("CGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00299 infoc_1.ok);
00300 infoc_1.infot = 7;
00301 cgeevx_("N", "N", "N", "N", &c__2, a, &c__1, x, vl, &c__1, vr, &c__1,
00302 &ilo, &ihi, s, &abnrm, r1, r2, w, &c__4, rw, &info);
00303 chkxer_("CGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00304 infoc_1.ok);
00305 infoc_1.infot = 10;
00306 cgeevx_("N", "V", "N", "N", &c__2, a, &c__2, x, vl, &c__1, vr, &c__1,
00307 &ilo, &ihi, s, &abnrm, r1, r2, w, &c__4, rw, &info);
00308 chkxer_("CGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00309 infoc_1.ok);
00310 infoc_1.infot = 12;
00311 cgeevx_("N", "N", "V", "N", &c__2, a, &c__2, x, vl, &c__1, vr, &c__1,
00312 &ilo, &ihi, s, &abnrm, r1, r2, w, &c__4, rw, &info);
00313 chkxer_("CGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00314 infoc_1.ok);
00315 infoc_1.infot = 20;
00316 cgeevx_("N", "N", "N", "N", &c__1, a, &c__1, x, vl, &c__1, vr, &c__1,
00317 &ilo, &ihi, s, &abnrm, r1, r2, w, &c__1, rw, &info);
00318 chkxer_("CGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00319 infoc_1.ok);
00320 infoc_1.infot = 20;
00321 cgeevx_("N", "N", "V", "V", &c__1, a, &c__1, x, vl, &c__1, vr, &c__1,
00322 &ilo, &ihi, s, &abnrm, r1, r2, w, &c__2, rw, &info);
00323 chkxer_("CGEEVX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00324 infoc_1.ok);
00325 nt += 10;
00326
00327 } else if (lsamen_(&c__2, c2, "SX")) {
00328
00329
00330
00331 s_copy(srnamc_1.srnamt, "CGEESX", (ftnlen)32, (ftnlen)6);
00332 infoc_1.infot = 1;
00333 cgeesx_("X", "N", (L_fp)cslect_, "N", &c__0, a, &c__1, &sdim, x, vl, &
00334 c__1, r1, r2, w, &c__1, rw, b, &info);
00335 chkxer_("CGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00336 infoc_1.ok);
00337 infoc_1.infot = 2;
00338 cgeesx_("N", "X", (L_fp)cslect_, "N", &c__0, a, &c__1, &sdim, x, vl, &
00339 c__1, r1, r2, w, &c__1, rw, b, &info);
00340 chkxer_("CGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00341 infoc_1.ok);
00342 infoc_1.infot = 4;
00343 cgeesx_("N", "N", (L_fp)cslect_, "X", &c__0, a, &c__1, &sdim, x, vl, &
00344 c__1, r1, r2, w, &c__1, rw, b, &info);
00345 chkxer_("CGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00346 infoc_1.ok);
00347 infoc_1.infot = 5;
00348 cgeesx_("N", "N", (L_fp)cslect_, "N", &c_n1, a, &c__1, &sdim, x, vl, &
00349 c__1, r1, r2, w, &c__1, rw, b, &info);
00350 chkxer_("CGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00351 infoc_1.ok);
00352 infoc_1.infot = 7;
00353 cgeesx_("N", "N", (L_fp)cslect_, "N", &c__2, a, &c__1, &sdim, x, vl, &
00354 c__1, r1, r2, w, &c__4, rw, b, &info);
00355 chkxer_("CGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00356 infoc_1.ok);
00357 infoc_1.infot = 11;
00358 cgeesx_("V", "N", (L_fp)cslect_, "N", &c__2, a, &c__2, &sdim, x, vl, &
00359 c__1, r1, r2, w, &c__4, rw, b, &info);
00360 chkxer_("CGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00361 infoc_1.ok);
00362 infoc_1.infot = 15;
00363 cgeesx_("N", "N", (L_fp)cslect_, "N", &c__1, a, &c__1, &sdim, x, vl, &
00364 c__1, r1, r2, w, &c__1, rw, b, &info);
00365 chkxer_("CGEESX", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00366 infoc_1.ok);
00367 nt += 7;
00368
00369 } else if (lsamen_(&c__2, c2, "BD")) {
00370
00371
00372
00373 s_copy(srnamc_1.srnamt, "CGESVD", (ftnlen)32, (ftnlen)6);
00374 infoc_1.infot = 1;
00375 cgesvd_("X", "N", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &
00376 c__1, rw, &info);
00377 chkxer_("CGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00378 infoc_1.ok);
00379 infoc_1.infot = 2;
00380 cgesvd_("N", "X", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &
00381 c__1, rw, &info);
00382 chkxer_("CGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00383 infoc_1.ok);
00384 infoc_1.infot = 2;
00385 cgesvd_("O", "O", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &
00386 c__1, rw, &info);
00387 chkxer_("CGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00388 infoc_1.ok);
00389 infoc_1.infot = 3;
00390 cgesvd_("N", "N", &c_n1, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &
00391 c__1, rw, &info);
00392 chkxer_("CGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00393 infoc_1.ok);
00394 infoc_1.infot = 4;
00395 cgesvd_("N", "N", &c__0, &c_n1, a, &c__1, s, u, &c__1, vt, &c__1, w, &
00396 c__1, rw, &info);
00397 chkxer_("CGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00398 infoc_1.ok);
00399 infoc_1.infot = 6;
00400 cgesvd_("N", "N", &c__2, &c__1, a, &c__1, s, u, &c__1, vt, &c__1, w, &
00401 c__5, rw, &info);
00402 chkxer_("CGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00403 infoc_1.ok);
00404 infoc_1.infot = 9;
00405 cgesvd_("A", "N", &c__2, &c__1, a, &c__2, s, u, &c__1, vt, &c__1, w, &
00406 c__5, rw, &info);
00407 chkxer_("CGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00408 infoc_1.ok);
00409 infoc_1.infot = 11;
00410 cgesvd_("N", "A", &c__1, &c__2, a, &c__1, s, u, &c__1, vt, &c__1, w, &
00411 c__5, rw, &info);
00412 chkxer_("CGESVD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00413 infoc_1.ok);
00414 nt += 8;
00415 if (infoc_1.ok) {
00416 io___23.ciunit = infoc_1.nout;
00417 s_wsfe(&io___23);
00418 do_fio(&c__1, srnamc_1.srnamt, i_len_trim(srnamc_1.srnamt, (
00419 ftnlen)32));
00420 do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer));
00421 e_wsfe();
00422 } else {
00423 io___24.ciunit = infoc_1.nout;
00424 s_wsfe(&io___24);
00425 e_wsfe();
00426 }
00427
00428
00429
00430 s_copy(srnamc_1.srnamt, "CGESDD", (ftnlen)32, (ftnlen)6);
00431 infoc_1.infot = 1;
00432 cgesdd_("X", &c__0, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__1,
00433 rw, iw, &info);
00434 chkxer_("CGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00435 infoc_1.ok);
00436 infoc_1.infot = 2;
00437 cgesdd_("N", &c_n1, &c__0, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__1,
00438 rw, iw, &info);
00439 chkxer_("CGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00440 infoc_1.ok);
00441 infoc_1.infot = 3;
00442 cgesdd_("N", &c__0, &c_n1, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__1,
00443 rw, iw, &info);
00444 chkxer_("CGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00445 infoc_1.ok);
00446 infoc_1.infot = 5;
00447 cgesdd_("N", &c__2, &c__1, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__5,
00448 rw, iw, &info);
00449 chkxer_("CGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00450 infoc_1.ok);
00451 infoc_1.infot = 8;
00452 cgesdd_("A", &c__2, &c__1, a, &c__2, s, u, &c__1, vt, &c__1, w, &c__5,
00453 rw, iw, &info);
00454 chkxer_("CGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00455 infoc_1.ok);
00456 infoc_1.infot = 10;
00457 cgesdd_("A", &c__1, &c__2, a, &c__1, s, u, &c__1, vt, &c__1, w, &c__5,
00458 rw, iw, &info);
00459 chkxer_("CGESDD", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
00460 infoc_1.ok);
00461 nt += -2;
00462 if (infoc_1.ok) {
00463 io___26.ciunit = infoc_1.nout;
00464 s_wsfe(&io___26);
00465 do_fio(&c__1, srnamc_1.srnamt, i_len_trim(srnamc_1.srnamt, (
00466 ftnlen)32));
00467 do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer));
00468 e_wsfe();
00469 } else {
00470 io___27.ciunit = infoc_1.nout;
00471 s_wsfe(&io___27);
00472 e_wsfe();
00473 }
00474 }
00475
00476
00477
00478 if (! lsamen_(&c__2, c2, "BD")) {
00479 if (infoc_1.ok) {
00480 io___28.ciunit = infoc_1.nout;
00481 s_wsfe(&io___28);
00482 do_fio(&c__1, srnamc_1.srnamt, i_len_trim(srnamc_1.srnamt, (
00483 ftnlen)32));
00484 do_fio(&c__1, (char *)&nt, (ftnlen)sizeof(integer));
00485 e_wsfe();
00486 } else {
00487 io___29.ciunit = infoc_1.nout;
00488 s_wsfe(&io___29);
00489 e_wsfe();
00490 }
00491 }
00492
00493 return 0;
00494
00495
00496
00497 }