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__3 = 3;
00020 static integer c__12 = 12;
00021 static integer c__0 = 0;
00022 static integer c__50 = 50;
00023 static integer c__16 = 16;
00024 static integer c__9 = 9;
00025 static integer c__4 = 4;
00026 static integer c__8 = 8;
00027 static integer c__6 = 6;
00028
00029 int MAIN__(void)
00030 {
00031
00032 static char fmt_9994[] = "(/\002 Tests of the COMPLEX LAPACK RFP routine"
00033 "s \002,/\002 LAPACK VERSION \002,i1,\002.\002,i1,\002.\002,i1,/"
00034 "/\002 The following parameter values will be used:\002)";
00035 static char fmt_9996[] = "(\002 !! Invalid input value: \002,a4,\002="
00036 "\002,i6,\002; must be >=\002,i6)";
00037 static char fmt_9995[] = "(\002 !! Invalid input value: \002,a4,\002="
00038 "\002,i6,\002; must be <=\002,i6)";
00039 static char fmt_9993[] = "(4x,a4,\002: \002,10i6,/11x,10i6)";
00040 static char fmt_9992[] = "(/\002 Routines pass computational tests if te"
00041 "st ratio is \002,\002less than\002,f8.2,/)";
00042 static char fmt_9999[] = "(/\002 Execution not attempted due to input er"
00043 "rors\002)";
00044 static char fmt_9991[] = "(\002 Relative machine \002,a,\002 is taken to"
00045 " be\002,d16.6)";
00046 static char fmt_9998[] = "(/\002 End of tests\002)";
00047 static char fmt_9997[] = "(\002 Total time used = \002,f12.2,\002 seco"
00048 "nds\002,/)";
00049
00050
00051 integer i__1;
00052 real r__1;
00053 cllist cl__1;
00054
00055
00056 integer s_rsle(cilist *), e_rsle(void), s_wsfe(cilist *), do_fio(integer *
00057 , char *, ftnlen), e_wsfe(void), do_lio(integer *, integer *,
00058 char *, ftnlen);
00059 int s_stop(char *, ftnlen);
00060 integer s_wsle(cilist *), e_wsle(void), f_clos(cllist *);
00061
00062
00063 complex workafac[2500] , workasav[2500]
00064 , workbsav[800] , workainv[
00065 2500] , workxact[800]
00066 ;
00067 integer i__;
00068 real s1, s2;
00069 integer nn, vers_patch__, vers_major__, vers_minor__;
00070 complex workarfinv[1275];
00071 real eps;
00072 integer nns, nnt, nval[12];
00073 complex c_work_cpot01__[50], c_work_cpot02__[800] ,
00074 c_work_cpot03__[2500] ;
00075 real s_work_cpot02__[50], s_work_cpot03__[50];
00076 logical fatal;
00077 integer nsval[12], ntval[9];
00078 complex worka[2500] , workb[800] ,
00079 workx[800] ;
00080 real s_work_clanhe__[50];
00081 complex c_work_clatms__[150];
00082 real s_work_clatms__[50];
00083 extern doublereal slamch_(char *), second_(void);
00084 extern int ilaver_(integer *, integer *, integer *);
00085 real thresh;
00086 complex workap[1275];
00087 logical tsterr;
00088 extern int cdrvrf1_(integer *, integer *, integer *,
00089 real *, complex *, integer *, complex *, real *), cdrvrf2_(
00090 integer *, integer *, integer *, complex *, integer *, complex *,
00091 complex *, complex *), cdrvrf3_(integer *, integer *, integer *,
00092 real *, complex *, integer *, complex *, complex *, complex *,
00093 real *, complex *, complex *), cdrvrf4_(integer *, integer *,
00094 integer *, real *, complex *, complex *, integer *, complex *,
00095 complex *, integer *, real *), cerrrfp_(integer *), cdrvrfp_(
00096 integer *, integer *, integer *, integer *, integer *, integer *,
00097 integer *, real *, complex *, complex *, complex *, complex *,
00098 complex *, complex *, complex *, complex *, complex *, complex *,
00099 complex *, complex *, complex *, complex *, real *, real *, real *
00100 , real *);
00101 complex workarf[1275];
00102
00103
00104 static cilist io___3 = { 0, 5, 0, 0, 0 };
00105 static cilist io___7 = { 0, 6, 0, fmt_9994, 0 };
00106 static cilist io___8 = { 0, 5, 0, 0, 0 };
00107 static cilist io___10 = { 0, 6, 0, fmt_9996, 0 };
00108 static cilist io___11 = { 0, 6, 0, fmt_9995, 0 };
00109 static cilist io___12 = { 0, 5, 0, 0, 0 };
00110 static cilist io___15 = { 0, 6, 0, fmt_9996, 0 };
00111 static cilist io___16 = { 0, 6, 0, fmt_9995, 0 };
00112 static cilist io___17 = { 0, 6, 0, fmt_9993, 0 };
00113 static cilist io___18 = { 0, 5, 0, 0, 0 };
00114 static cilist io___20 = { 0, 6, 0, fmt_9996, 0 };
00115 static cilist io___21 = { 0, 6, 0, fmt_9995, 0 };
00116 static cilist io___22 = { 0, 5, 0, 0, 0 };
00117 static cilist io___24 = { 0, 6, 0, fmt_9996, 0 };
00118 static cilist io___25 = { 0, 6, 0, fmt_9995, 0 };
00119 static cilist io___26 = { 0, 6, 0, fmt_9993, 0 };
00120 static cilist io___27 = { 0, 5, 0, 0, 0 };
00121 static cilist io___29 = { 0, 6, 0, fmt_9996, 0 };
00122 static cilist io___30 = { 0, 6, 0, fmt_9995, 0 };
00123 static cilist io___31 = { 0, 5, 0, 0, 0 };
00124 static cilist io___33 = { 0, 6, 0, fmt_9996, 0 };
00125 static cilist io___34 = { 0, 6, 0, fmt_9995, 0 };
00126 static cilist io___35 = { 0, 6, 0, fmt_9993, 0 };
00127 static cilist io___36 = { 0, 5, 0, 0, 0 };
00128 static cilist io___38 = { 0, 6, 0, fmt_9992, 0 };
00129 static cilist io___39 = { 0, 5, 0, 0, 0 };
00130 static cilist io___41 = { 0, 6, 0, fmt_9999, 0 };
00131 static cilist io___42 = { 0, 6, 0, fmt_9999, 0 };
00132 static cilist io___44 = { 0, 6, 0, fmt_9991, 0 };
00133 static cilist io___45 = { 0, 6, 0, fmt_9991, 0 };
00134 static cilist io___46 = { 0, 6, 0, fmt_9991, 0 };
00135 static cilist io___47 = { 0, 6, 0, 0, 0 };
00136 static cilist io___68 = { 0, 6, 0, fmt_9998, 0 };
00137 static cilist io___69 = { 0, 6, 0, fmt_9997, 0 };
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
00168
00169
00170
00171
00172
00173
00174
00175
00176
00177
00178
00179
00180
00181
00182
00183
00184
00185
00186
00187 s1 = second_();
00188 fatal = FALSE_;
00189
00190
00191
00192 s_rsle(&io___3);
00193 e_rsle();
00194
00195
00196
00197 ilaver_(&vers_major__, &vers_minor__, &vers_patch__);
00198 s_wsfe(&io___7);
00199 do_fio(&c__1, (char *)&vers_major__, (ftnlen)sizeof(integer));
00200 do_fio(&c__1, (char *)&vers_minor__, (ftnlen)sizeof(integer));
00201 do_fio(&c__1, (char *)&vers_patch__, (ftnlen)sizeof(integer));
00202 e_wsfe();
00203
00204
00205
00206 s_rsle(&io___8);
00207 do_lio(&c__3, &c__1, (char *)&nn, (ftnlen)sizeof(integer));
00208 e_rsle();
00209 if (nn < 1) {
00210 s_wsfe(&io___10);
00211 do_fio(&c__1, " NN ", (ftnlen)4);
00212 do_fio(&c__1, (char *)&nn, (ftnlen)sizeof(integer));
00213 do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
00214 e_wsfe();
00215 nn = 0;
00216 fatal = TRUE_;
00217 } else if (nn > 12) {
00218 s_wsfe(&io___11);
00219 do_fio(&c__1, " NN ", (ftnlen)4);
00220 do_fio(&c__1, (char *)&nn, (ftnlen)sizeof(integer));
00221 do_fio(&c__1, (char *)&c__12, (ftnlen)sizeof(integer));
00222 e_wsfe();
00223 nn = 0;
00224 fatal = TRUE_;
00225 }
00226 s_rsle(&io___12);
00227 i__1 = nn;
00228 for (i__ = 1; i__ <= i__1; ++i__) {
00229 do_lio(&c__3, &c__1, (char *)&nval[i__ - 1], (ftnlen)sizeof(integer));
00230 }
00231 e_rsle();
00232 i__1 = nn;
00233 for (i__ = 1; i__ <= i__1; ++i__) {
00234 if (nval[i__ - 1] < 0) {
00235 s_wsfe(&io___15);
00236 do_fio(&c__1, " M ", (ftnlen)4);
00237 do_fio(&c__1, (char *)&nval[i__ - 1], (ftnlen)sizeof(integer));
00238 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
00239 e_wsfe();
00240 fatal = TRUE_;
00241 } else if (nval[i__ - 1] > 50) {
00242 s_wsfe(&io___16);
00243 do_fio(&c__1, " M ", (ftnlen)4);
00244 do_fio(&c__1, (char *)&nval[i__ - 1], (ftnlen)sizeof(integer));
00245 do_fio(&c__1, (char *)&c__50, (ftnlen)sizeof(integer));
00246 e_wsfe();
00247 fatal = TRUE_;
00248 }
00249
00250 }
00251 if (nn > 0) {
00252 s_wsfe(&io___17);
00253 do_fio(&c__1, "N ", (ftnlen)4);
00254 i__1 = nn;
00255 for (i__ = 1; i__ <= i__1; ++i__) {
00256 do_fio(&c__1, (char *)&nval[i__ - 1], (ftnlen)sizeof(integer));
00257 }
00258 e_wsfe();
00259 }
00260
00261
00262
00263 s_rsle(&io___18);
00264 do_lio(&c__3, &c__1, (char *)&nns, (ftnlen)sizeof(integer));
00265 e_rsle();
00266 if (nns < 1) {
00267 s_wsfe(&io___20);
00268 do_fio(&c__1, " NNS", (ftnlen)4);
00269 do_fio(&c__1, (char *)&nns, (ftnlen)sizeof(integer));
00270 do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
00271 e_wsfe();
00272 nns = 0;
00273 fatal = TRUE_;
00274 } else if (nns > 12) {
00275 s_wsfe(&io___21);
00276 do_fio(&c__1, " NNS", (ftnlen)4);
00277 do_fio(&c__1, (char *)&nns, (ftnlen)sizeof(integer));
00278 do_fio(&c__1, (char *)&c__12, (ftnlen)sizeof(integer));
00279 e_wsfe();
00280 nns = 0;
00281 fatal = TRUE_;
00282 }
00283 s_rsle(&io___22);
00284 i__1 = nns;
00285 for (i__ = 1; i__ <= i__1; ++i__) {
00286 do_lio(&c__3, &c__1, (char *)&nsval[i__ - 1], (ftnlen)sizeof(integer))
00287 ;
00288 }
00289 e_rsle();
00290 i__1 = nns;
00291 for (i__ = 1; i__ <= i__1; ++i__) {
00292 if (nsval[i__ - 1] < 0) {
00293 s_wsfe(&io___24);
00294 do_fio(&c__1, "NRHS", (ftnlen)4);
00295 do_fio(&c__1, (char *)&nsval[i__ - 1], (ftnlen)sizeof(integer));
00296 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
00297 e_wsfe();
00298 fatal = TRUE_;
00299 } else if (nsval[i__ - 1] > 16) {
00300 s_wsfe(&io___25);
00301 do_fio(&c__1, "NRHS", (ftnlen)4);
00302 do_fio(&c__1, (char *)&nsval[i__ - 1], (ftnlen)sizeof(integer));
00303 do_fio(&c__1, (char *)&c__16, (ftnlen)sizeof(integer));
00304 e_wsfe();
00305 fatal = TRUE_;
00306 }
00307
00308 }
00309 if (nns > 0) {
00310 s_wsfe(&io___26);
00311 do_fio(&c__1, "NRHS", (ftnlen)4);
00312 i__1 = nns;
00313 for (i__ = 1; i__ <= i__1; ++i__) {
00314 do_fio(&c__1, (char *)&nsval[i__ - 1], (ftnlen)sizeof(integer));
00315 }
00316 e_wsfe();
00317 }
00318
00319
00320
00321 s_rsle(&io___27);
00322 do_lio(&c__3, &c__1, (char *)&nnt, (ftnlen)sizeof(integer));
00323 e_rsle();
00324 if (nnt < 1) {
00325 s_wsfe(&io___29);
00326 do_fio(&c__1, " NMA", (ftnlen)4);
00327 do_fio(&c__1, (char *)&nnt, (ftnlen)sizeof(integer));
00328 do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
00329 e_wsfe();
00330 nnt = 0;
00331 fatal = TRUE_;
00332 } else if (nnt > 9) {
00333 s_wsfe(&io___30);
00334 do_fio(&c__1, " NMA", (ftnlen)4);
00335 do_fio(&c__1, (char *)&nnt, (ftnlen)sizeof(integer));
00336 do_fio(&c__1, (char *)&c__9, (ftnlen)sizeof(integer));
00337 e_wsfe();
00338 nnt = 0;
00339 fatal = TRUE_;
00340 }
00341 s_rsle(&io___31);
00342 i__1 = nnt;
00343 for (i__ = 1; i__ <= i__1; ++i__) {
00344 do_lio(&c__3, &c__1, (char *)&ntval[i__ - 1], (ftnlen)sizeof(integer))
00345 ;
00346 }
00347 e_rsle();
00348 i__1 = nnt;
00349 for (i__ = 1; i__ <= i__1; ++i__) {
00350 if (ntval[i__ - 1] < 0) {
00351 s_wsfe(&io___33);
00352 do_fio(&c__1, "TYPE", (ftnlen)4);
00353 do_fio(&c__1, (char *)&ntval[i__ - 1], (ftnlen)sizeof(integer));
00354 do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer));
00355 e_wsfe();
00356 fatal = TRUE_;
00357 } else if (ntval[i__ - 1] > 9) {
00358 s_wsfe(&io___34);
00359 do_fio(&c__1, "TYPE", (ftnlen)4);
00360 do_fio(&c__1, (char *)&ntval[i__ - 1], (ftnlen)sizeof(integer));
00361 do_fio(&c__1, (char *)&c__9, (ftnlen)sizeof(integer));
00362 e_wsfe();
00363 fatal = TRUE_;
00364 }
00365
00366 }
00367 if (nnt > 0) {
00368 s_wsfe(&io___35);
00369 do_fio(&c__1, "TYPE", (ftnlen)4);
00370 i__1 = nnt;
00371 for (i__ = 1; i__ <= i__1; ++i__) {
00372 do_fio(&c__1, (char *)&ntval[i__ - 1], (ftnlen)sizeof(integer));
00373 }
00374 e_wsfe();
00375 }
00376
00377
00378
00379 s_rsle(&io___36);
00380 do_lio(&c__4, &c__1, (char *)&thresh, (ftnlen)sizeof(real));
00381 e_rsle();
00382 s_wsfe(&io___38);
00383 do_fio(&c__1, (char *)&thresh, (ftnlen)sizeof(real));
00384 e_wsfe();
00385
00386
00387
00388 s_rsle(&io___39);
00389 do_lio(&c__8, &c__1, (char *)&tsterr, (ftnlen)sizeof(logical));
00390 e_rsle();
00391
00392 if (fatal) {
00393 s_wsfe(&io___41);
00394 e_wsfe();
00395 s_stop("", (ftnlen)0);
00396 }
00397
00398 if (fatal) {
00399 s_wsfe(&io___42);
00400 e_wsfe();
00401 s_stop("", (ftnlen)0);
00402 }
00403
00404
00405
00406 eps = slamch_("Underflow threshold");
00407 s_wsfe(&io___44);
00408 do_fio(&c__1, "underflow", (ftnlen)9);
00409 do_fio(&c__1, (char *)&eps, (ftnlen)sizeof(real));
00410 e_wsfe();
00411 eps = slamch_("Overflow threshold");
00412 s_wsfe(&io___45);
00413 do_fio(&c__1, "overflow ", (ftnlen)9);
00414 do_fio(&c__1, (char *)&eps, (ftnlen)sizeof(real));
00415 e_wsfe();
00416 eps = slamch_("Epsilon");
00417 s_wsfe(&io___46);
00418 do_fio(&c__1, "precision", (ftnlen)9);
00419 do_fio(&c__1, (char *)&eps, (ftnlen)sizeof(real));
00420 e_wsfe();
00421 s_wsle(&io___47);
00422 e_wsle();
00423
00424
00425
00426 if (tsterr) {
00427 cerrrfp_(&c__6);
00428 }
00429
00430
00431
00432
00433 cdrvrfp_(&c__6, &nn, nval, &nns, nsval, &nnt, ntval, &thresh, worka,
00434 workasav, workafac, workainv, workb, workbsav, workxact, workx,
00435 workarf, workarfinv, c_work_clatms__, c_work_cpot01__,
00436 c_work_cpot02__, c_work_cpot03__, s_work_clatms__,
00437 s_work_clanhe__, s_work_cpot02__, s_work_cpot03__);
00438
00439
00440
00441 cdrvrf1_(&c__6, &nn, nval, &thresh, worka, &c__50, workarf,
00442 s_work_clanhe__);
00443
00444
00445
00446
00447 cdrvrf2_(&c__6, &nn, nval, worka, &c__50, workarf, workap, workasav);
00448
00449
00450
00451 cdrvrf3_(&c__6, &nn, nval, &thresh, worka, &c__50, workarf, workainv,
00452 workafac, s_work_clanhe__, c_work_cpot03__, c_work_cpot01__);
00453
00454
00455
00456
00457 cdrvrf4_(&c__6, &nn, nval, &thresh, worka, workafac, &c__50, workarf,
00458 workainv, &c__50, s_work_clanhe__);
00459
00460 cl__1.cerr = 0;
00461 cl__1.cunit = 5;
00462 cl__1.csta = 0;
00463 f_clos(&cl__1);
00464 s2 = second_();
00465 s_wsfe(&io___68);
00466 e_wsfe();
00467 s_wsfe(&io___69);
00468 r__1 = s2 - s1;
00469 do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real));
00470 e_wsfe();
00471
00472
00473
00474
00475 return 0;
00476 }
00477
00478 int cchkrfp_ () { MAIN__ (); return 0; }