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 complex c_b1 = {0.f,0.f};
00041 static complex c_b2 = {1.f,0.f};
00042 static integer c__9 = 9;
00043 static integer c__1 = 1;
00044 static integer c__3 = 3;
00045 static integer c__8 = 8;
00046 static integer c__4 = 4;
00047 static integer c__65 = 65;
00048 static integer c__7 = 7;
00049 static integer c__6 = 6;
00050 static integer c__2 = 2;
00051 static real c_b87 = 1.f;
00052 static logical c_true = TRUE_;
00053 static logical c_false = FALSE_;
00054 static integer c__0 = 0;
00055 static integer c_n1 = -1;
00056
00057 int MAIN__(void)
00058 {
00059
00060
00061 static char snames[6*9] = "CGEMM " "CHEMM " "CSYMM " "CTRMM " "CTRSM "
00062 "CHERK " "CSYRK " "CHER2K" "CSYR2K";
00063
00064
00065 static char fmt_9997[] = "(\002 NUMBER OF VALUES OF \002,a,\002 IS LESS "
00066 "THAN 1 OR GREATER \002,\002THAN \002,i2)";
00067 static char fmt_9996[] = "(\002 VALUE OF N IS LESS THAN 0 OR GREATER THA"
00068 "N \002,i2)";
00069 static char fmt_9995[] = "(\002 TESTS OF THE COMPLEX LEVEL 3 BL"
00070 "AS\002,//\002 THE F\002,\002OLLOWING PARAMETER VALUES WILL BE US"
00071 "ED:\002)";
00072 static char fmt_9994[] = "(\002 FOR N \002,9i6)";
00073 static char fmt_9993[] = "(\002 FOR ALPHA \002,7(\002(\002,f4"
00074 ".1,\002,\002,f4.1,\002) \002,:))";
00075 static char fmt_9992[] = "(\002 FOR BETA \002,7(\002(\002,f4"
00076 ".1,\002,\002,f4.1,\002) \002,:))";
00077 static char fmt_9984[] = "(\002 ERROR-EXITS WILL NOT BE TESTED\002)";
00078 static char fmt_9999[] = "(\002 ROUTINES PASS COMPUTATIONAL TESTS IF TES"
00079 "T RATIO IS LES\002,\002S THAN\002,f8.2)";
00080 static char fmt_9988[] = "(a6,l2)";
00081 static char fmt_9990[] = "(\002 SUBPROGRAM NAME \002,a6,\002 NOT RECOGNI"
00082 "ZED\002,/\002 ******* T\002,\002ESTS ABANDONED *******\002)";
00083 static char fmt_9998[] = "(\002 RELATIVE MACHINE PRECISION IS TAKEN TO"
00084 " BE\002,1p,e9.1)";
00085 static char fmt_9989[] = "(\002 ERROR IN CMMCH - IN-LINE DOT PRODUCTS A"
00086 "RE BEING EVALU\002,\002ATED WRONGLY.\002,/\002 CMMCH WAS CALLED "
00087 "WITH TRANSA = \002,a1,\002 AND TRANSB = \002,a1,/\002 AND RETURN"
00088 "ED SAME = \002,l1,\002 AND \002,\002ERR = \002,f12.3,\002.\002,"
00089 "/\002 THIS MAY BE DUE TO FAULTS IN THE \002,\002ARITHMETIC OR TH"
00090 "E COMPILER.\002,/\002 ******* TESTS ABANDONED \002,\002******"
00091 "*\002)";
00092 static char fmt_9987[] = "(1x,a6,\002 WAS NOT TESTED\002)";
00093 static char fmt_9986[] = "(/\002 END OF TESTS\002)";
00094 static char fmt_9985[] = "(/\002 ******* FATAL ERROR - TESTS ABANDONED *"
00095 "******\002)";
00096 static char fmt_9991[] = "(\002 AMEND DATA FILE OR INCREASE ARRAY SIZES "
00097 "IN PROGRAM\002,/\002 ******* TESTS ABANDONED *******\002)";
00098
00099
00100 integer i__1, i__2, i__3, i__4, i__5;
00101 real r__1;
00102 olist o__1;
00103 cllist cl__1;
00104
00105
00106 integer s_rsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
00107 e_rsle(void), f_open(olist *), s_wsfe(cilist *), do_fio(integer *,
00108 char *, ftnlen), e_wsfe(void), s_wsle(cilist *), e_wsle(void),
00109 s_rsfe(cilist *), e_rsfe(void), s_cmp(char *, char *, ftnlen,
00110 ftnlen);
00111 int s_stop(char *, ftnlen);
00112 integer f_clos(cllist *);
00113 int s_copy(char *, char *, ftnlen, ftnlen);
00114
00115
00116 complex c__[4225] ;
00117 real g[65];
00118 integer i__, j, n;
00119 complex w[130], aa[4225], ab[8450] , bb[4225], cc[
00120 4225], as[4225], bs[4225], cs[4225], ct[65], alf[7];
00121 extern logical lce_(complex *, complex *, integer *);
00122 complex bet[7];
00123 real eps, err;
00124 integer nalf, idim[9];
00125 logical same;
00126 integer nbet, ntra;
00127 logical rewi;
00128 integer nout;
00129 extern int cchk1_(char *, real *, real *, integer *,
00130 integer *, logical *, logical *, logical *, integer *, integer *,
00131 integer *, complex *, integer *, complex *, integer *, complex *,
00132 complex *, complex *, complex *, complex *, complex *, complex *,
00133 complex *, complex *, complex *, real *, ftnlen), cchk2_(char *,
00134 real *, real *, integer *, integer *, logical *, logical *,
00135 logical *, integer *, integer *, integer *, complex *, integer *,
00136 complex *, integer *, complex *, complex *, complex *, complex *,
00137 complex *, complex *, complex *, complex *, complex *, complex *,
00138 real *, ftnlen), cchk3_(char *, real *, real *, integer *,
00139 integer *, logical *, logical *, logical *, integer *, integer *,
00140 integer *, complex *, integer *, complex *, complex *, complex *,
00141 complex *, complex *, complex *, complex *, real *, complex *,
00142 ftnlen), cchk4_(char *, real *, real *, integer *, integer *,
00143 logical *, logical *, logical *, integer *, integer *, integer *,
00144 complex *, integer *, complex *, integer *, complex *, complex *,
00145 complex *, complex *, complex *, complex *, complex *, complex *,
00146 complex *, complex *, real *, ftnlen), cchk5_(char *, real *,
00147 real *, integer *, integer *, logical *, logical *, logical *,
00148 integer *, integer *, integer *, complex *, integer *, complex *,
00149 integer *, complex *, complex *, complex *, complex *, complex *,
00150 complex *, complex *, complex *, complex *, real *, complex *,
00151 ftnlen), cchke_(integer *, char *, integer *, ftnlen);
00152 logical fatal;
00153 extern int cmmch_(char *, char *, integer *, integer *,
00154 integer *, complex *, complex *, integer *, complex *, integer *,
00155 complex *, complex *, integer *, complex *, real *, complex *,
00156 integer *, real *, real *, logical *, integer *, logical *,
00157 ftnlen, ftnlen);
00158 extern doublereal sdiff_(real *, real *);
00159 logical trace;
00160 integer nidim;
00161 char snaps[32];
00162 integer isnum;
00163 logical ltest[9], sfatal;
00164 char snamet[6], transa[1], transb[1];
00165 real thresh;
00166 logical ltestt, tsterr;
00167 char summry[32];
00168
00169
00170 static cilist io___2 = { 0, 5, 0, 0, 0 };
00171 static cilist io___4 = { 0, 5, 0, 0, 0 };
00172 static cilist io___6 = { 0, 5, 0, 0, 0 };
00173 static cilist io___8 = { 0, 5, 0, 0, 0 };
00174 static cilist io___11 = { 0, 5, 0, 0, 0 };
00175 static cilist io___13 = { 0, 5, 0, 0, 0 };
00176 static cilist io___15 = { 0, 5, 0, 0, 0 };
00177 static cilist io___17 = { 0, 5, 0, 0, 0 };
00178 static cilist io___19 = { 0, 5, 0, 0, 0 };
00179 static cilist io___21 = { 0, 0, 0, fmt_9997, 0 };
00180 static cilist io___22 = { 0, 5, 0, 0, 0 };
00181 static cilist io___25 = { 0, 0, 0, fmt_9996, 0 };
00182 static cilist io___26 = { 0, 5, 0, 0, 0 };
00183 static cilist io___28 = { 0, 0, 0, fmt_9997, 0 };
00184 static cilist io___29 = { 0, 5, 0, 0, 0 };
00185 static cilist io___31 = { 0, 5, 0, 0, 0 };
00186 static cilist io___33 = { 0, 0, 0, fmt_9997, 0 };
00187 static cilist io___34 = { 0, 5, 0, 0, 0 };
00188 static cilist io___36 = { 0, 0, 0, fmt_9995, 0 };
00189 static cilist io___37 = { 0, 0, 0, fmt_9994, 0 };
00190 static cilist io___38 = { 0, 0, 0, fmt_9993, 0 };
00191 static cilist io___39 = { 0, 0, 0, fmt_9992, 0 };
00192 static cilist io___40 = { 0, 0, 0, 0, 0 };
00193 static cilist io___41 = { 0, 0, 0, fmt_9984, 0 };
00194 static cilist io___42 = { 0, 0, 0, 0, 0 };
00195 static cilist io___43 = { 0, 0, 0, fmt_9999, 0 };
00196 static cilist io___44 = { 0, 0, 0, 0, 0 };
00197 static cilist io___46 = { 0, 5, 1, fmt_9988, 0 };
00198 static cilist io___49 = { 0, 0, 0, fmt_9990, 0 };
00199 static cilist io___51 = { 0, 0, 0, fmt_9998, 0 };
00200 static cilist io___64 = { 0, 0, 0, fmt_9989, 0 };
00201 static cilist io___65 = { 0, 0, 0, fmt_9989, 0 };
00202 static cilist io___66 = { 0, 0, 0, fmt_9989, 0 };
00203 static cilist io___67 = { 0, 0, 0, fmt_9989, 0 };
00204 static cilist io___69 = { 0, 0, 0, 0, 0 };
00205 static cilist io___70 = { 0, 0, 0, fmt_9987, 0 };
00206 static cilist io___71 = { 0, 0, 0, 0, 0 };
00207 static cilist io___78 = { 0, 0, 0, fmt_9986, 0 };
00208 static cilist io___79 = { 0, 0, 0, fmt_9985, 0 };
00209 static cilist io___80 = { 0, 0, 0, fmt_9991, 0 };
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
00273
00274
00275
00276 s_rsle(&io___2);
00277 do_lio(&c__9, &c__1, summry, (ftnlen)32);
00278 e_rsle();
00279 s_rsle(&io___4);
00280 do_lio(&c__3, &c__1, (char *)&nout, (ftnlen)sizeof(integer));
00281 e_rsle();
00282 o__1.oerr = 0;
00283 o__1.ounit = nout;
00284 o__1.ofnmlen = 32;
00285 o__1.ofnm = summry;
00286 o__1.orl = 0;
00287 o__1.osta = 0;
00288 o__1.oacc = 0;
00289 o__1.ofm = 0;
00290 o__1.oblnk = 0;
00291 f_open(&o__1);
00292 infoc_1.noutc = nout;
00293
00294
00295
00296 s_rsle(&io___6);
00297 do_lio(&c__9, &c__1, snaps, (ftnlen)32);
00298 e_rsle();
00299 s_rsle(&io___8);
00300 do_lio(&c__3, &c__1, (char *)&ntra, (ftnlen)sizeof(integer));
00301 e_rsle();
00302 trace = ntra >= 0;
00303 if (trace) {
00304 o__1.oerr = 0;
00305 o__1.ounit = ntra;
00306 o__1.ofnmlen = 32;
00307 o__1.ofnm = snaps;
00308 o__1.orl = 0;
00309 o__1.osta = 0;
00310 o__1.oacc = 0;
00311 o__1.ofm = 0;
00312 o__1.oblnk = 0;
00313 f_open(&o__1);
00314 }
00315
00316 s_rsle(&io___11);
00317 do_lio(&c__8, &c__1, (char *)&rewi, (ftnlen)sizeof(logical));
00318 e_rsle();
00319 rewi = rewi && trace;
00320
00321 s_rsle(&io___13);
00322 do_lio(&c__8, &c__1, (char *)&sfatal, (ftnlen)sizeof(logical));
00323 e_rsle();
00324
00325 s_rsle(&io___15);
00326 do_lio(&c__8, &c__1, (char *)&tsterr, (ftnlen)sizeof(logical));
00327 e_rsle();
00328
00329 s_rsle(&io___17);
00330 do_lio(&c__4, &c__1, (char *)&thresh, (ftnlen)sizeof(real));
00331 e_rsle();
00332
00333
00334
00335
00336 s_rsle(&io___19);
00337 do_lio(&c__3, &c__1, (char *)&nidim, (ftnlen)sizeof(integer));
00338 e_rsle();
00339 if (nidim < 1 || nidim > 9) {
00340 io___21.ciunit = nout;
00341 s_wsfe(&io___21);
00342 do_fio(&c__1, "N", (ftnlen)1);
00343 do_fio(&c__1, (char *)&c__9, (ftnlen)sizeof(integer));
00344 e_wsfe();
00345 goto L220;
00346 }
00347 s_rsle(&io___22);
00348 i__1 = nidim;
00349 for (i__ = 1; i__ <= i__1; ++i__) {
00350 do_lio(&c__3, &c__1, (char *)&idim[i__ - 1], (ftnlen)sizeof(integer));
00351 }
00352 e_rsle();
00353 i__1 = nidim;
00354 for (i__ = 1; i__ <= i__1; ++i__) {
00355 if (idim[i__ - 1] < 0 || idim[i__ - 1] > 65) {
00356 io___25.ciunit = nout;
00357 s_wsfe(&io___25);
00358 do_fio(&c__1, (char *)&c__65, (ftnlen)sizeof(integer));
00359 e_wsfe();
00360 goto L220;
00361 }
00362
00363 }
00364
00365 s_rsle(&io___26);
00366 do_lio(&c__3, &c__1, (char *)&nalf, (ftnlen)sizeof(integer));
00367 e_rsle();
00368 if (nalf < 1 || nalf > 7) {
00369 io___28.ciunit = nout;
00370 s_wsfe(&io___28);
00371 do_fio(&c__1, "ALPHA", (ftnlen)5);
00372 do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer));
00373 e_wsfe();
00374 goto L220;
00375 }
00376 s_rsle(&io___29);
00377 i__1 = nalf;
00378 for (i__ = 1; i__ <= i__1; ++i__) {
00379 do_lio(&c__6, &c__1, (char *)&alf[i__ - 1], (ftnlen)sizeof(complex));
00380 }
00381 e_rsle();
00382
00383 s_rsle(&io___31);
00384 do_lio(&c__3, &c__1, (char *)&nbet, (ftnlen)sizeof(integer));
00385 e_rsle();
00386 if (nbet < 1 || nbet > 7) {
00387 io___33.ciunit = nout;
00388 s_wsfe(&io___33);
00389 do_fio(&c__1, "BETA", (ftnlen)4);
00390 do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer));
00391 e_wsfe();
00392 goto L220;
00393 }
00394 s_rsle(&io___34);
00395 i__1 = nbet;
00396 for (i__ = 1; i__ <= i__1; ++i__) {
00397 do_lio(&c__6, &c__1, (char *)&bet[i__ - 1], (ftnlen)sizeof(complex));
00398 }
00399 e_rsle();
00400
00401
00402
00403 io___36.ciunit = nout;
00404 s_wsfe(&io___36);
00405 e_wsfe();
00406 io___37.ciunit = nout;
00407 s_wsfe(&io___37);
00408 i__1 = nidim;
00409 for (i__ = 1; i__ <= i__1; ++i__) {
00410 do_fio(&c__1, (char *)&idim[i__ - 1], (ftnlen)sizeof(integer));
00411 }
00412 e_wsfe();
00413 io___38.ciunit = nout;
00414 s_wsfe(&io___38);
00415 i__1 = nalf;
00416 for (i__ = 1; i__ <= i__1; ++i__) {
00417 do_fio(&c__2, (char *)&alf[i__ - 1], (ftnlen)sizeof(real));
00418 }
00419 e_wsfe();
00420 io___39.ciunit = nout;
00421 s_wsfe(&io___39);
00422 i__1 = nbet;
00423 for (i__ = 1; i__ <= i__1; ++i__) {
00424 do_fio(&c__2, (char *)&bet[i__ - 1], (ftnlen)sizeof(real));
00425 }
00426 e_wsfe();
00427 if (! tsterr) {
00428 io___40.ciunit = nout;
00429 s_wsle(&io___40);
00430 e_wsle();
00431 io___41.ciunit = nout;
00432 s_wsfe(&io___41);
00433 e_wsfe();
00434 }
00435 io___42.ciunit = nout;
00436 s_wsle(&io___42);
00437 e_wsle();
00438 io___43.ciunit = nout;
00439 s_wsfe(&io___43);
00440 do_fio(&c__1, (char *)&thresh, (ftnlen)sizeof(real));
00441 e_wsfe();
00442 io___44.ciunit = nout;
00443 s_wsle(&io___44);
00444 e_wsle();
00445
00446
00447
00448
00449 for (i__ = 1; i__ <= 9; ++i__) {
00450 ltest[i__ - 1] = FALSE_;
00451
00452 }
00453 L30:
00454 i__1 = s_rsfe(&io___46);
00455 if (i__1 != 0) {
00456 goto L60;
00457 }
00458 i__1 = do_fio(&c__1, snamet, (ftnlen)6);
00459 if (i__1 != 0) {
00460 goto L60;
00461 }
00462 i__1 = do_fio(&c__1, (char *)<estt, (ftnlen)sizeof(logical));
00463 if (i__1 != 0) {
00464 goto L60;
00465 }
00466 i__1 = e_rsfe();
00467 if (i__1 != 0) {
00468 goto L60;
00469 }
00470 for (i__ = 1; i__ <= 9; ++i__) {
00471 if (s_cmp(snamet, snames + (i__ - 1) * 6, (ftnlen)6, (ftnlen)6) == 0)
00472 {
00473 goto L50;
00474 }
00475
00476 }
00477 io___49.ciunit = nout;
00478 s_wsfe(&io___49);
00479 do_fio(&c__1, snamet, (ftnlen)6);
00480 e_wsfe();
00481 s_stop("", (ftnlen)0);
00482 L50:
00483 ltest[i__ - 1] = ltestt;
00484 goto L30;
00485
00486 L60:
00487 cl__1.cerr = 0;
00488 cl__1.cunit = 5;
00489 cl__1.csta = 0;
00490 f_clos(&cl__1);
00491
00492
00493
00494 eps = 1.f;
00495 L70:
00496 r__1 = eps + 1.f;
00497 if (sdiff_(&r__1, &c_b87) == 0.f) {
00498 goto L80;
00499 }
00500 eps *= .5f;
00501 goto L70;
00502 L80:
00503 eps += eps;
00504 io___51.ciunit = nout;
00505 s_wsfe(&io___51);
00506 do_fio(&c__1, (char *)&eps, (ftnlen)sizeof(real));
00507 e_wsfe();
00508
00509
00510
00511 n = 32;
00512 i__1 = n;
00513 for (j = 1; j <= i__1; ++j) {
00514 i__2 = n;
00515 for (i__ = 1; i__ <= i__2; ++i__) {
00516 i__3 = i__ + j * 65 - 66;
00517
00518 i__5 = i__ - j + 1;
00519 i__4 = max(i__5,0);
00520 ab[i__3].r = (real) i__4, ab[i__3].i = 0.f;
00521
00522 }
00523 i__2 = j + 4224;
00524 ab[i__2].r = (real) j, ab[i__2].i = 0.f;
00525 i__2 = (j + 65) * 65 - 65;
00526 ab[i__2].r = (real) j, ab[i__2].i = 0.f;
00527 i__2 = j - 1;
00528 c__[i__2].r = 0.f, c__[i__2].i = 0.f;
00529
00530 }
00531 i__1 = n;
00532 for (j = 1; j <= i__1; ++j) {
00533 i__2 = j - 1;
00534 i__3 = j * ((j + 1) * j) / 2 - (j + 1) * j * (j - 1) / 3;
00535 cc[i__2].r = (real) i__3, cc[i__2].i = 0.f;
00536
00537 }
00538
00539
00540 *(unsigned char *)transa = 'N';
00541 *(unsigned char *)transb = 'N';
00542 cmmch_(transa, transb, &n, &c__1, &n, &c_b2, ab, &c__65, &ab[4225], &
00543 c__65, &c_b1, c__, &c__65, ct, g, cc, &c__65, &eps, &err, &fatal,
00544 &nout, &c_true, (ftnlen)1, (ftnlen)1);
00545 same = lce_(cc, ct, &n);
00546 if (! same || err != 0.f) {
00547 io___64.ciunit = nout;
00548 s_wsfe(&io___64);
00549 do_fio(&c__1, transa, (ftnlen)1);
00550 do_fio(&c__1, transb, (ftnlen)1);
00551 do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical));
00552 do_fio(&c__1, (char *)&err, (ftnlen)sizeof(real));
00553 e_wsfe();
00554 s_stop("", (ftnlen)0);
00555 }
00556 *(unsigned char *)transb = 'C';
00557 cmmch_(transa, transb, &n, &c__1, &n, &c_b2, ab, &c__65, &ab[4225], &
00558 c__65, &c_b1, c__, &c__65, ct, g, cc, &c__65, &eps, &err, &fatal,
00559 &nout, &c_true, (ftnlen)1, (ftnlen)1);
00560 same = lce_(cc, ct, &n);
00561 if (! same || err != 0.f) {
00562 io___65.ciunit = nout;
00563 s_wsfe(&io___65);
00564 do_fio(&c__1, transa, (ftnlen)1);
00565 do_fio(&c__1, transb, (ftnlen)1);
00566 do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical));
00567 do_fio(&c__1, (char *)&err, (ftnlen)sizeof(real));
00568 e_wsfe();
00569 s_stop("", (ftnlen)0);
00570 }
00571 i__1 = n;
00572 for (j = 1; j <= i__1; ++j) {
00573 i__2 = j + 4224;
00574 i__3 = n - j + 1;
00575 ab[i__2].r = (real) i__3, ab[i__2].i = 0.f;
00576 i__2 = (j + 65) * 65 - 65;
00577 i__3 = n - j + 1;
00578 ab[i__2].r = (real) i__3, ab[i__2].i = 0.f;
00579
00580 }
00581 i__1 = n;
00582 for (j = 1; j <= i__1; ++j) {
00583 i__2 = n - j;
00584 i__3 = j * ((j + 1) * j) / 2 - (j + 1) * j * (j - 1) / 3;
00585 cc[i__2].r = (real) i__3, cc[i__2].i = 0.f;
00586
00587 }
00588 *(unsigned char *)transa = 'C';
00589 *(unsigned char *)transb = 'N';
00590 cmmch_(transa, transb, &n, &c__1, &n, &c_b2, ab, &c__65, &ab[4225], &
00591 c__65, &c_b1, c__, &c__65, ct, g, cc, &c__65, &eps, &err, &fatal,
00592 &nout, &c_true, (ftnlen)1, (ftnlen)1);
00593 same = lce_(cc, ct, &n);
00594 if (! same || err != 0.f) {
00595 io___66.ciunit = nout;
00596 s_wsfe(&io___66);
00597 do_fio(&c__1, transa, (ftnlen)1);
00598 do_fio(&c__1, transb, (ftnlen)1);
00599 do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical));
00600 do_fio(&c__1, (char *)&err, (ftnlen)sizeof(real));
00601 e_wsfe();
00602 s_stop("", (ftnlen)0);
00603 }
00604 *(unsigned char *)transb = 'C';
00605 cmmch_(transa, transb, &n, &c__1, &n, &c_b2, ab, &c__65, &ab[4225], &
00606 c__65, &c_b1, c__, &c__65, ct, g, cc, &c__65, &eps, &err, &fatal,
00607 &nout, &c_true, (ftnlen)1, (ftnlen)1);
00608 same = lce_(cc, ct, &n);
00609 if (! same || err != 0.f) {
00610 io___67.ciunit = nout;
00611 s_wsfe(&io___67);
00612 do_fio(&c__1, transa, (ftnlen)1);
00613 do_fio(&c__1, transb, (ftnlen)1);
00614 do_fio(&c__1, (char *)&same, (ftnlen)sizeof(logical));
00615 do_fio(&c__1, (char *)&err, (ftnlen)sizeof(real));
00616 e_wsfe();
00617 s_stop("", (ftnlen)0);
00618 }
00619
00620
00621
00622 for (isnum = 1; isnum <= 9; ++isnum) {
00623 io___69.ciunit = nout;
00624 s_wsle(&io___69);
00625 e_wsle();
00626 if (! ltest[isnum - 1]) {
00627
00628 io___70.ciunit = nout;
00629 s_wsfe(&io___70);
00630 do_fio(&c__1, snames + (isnum - 1) * 6, (ftnlen)6);
00631 e_wsfe();
00632 } else {
00633 s_copy(srnamc_1.srnamt, snames + (isnum - 1) * 6, (ftnlen)6, (
00634 ftnlen)6);
00635
00636 if (tsterr) {
00637 cchke_(&isnum, snames + (isnum - 1) * 6, &nout, (ftnlen)6);
00638 io___71.ciunit = nout;
00639 s_wsle(&io___71);
00640 e_wsle();
00641 }
00642
00643 infoc_1.infot = 0;
00644 infoc_1.ok = TRUE_;
00645 fatal = FALSE_;
00646 switch (isnum) {
00647 case 1: goto L140;
00648 case 2: goto L150;
00649 case 3: goto L150;
00650 case 4: goto L160;
00651 case 5: goto L160;
00652 case 6: goto L170;
00653 case 7: goto L170;
00654 case 8: goto L180;
00655 case 9: goto L180;
00656 }
00657
00658 L140:
00659 cchk1_(snames + (isnum - 1) * 6, &eps, &thresh, &nout, &ntra, &
00660 trace, &rewi, &fatal, &nidim, idim, &nalf, alf, &nbet,
00661 bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, cc, cs,
00662 ct, g, (ftnlen)6);
00663 goto L190;
00664
00665 L150:
00666 cchk2_(snames + (isnum - 1) * 6, &eps, &thresh, &nout, &ntra, &
00667 trace, &rewi, &fatal, &nidim, idim, &nalf, alf, &nbet,
00668 bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, cc, cs,
00669 ct, g, (ftnlen)6);
00670 goto L190;
00671
00672 L160:
00673 cchk3_(snames + (isnum - 1) * 6, &eps, &thresh, &nout, &ntra, &
00674 trace, &rewi, &fatal, &nidim, idim, &nalf, alf, &c__65,
00675 ab, aa, as, &ab[4225], bb, bs, ct, g, c__, (ftnlen)6);
00676 goto L190;
00677
00678 L170:
00679 cchk4_(snames + (isnum - 1) * 6, &eps, &thresh, &nout, &ntra, &
00680 trace, &rewi, &fatal, &nidim, idim, &nalf, alf, &nbet,
00681 bet, &c__65, ab, aa, as, &ab[4225], bb, bs, c__, cc, cs,
00682 ct, g, (ftnlen)6);
00683 goto L190;
00684
00685 L180:
00686 cchk5_(snames + (isnum - 1) * 6, &eps, &thresh, &nout, &ntra, &
00687 trace, &rewi, &fatal, &nidim, idim, &nalf, alf, &nbet,
00688 bet, &c__65, ab, aa, as, bb, bs, c__, cc, cs, ct, g, w, (
00689 ftnlen)6);
00690 goto L190;
00691
00692 L190:
00693 if (fatal && sfatal) {
00694 goto L210;
00695 }
00696 }
00697
00698 }
00699 io___78.ciunit = nout;
00700 s_wsfe(&io___78);
00701 e_wsfe();
00702 goto L230;
00703
00704 L210:
00705 io___79.ciunit = nout;
00706 s_wsfe(&io___79);
00707 e_wsfe();
00708 goto L230;
00709
00710 L220:
00711 io___80.ciunit = nout;
00712 s_wsfe(&io___80);
00713 e_wsfe();
00714
00715 L230:
00716 if (trace) {
00717 cl__1.cerr = 0;
00718 cl__1.cunit = ntra;
00719 cl__1.csta = 0;
00720 f_clos(&cl__1);
00721 }
00722 cl__1.cerr = 0;
00723 cl__1.cunit = nout;
00724 cl__1.csta = 0;
00725 f_clos(&cl__1);
00726 s_stop("", (ftnlen)0);
00727
00728
00729
00730
00731 return 0;
00732 }
00733
00734 int cchk1_(char *sname, real *eps, real *thresh, integer *
00735 nout, integer *ntra, logical *trace, logical *rewi, logical *fatal,
00736 integer *nidim, integer *idim, integer *nalf, complex *alf, integer *
00737 nbet, complex *bet, integer *nmax, complex *a, complex *aa, complex *
00738 as, complex *b, complex *bb, complex *bs, complex *c__, complex *cc,
00739 complex *cs, complex *ct, real *g, ftnlen sname_len)
00740 {
00741
00742
00743 static char ich[3] = "NTC";
00744
00745
00746 static char fmt_9995[] = "(1x,i6,\002: \002,a6,\002('\002,a1,\002','\002"
00747 ",a1,\002',\002,3(i3,\002,\002),\002(\002,f4.1,\002,\002,f4.1,"
00748 "\002), A,\002,i3,\002, B,\002,i3,\002,(\002,f4.1,\002,\002,f4.1"
00749 ",\002), C,\002,i3,\002).\002)";
00750 static char fmt_9994[] = "(\002 ******* FATAL ERROR - ERROR-EXIT TAKEN O"
00751 "N VALID CALL *\002,\002******\002)";
00752 static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER"
00753 " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)";
00754 static char fmt_9999[] = "(\002 \002,a6,\002 PASSED THE COMPUTATIONAL TE"
00755 "STS (\002,i6,\002 CALL\002,\002S)\002)";
00756 static char fmt_9997[] = "(\002 \002,a6,\002 COMPLETED THE COMPUTATIONAL"
00757 " TESTS (\002,i6,\002 C\002,\002ALLS)\002,/\002 ******* BUT WITH "
00758 "MAXIMUM TEST RATIO\002,f8.2,\002 - SUSPECT *******\002)";
00759 static char fmt_9996[] = "(\002 ******* \002,a6,\002 FAILED ON CALL NUMB"
00760 "ER:\002)";
00761
00762
00763 integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
00764 i__3, i__4, i__5, i__6, i__7, i__8;
00765 alist al__1;
00766
00767
00768 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void),
00769 f_rew(alist *);
00770
00771
00772 integer i__, k, m, n, ia, ib, ma, mb, na, nb, nc, ik, im, in, ks, ms, ns,
00773 ica, icb, laa, lbb, lda, lcc, ldb, ldc;
00774 extern logical lce_(complex *, complex *, integer *);
00775 complex als, bls;
00776 real err;
00777 complex beta;
00778 integer ldas, ldbs, ldcs;
00779 logical same, null;
00780 extern int cmake_(char *, char *, char *, integer *,
00781 integer *, complex *, integer *, complex *, integer *, logical *,
00782 complex *, ftnlen, ftnlen, ftnlen);
00783 complex alpha;
00784 extern int cgemm_(char *, char *, integer *, integer *,
00785 integer *, complex *, complex *, integer *, complex *, integer *,
00786 complex *, complex *, integer *), cmmch_(char *,
00787 char *, integer *, integer *, integer *, complex *, complex *,
00788 integer *, complex *, integer *, complex *, complex *, integer *,
00789 complex *, real *, complex *, integer *, real *, real *, logical *
00790 , integer *, logical *, ftnlen, ftnlen);
00791 logical isame[13], trana, tranb;
00792 integer nargs;
00793 logical reset;
00794 extern logical lceres_(char *, char *, integer *, integer *, complex *,
00795 complex *, integer *, ftnlen, ftnlen);
00796 char tranas[1], tranbs[1], transa[1], transb[1];
00797 real errmax;
00798
00799
00800 static cilist io___124 = { 0, 0, 0, fmt_9995, 0 };
00801 static cilist io___125 = { 0, 0, 0, fmt_9994, 0 };
00802 static cilist io___128 = { 0, 0, 0, fmt_9998, 0 };
00803 static cilist io___130 = { 0, 0, 0, fmt_9999, 0 };
00804 static cilist io___131 = { 0, 0, 0, fmt_9997, 0 };
00805 static cilist io___132 = { 0, 0, 0, fmt_9996, 0 };
00806 static cilist io___133 = { 0, 0, 0, fmt_9995, 0 };
00807
00808
00809
00810
00811
00812
00813
00814
00815
00816
00817
00818
00819
00820
00821
00822
00823
00824
00825
00826
00827
00828
00829
00830
00831
00832 --idim;
00833 --alf;
00834 --bet;
00835 --g;
00836 --ct;
00837 --cs;
00838 --cc;
00839 c_dim1 = *nmax;
00840 c_offset = 1 + c_dim1;
00841 c__ -= c_offset;
00842 --bs;
00843 --bb;
00844 b_dim1 = *nmax;
00845 b_offset = 1 + b_dim1;
00846 b -= b_offset;
00847 --as;
00848 --aa;
00849 a_dim1 = *nmax;
00850 a_offset = 1 + a_dim1;
00851 a -= a_offset;
00852
00853
00854
00855
00856 nargs = 13;
00857 nc = 0;
00858 reset = TRUE_;
00859 errmax = 0.f;
00860
00861 i__1 = *nidim;
00862 for (im = 1; im <= i__1; ++im) {
00863 m = idim[im];
00864
00865 i__2 = *nidim;
00866 for (in = 1; in <= i__2; ++in) {
00867 n = idim[in];
00868
00869 ldc = m;
00870 if (ldc < *nmax) {
00871 ++ldc;
00872 }
00873
00874 if (ldc > *nmax) {
00875 goto L100;
00876 }
00877 lcc = ldc * n;
00878 null = n <= 0 || m <= 0;
00879
00880 i__3 = *nidim;
00881 for (ik = 1; ik <= i__3; ++ik) {
00882 k = idim[ik];
00883
00884 for (ica = 1; ica <= 3; ++ica) {
00885 *(unsigned char *)transa = *(unsigned char *)&ich[ica - 1]
00886 ;
00887 trana = *(unsigned char *)transa == 'T' || *(unsigned
00888 char *)transa == 'C';
00889
00890 if (trana) {
00891 ma = k;
00892 na = m;
00893 } else {
00894 ma = m;
00895 na = k;
00896 }
00897
00898 lda = ma;
00899 if (lda < *nmax) {
00900 ++lda;
00901 }
00902
00903 if (lda > *nmax) {
00904 goto L80;
00905 }
00906 laa = lda * na;
00907
00908
00909
00910 cmake_("GE", " ", " ", &ma, &na, &a[a_offset], nmax, &aa[
00911 1], &lda, &reset, &c_b1, (ftnlen)2, (ftnlen)1, (
00912 ftnlen)1);
00913
00914 for (icb = 1; icb <= 3; ++icb) {
00915 *(unsigned char *)transb = *(unsigned char *)&ich[icb
00916 - 1];
00917 tranb = *(unsigned char *)transb == 'T' || *(unsigned
00918 char *)transb == 'C';
00919
00920 if (tranb) {
00921 mb = n;
00922 nb = k;
00923 } else {
00924 mb = k;
00925 nb = n;
00926 }
00927
00928 ldb = mb;
00929 if (ldb < *nmax) {
00930 ++ldb;
00931 }
00932
00933 if (ldb > *nmax) {
00934 goto L70;
00935 }
00936 lbb = ldb * nb;
00937
00938
00939
00940 cmake_("GE", " ", " ", &mb, &nb, &b[b_offset], nmax, &
00941 bb[1], &ldb, &reset, &c_b1, (ftnlen)2, (
00942 ftnlen)1, (ftnlen)1);
00943
00944 i__4 = *nalf;
00945 for (ia = 1; ia <= i__4; ++ia) {
00946 i__5 = ia;
00947 alpha.r = alf[i__5].r, alpha.i = alf[i__5].i;
00948
00949 i__5 = *nbet;
00950 for (ib = 1; ib <= i__5; ++ib) {
00951 i__6 = ib;
00952 beta.r = bet[i__6].r, beta.i = bet[i__6].i;
00953
00954
00955
00956 cmake_("GE", " ", " ", &m, &n, &c__[c_offset],
00957 nmax, &cc[1], &ldc, &reset, &c_b1, (
00958 ftnlen)2, (ftnlen)1, (ftnlen)1);
00959
00960 ++nc;
00961
00962
00963
00964
00965 *(unsigned char *)tranas = *(unsigned char *)
00966 transa;
00967 *(unsigned char *)tranbs = *(unsigned char *)
00968 transb;
00969 ms = m;
00970 ns = n;
00971 ks = k;
00972 als.r = alpha.r, als.i = alpha.i;
00973 i__6 = laa;
00974 for (i__ = 1; i__ <= i__6; ++i__) {
00975 i__7 = i__;
00976 i__8 = i__;
00977 as[i__7].r = aa[i__8].r, as[i__7].i = aa[
00978 i__8].i;
00979
00980 }
00981 ldas = lda;
00982 i__6 = lbb;
00983 for (i__ = 1; i__ <= i__6; ++i__) {
00984 i__7 = i__;
00985 i__8 = i__;
00986 bs[i__7].r = bb[i__8].r, bs[i__7].i = bb[
00987 i__8].i;
00988
00989 }
00990 ldbs = ldb;
00991 bls.r = beta.r, bls.i = beta.i;
00992 i__6 = lcc;
00993 for (i__ = 1; i__ <= i__6; ++i__) {
00994 i__7 = i__;
00995 i__8 = i__;
00996 cs[i__7].r = cc[i__8].r, cs[i__7].i = cc[
00997 i__8].i;
00998
00999 }
01000 ldcs = ldc;
01001
01002
01003
01004 if (*trace) {
01005 io___124.ciunit = *ntra;
01006 s_wsfe(&io___124);
01007 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(
01008 integer));
01009 do_fio(&c__1, sname, (ftnlen)6);
01010 do_fio(&c__1, transa, (ftnlen)1);
01011 do_fio(&c__1, transb, (ftnlen)1);
01012 do_fio(&c__1, (char *)&m, (ftnlen)sizeof(
01013 integer));
01014 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
01015 integer));
01016 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(
01017 integer));
01018 do_fio(&c__2, (char *)&alpha, (ftnlen)
01019 sizeof(real));
01020 do_fio(&c__1, (char *)&lda, (ftnlen)
01021 sizeof(integer));
01022 do_fio(&c__1, (char *)&ldb, (ftnlen)
01023 sizeof(integer));
01024 do_fio(&c__2, (char *)&beta, (ftnlen)
01025 sizeof(real));
01026 do_fio(&c__1, (char *)&ldc, (ftnlen)
01027 sizeof(integer));
01028 e_wsfe();
01029 }
01030 if (*rewi) {
01031 al__1.aerr = 0;
01032 al__1.aunit = *ntra;
01033 f_rew(&al__1);
01034 }
01035 cgemm_(transa, transb, &m, &n, &k, &alpha, &
01036 aa[1], &lda, &bb[1], &ldb, &beta, &cc[
01037 1], &ldc);
01038
01039
01040
01041 if (! infoc_1.ok) {
01042 io___125.ciunit = *nout;
01043 s_wsfe(&io___125);
01044 e_wsfe();
01045 *fatal = TRUE_;
01046 goto L120;
01047 }
01048
01049
01050
01051 isame[0] = *(unsigned char *)transa == *(
01052 unsigned char *)tranas;
01053 isame[1] = *(unsigned char *)transb == *(
01054 unsigned char *)tranbs;
01055 isame[2] = ms == m;
01056 isame[3] = ns == n;
01057 isame[4] = ks == k;
01058 isame[5] = als.r == alpha.r && als.i ==
01059 alpha.i;
01060 isame[6] = lce_(&as[1], &aa[1], &laa);
01061 isame[7] = ldas == lda;
01062 isame[8] = lce_(&bs[1], &bb[1], &lbb);
01063 isame[9] = ldbs == ldb;
01064 isame[10] = bls.r == beta.r && bls.i ==
01065 beta.i;
01066 if (null) {
01067 isame[11] = lce_(&cs[1], &cc[1], &lcc);
01068 } else {
01069 isame[11] = lceres_("GE", " ", &m, &n, &
01070 cs[1], &cc[1], &ldc, (ftnlen)2, (
01071 ftnlen)1);
01072 }
01073 isame[12] = ldcs == ldc;
01074
01075
01076
01077
01078 same = TRUE_;
01079 i__6 = nargs;
01080 for (i__ = 1; i__ <= i__6; ++i__) {
01081 same = same && isame[i__ - 1];
01082 if (! isame[i__ - 1]) {
01083 io___128.ciunit = *nout;
01084 s_wsfe(&io___128);
01085 do_fio(&c__1, (char *)&i__, (ftnlen)
01086 sizeof(integer));
01087 e_wsfe();
01088 }
01089
01090 }
01091 if (! same) {
01092 *fatal = TRUE_;
01093 goto L120;
01094 }
01095
01096 if (! null) {
01097
01098
01099
01100 cmmch_(transa, transb, &m, &n, &k, &alpha,
01101 &a[a_offset], nmax, &b[b_offset],
01102 nmax, &beta, &c__[c_offset],
01103 nmax, &ct[1], &g[1], &cc[1], &ldc,
01104 eps, &err, fatal, nout, &c_true,
01105 (ftnlen)1, (ftnlen)1);
01106 errmax = dmax(errmax,err);
01107
01108
01109 if (*fatal) {
01110 goto L120;
01111 }
01112 }
01113
01114
01115 }
01116
01117
01118 }
01119
01120 L70:
01121 ;
01122 }
01123
01124 L80:
01125 ;
01126 }
01127
01128
01129 }
01130
01131 L100:
01132 ;
01133 }
01134
01135
01136 }
01137
01138
01139
01140 if (errmax < *thresh) {
01141 io___130.ciunit = *nout;
01142 s_wsfe(&io___130);
01143 do_fio(&c__1, sname, (ftnlen)6);
01144 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
01145 e_wsfe();
01146 } else {
01147 io___131.ciunit = *nout;
01148 s_wsfe(&io___131);
01149 do_fio(&c__1, sname, (ftnlen)6);
01150 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
01151 do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real));
01152 e_wsfe();
01153 }
01154 goto L130;
01155
01156 L120:
01157 io___132.ciunit = *nout;
01158 s_wsfe(&io___132);
01159 do_fio(&c__1, sname, (ftnlen)6);
01160 e_wsfe();
01161 io___133.ciunit = *nout;
01162 s_wsfe(&io___133);
01163 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
01164 do_fio(&c__1, sname, (ftnlen)6);
01165 do_fio(&c__1, transa, (ftnlen)1);
01166 do_fio(&c__1, transb, (ftnlen)1);
01167 do_fio(&c__1, (char *)&m, (ftnlen)sizeof(integer));
01168 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01169 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
01170 do_fio(&c__2, (char *)&alpha, (ftnlen)sizeof(real));
01171 do_fio(&c__1, (char *)&lda, (ftnlen)sizeof(integer));
01172 do_fio(&c__1, (char *)&ldb, (ftnlen)sizeof(integer));
01173 do_fio(&c__2, (char *)&beta, (ftnlen)sizeof(real));
01174 do_fio(&c__1, (char *)&ldc, (ftnlen)sizeof(integer));
01175 e_wsfe();
01176
01177 L130:
01178 return 0;
01179
01180
01181
01182
01183 }
01184
01185 int cchk2_(char *sname, real *eps, real *thresh, integer *
01186 nout, integer *ntra, logical *trace, logical *rewi, logical *fatal,
01187 integer *nidim, integer *idim, integer *nalf, complex *alf, integer *
01188 nbet, complex *bet, integer *nmax, complex *a, complex *aa, complex *
01189 as, complex *b, complex *bb, complex *bs, complex *c__, complex *cc,
01190 complex *cs, complex *ct, real *g, ftnlen sname_len)
01191 {
01192
01193
01194 static char ichs[2] = "LR";
01195 static char ichu[2] = "UL";
01196
01197
01198 static char fmt_9995[] = "(1x,i6,\002: \002,a6,\002(\002,2(\002'\002,a1"
01199 ",\002',\002),2(i3,\002,\002),\002(\002,f4.1,\002,\002,f4.1,\002)"
01200 ", A,\002,i3,\002, B,\002,i3,\002,(\002,f4.1,\002,\002,f4.1,\002)"
01201 ", C,\002,i3,\002) .\002)";
01202 static char fmt_9994[] = "(\002 ******* FATAL ERROR - ERROR-EXIT TAKEN O"
01203 "N VALID CALL *\002,\002******\002)";
01204 static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER"
01205 " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)";
01206 static char fmt_9999[] = "(\002 \002,a6,\002 PASSED THE COMPUTATIONAL TE"
01207 "STS (\002,i6,\002 CALL\002,\002S)\002)";
01208 static char fmt_9997[] = "(\002 \002,a6,\002 COMPLETED THE COMPUTATIONAL"
01209 " TESTS (\002,i6,\002 C\002,\002ALLS)\002,/\002 ******* BUT WITH "
01210 "MAXIMUM TEST RATIO\002,f8.2,\002 - SUSPECT *******\002)";
01211 static char fmt_9996[] = "(\002 ******* \002,a6,\002 FAILED ON CALL NUMB"
01212 "ER:\002)";
01213
01214
01215 integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
01216 i__3, i__4, i__5, i__6, i__7;
01217 alist al__1;
01218
01219
01220 integer s_cmp(char *, char *, ftnlen, ftnlen), s_wsfe(cilist *), do_fio(
01221 integer *, char *, ftnlen), e_wsfe(void), f_rew(alist *);
01222
01223
01224 integer i__, m, n, ia, ib, na, nc, im, in, ms, ns, laa, lbb, lda, lcc,
01225 ldb, ldc;
01226 extern logical lce_(complex *, complex *, integer *);
01227 integer ics;
01228 complex als, bls;
01229 integer icu;
01230 real err;
01231 complex beta;
01232 integer ldas, ldbs, ldcs;
01233 logical same;
01234 char side[1];
01235 logical conj, left, null;
01236 char uplo[1];
01237 extern int cmake_(char *, char *, char *, integer *,
01238 integer *, complex *, integer *, complex *, integer *, logical *,
01239 complex *, ftnlen, ftnlen, ftnlen);
01240 complex alpha;
01241 extern int cmmch_(char *, char *, integer *, integer *,
01242 integer *, complex *, complex *, integer *, complex *, integer *,
01243 complex *, complex *, integer *, complex *, real *, complex *,
01244 integer *, real *, real *, logical *, integer *, logical *,
01245 ftnlen, ftnlen), chemm_(char *, char *, integer *, integer *,
01246 complex *, complex *, integer *, complex *, integer *, complex *,
01247 complex *, integer *);
01248 logical isame[13];
01249 char sides[1];
01250 integer nargs;
01251 logical reset;
01252 extern int csymm_(char *, char *, integer *, integer *,
01253 complex *, complex *, integer *, complex *, integer *, complex *,
01254 complex *, integer *);
01255 char uplos[1];
01256 extern logical lceres_(char *, char *, integer *, integer *, complex *,
01257 complex *, integer *, ftnlen, ftnlen);
01258 real errmax;
01259
01260
01261 static cilist io___172 = { 0, 0, 0, fmt_9995, 0 };
01262 static cilist io___173 = { 0, 0, 0, fmt_9994, 0 };
01263 static cilist io___176 = { 0, 0, 0, fmt_9998, 0 };
01264 static cilist io___178 = { 0, 0, 0, fmt_9999, 0 };
01265 static cilist io___179 = { 0, 0, 0, fmt_9997, 0 };
01266 static cilist io___180 = { 0, 0, 0, fmt_9996, 0 };
01267 static cilist io___181 = { 0, 0, 0, fmt_9995, 0 };
01268
01269
01270
01271
01272
01273
01274
01275
01276
01277
01278
01279
01280
01281
01282
01283
01284
01285
01286
01287
01288
01289
01290
01291
01292
01293 --idim;
01294 --alf;
01295 --bet;
01296 --g;
01297 --ct;
01298 --cs;
01299 --cc;
01300 c_dim1 = *nmax;
01301 c_offset = 1 + c_dim1;
01302 c__ -= c_offset;
01303 --bs;
01304 --bb;
01305 b_dim1 = *nmax;
01306 b_offset = 1 + b_dim1;
01307 b -= b_offset;
01308 --as;
01309 --aa;
01310 a_dim1 = *nmax;
01311 a_offset = 1 + a_dim1;
01312 a -= a_offset;
01313
01314
01315
01316 conj = s_cmp(sname + 1, "HE", (ftnlen)2, (ftnlen)2) == 0;
01317
01318 nargs = 12;
01319 nc = 0;
01320 reset = TRUE_;
01321 errmax = 0.f;
01322
01323 i__1 = *nidim;
01324 for (im = 1; im <= i__1; ++im) {
01325 m = idim[im];
01326
01327 i__2 = *nidim;
01328 for (in = 1; in <= i__2; ++in) {
01329 n = idim[in];
01330
01331 ldc = m;
01332 if (ldc < *nmax) {
01333 ++ldc;
01334 }
01335
01336 if (ldc > *nmax) {
01337 goto L90;
01338 }
01339 lcc = ldc * n;
01340 null = n <= 0 || m <= 0;
01341
01342 ldb = m;
01343 if (ldb < *nmax) {
01344 ++ldb;
01345 }
01346
01347 if (ldb > *nmax) {
01348 goto L90;
01349 }
01350 lbb = ldb * n;
01351
01352
01353
01354 cmake_("GE", " ", " ", &m, &n, &b[b_offset], nmax, &bb[1], &ldb, &
01355 reset, &c_b1, (ftnlen)2, (ftnlen)1, (ftnlen)1);
01356
01357 for (ics = 1; ics <= 2; ++ics) {
01358 *(unsigned char *)side = *(unsigned char *)&ichs[ics - 1];
01359 left = *(unsigned char *)side == 'L';
01360
01361 if (left) {
01362 na = m;
01363 } else {
01364 na = n;
01365 }
01366
01367 lda = na;
01368 if (lda < *nmax) {
01369 ++lda;
01370 }
01371
01372 if (lda > *nmax) {
01373 goto L80;
01374 }
01375 laa = lda * na;
01376
01377 for (icu = 1; icu <= 2; ++icu) {
01378 *(unsigned char *)uplo = *(unsigned char *)&ichu[icu - 1];
01379
01380
01381
01382 cmake_(sname + 1, uplo, " ", &na, &na, &a[a_offset], nmax,
01383 &aa[1], &lda, &reset, &c_b1, (ftnlen)2, (ftnlen)
01384 1, (ftnlen)1);
01385
01386 i__3 = *nalf;
01387 for (ia = 1; ia <= i__3; ++ia) {
01388 i__4 = ia;
01389 alpha.r = alf[i__4].r, alpha.i = alf[i__4].i;
01390
01391 i__4 = *nbet;
01392 for (ib = 1; ib <= i__4; ++ib) {
01393 i__5 = ib;
01394 beta.r = bet[i__5].r, beta.i = bet[i__5].i;
01395
01396
01397
01398 cmake_("GE", " ", " ", &m, &n, &c__[c_offset],
01399 nmax, &cc[1], &ldc, &reset, &c_b1, (
01400 ftnlen)2, (ftnlen)1, (ftnlen)1);
01401
01402 ++nc;
01403
01404
01405
01406
01407 *(unsigned char *)sides = *(unsigned char *)side;
01408 *(unsigned char *)uplos = *(unsigned char *)uplo;
01409 ms = m;
01410 ns = n;
01411 als.r = alpha.r, als.i = alpha.i;
01412 i__5 = laa;
01413 for (i__ = 1; i__ <= i__5; ++i__) {
01414 i__6 = i__;
01415 i__7 = i__;
01416 as[i__6].r = aa[i__7].r, as[i__6].i = aa[i__7]
01417 .i;
01418
01419 }
01420 ldas = lda;
01421 i__5 = lbb;
01422 for (i__ = 1; i__ <= i__5; ++i__) {
01423 i__6 = i__;
01424 i__7 = i__;
01425 bs[i__6].r = bb[i__7].r, bs[i__6].i = bb[i__7]
01426 .i;
01427
01428 }
01429 ldbs = ldb;
01430 bls.r = beta.r, bls.i = beta.i;
01431 i__5 = lcc;
01432 for (i__ = 1; i__ <= i__5; ++i__) {
01433 i__6 = i__;
01434 i__7 = i__;
01435 cs[i__6].r = cc[i__7].r, cs[i__6].i = cc[i__7]
01436 .i;
01437
01438 }
01439 ldcs = ldc;
01440
01441
01442
01443 if (*trace) {
01444 io___172.ciunit = *ntra;
01445 s_wsfe(&io___172);
01446 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(
01447 integer));
01448 do_fio(&c__1, sname, (ftnlen)6);
01449 do_fio(&c__1, side, (ftnlen)1);
01450 do_fio(&c__1, uplo, (ftnlen)1);
01451 do_fio(&c__1, (char *)&m, (ftnlen)sizeof(
01452 integer));
01453 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
01454 integer));
01455 do_fio(&c__2, (char *)&alpha, (ftnlen)sizeof(
01456 real));
01457 do_fio(&c__1, (char *)&lda, (ftnlen)sizeof(
01458 integer));
01459 do_fio(&c__1, (char *)&ldb, (ftnlen)sizeof(
01460 integer));
01461 do_fio(&c__2, (char *)&beta, (ftnlen)sizeof(
01462 real));
01463 do_fio(&c__1, (char *)&ldc, (ftnlen)sizeof(
01464 integer));
01465 e_wsfe();
01466 }
01467 if (*rewi) {
01468 al__1.aerr = 0;
01469 al__1.aunit = *ntra;
01470 f_rew(&al__1);
01471 }
01472 if (conj) {
01473 chemm_(side, uplo, &m, &n, &alpha, &aa[1], &
01474 lda, &bb[1], &ldb, &beta, &cc[1], &
01475 ldc);
01476 } else {
01477 csymm_(side, uplo, &m, &n, &alpha, &aa[1], &
01478 lda, &bb[1], &ldb, &beta, &cc[1], &
01479 ldc);
01480 }
01481
01482
01483
01484 if (! infoc_1.ok) {
01485 io___173.ciunit = *nout;
01486 s_wsfe(&io___173);
01487 e_wsfe();
01488 *fatal = TRUE_;
01489 goto L110;
01490 }
01491
01492
01493
01494 isame[0] = *(unsigned char *)sides == *(unsigned
01495 char *)side;
01496 isame[1] = *(unsigned char *)uplos == *(unsigned
01497 char *)uplo;
01498 isame[2] = ms == m;
01499 isame[3] = ns == n;
01500 isame[4] = als.r == alpha.r && als.i == alpha.i;
01501 isame[5] = lce_(&as[1], &aa[1], &laa);
01502 isame[6] = ldas == lda;
01503 isame[7] = lce_(&bs[1], &bb[1], &lbb);
01504 isame[8] = ldbs == ldb;
01505 isame[9] = bls.r == beta.r && bls.i == beta.i;
01506 if (null) {
01507 isame[10] = lce_(&cs[1], &cc[1], &lcc);
01508 } else {
01509 isame[10] = lceres_("GE", " ", &m, &n, &cs[1],
01510 &cc[1], &ldc, (ftnlen)2, (ftnlen)1);
01511 }
01512 isame[11] = ldcs == ldc;
01513
01514
01515
01516
01517 same = TRUE_;
01518 i__5 = nargs;
01519 for (i__ = 1; i__ <= i__5; ++i__) {
01520 same = same && isame[i__ - 1];
01521 if (! isame[i__ - 1]) {
01522 io___176.ciunit = *nout;
01523 s_wsfe(&io___176);
01524 do_fio(&c__1, (char *)&i__, (ftnlen)
01525 sizeof(integer));
01526 e_wsfe();
01527 }
01528
01529 }
01530 if (! same) {
01531 *fatal = TRUE_;
01532 goto L110;
01533 }
01534
01535 if (! null) {
01536
01537
01538
01539 if (left) {
01540 cmmch_("N", "N", &m, &n, &m, &alpha, &a[
01541 a_offset], nmax, &b[b_offset],
01542 nmax, &beta, &c__[c_offset], nmax,
01543 &ct[1], &g[1], &cc[1], &ldc, eps,
01544 &err, fatal, nout, &c_true, (
01545 ftnlen)1, (ftnlen)1);
01546 } else {
01547 cmmch_("N", "N", &m, &n, &n, &alpha, &b[
01548 b_offset], nmax, &a[a_offset],
01549 nmax, &beta, &c__[c_offset], nmax,
01550 &ct[1], &g[1], &cc[1], &ldc, eps,
01551 &err, fatal, nout, &c_true, (
01552 ftnlen)1, (ftnlen)1);
01553 }
01554 errmax = dmax(errmax,err);
01555
01556
01557 if (*fatal) {
01558 goto L110;
01559 }
01560 }
01561
01562
01563 }
01564
01565
01566 }
01567
01568
01569 }
01570
01571 L80:
01572 ;
01573 }
01574
01575 L90:
01576 ;
01577 }
01578
01579
01580 }
01581
01582
01583
01584 if (errmax < *thresh) {
01585 io___178.ciunit = *nout;
01586 s_wsfe(&io___178);
01587 do_fio(&c__1, sname, (ftnlen)6);
01588 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
01589 e_wsfe();
01590 } else {
01591 io___179.ciunit = *nout;
01592 s_wsfe(&io___179);
01593 do_fio(&c__1, sname, (ftnlen)6);
01594 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
01595 do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real));
01596 e_wsfe();
01597 }
01598 goto L120;
01599
01600 L110:
01601 io___180.ciunit = *nout;
01602 s_wsfe(&io___180);
01603 do_fio(&c__1, sname, (ftnlen)6);
01604 e_wsfe();
01605 io___181.ciunit = *nout;
01606 s_wsfe(&io___181);
01607 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
01608 do_fio(&c__1, sname, (ftnlen)6);
01609 do_fio(&c__1, side, (ftnlen)1);
01610 do_fio(&c__1, uplo, (ftnlen)1);
01611 do_fio(&c__1, (char *)&m, (ftnlen)sizeof(integer));
01612 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01613 do_fio(&c__2, (char *)&alpha, (ftnlen)sizeof(real));
01614 do_fio(&c__1, (char *)&lda, (ftnlen)sizeof(integer));
01615 do_fio(&c__1, (char *)&ldb, (ftnlen)sizeof(integer));
01616 do_fio(&c__2, (char *)&beta, (ftnlen)sizeof(real));
01617 do_fio(&c__1, (char *)&ldc, (ftnlen)sizeof(integer));
01618 e_wsfe();
01619
01620 L120:
01621 return 0;
01622
01623
01624
01625
01626 }
01627
01628 int cchk3_(char *sname, real *eps, real *thresh, integer *
01629 nout, integer *ntra, logical *trace, logical *rewi, logical *fatal,
01630 integer *nidim, integer *idim, integer *nalf, complex *alf, integer *
01631 nmax, complex *a, complex *aa, complex *as, complex *b, complex *bb,
01632 complex *bs, complex *ct, real *g, complex *c__, ftnlen sname_len)
01633 {
01634
01635
01636 static char ichu[2] = "UL";
01637 static char icht[3] = "NTC";
01638 static char ichd[2] = "UN";
01639 static char ichs[2] = "LR";
01640
01641
01642 static char fmt_9995[] = "(1x,i6,\002: \002,a6,\002(\002,4(\002'\002,a1"
01643 ",\002',\002),2(i3,\002,\002),\002(\002,f4.1,\002,\002,f4.1,\002)"
01644 ", A,\002,i3,\002, B,\002,i3,\002) \002,\002 .\002)";
01645 static char fmt_9994[] = "(\002 ******* FATAL ERROR - ERROR-EXIT TAKEN O"
01646 "N VALID CALL *\002,\002******\002)";
01647 static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER"
01648 " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)";
01649 static char fmt_9999[] = "(\002 \002,a6,\002 PASSED THE COMPUTATIONAL TE"
01650 "STS (\002,i6,\002 CALL\002,\002S)\002)";
01651 static char fmt_9997[] = "(\002 \002,a6,\002 COMPLETED THE COMPUTATIONAL"
01652 " TESTS (\002,i6,\002 C\002,\002ALLS)\002,/\002 ******* BUT WITH "
01653 "MAXIMUM TEST RATIO\002,f8.2,\002 - SUSPECT *******\002)";
01654 static char fmt_9996[] = "(\002 ******* \002,a6,\002 FAILED ON CALL NUMB"
01655 "ER:\002)";
01656
01657
01658 integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
01659 i__3, i__4, i__5, i__6, i__7;
01660 complex q__1;
01661 alist al__1;
01662
01663
01664 integer s_cmp(char *, char *, ftnlen, ftnlen), s_wsfe(cilist *), do_fio(
01665 integer *, char *, ftnlen), e_wsfe(void), f_rew(alist *);
01666
01667
01668 integer i__, j, m, n, ia, na, nc, im, in, ms, ns, laa, icd, lbb, lda, ldb;
01669 extern logical lce_(complex *, complex *, integer *);
01670 integer ics;
01671 complex als;
01672 integer ict, icu;
01673 real err;
01674 char diag[1];
01675 integer ldas, ldbs;
01676 logical same;
01677 char side[1];
01678 logical left, null;
01679 char uplo[1];
01680 extern int cmake_(char *, char *, char *, integer *,
01681 integer *, complex *, integer *, complex *, integer *, logical *,
01682 complex *, ftnlen, ftnlen, ftnlen);
01683 complex alpha;
01684 char diags[1];
01685 extern int cmmch_(char *, char *, integer *, integer *,
01686 integer *, complex *, complex *, integer *, complex *, integer *,
01687 complex *, complex *, integer *, complex *, real *, complex *,
01688 integer *, real *, real *, logical *, integer *, logical *,
01689 ftnlen, ftnlen);
01690 logical isame[13];
01691 char sides[1];
01692 integer nargs;
01693 logical reset;
01694 extern int ctrmm_(char *, char *, char *, char *,
01695 integer *, integer *, complex *, complex *, integer *, complex *,
01696 integer *), ctrsm_(char *, char *,
01697 char *, char *, integer *, integer *, complex *, complex *,
01698 integer *, complex *, integer *);
01699 char uplos[1];
01700 extern logical lceres_(char *, char *, integer *, integer *, complex *,
01701 complex *, integer *, ftnlen, ftnlen);
01702 char tranas[1], transa[1];
01703 real errmax;
01704
01705
01706 static cilist io___222 = { 0, 0, 0, fmt_9995, 0 };
01707 static cilist io___223 = { 0, 0, 0, fmt_9995, 0 };
01708 static cilist io___224 = { 0, 0, 0, fmt_9994, 0 };
01709 static cilist io___227 = { 0, 0, 0, fmt_9998, 0 };
01710 static cilist io___229 = { 0, 0, 0, fmt_9999, 0 };
01711 static cilist io___230 = { 0, 0, 0, fmt_9997, 0 };
01712 static cilist io___231 = { 0, 0, 0, fmt_9996, 0 };
01713 static cilist io___232 = { 0, 0, 0, fmt_9995, 0 };
01714
01715
01716
01717
01718
01719
01720
01721
01722
01723
01724
01725
01726
01727
01728
01729
01730
01731
01732
01733
01734
01735
01736
01737
01738
01739 --idim;
01740 --alf;
01741 c_dim1 = *nmax;
01742 c_offset = 1 + c_dim1;
01743 c__ -= c_offset;
01744 --g;
01745 --ct;
01746 --bs;
01747 --bb;
01748 b_dim1 = *nmax;
01749 b_offset = 1 + b_dim1;
01750 b -= b_offset;
01751 --as;
01752 --aa;
01753 a_dim1 = *nmax;
01754 a_offset = 1 + a_dim1;
01755 a -= a_offset;
01756
01757
01758
01759
01760 nargs = 11;
01761 nc = 0;
01762 reset = TRUE_;
01763 errmax = 0.f;
01764
01765 i__1 = *nmax;
01766 for (j = 1; j <= i__1; ++j) {
01767 i__2 = *nmax;
01768 for (i__ = 1; i__ <= i__2; ++i__) {
01769 i__3 = i__ + j * c_dim1;
01770 c__[i__3].r = 0.f, c__[i__3].i = 0.f;
01771
01772 }
01773
01774 }
01775
01776 i__1 = *nidim;
01777 for (im = 1; im <= i__1; ++im) {
01778 m = idim[im];
01779
01780 i__2 = *nidim;
01781 for (in = 1; in <= i__2; ++in) {
01782 n = idim[in];
01783
01784 ldb = m;
01785 if (ldb < *nmax) {
01786 ++ldb;
01787 }
01788
01789 if (ldb > *nmax) {
01790 goto L130;
01791 }
01792 lbb = ldb * n;
01793 null = m <= 0 || n <= 0;
01794
01795 for (ics = 1; ics <= 2; ++ics) {
01796 *(unsigned char *)side = *(unsigned char *)&ichs[ics - 1];
01797 left = *(unsigned char *)side == 'L';
01798 if (left) {
01799 na = m;
01800 } else {
01801 na = n;
01802 }
01803
01804 lda = na;
01805 if (lda < *nmax) {
01806 ++lda;
01807 }
01808
01809 if (lda > *nmax) {
01810 goto L130;
01811 }
01812 laa = lda * na;
01813
01814 for (icu = 1; icu <= 2; ++icu) {
01815 *(unsigned char *)uplo = *(unsigned char *)&ichu[icu - 1];
01816
01817 for (ict = 1; ict <= 3; ++ict) {
01818 *(unsigned char *)transa = *(unsigned char *)&icht[
01819 ict - 1];
01820
01821 for (icd = 1; icd <= 2; ++icd) {
01822 *(unsigned char *)diag = *(unsigned char *)&ichd[
01823 icd - 1];
01824
01825 i__3 = *nalf;
01826 for (ia = 1; ia <= i__3; ++ia) {
01827 i__4 = ia;
01828 alpha.r = alf[i__4].r, alpha.i = alf[i__4].i;
01829
01830
01831
01832 cmake_("TR", uplo, diag, &na, &na, &a[
01833 a_offset], nmax, &aa[1], &lda, &reset,
01834 &c_b1, (ftnlen)2, (ftnlen)1, (ftnlen)
01835 1);
01836
01837
01838
01839 cmake_("GE", " ", " ", &m, &n, &b[b_offset],
01840 nmax, &bb[1], &ldb, &reset, &c_b1, (
01841 ftnlen)2, (ftnlen)1, (ftnlen)1);
01842
01843 ++nc;
01844
01845
01846
01847
01848 *(unsigned char *)sides = *(unsigned char *)
01849 side;
01850 *(unsigned char *)uplos = *(unsigned char *)
01851 uplo;
01852 *(unsigned char *)tranas = *(unsigned char *)
01853 transa;
01854 *(unsigned char *)diags = *(unsigned char *)
01855 diag;
01856 ms = m;
01857 ns = n;
01858 als.r = alpha.r, als.i = alpha.i;
01859 i__4 = laa;
01860 for (i__ = 1; i__ <= i__4; ++i__) {
01861 i__5 = i__;
01862 i__6 = i__;
01863 as[i__5].r = aa[i__6].r, as[i__5].i = aa[
01864 i__6].i;
01865
01866 }
01867 ldas = lda;
01868 i__4 = lbb;
01869 for (i__ = 1; i__ <= i__4; ++i__) {
01870 i__5 = i__;
01871 i__6 = i__;
01872 bs[i__5].r = bb[i__6].r, bs[i__5].i = bb[
01873 i__6].i;
01874
01875 }
01876 ldbs = ldb;
01877
01878
01879
01880 if (s_cmp(sname + 3, "MM", (ftnlen)2, (ftnlen)
01881 2) == 0) {
01882 if (*trace) {
01883 io___222.ciunit = *ntra;
01884 s_wsfe(&io___222);
01885 do_fio(&c__1, (char *)&nc, (ftnlen)
01886 sizeof(integer));
01887 do_fio(&c__1, sname, (ftnlen)6);
01888 do_fio(&c__1, side, (ftnlen)1);
01889 do_fio(&c__1, uplo, (ftnlen)1);
01890 do_fio(&c__1, transa, (ftnlen)1);
01891 do_fio(&c__1, diag, (ftnlen)1);
01892 do_fio(&c__1, (char *)&m, (ftnlen)
01893 sizeof(integer));
01894 do_fio(&c__1, (char *)&n, (ftnlen)
01895 sizeof(integer));
01896 do_fio(&c__2, (char *)&alpha, (ftnlen)
01897 sizeof(real));
01898 do_fio(&c__1, (char *)&lda, (ftnlen)
01899 sizeof(integer));
01900 do_fio(&c__1, (char *)&ldb, (ftnlen)
01901 sizeof(integer));
01902 e_wsfe();
01903 }
01904 if (*rewi) {
01905 al__1.aerr = 0;
01906 al__1.aunit = *ntra;
01907 f_rew(&al__1);
01908 }
01909 ctrmm_(side, uplo, transa, diag, &m, &n, &
01910 alpha, &aa[1], &lda, &bb[1], &ldb);
01911 } else if (s_cmp(sname + 3, "SM", (ftnlen)2, (
01912 ftnlen)2) == 0) {
01913 if (*trace) {
01914 io___223.ciunit = *ntra;
01915 s_wsfe(&io___223);
01916 do_fio(&c__1, (char *)&nc, (ftnlen)
01917 sizeof(integer));
01918 do_fio(&c__1, sname, (ftnlen)6);
01919 do_fio(&c__1, side, (ftnlen)1);
01920 do_fio(&c__1, uplo, (ftnlen)1);
01921 do_fio(&c__1, transa, (ftnlen)1);
01922 do_fio(&c__1, diag, (ftnlen)1);
01923 do_fio(&c__1, (char *)&m, (ftnlen)
01924 sizeof(integer));
01925 do_fio(&c__1, (char *)&n, (ftnlen)
01926 sizeof(integer));
01927 do_fio(&c__2, (char *)&alpha, (ftnlen)
01928 sizeof(real));
01929 do_fio(&c__1, (char *)&lda, (ftnlen)
01930 sizeof(integer));
01931 do_fio(&c__1, (char *)&ldb, (ftnlen)
01932 sizeof(integer));
01933 e_wsfe();
01934 }
01935 if (*rewi) {
01936 al__1.aerr = 0;
01937 al__1.aunit = *ntra;
01938 f_rew(&al__1);
01939 }
01940 ctrsm_(side, uplo, transa, diag, &m, &n, &
01941 alpha, &aa[1], &lda, &bb[1], &ldb);
01942 }
01943
01944
01945
01946 if (! infoc_1.ok) {
01947 io___224.ciunit = *nout;
01948 s_wsfe(&io___224);
01949 e_wsfe();
01950 *fatal = TRUE_;
01951 goto L150;
01952 }
01953
01954
01955
01956 isame[0] = *(unsigned char *)sides == *(
01957 unsigned char *)side;
01958 isame[1] = *(unsigned char *)uplos == *(
01959 unsigned char *)uplo;
01960 isame[2] = *(unsigned char *)tranas == *(
01961 unsigned char *)transa;
01962 isame[3] = *(unsigned char *)diags == *(
01963 unsigned char *)diag;
01964 isame[4] = ms == m;
01965 isame[5] = ns == n;
01966 isame[6] = als.r == alpha.r && als.i ==
01967 alpha.i;
01968 isame[7] = lce_(&as[1], &aa[1], &laa);
01969 isame[8] = ldas == lda;
01970 if (null) {
01971 isame[9] = lce_(&bs[1], &bb[1], &lbb);
01972 } else {
01973 isame[9] = lceres_("GE", " ", &m, &n, &bs[
01974 1], &bb[1], &ldb, (ftnlen)2, (
01975 ftnlen)1);
01976 }
01977 isame[10] = ldbs == ldb;
01978
01979
01980
01981
01982 same = TRUE_;
01983 i__4 = nargs;
01984 for (i__ = 1; i__ <= i__4; ++i__) {
01985 same = same && isame[i__ - 1];
01986 if (! isame[i__ - 1]) {
01987 io___227.ciunit = *nout;
01988 s_wsfe(&io___227);
01989 do_fio(&c__1, (char *)&i__, (ftnlen)
01990 sizeof(integer));
01991 e_wsfe();
01992 }
01993
01994 }
01995 if (! same) {
01996 *fatal = TRUE_;
01997 goto L150;
01998 }
01999
02000 if (! null) {
02001 if (s_cmp(sname + 3, "MM", (ftnlen)2, (
02002 ftnlen)2) == 0) {
02003
02004
02005
02006 if (left) {
02007 cmmch_(transa, "N", &m, &n, &m, &
02008 alpha, &a[a_offset], nmax,
02009 &b[b_offset], nmax, &
02010 c_b1, &c__[c_offset],
02011 nmax, &ct[1], &g[1], &bb[
02012 1], &ldb, eps, &err,
02013 fatal, nout, &c_true, (
02014 ftnlen)1, (ftnlen)1);
02015 } else {
02016 cmmch_("N", transa, &m, &n, &n, &
02017 alpha, &b[b_offset], nmax,
02018 &a[a_offset], nmax, &
02019 c_b1, &c__[c_offset],
02020 nmax, &ct[1], &g[1], &bb[
02021 1], &ldb, eps, &err,
02022 fatal, nout, &c_true, (
02023 ftnlen)1, (ftnlen)1);
02024 }
02025 } else if (s_cmp(sname + 3, "SM", (ftnlen)
02026 2, (ftnlen)2) == 0) {
02027
02028
02029
02030
02031 i__4 = n;
02032 for (j = 1; j <= i__4; ++j) {
02033 i__5 = m;
02034 for (i__ = 1; i__ <= i__5; ++i__)
02035 {
02036 i__6 = i__ + j * c_dim1;
02037 i__7 = i__ + (j - 1) * ldb;
02038 c__[i__6].r = bb[i__7].r, c__[i__6].i = bb[i__7].i;
02039 i__6 = i__ + (j - 1) * ldb;
02040 i__7 = i__ + j * b_dim1;
02041 q__1.r = alpha.r * b[i__7].r - alpha.i * b[i__7].i,
02042 q__1.i = alpha.r * b[i__7].i + alpha.i * b[
02043 i__7].r;
02044 bb[i__6].r = q__1.r, bb[i__6].i = q__1.i;
02045
02046 }
02047
02048 }
02049
02050 if (left) {
02051 cmmch_(transa, "N", &m, &n, &m, &
02052 c_b2, &a[a_offset], nmax,
02053 &c__[c_offset], nmax, &
02054 c_b1, &b[b_offset], nmax,
02055 &ct[1], &g[1], &bb[1], &
02056 ldb, eps, &err, fatal,
02057 nout, &c_false, (ftnlen)1,
02058 (ftnlen)1);
02059 } else {
02060 cmmch_("N", transa, &m, &n, &n, &
02061 c_b2, &c__[c_offset],
02062 nmax, &a[a_offset], nmax,
02063 &c_b1, &b[b_offset], nmax,
02064 &ct[1], &g[1], &bb[1], &
02065 ldb, eps, &err, fatal,
02066 nout, &c_false, (ftnlen)1,
02067 (ftnlen)1);
02068 }
02069 }
02070 errmax = dmax(errmax,err);
02071
02072
02073 if (*fatal) {
02074 goto L150;
02075 }
02076 }
02077
02078
02079 }
02080
02081
02082 }
02083
02084
02085 }
02086
02087
02088 }
02089
02090
02091 }
02092
02093 L130:
02094 ;
02095 }
02096
02097
02098 }
02099
02100
02101
02102 if (errmax < *thresh) {
02103 io___229.ciunit = *nout;
02104 s_wsfe(&io___229);
02105 do_fio(&c__1, sname, (ftnlen)6);
02106 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
02107 e_wsfe();
02108 } else {
02109 io___230.ciunit = *nout;
02110 s_wsfe(&io___230);
02111 do_fio(&c__1, sname, (ftnlen)6);
02112 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
02113 do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real));
02114 e_wsfe();
02115 }
02116 goto L160;
02117
02118 L150:
02119 io___231.ciunit = *nout;
02120 s_wsfe(&io___231);
02121 do_fio(&c__1, sname, (ftnlen)6);
02122 e_wsfe();
02123 io___232.ciunit = *nout;
02124 s_wsfe(&io___232);
02125 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
02126 do_fio(&c__1, sname, (ftnlen)6);
02127 do_fio(&c__1, side, (ftnlen)1);
02128 do_fio(&c__1, uplo, (ftnlen)1);
02129 do_fio(&c__1, transa, (ftnlen)1);
02130 do_fio(&c__1, diag, (ftnlen)1);
02131 do_fio(&c__1, (char *)&m, (ftnlen)sizeof(integer));
02132 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02133 do_fio(&c__2, (char *)&alpha, (ftnlen)sizeof(real));
02134 do_fio(&c__1, (char *)&lda, (ftnlen)sizeof(integer));
02135 do_fio(&c__1, (char *)&ldb, (ftnlen)sizeof(integer));
02136 e_wsfe();
02137
02138 L160:
02139 return 0;
02140
02141
02142
02143
02144 }
02145
02146 int cchk4_(char *sname, real *eps, real *thresh, integer *
02147 nout, integer *ntra, logical *trace, logical *rewi, logical *fatal,
02148 integer *nidim, integer *idim, integer *nalf, complex *alf, integer *
02149 nbet, complex *bet, integer *nmax, complex *a, complex *aa, complex *
02150 as, complex *b, complex *bb, complex *bs, complex *c__, complex *cc,
02151 complex *cs, complex *ct, real *g, ftnlen sname_len)
02152 {
02153
02154
02155 static char icht[2] = "NC";
02156 static char ichu[2] = "UL";
02157
02158
02159 static char fmt_9994[] = "(1x,i6,\002: \002,a6,\002(\002,2(\002'\002,a1"
02160 ",\002',\002),2(i3,\002,\002),f4.1,\002, A,\002,i3,\002,\002,f4.1,"
02161 "\002, C,\002,i3,\002) \002,\002 .\002)";
02162 static char fmt_9993[] = "(1x,i6,\002: \002,a6,\002(\002,2(\002'\002,a1"
02163 ",\002',\002),2(i3,\002,\002),\002(\002,f4.1,\002,\002,f4.1,\002)"
02164 " , A,\002,i3,\002,(\002,f4.1,\002,\002,f4.1,\002), C,\002,i3,"
02165 "\002) .\002)";
02166 static char fmt_9992[] = "(\002 ******* FATAL ERROR - ERROR-EXIT TAKEN O"
02167 "N VALID CALL *\002,\002******\002)";
02168 static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER"
02169 " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)";
02170 static char fmt_9999[] = "(\002 \002,a6,\002 PASSED THE COMPUTATIONAL TE"
02171 "STS (\002,i6,\002 CALL\002,\002S)\002)";
02172 static char fmt_9997[] = "(\002 \002,a6,\002 COMPLETED THE COMPUTATIONAL"
02173 " TESTS (\002,i6,\002 C\002,\002ALLS)\002,/\002 ******* BUT WITH "
02174 "MAXIMUM TEST RATIO\002,f8.2,\002 - SUSPECT *******\002)";
02175 static char fmt_9995[] = "(\002 THESE ARE THE RESULTS FOR COLUMN"
02176 " \002,i3)";
02177 static char fmt_9996[] = "(\002 ******* \002,a6,\002 FAILED ON CALL NUMB"
02178 "ER:\002)";
02179
02180
02181 integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, i__1, i__2,
02182 i__3, i__4, i__5, i__6, i__7;
02183 complex q__1;
02184 alist al__1;
02185
02186
02187 integer s_cmp(char *, char *, ftnlen, ftnlen), s_wsfe(cilist *), do_fio(
02188 integer *, char *, ftnlen), e_wsfe(void), f_rew(alist *);
02189
02190
02191 integer i__, j, k, n, ia, ib, jc, ma, na, nc, ik, in, jj, lj, ks, ns, laa,
02192 lda, lcc, ldc;
02193 extern logical lce_(complex *, complex *, integer *);
02194 complex als;
02195 integer ict, icu;
02196 real err;
02197 complex beta;
02198 integer ldas, ldcs;
02199 logical same, conj;
02200 complex bets;
02201 real rals;
02202 logical tran, null;
02203 char uplo[1];
02204 extern int cmake_(char *, char *, char *, integer *,
02205 integer *, complex *, integer *, complex *, integer *, logical *,
02206 complex *, ftnlen, ftnlen, ftnlen);
02207 complex alpha;
02208 extern int cmmch_(char *, char *, integer *, integer *,
02209 integer *, complex *, complex *, integer *, complex *, integer *,
02210 complex *, complex *, integer *, complex *, real *, complex *,
02211 integer *, real *, real *, logical *, integer *, logical *,
02212 ftnlen, ftnlen), cherk_(char *, char *, integer *, integer *,
02213 real *, complex *, integer *, real *, complex *, integer *);
02214 real rbeta;
02215 logical isame[13];
02216 integer nargs;
02217 real rbets;
02218 logical reset;
02219 char trans[1];
02220 logical upper;
02221 extern int csyrk_(char *, char *, integer *, integer *,
02222 complex *, complex *, integer *, complex *, complex *, integer *);
02223 char uplos[1];
02224 real ralpha;
02225 extern logical lceres_(char *, char *, integer *, integer *, complex *,
02226 complex *, integer *, ftnlen, ftnlen);
02227 real errmax;
02228 char transs[1], transt[1];
02229
02230
02231 static cilist io___274 = { 0, 0, 0, fmt_9994, 0 };
02232 static cilist io___275 = { 0, 0, 0, fmt_9993, 0 };
02233 static cilist io___276 = { 0, 0, 0, fmt_9992, 0 };
02234 static cilist io___279 = { 0, 0, 0, fmt_9998, 0 };
02235 static cilist io___286 = { 0, 0, 0, fmt_9999, 0 };
02236 static cilist io___287 = { 0, 0, 0, fmt_9997, 0 };
02237 static cilist io___288 = { 0, 0, 0, fmt_9995, 0 };
02238 static cilist io___289 = { 0, 0, 0, fmt_9996, 0 };
02239 static cilist io___290 = { 0, 0, 0, fmt_9994, 0 };
02240 static cilist io___291 = { 0, 0, 0, fmt_9993, 0 };
02241
02242
02243
02244
02245
02246
02247
02248
02249
02250
02251
02252
02253
02254
02255
02256
02257
02258
02259
02260
02261
02262
02263
02264
02265
02266 --idim;
02267 --alf;
02268 --bet;
02269 --g;
02270 --ct;
02271 --cs;
02272 --cc;
02273 c_dim1 = *nmax;
02274 c_offset = 1 + c_dim1;
02275 c__ -= c_offset;
02276 --bs;
02277 --bb;
02278 b_dim1 = *nmax;
02279 b_offset = 1 + b_dim1;
02280 b -= b_offset;
02281 --as;
02282 --aa;
02283 a_dim1 = *nmax;
02284 a_offset = 1 + a_dim1;
02285 a -= a_offset;
02286
02287
02288
02289 conj = s_cmp(sname + 1, "HE", (ftnlen)2, (ftnlen)2) == 0;
02290
02291 nargs = 10;
02292 nc = 0;
02293 reset = TRUE_;
02294 errmax = 0.f;
02295
02296 i__1 = *nidim;
02297 for (in = 1; in <= i__1; ++in) {
02298 n = idim[in];
02299
02300 ldc = n;
02301 if (ldc < *nmax) {
02302 ++ldc;
02303 }
02304
02305 if (ldc > *nmax) {
02306 goto L100;
02307 }
02308 lcc = ldc * n;
02309
02310 i__2 = *nidim;
02311 for (ik = 1; ik <= i__2; ++ik) {
02312 k = idim[ik];
02313
02314 for (ict = 1; ict <= 2; ++ict) {
02315 *(unsigned char *)trans = *(unsigned char *)&icht[ict - 1];
02316 tran = *(unsigned char *)trans == 'C';
02317 if (tran && ! conj) {
02318 *(unsigned char *)trans = 'T';
02319 }
02320 if (tran) {
02321 ma = k;
02322 na = n;
02323 } else {
02324 ma = n;
02325 na = k;
02326 }
02327
02328 lda = ma;
02329 if (lda < *nmax) {
02330 ++lda;
02331 }
02332
02333 if (lda > *nmax) {
02334 goto L80;
02335 }
02336 laa = lda * na;
02337
02338
02339
02340 cmake_("GE", " ", " ", &ma, &na, &a[a_offset], nmax, &aa[1], &
02341 lda, &reset, &c_b1, (ftnlen)2, (ftnlen)1, (ftnlen)1);
02342
02343 for (icu = 1; icu <= 2; ++icu) {
02344 *(unsigned char *)uplo = *(unsigned char *)&ichu[icu - 1];
02345 upper = *(unsigned char *)uplo == 'U';
02346
02347 i__3 = *nalf;
02348 for (ia = 1; ia <= i__3; ++ia) {
02349 i__4 = ia;
02350 alpha.r = alf[i__4].r, alpha.i = alf[i__4].i;
02351 if (conj) {
02352 ralpha = alpha.r;
02353 q__1.r = ralpha, q__1.i = 0.f;
02354 alpha.r = q__1.r, alpha.i = q__1.i;
02355 }
02356
02357 i__4 = *nbet;
02358 for (ib = 1; ib <= i__4; ++ib) {
02359 i__5 = ib;
02360 beta.r = bet[i__5].r, beta.i = bet[i__5].i;
02361 if (conj) {
02362 rbeta = beta.r;
02363 q__1.r = rbeta, q__1.i = 0.f;
02364 beta.r = q__1.r, beta.i = q__1.i;
02365 }
02366 null = n <= 0;
02367 if (conj) {
02368 null = null || (k <= 0 || ralpha == 0.f) &&
02369 rbeta == 1.f;
02370 }
02371
02372
02373
02374 cmake_(sname + 1, uplo, " ", &n, &n, &c__[
02375 c_offset], nmax, &cc[1], &ldc, &reset, &
02376 c_b1, (ftnlen)2, (ftnlen)1, (ftnlen)1);
02377
02378 ++nc;
02379
02380
02381
02382 *(unsigned char *)uplos = *(unsigned char *)uplo;
02383 *(unsigned char *)transs = *(unsigned char *)
02384 trans;
02385 ns = n;
02386 ks = k;
02387 if (conj) {
02388 rals = ralpha;
02389 } else {
02390 als.r = alpha.r, als.i = alpha.i;
02391 }
02392 i__5 = laa;
02393 for (i__ = 1; i__ <= i__5; ++i__) {
02394 i__6 = i__;
02395 i__7 = i__;
02396 as[i__6].r = aa[i__7].r, as[i__6].i = aa[i__7]
02397 .i;
02398
02399 }
02400 ldas = lda;
02401 if (conj) {
02402 rbets = rbeta;
02403 } else {
02404 bets.r = beta.r, bets.i = beta.i;
02405 }
02406 i__5 = lcc;
02407 for (i__ = 1; i__ <= i__5; ++i__) {
02408 i__6 = i__;
02409 i__7 = i__;
02410 cs[i__6].r = cc[i__7].r, cs[i__6].i = cc[i__7]
02411 .i;
02412
02413 }
02414 ldcs = ldc;
02415
02416
02417
02418 if (conj) {
02419 if (*trace) {
02420 io___274.ciunit = *ntra;
02421 s_wsfe(&io___274);
02422 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(
02423 integer));
02424 do_fio(&c__1, sname, (ftnlen)6);
02425 do_fio(&c__1, uplo, (ftnlen)1);
02426 do_fio(&c__1, trans, (ftnlen)1);
02427 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
02428 integer));
02429 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(
02430 integer));
02431 do_fio(&c__1, (char *)&ralpha, (ftnlen)
02432 sizeof(real));
02433 do_fio(&c__1, (char *)&lda, (ftnlen)
02434 sizeof(integer));
02435 do_fio(&c__1, (char *)&rbeta, (ftnlen)
02436 sizeof(real));
02437 do_fio(&c__1, (char *)&ldc, (ftnlen)
02438 sizeof(integer));
02439 e_wsfe();
02440 }
02441 if (*rewi) {
02442 al__1.aerr = 0;
02443 al__1.aunit = *ntra;
02444 f_rew(&al__1);
02445 }
02446 cherk_(uplo, trans, &n, &k, &ralpha, &aa[1], &
02447 lda, &rbeta, &cc[1], &ldc);
02448 } else {
02449 if (*trace) {
02450 io___275.ciunit = *ntra;
02451 s_wsfe(&io___275);
02452 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(
02453 integer));
02454 do_fio(&c__1, sname, (ftnlen)6);
02455 do_fio(&c__1, uplo, (ftnlen)1);
02456 do_fio(&c__1, trans, (ftnlen)1);
02457 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
02458 integer));
02459 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(
02460 integer));
02461 do_fio(&c__2, (char *)&alpha, (ftnlen)
02462 sizeof(real));
02463 do_fio(&c__1, (char *)&lda, (ftnlen)
02464 sizeof(integer));
02465 do_fio(&c__2, (char *)&beta, (ftnlen)
02466 sizeof(real));
02467 do_fio(&c__1, (char *)&ldc, (ftnlen)
02468 sizeof(integer));
02469 e_wsfe();
02470 }
02471 if (*rewi) {
02472 al__1.aerr = 0;
02473 al__1.aunit = *ntra;
02474 f_rew(&al__1);
02475 }
02476 csyrk_(uplo, trans, &n, &k, &alpha, &aa[1], &
02477 lda, &beta, &cc[1], &ldc);
02478 }
02479
02480
02481
02482 if (! infoc_1.ok) {
02483 io___276.ciunit = *nout;
02484 s_wsfe(&io___276);
02485 e_wsfe();
02486 *fatal = TRUE_;
02487 goto L120;
02488 }
02489
02490
02491
02492 isame[0] = *(unsigned char *)uplos == *(unsigned
02493 char *)uplo;
02494 isame[1] = *(unsigned char *)transs == *(unsigned
02495 char *)trans;
02496 isame[2] = ns == n;
02497 isame[3] = ks == k;
02498 if (conj) {
02499 isame[4] = rals == ralpha;
02500 } else {
02501 isame[4] = als.r == alpha.r && als.i ==
02502 alpha.i;
02503 }
02504 isame[5] = lce_(&as[1], &aa[1], &laa);
02505 isame[6] = ldas == lda;
02506 if (conj) {
02507 isame[7] = rbets == rbeta;
02508 } else {
02509 isame[7] = bets.r == beta.r && bets.i ==
02510 beta.i;
02511 }
02512 if (null) {
02513 isame[8] = lce_(&cs[1], &cc[1], &lcc);
02514 } else {
02515 isame[8] = lceres_(sname + 1, uplo, &n, &n, &
02516 cs[1], &cc[1], &ldc, (ftnlen)2, (
02517 ftnlen)1);
02518 }
02519 isame[9] = ldcs == ldc;
02520
02521
02522
02523
02524 same = TRUE_;
02525 i__5 = nargs;
02526 for (i__ = 1; i__ <= i__5; ++i__) {
02527 same = same && isame[i__ - 1];
02528 if (! isame[i__ - 1]) {
02529 io___279.ciunit = *nout;
02530 s_wsfe(&io___279);
02531 do_fio(&c__1, (char *)&i__, (ftnlen)
02532 sizeof(integer));
02533 e_wsfe();
02534 }
02535
02536 }
02537 if (! same) {
02538 *fatal = TRUE_;
02539 goto L120;
02540 }
02541
02542 if (! null) {
02543
02544
02545
02546 if (conj) {
02547 *(unsigned char *)transt = 'C';
02548 } else {
02549 *(unsigned char *)transt = 'T';
02550 }
02551 jc = 1;
02552 i__5 = n;
02553 for (j = 1; j <= i__5; ++j) {
02554 if (upper) {
02555 jj = 1;
02556 lj = j;
02557 } else {
02558 jj = j;
02559 lj = n - j + 1;
02560 }
02561 if (tran) {
02562 cmmch_(transt, "N", &lj, &c__1, &k, &
02563 alpha, &a[jj * a_dim1 + 1],
02564 nmax, &a[j * a_dim1 + 1],
02565 nmax, &beta, &c__[jj + j *
02566 c_dim1], nmax, &ct[1], &g[1],
02567 &cc[jc], &ldc, eps, &err,
02568 fatal, nout, &c_true, (ftnlen)
02569 1, (ftnlen)1);
02570 } else {
02571 cmmch_("N", transt, &lj, &c__1, &k, &
02572 alpha, &a[jj + a_dim1], nmax,
02573 &a[j + a_dim1], nmax, &beta, &
02574 c__[jj + j * c_dim1], nmax, &
02575 ct[1], &g[1], &cc[jc], &ldc,
02576 eps, &err, fatal, nout, &
02577 c_true, (ftnlen)1, (ftnlen)1);
02578 }
02579 if (upper) {
02580 jc += ldc;
02581 } else {
02582 jc = jc + ldc + 1;
02583 }
02584 errmax = dmax(errmax,err);
02585
02586
02587 if (*fatal) {
02588 goto L110;
02589 }
02590
02591 }
02592 }
02593
02594
02595 }
02596
02597
02598 }
02599
02600
02601 }
02602
02603 L80:
02604 ;
02605 }
02606
02607
02608 }
02609
02610 L100:
02611 ;
02612 }
02613
02614
02615
02616 if (errmax < *thresh) {
02617 io___286.ciunit = *nout;
02618 s_wsfe(&io___286);
02619 do_fio(&c__1, sname, (ftnlen)6);
02620 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
02621 e_wsfe();
02622 } else {
02623 io___287.ciunit = *nout;
02624 s_wsfe(&io___287);
02625 do_fio(&c__1, sname, (ftnlen)6);
02626 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
02627 do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real));
02628 e_wsfe();
02629 }
02630 goto L130;
02631
02632 L110:
02633 if (n > 1) {
02634 io___288.ciunit = *nout;
02635 s_wsfe(&io___288);
02636 do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer));
02637 e_wsfe();
02638 }
02639
02640 L120:
02641 io___289.ciunit = *nout;
02642 s_wsfe(&io___289);
02643 do_fio(&c__1, sname, (ftnlen)6);
02644 e_wsfe();
02645 if (conj) {
02646 io___290.ciunit = *nout;
02647 s_wsfe(&io___290);
02648 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
02649 do_fio(&c__1, sname, (ftnlen)6);
02650 do_fio(&c__1, uplo, (ftnlen)1);
02651 do_fio(&c__1, trans, (ftnlen)1);
02652 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02653 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
02654 do_fio(&c__1, (char *)&ralpha, (ftnlen)sizeof(real));
02655 do_fio(&c__1, (char *)&lda, (ftnlen)sizeof(integer));
02656 do_fio(&c__1, (char *)&rbeta, (ftnlen)sizeof(real));
02657 do_fio(&c__1, (char *)&ldc, (ftnlen)sizeof(integer));
02658 e_wsfe();
02659 } else {
02660 io___291.ciunit = *nout;
02661 s_wsfe(&io___291);
02662 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
02663 do_fio(&c__1, sname, (ftnlen)6);
02664 do_fio(&c__1, uplo, (ftnlen)1);
02665 do_fio(&c__1, trans, (ftnlen)1);
02666 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02667 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
02668 do_fio(&c__2, (char *)&alpha, (ftnlen)sizeof(real));
02669 do_fio(&c__1, (char *)&lda, (ftnlen)sizeof(integer));
02670 do_fio(&c__2, (char *)&beta, (ftnlen)sizeof(real));
02671 do_fio(&c__1, (char *)&ldc, (ftnlen)sizeof(integer));
02672 e_wsfe();
02673 }
02674
02675 L130:
02676 return 0;
02677
02678
02679
02680
02681 }
02682
02683 int cchk5_(char *sname, real *eps, real *thresh, integer *
02684 nout, integer *ntra, logical *trace, logical *rewi, logical *fatal,
02685 integer *nidim, integer *idim, integer *nalf, complex *alf, integer *
02686 nbet, complex *bet, integer *nmax, complex *ab, complex *aa, complex *
02687 as, complex *bb, complex *bs, complex *c__, complex *cc, complex *cs,
02688 complex *ct, real *g, complex *w, ftnlen sname_len)
02689 {
02690
02691
02692 static char icht[2] = "NC";
02693 static char ichu[2] = "UL";
02694
02695
02696 static char fmt_9994[] = "(1x,i6,\002: \002,a6,\002(\002,2(\002'\002,a1"
02697 ",\002',\002),2(i3,\002,\002),\002(\002,f4.1,\002,\002,f4.1,\002)"
02698 ", A,\002,i3,\002, B,\002,i3,\002,\002,f4.1,\002, C,\002,i3,\002)"
02699 " .\002)";
02700 static char fmt_9993[] = "(1x,i6,\002: \002,a6,\002(\002,2(\002'\002,a1"
02701 ",\002',\002),2(i3,\002,\002),\002(\002,f4.1,\002,\002,f4.1,\002)"
02702 ", A,\002,i3,\002, B,\002,i3,\002,(\002,f4.1,\002,\002,f4.1,\002)"
02703 ", C,\002,i3,\002) .\002)";
02704 static char fmt_9992[] = "(\002 ******* FATAL ERROR - ERROR-EXIT TAKEN O"
02705 "N VALID CALL *\002,\002******\002)";
02706 static char fmt_9998[] = "(\002 ******* FATAL ERROR - PARAMETER NUMBER"
02707 " \002,i2,\002 WAS CH\002,\002ANGED INCORRECTLY *******\002)";
02708 static char fmt_9999[] = "(\002 \002,a6,\002 PASSED THE COMPUTATIONAL TE"
02709 "STS (\002,i6,\002 CALL\002,\002S)\002)";
02710 static char fmt_9997[] = "(\002 \002,a6,\002 COMPLETED THE COMPUTATIONAL"
02711 " TESTS (\002,i6,\002 C\002,\002ALLS)\002,/\002 ******* BUT WITH "
02712 "MAXIMUM TEST RATIO\002,f8.2,\002 - SUSPECT *******\002)";
02713 static char fmt_9995[] = "(\002 THESE ARE THE RESULTS FOR COLUMN"
02714 " \002,i3)";
02715 static char fmt_9996[] = "(\002 ******* \002,a6,\002 FAILED ON CALL NUMB"
02716 "ER:\002)";
02717
02718
02719 integer c_dim1, c_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7, i__8;
02720 complex q__1, q__2;
02721 alist al__1;
02722
02723
02724 integer s_cmp(char *, char *, ftnlen, ftnlen), s_wsfe(cilist *), do_fio(
02725 integer *, char *, ftnlen), e_wsfe(void), f_rew(alist *);
02726 void r_cnjg(complex *, complex *);
02727
02728
02729 integer i__, j, k, n, ia, ib, jc, ma, na, nc, ik, in, jj, lj, ks, ns, laa,
02730 lbb, lda, lcc, ldb, ldc;
02731 extern logical lce_(complex *, complex *, integer *);
02732 complex als;
02733 integer ict, icu;
02734 real err;
02735 integer jjab;
02736 complex beta;
02737 integer ldas, ldbs, ldcs;
02738 logical same, conj;
02739 complex bets;
02740 logical tran, null;
02741 char uplo[1];
02742 extern int cmake_(char *, char *, char *, integer *,
02743 integer *, complex *, integer *, complex *, integer *, logical *,
02744 complex *, ftnlen, ftnlen, ftnlen);
02745 complex alpha;
02746 extern int cmmch_(char *, char *, integer *, integer *,
02747 integer *, complex *, complex *, integer *, complex *, integer *,
02748 complex *, complex *, integer *, complex *, real *, complex *,
02749 integer *, real *, real *, logical *, integer *, logical *,
02750 ftnlen, ftnlen);
02751 real rbeta;
02752 logical isame[13];
02753 integer nargs;
02754 real rbets;
02755 logical reset;
02756 char trans[1];
02757 logical upper;
02758 char uplos[1];
02759 extern int cher2k_(char *, char *, integer *, integer *,
02760 complex *, complex *, integer *, complex *, integer *, real *,
02761 complex *, integer *), csyr2k_(char *, char *,
02762 integer *, integer *, complex *, complex *, integer *, complex *,
02763 integer *, complex *, complex *, integer *);
02764 extern logical lceres_(char *, char *, integer *, integer *, complex *,
02765 complex *, integer *, ftnlen, ftnlen);
02766 real errmax;
02767 char transs[1], transt[1];
02768
02769
02770 static cilist io___334 = { 0, 0, 0, fmt_9994, 0 };
02771 static cilist io___335 = { 0, 0, 0, fmt_9993, 0 };
02772 static cilist io___336 = { 0, 0, 0, fmt_9992, 0 };
02773 static cilist io___339 = { 0, 0, 0, fmt_9998, 0 };
02774 static cilist io___347 = { 0, 0, 0, fmt_9999, 0 };
02775 static cilist io___348 = { 0, 0, 0, fmt_9997, 0 };
02776 static cilist io___349 = { 0, 0, 0, fmt_9995, 0 };
02777 static cilist io___350 = { 0, 0, 0, fmt_9996, 0 };
02778 static cilist io___351 = { 0, 0, 0, fmt_9994, 0 };
02779 static cilist io___352 = { 0, 0, 0, fmt_9993, 0 };
02780
02781
02782
02783
02784
02785
02786
02787
02788
02789
02790
02791
02792
02793
02794
02795
02796
02797
02798
02799
02800
02801
02802
02803
02804
02805 --idim;
02806 --alf;
02807 --bet;
02808 --w;
02809 --g;
02810 --ct;
02811 --cs;
02812 --cc;
02813 c_dim1 = *nmax;
02814 c_offset = 1 + c_dim1;
02815 c__ -= c_offset;
02816 --bs;
02817 --bb;
02818 --as;
02819 --aa;
02820 --ab;
02821
02822
02823
02824 conj = s_cmp(sname + 1, "HE", (ftnlen)2, (ftnlen)2) == 0;
02825
02826 nargs = 12;
02827 nc = 0;
02828 reset = TRUE_;
02829 errmax = 0.f;
02830
02831 i__1 = *nidim;
02832 for (in = 1; in <= i__1; ++in) {
02833 n = idim[in];
02834
02835 ldc = n;
02836 if (ldc < *nmax) {
02837 ++ldc;
02838 }
02839
02840 if (ldc > *nmax) {
02841 goto L130;
02842 }
02843 lcc = ldc * n;
02844
02845 i__2 = *nidim;
02846 for (ik = 1; ik <= i__2; ++ik) {
02847 k = idim[ik];
02848
02849 for (ict = 1; ict <= 2; ++ict) {
02850 *(unsigned char *)trans = *(unsigned char *)&icht[ict - 1];
02851 tran = *(unsigned char *)trans == 'C';
02852 if (tran && ! conj) {
02853 *(unsigned char *)trans = 'T';
02854 }
02855 if (tran) {
02856 ma = k;
02857 na = n;
02858 } else {
02859 ma = n;
02860 na = k;
02861 }
02862
02863 lda = ma;
02864 if (lda < *nmax) {
02865 ++lda;
02866 }
02867
02868 if (lda > *nmax) {
02869 goto L110;
02870 }
02871 laa = lda * na;
02872
02873
02874
02875 if (tran) {
02876 i__3 = *nmax << 1;
02877 cmake_("GE", " ", " ", &ma, &na, &ab[1], &i__3, &aa[1], &
02878 lda, &reset, &c_b1, (ftnlen)2, (ftnlen)1, (ftnlen)
02879 1);
02880 } else {
02881 cmake_("GE", " ", " ", &ma, &na, &ab[1], nmax, &aa[1], &
02882 lda, &reset, &c_b1, (ftnlen)2, (ftnlen)1, (ftnlen)
02883 1);
02884 }
02885
02886
02887
02888 ldb = lda;
02889 lbb = laa;
02890 if (tran) {
02891 i__3 = *nmax << 1;
02892 cmake_("GE", " ", " ", &ma, &na, &ab[k + 1], &i__3, &bb[1]
02893 , &ldb, &reset, &c_b1, (ftnlen)2, (ftnlen)1, (
02894 ftnlen)1);
02895 } else {
02896 cmake_("GE", " ", " ", &ma, &na, &ab[k * *nmax + 1], nmax,
02897 &bb[1], &ldb, &reset, &c_b1, (ftnlen)2, (ftnlen)
02898 1, (ftnlen)1);
02899 }
02900
02901 for (icu = 1; icu <= 2; ++icu) {
02902 *(unsigned char *)uplo = *(unsigned char *)&ichu[icu - 1];
02903 upper = *(unsigned char *)uplo == 'U';
02904
02905 i__3 = *nalf;
02906 for (ia = 1; ia <= i__3; ++ia) {
02907 i__4 = ia;
02908 alpha.r = alf[i__4].r, alpha.i = alf[i__4].i;
02909
02910 i__4 = *nbet;
02911 for (ib = 1; ib <= i__4; ++ib) {
02912 i__5 = ib;
02913 beta.r = bet[i__5].r, beta.i = bet[i__5].i;
02914 if (conj) {
02915 rbeta = beta.r;
02916 q__1.r = rbeta, q__1.i = 0.f;
02917 beta.r = q__1.r, beta.i = q__1.i;
02918 }
02919 null = n <= 0;
02920 if (conj) {
02921 null = null || (k <= 0 || alpha.r == 0.f &&
02922 alpha.i == 0.f) && rbeta == 1.f;
02923 }
02924
02925
02926
02927 cmake_(sname + 1, uplo, " ", &n, &n, &c__[
02928 c_offset], nmax, &cc[1], &ldc, &reset, &
02929 c_b1, (ftnlen)2, (ftnlen)1, (ftnlen)1);
02930
02931 ++nc;
02932
02933
02934
02935 *(unsigned char *)uplos = *(unsigned char *)uplo;
02936 *(unsigned char *)transs = *(unsigned char *)
02937 trans;
02938 ns = n;
02939 ks = k;
02940 als.r = alpha.r, als.i = alpha.i;
02941 i__5 = laa;
02942 for (i__ = 1; i__ <= i__5; ++i__) {
02943 i__6 = i__;
02944 i__7 = i__;
02945 as[i__6].r = aa[i__7].r, as[i__6].i = aa[i__7]
02946 .i;
02947
02948 }
02949 ldas = lda;
02950 i__5 = lbb;
02951 for (i__ = 1; i__ <= i__5; ++i__) {
02952 i__6 = i__;
02953 i__7 = i__;
02954 bs[i__6].r = bb[i__7].r, bs[i__6].i = bb[i__7]
02955 .i;
02956
02957 }
02958 ldbs = ldb;
02959 if (conj) {
02960 rbets = rbeta;
02961 } else {
02962 bets.r = beta.r, bets.i = beta.i;
02963 }
02964 i__5 = lcc;
02965 for (i__ = 1; i__ <= i__5; ++i__) {
02966 i__6 = i__;
02967 i__7 = i__;
02968 cs[i__6].r = cc[i__7].r, cs[i__6].i = cc[i__7]
02969 .i;
02970
02971 }
02972 ldcs = ldc;
02973
02974
02975
02976 if (conj) {
02977 if (*trace) {
02978 io___334.ciunit = *ntra;
02979 s_wsfe(&io___334);
02980 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(
02981 integer));
02982 do_fio(&c__1, sname, (ftnlen)6);
02983 do_fio(&c__1, uplo, (ftnlen)1);
02984 do_fio(&c__1, trans, (ftnlen)1);
02985 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
02986 integer));
02987 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(
02988 integer));
02989 do_fio(&c__2, (char *)&alpha, (ftnlen)
02990 sizeof(real));
02991 do_fio(&c__1, (char *)&lda, (ftnlen)
02992 sizeof(integer));
02993 do_fio(&c__1, (char *)&ldb, (ftnlen)
02994 sizeof(integer));
02995 do_fio(&c__1, (char *)&rbeta, (ftnlen)
02996 sizeof(real));
02997 do_fio(&c__1, (char *)&ldc, (ftnlen)
02998 sizeof(integer));
02999 e_wsfe();
03000 }
03001 if (*rewi) {
03002 al__1.aerr = 0;
03003 al__1.aunit = *ntra;
03004 f_rew(&al__1);
03005 }
03006 cher2k_(uplo, trans, &n, &k, &alpha, &aa[1], &
03007 lda, &bb[1], &ldb, &rbeta, &cc[1], &
03008 ldc);
03009 } else {
03010 if (*trace) {
03011 io___335.ciunit = *ntra;
03012 s_wsfe(&io___335);
03013 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(
03014 integer));
03015 do_fio(&c__1, sname, (ftnlen)6);
03016 do_fio(&c__1, uplo, (ftnlen)1);
03017 do_fio(&c__1, trans, (ftnlen)1);
03018 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(
03019 integer));
03020 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(
03021 integer));
03022 do_fio(&c__2, (char *)&alpha, (ftnlen)
03023 sizeof(real));
03024 do_fio(&c__1, (char *)&lda, (ftnlen)
03025 sizeof(integer));
03026 do_fio(&c__1, (char *)&ldb, (ftnlen)
03027 sizeof(integer));
03028 do_fio(&c__2, (char *)&beta, (ftnlen)
03029 sizeof(real));
03030 do_fio(&c__1, (char *)&ldc, (ftnlen)
03031 sizeof(integer));
03032 e_wsfe();
03033 }
03034 if (*rewi) {
03035 al__1.aerr = 0;
03036 al__1.aunit = *ntra;
03037 f_rew(&al__1);
03038 }
03039 csyr2k_(uplo, trans, &n, &k, &alpha, &aa[1], &
03040 lda, &bb[1], &ldb, &beta, &cc[1], &
03041 ldc);
03042 }
03043
03044
03045
03046 if (! infoc_1.ok) {
03047 io___336.ciunit = *nout;
03048 s_wsfe(&io___336);
03049 e_wsfe();
03050 *fatal = TRUE_;
03051 goto L150;
03052 }
03053
03054
03055
03056 isame[0] = *(unsigned char *)uplos == *(unsigned
03057 char *)uplo;
03058 isame[1] = *(unsigned char *)transs == *(unsigned
03059 char *)trans;
03060 isame[2] = ns == n;
03061 isame[3] = ks == k;
03062 isame[4] = als.r == alpha.r && als.i == alpha.i;
03063 isame[5] = lce_(&as[1], &aa[1], &laa);
03064 isame[6] = ldas == lda;
03065 isame[7] = lce_(&bs[1], &bb[1], &lbb);
03066 isame[8] = ldbs == ldb;
03067 if (conj) {
03068 isame[9] = rbets == rbeta;
03069 } else {
03070 isame[9] = bets.r == beta.r && bets.i ==
03071 beta.i;
03072 }
03073 if (null) {
03074 isame[10] = lce_(&cs[1], &cc[1], &lcc);
03075 } else {
03076 isame[10] = lceres_("HE", uplo, &n, &n, &cs[1]
03077 , &cc[1], &ldc, (ftnlen)2, (ftnlen)1);
03078 }
03079 isame[11] = ldcs == ldc;
03080
03081
03082
03083
03084 same = TRUE_;
03085 i__5 = nargs;
03086 for (i__ = 1; i__ <= i__5; ++i__) {
03087 same = same && isame[i__ - 1];
03088 if (! isame[i__ - 1]) {
03089 io___339.ciunit = *nout;
03090 s_wsfe(&io___339);
03091 do_fio(&c__1, (char *)&i__, (ftnlen)
03092 sizeof(integer));
03093 e_wsfe();
03094 }
03095
03096 }
03097 if (! same) {
03098 *fatal = TRUE_;
03099 goto L150;
03100 }
03101
03102 if (! null) {
03103
03104
03105
03106 if (conj) {
03107 *(unsigned char *)transt = 'C';
03108 } else {
03109 *(unsigned char *)transt = 'T';
03110 }
03111 jjab = 1;
03112 jc = 1;
03113 i__5 = n;
03114 for (j = 1; j <= i__5; ++j) {
03115 if (upper) {
03116 jj = 1;
03117 lj = j;
03118 } else {
03119 jj = j;
03120 lj = n - j + 1;
03121 }
03122 if (tran) {
03123 i__6 = k;
03124 for (i__ = 1; i__ <= i__6; ++i__) {
03125 i__7 = i__;
03126 i__8 = (j - 1 << 1) * *nmax + k +
03127 i__;
03128 q__1.r = alpha.r * ab[i__8].r -
03129 alpha.i * ab[i__8].i,
03130 q__1.i = alpha.r * ab[
03131 i__8].i + alpha.i * ab[
03132 i__8].r;
03133 w[i__7].r = q__1.r, w[i__7].i =
03134 q__1.i;
03135 if (conj) {
03136 i__7 = k + i__;
03137 r_cnjg(&q__2, &alpha);
03138 i__8 = (j - 1 << 1) * *nmax + i__;
03139 q__1.r = q__2.r * ab[i__8].r - q__2.i * ab[i__8].i,
03140 q__1.i = q__2.r * ab[i__8].i + q__2.i * ab[
03141 i__8].r;
03142 w[i__7].r = q__1.r, w[i__7].i = q__1.i;
03143 } else {
03144 i__7 = k + i__;
03145 i__8 = (j - 1 << 1) * *nmax + i__;
03146 q__1.r = alpha.r * ab[i__8].r - alpha.i * ab[i__8]
03147 .i, q__1.i = alpha.r * ab[i__8].i + alpha.i
03148 * ab[i__8].r;
03149 w[i__7].r = q__1.r, w[i__7].i = q__1.i;
03150 }
03151
03152 }
03153 i__6 = k << 1;
03154 i__7 = *nmax << 1;
03155 i__8 = *nmax << 1;
03156 cmmch_(transt, "N", &lj, &c__1, &i__6,
03157 &c_b2, &ab[jjab], &i__7, &w[
03158 1], &i__8, &beta, &c__[jj + j
03159 * c_dim1], nmax, &ct[1], &g[1]
03160 , &cc[jc], &ldc, eps, &err,
03161 fatal, nout, &c_true, (ftnlen)
03162 1, (ftnlen)1);
03163 } else {
03164 i__6 = k;
03165 for (i__ = 1; i__ <= i__6; ++i__) {
03166 if (conj) {
03167 i__7 = i__;
03168 r_cnjg(&q__2, &ab[(k + i__ - 1) * *nmax + j]);
03169 q__1.r = alpha.r * q__2.r - alpha.i * q__2.i,
03170 q__1.i = alpha.r * q__2.i + alpha.i *
03171 q__2.r;
03172 w[i__7].r = q__1.r, w[i__7].i = q__1.i;
03173 i__7 = k + i__;
03174 i__8 = (i__ - 1) * *nmax + j;
03175 q__2.r = alpha.r * ab[i__8].r - alpha.i * ab[i__8]
03176 .i, q__2.i = alpha.r * ab[i__8].i + alpha.i
03177 * ab[i__8].r;
03178 r_cnjg(&q__1, &q__2);
03179 w[i__7].r = q__1.r, w[i__7].i = q__1.i;
03180 } else {
03181 i__7 = i__;
03182 i__8 = (k + i__ - 1) * *nmax + j;
03183 q__1.r = alpha.r * ab[i__8].r - alpha.i * ab[i__8]
03184 .i, q__1.i = alpha.r * ab[i__8].i + alpha.i
03185 * ab[i__8].r;
03186 w[i__7].r = q__1.r, w[i__7].i = q__1.i;
03187 i__7 = k + i__;
03188 i__8 = (i__ - 1) * *nmax + j;
03189 q__1.r = alpha.r * ab[i__8].r - alpha.i * ab[i__8]
03190 .i, q__1.i = alpha.r * ab[i__8].i + alpha.i
03191 * ab[i__8].r;
03192 w[i__7].r = q__1.r, w[i__7].i = q__1.i;
03193 }
03194
03195 }
03196 i__6 = k << 1;
03197 i__7 = *nmax << 1;
03198 cmmch_("N", "N", &lj, &c__1, &i__6, &
03199 c_b2, &ab[jj], nmax, &w[1], &
03200 i__7, &beta, &c__[jj + j *
03201 c_dim1], nmax, &ct[1], &g[1],
03202 &cc[jc], &ldc, eps, &err,
03203 fatal, nout, &c_true, (ftnlen)
03204 1, (ftnlen)1);
03205 }
03206 if (upper) {
03207 jc += ldc;
03208 } else {
03209 jc = jc + ldc + 1;
03210 if (tran) {
03211 jjab += *nmax << 1;
03212 }
03213 }
03214 errmax = dmax(errmax,err);
03215
03216
03217 if (*fatal) {
03218 goto L140;
03219 }
03220
03221 }
03222 }
03223
03224
03225 }
03226
03227
03228 }
03229
03230
03231 }
03232
03233 L110:
03234 ;
03235 }
03236
03237
03238 }
03239
03240 L130:
03241 ;
03242 }
03243
03244
03245
03246 if (errmax < *thresh) {
03247 io___347.ciunit = *nout;
03248 s_wsfe(&io___347);
03249 do_fio(&c__1, sname, (ftnlen)6);
03250 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
03251 e_wsfe();
03252 } else {
03253 io___348.ciunit = *nout;
03254 s_wsfe(&io___348);
03255 do_fio(&c__1, sname, (ftnlen)6);
03256 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
03257 do_fio(&c__1, (char *)&errmax, (ftnlen)sizeof(real));
03258 e_wsfe();
03259 }
03260 goto L160;
03261
03262 L140:
03263 if (n > 1) {
03264 io___349.ciunit = *nout;
03265 s_wsfe(&io___349);
03266 do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer));
03267 e_wsfe();
03268 }
03269
03270 L150:
03271 io___350.ciunit = *nout;
03272 s_wsfe(&io___350);
03273 do_fio(&c__1, sname, (ftnlen)6);
03274 e_wsfe();
03275 if (conj) {
03276 io___351.ciunit = *nout;
03277 s_wsfe(&io___351);
03278 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
03279 do_fio(&c__1, sname, (ftnlen)6);
03280 do_fio(&c__1, uplo, (ftnlen)1);
03281 do_fio(&c__1, trans, (ftnlen)1);
03282 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
03283 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
03284 do_fio(&c__2, (char *)&alpha, (ftnlen)sizeof(real));
03285 do_fio(&c__1, (char *)&lda, (ftnlen)sizeof(integer));
03286 do_fio(&c__1, (char *)&ldb, (ftnlen)sizeof(integer));
03287 do_fio(&c__1, (char *)&rbeta, (ftnlen)sizeof(real));
03288 do_fio(&c__1, (char *)&ldc, (ftnlen)sizeof(integer));
03289 e_wsfe();
03290 } else {
03291 io___352.ciunit = *nout;
03292 s_wsfe(&io___352);
03293 do_fio(&c__1, (char *)&nc, (ftnlen)sizeof(integer));
03294 do_fio(&c__1, sname, (ftnlen)6);
03295 do_fio(&c__1, uplo, (ftnlen)1);
03296 do_fio(&c__1, trans, (ftnlen)1);
03297 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
03298 do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));
03299 do_fio(&c__2, (char *)&alpha, (ftnlen)sizeof(real));
03300 do_fio(&c__1, (char *)&lda, (ftnlen)sizeof(integer));
03301 do_fio(&c__1, (char *)&ldb, (ftnlen)sizeof(integer));
03302 do_fio(&c__2, (char *)&beta, (ftnlen)sizeof(real));
03303 do_fio(&c__1, (char *)&ldc, (ftnlen)sizeof(integer));
03304 e_wsfe();
03305 }
03306
03307 L160:
03308 return 0;
03309
03310
03311
03312
03313 }
03314
03315 int cchke_(integer *isnum, char *srnamt, integer *nout,
03316 ftnlen srnamt_len)
03317 {
03318
03319 static char fmt_9999[] = "(\002 \002,a6,\002 PASSED THE TESTS OF ERROR-E"
03320 "XITS\002)";
03321 static char fmt_9998[] = "(\002 ******* \002,a6,\002 FAILED THE TESTS OF"
03322 " ERROR-EXITS *****\002,\002**\002)";
03323
03324
03325 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
03326
03327
03328 complex a[2] , b[2] , c__[2]
03329 , beta, alpha;
03330 extern int cgemm_(char *, char *, integer *, integer *,
03331 integer *, complex *, complex *, integer *, complex *, integer *,
03332 complex *, complex *, integer *), chemm_(char *,
03333 char *, integer *, integer *, complex *, complex *, integer *,
03334 complex *, integer *, complex *, complex *, integer *), cherk_(char *, char *, integer *, integer *, real *,
03335 complex *, integer *, real *, complex *, integer *);
03336 real rbeta;
03337 extern int ctrmm_(char *, char *, char *, char *,
03338 integer *, integer *, complex *, complex *, integer *, complex *,
03339 integer *), csymm_(char *, char *,
03340 integer *, integer *, complex *, complex *, integer *, complex *,
03341 integer *, complex *, complex *, integer *),
03342 ctrsm_(char *, char *, char *, char *, integer *, integer *,
03343 complex *, complex *, integer *, complex *, integer *), csyrk_(char *, char *, integer *,
03344 integer *, complex *, complex *, integer *, complex *, complex *,
03345 integer *), cher2k_(char *, char *, integer *,
03346 integer *, complex *, complex *, integer *, complex *, integer *,
03347 real *, complex *, integer *), csyr2k_(char *,
03348 char *, integer *, integer *, complex *, complex *, integer *,
03349 complex *, integer *, complex *, complex *, integer *);
03350 real ralpha;
03351 extern int chkxer_(char *, integer *, integer *, logical
03352 *, logical *);
03353
03354
03355 static cilist io___360 = { 0, 0, 0, fmt_9999, 0 };
03356 static cilist io___361 = { 0, 0, 0, fmt_9998, 0 };
03357
03358
03359
03360
03361
03362
03363
03364
03365
03366
03367
03368
03369
03370
03371
03372
03373
03374
03375
03376
03377
03378
03379
03380
03381
03382
03383
03384
03385
03386 infoc_1.ok = TRUE_;
03387
03388
03389 infoc_1.lerr = FALSE_;
03390
03391
03392
03393 alpha.r = 1.f, alpha.i = -1.f;
03394 beta.r = 2.f, beta.i = -2.f;
03395 ralpha = 1.f;
03396 rbeta = 2.f;
03397
03398 switch (*isnum) {
03399 case 1: goto L10;
03400 case 2: goto L20;
03401 case 3: goto L30;
03402 case 4: goto L40;
03403 case 5: goto L50;
03404 case 6: goto L60;
03405 case 7: goto L70;
03406 case 8: goto L80;
03407 case 9: goto L90;
03408 }
03409 L10:
03410 infoc_1.infot = 1;
03411 cgemm_("/", "N", &c__0, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03412 c__, &c__1);
03413 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03414 infoc_1.infot = 1;
03415 cgemm_("/", "C", &c__0, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03416 c__, &c__1);
03417 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03418 infoc_1.infot = 1;
03419 cgemm_("/", "T", &c__0, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03420 c__, &c__1);
03421 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03422 infoc_1.infot = 2;
03423 cgemm_("N", "/", &c__0, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03424 c__, &c__1);
03425 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03426 infoc_1.infot = 2;
03427 cgemm_("C", "/", &c__0, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03428 c__, &c__1);
03429 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03430 infoc_1.infot = 2;
03431 cgemm_("T", "/", &c__0, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03432 c__, &c__1);
03433 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03434 infoc_1.infot = 3;
03435 cgemm_("N", "N", &c_n1, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03436 c__, &c__1);
03437 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03438 infoc_1.infot = 3;
03439 cgemm_("N", "C", &c_n1, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03440 c__, &c__1);
03441 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03442 infoc_1.infot = 3;
03443 cgemm_("N", "T", &c_n1, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03444 c__, &c__1);
03445 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03446 infoc_1.infot = 3;
03447 cgemm_("C", "N", &c_n1, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03448 c__, &c__1);
03449 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03450 infoc_1.infot = 3;
03451 cgemm_("C", "C", &c_n1, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03452 c__, &c__1);
03453 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03454 infoc_1.infot = 3;
03455 cgemm_("C", "T", &c_n1, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03456 c__, &c__1);
03457 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03458 infoc_1.infot = 3;
03459 cgemm_("T", "N", &c_n1, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03460 c__, &c__1);
03461 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03462 infoc_1.infot = 3;
03463 cgemm_("T", "C", &c_n1, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03464 c__, &c__1);
03465 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03466 infoc_1.infot = 3;
03467 cgemm_("T", "T", &c_n1, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03468 c__, &c__1);
03469 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03470 infoc_1.infot = 4;
03471 cgemm_("N", "N", &c__0, &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03472 c__, &c__1);
03473 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03474 infoc_1.infot = 4;
03475 cgemm_("N", "C", &c__0, &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03476 c__, &c__1);
03477 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03478 infoc_1.infot = 4;
03479 cgemm_("N", "T", &c__0, &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03480 c__, &c__1);
03481 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03482 infoc_1.infot = 4;
03483 cgemm_("C", "N", &c__0, &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03484 c__, &c__1);
03485 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03486 infoc_1.infot = 4;
03487 cgemm_("C", "C", &c__0, &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03488 c__, &c__1);
03489 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03490 infoc_1.infot = 4;
03491 cgemm_("C", "T", &c__0, &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03492 c__, &c__1);
03493 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03494 infoc_1.infot = 4;
03495 cgemm_("T", "N", &c__0, &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03496 c__, &c__1);
03497 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03498 infoc_1.infot = 4;
03499 cgemm_("T", "C", &c__0, &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03500 c__, &c__1);
03501 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03502 infoc_1.infot = 4;
03503 cgemm_("T", "T", &c__0, &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03504 c__, &c__1);
03505 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03506 infoc_1.infot = 5;
03507 cgemm_("N", "N", &c__0, &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta,
03508 c__, &c__1);
03509 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03510 infoc_1.infot = 5;
03511 cgemm_("N", "C", &c__0, &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta,
03512 c__, &c__1);
03513 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03514 infoc_1.infot = 5;
03515 cgemm_("N", "T", &c__0, &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta,
03516 c__, &c__1);
03517 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03518 infoc_1.infot = 5;
03519 cgemm_("C", "N", &c__0, &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta,
03520 c__, &c__1);
03521 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03522 infoc_1.infot = 5;
03523 cgemm_("C", "C", &c__0, &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta,
03524 c__, &c__1);
03525 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03526 infoc_1.infot = 5;
03527 cgemm_("C", "T", &c__0, &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta,
03528 c__, &c__1);
03529 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03530 infoc_1.infot = 5;
03531 cgemm_("T", "N", &c__0, &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta,
03532 c__, &c__1);
03533 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03534 infoc_1.infot = 5;
03535 cgemm_("T", "C", &c__0, &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta,
03536 c__, &c__1);
03537 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03538 infoc_1.infot = 5;
03539 cgemm_("T", "T", &c__0, &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta,
03540 c__, &c__1);
03541 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03542 infoc_1.infot = 8;
03543 cgemm_("N", "N", &c__2, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03544 c__, &c__2);
03545 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03546 infoc_1.infot = 8;
03547 cgemm_("N", "C", &c__2, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03548 c__, &c__2);
03549 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03550 infoc_1.infot = 8;
03551 cgemm_("N", "T", &c__2, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03552 c__, &c__2);
03553 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03554 infoc_1.infot = 8;
03555 cgemm_("C", "N", &c__0, &c__0, &c__2, &alpha, a, &c__1, b, &c__2, &beta,
03556 c__, &c__1);
03557 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03558 infoc_1.infot = 8;
03559 cgemm_("C", "C", &c__0, &c__0, &c__2, &alpha, a, &c__1, b, &c__1, &beta,
03560 c__, &c__1);
03561 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03562 infoc_1.infot = 8;
03563 cgemm_("C", "T", &c__0, &c__0, &c__2, &alpha, a, &c__1, b, &c__1, &beta,
03564 c__, &c__1);
03565 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03566 infoc_1.infot = 8;
03567 cgemm_("T", "N", &c__0, &c__0, &c__2, &alpha, a, &c__1, b, &c__2, &beta,
03568 c__, &c__1);
03569 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03570 infoc_1.infot = 8;
03571 cgemm_("T", "C", &c__0, &c__0, &c__2, &alpha, a, &c__1, b, &c__1, &beta,
03572 c__, &c__1);
03573 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03574 infoc_1.infot = 8;
03575 cgemm_("T", "T", &c__0, &c__0, &c__2, &alpha, a, &c__1, b, &c__1, &beta,
03576 c__, &c__1);
03577 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03578 infoc_1.infot = 10;
03579 cgemm_("N", "N", &c__0, &c__0, &c__2, &alpha, a, &c__1, b, &c__1, &beta,
03580 c__, &c__1);
03581 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03582 infoc_1.infot = 10;
03583 cgemm_("C", "N", &c__0, &c__0, &c__2, &alpha, a, &c__2, b, &c__1, &beta,
03584 c__, &c__1);
03585 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03586 infoc_1.infot = 10;
03587 cgemm_("T", "N", &c__0, &c__0, &c__2, &alpha, a, &c__2, b, &c__1, &beta,
03588 c__, &c__1);
03589 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03590 infoc_1.infot = 10;
03591 cgemm_("N", "C", &c__0, &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03592 c__, &c__1);
03593 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03594 infoc_1.infot = 10;
03595 cgemm_("C", "C", &c__0, &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03596 c__, &c__1);
03597 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03598 infoc_1.infot = 10;
03599 cgemm_("T", "C", &c__0, &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03600 c__, &c__1);
03601 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03602 infoc_1.infot = 10;
03603 cgemm_("N", "T", &c__0, &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03604 c__, &c__1);
03605 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03606 infoc_1.infot = 10;
03607 cgemm_("C", "T", &c__0, &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03608 c__, &c__1);
03609 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03610 infoc_1.infot = 10;
03611 cgemm_("T", "T", &c__0, &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03612 c__, &c__1);
03613 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03614 infoc_1.infot = 13;
03615 cgemm_("N", "N", &c__2, &c__0, &c__0, &alpha, a, &c__2, b, &c__1, &beta,
03616 c__, &c__1);
03617 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03618 infoc_1.infot = 13;
03619 cgemm_("N", "C", &c__2, &c__0, &c__0, &alpha, a, &c__2, b, &c__1, &beta,
03620 c__, &c__1);
03621 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03622 infoc_1.infot = 13;
03623 cgemm_("N", "T", &c__2, &c__0, &c__0, &alpha, a, &c__2, b, &c__1, &beta,
03624 c__, &c__1);
03625 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03626 infoc_1.infot = 13;
03627 cgemm_("C", "N", &c__2, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03628 c__, &c__1);
03629 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03630 infoc_1.infot = 13;
03631 cgemm_("C", "C", &c__2, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03632 c__, &c__1);
03633 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03634 infoc_1.infot = 13;
03635 cgemm_("C", "T", &c__2, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03636 c__, &c__1);
03637 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03638 infoc_1.infot = 13;
03639 cgemm_("T", "N", &c__2, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03640 c__, &c__1);
03641 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03642 infoc_1.infot = 13;
03643 cgemm_("T", "C", &c__2, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03644 c__, &c__1);
03645 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03646 infoc_1.infot = 13;
03647 cgemm_("T", "T", &c__2, &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta,
03648 c__, &c__1);
03649 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03650 goto L100;
03651 L20:
03652 infoc_1.infot = 1;
03653 chemm_("/", "U", &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03654 c__1);
03655 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03656 infoc_1.infot = 2;
03657 chemm_("L", "/", &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03658 c__1);
03659 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03660 infoc_1.infot = 3;
03661 chemm_("L", "U", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03662 c__1);
03663 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03664 infoc_1.infot = 3;
03665 chemm_("R", "U", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03666 c__1);
03667 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03668 infoc_1.infot = 3;
03669 chemm_("L", "L", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03670 c__1);
03671 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03672 infoc_1.infot = 3;
03673 chemm_("R", "L", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03674 c__1);
03675 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03676 infoc_1.infot = 4;
03677 chemm_("L", "U", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03678 c__1);
03679 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03680 infoc_1.infot = 4;
03681 chemm_("R", "U", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03682 c__1);
03683 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03684 infoc_1.infot = 4;
03685 chemm_("L", "L", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03686 c__1);
03687 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03688 infoc_1.infot = 4;
03689 chemm_("R", "L", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03690 c__1);
03691 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03692 infoc_1.infot = 7;
03693 chemm_("L", "U", &c__2, &c__0, &alpha, a, &c__1, b, &c__2, &beta, c__, &
03694 c__2);
03695 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03696 infoc_1.infot = 7;
03697 chemm_("R", "U", &c__0, &c__2, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03698 c__1);
03699 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03700 infoc_1.infot = 7;
03701 chemm_("L", "L", &c__2, &c__0, &alpha, a, &c__1, b, &c__2, &beta, c__, &
03702 c__2);
03703 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03704 infoc_1.infot = 7;
03705 chemm_("R", "L", &c__0, &c__2, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03706 c__1);
03707 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03708 infoc_1.infot = 9;
03709 chemm_("L", "U", &c__2, &c__0, &alpha, a, &c__2, b, &c__1, &beta, c__, &
03710 c__2);
03711 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03712 infoc_1.infot = 9;
03713 chemm_("R", "U", &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03714 c__2);
03715 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03716 infoc_1.infot = 9;
03717 chemm_("L", "L", &c__2, &c__0, &alpha, a, &c__2, b, &c__1, &beta, c__, &
03718 c__2);
03719 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03720 infoc_1.infot = 9;
03721 chemm_("R", "L", &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03722 c__2);
03723 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03724 infoc_1.infot = 12;
03725 chemm_("L", "U", &c__2, &c__0, &alpha, a, &c__2, b, &c__2, &beta, c__, &
03726 c__1);
03727 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03728 infoc_1.infot = 12;
03729 chemm_("R", "U", &c__2, &c__0, &alpha, a, &c__1, b, &c__2, &beta, c__, &
03730 c__1);
03731 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03732 infoc_1.infot = 12;
03733 chemm_("L", "L", &c__2, &c__0, &alpha, a, &c__2, b, &c__2, &beta, c__, &
03734 c__1);
03735 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03736 infoc_1.infot = 12;
03737 chemm_("R", "L", &c__2, &c__0, &alpha, a, &c__1, b, &c__2, &beta, c__, &
03738 c__1);
03739 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03740 goto L100;
03741 L30:
03742 infoc_1.infot = 1;
03743 csymm_("/", "U", &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03744 c__1);
03745 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03746 infoc_1.infot = 2;
03747 csymm_("L", "/", &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03748 c__1);
03749 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03750 infoc_1.infot = 3;
03751 csymm_("L", "U", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03752 c__1);
03753 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03754 infoc_1.infot = 3;
03755 csymm_("R", "U", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03756 c__1);
03757 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03758 infoc_1.infot = 3;
03759 csymm_("L", "L", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03760 c__1);
03761 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03762 infoc_1.infot = 3;
03763 csymm_("R", "L", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03764 c__1);
03765 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03766 infoc_1.infot = 4;
03767 csymm_("L", "U", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03768 c__1);
03769 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03770 infoc_1.infot = 4;
03771 csymm_("R", "U", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03772 c__1);
03773 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03774 infoc_1.infot = 4;
03775 csymm_("L", "L", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03776 c__1);
03777 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03778 infoc_1.infot = 4;
03779 csymm_("R", "L", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03780 c__1);
03781 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03782 infoc_1.infot = 7;
03783 csymm_("L", "U", &c__2, &c__0, &alpha, a, &c__1, b, &c__2, &beta, c__, &
03784 c__2);
03785 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03786 infoc_1.infot = 7;
03787 csymm_("R", "U", &c__0, &c__2, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03788 c__1);
03789 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03790 infoc_1.infot = 7;
03791 csymm_("L", "L", &c__2, &c__0, &alpha, a, &c__1, b, &c__2, &beta, c__, &
03792 c__2);
03793 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03794 infoc_1.infot = 7;
03795 csymm_("R", "L", &c__0, &c__2, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03796 c__1);
03797 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03798 infoc_1.infot = 9;
03799 csymm_("L", "U", &c__2, &c__0, &alpha, a, &c__2, b, &c__1, &beta, c__, &
03800 c__2);
03801 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03802 infoc_1.infot = 9;
03803 csymm_("R", "U", &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03804 c__2);
03805 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03806 infoc_1.infot = 9;
03807 csymm_("L", "L", &c__2, &c__0, &alpha, a, &c__2, b, &c__1, &beta, c__, &
03808 c__2);
03809 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03810 infoc_1.infot = 9;
03811 csymm_("R", "L", &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
03812 c__2);
03813 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03814 infoc_1.infot = 12;
03815 csymm_("L", "U", &c__2, &c__0, &alpha, a, &c__2, b, &c__2, &beta, c__, &
03816 c__1);
03817 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03818 infoc_1.infot = 12;
03819 csymm_("R", "U", &c__2, &c__0, &alpha, a, &c__1, b, &c__2, &beta, c__, &
03820 c__1);
03821 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03822 infoc_1.infot = 12;
03823 csymm_("L", "L", &c__2, &c__0, &alpha, a, &c__2, b, &c__2, &beta, c__, &
03824 c__1);
03825 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03826 infoc_1.infot = 12;
03827 csymm_("R", "L", &c__2, &c__0, &alpha, a, &c__1, b, &c__2, &beta, c__, &
03828 c__1);
03829 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03830 goto L100;
03831 L40:
03832 infoc_1.infot = 1;
03833 ctrmm_("/", "U", "N", "N", &c__0, &c__0, &alpha, a, &c__1, b, &c__1);
03834 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03835 infoc_1.infot = 2;
03836 ctrmm_("L", "/", "N", "N", &c__0, &c__0, &alpha, a, &c__1, b, &c__1);
03837 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03838 infoc_1.infot = 3;
03839 ctrmm_("L", "U", "/", "N", &c__0, &c__0, &alpha, a, &c__1, b, &c__1);
03840 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03841 infoc_1.infot = 4;
03842 ctrmm_("L", "U", "N", "/", &c__0, &c__0, &alpha, a, &c__1, b, &c__1);
03843 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03844 infoc_1.infot = 5;
03845 ctrmm_("L", "U", "N", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03846 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03847 infoc_1.infot = 5;
03848 ctrmm_("L", "U", "C", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03849 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03850 infoc_1.infot = 5;
03851 ctrmm_("L", "U", "T", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03852 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03853 infoc_1.infot = 5;
03854 ctrmm_("R", "U", "N", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03855 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03856 infoc_1.infot = 5;
03857 ctrmm_("R", "U", "C", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03858 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03859 infoc_1.infot = 5;
03860 ctrmm_("R", "U", "T", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03861 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03862 infoc_1.infot = 5;
03863 ctrmm_("L", "L", "N", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03864 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03865 infoc_1.infot = 5;
03866 ctrmm_("L", "L", "C", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03867 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03868 infoc_1.infot = 5;
03869 ctrmm_("L", "L", "T", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03870 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03871 infoc_1.infot = 5;
03872 ctrmm_("R", "L", "N", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03873 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03874 infoc_1.infot = 5;
03875 ctrmm_("R", "L", "C", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03876 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03877 infoc_1.infot = 5;
03878 ctrmm_("R", "L", "T", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
03879 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03880 infoc_1.infot = 6;
03881 ctrmm_("L", "U", "N", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03882 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03883 infoc_1.infot = 6;
03884 ctrmm_("L", "U", "C", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03885 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03886 infoc_1.infot = 6;
03887 ctrmm_("L", "U", "T", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03888 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03889 infoc_1.infot = 6;
03890 ctrmm_("R", "U", "N", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03891 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03892 infoc_1.infot = 6;
03893 ctrmm_("R", "U", "C", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03894 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03895 infoc_1.infot = 6;
03896 ctrmm_("R", "U", "T", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03897 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03898 infoc_1.infot = 6;
03899 ctrmm_("L", "L", "N", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03900 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03901 infoc_1.infot = 6;
03902 ctrmm_("L", "L", "C", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03903 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03904 infoc_1.infot = 6;
03905 ctrmm_("L", "L", "T", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03906 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03907 infoc_1.infot = 6;
03908 ctrmm_("R", "L", "N", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03909 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03910 infoc_1.infot = 6;
03911 ctrmm_("R", "L", "C", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03912 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03913 infoc_1.infot = 6;
03914 ctrmm_("R", "L", "T", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
03915 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03916 infoc_1.infot = 9;
03917 ctrmm_("L", "U", "N", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__2);
03918 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03919 infoc_1.infot = 9;
03920 ctrmm_("L", "U", "C", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__2);
03921 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03922 infoc_1.infot = 9;
03923 ctrmm_("L", "U", "T", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__2);
03924 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03925 infoc_1.infot = 9;
03926 ctrmm_("R", "U", "N", "N", &c__0, &c__2, &alpha, a, &c__1, b, &c__1);
03927 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03928 infoc_1.infot = 9;
03929 ctrmm_("R", "U", "C", "N", &c__0, &c__2, &alpha, a, &c__1, b, &c__1);
03930 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03931 infoc_1.infot = 9;
03932 ctrmm_("R", "U", "T", "N", &c__0, &c__2, &alpha, a, &c__1, b, &c__1);
03933 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03934 infoc_1.infot = 9;
03935 ctrmm_("L", "L", "N", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__2);
03936 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03937 infoc_1.infot = 9;
03938 ctrmm_("L", "L", "C", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__2);
03939 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03940 infoc_1.infot = 9;
03941 ctrmm_("L", "L", "T", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__2);
03942 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03943 infoc_1.infot = 9;
03944 ctrmm_("R", "L", "N", "N", &c__0, &c__2, &alpha, a, &c__1, b, &c__1);
03945 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03946 infoc_1.infot = 9;
03947 ctrmm_("R", "L", "C", "N", &c__0, &c__2, &alpha, a, &c__1, b, &c__1);
03948 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03949 infoc_1.infot = 9;
03950 ctrmm_("R", "L", "T", "N", &c__0, &c__2, &alpha, a, &c__1, b, &c__1);
03951 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03952 infoc_1.infot = 11;
03953 ctrmm_("L", "U", "N", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1);
03954 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03955 infoc_1.infot = 11;
03956 ctrmm_("L", "U", "C", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1);
03957 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03958 infoc_1.infot = 11;
03959 ctrmm_("L", "U", "T", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1);
03960 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03961 infoc_1.infot = 11;
03962 ctrmm_("R", "U", "N", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1);
03963 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03964 infoc_1.infot = 11;
03965 ctrmm_("R", "U", "C", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1);
03966 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03967 infoc_1.infot = 11;
03968 ctrmm_("R", "U", "T", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1);
03969 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03970 infoc_1.infot = 11;
03971 ctrmm_("L", "L", "N", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1);
03972 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03973 infoc_1.infot = 11;
03974 ctrmm_("L", "L", "C", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1);
03975 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03976 infoc_1.infot = 11;
03977 ctrmm_("L", "L", "T", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1);
03978 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03979 infoc_1.infot = 11;
03980 ctrmm_("R", "L", "N", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1);
03981 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03982 infoc_1.infot = 11;
03983 ctrmm_("R", "L", "C", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1);
03984 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03985 infoc_1.infot = 11;
03986 ctrmm_("R", "L", "T", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1);
03987 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03988 goto L100;
03989 L50:
03990 infoc_1.infot = 1;
03991 ctrsm_("/", "U", "N", "N", &c__0, &c__0, &alpha, a, &c__1, b, &c__1);
03992 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03993 infoc_1.infot = 2;
03994 ctrsm_("L", "/", "N", "N", &c__0, &c__0, &alpha, a, &c__1, b, &c__1);
03995 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03996 infoc_1.infot = 3;
03997 ctrsm_("L", "U", "/", "N", &c__0, &c__0, &alpha, a, &c__1, b, &c__1);
03998 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
03999 infoc_1.infot = 4;
04000 ctrsm_("L", "U", "N", "/", &c__0, &c__0, &alpha, a, &c__1, b, &c__1);
04001 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04002 infoc_1.infot = 5;
04003 ctrsm_("L", "U", "N", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
04004 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04005 infoc_1.infot = 5;
04006 ctrsm_("L", "U", "C", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
04007 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04008 infoc_1.infot = 5;
04009 ctrsm_("L", "U", "T", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
04010 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04011 infoc_1.infot = 5;
04012 ctrsm_("R", "U", "N", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
04013 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04014 infoc_1.infot = 5;
04015 ctrsm_("R", "U", "C", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
04016 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04017 infoc_1.infot = 5;
04018 ctrsm_("R", "U", "T", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
04019 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04020 infoc_1.infot = 5;
04021 ctrsm_("L", "L", "N", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
04022 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04023 infoc_1.infot = 5;
04024 ctrsm_("L", "L", "C", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
04025 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04026 infoc_1.infot = 5;
04027 ctrsm_("L", "L", "T", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
04028 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04029 infoc_1.infot = 5;
04030 ctrsm_("R", "L", "N", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
04031 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04032 infoc_1.infot = 5;
04033 ctrsm_("R", "L", "C", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
04034 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04035 infoc_1.infot = 5;
04036 ctrsm_("R", "L", "T", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1);
04037 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04038 infoc_1.infot = 6;
04039 ctrsm_("L", "U", "N", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
04040 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04041 infoc_1.infot = 6;
04042 ctrsm_("L", "U", "C", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
04043 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04044 infoc_1.infot = 6;
04045 ctrsm_("L", "U", "T", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
04046 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04047 infoc_1.infot = 6;
04048 ctrsm_("R", "U", "N", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
04049 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04050 infoc_1.infot = 6;
04051 ctrsm_("R", "U", "C", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
04052 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04053 infoc_1.infot = 6;
04054 ctrsm_("R", "U", "T", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
04055 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04056 infoc_1.infot = 6;
04057 ctrsm_("L", "L", "N", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
04058 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04059 infoc_1.infot = 6;
04060 ctrsm_("L", "L", "C", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
04061 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04062 infoc_1.infot = 6;
04063 ctrsm_("L", "L", "T", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
04064 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04065 infoc_1.infot = 6;
04066 ctrsm_("R", "L", "N", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
04067 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04068 infoc_1.infot = 6;
04069 ctrsm_("R", "L", "C", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
04070 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04071 infoc_1.infot = 6;
04072 ctrsm_("R", "L", "T", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1);
04073 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04074 infoc_1.infot = 9;
04075 ctrsm_("L", "U", "N", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__2);
04076 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04077 infoc_1.infot = 9;
04078 ctrsm_("L", "U", "C", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__2);
04079 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04080 infoc_1.infot = 9;
04081 ctrsm_("L", "U", "T", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__2);
04082 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04083 infoc_1.infot = 9;
04084 ctrsm_("R", "U", "N", "N", &c__0, &c__2, &alpha, a, &c__1, b, &c__1);
04085 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04086 infoc_1.infot = 9;
04087 ctrsm_("R", "U", "C", "N", &c__0, &c__2, &alpha, a, &c__1, b, &c__1);
04088 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04089 infoc_1.infot = 9;
04090 ctrsm_("R", "U", "T", "N", &c__0, &c__2, &alpha, a, &c__1, b, &c__1);
04091 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04092 infoc_1.infot = 9;
04093 ctrsm_("L", "L", "N", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__2);
04094 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04095 infoc_1.infot = 9;
04096 ctrsm_("L", "L", "C", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__2);
04097 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04098 infoc_1.infot = 9;
04099 ctrsm_("L", "L", "T", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__2);
04100 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04101 infoc_1.infot = 9;
04102 ctrsm_("R", "L", "N", "N", &c__0, &c__2, &alpha, a, &c__1, b, &c__1);
04103 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04104 infoc_1.infot = 9;
04105 ctrsm_("R", "L", "C", "N", &c__0, &c__2, &alpha, a, &c__1, b, &c__1);
04106 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04107 infoc_1.infot = 9;
04108 ctrsm_("R", "L", "T", "N", &c__0, &c__2, &alpha, a, &c__1, b, &c__1);
04109 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04110 infoc_1.infot = 11;
04111 ctrsm_("L", "U", "N", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1);
04112 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04113 infoc_1.infot = 11;
04114 ctrsm_("L", "U", "C", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1);
04115 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04116 infoc_1.infot = 11;
04117 ctrsm_("L", "U", "T", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1);
04118 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04119 infoc_1.infot = 11;
04120 ctrsm_("R", "U", "N", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1);
04121 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04122 infoc_1.infot = 11;
04123 ctrsm_("R", "U", "C", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1);
04124 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04125 infoc_1.infot = 11;
04126 ctrsm_("R", "U", "T", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1);
04127 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04128 infoc_1.infot = 11;
04129 ctrsm_("L", "L", "N", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1);
04130 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04131 infoc_1.infot = 11;
04132 ctrsm_("L", "L", "C", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1);
04133 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04134 infoc_1.infot = 11;
04135 ctrsm_("L", "L", "T", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1);
04136 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04137 infoc_1.infot = 11;
04138 ctrsm_("R", "L", "N", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1);
04139 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04140 infoc_1.infot = 11;
04141 ctrsm_("R", "L", "C", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1);
04142 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04143 infoc_1.infot = 11;
04144 ctrsm_("R", "L", "T", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1);
04145 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04146 goto L100;
04147 L60:
04148 infoc_1.infot = 1;
04149 cherk_("/", "N", &c__0, &c__0, &ralpha, a, &c__1, &rbeta, c__, &c__1);
04150 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04151 infoc_1.infot = 2;
04152 cherk_("U", "T", &c__0, &c__0, &ralpha, a, &c__1, &rbeta, c__, &c__1);
04153 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04154 infoc_1.infot = 3;
04155 cherk_("U", "N", &c_n1, &c__0, &ralpha, a, &c__1, &rbeta, c__, &c__1);
04156 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04157 infoc_1.infot = 3;
04158 cherk_("U", "C", &c_n1, &c__0, &ralpha, a, &c__1, &rbeta, c__, &c__1);
04159 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04160 infoc_1.infot = 3;
04161 cherk_("L", "N", &c_n1, &c__0, &ralpha, a, &c__1, &rbeta, c__, &c__1);
04162 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04163 infoc_1.infot = 3;
04164 cherk_("L", "C", &c_n1, &c__0, &ralpha, a, &c__1, &rbeta, c__, &c__1);
04165 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04166 infoc_1.infot = 4;
04167 cherk_("U", "N", &c__0, &c_n1, &ralpha, a, &c__1, &rbeta, c__, &c__1);
04168 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04169 infoc_1.infot = 4;
04170 cherk_("U", "C", &c__0, &c_n1, &ralpha, a, &c__1, &rbeta, c__, &c__1);
04171 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04172 infoc_1.infot = 4;
04173 cherk_("L", "N", &c__0, &c_n1, &ralpha, a, &c__1, &rbeta, c__, &c__1);
04174 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04175 infoc_1.infot = 4;
04176 cherk_("L", "C", &c__0, &c_n1, &ralpha, a, &c__1, &rbeta, c__, &c__1);
04177 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04178 infoc_1.infot = 7;
04179 cherk_("U", "N", &c__2, &c__0, &ralpha, a, &c__1, &rbeta, c__, &c__2);
04180 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04181 infoc_1.infot = 7;
04182 cherk_("U", "C", &c__0, &c__2, &ralpha, a, &c__1, &rbeta, c__, &c__1);
04183 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04184 infoc_1.infot = 7;
04185 cherk_("L", "N", &c__2, &c__0, &ralpha, a, &c__1, &rbeta, c__, &c__2);
04186 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04187 infoc_1.infot = 7;
04188 cherk_("L", "C", &c__0, &c__2, &ralpha, a, &c__1, &rbeta, c__, &c__1);
04189 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04190 infoc_1.infot = 10;
04191 cherk_("U", "N", &c__2, &c__0, &ralpha, a, &c__2, &rbeta, c__, &c__1);
04192 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04193 infoc_1.infot = 10;
04194 cherk_("U", "C", &c__2, &c__0, &ralpha, a, &c__1, &rbeta, c__, &c__1);
04195 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04196 infoc_1.infot = 10;
04197 cherk_("L", "N", &c__2, &c__0, &ralpha, a, &c__2, &rbeta, c__, &c__1);
04198 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04199 infoc_1.infot = 10;
04200 cherk_("L", "C", &c__2, &c__0, &ralpha, a, &c__1, &rbeta, c__, &c__1);
04201 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04202 goto L100;
04203 L70:
04204 infoc_1.infot = 1;
04205 csyrk_("/", "N", &c__0, &c__0, &alpha, a, &c__1, &beta, c__, &c__1);
04206 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04207 infoc_1.infot = 2;
04208 csyrk_("U", "C", &c__0, &c__0, &alpha, a, &c__1, &beta, c__, &c__1);
04209 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04210 infoc_1.infot = 3;
04211 csyrk_("U", "N", &c_n1, &c__0, &alpha, a, &c__1, &beta, c__, &c__1);
04212 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04213 infoc_1.infot = 3;
04214 csyrk_("U", "T", &c_n1, &c__0, &alpha, a, &c__1, &beta, c__, &c__1);
04215 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04216 infoc_1.infot = 3;
04217 csyrk_("L", "N", &c_n1, &c__0, &alpha, a, &c__1, &beta, c__, &c__1);
04218 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04219 infoc_1.infot = 3;
04220 csyrk_("L", "T", &c_n1, &c__0, &alpha, a, &c__1, &beta, c__, &c__1);
04221 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04222 infoc_1.infot = 4;
04223 csyrk_("U", "N", &c__0, &c_n1, &alpha, a, &c__1, &beta, c__, &c__1);
04224 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04225 infoc_1.infot = 4;
04226 csyrk_("U", "T", &c__0, &c_n1, &alpha, a, &c__1, &beta, c__, &c__1);
04227 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04228 infoc_1.infot = 4;
04229 csyrk_("L", "N", &c__0, &c_n1, &alpha, a, &c__1, &beta, c__, &c__1);
04230 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04231 infoc_1.infot = 4;
04232 csyrk_("L", "T", &c__0, &c_n1, &alpha, a, &c__1, &beta, c__, &c__1);
04233 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04234 infoc_1.infot = 7;
04235 csyrk_("U", "N", &c__2, &c__0, &alpha, a, &c__1, &beta, c__, &c__2);
04236 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04237 infoc_1.infot = 7;
04238 csyrk_("U", "T", &c__0, &c__2, &alpha, a, &c__1, &beta, c__, &c__1);
04239 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04240 infoc_1.infot = 7;
04241 csyrk_("L", "N", &c__2, &c__0, &alpha, a, &c__1, &beta, c__, &c__2);
04242 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04243 infoc_1.infot = 7;
04244 csyrk_("L", "T", &c__0, &c__2, &alpha, a, &c__1, &beta, c__, &c__1);
04245 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04246 infoc_1.infot = 10;
04247 csyrk_("U", "N", &c__2, &c__0, &alpha, a, &c__2, &beta, c__, &c__1);
04248 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04249 infoc_1.infot = 10;
04250 csyrk_("U", "T", &c__2, &c__0, &alpha, a, &c__1, &beta, c__, &c__1);
04251 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04252 infoc_1.infot = 10;
04253 csyrk_("L", "N", &c__2, &c__0, &alpha, a, &c__2, &beta, c__, &c__1);
04254 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04255 infoc_1.infot = 10;
04256 csyrk_("L", "T", &c__2, &c__0, &alpha, a, &c__1, &beta, c__, &c__1);
04257 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04258 goto L100;
04259 L80:
04260 infoc_1.infot = 1;
04261 cher2k_("/", "N", &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &rbeta, c__, &
04262 c__1);
04263 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04264 infoc_1.infot = 2;
04265 cher2k_("U", "T", &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &rbeta, c__, &
04266 c__1);
04267 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04268 infoc_1.infot = 3;
04269 cher2k_("U", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &rbeta, c__, &
04270 c__1);
04271 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04272 infoc_1.infot = 3;
04273 cher2k_("U", "C", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &rbeta, c__, &
04274 c__1);
04275 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04276 infoc_1.infot = 3;
04277 cher2k_("L", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &rbeta, c__, &
04278 c__1);
04279 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04280 infoc_1.infot = 3;
04281 cher2k_("L", "C", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &rbeta, c__, &
04282 c__1);
04283 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04284 infoc_1.infot = 4;
04285 cher2k_("U", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &rbeta, c__, &
04286 c__1);
04287 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04288 infoc_1.infot = 4;
04289 cher2k_("U", "C", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &rbeta, c__, &
04290 c__1);
04291 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04292 infoc_1.infot = 4;
04293 cher2k_("L", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &rbeta, c__, &
04294 c__1);
04295 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04296 infoc_1.infot = 4;
04297 cher2k_("L", "C", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &rbeta, c__, &
04298 c__1);
04299 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04300 infoc_1.infot = 7;
04301 cher2k_("U", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &rbeta, c__, &
04302 c__2);
04303 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04304 infoc_1.infot = 7;
04305 cher2k_("U", "C", &c__0, &c__2, &alpha, a, &c__1, b, &c__1, &rbeta, c__, &
04306 c__1);
04307 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04308 infoc_1.infot = 7;
04309 cher2k_("L", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &rbeta, c__, &
04310 c__2);
04311 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04312 infoc_1.infot = 7;
04313 cher2k_("L", "C", &c__0, &c__2, &alpha, a, &c__1, b, &c__1, &rbeta, c__, &
04314 c__1);
04315 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04316 infoc_1.infot = 9;
04317 cher2k_("U", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1, &rbeta, c__, &
04318 c__2);
04319 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04320 infoc_1.infot = 9;
04321 cher2k_("U", "C", &c__0, &c__2, &alpha, a, &c__2, b, &c__1, &rbeta, c__, &
04322 c__1);
04323 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04324 infoc_1.infot = 9;
04325 cher2k_("L", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1, &rbeta, c__, &
04326 c__2);
04327 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04328 infoc_1.infot = 9;
04329 cher2k_("L", "C", &c__0, &c__2, &alpha, a, &c__2, b, &c__1, &rbeta, c__, &
04330 c__1);
04331 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04332 infoc_1.infot = 12;
04333 cher2k_("U", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__2, &rbeta, c__, &
04334 c__1);
04335 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04336 infoc_1.infot = 12;
04337 cher2k_("U", "C", &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &rbeta, c__, &
04338 c__1);
04339 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04340 infoc_1.infot = 12;
04341 cher2k_("L", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__2, &rbeta, c__, &
04342 c__1);
04343 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04344 infoc_1.infot = 12;
04345 cher2k_("L", "C", &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &rbeta, c__, &
04346 c__1);
04347 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04348 goto L100;
04349 L90:
04350 infoc_1.infot = 1;
04351 csyr2k_("/", "N", &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
04352 c__1);
04353 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04354 infoc_1.infot = 2;
04355 csyr2k_("U", "C", &c__0, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
04356 c__1);
04357 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04358 infoc_1.infot = 3;
04359 csyr2k_("U", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
04360 c__1);
04361 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04362 infoc_1.infot = 3;
04363 csyr2k_("U", "T", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
04364 c__1);
04365 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04366 infoc_1.infot = 3;
04367 csyr2k_("L", "N", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
04368 c__1);
04369 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04370 infoc_1.infot = 3;
04371 csyr2k_("L", "T", &c_n1, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
04372 c__1);
04373 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04374 infoc_1.infot = 4;
04375 csyr2k_("U", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta, c__, &
04376 c__1);
04377 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04378 infoc_1.infot = 4;
04379 csyr2k_("U", "T", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta, c__, &
04380 c__1);
04381 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04382 infoc_1.infot = 4;
04383 csyr2k_("L", "N", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta, c__, &
04384 c__1);
04385 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04386 infoc_1.infot = 4;
04387 csyr2k_("L", "T", &c__0, &c_n1, &alpha, a, &c__1, b, &c__1, &beta, c__, &
04388 c__1);
04389 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04390 infoc_1.infot = 7;
04391 csyr2k_("U", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
04392 c__2);
04393 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04394 infoc_1.infot = 7;
04395 csyr2k_("U", "T", &c__0, &c__2, &alpha, a, &c__1, b, &c__1, &beta, c__, &
04396 c__1);
04397 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04398 infoc_1.infot = 7;
04399 csyr2k_("L", "N", &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
04400 c__2);
04401 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04402 infoc_1.infot = 7;
04403 csyr2k_("L", "T", &c__0, &c__2, &alpha, a, &c__1, b, &c__1, &beta, c__, &
04404 c__1);
04405 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04406 infoc_1.infot = 9;
04407 csyr2k_("U", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1, &beta, c__, &
04408 c__2);
04409 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04410 infoc_1.infot = 9;
04411 csyr2k_("U", "T", &c__0, &c__2, &alpha, a, &c__2, b, &c__1, &beta, c__, &
04412 c__1);
04413 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04414 infoc_1.infot = 9;
04415 csyr2k_("L", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__1, &beta, c__, &
04416 c__2);
04417 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04418 infoc_1.infot = 9;
04419 csyr2k_("L", "T", &c__0, &c__2, &alpha, a, &c__2, b, &c__1, &beta, c__, &
04420 c__1);
04421 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04422 infoc_1.infot = 12;
04423 csyr2k_("U", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__2, &beta, c__, &
04424 c__1);
04425 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04426 infoc_1.infot = 12;
04427 csyr2k_("U", "T", &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
04428 c__1);
04429 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04430 infoc_1.infot = 12;
04431 csyr2k_("L", "N", &c__2, &c__0, &alpha, a, &c__2, b, &c__2, &beta, c__, &
04432 c__1);
04433 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04434 infoc_1.infot = 12;
04435 csyr2k_("L", "T", &c__2, &c__0, &alpha, a, &c__1, b, &c__1, &beta, c__, &
04436 c__1);
04437 chkxer_(srnamt, &infoc_1.infot, nout, &infoc_1.lerr, &infoc_1.ok);
04438
04439 L100:
04440 if (infoc_1.ok) {
04441 io___360.ciunit = *nout;
04442 s_wsfe(&io___360);
04443 do_fio(&c__1, srnamt, (ftnlen)6);
04444 e_wsfe();
04445 } else {
04446 io___361.ciunit = *nout;
04447 s_wsfe(&io___361);
04448 do_fio(&c__1, srnamt, (ftnlen)6);
04449 e_wsfe();
04450 }
04451 return 0;
04452
04453
04454
04455
04456 }
04457
04458 int cmake_(char *type__, char *uplo, char *diag, integer *m,
04459 integer *n, complex *a, integer *nmax, complex *aa, integer *lda,
04460 logical *reset, complex *transl, ftnlen type_len, ftnlen uplo_len,
04461 ftnlen diag_len)
04462 {
04463
04464 integer a_dim1, a_offset, i__1, i__2, i__3, i__4;
04465 real r__1;
04466 complex q__1, q__2;
04467
04468
04469 integer s_cmp(char *, char *, ftnlen, ftnlen);
04470 void r_cnjg(complex *, complex *);
04471
04472
04473 integer i__, j, jj;
04474 logical gen, her, tri, sym;
04475 extern VOID cbeg_(complex *, logical *);
04476 integer ibeg, iend;
04477 logical unit, lower, upper;
04478
04479
04480
04481
04482
04483
04484
04485
04486
04487
04488
04489
04490
04491
04492
04493
04494
04495
04496
04497
04498
04499
04500
04501
04502 a_dim1 = *nmax;
04503 a_offset = 1 + a_dim1;
04504 a -= a_offset;
04505 --aa;
04506
04507
04508 gen = s_cmp(type__, "GE", (ftnlen)2, (ftnlen)2) == 0;
04509 her = s_cmp(type__, "HE", (ftnlen)2, (ftnlen)2) == 0;
04510 sym = s_cmp(type__, "SY", (ftnlen)2, (ftnlen)2) == 0;
04511 tri = s_cmp(type__, "TR", (ftnlen)2, (ftnlen)2) == 0;
04512 upper = (her || sym || tri) && *(unsigned char *)uplo == 'U';
04513 lower = (her || sym || tri) && *(unsigned char *)uplo == 'L';
04514 unit = tri && *(unsigned char *)diag == 'U';
04515
04516
04517
04518 i__1 = *n;
04519 for (j = 1; j <= i__1; ++j) {
04520 i__2 = *m;
04521 for (i__ = 1; i__ <= i__2; ++i__) {
04522 if (gen || upper && i__ <= j || lower && i__ >= j) {
04523 i__3 = i__ + j * a_dim1;
04524 cbeg_(&q__2, reset);
04525 q__1.r = q__2.r + transl->r, q__1.i = q__2.i + transl->i;
04526 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
04527 if (i__ != j) {
04528
04529 if (*n > 3 && j == *n / 2) {
04530 i__3 = i__ + j * a_dim1;
04531 a[i__3].r = 0.f, a[i__3].i = 0.f;
04532 }
04533 if (her) {
04534 i__3 = j + i__ * a_dim1;
04535 r_cnjg(&q__1, &a[i__ + j * a_dim1]);
04536 a[i__3].r = q__1.r, a[i__3].i = q__1.i;
04537 } else if (sym) {
04538 i__3 = j + i__ * a_dim1;
04539 i__4 = i__ + j * a_dim1;
04540 a[i__3].r = a[i__4].r, a[i__3].i = a[i__4].i;
04541 } else if (tri) {
04542 i__3 = j + i__ * a_dim1;
04543 a[i__3].r = 0.f, a[i__3].i = 0.f;
04544 }
04545 }
04546 }
04547
04548 }
04549 if (her) {
04550 i__2 = j + j * a_dim1;
04551 i__3 = j + j * a_dim1;
04552 r__1 = a[i__3].r;
04553 q__1.r = r__1, q__1.i = 0.f;
04554 a[i__2].r = q__1.r, a[i__2].i = q__1.i;
04555 }
04556 if (tri) {
04557 i__2 = j + j * a_dim1;
04558 i__3 = j + j * a_dim1;
04559 q__1.r = a[i__3].r + 1.f, q__1.i = a[i__3].i + 0.f;
04560 a[i__2].r = q__1.r, a[i__2].i = q__1.i;
04561 }
04562 if (unit) {
04563 i__2 = j + j * a_dim1;
04564 a[i__2].r = 1.f, a[i__2].i = 0.f;
04565 }
04566
04567 }
04568
04569
04570
04571 if (s_cmp(type__, "GE", (ftnlen)2, (ftnlen)2) == 0) {
04572 i__1 = *n;
04573 for (j = 1; j <= i__1; ++j) {
04574 i__2 = *m;
04575 for (i__ = 1; i__ <= i__2; ++i__) {
04576 i__3 = i__ + (j - 1) * *lda;
04577 i__4 = i__ + j * a_dim1;
04578 aa[i__3].r = a[i__4].r, aa[i__3].i = a[i__4].i;
04579
04580 }
04581 i__2 = *lda;
04582 for (i__ = *m + 1; i__ <= i__2; ++i__) {
04583 i__3 = i__ + (j - 1) * *lda;
04584 aa[i__3].r = -1e10f, aa[i__3].i = 1e10f;
04585
04586 }
04587
04588 }
04589 } else if (s_cmp(type__, "HE", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(type__,
04590 "SY", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(type__, "TR", (ftnlen)
04591 2, (ftnlen)2) == 0) {
04592 i__1 = *n;
04593 for (j = 1; j <= i__1; ++j) {
04594 if (upper) {
04595 ibeg = 1;
04596 if (unit) {
04597 iend = j - 1;
04598 } else {
04599 iend = j;
04600 }
04601 } else {
04602 if (unit) {
04603 ibeg = j + 1;
04604 } else {
04605 ibeg = j;
04606 }
04607 iend = *n;
04608 }
04609 i__2 = ibeg - 1;
04610 for (i__ = 1; i__ <= i__2; ++i__) {
04611 i__3 = i__ + (j - 1) * *lda;
04612 aa[i__3].r = -1e10f, aa[i__3].i = 1e10f;
04613
04614 }
04615 i__2 = iend;
04616 for (i__ = ibeg; i__ <= i__2; ++i__) {
04617 i__3 = i__ + (j - 1) * *lda;
04618 i__4 = i__ + j * a_dim1;
04619 aa[i__3].r = a[i__4].r, aa[i__3].i = a[i__4].i;
04620
04621 }
04622 i__2 = *lda;
04623 for (i__ = iend + 1; i__ <= i__2; ++i__) {
04624 i__3 = i__ + (j - 1) * *lda;
04625 aa[i__3].r = -1e10f, aa[i__3].i = 1e10f;
04626
04627 }
04628 if (her) {
04629 jj = j + (j - 1) * *lda;
04630 i__2 = jj;
04631 i__3 = jj;
04632 r__1 = aa[i__3].r;
04633 q__1.r = r__1, q__1.i = -1e10f;
04634 aa[i__2].r = q__1.r, aa[i__2].i = q__1.i;
04635 }
04636
04637 }
04638 }
04639 return 0;
04640
04641
04642
04643 }
04644
04645 int cmmch_(char *transa, char *transb, integer *m, integer *
04646 n, integer *kk, complex *alpha, complex *a, integer *lda, complex *b,
04647 integer *ldb, complex *beta, complex *c__, integer *ldc, complex *ct,
04648 real *g, complex *cc, integer *ldcc, real *eps, real *err, logical *
04649 fatal, integer *nout, logical *mv, ftnlen transa_len, ftnlen
04650 transb_len)
04651 {
04652
04653 static char fmt_9999[] = "(\002 ******* FATAL ERROR - COMPUTED RESULT IS"
04654 " LESS THAN HAL\002,\002F ACCURATE *******\002,/\002 "
04655 " EXPECTED RE\002,\002SULT COMPUTED R"
04656 "ESULT\002)";
04657 static char fmt_9998[] = "(1x,i7,2(\002 (\002,g15.6,\002,\002,g15.6,"
04658 "\002)\002))";
04659 static char fmt_9997[] = "(\002 THESE ARE THE RESULTS FOR COLUMN"
04660 " \002,i3)";
04661
04662
04663 integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, cc_dim1,
04664 cc_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7;
04665 real r__1, r__2, r__3, r__4, r__5, r__6;
04666 complex q__1, q__2, q__3, q__4;
04667
04668
04669 double r_imag(complex *);
04670 void r_cnjg(complex *, complex *);
04671 double sqrt(doublereal);
04672 integer s_wsfe(cilist *), e_wsfe(void), do_fio(integer *, char *, ftnlen);
04673
04674
04675 integer i__, j, k;
04676 real erri;
04677 logical trana, tranb, ctrana, ctranb;
04678
04679
04680 static cilist io___382 = { 0, 0, 0, fmt_9999, 0 };
04681 static cilist io___383 = { 0, 0, 0, fmt_9998, 0 };
04682 static cilist io___384 = { 0, 0, 0, fmt_9998, 0 };
04683 static cilist io___385 = { 0, 0, 0, fmt_9997, 0 };
04684
04685
04686
04687
04688
04689
04690
04691
04692
04693
04694
04695
04696
04697
04698
04699
04700
04701
04702
04703
04704
04705
04706 a_dim1 = *lda;
04707 a_offset = 1 + a_dim1;
04708 a -= a_offset;
04709 b_dim1 = *ldb;
04710 b_offset = 1 + b_dim1;
04711 b -= b_offset;
04712 c_dim1 = *ldc;
04713 c_offset = 1 + c_dim1;
04714 c__ -= c_offset;
04715 --ct;
04716 --g;
04717 cc_dim1 = *ldcc;
04718 cc_offset = 1 + cc_dim1;
04719 cc -= cc_offset;
04720
04721
04722 trana = *(unsigned char *)transa == 'T' || *(unsigned char *)transa ==
04723 'C';
04724 tranb = *(unsigned char *)transb == 'T' || *(unsigned char *)transb ==
04725 'C';
04726 ctrana = *(unsigned char *)transa == 'C';
04727 ctranb = *(unsigned char *)transb == 'C';
04728
04729
04730
04731
04732
04733 i__1 = *n;
04734 for (j = 1; j <= i__1; ++j) {
04735
04736 i__2 = *m;
04737 for (i__ = 1; i__ <= i__2; ++i__) {
04738 i__3 = i__;
04739 ct[i__3].r = 0.f, ct[i__3].i = 0.f;
04740 g[i__] = 0.f;
04741
04742 }
04743 if (! trana && ! tranb) {
04744 i__2 = *kk;
04745 for (k = 1; k <= i__2; ++k) {
04746 i__3 = *m;
04747 for (i__ = 1; i__ <= i__3; ++i__) {
04748 i__4 = i__;
04749 i__5 = i__;
04750 i__6 = i__ + k * a_dim1;
04751 i__7 = k + j * b_dim1;
04752 q__2.r = a[i__6].r * b[i__7].r - a[i__6].i * b[i__7].i,
04753 q__2.i = a[i__6].r * b[i__7].i + a[i__6].i * b[
04754 i__7].r;
04755 q__1.r = ct[i__5].r + q__2.r, q__1.i = ct[i__5].i +
04756 q__2.i;
04757 ct[i__4].r = q__1.r, ct[i__4].i = q__1.i;
04758 i__4 = i__ + k * a_dim1;
04759 i__5 = k + j * b_dim1;
04760 g[i__] += ((r__1 = a[i__4].r, dabs(r__1)) + (r__2 =
04761 r_imag(&a[i__ + k * a_dim1]), dabs(r__2))) * ((
04762 r__3 = b[i__5].r, dabs(r__3)) + (r__4 = r_imag(&b[
04763 k + j * b_dim1]), dabs(r__4)));
04764
04765 }
04766
04767 }
04768 } else if (trana && ! tranb) {
04769 if (ctrana) {
04770 i__2 = *kk;
04771 for (k = 1; k <= i__2; ++k) {
04772 i__3 = *m;
04773 for (i__ = 1; i__ <= i__3; ++i__) {
04774 i__4 = i__;
04775 i__5 = i__;
04776 r_cnjg(&q__3, &a[k + i__ * a_dim1]);
04777 i__6 = k + j * b_dim1;
04778 q__2.r = q__3.r * b[i__6].r - q__3.i * b[i__6].i,
04779 q__2.i = q__3.r * b[i__6].i + q__3.i * b[i__6]
04780 .r;
04781 q__1.r = ct[i__5].r + q__2.r, q__1.i = ct[i__5].i +
04782 q__2.i;
04783 ct[i__4].r = q__1.r, ct[i__4].i = q__1.i;
04784 i__4 = k + i__ * a_dim1;
04785 i__5 = k + j * b_dim1;
04786 g[i__] += ((r__1 = a[i__4].r, dabs(r__1)) + (r__2 =
04787 r_imag(&a[k + i__ * a_dim1]), dabs(r__2))) * (
04788 (r__3 = b[i__5].r, dabs(r__3)) + (r__4 =
04789 r_imag(&b[k + j * b_dim1]), dabs(r__4)));
04790
04791 }
04792
04793 }
04794 } else {
04795 i__2 = *kk;
04796 for (k = 1; k <= i__2; ++k) {
04797 i__3 = *m;
04798 for (i__ = 1; i__ <= i__3; ++i__) {
04799 i__4 = i__;
04800 i__5 = i__;
04801 i__6 = k + i__ * a_dim1;
04802 i__7 = k + j * b_dim1;
04803 q__2.r = a[i__6].r * b[i__7].r - a[i__6].i * b[i__7]
04804 .i, q__2.i = a[i__6].r * b[i__7].i + a[i__6]
04805 .i * b[i__7].r;
04806 q__1.r = ct[i__5].r + q__2.r, q__1.i = ct[i__5].i +
04807 q__2.i;
04808 ct[i__4].r = q__1.r, ct[i__4].i = q__1.i;
04809 i__4 = k + i__ * a_dim1;
04810 i__5 = k + j * b_dim1;
04811 g[i__] += ((r__1 = a[i__4].r, dabs(r__1)) + (r__2 =
04812 r_imag(&a[k + i__ * a_dim1]), dabs(r__2))) * (
04813 (r__3 = b[i__5].r, dabs(r__3)) + (r__4 =
04814 r_imag(&b[k + j * b_dim1]), dabs(r__4)));
04815
04816 }
04817
04818 }
04819 }
04820 } else if (! trana && tranb) {
04821 if (ctranb) {
04822 i__2 = *kk;
04823 for (k = 1; k <= i__2; ++k) {
04824 i__3 = *m;
04825 for (i__ = 1; i__ <= i__3; ++i__) {
04826 i__4 = i__;
04827 i__5 = i__;
04828 i__6 = i__ + k * a_dim1;
04829 r_cnjg(&q__3, &b[j + k * b_dim1]);
04830 q__2.r = a[i__6].r * q__3.r - a[i__6].i * q__3.i,
04831 q__2.i = a[i__6].r * q__3.i + a[i__6].i *
04832 q__3.r;
04833 q__1.r = ct[i__5].r + q__2.r, q__1.i = ct[i__5].i +
04834 q__2.i;
04835 ct[i__4].r = q__1.r, ct[i__4].i = q__1.i;
04836 i__4 = i__ + k * a_dim1;
04837 i__5 = j + k * b_dim1;
04838 g[i__] += ((r__1 = a[i__4].r, dabs(r__1)) + (r__2 =
04839 r_imag(&a[i__ + k * a_dim1]), dabs(r__2))) * (
04840 (r__3 = b[i__5].r, dabs(r__3)) + (r__4 =
04841 r_imag(&b[j + k * b_dim1]), dabs(r__4)));
04842
04843 }
04844
04845 }
04846 } else {
04847 i__2 = *kk;
04848 for (k = 1; k <= i__2; ++k) {
04849 i__3 = *m;
04850 for (i__ = 1; i__ <= i__3; ++i__) {
04851 i__4 = i__;
04852 i__5 = i__;
04853 i__6 = i__ + k * a_dim1;
04854 i__7 = j + k * b_dim1;
04855 q__2.r = a[i__6].r * b[i__7].r - a[i__6].i * b[i__7]
04856 .i, q__2.i = a[i__6].r * b[i__7].i + a[i__6]
04857 .i * b[i__7].r;
04858 q__1.r = ct[i__5].r + q__2.r, q__1.i = ct[i__5].i +
04859 q__2.i;
04860 ct[i__4].r = q__1.r, ct[i__4].i = q__1.i;
04861 i__4 = i__ + k * a_dim1;
04862 i__5 = j + k * b_dim1;
04863 g[i__] += ((r__1 = a[i__4].r, dabs(r__1)) + (r__2 =
04864 r_imag(&a[i__ + k * a_dim1]), dabs(r__2))) * (
04865 (r__3 = b[i__5].r, dabs(r__3)) + (r__4 =
04866 r_imag(&b[j + k * b_dim1]), dabs(r__4)));
04867
04868 }
04869
04870 }
04871 }
04872 } else if (trana && tranb) {
04873 if (ctrana) {
04874 if (ctranb) {
04875 i__2 = *kk;
04876 for (k = 1; k <= i__2; ++k) {
04877 i__3 = *m;
04878 for (i__ = 1; i__ <= i__3; ++i__) {
04879 i__4 = i__;
04880 i__5 = i__;
04881 r_cnjg(&q__3, &a[k + i__ * a_dim1]);
04882 r_cnjg(&q__4, &b[j + k * b_dim1]);
04883 q__2.r = q__3.r * q__4.r - q__3.i * q__4.i,
04884 q__2.i = q__3.r * q__4.i + q__3.i *
04885 q__4.r;
04886 q__1.r = ct[i__5].r + q__2.r, q__1.i = ct[i__5].i
04887 + q__2.i;
04888 ct[i__4].r = q__1.r, ct[i__4].i = q__1.i;
04889 i__4 = k + i__ * a_dim1;
04890 i__5 = j + k * b_dim1;
04891 g[i__] += ((r__1 = a[i__4].r, dabs(r__1)) + (r__2
04892 = r_imag(&a[k + i__ * a_dim1]), dabs(r__2)
04893 )) * ((r__3 = b[i__5].r, dabs(r__3)) + (
04894 r__4 = r_imag(&b[j + k * b_dim1]), dabs(
04895 r__4)));
04896
04897 }
04898
04899 }
04900 } else {
04901 i__2 = *kk;
04902 for (k = 1; k <= i__2; ++k) {
04903 i__3 = *m;
04904 for (i__ = 1; i__ <= i__3; ++i__) {
04905 i__4 = i__;
04906 i__5 = i__;
04907 r_cnjg(&q__3, &a[k + i__ * a_dim1]);
04908 i__6 = j + k * b_dim1;
04909 q__2.r = q__3.r * b[i__6].r - q__3.i * b[i__6].i,
04910 q__2.i = q__3.r * b[i__6].i + q__3.i * b[
04911 i__6].r;
04912 q__1.r = ct[i__5].r + q__2.r, q__1.i = ct[i__5].i
04913 + q__2.i;
04914 ct[i__4].r = q__1.r, ct[i__4].i = q__1.i;
04915 i__4 = k + i__ * a_dim1;
04916 i__5 = j + k * b_dim1;
04917 g[i__] += ((r__1 = a[i__4].r, dabs(r__1)) + (r__2
04918 = r_imag(&a[k + i__ * a_dim1]), dabs(r__2)
04919 )) * ((r__3 = b[i__5].r, dabs(r__3)) + (
04920 r__4 = r_imag(&b[j + k * b_dim1]), dabs(
04921 r__4)));
04922
04923 }
04924
04925 }
04926 }
04927 } else {
04928 if (ctranb) {
04929 i__2 = *kk;
04930 for (k = 1; k <= i__2; ++k) {
04931 i__3 = *m;
04932 for (i__ = 1; i__ <= i__3; ++i__) {
04933 i__4 = i__;
04934 i__5 = i__;
04935 i__6 = k + i__ * a_dim1;
04936 r_cnjg(&q__3, &b[j + k * b_dim1]);
04937 q__2.r = a[i__6].r * q__3.r - a[i__6].i * q__3.i,
04938 q__2.i = a[i__6].r * q__3.i + a[i__6].i *
04939 q__3.r;
04940 q__1.r = ct[i__5].r + q__2.r, q__1.i = ct[i__5].i
04941 + q__2.i;
04942 ct[i__4].r = q__1.r, ct[i__4].i = q__1.i;
04943 i__4 = k + i__ * a_dim1;
04944 i__5 = j + k * b_dim1;
04945 g[i__] += ((r__1 = a[i__4].r, dabs(r__1)) + (r__2
04946 = r_imag(&a[k + i__ * a_dim1]), dabs(r__2)
04947 )) * ((r__3 = b[i__5].r, dabs(r__3)) + (
04948 r__4 = r_imag(&b[j + k * b_dim1]), dabs(
04949 r__4)));
04950
04951 }
04952
04953 }
04954 } else {
04955 i__2 = *kk;
04956 for (k = 1; k <= i__2; ++k) {
04957 i__3 = *m;
04958 for (i__ = 1; i__ <= i__3; ++i__) {
04959 i__4 = i__;
04960 i__5 = i__;
04961 i__6 = k + i__ * a_dim1;
04962 i__7 = j + k * b_dim1;
04963 q__2.r = a[i__6].r * b[i__7].r - a[i__6].i * b[
04964 i__7].i, q__2.i = a[i__6].r * b[i__7].i +
04965 a[i__6].i * b[i__7].r;
04966 q__1.r = ct[i__5].r + q__2.r, q__1.i = ct[i__5].i
04967 + q__2.i;
04968 ct[i__4].r = q__1.r, ct[i__4].i = q__1.i;
04969 i__4 = k + i__ * a_dim1;
04970 i__5 = j + k * b_dim1;
04971 g[i__] += ((r__1 = a[i__4].r, dabs(r__1)) + (r__2
04972 = r_imag(&a[k + i__ * a_dim1]), dabs(r__2)
04973 )) * ((r__3 = b[i__5].r, dabs(r__3)) + (
04974 r__4 = r_imag(&b[j + k * b_dim1]), dabs(
04975 r__4)));
04976
04977 }
04978
04979 }
04980 }
04981 }
04982 }
04983 i__2 = *m;
04984 for (i__ = 1; i__ <= i__2; ++i__) {
04985 i__3 = i__;
04986 i__4 = i__;
04987 q__2.r = alpha->r * ct[i__4].r - alpha->i * ct[i__4].i, q__2.i =
04988 alpha->r * ct[i__4].i + alpha->i * ct[i__4].r;
04989 i__5 = i__ + j * c_dim1;
04990 q__3.r = beta->r * c__[i__5].r - beta->i * c__[i__5].i, q__3.i =
04991 beta->r * c__[i__5].i + beta->i * c__[i__5].r;
04992 q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;
04993 ct[i__3].r = q__1.r, ct[i__3].i = q__1.i;
04994 i__3 = i__ + j * c_dim1;
04995 g[i__] = ((r__1 = alpha->r, dabs(r__1)) + (r__2 = r_imag(alpha),
04996 dabs(r__2))) * g[i__] + ((r__3 = beta->r, dabs(r__3)) + (
04997 r__4 = r_imag(beta), dabs(r__4))) * ((r__5 = c__[i__3].r,
04998 dabs(r__5)) + (r__6 = r_imag(&c__[i__ + j * c_dim1]),
04999 dabs(r__6)));
05000
05001 }
05002
05003
05004
05005 *err = 0.f;
05006 i__2 = *m;
05007 for (i__ = 1; i__ <= i__2; ++i__) {
05008 i__3 = i__;
05009 i__4 = i__ + j * cc_dim1;
05010 q__2.r = ct[i__3].r - cc[i__4].r, q__2.i = ct[i__3].i - cc[i__4]
05011 .i;
05012 q__1.r = q__2.r, q__1.i = q__2.i;
05013 erri = ((r__1 = q__1.r, dabs(r__1)) + (r__2 = r_imag(&q__1), dabs(
05014 r__2))) / *eps;
05015 if (g[i__] != 0.f) {
05016 erri /= g[i__];
05017 }
05018 *err = dmax(*err,erri);
05019 if (*err * sqrt(*eps) >= 1.f) {
05020 goto L230;
05021 }
05022
05023 }
05024
05025
05026 }
05027
05028
05029 goto L250;
05030
05031
05032
05033 L230:
05034 *fatal = TRUE_;
05035 io___382.ciunit = *nout;
05036 s_wsfe(&io___382);
05037 e_wsfe();
05038 i__1 = *m;
05039 for (i__ = 1; i__ <= i__1; ++i__) {
05040 if (*mv) {
05041 io___383.ciunit = *nout;
05042 s_wsfe(&io___383);
05043 do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
05044 do_fio(&c__2, (char *)&ct[i__], (ftnlen)sizeof(real));
05045 do_fio(&c__2, (char *)&cc[i__ + j * cc_dim1], (ftnlen)sizeof(real)
05046 );
05047 e_wsfe();
05048 } else {
05049 io___384.ciunit = *nout;
05050 s_wsfe(&io___384);
05051 do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
05052 do_fio(&c__2, (char *)&cc[i__ + j * cc_dim1], (ftnlen)sizeof(real)
05053 );
05054 do_fio(&c__2, (char *)&ct[i__], (ftnlen)sizeof(real));
05055 e_wsfe();
05056 }
05057
05058 }
05059 if (*n > 1) {
05060 io___385.ciunit = *nout;
05061 s_wsfe(&io___385);
05062 do_fio(&c__1, (char *)&j, (ftnlen)sizeof(integer));
05063 e_wsfe();
05064 }
05065
05066 L250:
05067 return 0;
05068
05069
05070
05071
05072 }
05073
05074 logical lce_(complex *ri, complex *rj, integer *lr)
05075 {
05076
05077 integer i__1, i__2, i__3;
05078 logical ret_val;
05079
05080
05081 integer i__;
05082
05083
05084
05085
05086
05087
05088
05089
05090
05091
05092
05093
05094
05095
05096
05097
05098
05099 --rj;
05100 --ri;
05101
05102
05103 i__1 = *lr;
05104 for (i__ = 1; i__ <= i__1; ++i__) {
05105 i__2 = i__;
05106 i__3 = i__;
05107 if (ri[i__2].r != rj[i__3].r || ri[i__2].i != rj[i__3].i) {
05108 goto L20;
05109 }
05110
05111 }
05112 ret_val = TRUE_;
05113 goto L30;
05114 L20:
05115 ret_val = FALSE_;
05116 L30:
05117 return ret_val;
05118
05119
05120
05121 }
05122
05123 logical lceres_(char *type__, char *uplo, integer *m, integer *n, complex *aa,
05124 complex *as, integer *lda, ftnlen type_len, ftnlen uplo_len)
05125 {
05126
05127 integer aa_dim1, aa_offset, as_dim1, as_offset, i__1, i__2, i__3, i__4;
05128 logical ret_val;
05129
05130
05131 integer s_cmp(char *, char *, ftnlen, ftnlen);
05132
05133
05134 integer i__, j, ibeg, iend;
05135 logical upper;
05136
05137
05138
05139
05140
05141
05142
05143
05144
05145
05146
05147
05148
05149
05150
05151
05152
05153
05154
05155 as_dim1 = *lda;
05156 as_offset = 1 + as_dim1;
05157 as -= as_offset;
05158 aa_dim1 = *lda;
05159 aa_offset = 1 + aa_dim1;
05160 aa -= aa_offset;
05161
05162
05163 upper = *(unsigned char *)uplo == 'U';
05164 if (s_cmp(type__, "GE", (ftnlen)2, (ftnlen)2) == 0) {
05165 i__1 = *n;
05166 for (j = 1; j <= i__1; ++j) {
05167 i__2 = *lda;
05168 for (i__ = *m + 1; i__ <= i__2; ++i__) {
05169 i__3 = i__ + j * aa_dim1;
05170 i__4 = i__ + j * as_dim1;
05171 if (aa[i__3].r != as[i__4].r || aa[i__3].i != as[i__4].i) {
05172 goto L70;
05173 }
05174
05175 }
05176
05177 }
05178 } else if (s_cmp(type__, "HE", (ftnlen)2, (ftnlen)2) == 0 || s_cmp(type__,
05179 "SY", (ftnlen)2, (ftnlen)2) == 0) {
05180 i__1 = *n;
05181 for (j = 1; j <= i__1; ++j) {
05182 if (upper) {
05183 ibeg = 1;
05184 iend = j;
05185 } else {
05186 ibeg = j;
05187 iend = *n;
05188 }
05189 i__2 = ibeg - 1;
05190 for (i__ = 1; i__ <= i__2; ++i__) {
05191 i__3 = i__ + j * aa_dim1;
05192 i__4 = i__ + j * as_dim1;
05193 if (aa[i__3].r != as[i__4].r || aa[i__3].i != as[i__4].i) {
05194 goto L70;
05195 }
05196
05197 }
05198 i__2 = *lda;
05199 for (i__ = iend + 1; i__ <= i__2; ++i__) {
05200 i__3 = i__ + j * aa_dim1;
05201 i__4 = i__ + j * as_dim1;
05202 if (aa[i__3].r != as[i__4].r || aa[i__3].i != as[i__4].i) {
05203 goto L70;
05204 }
05205
05206 }
05207
05208 }
05209 }
05210
05211
05212 ret_val = TRUE_;
05213 goto L80;
05214 L70:
05215 ret_val = FALSE_;
05216 L80:
05217 return ret_val;
05218
05219
05220
05221 }
05222
05223 VOID cbeg_(complex * ret_val, logical *reset)
05224 {
05225
05226 real r__1, r__2;
05227 complex q__1;
05228
05229
05230 static integer i__, j, ic, mi, mj;
05231
05232
05233
05234
05235
05236
05237
05238
05239
05240
05241
05242
05243
05244
05245
05246
05247
05248
05249 if (*reset) {
05250
05251 mi = 891;
05252 mj = 457;
05253 i__ = 7;
05254 j = 7;
05255 ic = 0;
05256 *reset = FALSE_;
05257 }
05258
05259
05260
05261
05262
05263
05264
05265
05266 ++ic;
05267 L10:
05268 i__ *= mi;
05269 j *= mj;
05270 i__ -= i__ / 1000 * 1000;
05271 j -= j / 1000 * 1000;
05272 if (ic >= 5) {
05273 ic = 0;
05274 goto L10;
05275 }
05276 r__1 = (i__ - 500) / 1001.f;
05277 r__2 = (j - 500) / 1001.f;
05278 q__1.r = r__1, q__1.i = r__2;
05279 ret_val->r = q__1.r, ret_val->i = q__1.i;
05280 return ;
05281
05282
05283
05284 }
05285
05286 doublereal sdiff_(real *x, real *y)
05287 {
05288
05289 real ret_val;
05290
05291
05292
05293
05294
05295
05296
05297
05298
05299
05300
05301
05302 ret_val = *x - *y;
05303 return ret_val;
05304
05305
05306
05307 }
05308
05309 int chkxer_(char *srnamt, integer *infot, integer *nout,
05310 logical *lerr, logical *ok)
05311 {
05312
05313 static char fmt_9999[] = "(\002 ***** ILLEGAL VALUE OF PARAMETER NUMBER"
05314 " \002,i2,\002 NOT D\002,\002ETECTED BY \002,a6,\002 *****\002)";
05315
05316
05317 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
05318
05319
05320 static cilist io___397 = { 0, 0, 0, fmt_9999, 0 };
05321
05322
05323
05324
05325
05326
05327
05328
05329
05330
05331
05332
05333
05334
05335
05336 if (! (*lerr)) {
05337 io___397.ciunit = *nout;
05338 s_wsfe(&io___397);
05339 do_fio(&c__1, (char *)&(*infot), (ftnlen)sizeof(integer));
05340 do_fio(&c__1, srnamt, (ftnlen)6);
05341 e_wsfe();
05342 *ok = FALSE_;
05343 }
05344 *lerr = FALSE_;
05345 return 0;
05346
05347
05348
05349
05350 }
05351
05352 int xerbla_(char *srname, integer *info)
05353 {
05354
05355 static char fmt_9999[] = "(\002 ******* XERBLA WAS CALLED WITH INFO ="
05356 " \002,i6,\002 INSTEAD\002,\002 OF \002,i2,\002 *******\002)";
05357 static char fmt_9997[] = "(\002 ******* XERBLA WAS CALLED WITH INFO ="
05358 " \002,i6,\002 *******\002)";
05359 static char fmt_9998[] = "(\002 ******* XERBLA WAS CALLED WITH SRNAME ="
05360 " \002,a6,\002 INSTE\002,\002AD OF \002,a6,\002 *******\002)";
05361
05362
05363 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void),
05364 s_cmp(char *, char *, ftnlen, ftnlen);
05365
05366
05367 static cilist io___398 = { 0, 0, 0, fmt_9999, 0 };
05368 static cilist io___399 = { 0, 0, 0, fmt_9997, 0 };
05369 static cilist io___400 = { 0, 0, 0, fmt_9998, 0 };
05370
05371
05372
05373
05374
05375
05376
05377
05378
05379
05380
05381
05382
05383
05384
05385
05386
05387
05388
05389
05390
05391
05392
05393
05394 infoc_2.lerr = TRUE_;
05395 if (*info != infoc_2.infot) {
05396 if (infoc_2.infot != 0) {
05397 io___398.ciunit = infoc_2.nout;
05398 s_wsfe(&io___398);
05399 do_fio(&c__1, (char *)&(*info), (ftnlen)sizeof(integer));
05400 do_fio(&c__1, (char *)&infoc_2.infot, (ftnlen)sizeof(integer));
05401 e_wsfe();
05402 } else {
05403 io___399.ciunit = infoc_2.nout;
05404 s_wsfe(&io___399);
05405 do_fio(&c__1, (char *)&(*info), (ftnlen)sizeof(integer));
05406 e_wsfe();
05407 }
05408 infoc_2.ok = FALSE_;
05409 }
05410 if (s_cmp(srname, srnamc_1.srnamt, (ftnlen)6, (ftnlen)6) != 0) {
05411 io___400.ciunit = infoc_2.nout;
05412 s_wsfe(&io___400);
05413 do_fio(&c__1, srname, (ftnlen)6);
05414 do_fio(&c__1, srnamc_1.srnamt, (ftnlen)6);
05415 e_wsfe();
05416 infoc_2.ok = FALSE_;
05417 }
05418 return 0;
05419
05420
05421
05422
05423 }
05424
05425 int cblat3_ () { MAIN__ (); return 0; }