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