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