00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015
00016
00017
00018 union {
00019 struct {
00020 integer infot, noutc;
00021 logical ok, lerr;
00022 } _1;
00023 struct {
00024 integer infot, nout;
00025 logical ok, lerr;
00026 } _2;
00027 } infoc_;
00028
00029 #define infoc_1 (infoc_._1)
00030 #define infoc_2 (infoc_._2)
00031
00032 struct {
00033 char srnamt[6];
00034 } srnamc_;
00035
00036 #define srnamc_1 srnamc_
00037
00038
00039
00040 static integer c__9 = 9;
00041 static integer c__1 = 1;
00042 static integer c__3 = 3;
00043 static integer c__8 = 8;
00044 static integer c__4 = 4;
00045 static integer c__65 = 65;
00046 static integer c__7 = 7;
00047 static real c_b85 = 1.f;
00048 static real c_b99 = 0.f;
00049 static logical c_true = TRUE_;
00050 static logical c_false = FALSE_;
00051 static integer c__0 = 0;
00052 static integer c_n1 = -1;
00053 static integer c__2 = 2;
00054
00055 int MAIN__(void)
00056 {
00057
00058
00059 static char snames[6*6] = "SGEMM " "SSYMM " "STRMM " "STRSM " "SSYRK "
00060 "SSYR2K";
00061
00062
00063 static char fmt_9997[] = "(\002 NUMBER OF VALUES OF \002,a,\002 IS LESS "
00064 "THAN 1 OR GREATER \002,\002THAN \002,i2)";
00065 static char fmt_9996[] = "(\002 VALUE OF N IS LESS THAN 0 OR GREATER THA"
00066 "N \002,i2)";
00067 static char fmt_9995[] = "(\002 TESTS OF THE REAL LEVEL 3 BL"
00068 "AS\002,//\002 THE F\002,\002OLLOWING PARAMETER VALUES WILL BE US"
00069 "ED:\002)";
00070 static char fmt_9994[] = "(\002 FOR N \002,9i6)";
00071 static char fmt_9993[] = "(\002 FOR ALPHA \002,7f6.1)";
00072 static char fmt_9992[] = "(\002 FOR BETA \002,7f6.1)";
00073 static char fmt_9984[] = "(\002 ERROR-EXITS WILL NOT BE TESTED\002)";
00074 static char fmt_9999[] = "(\002 ROUTINES PASS COMPUTATIONAL TESTS IF TES"
00075 "T RATIO IS LES\002,\002S THAN\002,f8.2)";
00076 static char fmt_9988[] = "(a6,l2)";
00077 static char fmt_9990[] = "(\002 SUBPROGRAM NAME \002,a6,\002 NOT RECOGNI"
00078 "ZED\002,/\002 ******* T\002,\002ESTS ABANDONED *******\002)";
00079 static char fmt_9998[] = "(\002 RELATIVE MACHINE PRECISION IS TAKEN TO"
00080 " BE\002,1p,e9.1)";
00081 static char fmt_9989[] = "(\002 ERROR IN SMMCH - IN-LINE DOT PRODUCTS A"
00082 "RE BEING EVALU\002,\002ATED WRONGLY.\002,/\002 SMMCH WAS CALLED "
00083 "WITH TRANSA = \002,a1,\002 AND TRANSB = \002,a1,/\002 AND RETURN"
00084 "ED SAME = \002,l1,\002 AND \002,\002ERR = \002,f12.3,\002.\002,"
00085 "/\002 THIS MAY BE DUE TO FAULTS IN THE \002,\002ARITHMETIC OR TH"
00086 "E COMPILER.\002,/\002 ******* TESTS ABANDONED \002,\002******"
00087 "*\002)";
00088 static char fmt_9987[] = "(1x,a6,\002 WAS NOT TESTED\002)";
00089 static char fmt_9986[] = "(/\002 END OF TESTS\002)";
00090 static char fmt_9985[] = "(/\002 ******* FATAL ERROR - TESTS ABANDONED *"
00091 "******\002)";
00092 static char fmt_9991[] = "(\002 AMEND DATA FILE OR INCREASE ARRAY SIZES "
00093 "IN PROGRAM\002,/\002 ******* TESTS ABANDONED *******\002)";
00094
00095
00096 integer i__1, i__2, i__3;
00097 real r__1;
00098 olist o__1;
00099 cllist cl__1;
00100
00101
00102 integer s_rsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
00103 e_rsle(void), f_open(olist *), s_wsfe(cilist *), do_fio(integer *,
00104 char *, ftnlen), e_wsfe(void), s_wsle(cilist *), e_wsle(void),
00105 s_rsfe(cilist *), e_rsfe(void), s_cmp(char *, char *, ftnlen,
00106 ftnlen);
00107 int s_stop(char *, ftnlen);
00108 integer f_clos(cllist *);
00109 int s_copy(char *, char *, ftnlen, ftnlen);
00110
00111
00112 real c__[4225] , g[65];
00113 integer i__, j, n;
00114 real w[130], aa[4225], ab[8450] , bb[4225], cc[
00115 4225], as[4225], bs[4225], cs[4225], ct[65], alf[7], bet[7];
00116 extern logical lse_(real *, real *, integer *);
00117 real eps, err;
00118 integer nalf, idim[9];
00119 logical same;
00120 integer nbet, ntra;
00121 logical rewi;
00122 integer nout;
00123 extern int schk1_(char *, real *, real *, integer *,
00124 integer *, logical *, logical *, logical *, integer *, integer *,
00125 integer *, real *, integer *, real *, integer *, real *, real *,
00126 real *, real *, real *, real *, real *, real *, real *, real *,
00127 real *, ftnlen), schk2_(char *, real *, real *, integer *,
00128 integer *, logical *, logical *, logical *, integer *, integer *,
00129 integer *, real *, integer *, real *, integer *, real *, real *,
00130 real *, real *, real *, real *, real *, real *, real *, real *,
00131 real *, ftnlen), schk3_(char *, real *, real *, integer *,
00132 integer *, logical *, logical *, logical *, integer *, integer *,
00133 integer *, real *, integer *, real *, real *, real *, real *,
00134 real *, real *, real *, real *, real *, ftnlen), schk4_(char *,
00135 real *, real *, integer *, integer *, logical *, logical *,
00136 logical *, integer *, integer *, integer *, real *, integer *,
00137 real *, integer *, real *, real *, real *, real *, real *, real *,
00138 real *, real *, real *, real *, real *, ftnlen), schk5_(char *,
00139 real *, real *, integer *, integer *, logical *, logical *,
00140 logical *, integer *, integer *, integer *, real *, integer *,
00141 real *, integer *, real *, real *, real *, real *, real *, real *,
00142 real *, real *, real *, real *, real *, ftnlen);
00143 logical fatal;
00144 extern doublereal sdiff_(real *, real *);
00145 extern int schke_(integer *, char *, integer *, ftnlen);
00146 logical trace;
00147 integer nidim;
00148 extern int smmch_(char *, char *, integer *, integer *,
00149 integer *, real *, real *, integer *, real *, integer *, real *,
00150 real *, integer *, real *, real *, real *, integer *, real *,
00151 real *, logical *, integer *, logical *, ftnlen, ftnlen);
00152 char snaps[32];
00153 integer isnum;
00154 logical ltest[6], sfatal;
00155 char snamet[6], transa[1], transb[1];
00156 real thresh;
00157 logical ltestt, tsterr;
00158 char summry[32];
00159
00160
00161 static cilist io___2 = { 0, 5, 0, 0, 0 };
00162 static cilist io___4 = { 0, 5, 0, 0, 0 };
00163 static cilist io___6 = { 0, 5, 0, 0, 0 };
00164 static cilist io___8 = { 0, 5, 0, 0, 0 };
00165 static cilist io___11 = { 0, 5, 0, 0, 0 };
00166 static cilist io___13 = { 0, 5, 0, 0, 0 };
00167 static cilist io___15 = { 0, 5, 0, 0, 0 };
00168 static cilist io___17 = { 0, 5, 0, 0, 0 };
00169 static cilist io___19 = { 0, 5, 0, 0, 0 };
00170 static cilist io___21 = { 0, 0, 0, fmt_9997, 0 };
00171 static cilist io___22 = { 0, 5, 0, 0, 0 };
00172 static cilist io___25 = { 0, 0, 0, fmt_9996, 0 };
00173 static cilist io___26 = { 0, 5, 0, 0, 0 };
00174 static cilist io___28 = { 0, 0, 0, fmt_9997, 0 };
00175 static cilist io___29 = { 0, 5, 0, 0, 0 };
00176 static cilist io___31 = { 0, 5, 0, 0, 0 };
00177 static cilist io___33 = { 0, 0, 0, fmt_9997, 0 };
00178 static cilist io___34 = { 0, 5, 0, 0, 0 };
00179 static cilist io___36 = { 0, 0, 0, fmt_9995, 0 };
00180 static cilist io___37 = { 0, 0, 0, fmt_9994, 0 };
00181 static cilist io___38 = { 0, 0, 0, fmt_9993, 0 };
00182 static cilist io___39 = { 0, 0, 0, fmt_9992, 0 };
00183 static cilist io___40 = { 0, 0, 0, 0, 0 };
00184 static cilist io___41 = { 0, 0, 0, fmt_9984, 0 };
00185 static cilist io___42 = { 0, 0, 0, 0, 0 };
00186 static cilist io___43 = { 0, 0, 0, fmt_9999, 0 };
00187 static cilist io___44 = { 0, 0, 0, 0, 0 };
00188 static cilist io___46 = { 0, 5, 1, fmt_9988, 0 };
00189 static cilist io___49 = { 0, 0, 0, fmt_9990, 0 };
00190 static cilist io___51 = { 0, 0, 0, fmt_9998, 0 };
00191 static cilist io___64 = { 0, 0, 0, fmt_9989, 0 };
00192 static cilist io___65 = { 0, 0, 0, fmt_9989, 0 };
00193 static cilist io___66 = { 0, 0, 0, fmt_9989, 0 };
00194 static cilist io___67 = { 0, 0, 0, fmt_9989, 0 };
00195 static cilist io___69 = { 0, 0, 0, 0, 0 };
00196 static cilist io___70 = { 0, 0, 0, fmt_9987, 0 };
00197 static cilist io___71 = { 0, 0, 0, 0, 0 };
00198 static cilist io___78 = { 0, 0, 0, fmt_9986, 0 };
00199 static cilist io___79 = { 0, 0, 0, fmt_9985, 0 };
00200 static cilist io___80 = { 0, 0, 0, fmt_9991, 0 };
00201
00202
00203
00204
00205
00206
00207
00208
00209
00210
00211
00212
00213
00214
00215
00216
00217
00218
00219
00220
00221
00222
00223
00224
00225
00226
00227
00228
00229
00230
00231
00232
00233
00234
00235
00236
00237
00238
00239
00240
00241
00242
00243
00244
00245
00246
00247
00248
00249
00250
00251
00252
00253
00254
00255
00256
00257
00258
00259
00260
00261
00262
00263
00264 s_rsle(&io___2);
00265 do_lio(&c__9, &c__1, summry, (ftnlen)32);
00266 e_rsle();
00267 s_rsle(&io___4);
00268 do_lio(&c__3, &c__1, (char *)&nout, (ftnlen)sizeof(integer));
00269 e_rsle();
00270 o__1.oerr = 0;
00271 o__1.ounit = nout;
00272 o__1.ofnmlen = 32;
00273 o__1.ofnm = summry;
00274 o__1.orl = 0;
00275 o__1.osta = 0;
00276 o__1.oacc = 0;
00277 o__1.ofm = 0;
00278 o__1.oblnk = 0;
00279 f_open(&o__1);
00280 infoc_1.noutc = nout;
00281
00282
00283
00284 s_rsle(&io___6);
00285 do_lio(&c__9, &c__1, snaps, (ftnlen)32);
00286 e_rsle();
00287 s_rsle(&io___8);
00288 do_lio(&c__3, &c__1, (char *)&ntra, (ftnlen)sizeof(integer));
00289 e_rsle();
00290 trace = ntra >= 0;
00291 if (trace) {
00292 o__1.oerr = 0;
00293 o__1.ounit = ntra;
00294 o__1.ofnmlen = 32;
00295 o__1.ofnm = snaps;
00296 o__1.orl = 0;
00297 o__1.osta = 0;
00298 o__1.oacc = 0;
00299 o__1.ofm = 0;
00300 o__1.oblnk = 0;
00301 f_open(&o__1);
00302 }
00303
00304 s_rsle(&io___11);
00305 do_lio(&c__8, &c__1, (char *)&rewi, (ftnlen)sizeof(logical));
00306 e_rsle();
00307 rewi = rewi && trace;
00308
00309 s_rsle(&io___13);
00310 do_lio(&c__8, &c__1, (char *)&sfatal, (ftnlen)sizeof(logical));
00311 e_rsle();
00312
00313 s_rsle(&io___15);
00314 do_lio(&c__8, &c__1, (char *)&tsterr, (ftnlen)sizeof(logical));
00315 e_rsle();
00316
00317 s_rsle(&io___17);
00318 do_lio(&c__4, &c__1, (char *)&thresh, (ftnlen)sizeof(real));
00319 e_rsle();
00320
00321
00322
00323
00324 s_rsle(&io___19);
00325 do_lio(&c__3, &c__1, (char *)&nidim, (ftnlen)sizeof(integer));
00326 e_rsle();
00327 if (nidim < 1 || nidim > 9) {
00328 io___21.ciunit = nout;
00329 s_wsfe(&io___21);
00330 do_fio(&c__1, "N", (ftnlen)1);
00331 do_fio(&c__1, (char *)&c__9, (ftnlen)sizeof(integer));
00332 e_wsfe();
00333 goto L220;
00334 }
00335 s_rsle(&io___22);
00336 i__1 = nidim;
00337 for (i__ = 1; i__ <= i__1; ++i__) {
00338 do_lio(&c__3, &c__1, (char *)&idim[i__ - 1], (ftnlen)sizeof(integer));
00339 }
00340 e_rsle();
00341 i__1 = nidim;
00342 for (i__ = 1; i__ <= i__1; ++i__) {
00343 if (idim[i__ - 1] < 0 || idim[i__ - 1] > 65) {
00344 io___25.ciunit = nout;
00345 s_wsfe(&io___25);
00346 do_fio(&c__1, (char *)&c__65, (ftnlen)sizeof(integer));
00347 e_wsfe();
00348 goto L220;
00349 }
00350
00351 }
00352
00353 s_rsle(&io___26);
00354 do_lio(&c__3, &c__1, (char *)&nalf, (ftnlen)sizeof(integer));
00355 e_rsle();
00356 if (nalf < 1 || nalf > 7) {
00357 io___28.ciunit = nout;
00358 s_wsfe(&io___28);
00359 do_fio(&c__1, "ALPHA", (ftnlen)5);
00360 do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer));
00361 e_wsfe();
00362 goto L220;
00363 }
00364 s_rsle(&io___29);
00365 i__1 = nalf;
00366 for (i__ = 1; i__ <= i__1; ++i__) {
00367 do_lio(&c__4, &c__1, (char *)&alf[i__ - 1], (ftnlen)sizeof(real));
00368 }
00369 e_rsle();
00370
00371 s_rsle(&io___31);
00372 do_lio(&c__3, &c__1, (char *)&nbet, (ftnlen)sizeof(integer));
00373 e_rsle();
00374 if (nbet < 1 || nbet > 7) {
00375 io___33.ciunit = nout;
00376 s_wsfe(&io___33);
00377 do_fio(&c__1, "BETA", (ftnlen)4);
00378 do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer));
00379 e_wsfe();
00380 goto L220;
00381 }
00382 s_rsle(&io___34);
00383 i__1 = nbet;
00384 for (i__ = 1; i__ <= i__1; ++i__) {
00385 do_lio(&c__4, &c__1, (char *)&bet[i__ - 1], (ftnlen)sizeof(real));
00386 }
00387 e_rsle();
00388
00389
00390
00391 io___36.ciunit = nout;
00392 s_wsfe(&io___36);
00393 e_wsfe();
00394 io___37.ciunit = nout;
00395 s_wsfe(&io___37);
00396 i__1 = nidim;
00397 for (i__ = 1; i__ <= i__1; ++i__) {
00398 do_fio(&c__1, (char *)&idim[i__ - 1], (ftnlen)sizeof(integer));
00399 }
00400 e_wsfe();
00401 io___38.ciunit = nout;
00402 s_wsfe(&io___38);
00403 i__1 = nalf;
00404 for (i__ = 1; i__ <= i__1; ++i__) {
00405 do_fio(&c__1, (char *)&alf[i__ - 1], (ftnlen)sizeof(real));
00406 }
00407 e_wsfe();
00408 io___39.ciunit = nout;
00409 s_wsfe(&io___39);
00410 i__1 = nbet;
00411 for (i__ = 1; i__ <= i__1; ++i__) {
00412 do_fio(&c__1, (char *)&bet[i__ - 1], (ftnlen)sizeof(real));
00413 }
00414 e_wsfe();
00415 if (! tsterr) {
00416 io___40.ciunit = nout;
00417 s_wsle(&io___40);
00418 e_wsle();
00419 io___41.ciunit = nout;
00420 s_wsfe(&io___41);
00421 e_wsfe();
00422 }
00423 io___42.ciunit = nout;
00424 s_wsle(&io___42);
00425 e_wsle();
00426 io___43.ciunit = nout;
00427 s_wsfe(&io___43);
00428 do_fio(&c__1, (char *)&thresh, (ftnlen)sizeof(real));
00429 e_wsfe();
00430 io___44.ciunit = nout;
00431 s_wsle(&io___44);
00432 e_wsle();
00433
00434
00435
00436
00437 for (i__ = 1; i__ <= 6; ++i__) {
00438 ltest[i__ - 1] = FALSE_;
00439
00440 }
00441 L30:
00442 i__1 = s_rsfe(&io___46);
00443 if (i__1 != 0) {
00444 goto L60;
00445 }
00446 i__1 = do_fio(&c__1, snamet, (ftnlen)6);
00447 if (i__1 != 0) {
00448 goto L60;
00449 }
00450 i__1 = do_fio(&c__1, (char *)<estt, (ftnlen)sizeof(logical));
00451 if (i__1 != 0) {
00452 goto L60;
00453 }
00454 i__1 = e_rsfe();
00455 if (i__1 != 0) {
00456 goto L60;
00457 }
00458 for (i__ = 1; i__ <= 6; ++i__) {
00459 if (s_cmp(snamet, snames + (i__ - 1) * 6, (ftnlen)6, (ftnlen)6) == 0)
00460 {
00461 goto L50;
00462 }
00463
00464 }
00465 io___49.ciunit = nout;
00466 s_wsfe(&io___49);
00467 do_fio(&c__1, snamet, (ftnlen)6);
00468 e_wsfe();
00469 s_stop("", (ftnlen)0);
00470 L50:
00471 ltest[i__ - 1] = ltestt;
00472 goto L30;
00473
00474 L60:
00475 cl__1.cerr = 0;
00476 cl__1.cunit = 5;
00477 cl__1.csta = 0;
00478 f_clos(&cl__1);
00479
00480
00481
00482 eps = 1.f;
00483 L70:
00484 r__1 = eps + 1.f;
00485 if (sdiff_(&r__1, &c_b85) == 0.f) {
00486 goto L80;
00487 }
00488 eps *= .5f;
00489 goto L70;
00490 L80:
00491 eps += eps;
00492 io___51.ciunit = nout;
00493 s_wsfe(&io___51);
00494 do_fio(&c__1, (char *)&eps, (ftnlen)sizeof(real));
00495 e_wsfe();
00496
00497
00498
00499 n = 32;
00500 i__1 = n;
00501 for (j = 1; j <= i__1; ++j) {
00502 i__2 = n;
00503 for (i__ = 1; i__ <= i__2; ++i__) {
00504
00505 i__3 = i__ - j + 1;
00506 ab[i__ + j * 65 - 66] = (real) max(i__3,0);
00507
00508 }
00509 ab[j + 4224] = (real) j;
00510 ab[(j + 65) * 65 - 65] = (real) j;
00511 c__[j - 1] = 0.f;
00512
00513 }
00514 i__1 = n;
00515 for (j = 1; j <= i__1; ++j) {
00516 cc[j - 1] = (real) (j * ((j + 1) * j) / 2 - (j + 1) * j * (j - 1) / 3)
00517 ;
00518
00519 }
00520
00521
00522 *(unsigned char *)transa = 'N';
00523 *(unsigned char *)transb = 'N';
00524 smmch_(transa, transb, &n, &c__1, &n, &c_b85, ab, &c__65, &ab[4225], &
00525 c__65, &c_b99, c__, &c__65, ct, g, cc, &c__65, &eps, &err, &fatal,
00526 &nout, &c_true, (ftnlen)1, (ftnlen)1);
00527 same = lse_(cc, ct, &n);
00528 if (! same || err != 0.f) {
00529 io___64.ciunit = nout;
00530 s_wsfe(&io___64);
00531 do_fio(&c__1, transa, (ftnlen)1);
00532 do_fio(&c__1, transb, (ftnlen)1);
00533 do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical));
00534 do_fio(&c__1, (char *)&err, (ftnlen)sizeof(real));
00535 e_wsfe();
00536 s_stop("", (ftnlen)0);
00537 }
00538 *(unsigned char *)transb = 'T';
00539 smmch_(transa, transb, &n, &c__1, &n, &c_b85, ab, &c__65, &ab[4225], &
00540 c__65, &c_b99, c__, &c__65, ct, g, cc, &c__65, &eps, &err, &fatal,
00541 &nout, &c_true, (ftnlen)1, (ftnlen)1);
00542 same = lse_(cc, ct, &n);
00543 if (! same || err != 0.f) {
00544 io___65.ciunit = nout;
00545 s_wsfe(&io___65);
00546 do_fio(&c__1, transa, (ftnlen)1);
00547 do_fio(&c__1, transb, (ftnlen)1);
00548 do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical));
00549 do_fio(&c__1, (char *)&err, (ftnlen)sizeof(real));
00550 e_wsfe();
00551 s_stop("", (ftnlen)0);
00552 }
00553 i__1 = n;
00554 for (j = 1; j <= i__1; ++j) {
00555 ab[j + 4224] = (real) (n - j + 1);
00556 ab[(j + 65) * 65 - 65] = (real) (n - j + 1);
00557
00558 }
00559 i__1 = n;
00560 for (j = 1; j <= i__1; ++j) {
00561 cc[n - j] = (real) (j * ((j + 1) * j) / 2 - (j + 1) * j * (j - 1) / 3)
00562 ;
00563
00564 }
00565 *(unsigned char *)transa = 'T';
00566 *(unsigned char *)transb = 'N';
00567 smmch_(transa, transb, &n, &c__1, &n, &c_b85, ab, &c__65, &ab[4225], &
00568 c__65, &c_b99, c__, &c__65, ct, g, cc, &c__65, &eps, &err, &fatal,
00569 &nout, &c_true, (ftnlen)1, (ftnlen)1);
00570 same = lse_(cc, ct, &n);
00571 if (! same || err != 0.f) {
00572 io___66.ciunit = nout;
00573 s_wsfe(&io___66);
00574 do_fio(&c__1, transa, (ftnlen)1);
00575 do_fio(&c__1, transb, (ftnlen)1);
00576 do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical));
00577 do_fio(&c__1, (char *)&err, (ftnlen)sizeof(real));
00578 e_wsfe();
00579 s_stop("", (ftnlen)0);
00580 }
00581 *(unsigned char *)transb = 'T';
00582 smmch_(transa, transb, &n, &c__1, &n, &c_b85, ab, &c__65, &ab[4225], &
00583 c__65, &c_b99, c__, &c__65, ct, g, cc, &c__65, &eps, &err, &fatal,
00584 &nout, &c_true, (ftnlen)1, (ftnlen)1);
00585 same = lse_(cc, ct, &n);
00586 if (! same || err != 0.f) {
00587 io___67.ciunit = nout;
00588 s_wsfe(&io___67);
00589 do_fio(&c__1, transa, (ftnlen)1);
00590 do_fio(&c__1, transb, (ftnlen)1);
00591 do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical));
00592 do_fio(&c__1, (char *)&err, (ftnlen)sizeof(real));
00593 e_wsfe();
00594 s_stop("", (ftnlen)0);
00595 }
00596
00597
00598
00599 for (isnum = 1; isnum <= 6; ++isnum) {
00600 io___69.ciunit = nout;
00601 s_wsle(&io___69);
00602 e_wsle();
00603 if (! ltest[isnum - 1]) {
00604
00605 io___70.ciunit = nout;
00606 s_wsfe(&io___70);
00607 do_fio(&c__1, snames + (isnum - 1) * 6, (ftnlen)6);
00608 e_wsfe();
00609 } else {
00610 s_copy(srnamc_1.srnamt, snames + (isnum - 1) * 6, (ftnlen)6, (
00611 ftnlen)6);
00612
00613 if (tsterr) {
00614 schke_(&isnum, snames + (isnum - 1) * 6, &nout, (ftnlen)6);
00615 io___71.ciunit = nout;
00616 s_wsle(&io___71);
00617 e_wsle();
00618 }
00619
00620 infoc_1.infot = 0;
00621 infoc_1.ok = TRUE_;
00622 fatal = FALSE_;
00623 switch (isnum) {
00624 case 1: goto L140;
00625 case 2: goto L150;
00626 case 3: goto L160;
00627 case 4: goto L160;
00628 case 5: goto L170;
00629 case 6: goto L180;
00630 }
00631
00632 L140:
00633 schk1_(snames + (isnum - 1) * 6, &eps, &thresh, &nout, &ntra, &
00634 trace, &rewi, &fatal, &nidim, idim, &nalf, alf, &nbet,
00635 bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, cc, cs,
00636 ct, g, (ftnlen)6);
00637 goto L190;
00638
00639 L150:
00640 schk2_(snames + (isnum - 1) * 6, &eps, &thresh, &nout, &ntra, &
00641 trace, &rewi, &fatal, &nidim, idim, &nalf, alf, &nbet,
00642 bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, cc, cs,
00643 ct, g, (ftnlen)6);
00644 goto L190;
00645
00646 L160:
00647 schk3_(snames + (isnum - 1) * 6, &eps, &thresh, &nout, &ntra, &
00648 trace, &rewi, &fatal, &nidim, idim, &nalf, alf, &c__65,
00649 ab, aa, as, &ab[4225], bb, bs, ct, g, c__, (ftnlen)6);
00650 goto L190;
00651
00652 L170:
00653 schk4_(snames + (isnum - 1) * 6, &eps, &thresh, &nout, &ntra, &
00654 trace, &rewi, &fatal, &nidim, idim, &nalf, alf, &nbet,
00655 bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, cc, cs,
00656 ct, g, (ftnlen)6);
00657 goto L190;
00658
00659 L180:
00660 schk5_(snames + (isnum - 1) * 6, &eps, &thresh, &nout, &ntra, &
00661 trace, &rewi, &fatal, &nidim, idim, &nalf, alf, &nbet,
00662 bet, &c__65, ab, aa, as, bb, bs, c__, cc, cs, ct, g, w, (
00663 ftnlen)6);
00664 goto L190;
00665
00666 L190:
00667 if (fatal && sfatal) {
00668 goto L210;
00669 }
00670 }
00671
00672 }
00673 io___78.ciunit = nout;
00674 s_wsfe(&io___78);
00675 e_wsfe();
00676 goto L230;
00677
00678 L210:
00679 io___79.ciunit = nout;
00680 s_wsfe(&io___79);
00681 e_wsfe();
00682 goto L230;
00683
00684 L220:
00685 io___80.ciunit = nout;
00686 s_wsfe(&io___80);
00687 e_wsfe();
00688
00689 L230:
00690 if (trace) {
00691 cl__1.cerr = 0;
00692 cl__1.cunit = ntra;
00693 cl__1.csta = 0;
00694 f_clos(&cl__1);
00695 }
00696 cl__1.cerr = 0;
00697 cl__1.cunit = nout;
00698 cl__1.csta = 0;
00699 f_clos(&cl__1);
00700 s_stop("", (ftnlen)0);
00701
00702
00703
00704
00705 return 0;
00706 }
00707
00708 int schk1_(char *sname, real *eps, real *thresh, integer *
00709 nout, integer *ntra, logical *trace, logical *rewi, logical *fatal,
00710 integer *nidim, integer *idim, integer *nalf, real *alf, integer *
00711 nbet, real *bet, integer *nmax, real *a, real *aa, real *as, real *b,
00712 real *bb, real *bs, real *c__, real *cc, real *cs, real *ct, real *g,
00713 ftnlen sname_len)
00714 {
00715
00716
00717 static char ich[3] = "NTC";
00718
00719
00720 static char fmt_9995[] = "(1x,i6,\002: \002,a6,\002('\002,a1,\002','\002"
00721 ",a1,\002',\002,3(i3,\002,\002),f4.1,\002, A,\002,i3,\002, B,\002"
00722 ",i3,\002,\002,f4.1,\002, \002,\002C,\002,i3,\002).\002)";
00723 static char fmt_9994[] = "(\002 ******* FATAL ERROR - ERROR-EXIT TAKEN O"
00724 "N VALID CALL *\002,\002******\002)";
00725 static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER"
00726 " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)";
00727 static char fmt_9999[] = "(\002 \002,a6,\002 PASSED THE COMPUTATIONAL TE"
00728 "STS (\002,i6,\002 CALL\002,\002S)\002)";
00729 static char fmt_9997[] = "(\002 \002,a6,\002 COMPLETED THE COMPUTATIONAL"
00730 " TESTS (\002,i6,\002 C\002,\002ALLS)\002,/\002 ******* BUT WITH "
00731 "MAXIMUM TEST RATIO\002,f8.2,\002 - SUSPECT *******\002)";
00732 static char fmt_9996[] = "(\002 ******* \002,a6,\002 FAILED ON CALL NUMB"
00733 "ER:\002)";
00734
00735
00736 integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
00737 i__3, i__4, i__5, i__6;
00738 alist al__1;
00739
00740
00741 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void),
00742 f_rew(alist *);
00743
00744
00745 integer i__, k, m, n, ia, ib, ma, mb, na, nb, nc, ik, im, in, ks, ms, ns,
00746 ica, icb, laa, lbb, lda, lcc, ldb, ldc;
00747 real als, bls;
00748 extern logical lse_(real *, real *, integer *);
00749 real err, beta;
00750 integer ldas, ldbs, ldcs;
00751 logical same, null;
00752 real alpha;
00753 logical isame[13];
00754 extern int smake_(char *, char *, char *, integer *,
00755 integer *, real *, integer *, real *, integer *, logical *, real *
00756 , ftnlen, ftnlen, ftnlen);
00757 logical trana, tranb;
00758 extern int smmch_(char *, char *, integer *, integer *,
00759 integer *, real *, real *, integer *, real *, integer *, real *,
00760 real *, integer *, real *, real *, real *, integer *, real *,
00761 real *, logical *, integer *, logical *, ftnlen, ftnlen), sgemm_(
00762 char *, char *, integer *, integer *, integer *, real *, real *,
00763 integer *, real *, integer *, real *, real *, integer *);
00764 integer nargs;
00765 logical reset;
00766 char tranas[1], tranbs[1], transa[1], transb[1];
00767 real errmax;
00768 extern logical lseres_(char *, char *, integer *, integer *, real *, real
00769 *, integer *, ftnlen, ftnlen);
00770
00771
00772 static cilist io___124 = { 0, 0, 0, fmt_9995, 0 };
00773 static cilist io___125 = { 0, 0, 0, fmt_9994, 0 };
00774 static cilist io___128 = { 0, 0, 0, fmt_9998, 0 };
00775 static cilist io___130 = { 0, 0, 0, fmt_9999, 0 };
00776 static cilist io___131 = { 0, 0, 0, fmt_9997, 0 };
00777 static cilist io___132 = { 0, 0, 0, fmt_9996, 0 };
00778 static cilist io___133 = { 0, 0, 0, fmt_9995, 0 };
00779
00780
00781
00782
00783
00784
00785
00786
00787
00788
00789
00790
00791
00792
00793
00794
00795
00796
00797
00798
00799
00800
00801
00802
00803
00804 --idim;
00805 --alf;
00806 --bet;
00807 --g;
00808 --ct;
00809 --cs;
00810 --cc;
00811 c_dim1 = *nmax;
00812 c_offset = 1 + c_dim1;
00813 c__ -= c_offset;
00814 --bs;
00815 --bb;
00816 b_dim1 = *nmax;
00817 b_offset = 1 + b_dim1;
00818 b -= b_offset;
00819 --as;
00820 --aa;
00821 a_dim1 = *nmax;
00822 a_offset = 1 + a_dim1;
00823 a -= a_offset;
00824
00825
00826
00827
00828 nargs = 13;
00829 nc = 0;
00830 reset = TRUE_;
00831 errmax = 0.f;
00832
00833 i__1 = *nidim;
00834 for (im = 1; im <= i__1; ++im) {
00835 m = idim[im];
00836
00837 i__2 = *nidim;
00838 for (in = 1; in <= i__2; ++in) {
00839 n = idim[in];
00840
00841 ldc = m;
00842 if (ldc < *nmax) {
00843 ++ldc;
00844 }
00845
00846 if (ldc > *nmax) {
00847 goto L100;
00848 }
00849 lcc = ldc * n;
00850 null = n <= 0 || m <= 0;
00851
00852 i__3 = *nidim;
00853 for (ik = 1; ik <= i__3; ++ik) {
00854 k = idim[ik];
00855
00856 for (ica = 1; ica <= 3; ++ica) {
00857 *(unsigned char *)transa = *(unsigned char *)&ich[ica - 1]
00858 ;
00859 trana = *(unsigned char *)transa == 'T' || *(unsigned
00860 char *)transa == 'C';
00861
00862 if (trana) {
00863 ma = k;
00864 na = m;
00865 } else {
00866 ma = m;
00867 na = k;
00868 }
00869
00870 lda = ma;
00871 if (lda < *nmax) {
00872 ++lda;
00873 }
00874
00875 if (lda > *nmax) {
00876 goto L80;
00877 }
00878 laa = lda * na;
00879
00880
00881
00882 smake_("GE", " ", " ", &ma, &na, &a[a_offset], nmax, &aa[
00883 1], &lda, &reset, &c_b99, (ftnlen)2, (ftnlen)1, (
00884 ftnlen)1);
00885
00886 for (icb = 1; icb <= 3; ++icb) {
00887 *(unsigned char *)transb = *(unsigned char *)&ich[icb
00888 - 1];
00889 tranb = *(unsigned char *)transb == 'T' || *(unsigned
00890 char *)transb == 'C';
00891
00892 if (tranb) {
00893 mb = n;
00894 nb = k;
00895 } else {
00896 mb = k;
00897 nb = n;
00898 }
00899
00900 ldb = mb;
00901 if (ldb < *nmax) {
00902 ++ldb;
00903 }
00904
00905 if (ldb > *nmax) {
00906 goto L70;
00907 }
00908 lbb = ldb * nb;
00909
00910
00911
00912 smake_("GE", " ", " ", &mb, &nb, &b[b_offset], nmax, &
00913 bb[1], &ldb, &reset, &c_b99, (ftnlen)2, (
00914 ftnlen)1, (ftnlen)1);
00915
00916 i__4 = *nalf;
00917 for (ia = 1; ia <= i__4; ++ia) {
00918 alpha = alf[ia];
00919
00920 i__5 = *nbet;
00921 for (ib = 1; ib <= i__5; ++ib) {
00922 beta = bet[ib];
00923
00924
00925
00926 smake_("GE", " ", " ", &m, &n, &c__[c_offset],
00927 nmax, &cc[1], &ldc, &reset, &c_b99, (
00928 ftnlen)2, (ftnlen)1, (ftnlen)1);
00929
00930 ++nc;
00931
00932
00933
00934
00935 *(unsigned char *)tranas = *(unsigned char *)
00936 transa;
00937 *(unsigned char *)tranbs = *(unsigned char *)
00938 transb;
00939 ms = m;
00940 ns = n;
00941 ks = k;
00942 als = alpha;
00943 i__6 = laa;
00944 for (i__ = 1; i__ <= i__6; ++i__) {
00945 as[i__] = aa[i__];
00946
00947 }
00948 ldas = lda;
00949 i__6 = lbb;
00950 for (i__ = 1; i__ <= i__6; ++i__) {
00951 bs[i__] = bb[i__];
00952
00953 }
00954 ldbs = ldb;
00955 bls = beta;
00956 i__6 = lcc;
00957 for (i__ = 1; i__ <= i__6; ++i__) {
00958 cs[i__] = cc[i__];
00959
00960 }
00961 ldcs = ldc;
00962
00963
00964
00965 if (*trace) {
00966 io___124.ciunit = *ntra;
00967 s_wsfe(&io___124);
00968 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(
00969 integer));
00970 do_fio(&c__1, sname, (ftnlen)6);
00971 do_fio(&c__1, transa, (ftnlen)1);
00972 do_fio(&c__1, transb, (ftnlen)1);
00973 do_fio(&c__1, (char *)&m, (ftnlen)sizeof(
00974 integer));
00975 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
00976 integer));
00977 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(
00978 integer));
00979 do_fio(&c__1, (char *)&alpha, (ftnlen)
00980 sizeof(real));
00981 do_fio(&c__1, (char *)&lda, (ftnlen)
00982 sizeof(integer));
00983 do_fio(&c__1, (char *)&ldb, (ftnlen)
00984 sizeof(integer));
00985 do_fio(&c__1, (char *)&beta, (ftnlen)
00986 sizeof(real));
00987 do_fio(&c__1, (char *)&ldc, (ftnlen)
00988 sizeof(integer));
00989 e_wsfe();
00990 }
00991 if (*rewi) {
00992 al__1.aerr = 0;
00993 al__1.aunit = *ntra;
00994 f_rew(&al__1);
00995 }
00996 sgemm_(transa, transb, &m, &n, &k, &alpha, &
00997 aa[1], &lda, &bb[1], &ldb, &beta, &cc[
00998 1], &ldc);
00999
01000
01001
01002 if (! infoc_1.ok) {
01003 io___125.ciunit = *nout;
01004 s_wsfe(&io___125);
01005 e_wsfe();
01006 *fatal = TRUE_;
01007 goto L120;
01008 }
01009
01010
01011
01012 isame[0] = *(unsigned char *)transa == *(
01013 unsigned char *)tranas;
01014 isame[1] = *(unsigned char *)transb == *(
01015 unsigned char *)tranbs;
01016 isame[2] = ms == m;
01017 isame[3] = ns == n;
01018 isame[4] = ks == k;
01019 isame[5] = als == alpha;
01020 isame[6] = lse_(&as[1], &aa[1], &laa);
01021 isame[7] = ldas == lda;
01022 isame[8] = lse_(&bs[1], &bb[1], &lbb);
01023 isame[9] = ldbs == ldb;
01024 isame[10] = bls == beta;
01025 if (null) {
01026 isame[11] = lse_(&cs[1], &cc[1], &lcc);
01027 } else {
01028 isame[11] = lseres_("GE", " ", &m, &n, &
01029 cs[1], &cc[1], &ldc, (ftnlen)2, (
01030 ftnlen)1);
01031 }
01032 isame[12] = ldcs == ldc;
01033
01034
01035
01036
01037 same = TRUE_;
01038 i__6 = nargs;
01039 for (i__ = 1; i__ <= i__6; ++i__) {
01040 same = same && isame[i__ - 1];
01041 if (! isame[i__ - 1]) {
01042 io___128.ciunit = *nout;
01043 s_wsfe(&io___128);
01044 do_fio(&c__1, (char *)&i__, (ftnlen)
01045 sizeof(integer));
01046 e_wsfe();
01047 }
01048
01049 }
01050 if (! same) {
01051 *fatal = TRUE_;
01052 goto L120;
01053 }
01054
01055 if (! null) {
01056
01057
01058
01059 smmch_(transa, transb, &m, &n, &k, &alpha,
01060 &a[a_offset], nmax, &b[b_offset],
01061 nmax, &beta, &c__[c_offset],
01062 nmax, &ct[1], &g[1], &cc[1], &ldc,
01063 eps, &err, fatal, nout, &c_true,
01064 (ftnlen)1, (ftnlen)1);
01065 errmax = dmax(errmax,err);
01066
01067
01068 if (*fatal) {
01069 goto L120;
01070 }
01071 }
01072
01073
01074 }
01075
01076
01077 }
01078
01079 L70:
01080 ;
01081 }
01082
01083 L80:
01084 ;
01085 }
01086
01087
01088 }
01089
01090 L100:
01091 ;
01092 }
01093
01094
01095 }
01096
01097
01098
01099 if (errmax < *thresh) {
01100 io___130.ciunit = *nout;
01101 s_wsfe(&io___130);
01102 do_fio(&c__1, sname, (ftnlen)6);
01103 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
01104 e_wsfe();
01105 } else {
01106 io___131.ciunit = *nout;
01107 s_wsfe(&io___131);
01108 do_fio(&c__1, sname, (ftnlen)6);
01109 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
01110 do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real));
01111 e_wsfe();
01112 }
01113 goto L130;
01114
01115 L120:
01116 io___132.ciunit = *nout;
01117 s_wsfe(&io___132);
01118 do_fio(&c__1, sname, (ftnlen)6);
01119 e_wsfe();
01120 io___133.ciunit = *nout;
01121 s_wsfe(&io___133);
01122 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
01123 do_fio(&c__1, sname, (ftnlen)6);
01124 do_fio(&c__1, transa, (ftnlen)1);
01125 do_fio(&c__1, transb, (ftnlen)1);
01126 do_fio(&c__1, (char *)&m, (ftnlen)sizeof(integer));
01127 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01128 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
01129 do_fio(&c__1, (char *)&alpha, (ftnlen)sizeof(real));
01130 do_fio(&c__1, (char *)&lda, (ftnlen)sizeof(integer));
01131 do_fio(&c__1, (char *)&ldb, (ftnlen)sizeof(integer));
01132 do_fio(&c__1, (char *)&beta, (ftnlen)sizeof(real));
01133 do_fio(&c__1, (char *)&ldc, (ftnlen)sizeof(integer));
01134 e_wsfe();
01135
01136 L130:
01137 return 0;
01138
01139
01140
01141
01142 }
01143
01144 int schk2_(char *sname, real *eps, real *thresh, integer *
01145 nout, integer *ntra, logical *trace, logical *rewi, logical *fatal,
01146 integer *nidim, integer *idim, integer *nalf, real *alf, integer *
01147 nbet, real *bet, integer *nmax, real *a, real *aa, real *as, real *b,
01148 real *bb, real *bs, real *c__, real *cc, real *cs, real *ct, real *g,
01149 ftnlen sname_len)
01150 {
01151
01152
01153 static char ichs[2] = "LR";
01154 static char ichu[2] = "UL";
01155
01156
01157 static char fmt_9995[] = "(1x,i6,\002: \002,a6,\002(\002,2(\002'\002,a1"
01158 ",\002',\002),2(i3,\002,\002),f4.1,\002, A,\002,i3,\002, B,\002,i"
01159 "3,\002,\002,f4.1,\002, C,\002,i3,\002) \002,\002 .\002)";
01160 static char fmt_9994[] = "(\002 ******* FATAL ERROR - ERROR-EXIT TAKEN O"
01161 "N VALID CALL *\002,\002******\002)";
01162 static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER"
01163 " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)";
01164 static char fmt_9999[] = "(\002 \002,a6,\002 PASSED THE COMPUTATIONAL TE"
01165 "STS (\002,i6,\002 CALL\002,\002S)\002)";
01166 static char fmt_9997[] = "(\002 \002,a6,\002 COMPLETED THE COMPUTATIONAL"
01167 " TESTS (\002,i6,\002 C\002,\002ALLS)\002,/\002 ******* BUT WITH "
01168 "MAXIMUM TEST RATIO\002,f8.2,\002 - SUSPECT *******\002)";
01169 static char fmt_9996[] = "(\002 ******* \002,a6,\002 FAILED ON CALL NUMB"
01170 "ER:\002)";
01171
01172
01173 integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
01174 i__3, i__4, i__5;
01175 alist al__1;
01176
01177
01178 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void),
01179 f_rew(alist *);
01180
01181
01182 integer i__, m, n, ia, ib, na, nc, im, in, ms, ns, laa, lbb, lda, lcc,
01183 ldb, ldc, ics;
01184 real als, bls;
01185 integer icu;
01186 extern logical lse_(real *, real *, integer *);
01187 real err, beta;
01188 integer ldas, ldbs, ldcs;
01189 logical same;
01190 char side[1];
01191 logical left, null;
01192 char uplo[1];
01193 real alpha;
01194 logical isame[13];
01195 extern int smake_(char *, char *, char *, integer *,
01196 integer *, real *, integer *, real *, integer *, logical *, real *
01197 , ftnlen, ftnlen, ftnlen);
01198 char sides[1];
01199 extern int smmch_(char *, char *, integer *, integer *,
01200 integer *, real *, real *, integer *, real *, integer *, real *,
01201 real *, integer *, real *, real *, real *, integer *, real *,
01202 real *, logical *, integer *, logical *, ftnlen, ftnlen);
01203 integer nargs;
01204 logical reset;
01205 char uplos[1];
01206 extern int ssymm_(char *, char *, integer *, integer *,
01207 real *, real *, integer *, real *, integer *, real *, real *,
01208 integer *);
01209 real errmax;
01210 extern logical lseres_(char *, char *, integer *, integer *, real *, real
01211 *, integer *, ftnlen, ftnlen);
01212
01213
01214 static cilist io___171 = { 0, 0, 0, fmt_9995, 0 };
01215 static cilist io___172 = { 0, 0, 0, fmt_9994, 0 };
01216 static cilist io___175 = { 0, 0, 0, fmt_9998, 0 };
01217 static cilist io___177 = { 0, 0, 0, fmt_9999, 0 };
01218 static cilist io___178 = { 0, 0, 0, fmt_9997, 0 };
01219 static cilist io___179 = { 0, 0, 0, fmt_9996, 0 };
01220 static cilist io___180 = { 0, 0, 0, fmt_9995, 0 };
01221
01222
01223
01224
01225
01226
01227
01228
01229
01230
01231
01232
01233
01234
01235
01236
01237
01238
01239
01240
01241
01242
01243
01244
01245
01246 --idim;
01247 --alf;
01248 --bet;
01249 --g;
01250 --ct;
01251 --cs;
01252 --cc;
01253 c_dim1 = *nmax;
01254 c_offset = 1 + c_dim1;
01255 c__ -= c_offset;
01256 --bs;
01257 --bb;
01258 b_dim1 = *nmax;
01259 b_offset = 1 + b_dim1;
01260 b -= b_offset;
01261 --as;
01262 --aa;
01263 a_dim1 = *nmax;
01264 a_offset = 1 + a_dim1;
01265 a -= a_offset;
01266
01267
01268
01269
01270 nargs = 12;
01271 nc = 0;
01272 reset = TRUE_;
01273 errmax = 0.f;
01274
01275 i__1 = *nidim;
01276 for (im = 1; im <= i__1; ++im) {
01277 m = idim[im];
01278
01279 i__2 = *nidim;
01280 for (in = 1; in <= i__2; ++in) {
01281 n = idim[in];
01282
01283 ldc = m;
01284 if (ldc < *nmax) {
01285 ++ldc;
01286 }
01287
01288 if (ldc > *nmax) {
01289 goto L90;
01290 }
01291 lcc = ldc * n;
01292 null = n <= 0 || m <= 0;
01293
01294
01295 ldb = m;
01296 if (ldb < *nmax) {
01297 ++ldb;
01298 }
01299
01300 if (ldb > *nmax) {
01301 goto L90;
01302 }
01303 lbb = ldb * n;
01304
01305
01306
01307 smake_("GE", " ", " ", &m, &n, &b[b_offset], nmax, &bb[1], &ldb, &
01308 reset, &c_b99, (ftnlen)2, (ftnlen)1, (ftnlen)1);
01309
01310 for (ics = 1; ics <= 2; ++ics) {
01311 *(unsigned char *)side = *(unsigned char *)&ichs[ics - 1];
01312 left = *(unsigned char *)side == 'L';
01313
01314 if (left) {
01315 na = m;
01316 } else {
01317 na = n;
01318 }
01319
01320 lda = na;
01321 if (lda < *nmax) {
01322 ++lda;
01323 }
01324
01325 if (lda > *nmax) {
01326 goto L80;
01327 }
01328 laa = lda * na;
01329
01330 for (icu = 1; icu <= 2; ++icu) {
01331 *(unsigned char *)uplo = *(unsigned char *)&ichu[icu - 1];
01332
01333
01334
01335 smake_("SY", uplo, " ", &na, &na, &a[a_offset], nmax, &aa[
01336 1], &lda, &reset, &c_b99, (ftnlen)2, (ftnlen)1, (
01337 ftnlen)1);
01338
01339 i__3 = *nalf;
01340 for (ia = 1; ia <= i__3; ++ia) {
01341 alpha = alf[ia];
01342
01343 i__4 = *nbet;
01344 for (ib = 1; ib <= i__4; ++ib) {
01345 beta = bet[ib];
01346
01347
01348
01349 smake_("GE", " ", " ", &m, &n, &c__[c_offset],
01350 nmax, &cc[1], &ldc, &reset, &c_b99, (
01351 ftnlen)2, (ftnlen)1, (ftnlen)1);
01352
01353 ++nc;
01354
01355
01356
01357
01358 *(unsigned char *)sides = *(unsigned char *)side;
01359 *(unsigned char *)uplos = *(unsigned char *)uplo;
01360 ms = m;
01361 ns = n;
01362 als = alpha;
01363 i__5 = laa;
01364 for (i__ = 1; i__ <= i__5; ++i__) {
01365 as[i__] = aa[i__];
01366
01367 }
01368 ldas = lda;
01369 i__5 = lbb;
01370 for (i__ = 1; i__ <= i__5; ++i__) {
01371 bs[i__] = bb[i__];
01372
01373 }
01374 ldbs = ldb;
01375 bls = beta;
01376 i__5 = lcc;
01377 for (i__ = 1; i__ <= i__5; ++i__) {
01378 cs[i__] = cc[i__];
01379
01380 }
01381 ldcs = ldc;
01382
01383
01384
01385 if (*trace) {
01386 io___171.ciunit = *ntra;
01387 s_wsfe(&io___171);
01388 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(
01389 integer));
01390 do_fio(&c__1, sname, (ftnlen)6);
01391 do_fio(&c__1, side, (ftnlen)1);
01392 do_fio(&c__1, uplo, (ftnlen)1);
01393 do_fio(&c__1, (char *)&m, (ftnlen)sizeof(
01394 integer));
01395 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
01396 integer));
01397 do_fio(&c__1, (char *)&alpha, (ftnlen)sizeof(
01398 real));
01399 do_fio(&c__1, (char *)&lda, (ftnlen)sizeof(
01400 integer));
01401 do_fio(&c__1, (char *)&ldb, (ftnlen)sizeof(
01402 integer));
01403 do_fio(&c__1, (char *)&beta, (ftnlen)sizeof(
01404 real));
01405 do_fio(&c__1, (char *)&ldc, (ftnlen)sizeof(
01406 integer));
01407 e_wsfe();
01408 }
01409 if (*rewi) {
01410 al__1.aerr = 0;
01411 al__1.aunit = *ntra;
01412 f_rew(&al__1);
01413 }
01414 ssymm_(side, uplo, &m, &n, &alpha, &aa[1], &lda, &
01415 bb[1], &ldb, &beta, &cc[1], &ldc);
01416
01417
01418
01419 if (! infoc_1.ok) {
01420 io___172.ciunit = *nout;
01421 s_wsfe(&io___172);
01422 e_wsfe();
01423 *fatal = TRUE_;
01424 goto L110;
01425 }
01426
01427
01428
01429 isame[0] = *(unsigned char *)sides == *(unsigned
01430 char *)side;
01431 isame[1] = *(unsigned char *)uplos == *(unsigned
01432 char *)uplo;
01433 isame[2] = ms == m;
01434 isame[3] = ns == n;
01435 isame[4] = als == alpha;
01436 isame[5] = lse_(&as[1], &aa[1], &laa);
01437 isame[6] = ldas == lda;
01438 isame[7] = lse_(&bs[1], &bb[1], &lbb);
01439 isame[8] = ldbs == ldb;
01440 isame[9] = bls == beta;
01441 if (null) {
01442 isame[10] = lse_(&cs[1], &cc[1], &lcc);
01443 } else {
01444 isame[10] = lseres_("GE", " ", &m, &n, &cs[1],
01445 &cc[1], &ldc, (ftnlen)2, (ftnlen)1);
01446 }
01447 isame[11] = ldcs == ldc;
01448
01449
01450
01451
01452 same = TRUE_;
01453 i__5 = nargs;
01454 for (i__ = 1; i__ <= i__5; ++i__) {
01455 same = same && isame[i__ - 1];
01456 if (! isame[i__ - 1]) {
01457 io___175.ciunit = *nout;
01458 s_wsfe(&io___175);
01459 do_fio(&c__1, (char *)&i__, (ftnlen)
01460 sizeof(integer));
01461 e_wsfe();
01462 }
01463
01464 }
01465 if (! same) {
01466 *fatal = TRUE_;
01467 goto L110;
01468 }
01469
01470 if (! null) {
01471
01472
01473
01474 if (left) {
01475 smmch_("N", "N", &m, &n, &m, &alpha, &a[
01476 a_offset], nmax, &b[b_offset],
01477 nmax, &beta, &c__[c_offset], nmax,
01478 &ct[1], &g[1], &cc[1], &ldc, eps,
01479 &err, fatal, nout, &c_true, (
01480 ftnlen)1, (ftnlen)1);
01481 } else {
01482 smmch_("N", "N", &m, &n, &n, &alpha, &b[
01483 b_offset], nmax, &a[a_offset],
01484 nmax, &beta, &c__[c_offset], nmax,
01485 &ct[1], &g[1], &cc[1], &ldc, eps,
01486 &err, fatal, nout, &c_true, (
01487 ftnlen)1, (ftnlen)1);
01488 }
01489 errmax = dmax(errmax,err);
01490
01491
01492 if (*fatal) {
01493 goto L110;
01494 }
01495 }
01496
01497
01498 }
01499
01500
01501 }
01502
01503
01504 }
01505
01506 L80:
01507 ;
01508 }
01509
01510 L90:
01511 ;
01512 }
01513
01514
01515 }
01516
01517
01518
01519 if (errmax < *thresh) {
01520 io___177.ciunit = *nout;
01521 s_wsfe(&io___177);
01522 do_fio(&c__1, sname, (ftnlen)6);
01523 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
01524 e_wsfe();
01525 } else {
01526 io___178.ciunit = *nout;
01527 s_wsfe(&io___178);
01528 do_fio(&c__1, sname, (ftnlen)6);
01529 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
01530 do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real));
01531 e_wsfe();
01532 }
01533 goto L120;
01534
01535 L110:
01536 io___179.ciunit = *nout;
01537 s_wsfe(&io___179);
01538 do_fio(&c__1, sname, (ftnlen)6);
01539 e_wsfe();
01540 io___180.ciunit = *nout;
01541 s_wsfe(&io___180);
01542 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
01543 do_fio(&c__1, sname, (ftnlen)6);
01544 do_fio(&c__1, side, (ftnlen)1);
01545 do_fio(&c__1, uplo, (ftnlen)1);
01546 do_fio(&c__1, (char *)&m, (ftnlen)sizeof(integer));
01547 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01548 do_fio(&c__1, (char *)&alpha, (ftnlen)sizeof(real));
01549 do_fio(&c__1, (char *)&lda, (ftnlen)sizeof(integer));
01550 do_fio(&c__1, (char *)&ldb, (ftnlen)sizeof(integer));
01551 do_fio(&c__1, (char *)&beta, (ftnlen)sizeof(real));
01552 do_fio(&c__1, (char *)&ldc, (ftnlen)sizeof(integer));
01553 e_wsfe();
01554
01555 L120:
01556 return 0;
01557
01558
01559
01560
01561 }
01562
01563 int schk3_(char *sname, real *eps, real *thresh, integer *
01564 nout, integer *ntra, logical *trace, logical *rewi, logical *fatal,
01565 integer *nidim, integer *idim, integer *nalf, real *alf, integer *
01566 nmax, real *a, real *aa, real *as, real *b, real *bb, real *bs, real *
01567 ct, real *g, real *c__, ftnlen sname_len)
01568 {
01569
01570
01571 static char ichu[2] = "UL";
01572 static char icht[3] = "NTC";
01573 static char ichd[2] = "UN";
01574 static char ichs[2] = "LR";
01575
01576
01577 static char fmt_9995[] = "(1x,i6,\002: \002,a6,\002(\002,4(\002'\002,a1"
01578 ",\002',\002),2(i3,\002,\002),f4.1,\002, A,\002,i3,\002, B,\002,i"
01579 "3,\002) .\002)";
01580 static char fmt_9994[] = "(\002 ******* FATAL ERROR - ERROR-EXIT TAKEN O"
01581 "N VALID CALL *\002,\002******\002)";
01582 static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER"
01583 " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)";
01584 static char fmt_9999[] = "(\002 \002,a6,\002 PASSED THE COMPUTATIONAL TE"
01585 "STS (\002,i6,\002 CALL\002,\002S)\002)";
01586 static char fmt_9997[] = "(\002 \002,a6,\002 COMPLETED THE COMPUTATIONAL"
01587 " TESTS (\002,i6,\002 C\002,\002ALLS)\002,/\002 ******* BUT WITH "
01588 "MAXIMUM TEST RATIO\002,f8.2,\002 - SUSPECT *******\002)";
01589 static char fmt_9996[] = "(\002 ******* \002,a6,\002 FAILED ON CALL NUMB"
01590 "ER:\002)";
01591
01592
01593 integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
01594 i__3, i__4, i__5;
01595 alist al__1;
01596
01597
01598 integer s_cmp(char *, char *, ftnlen, ftnlen), s_wsfe(cilist *), do_fio(
01599 integer *, char *, ftnlen), e_wsfe(void), f_rew(alist *);
01600
01601
01602 integer i__, j, m, n, ia, na, nc, im, in, ms, ns, laa, icd, lbb, lda, ldb,
01603 ics;
01604 real als;
01605 integer ict, icu;
01606 extern logical lse_(real *, real *, integer *);
01607 real err;
01608 char diag[1];
01609 integer ldas, ldbs;
01610 logical same;
01611 char side[1];
01612 logical left, null;
01613 char uplo[1];
01614 real alpha;
01615 char diags[1];
01616 logical isame[13];
01617 extern int smake_(char *, char *, char *, integer *,
01618 integer *, real *, integer *, real *, integer *, logical *, real *
01619 , ftnlen, ftnlen, ftnlen);
01620 char sides[1];
01621 extern int smmch_(char *, char *, integer *, integer *,
01622 integer *, real *, real *, integer *, real *, integer *, real *,
01623 real *, integer *, real *, real *, real *, integer *, real *,
01624 real *, logical *, integer *, logical *, ftnlen, ftnlen);
01625 integer nargs;
01626 logical reset;
01627 char uplos[1];
01628 extern int strmm_(char *, char *, char *, char *,
01629 integer *, integer *, real *, real *, integer *, real *, integer *
01630 ), strsm_(char *, char *, char *,
01631 char *, integer *, integer *, real *, real *, integer *, real *,
01632 integer *);
01633 char tranas[1], transa[1];
01634 real errmax;
01635 extern logical lseres_(char *, char *, integer *, integer *, real *, real
01636 *, integer *, ftnlen, ftnlen);
01637
01638
01639 static cilist io___221 = { 0, 0, 0, fmt_9995, 0 };
01640 static cilist io___222 = { 0, 0, 0, fmt_9995, 0 };
01641 static cilist io___223 = { 0, 0, 0, fmt_9994, 0 };
01642 static cilist io___226 = { 0, 0, 0, fmt_9998, 0 };
01643 static cilist io___228 = { 0, 0, 0, fmt_9999, 0 };
01644 static cilist io___229 = { 0, 0, 0, fmt_9997, 0 };
01645 static cilist io___230 = { 0, 0, 0, fmt_9996, 0 };
01646 static cilist io___231 = { 0, 0, 0, fmt_9995, 0 };
01647
01648
01649
01650
01651
01652
01653
01654
01655
01656
01657
01658
01659
01660
01661
01662
01663
01664
01665
01666
01667
01668
01669
01670
01671
01672 --idim;
01673 --alf;
01674 c_dim1 = *nmax;
01675 c_offset = 1 + c_dim1;
01676 c__ -= c_offset;
01677 --g;
01678 --ct;
01679 --bs;
01680 --bb;
01681 b_dim1 = *nmax;
01682 b_offset = 1 + b_dim1;
01683 b -= b_offset;
01684 --as;
01685 --aa;
01686 a_dim1 = *nmax;
01687 a_offset = 1 + a_dim1;
01688 a -= a_offset;
01689
01690
01691
01692
01693 nargs = 11;
01694 nc = 0;
01695 reset = TRUE_;
01696 errmax = 0.f;
01697
01698 i__1 = *nmax;
01699 for (j = 1; j <= i__1; ++j) {
01700 i__2 = *nmax;
01701 for (i__ = 1; i__ <= i__2; ++i__) {
01702 c__[i__ + j * c_dim1] = 0.f;
01703
01704 }
01705
01706 }
01707
01708 i__1 = *nidim;
01709 for (im = 1; im <= i__1; ++im) {
01710 m = idim[im];
01711
01712 i__2 = *nidim;
01713 for (in = 1; in <= i__2; ++in) {
01714 n = idim[in];
01715
01716 ldb = m;
01717 if (ldb < *nmax) {
01718 ++ldb;
01719 }
01720
01721 if (ldb > *nmax) {
01722 goto L130;
01723 }
01724 lbb = ldb * n;
01725 null = m <= 0 || n <= 0;
01726
01727 for (ics = 1; ics <= 2; ++ics) {
01728 *(unsigned char *)side = *(unsigned char *)&ichs[ics - 1];
01729 left = *(unsigned char *)side == 'L';
01730 if (left) {
01731 na = m;
01732 } else {
01733 na = n;
01734 }
01735
01736 lda = na;
01737 if (lda < *nmax) {
01738 ++lda;
01739 }
01740
01741 if (lda > *nmax) {
01742 goto L130;
01743 }
01744 laa = lda * na;
01745
01746 for (icu = 1; icu <= 2; ++icu) {
01747 *(unsigned char *)uplo = *(unsigned char *)&ichu[icu - 1];
01748
01749 for (ict = 1; ict <= 3; ++ict) {
01750 *(unsigned char *)transa = *(unsigned char *)&icht[
01751 ict - 1];
01752
01753 for (icd = 1; icd <= 2; ++icd) {
01754 *(unsigned char *)diag = *(unsigned char *)&ichd[
01755 icd - 1];
01756
01757 i__3 = *nalf;
01758 for (ia = 1; ia <= i__3; ++ia) {
01759 alpha = alf[ia];
01760
01761
01762
01763 smake_("TR", uplo, diag, &na, &na, &a[
01764 a_offset], nmax, &aa[1], &lda, &reset,
01765 &c_b99, (ftnlen)2, (ftnlen)1, (
01766 ftnlen)1);
01767
01768
01769
01770 smake_("GE", " ", " ", &m, &n, &b[b_offset],
01771 nmax, &bb[1], &ldb, &reset, &c_b99, (
01772 ftnlen)2, (ftnlen)1, (ftnlen)1);
01773
01774 ++nc;
01775
01776
01777
01778
01779 *(unsigned char *)sides = *(unsigned char *)
01780 side;
01781 *(unsigned char *)uplos = *(unsigned char *)
01782 uplo;
01783 *(unsigned char *)tranas = *(unsigned char *)
01784 transa;
01785 *(unsigned char *)diags = *(unsigned char *)
01786 diag;
01787 ms = m;
01788 ns = n;
01789 als = alpha;
01790 i__4 = laa;
01791 for (i__ = 1; i__ <= i__4; ++i__) {
01792 as[i__] = aa[i__];
01793
01794 }
01795 ldas = lda;
01796 i__4 = lbb;
01797 for (i__ = 1; i__ <= i__4; ++i__) {
01798 bs[i__] = bb[i__];
01799
01800 }
01801 ldbs = ldb;
01802
01803
01804
01805 if (s_cmp(sname + 3, "MM", (ftnlen)2, (ftnlen)
01806 2) == 0) {
01807 if (*trace) {
01808 io___221.ciunit = *ntra;
01809 s_wsfe(&io___221);
01810 do_fio(&c__1, (char *)&nc, (ftnlen)
01811 sizeof(integer));
01812 do_fio(&c__1, sname, (ftnlen)6);
01813 do_fio(&c__1, side, (ftnlen)1);
01814 do_fio(&c__1, uplo, (ftnlen)1);
01815 do_fio(&c__1, transa, (ftnlen)1);
01816 do_fio(&c__1, diag, (ftnlen)1);
01817 do_fio(&c__1, (char *)&m, (ftnlen)
01818 sizeof(integer));
01819 do_fio(&c__1, (char *)&n, (ftnlen)
01820 sizeof(integer));
01821 do_fio(&c__1, (char *)&alpha, (ftnlen)
01822 sizeof(real));
01823 do_fio(&c__1, (char *)&lda, (ftnlen)
01824 sizeof(integer));
01825 do_fio(&c__1, (char *)&ldb, (ftnlen)
01826 sizeof(integer));
01827 e_wsfe();
01828 }
01829 if (*rewi) {
01830 al__1.aerr = 0;
01831 al__1.aunit = *ntra;
01832 f_rew(&al__1);
01833 }
01834 strmm_(side, uplo, transa, diag, &m, &n, &
01835 alpha, &aa[1], &lda, &bb[1], &ldb);
01836 } else if (s_cmp(sname + 3, "SM", (ftnlen)2, (
01837 ftnlen)2) == 0) {
01838 if (*trace) {
01839 io___222.ciunit = *ntra;
01840 s_wsfe(&io___222);
01841 do_fio(&c__1, (char *)&nc, (ftnlen)
01842 sizeof(integer));
01843 do_fio(&c__1, sname, (ftnlen)6);
01844 do_fio(&c__1, side, (ftnlen)1);
01845 do_fio(&c__1, uplo, (ftnlen)1);
01846 do_fio(&c__1, transa, (ftnlen)1);
01847 do_fio(&c__1, diag, (ftnlen)1);
01848 do_fio(&c__1, (char *)&m, (ftnlen)
01849 sizeof(integer));
01850 do_fio(&c__1, (char *)&n, (ftnlen)
01851 sizeof(integer));
01852 do_fio(&c__1, (char *)&alpha, (ftnlen)
01853 sizeof(real));
01854 do_fio(&c__1, (char *)&lda, (ftnlen)
01855 sizeof(integer));
01856 do_fio(&c__1, (char *)&ldb, (ftnlen)
01857 sizeof(integer));
01858 e_wsfe();
01859 }
01860 if (*rewi) {
01861 al__1.aerr = 0;
01862 al__1.aunit = *ntra;
01863 f_rew(&al__1);
01864 }
01865 strsm_(side, uplo, transa, diag, &m, &n, &
01866 alpha, &aa[1], &lda, &bb[1], &ldb);
01867 }
01868
01869
01870
01871 if (! infoc_1.ok) {
01872 io___223.ciunit = *nout;
01873 s_wsfe(&io___223);
01874 e_wsfe();
01875 *fatal = TRUE_;
01876 goto L150;
01877 }
01878
01879
01880
01881 isame[0] = *(unsigned char *)sides == *(
01882 unsigned char *)side;
01883 isame[1] = *(unsigned char *)uplos == *(
01884 unsigned char *)uplo;
01885 isame[2] = *(unsigned char *)tranas == *(
01886 unsigned char *)transa;
01887 isame[3] = *(unsigned char *)diags == *(
01888 unsigned char *)diag;
01889 isame[4] = ms == m;
01890 isame[5] = ns == n;
01891 isame[6] = als == alpha;
01892 isame[7] = lse_(&as[1], &aa[1], &laa);
01893 isame[8] = ldas == lda;
01894 if (null) {
01895 isame[9] = lse_(&bs[1], &bb[1], &lbb);
01896 } else {
01897 isame[9] = lseres_("GE", " ", &m, &n, &bs[
01898 1], &bb[1], &ldb, (ftnlen)2, (
01899 ftnlen)1);
01900 }
01901 isame[10] = ldbs == ldb;
01902
01903
01904
01905
01906 same = TRUE_;
01907 i__4 = nargs;
01908 for (i__ = 1; i__ <= i__4; ++i__) {
01909 same = same && isame[i__ - 1];
01910 if (! isame[i__ - 1]) {
01911 io___226.ciunit = *nout;
01912 s_wsfe(&io___226);
01913 do_fio(&c__1, (char *)&i__, (ftnlen)
01914 sizeof(integer));
01915 e_wsfe();
01916 }
01917
01918 }
01919 if (! same) {
01920 *fatal = TRUE_;
01921 goto L150;
01922 }
01923
01924 if (! null) {
01925 if (s_cmp(sname + 3, "MM", (ftnlen)2, (
01926 ftnlen)2) == 0) {
01927
01928
01929
01930 if (left) {
01931 smmch_(transa, "N", &m, &n, &m, &
01932 alpha, &a[a_offset], nmax,
01933 &b[b_offset], nmax, &
01934 c_b99, &c__[c_offset],
01935 nmax, &ct[1], &g[1], &bb[
01936 1], &ldb, eps, &err,
01937 fatal, nout, &c_true, (
01938 ftnlen)1, (ftnlen)1);
01939 } else {
01940 smmch_("N", transa, &m, &n, &n, &
01941 alpha, &b[b_offset], nmax,
01942 &a[a_offset], nmax, &
01943 c_b99, &c__[c_offset],
01944 nmax, &ct[1], &g[1], &bb[
01945 1], &ldb, eps, &err,
01946 fatal, nout, &c_true, (
01947 ftnlen)1, (ftnlen)1);
01948 }
01949 } else if (s_cmp(sname + 3, "SM", (ftnlen)
01950 2, (ftnlen)2) == 0) {
01951
01952
01953
01954
01955 i__4 = n;
01956 for (j = 1; j <= i__4; ++j) {
01957 i__5 = m;
01958 for (i__ = 1; i__ <= i__5; ++i__)
01959 {
01960 c__[i__ + j * c_dim1] = bb[i__ + (j - 1) * ldb];
01961 bb[i__ + (j - 1) * ldb] = alpha * b[i__ + j *
01962 b_dim1];
01963
01964 }
01965
01966 }
01967
01968 if (left) {
01969 smmch_(transa, "N", &m, &n, &m, &
01970 c_b85, &a[a_offset], nmax,
01971 &c__[c_offset], nmax, &
01972 c_b99, &b[b_offset], nmax,
01973 &ct[1], &g[1], &bb[1], &
01974 ldb, eps, &err, fatal,
01975 nout, &c_false, (ftnlen)1,
01976 (ftnlen)1);
01977 } else {
01978 smmch_("N", transa, &m, &n, &n, &
01979 c_b85, &c__[c_offset],
01980 nmax, &a[a_offset], nmax,
01981 &c_b99, &b[b_offset],
01982 nmax, &ct[1], &g[1], &bb[
01983 1], &ldb, eps, &err,
01984 fatal, nout, &c_false, (
01985 ftnlen)1, (ftnlen)1);
01986 }
01987 }
01988 errmax = dmax(errmax,err);
01989
01990
01991 if (*fatal) {
01992 goto L150;
01993 }
01994 }
01995
01996
01997 }
01998
01999
02000 }
02001
02002
02003 }
02004
02005
02006 }
02007
02008
02009 }
02010
02011 L130:
02012 ;
02013 }
02014
02015
02016 }
02017
02018
02019
02020 if (errmax < *thresh) {
02021 io___228.ciunit = *nout;
02022 s_wsfe(&io___228);
02023 do_fio(&c__1, sname, (ftnlen)6);
02024 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
02025 e_wsfe();
02026 } else {
02027 io___229.ciunit = *nout;
02028 s_wsfe(&io___229);
02029 do_fio(&c__1, sname, (ftnlen)6);
02030 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
02031 do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real));
02032 e_wsfe();
02033 }
02034 goto L160;
02035
02036 L150:
02037 io___230.ciunit = *nout;
02038 s_wsfe(&io___230);
02039 do_fio(&c__1, sname, (ftnlen)6);
02040 e_wsfe();
02041 io___231.ciunit = *nout;
02042 s_wsfe(&io___231);
02043 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
02044 do_fio(&c__1, sname, (ftnlen)6);
02045 do_fio(&c__1, side, (ftnlen)1);
02046 do_fio(&c__1, uplo, (ftnlen)1);
02047 do_fio(&c__1, transa, (ftnlen)1);
02048 do_fio(&c__1, diag, (ftnlen)1);
02049 do_fio(&c__1, (char *)&m, (ftnlen)sizeof(integer));
02050 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02051 do_fio(&c__1, (char *)&alpha, (ftnlen)sizeof(real));
02052 do_fio(&c__1, (char *)&lda, (ftnlen)sizeof(integer));
02053 do_fio(&c__1, (char *)&ldb, (ftnlen)sizeof(integer));
02054 e_wsfe();
02055
02056 L160:
02057 return 0;
02058
02059
02060
02061
02062 }
02063
02064 int schk4_(char *sname, real *eps, real *thresh, integer *
02065 nout, integer *ntra, logical *trace, logical *rewi, logical *fatal,
02066 integer *nidim, integer *idim, integer *nalf, real *alf, integer *
02067 nbet, real *bet, integer *nmax, real *a, real *aa, real *as, real *b,
02068 real *bb, real *bs, real *c__, real *cc, real *cs, real *ct, real *g,
02069 ftnlen sname_len)
02070 {
02071
02072
02073 static char icht[3] = "NTC";
02074 static char ichu[2] = "UL";
02075
02076
02077 static char fmt_9994[] = "(1x,i6,\002: \002,a6,\002(\002,2(\002'\002,a1"
02078 ",\002',\002),2(i3,\002,\002),f4.1,\002, A,\002,i3,\002,\002,f4.1,"
02079 "\002, C,\002,i3,\002) .\002)";
02080 static char fmt_9993[] = "(\002 ******* FATAL ERROR - ERROR-EXIT TAKEN O"
02081 "N VALID CALL *\002,\002******\002)";
02082 static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER"
02083 " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)";
02084 static char fmt_9999[] = "(\002 \002,a6,\002 PASSED THE COMPUTATIONAL TE"
02085 "STS (\002,i6,\002 CALL\002,\002S)\002)";
02086 static char fmt_9997[] = "(\002 \002,a6,\002 COMPLETED THE COMPUTATIONAL"
02087 " TESTS (\002,i6,\002 C\002,\002ALLS)\002,/\002 ******* BUT WITH "
02088 "MAXIMUM TEST RATIO\002,f8.2,\002 - SUSPECT *******\002)";
02089 static char fmt_9995[] = "(\002 THESE ARE THE RESULTS FOR COLUMN"
02090 " \002,i3)";
02091 static char fmt_9996[] = "(\002 ******* \002,a6,\002 FAILED ON CALL NUMB"
02092 "ER:\002)";
02093
02094
02095 integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
02096 i__3, i__4, i__5;
02097 alist al__1;
02098
02099
02100 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void),
02101 f_rew(alist *);
02102
02103
02104 integer i__, j, k, n, ia, ib, jc, ma, na, nc, ik, in, jj, lj, ks, ns, laa,
02105 lda, lcc, ldc;
02106 real als;
02107 integer ict, icu;
02108 extern logical lse_(real *, real *, integer *);
02109 real err, beta;
02110 integer ldas, ldcs;
02111 logical same;
02112 real bets;
02113 logical tran, null;
02114 char uplo[1];
02115 real alpha;
02116 logical isame[13];
02117 extern int smake_(char *, char *, char *, integer *,
02118 integer *, real *, integer *, real *, integer *, logical *, real *
02119 , ftnlen, ftnlen, ftnlen), smmch_(char *, char *, integer *,
02120 integer *, integer *, real *, real *, integer *, real *, integer *
02121 , real *, real *, integer *, real *, real *, real *, integer *,
02122 real *, real *, logical *, integer *, logical *, ftnlen, ftnlen);
02123 integer nargs;
02124 logical reset;
02125 char trans[1];
02126 logical upper;
02127 char uplos[1];
02128 extern int ssyrk_(char *, char *, integer *, integer *,
02129 real *, real *, integer *, real *, real *, integer *);
02130 real errmax;
02131 extern logical lseres_(char *, char *, integer *, integer *, real *, real
02132 *, integer *, ftnlen, ftnlen);
02133 char transs[1];
02134
02135
02136 static cilist io___268 = { 0, 0, 0, fmt_9994, 0 };
02137 static cilist io___269 = { 0, 0, 0, fmt_9993, 0 };
02138 static cilist io___272 = { 0, 0, 0, fmt_9998, 0 };
02139 static cilist io___278 = { 0, 0, 0, fmt_9999, 0 };
02140 static cilist io___279 = { 0, 0, 0, fmt_9997, 0 };
02141 static cilist io___280 = { 0, 0, 0, fmt_9995, 0 };
02142 static cilist io___281 = { 0, 0, 0, fmt_9996, 0 };
02143 static cilist io___282 = { 0, 0, 0, fmt_9994, 0 };
02144
02145
02146
02147
02148
02149
02150
02151
02152
02153
02154
02155
02156
02157
02158
02159
02160
02161
02162
02163
02164
02165
02166
02167
02168
02169 --idim;
02170 --alf;
02171 --bet;
02172 --g;
02173 --ct;
02174 --cs;
02175 --cc;
02176 c_dim1 = *nmax;
02177 c_offset = 1 + c_dim1;
02178 c__ -= c_offset;
02179 --bs;
02180 --bb;
02181 b_dim1 = *nmax;
02182 b_offset = 1 + b_dim1;
02183 b -= b_offset;
02184 --as;
02185 --aa;
02186 a_dim1 = *nmax;
02187 a_offset = 1 + a_dim1;
02188 a -= a_offset;
02189
02190
02191
02192
02193 nargs = 10;
02194 nc = 0;
02195 reset = TRUE_;
02196 errmax = 0.f;
02197
02198 i__1 = *nidim;
02199 for (in = 1; in <= i__1; ++in) {
02200 n = idim[in];
02201
02202 ldc = n;
02203 if (ldc < *nmax) {
02204 ++ldc;
02205 }
02206
02207 if (ldc > *nmax) {
02208 goto L100;
02209 }
02210 lcc = ldc * n;
02211 null = n <= 0;
02212
02213 i__2 = *nidim;
02214 for (ik = 1; ik <= i__2; ++ik) {
02215 k = idim[ik];
02216
02217 for (ict = 1; ict <= 3; ++ict) {
02218 *(unsigned char *)trans = *(unsigned char *)&icht[ict - 1];
02219 tran = *(unsigned char *)trans == 'T' || *(unsigned char *)
02220 trans == 'C';
02221 if (tran) {
02222 ma = k;
02223 na = n;
02224 } else {
02225 ma = n;
02226 na = k;
02227 }
02228
02229 lda = ma;
02230 if (lda < *nmax) {
02231 ++lda;
02232 }
02233
02234 if (lda > *nmax) {
02235 goto L80;
02236 }
02237 laa = lda * na;
02238
02239
02240
02241 smake_("GE", " ", " ", &ma, &na, &a[a_offset], nmax, &aa[1], &
02242 lda, &reset, &c_b99, (ftnlen)2, (ftnlen)1, (ftnlen)1);
02243
02244 for (icu = 1; icu <= 2; ++icu) {
02245 *(unsigned char *)uplo = *(unsigned char *)&ichu[icu - 1];
02246 upper = *(unsigned char *)uplo == 'U';
02247
02248 i__3 = *nalf;
02249 for (ia = 1; ia <= i__3; ++ia) {
02250 alpha = alf[ia];
02251
02252 i__4 = *nbet;
02253 for (ib = 1; ib <= i__4; ++ib) {
02254 beta = bet[ib];
02255
02256
02257
02258 smake_("SY", uplo, " ", &n, &n, &c__[c_offset],
02259 nmax, &cc[1], &ldc, &reset, &c_b99, (
02260 ftnlen)2, (ftnlen)1, (ftnlen)1);
02261
02262 ++nc;
02263
02264
02265
02266 *(unsigned char *)uplos = *(unsigned char *)uplo;
02267 *(unsigned char *)transs = *(unsigned char *)
02268 trans;
02269 ns = n;
02270 ks = k;
02271 als = alpha;
02272 i__5 = laa;
02273 for (i__ = 1; i__ <= i__5; ++i__) {
02274 as[i__] = aa[i__];
02275
02276 }
02277 ldas = lda;
02278 bets = beta;
02279 i__5 = lcc;
02280 for (i__ = 1; i__ <= i__5; ++i__) {
02281 cs[i__] = cc[i__];
02282
02283 }
02284 ldcs = ldc;
02285
02286
02287
02288 if (*trace) {
02289 io___268.ciunit = *ntra;
02290 s_wsfe(&io___268);
02291 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(
02292 integer));
02293 do_fio(&c__1, sname, (ftnlen)6);
02294 do_fio(&c__1, uplo, (ftnlen)1);
02295 do_fio(&c__1, trans, (ftnlen)1);
02296 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
02297 integer));
02298 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(
02299 integer));
02300 do_fio(&c__1, (char *)&alpha, (ftnlen)sizeof(
02301 real));
02302 do_fio(&c__1, (char *)&lda, (ftnlen)sizeof(
02303 integer));
02304 do_fio(&c__1, (char *)&beta, (ftnlen)sizeof(
02305 real));
02306 do_fio(&c__1, (char *)&ldc, (ftnlen)sizeof(
02307 integer));
02308 e_wsfe();
02309 }
02310 if (*rewi) {
02311 al__1.aerr = 0;
02312 al__1.aunit = *ntra;
02313 f_rew(&al__1);
02314 }
02315 ssyrk_(uplo, trans, &n, &k, &alpha, &aa[1], &lda,
02316 &beta, &cc[1], &ldc)
02317 ;
02318
02319
02320
02321 if (! infoc_1.ok) {
02322 io___269.ciunit = *nout;
02323 s_wsfe(&io___269);
02324 e_wsfe();
02325 *fatal = TRUE_;
02326 goto L120;
02327 }
02328
02329
02330
02331 isame[0] = *(unsigned char *)uplos == *(unsigned
02332 char *)uplo;
02333 isame[1] = *(unsigned char *)transs == *(unsigned
02334 char *)trans;
02335 isame[2] = ns == n;
02336 isame[3] = ks == k;
02337 isame[4] = als == alpha;
02338 isame[5] = lse_(&as[1], &aa[1], &laa);
02339 isame[6] = ldas == lda;
02340 isame[7] = bets == beta;
02341 if (null) {
02342 isame[8] = lse_(&cs[1], &cc[1], &lcc);
02343 } else {
02344 isame[8] = lseres_("SY", uplo, &n, &n, &cs[1],
02345 &cc[1], &ldc, (ftnlen)2, (ftnlen)1);
02346 }
02347 isame[9] = ldcs == ldc;
02348
02349
02350
02351
02352 same = TRUE_;
02353 i__5 = nargs;
02354 for (i__ = 1; i__ <= i__5; ++i__) {
02355 same = same && isame[i__ - 1];
02356 if (! isame[i__ - 1]) {
02357 io___272.ciunit = *nout;
02358 s_wsfe(&io___272);
02359 do_fio(&c__1, (char *)&i__, (ftnlen)
02360 sizeof(integer));
02361 e_wsfe();
02362 }
02363
02364 }
02365 if (! same) {
02366 *fatal = TRUE_;
02367 goto L120;
02368 }
02369
02370 if (! null) {
02371
02372
02373
02374 jc = 1;
02375 i__5 = n;
02376 for (j = 1; j <= i__5; ++j) {
02377 if (upper) {
02378 jj = 1;
02379 lj = j;
02380 } else {
02381 jj = j;
02382 lj = n - j + 1;
02383 }
02384 if (tran) {
02385 smmch_("T", "N", &lj, &c__1, &k, &
02386 alpha, &a[jj * a_dim1 + 1],
02387 nmax, &a[j * a_dim1 + 1],
02388 nmax, &beta, &c__[jj + j *
02389 c_dim1], nmax, &ct[1], &g[1],
02390 &cc[jc], &ldc, eps, &err,
02391 fatal, nout, &c_true, (ftnlen)
02392 1, (ftnlen)1);
02393 } else {
02394 smmch_("N", "T", &lj, &c__1, &k, &
02395 alpha, &a[jj + a_dim1], nmax,
02396 &a[j + a_dim1], nmax, &beta, &
02397 c__[jj + j * c_dim1], nmax, &
02398 ct[1], &g[1], &cc[jc], &ldc,
02399 eps, &err, fatal, nout, &
02400 c_true, (ftnlen)1, (ftnlen)1);
02401 }
02402 if (upper) {
02403 jc += ldc;
02404 } else {
02405 jc = jc + ldc + 1;
02406 }
02407 errmax = dmax(errmax,err);
02408
02409
02410 if (*fatal) {
02411 goto L110;
02412 }
02413
02414 }
02415 }
02416
02417
02418 }
02419
02420
02421 }
02422
02423
02424 }
02425
02426 L80:
02427 ;
02428 }
02429
02430
02431 }
02432
02433 L100:
02434 ;
02435 }
02436
02437
02438
02439 if (errmax < *thresh) {
02440 io___278.ciunit = *nout;
02441 s_wsfe(&io___278);
02442 do_fio(&c__1, sname, (ftnlen)6);
02443 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
02444 e_wsfe();
02445 } else {
02446 io___279.ciunit = *nout;
02447 s_wsfe(&io___279);
02448 do_fio(&c__1, sname, (ftnlen)6);
02449 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
02450 do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real));
02451 e_wsfe();
02452 }
02453 goto L130;
02454
02455 L110:
02456 if (n > 1) {
02457 io___280.ciunit = *nout;
02458 s_wsfe(&io___280);
02459 do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer));
02460 e_wsfe();
02461 }
02462
02463 L120:
02464 io___281.ciunit = *nout;
02465 s_wsfe(&io___281);
02466 do_fio(&c__1, sname, (ftnlen)6);
02467 e_wsfe();
02468 io___282.ciunit = *nout;
02469 s_wsfe(&io___282);
02470 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
02471 do_fio(&c__1, sname, (ftnlen)6);
02472 do_fio(&c__1, uplo, (ftnlen)1);
02473 do_fio(&c__1, trans, (ftnlen)1);
02474 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02475 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
02476 do_fio(&c__1, (char *)&alpha, (ftnlen)sizeof(real));
02477 do_fio(&c__1, (char *)&lda, (ftnlen)sizeof(integer));
02478 do_fio(&c__1, (char *)&beta, (ftnlen)sizeof(real));
02479 do_fio(&c__1, (char *)&ldc, (ftnlen)sizeof(integer));
02480 e_wsfe();
02481
02482 L130:
02483 return 0;
02484
02485
02486
02487
02488 }
02489
02490 int schk5_(char *sname, real *eps, real *thresh, integer *
02491 nout, integer *ntra, logical *trace, logical *rewi, logical *fatal,
02492 integer *nidim, integer *idim, integer *nalf, real *alf, integer *
02493 nbet, real *bet, integer *nmax, real *ab, real *aa, real *as, real *
02494 bb, real *bs, real *c__, real *cc, real *cs, real *ct, real *g, real *
02495 w, ftnlen sname_len)
02496 {
02497
02498
02499 static char icht[3] = "NTC";
02500 static char ichu[2] = "UL";
02501
02502
02503 static char fmt_9994[] = "(1x,i6,\002: \002,a6,\002(\002,2(\002'\002,a1"
02504 ",\002',\002),2(i3,\002,\002),f4.1,\002, A,\002,i3,\002, B,\002,i"
02505 "3,\002,\002,f4.1,\002, C,\002,i3,\002) \002,\002 .\002)";
02506 static char fmt_9993[] = "(\002 ******* FATAL ERROR - ERROR-EXIT TAKEN O"
02507 "N VALID CALL *\002,\002******\002)";
02508 static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER"
02509 " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)";
02510 static char fmt_9999[] = "(\002 \002,a6,\002 PASSED THE COMPUTATIONAL TE"
02511 "STS (\002,i6,\002 CALL\002,\002S)\002)";
02512 static char fmt_9997[] = "(\002 \002,a6,\002 COMPLETED THE COMPUTATIONAL"
02513 " TESTS (\002,i6,\002 C\002,\002ALLS)\002,/\002 ******* BUT WITH "
02514 "MAXIMUM TEST RATIO\002,f8.2,\002 - SUSPECT *******\002)";
02515 static char fmt_9995[] = "(\002 THESE ARE THE RESULTS FOR COLUMN"
02516 " \002,i3)";
02517 static char fmt_9996[] = "(\002 ******* \002,a6,\002 FAILED ON CALL NUMB"
02518 "ER:\002)";
02519
02520
02521 integer c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8;
02522 alist al__1;
02523
02524
02525 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void),
02526 f_rew(alist *);
02527
02528
02529 integer i__, j, k, n, ia, ib, jc, ma, na, nc, ik, in, jj, lj, ks, ns, laa,
02530 lbb, lda, lcc, ldb, ldc;
02531 real als;
02532 integer ict, icu;
02533 extern logical lse_(real *, real *, integer *);
02534 real err;
02535 integer jjab;
02536 real beta;
02537 integer ldas, ldbs, ldcs;
02538 logical same;
02539 real bets;
02540 logical tran, null;
02541 char uplo[1];
02542 real alpha;
02543 logical isame[13];
02544 extern int smake_(char *, char *, char *, integer *,
02545 integer *, real *, integer *, real *, integer *, logical *, real *
02546 , ftnlen, ftnlen, ftnlen), smmch_(char *, char *, integer *,
02547 integer *, integer *, real *, real *, integer *, real *, integer *
02548 , real *, real *, integer *, real *, real *, real *, integer *,
02549 real *, real *, logical *, integer *, logical *, ftnlen, ftnlen);
02550 integer nargs;
02551 logical reset;
02552 char trans[1];
02553 logical upper;
02554 char uplos[1];
02555 extern int ssyr2k_(char *, char *, integer *, integer *,
02556 real *, real *, integer *, real *, integer *, real *, real *,
02557 integer *);
02558 real errmax;
02559 extern logical lseres_(char *, char *, integer *, integer *, real *, real
02560 *, integer *, ftnlen, ftnlen);
02561 char transs[1];
02562
02563
02564 static cilist io___322 = { 0, 0, 0, fmt_9994, 0 };
02565 static cilist io___323 = { 0, 0, 0, fmt_9993, 0 };
02566 static cilist io___326 = { 0, 0, 0, fmt_9998, 0 };
02567 static cilist io___333 = { 0, 0, 0, fmt_9999, 0 };
02568 static cilist io___334 = { 0, 0, 0, fmt_9997, 0 };
02569 static cilist io___335 = { 0, 0, 0, fmt_9995, 0 };
02570 static cilist io___336 = { 0, 0, 0, fmt_9996, 0 };
02571 static cilist io___337 = { 0, 0, 0, fmt_9994, 0 };
02572
02573
02574
02575
02576
02577
02578
02579
02580
02581
02582
02583
02584
02585
02586
02587
02588
02589
02590
02591
02592
02593
02594
02595
02596
02597 --idim;
02598 --alf;
02599 --bet;
02600 --w;
02601 --g;
02602 --ct;
02603 --cs;
02604 --cc;
02605 c_dim1 = *nmax;
02606 c_offset = 1 + c_dim1;
02607 c__ -= c_offset;
02608 --bs;
02609 --bb;
02610 --as;
02611 --aa;
02612 --ab;
02613
02614
02615
02616
02617 nargs = 12;
02618 nc = 0;
02619 reset = TRUE_;
02620 errmax = 0.f;
02621
02622 i__1 = *nidim;
02623 for (in = 1; in <= i__1; ++in) {
02624 n = idim[in];
02625
02626 ldc = n;
02627 if (ldc < *nmax) {
02628 ++ldc;
02629 }
02630
02631 if (ldc > *nmax) {
02632 goto L130;
02633 }
02634 lcc = ldc * n;
02635 null = n <= 0;
02636
02637 i__2 = *nidim;
02638 for (ik = 1; ik <= i__2; ++ik) {
02639 k = idim[ik];
02640
02641 for (ict = 1; ict <= 3; ++ict) {
02642 *(unsigned char *)trans = *(unsigned char *)&icht[ict - 1];
02643 tran = *(unsigned char *)trans == 'T' || *(unsigned char *)
02644 trans == 'C';
02645 if (tran) {
02646 ma = k;
02647 na = n;
02648 } else {
02649 ma = n;
02650 na = k;
02651 }
02652
02653 lda = ma;
02654 if (lda < *nmax) {
02655 ++lda;
02656 }
02657
02658 if (lda > *nmax) {
02659 goto L110;
02660 }
02661 laa = lda * na;
02662
02663
02664
02665 if (tran) {
02666 i__3 = *nmax << 1;
02667 smake_("GE", " ", " ", &ma, &na, &ab[1], &i__3, &aa[1], &
02668 lda, &reset, &c_b99, (ftnlen)2, (ftnlen)1, (
02669 ftnlen)1);
02670 } else {
02671 smake_("GE", " ", " ", &ma, &na, &ab[1], nmax, &aa[1], &
02672 lda, &reset, &c_b99, (ftnlen)2, (ftnlen)1, (
02673 ftnlen)1);
02674 }
02675
02676
02677
02678 ldb = lda;
02679 lbb = laa;
02680 if (tran) {
02681 i__3 = *nmax << 1;
02682 smake_("GE", " ", " ", &ma, &na, &ab[k + 1], &i__3, &bb[1]
02683 , &ldb, &reset, &c_b99, (ftnlen)2, (ftnlen)1, (
02684 ftnlen)1);
02685 } else {
02686 smake_("GE", " ", " ", &ma, &na, &ab[k * *nmax + 1], nmax,
02687 &bb[1], &ldb, &reset, &c_b99, (ftnlen)2, (ftnlen)
02688 1, (ftnlen)1);
02689 }
02690
02691 for (icu = 1; icu <= 2; ++icu) {
02692 *(unsigned char *)uplo = *(unsigned char *)&ichu[icu - 1];
02693 upper = *(unsigned char *)uplo == 'U';
02694
02695 i__3 = *nalf;
02696 for (ia = 1; ia <= i__3; ++ia) {
02697 alpha = alf[ia];
02698
02699 i__4 = *nbet;
02700 for (ib = 1; ib <= i__4; ++ib) {
02701 beta = bet[ib];
02702
02703
02704
02705 smake_("SY", uplo, " ", &n, &n, &c__[c_offset],
02706 nmax, &cc[1], &ldc, &reset, &c_b99, (
02707 ftnlen)2, (ftnlen)1, (ftnlen)1);
02708
02709 ++nc;
02710
02711
02712
02713 *(unsigned char *)uplos = *(unsigned char *)uplo;
02714 *(unsigned char *)transs = *(unsigned char *)
02715 trans;
02716 ns = n;
02717 ks = k;
02718 als = alpha;
02719 i__5 = laa;
02720 for (i__ = 1; i__ <= i__5; ++i__) {
02721 as[i__] = aa[i__];
02722
02723 }
02724 ldas = lda;
02725 i__5 = lbb;
02726 for (i__ = 1; i__ <= i__5; ++i__) {
02727 bs[i__] = bb[i__];
02728
02729 }
02730 ldbs = ldb;
02731 bets = beta;
02732 i__5 = lcc;
02733 for (i__ = 1; i__ <= i__5; ++i__) {
02734 cs[i__] = cc[i__];
02735
02736 }
02737 ldcs = ldc;
02738
02739
02740
02741 if (*trace) {
02742 io___322.ciunit = *ntra;
02743 s_wsfe(&io___322);
02744 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(
02745 integer));
02746 do_fio(&c__1, sname, (ftnlen)6);
02747 do_fio(&c__1, uplo, (ftnlen)1);
02748 do_fio(&c__1, trans, (ftnlen)1);
02749 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
02750 integer));
02751 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(
02752 integer));
02753 do_fio(&c__1, (char *)&alpha, (ftnlen)sizeof(
02754 real));
02755 do_fio(&c__1, (char *)&lda, (ftnlen)sizeof(
02756 integer));
02757 do_fio(&c__1, (char *)&ldb, (ftnlen)sizeof(
02758 integer));
02759 do_fio(&c__1, (char *)&beta, (ftnlen)sizeof(
02760 real));
02761 do_fio(&c__1, (char *)&ldc, (ftnlen)sizeof(
02762 integer));
02763 e_wsfe();
02764 }
02765 if (*rewi) {
02766 al__1.aerr = 0;
02767 al__1.aunit = *ntra;
02768 f_rew(&al__1);
02769 }
02770 ssyr2k_(uplo, trans, &n, &k, &alpha, &aa[1], &lda,
02771 &bb[1], &ldb, &beta, &cc[1], &ldc);
02772
02773
02774
02775 if (! infoc_1.ok) {
02776 io___323.ciunit = *nout;
02777 s_wsfe(&io___323);
02778 e_wsfe();
02779 *fatal = TRUE_;
02780 goto L150;
02781 }
02782
02783
02784
02785 isame[0] = *(unsigned char *)uplos == *(unsigned
02786 char *)uplo;
02787 isame[1] = *(unsigned char *)transs == *(unsigned
02788 char *)trans;
02789 isame[2] = ns == n;
02790 isame[3] = ks == k;
02791 isame[4] = als == alpha;
02792 isame[5] = lse_(&as[1], &aa[1], &laa);
02793 isame[6] = ldas == lda;
02794 isame[7] = lse_(&bs[1], &bb[1], &lbb);
02795 isame[8] = ldbs == ldb;
02796 isame[9] = bets == beta;
02797 if (null) {
02798 isame[10] = lse_(&cs[1], &cc[1], &lcc);
02799 } else {
02800 isame[10] = lseres_("SY", uplo, &n, &n, &cs[1]
02801 , &cc[1], &ldc, (ftnlen)2, (ftnlen)1);
02802 }
02803 isame[11] = ldcs == ldc;
02804
02805
02806
02807
02808 same = TRUE_;
02809 i__5 = nargs;
02810 for (i__ = 1; i__ <= i__5; ++i__) {
02811 same = same && isame[i__ - 1];
02812 if (! isame[i__ - 1]) {
02813 io___326.ciunit = *nout;
02814 s_wsfe(&io___326);
02815 do_fio(&c__1, (char *)&i__, (ftnlen)
02816 sizeof(integer));
02817 e_wsfe();
02818 }
02819
02820 }
02821 if (! same) {
02822 *fatal = TRUE_;
02823 goto L150;
02824 }
02825
02826 if (! null) {
02827
02828
02829
02830 jjab = 1;
02831 jc = 1;
02832 i__5 = n;
02833 for (j = 1; j <= i__5; ++j) {
02834 if (upper) {
02835 jj = 1;
02836 lj = j;
02837 } else {
02838 jj = j;
02839 lj = n - j + 1;
02840 }
02841 if (tran) {
02842 i__6 = k;
02843 for (i__ = 1; i__ <= i__6; ++i__) {
02844 w[i__] = ab[(j - 1 << 1) * *nmax
02845 + k + i__];
02846 w[k + i__] = ab[(j - 1 << 1) * *
02847 nmax + i__];
02848
02849 }
02850 i__6 = k << 1;
02851 i__7 = *nmax << 1;
02852 i__8 = *nmax << 1;
02853 smmch_("T", "N", &lj, &c__1, &i__6, &
02854 alpha, &ab[jjab], &i__7, &w[1]
02855 , &i__8, &beta, &c__[jj + j *
02856 c_dim1], nmax, &ct[1], &g[1],
02857 &cc[jc], &ldc, eps, &err,
02858 fatal, nout, &c_true, (ftnlen)
02859 1, (ftnlen)1);
02860 } else {
02861 i__6 = k;
02862 for (i__ = 1; i__ <= i__6; ++i__) {
02863 w[i__] = ab[(k + i__ - 1) * *nmax
02864 + j];
02865 w[k + i__] = ab[(i__ - 1) * *nmax
02866 + j];
02867
02868 }
02869 i__6 = k << 1;
02870 i__7 = *nmax << 1;
02871 smmch_("N", "N", &lj, &c__1, &i__6, &
02872 alpha, &ab[jj], nmax, &w[1], &
02873 i__7, &beta, &c__[jj + j *
02874 c_dim1], nmax, &ct[1], &g[1],
02875 &cc[jc], &ldc, eps, &err,
02876 fatal, nout, &c_true, (ftnlen)
02877 1, (ftnlen)1);
02878 }
02879 if (upper) {
02880 jc += ldc;
02881 } else {
02882 jc = jc + ldc + 1;
02883 if (tran) {
02884 jjab += *nmax << 1;
02885 }
02886 }
02887 errmax = dmax(errmax,err);
02888
02889
02890 if (*fatal) {
02891 goto L140;
02892 }
02893
02894 }
02895 }
02896
02897
02898 }
02899
02900
02901 }
02902
02903
02904 }
02905
02906 L110:
02907 ;
02908 }
02909
02910
02911 }
02912
02913 L130:
02914 ;
02915 }
02916
02917
02918
02919 if (errmax < *thresh) {
02920 io___333.ciunit = *nout;
02921 s_wsfe(&io___333);
02922 do_fio(&c__1, sname, (ftnlen)6);
02923 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
02924 e_wsfe();
02925 } else {
02926 io___334.ciunit = *nout;
02927 s_wsfe(&io___334);
02928 do_fio(&c__1, sname, (ftnlen)6);
02929 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
02930 do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real));
02931 e_wsfe();
02932 }
02933 goto L160;
02934
02935 L140:
02936 if (n > 1) {
02937 io___335.ciunit = *nout;
02938 s_wsfe(&io___335);
02939 do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer));
02940 e_wsfe();
02941 }
02942
02943 L150:
02944 io___336.ciunit = *nout;
02945 s_wsfe(&io___336);
02946 do_fio(&c__1, sname, (ftnlen)6);
02947 e_wsfe();
02948 io___337.ciunit = *nout;
02949 s_wsfe(&io___337);
02950 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
02951 do_fio(&c__1, sname, (ftnlen)6);
02952 do_fio(&c__1, uplo, (ftnlen)1);
02953 do_fio(&c__1, trans, (ftnlen)1);
02954 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02955 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
02956 do_fio(&c__1, (char *)&alpha, (ftnlen)sizeof(real));
02957 do_fio(&c__1, (char *)&lda, (ftnlen)sizeof(integer));
02958 do_fio(&c__1, (char *)&ldb, (ftnlen)sizeof(integer));
02959 do_fio(&c__1, (char *)&beta, (ftnlen)sizeof(real));
02960 do_fio(&c__1, (char *)&ldc, (ftnlen)sizeof(integer));
02961 e_wsfe();
02962
02963 L160:
02964 return 0;
02965
02966
02967
02968
02969 }
02970
02971 int schke_(integer *isnum, char *srnamt, integer *nout,
02972 ftnlen srnamt_len)
02973 {
02974
02975 static char fmt_9999[] = "(\002 \002,a6,\002 PASSED THE TESTS OF ERROR-E"
02976 "XITS\002)";
02977 static char fmt_9998[] = "(\002 ******* \002,a6,\002 FAILED THE TESTS OF"
02978 " ERROR-EXITS *****\002,\002**\002)";
02979
02980
02981 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
02982
02983
02984 real a[2] , b[2] , c__[2]
02985 , beta, alpha;
02986 extern int sgemm_(char *, char *, integer *, integer *,
02987 integer *, real *, real *, integer *, real *, integer *, real *,
02988 real *, integer *), strmm_(char *, char *, char *,
02989 char *, integer *, integer *, real *, real *, integer *, real *,
02990 integer *), ssymm_(char *, char *,
02991 integer *, integer *, real *, real *, integer *, real *, integer
02992 *, real *, real *, integer *), strsm_(char *,
02993 char *, char *, char *, integer *, integer *, real *, real *,
02994 integer *, real *, integer *),
02995 ssyrk_(char *, char *, integer *, integer *, real *, real *,
02996 integer *, real *, real *, integer *), ssyr2k_(
02997 char *, char *, integer *, integer *, real *, real *, integer *,
02998 real *, integer *, real *, real *, integer *),
02999 chkxer_(char *, integer *, integer *, logical *, logical *);
03000
03001
03002 static cilist io___343 = { 0, 0, 0, fmt_9999, 0 };
03003 static cilist io___344 = { 0, 0, 0, fmt_9998, 0 };
03004
03005
03006
03007
03008
03009
03010
03011
03012
03013
03014
03015
03016
03017
03018
03019
03020
03021
03022
03023
03024
03025
03026
03027
03028
03029
03030
03031
03032 infoc_1.ok = TRUE_;
03033
03034
03035 infoc_1.lerr = FALSE_;
03036
03037
03038
03039 alpha = 1.f;
03040 beta = 2.f;
03041
03042 switch (*isnum) {
03043 case 1: goto L10;
03044 case 2: goto L20;
03045 case 3: goto L30;
03046 case 4: goto L40;
03047 case 5: goto L50;
03048 case 6: goto L60;
03049 }
03050 L10:
03051 infoc_1.infot = 1;
03052 sgemm_("/", "N", &c__0, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03053 c__, &c__1);
03054 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03055 infoc_1.infot = 1;
03056 sgemm_("/", "T", &c__0, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03057 c__, &c__1);
03058 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03059 infoc_1.infot = 2;
03060 sgemm_("N", "/", &c__0, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03061 c__, &c__1);
03062 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03063 infoc_1.infot = 2;
03064 sgemm_("T", "/", &c__0, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03065 c__, &c__1);
03066 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03067 infoc_1.infot = 3;
03068 sgemm_("N", "N", &c_n1, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03069 c__, &c__1);
03070 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03071 infoc_1.infot = 3;
03072 sgemm_("N", "T", &c_n1, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03073 c__, &c__1);
03074 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03075 infoc_1.infot = 3;
03076 sgemm_("T", "N", &c_n1, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03077 c__, &c__1);
03078 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03079 infoc_1.infot = 3;
03080 sgemm_("T", "T", &c_n1, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03081 c__, &c__1);
03082 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03083 infoc_1.infot = 4;
03084 sgemm_("N", "N", &c__0, &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03085 c__, &c__1);
03086 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03087 infoc_1.infot = 4;
03088 sgemm_("N", "T", &c__0, &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03089 c__, &c__1);
03090 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03091 infoc_1.infot = 4;
03092 sgemm_("T", "N", &c__0, &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03093 c__, &c__1);
03094 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03095 infoc_1.infot = 4;
03096 sgemm_("T", "T", &c__0, &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03097 c__, &c__1);
03098 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03099 infoc_1.infot = 5;
03100 sgemm_("N", "N", &c__0, &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta,
03101 c__, &c__1);
03102 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03103 infoc_1.infot = 5;
03104 sgemm_("N", "T", &c__0, &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta,
03105 c__, &c__1);
03106 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03107 infoc_1.infot = 5;
03108 sgemm_("T", "N", &c__0, &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta,
03109 c__, &c__1);
03110 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03111 infoc_1.infot = 5;
03112 sgemm_("T", "T", &c__0, &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta,
03113 c__, &c__1);
03114 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03115 infoc_1.infot = 8;
03116 sgemm_("N", "N", &c__2, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03117 c__, &c__2);
03118 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03119 infoc_1.infot = 8;
03120 sgemm_("N", "T", &c__2, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03121 c__, &c__2);
03122 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03123 infoc_1.infot = 8;
03124 sgemm_("T", "N", &c__0, &c__0, &c__2, &alpha, a, &c__1, b, &c__2, &beta,
03125 c__, &c__1);
03126 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03127 infoc_1.infot = 8;
03128 sgemm_("T", "T", &c__0, &c__0, &c__2, &alpha, a, &c__1, b, &c__1, &beta,
03129 c__, &c__1);
03130 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03131 infoc_1.infot = 10;
03132 sgemm_("N", "N", &c__0, &c__0, &c__2, &alpha, a, &c__1, b, &c__1, &beta,
03133 c__, &c__1);
03134 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03135 infoc_1.infot = 10;
03136 sgemm_("T", "N", &c__0, &c__0, &c__2, &alpha, a, &c__2, b, &c__1, &beta,
03137 c__, &c__1);
03138 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03139 infoc_1.infot = 10;
03140 sgemm_("N", "T", &c__0, &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03141 c__, &c__1);
03142 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03143 infoc_1.infot = 10;
03144 sgemm_("T", "T", &c__0, &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03145 c__, &c__1);
03146 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03147 infoc_1.infot = 13;
03148 sgemm_("N", "N", &c__2, &c__0, &c__0, &alpha, a, &c__2, b, &c__1, &beta,
03149 c__, &c__1);
03150 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03151 infoc_1.infot = 13;
03152 sgemm_("N", "T", &c__2, &c__0, &c__0, &alpha, a, &c__2, b, &c__1, &beta,
03153 c__, &c__1);
03154 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03155 infoc_1.infot = 13;
03156 sgemm_("T", "N", &c__2, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03157 c__, &c__1);
03158 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03159 infoc_1.infot = 13;
03160 sgemm_("T", "T", &c__2, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03161 c__, &c__1);
03162 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03163 goto L70;
03164 L20:
03165 infoc_1.infot = 1;
03166 ssymm_("/", "U", &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03167 c__1);
03168 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03169 infoc_1.infot = 2;
03170 ssymm_("L", "/", &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03171 c__1);
03172 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03173 infoc_1.infot = 3;
03174 ssymm_("L", "U", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03175 c__1);
03176 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03177 infoc_1.infot = 3;
03178 ssymm_("R", "U", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03179 c__1);
03180 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03181 infoc_1.infot = 3;
03182 ssymm_("L", "L", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03183 c__1);
03184 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03185 infoc_1.infot = 3;
03186 ssymm_("R", "L", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03187 c__1);
03188 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03189 infoc_1.infot = 4;
03190 ssymm_("L", "U", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03191 c__1);
03192 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03193 infoc_1.infot = 4;
03194 ssymm_("R", "U", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03195 c__1);
03196 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03197 infoc_1.infot = 4;
03198 ssymm_("L", "L", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03199 c__1);
03200 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03201 infoc_1.infot = 4;
03202 ssymm_("R", "L", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03203 c__1);
03204 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03205 infoc_1.infot = 7;
03206 ssymm_("L", "U", &c__2, &c__0, &alpha, a, &c__1, b, &c__2, &beta, c__, &
03207 c__2);
03208 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03209 infoc_1.infot = 7;
03210 ssymm_("R", "U", &c__0, &c__2, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03211 c__1);
03212 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03213 infoc_1.infot = 7;
03214 ssymm_("L", "L", &c__2, &c__0, &alpha, a, &c__1, b, &c__2, &beta, c__, &
03215 c__2);
03216 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03217 infoc_1.infot = 7;
03218 ssymm_("R", "L", &c__0, &c__2, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03219 c__1);
03220 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03221 infoc_1.infot = 9;
03222 ssymm_("L", "U", &c__2, &c__0, &alpha, a, &c__2, b, &c__1, &beta, c__, &
03223 c__2);
03224 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03225 infoc_1.infot = 9;
03226 ssymm_("R", "U", &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03227 c__2);
03228 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03229 infoc_1.infot = 9;
03230 ssymm_("L", "L", &c__2, &c__0, &alpha, a, &c__2, b, &c__1, &beta, c__, &
03231 c__2);
03232 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03233 infoc_1.infot = 9;
03234 ssymm_("R", "L", &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03235 c__2);
03236 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03237 infoc_1.infot = 12;
03238 ssymm_("L", "U", &c__2, &c__0, &alpha, a, &c__2, b, &c__2, &beta, c__, &
03239 c__1);
03240 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03241 infoc_1.infot = 12;
03242 ssymm_("R", "U", &c__2, &c__0, &alpha, a, &c__1, b, &c__2, &beta, c__, &
03243 c__1);
03244 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03245 infoc_1.infot = 12;
03246 ssymm_("L", "L", &c__2, &c__0, &alpha, a, &c__2, b, &c__2, &beta, c__, &
03247 c__1);
03248 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03249 infoc_1.infot = 12;
03250 ssymm_("R", "L", &c__2, &c__0, &alpha, a, &c__1, b, &c__2, &beta, c__, &
03251 c__1);
03252 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03253 goto L70;
03254 L30:
03255 infoc_1.infot = 1;
03256 strmm_("/", "U", "N", "N", &c__0, &c__0, &alpha, a, &c__1, b, &c__1);
03257 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03258 infoc_1.infot = 2;
03259 strmm_("L", "/", "N", "N", &c__0, &c__0, &alpha, a, &c__1, b, &c__1);
03260 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03261 infoc_1.infot = 3;
03262 strmm_("L", "U", "/", "N", &c__0, &c__0, &alpha, a, &c__1, b, &c__1);
03263 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03264 infoc_1.infot = 4;
03265 strmm_("L", "U", "N", "/", &c__0, &c__0, &alpha, a, &c__1, b, &c__1);
03266 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03267 infoc_1.infot = 5;
03268 strmm_("L", "U", "N", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03269 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03270 infoc_1.infot = 5;
03271 strmm_("L", "U", "T", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03272 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03273 infoc_1.infot = 5;
03274 strmm_("R", "U", "N", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03275 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03276 infoc_1.infot = 5;
03277 strmm_("R", "U", "T", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03278 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03279 infoc_1.infot = 5;
03280 strmm_("L", "L", "N", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03281 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03282 infoc_1.infot = 5;
03283 strmm_("L", "L", "T", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03284 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03285 infoc_1.infot = 5;
03286 strmm_("R", "L", "N", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03287 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03288 infoc_1.infot = 5;
03289 strmm_("R", "L", "T", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03290 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03291 infoc_1.infot = 6;
03292 strmm_("L", "U", "N", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03293 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03294 infoc_1.infot = 6;
03295 strmm_("L", "U", "T", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03296 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03297 infoc_1.infot = 6;
03298 strmm_("R", "U", "N", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03299 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03300 infoc_1.infot = 6;
03301 strmm_("R", "U", "T", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03302 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03303 infoc_1.infot = 6;
03304 strmm_("L", "L", "N", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03305 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03306 infoc_1.infot = 6;
03307 strmm_("L", "L", "T", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03308 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03309 infoc_1.infot = 6;
03310 strmm_("R", "L", "N", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03311 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03312 infoc_1.infot = 6;
03313 strmm_("R", "L", "T", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03314 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03315 infoc_1.infot = 9;
03316 strmm_("L", "U", "N", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__2);
03317 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03318 infoc_1.infot = 9;
03319 strmm_("L", "U", "T", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__2);
03320 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03321 infoc_1.infot = 9;
03322 strmm_("R", "U", "N", "N", &c__0, &c__2, &alpha, a, &c__1, b, &c__1);
03323 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03324 infoc_1.infot = 9;
03325 strmm_("R", "U", "T", "N", &c__0, &c__2, &alpha, a, &c__1, b, &c__1);
03326 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03327 infoc_1.infot = 9;
03328 strmm_("L", "L", "N", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__2);
03329 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03330 infoc_1.infot = 9;
03331 strmm_("L", "L", "T", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__2);
03332 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03333 infoc_1.infot = 9;
03334 strmm_("R", "L", "N", "N", &c__0, &c__2, &alpha, a, &c__1, b, &c__1);
03335 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03336 infoc_1.infot = 9;
03337 strmm_("R", "L", "T", "N", &c__0, &c__2, &alpha, a, &c__1, b, &c__1);
03338 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03339 infoc_1.infot = 11;
03340 strmm_("L", "U", "N", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1);
03341 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03342 infoc_1.infot = 11;
03343 strmm_("L", "U", "T", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1);
03344 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03345 infoc_1.infot = 11;
03346 strmm_("R", "U", "N", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1);
03347 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03348 infoc_1.infot = 11;
03349 strmm_("R", "U", "T", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1);
03350 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03351 infoc_1.infot = 11;
03352 strmm_("L", "L", "N", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1);
03353 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03354 infoc_1.infot = 11;
03355 strmm_("L", "L", "T", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1);
03356 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03357 infoc_1.infot = 11;
03358 strmm_("R", "L", "N", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1);
03359 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03360 infoc_1.infot = 11;
03361 strmm_("R", "L", "T", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1);
03362 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03363 goto L70;
03364 L40:
03365 infoc_1.infot = 1;
03366 strsm_("/", "U", "N", "N", &c__0, &c__0, &alpha, a, &c__1, b, &c__1);
03367 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03368 infoc_1.infot = 2;
03369 strsm_("L", "/", "N", "N", &c__0, &c__0, &alpha, a, &c__1, b, &c__1);
03370 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03371 infoc_1.infot = 3;
03372 strsm_("L", "U", "/", "N", &c__0, &c__0, &alpha, a, &c__1, b, &c__1);
03373 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03374 infoc_1.infot = 4;
03375 strsm_("L", "U", "N", "/", &c__0, &c__0, &alpha, a, &c__1, b, &c__1);
03376 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03377 infoc_1.infot = 5;
03378 strsm_("L", "U", "N", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03379 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03380 infoc_1.infot = 5;
03381 strsm_("L", "U", "T", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03382 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03383 infoc_1.infot = 5;
03384 strsm_("R", "U", "N", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03385 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03386 infoc_1.infot = 5;
03387 strsm_("R", "U", "T", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03388 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03389 infoc_1.infot = 5;
03390 strsm_("L", "L", "N", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03391 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03392 infoc_1.infot = 5;
03393 strsm_("L", "L", "T", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03394 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03395 infoc_1.infot = 5;
03396 strsm_("R", "L", "N", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03397 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03398 infoc_1.infot = 5;
03399 strsm_("R", "L", "T", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03400 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03401 infoc_1.infot = 6;
03402 strsm_("L", "U", "N", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03403 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03404 infoc_1.infot = 6;
03405 strsm_("L", "U", "T", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03406 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03407 infoc_1.infot = 6;
03408 strsm_("R", "U", "N", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03409 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03410 infoc_1.infot = 6;
03411 strsm_("R", "U", "T", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03412 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03413 infoc_1.infot = 6;
03414 strsm_("L", "L", "N", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03415 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03416 infoc_1.infot = 6;
03417 strsm_("L", "L", "T", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03418 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03419 infoc_1.infot = 6;
03420 strsm_("R", "L", "N", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03421 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03422 infoc_1.infot = 6;
03423 strsm_("R", "L", "T", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03424 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03425 infoc_1.infot = 9;
03426 strsm_("L", "U", "N", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__2);
03427 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03428 infoc_1.infot = 9;
03429 strsm_("L", "U", "T", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__2);
03430 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03431 infoc_1.infot = 9;
03432 strsm_("R", "U", "N", "N", &c__0, &c__2, &alpha, a, &c__1, b, &c__1);
03433 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03434 infoc_1.infot = 9;
03435 strsm_("R", "U", "T", "N", &c__0, &c__2, &alpha, a, &c__1, b, &c__1);
03436 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03437 infoc_1.infot = 9;
03438 strsm_("L", "L", "N", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__2);
03439 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03440 infoc_1.infot = 9;
03441 strsm_("L", "L", "T", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__2);
03442 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03443 infoc_1.infot = 9;
03444 strsm_("R", "L", "N", "N", &c__0, &c__2, &alpha, a, &c__1, b, &c__1);
03445 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03446 infoc_1.infot = 9;
03447 strsm_("R", "L", "T", "N", &c__0, &c__2, &alpha, a, &c__1, b, &c__1);
03448 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03449 infoc_1.infot = 11;
03450 strsm_("L", "U", "N", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1);
03451 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03452 infoc_1.infot = 11;
03453 strsm_("L", "U", "T", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1);
03454 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03455 infoc_1.infot = 11;
03456 strsm_("R", "U", "N", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1);
03457 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03458 infoc_1.infot = 11;
03459 strsm_("R", "U", "T", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1);
03460 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03461 infoc_1.infot = 11;
03462 strsm_("L", "L", "N", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1);
03463 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03464 infoc_1.infot = 11;
03465 strsm_("L", "L", "T", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1);
03466 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03467 infoc_1.infot = 11;
03468 strsm_("R", "L", "N", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1);
03469 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03470 infoc_1.infot = 11;
03471 strsm_("R", "L", "T", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1);
03472 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03473 goto L70;
03474 L50:
03475 infoc_1.infot = 1;
03476 ssyrk_("/", "N", &c__0, &c__0, &alpha, a, &c__1, &beta, c__, &c__1);
03477 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03478 infoc_1.infot = 2;
03479 ssyrk_("U", "/", &c__0, &c__0, &alpha, a, &c__1, &beta, c__, &c__1);
03480 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03481 infoc_1.infot = 3;
03482 ssyrk_("U", "N", &c_n1, &c__0, &alpha, a, &c__1, &beta, c__, &c__1);
03483 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03484 infoc_1.infot = 3;
03485 ssyrk_("U", "T", &c_n1, &c__0, &alpha, a, &c__1, &beta, c__, &c__1);
03486 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03487 infoc_1.infot = 3;
03488 ssyrk_("L", "N", &c_n1, &c__0, &alpha, a, &c__1, &beta, c__, &c__1);
03489 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03490 infoc_1.infot = 3;
03491 ssyrk_("L", "T", &c_n1, &c__0, &alpha, a, &c__1, &beta, c__, &c__1);
03492 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03493 infoc_1.infot = 4;
03494 ssyrk_("U", "N", &c__0, &c_n1, &alpha, a, &c__1, &beta, c__, &c__1);
03495 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03496 infoc_1.infot = 4;
03497 ssyrk_("U", "T", &c__0, &c_n1, &alpha, a, &c__1, &beta, c__, &c__1);
03498 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03499 infoc_1.infot = 4;
03500 ssyrk_("L", "N", &c__0, &c_n1, &alpha, a, &c__1, &beta, c__, &c__1);
03501 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03502 infoc_1.infot = 4;
03503 ssyrk_("L", "T", &c__0, &c_n1, &alpha, a, &c__1, &beta, c__, &c__1);
03504 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03505 infoc_1.infot = 7;
03506 ssyrk_("U", "N", &c__2, &c__0, &alpha, a, &c__1, &beta, c__, &c__2);
03507 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03508 infoc_1.infot = 7;
03509 ssyrk_("U", "T", &c__0, &c__2, &alpha, a, &c__1, &beta, c__, &c__1);
03510 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03511 infoc_1.infot = 7;
03512 ssyrk_("L", "N", &c__2, &c__0, &alpha, a, &c__1, &beta, c__, &c__2);
03513 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03514 infoc_1.infot = 7;
03515 ssyrk_("L", "T", &c__0, &c__2, &alpha, a, &c__1, &beta, c__, &c__1);
03516 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03517 infoc_1.infot = 10;
03518 ssyrk_("U", "N", &c__2, &c__0, &alpha, a, &c__2, &beta, c__, &c__1);
03519 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03520 infoc_1.infot = 10;
03521 ssyrk_("U", "T", &c__2, &c__0, &alpha, a, &c__1, &beta, c__, &c__1);
03522 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03523 infoc_1.infot = 10;
03524 ssyrk_("L", "N", &c__2, &c__0, &alpha, a, &c__2, &beta, c__, &c__1);
03525 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03526 infoc_1.infot = 10;
03527 ssyrk_("L", "T", &c__2, &c__0, &alpha, a, &c__1, &beta, c__, &c__1);
03528 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03529 goto L70;
03530 L60:
03531 infoc_1.infot = 1;
03532 ssyr2k_("/", "N", &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03533 c__1);
03534 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03535 infoc_1.infot = 2;
03536 ssyr2k_("U", "/", &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03537 c__1);
03538 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03539 infoc_1.infot = 3;
03540 ssyr2k_("U", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03541 c__1);
03542 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03543 infoc_1.infot = 3;
03544 ssyr2k_("U", "T", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03545 c__1);
03546 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03547 infoc_1.infot = 3;
03548 ssyr2k_("L", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03549 c__1);
03550 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03551 infoc_1.infot = 3;
03552 ssyr2k_("L", "T", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03553 c__1);
03554 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03555 infoc_1.infot = 4;
03556 ssyr2k_("U", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03557 c__1);
03558 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03559 infoc_1.infot = 4;
03560 ssyr2k_("U", "T", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03561 c__1);
03562 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03563 infoc_1.infot = 4;
03564 ssyr2k_("L", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03565 c__1);
03566 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03567 infoc_1.infot = 4;
03568 ssyr2k_("L", "T", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03569 c__1);
03570 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03571 infoc_1.infot = 7;
03572 ssyr2k_("U", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03573 c__2);
03574 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03575 infoc_1.infot = 7;
03576 ssyr2k_("U", "T", &c__0, &c__2, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03577 c__1);
03578 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03579 infoc_1.infot = 7;
03580 ssyr2k_("L", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03581 c__2);
03582 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03583 infoc_1.infot = 7;
03584 ssyr2k_("L", "T", &c__0, &c__2, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03585 c__1);
03586 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03587 infoc_1.infot = 9;
03588 ssyr2k_("U", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1, &beta, c__, &
03589 c__2);
03590 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03591 infoc_1.infot = 9;
03592 ssyr2k_("U", "T", &c__0, &c__2, &alpha, a, &c__2, b, &c__1, &beta, c__, &
03593 c__1);
03594 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03595 infoc_1.infot = 9;
03596 ssyr2k_("L", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1, &beta, c__, &
03597 c__2);
03598 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03599 infoc_1.infot = 9;
03600 ssyr2k_("L", "T", &c__0, &c__2, &alpha, a, &c__2, b, &c__1, &beta, c__, &
03601 c__1);
03602 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03603 infoc_1.infot = 12;
03604 ssyr2k_("U", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__2, &beta, c__, &
03605 c__1);
03606 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03607 infoc_1.infot = 12;
03608 ssyr2k_("U", "T", &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03609 c__1);
03610 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03611 infoc_1.infot = 12;
03612 ssyr2k_("L", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__2, &beta, c__, &
03613 c__1);
03614 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03615 infoc_1.infot = 12;
03616 ssyr2k_("L", "T", &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03617 c__1);
03618 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03619
03620 L70:
03621 if (infoc_1.ok) {
03622 io___343.ciunit = *nout;
03623 s_wsfe(&io___343);
03624 do_fio(&c__1, srnamt, (ftnlen)6);
03625 e_wsfe();
03626 } else {
03627 io___344.ciunit = *nout;
03628 s_wsfe(&io___344);
03629 do_fio(&c__1, srnamt, (ftnlen)6);
03630 e_wsfe();
03631 }
03632 return 0;
03633
03634
03635
03636
03637 }
03638
03639 int smake_(char *type__, char *uplo, char *diag, integer *m,
03640 integer *n, real *a, integer *nmax, real *aa, integer *lda, logical *
03641 reset, real *transl, ftnlen type_len, ftnlen uplo_len, ftnlen
03642 diag_len)
03643 {
03644
03645 integer a_dim1, a_offset, i__1, i__2;
03646
03647
03648 integer s_cmp(char *, char *, ftnlen, ftnlen);
03649
03650
03651 integer i__, j;
03652 logical gen, tri, sym;
03653 integer ibeg, iend;
03654 extern doublereal sbeg_(logical *);
03655 logical unit, lower, upper;
03656
03657
03658
03659
03660
03661
03662
03663
03664
03665
03666
03667
03668
03669
03670
03671
03672
03673
03674
03675
03676
03677
03678
03679 a_dim1 = *nmax;
03680 a_offset = 1 + a_dim1;
03681 a -= a_offset;
03682 --aa;
03683
03684
03685 gen = s_cmp(type__, "GE", (ftnlen)2, (ftnlen)2) == 0;
03686 sym = s_cmp(type__, "SY", (ftnlen)2, (ftnlen)2) == 0;
03687 tri = s_cmp(type__, "TR", (ftnlen)2, (ftnlen)2) == 0;
03688 upper = (sym || tri) && *(unsigned char *)uplo == 'U';
03689 lower = (sym || tri) && *(unsigned char *)uplo == 'L';
03690 unit = tri && *(unsigned char *)diag == 'U';
03691
03692
03693
03694 i__1 = *n;
03695 for (j = 1; j <= i__1; ++j) {
03696 i__2 = *m;
03697 for (i__ = 1; i__ <= i__2; ++i__) {
03698 if (gen || upper && i__ <= j || lower && i__ >= j) {
03699 a[i__ + j * a_dim1] = sbeg_(reset) + *transl;
03700 if (i__ != j) {
03701
03702 if (*n > 3 && j == *n / 2) {
03703 a[i__ + j * a_dim1] = 0.f;
03704 }
03705 if (sym) {
03706 a[j + i__ * a_dim1] = a[i__ + j * a_dim1];
03707 } else if (tri) {
03708 a[j + i__ * a_dim1] = 0.f;
03709 }
03710 }
03711 }
03712
03713 }
03714 if (tri) {
03715 a[j + j * a_dim1] += 1.f;
03716 }
03717 if (unit) {
03718 a[j + j * a_dim1] = 1.f;
03719 }
03720
03721 }
03722
03723
03724
03725 if (s_cmp(type__, "GE", (ftnlen)2, (ftnlen)2) == 0) {
03726 i__1 = *n;
03727 for (j = 1; j <= i__1; ++j) {
03728 i__2 = *m;
03729 for (i__ = 1; i__ <= i__2; ++i__) {
03730 aa[i__ + (j - 1) * *lda] = a[i__ + j * a_dim1];
03731
03732 }
03733 i__2 = *lda;
03734 for (i__ = *m + 1; i__ <= i__2; ++i__) {
03735 aa[i__ + (j - 1) * *lda] = -1e10f;
03736
03737 }
03738
03739 }
03740 } else if (s_cmp(type__, "SY", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(type__,
03741 "TR", (ftnlen)2, (ftnlen)2) == 0) {
03742 i__1 = *n;
03743 for (j = 1; j <= i__1; ++j) {
03744 if (upper) {
03745 ibeg = 1;
03746 if (unit) {
03747 iend = j - 1;
03748 } else {
03749 iend = j;
03750 }
03751 } else {
03752 if (unit) {
03753 ibeg = j + 1;
03754 } else {
03755 ibeg = j;
03756 }
03757 iend = *n;
03758 }
03759 i__2 = ibeg - 1;
03760 for (i__ = 1; i__ <= i__2; ++i__) {
03761 aa[i__ + (j - 1) * *lda] = -1e10f;
03762
03763 }
03764 i__2 = iend;
03765 for (i__ = ibeg; i__ <= i__2; ++i__) {
03766 aa[i__ + (j - 1) * *lda] = a[i__ + j * a_dim1];
03767
03768 }
03769 i__2 = *lda;
03770 for (i__ = iend + 1; i__ <= i__2; ++i__) {
03771 aa[i__ + (j - 1) * *lda] = -1e10f;
03772
03773 }
03774
03775 }
03776 }
03777 return 0;
03778
03779
03780
03781 }
03782
03783 int smmch_(char *transa, char *transb, integer *m, integer *
03784 n, integer *kk, real *alpha, real *a, integer *lda, real *b, integer *
03785 ldb, real *beta, real *c__, integer *ldc, real *ct, real *g, real *cc,
03786 integer *ldcc, real *eps, real *err, logical *fatal, integer *nout,
03787 logical *mv, ftnlen transa_len, ftnlen transb_len)
03788 {
03789
03790 static char fmt_9999[] = "(\002 ******* FATAL ERROR - COMPUTED RESULT IS"
03791 " LESS THAN HAL\002,\002F ACCURATE *******\002,/\002 EX"
03792 "PECTED RESULT COMPU\002,\002TED RESULT\002)";
03793 static char fmt_9998[] = "(1x,i7,2g18.6)";
03794 static char fmt_9997[] = "(\002 THESE ARE THE RESULTS FOR COLUMN"
03795 " \002,i3)";
03796
03797
03798 integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, cc_dim1,
03799 cc_offset, i__1, i__2, i__3;
03800 real r__1, r__2;
03801
03802
03803 double sqrt(doublereal);
03804 integer s_wsfe(cilist *), e_wsfe(void), do_fio(integer *, char *, ftnlen);
03805
03806
03807 integer i__, j, k;
03808 real erri;
03809 logical trana, tranb;
03810
03811
03812 static cilist io___361 = { 0, 0, 0, fmt_9999, 0 };
03813 static cilist io___362 = { 0, 0, 0, fmt_9998, 0 };
03814 static cilist io___363 = { 0, 0, 0, fmt_9998, 0 };
03815 static cilist io___364 = { 0, 0, 0, fmt_9997, 0 };
03816
03817
03818
03819
03820
03821
03822
03823
03824
03825
03826
03827
03828
03829
03830
03831
03832
03833
03834
03835
03836 a_dim1 = *lda;
03837 a_offset = 1 + a_dim1;
03838 a -= a_offset;
03839 b_dim1 = *ldb;
03840 b_offset = 1 + b_dim1;
03841 b -= b_offset;
03842 c_dim1 = *ldc;
03843 c_offset = 1 + c_dim1;
03844 c__ -= c_offset;
03845 --ct;
03846 --g;
03847 cc_dim1 = *ldcc;
03848 cc_offset = 1 + cc_dim1;
03849 cc -= cc_offset;
03850
03851
03852 trana = *(unsigned char *)transa == 'T' || *(unsigned char *)transa ==
03853 'C';
03854 tranb = *(unsigned char *)transb == 'T' || *(unsigned char *)transb ==
03855 'C';
03856
03857
03858
03859
03860
03861 i__1 = *n;
03862 for (j = 1; j <= i__1; ++j) {
03863
03864 i__2 = *m;
03865 for (i__ = 1; i__ <= i__2; ++i__) {
03866 ct[i__] = 0.f;
03867 g[i__] = 0.f;
03868
03869 }
03870 if (! trana && ! tranb) {
03871 i__2 = *kk;
03872 for (k = 1; k <= i__2; ++k) {
03873 i__3 = *m;
03874 for (i__ = 1; i__ <= i__3; ++i__) {
03875 ct[i__] += a[i__ + k * a_dim1] * b[k + j * b_dim1];
03876 g[i__] += (r__1 = a[i__ + k * a_dim1], dabs(r__1)) * (
03877 r__2 = b[k + j * b_dim1], dabs(r__2));
03878
03879 }
03880
03881 }
03882 } else if (trana && ! tranb) {
03883 i__2 = *kk;
03884 for (k = 1; k <= i__2; ++k) {
03885 i__3 = *m;
03886 for (i__ = 1; i__ <= i__3; ++i__) {
03887 ct[i__] += a[k + i__ * a_dim1] * b[k + j * b_dim1];
03888 g[i__] += (r__1 = a[k + i__ * a_dim1], dabs(r__1)) * (
03889 r__2 = b[k + j * b_dim1], dabs(r__2));
03890
03891 }
03892
03893 }
03894 } else if (! trana && tranb) {
03895 i__2 = *kk;
03896 for (k = 1; k <= i__2; ++k) {
03897 i__3 = *m;
03898 for (i__ = 1; i__ <= i__3; ++i__) {
03899 ct[i__] += a[i__ + k * a_dim1] * b[j + k * b_dim1];
03900 g[i__] += (r__1 = a[i__ + k * a_dim1], dabs(r__1)) * (
03901 r__2 = b[j + k * b_dim1], dabs(r__2));
03902
03903 }
03904
03905 }
03906 } else if (trana && tranb) {
03907 i__2 = *kk;
03908 for (k = 1; k <= i__2; ++k) {
03909 i__3 = *m;
03910 for (i__ = 1; i__ <= i__3; ++i__) {
03911 ct[i__] += a[k + i__ * a_dim1] * b[j + k * b_dim1];
03912 g[i__] += (r__1 = a[k + i__ * a_dim1], dabs(r__1)) * (
03913 r__2 = b[j + k * b_dim1], dabs(r__2));
03914
03915 }
03916
03917 }
03918 }
03919 i__2 = *m;
03920 for (i__ = 1; i__ <= i__2; ++i__) {
03921 ct[i__] = *alpha * ct[i__] + *beta * c__[i__ + j * c_dim1];
03922 g[i__] = dabs(*alpha) * g[i__] + dabs(*beta) * (r__1 = c__[i__ +
03923 j * c_dim1], dabs(r__1));
03924
03925 }
03926
03927
03928
03929 *err = 0.f;
03930 i__2 = *m;
03931 for (i__ = 1; i__ <= i__2; ++i__) {
03932 erri = (r__1 = ct[i__] - cc[i__ + j * cc_dim1], dabs(r__1)) / *
03933 eps;
03934 if (g[i__] != 0.f) {
03935 erri /= g[i__];
03936 }
03937 *err = dmax(*err,erri);
03938 if (*err * sqrt(*eps) >= 1.f) {
03939 goto L130;
03940 }
03941
03942 }
03943
03944
03945 }
03946
03947
03948 goto L150;
03949
03950
03951
03952 L130:
03953 *fatal = TRUE_;
03954 io___361.ciunit = *nout;
03955 s_wsfe(&io___361);
03956 e_wsfe();
03957 i__1 = *m;
03958 for (i__ = 1; i__ <= i__1; ++i__) {
03959 if (*mv) {
03960 io___362.ciunit = *nout;
03961 s_wsfe(&io___362);
03962 do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
03963 do_fio(&c__1, (char *)&ct[i__], (ftnlen)sizeof(real));
03964 do_fio(&c__1, (char *)&cc[i__ + j * cc_dim1], (ftnlen)sizeof(real)
03965 );
03966 e_wsfe();
03967 } else {
03968 io___363.ciunit = *nout;
03969 s_wsfe(&io___363);
03970 do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
03971 do_fio(&c__1, (char *)&cc[i__ + j * cc_dim1], (ftnlen)sizeof(real)
03972 );
03973 do_fio(&c__1, (char *)&ct[i__], (ftnlen)sizeof(real));
03974 e_wsfe();
03975 }
03976
03977 }
03978 if (*n > 1) {
03979 io___364.ciunit = *nout;
03980 s_wsfe(&io___364);
03981 do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer));
03982 e_wsfe();
03983 }
03984
03985 L150:
03986 return 0;
03987
03988
03989
03990
03991 }
03992
03993 logical lse_(real *ri, real *rj, integer *lr)
03994 {
03995
03996 integer i__1;
03997 logical ret_val;
03998
03999
04000 integer i__;
04001
04002
04003
04004
04005
04006
04007
04008
04009
04010
04011
04012
04013
04014
04015
04016
04017
04018 --rj;
04019 --ri;
04020
04021
04022 i__1 = *lr;
04023 for (i__ = 1; i__ <= i__1; ++i__) {
04024 if (ri[i__] != rj[i__]) {
04025 goto L20;
04026 }
04027
04028 }
04029 ret_val = TRUE_;
04030 goto L30;
04031 L20:
04032 ret_val = FALSE_;
04033 L30:
04034 return ret_val;
04035
04036
04037
04038 }
04039
04040 logical lseres_(char *type__, char *uplo, integer *m, integer *n, real *aa,
04041 real *as, integer *lda, ftnlen type_len, ftnlen uplo_len)
04042 {
04043
04044 integer aa_dim1, aa_offset, as_dim1, as_offset, i__1, i__2;
04045 logical ret_val;
04046
04047
04048 integer s_cmp(char *, char *, ftnlen, ftnlen);
04049
04050
04051 integer i__, j, ibeg, iend;
04052 logical upper;
04053
04054
04055
04056
04057
04058
04059
04060
04061
04062
04063
04064
04065
04066
04067
04068
04069
04070
04071
04072 as_dim1 = *lda;
04073 as_offset = 1 + as_dim1;
04074 as -= as_offset;
04075 aa_dim1 = *lda;
04076 aa_offset = 1 + aa_dim1;
04077 aa -= aa_offset;
04078
04079
04080 upper = *(unsigned char *)uplo == 'U';
04081 if (s_cmp(type__, "GE", (ftnlen)2, (ftnlen)2) == 0) {
04082 i__1 = *n;
04083 for (j = 1; j <= i__1; ++j) {
04084 i__2 = *lda;
04085 for (i__ = *m + 1; i__ <= i__2; ++i__) {
04086 if (aa[i__ + j * aa_dim1] != as[i__ + j * as_dim1]) {
04087 goto L70;
04088 }
04089
04090 }
04091
04092 }
04093 } else if (s_cmp(type__, "SY", (ftnlen)2, (ftnlen)2) == 0) {
04094 i__1 = *n;
04095 for (j = 1; j <= i__1; ++j) {
04096 if (upper) {
04097 ibeg = 1;
04098 iend = j;
04099 } else {
04100 ibeg = j;
04101 iend = *n;
04102 }
04103 i__2 = ibeg - 1;
04104 for (i__ = 1; i__ <= i__2; ++i__) {
04105 if (aa[i__ + j * aa_dim1] != as[i__ + j * as_dim1]) {
04106 goto L70;
04107 }
04108
04109 }
04110 i__2 = *lda;
04111 for (i__ = iend + 1; i__ <= i__2; ++i__) {
04112 if (aa[i__ + j * aa_dim1] != as[i__ + j * as_dim1]) {
04113 goto L70;
04114 }
04115
04116 }
04117
04118 }
04119 }
04120
04121
04122 ret_val = TRUE_;
04123 goto L80;
04124 L70:
04125 ret_val = FALSE_;
04126 L80:
04127 return ret_val;
04128
04129
04130
04131 }
04132
04133 doublereal sbeg_(logical *reset)
04134 {
04135
04136 real ret_val;
04137
04138
04139 static integer i__, ic, mi;
04140
04141
04142
04143
04144
04145
04146
04147
04148
04149
04150
04151
04152
04153
04154
04155
04156 if (*reset) {
04157
04158 mi = 891;
04159 i__ = 7;
04160 ic = 0;
04161 *reset = FALSE_;
04162 }
04163
04164
04165
04166
04167
04168
04169
04170 ++ic;
04171 L10:
04172 i__ *= mi;
04173 i__ -= i__ / 1000 * 1000;
04174 if (ic >= 5) {
04175 ic = 0;
04176 goto L10;
04177 }
04178 ret_val = (i__ - 500) / 1001.f;
04179 return ret_val;
04180
04181
04182
04183 }
04184
04185 doublereal sdiff_(real *x, real *y)
04186 {
04187
04188 real ret_val;
04189
04190
04191
04192
04193
04194
04195
04196
04197
04198
04199
04200
04201 ret_val = *x - *y;
04202 return ret_val;
04203
04204
04205
04206 }
04207
04208 int chkxer_(char *srnamt, integer *infot, integer *nout,
04209 logical *lerr, logical *ok)
04210 {
04211
04212 static char fmt_9999[] = "(\002 ***** ILLEGAL VALUE OF PARAMETER NUMBER"
04213 " \002,i2,\002 NOT D\002,\002ETECTED BY \002,a6,\002 *****\002)";
04214
04215
04216 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
04217
04218
04219 static cilist io___374 = { 0, 0, 0, fmt_9999, 0 };
04220
04221
04222
04223
04224
04225
04226
04227
04228
04229
04230
04231
04232
04233
04234
04235 if (! (*lerr)) {
04236 io___374.ciunit = *nout;
04237 s_wsfe(&io___374);
04238 do_fio(&c__1, (char *)&(*infot), (ftnlen)sizeof(integer));
04239 do_fio(&c__1, srnamt, (ftnlen)6);
04240 e_wsfe();
04241 *ok = FALSE_;
04242 }
04243 *lerr = FALSE_;
04244 return 0;
04245
04246
04247
04248
04249 }
04250
04251 int xerbla_(char *srname, integer *info)
04252 {
04253
04254 static char fmt_9999[] = "(\002 ******* XERBLA WAS CALLED WITH INFO ="
04255 " \002,i6,\002 INSTEAD\002,\002 OF \002,i2,\002 *******\002)";
04256 static char fmt_9997[] = "(\002 ******* XERBLA WAS CALLED WITH INFO ="
04257 " \002,i6,\002 *******\002)";
04258 static char fmt_9998[] = "(\002 ******* XERBLA WAS CALLED WITH SRNAME ="
04259 " \002,a6,\002 INSTE\002,\002AD OF \002,a6,\002 *******\002)";
04260
04261
04262 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void),
04263 s_cmp(char *, char *, ftnlen, ftnlen);
04264
04265
04266 static cilist io___375 = { 0, 0, 0, fmt_9999, 0 };
04267 static cilist io___376 = { 0, 0, 0, fmt_9997, 0 };
04268 static cilist io___377 = { 0, 0, 0, fmt_9998, 0 };
04269
04270
04271
04272
04273
04274
04275
04276
04277
04278
04279
04280
04281
04282
04283
04284
04285
04286
04287
04288
04289
04290
04291
04292
04293 infoc_2.lerr = TRUE_;
04294 if (*info != infoc_2.infot) {
04295 if (infoc_2.infot != 0) {
04296 io___375.ciunit = infoc_2.nout;
04297 s_wsfe(&io___375);
04298 do_fio(&c__1, (char *)&(*info), (ftnlen)sizeof(integer));
04299 do_fio(&c__1, (char *)&infoc_2.infot, (ftnlen)sizeof(integer));
04300 e_wsfe();
04301 } else {
04302 io___376.ciunit = infoc_2.nout;
04303 s_wsfe(&io___376);
04304 do_fio(&c__1, (char *)&(*info), (ftnlen)sizeof(integer));
04305 e_wsfe();
04306 }
04307 infoc_2.ok = FALSE_;
04308 }
04309 if (s_cmp(srname, srnamc_1.srnamt, (ftnlen)6, (ftnlen)6) != 0) {
04310 io___377.ciunit = infoc_2.nout;
04311 s_wsfe(&io___377);
04312 do_fio(&c__1, srname, (ftnlen)6);
04313 do_fio(&c__1, srnamc_1.srnamt, (ftnlen)6);
04314 e_wsfe();
04315 infoc_2.ok = FALSE_;
04316 }
04317 return 0;
04318
04319
04320
04321
04322 }
04323
04324 int sblat3_ () { MAIN__ (); return 0; }