00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015
00016
00017
00018 static complex c_b1 = {0.f,0.f};
00019 static complex c_b2 = {1.f,0.f};
00020 static integer c__2 = 2;
00021 static integer c__0 = 0;
00022 static integer c__6 = 6;
00023 static real c_b34 = 1.f;
00024 static integer c__1 = 1;
00025 static real c_b44 = 0.f;
00026 static integer c__4 = 4;
00027 static integer c__3 = 3;
00028
00029 int cdrvst_(integer *nsizes, integer *nn, integer *ntypes,
00030 logical *dotype, integer *iseed, real *thresh, integer *nounit,
00031 complex *a, integer *lda, real *d1, real *d2, real *d3, real *wa1,
00032 real *wa2, real *wa3, complex *u, integer *ldu, complex *v, complex *
00033 tau, complex *z__, complex *work, integer *lwork, real *rwork,
00034 integer *lrwork, integer *iwork, integer *liwork, real *result,
00035 integer *info)
00036 {
00037
00038
00039 static integer ktype[18] = { 1,2,4,4,4,4,4,5,5,5,5,5,8,8,8,9,9,9 };
00040 static integer kmagn[18] = { 1,1,1,1,1,2,3,1,1,1,2,3,1,2,3,1,2,3 };
00041 static integer kmode[18] = { 0,0,4,3,1,4,4,4,3,1,4,4,0,0,0,4,4,4 };
00042
00043
00044 static char fmt_9999[] = "(\002 CDRVST: \002,a,\002 returned INFO=\002,i"
00045 "6,/9x,\002N=\002,i6,\002, JTYPE=\002,i6,\002, ISEED=(\002,3(i5"
00046 ",\002,\002),i5,\002)\002)";
00047 static char fmt_9998[] = "(\002 CDRVST: \002,a,\002 returned INFO=\002,i"
00048 "6,/9x,\002N=\002,i6,\002, KD=\002,i6,\002, JTYPE=\002,i6,\002, I"
00049 "SEED=(\002,3(i5,\002,\002),i5,\002)\002)";
00050
00051
00052 address a__1[3];
00053 integer a_dim1, a_offset, u_dim1, u_offset, v_dim1, v_offset, z_dim1,
00054 z_offset, i__1, i__2, i__3, i__4, i__5, i__6, i__7[3];
00055 real r__1, r__2, r__3, r__4;
00056 char ch__1[11], ch__2[13], ch__3[10];
00057
00058
00059 double sqrt(doublereal), log(doublereal);
00060 integer pow_ii(integer *, integer *), s_wsfe(cilist *), do_fio(integer *,
00061 char *, ftnlen), e_wsfe(void);
00062 int s_cat(char *, char **, integer *, integer *, ftnlen);
00063
00064
00065 integer i__, j, m, n, j1, j2, m2, m3, kd, il, iu;
00066 real vl, vu;
00067 integer lgn;
00068 real ulp, cond;
00069 integer jcol, ihbw, indx, nmax;
00070 real unfl, ovfl;
00071 char uplo[1];
00072 integer irow;
00073 real temp1, temp2, temp3;
00074 integer idiag;
00075 logical badnn;
00076 extern doublereal ssxt1_(integer *, real *, integer *, real *, integer *,
00077 real *, real *, real *);
00078 extern int chet21_(integer *, char *, integer *, integer
00079 *, complex *, integer *, real *, real *, complex *, integer *,
00080 complex *, integer *, complex *, complex *, real *, real *), chbev_(char *, char *, integer *, integer *, complex *,
00081 integer *, real *, complex *, integer *, complex *, real *,
00082 integer *), chet22_(integer *, char *, integer *,
00083 integer *, integer *, complex *, integer *, real *, real *,
00084 complex *, integer *, complex *, integer *, complex *, complex *,
00085 real *, real *), cheev_(char *, char *, integer *,
00086 complex *, integer *, real *, complex *, integer *, real *,
00087 integer *);
00088 integer imode, lwedc, iinfo;
00089 extern int chpev_(char *, char *, integer *, complex *,
00090 real *, complex *, integer *, complex *, real *, integer *);
00091 real aninv, anorm;
00092 integer itemp, nmats, jsize, iuplo, nerrs, itype, jtype, ntest, iseed2[4],
00093 iseed3[4];
00094 extern int slabad_(real *, real *), chbevd_(char *, char
00095 *, integer *, integer *, complex *, integer *, real *, complex *,
00096 integer *, complex *, integer *, real *, integer *, integer *,
00097 integer *, integer *), cheevd_(char *, char *,
00098 integer *, complex *, integer *, real *, complex *, integer *,
00099 real *, integer *, integer *, integer *, integer *);
00100 integer liwedc;
00101 extern doublereal slamch_(char *);
00102 extern int chpevd_(char *, char *, integer *, complex *,
00103 real *, complex *, integer *, complex *, integer *, real *,
00104 integer *, integer *, integer *, integer *),
00105 clacpy_(char *, integer *, integer *, complex *, integer *,
00106 complex *, integer *);
00107 integer idumma[1];
00108 extern int cheevr_(char *, char *, char *, integer *,
00109 complex *, integer *, real *, real *, integer *, integer *, real *
00110 , integer *, real *, complex *, integer *, integer *, complex *,
00111 integer *, real *, integer *, integer *, integer *, integer *);
00112 integer ioldsd[4];
00113 extern int chbevx_(char *, char *, char *, integer *,
00114 integer *, complex *, integer *, complex *, integer *, real *,
00115 real *, integer *, integer *, real *, integer *, real *, complex *
00116 , integer *, complex *, real *, integer *, integer *, integer *);
00117 integer lrwedc;
00118 extern int claset_(char *, integer *, integer *, complex
00119 *, complex *, complex *, integer *), cheevx_(char *, char
00120 *, char *, integer *, complex *, integer *, real *, real *,
00121 integer *, integer *, real *, integer *, real *, complex *,
00122 integer *, complex *, integer *, real *, integer *, integer *,
00123 integer *);
00124 extern doublereal slarnd_(integer *, integer *);
00125 real abstol;
00126 extern int alasvm_(char *, integer *, integer *, integer
00127 *, integer *), clatmr_(integer *, integer *, char *,
00128 integer *, char *, complex *, integer *, real *, complex *, char *
00129 , char *, complex *, integer *, real *, complex *, integer *,
00130 real *, char *, integer *, integer *, integer *, real *, real *,
00131 char *, complex *, integer *, integer *, integer *), clatms_(integer *,
00132 integer *, char *, integer *, char *, real *, integer *, real *,
00133 real *, integer *, integer *, char *, complex *, integer *,
00134 complex *, integer *), xerbla_(char *,
00135 integer *), slafts_(char *, integer *, integer *, integer
00136 *, integer *, real *, integer *, real *, integer *, integer *);
00137 integer indwrk;
00138 extern int chpevx_(char *, char *, char *, integer *,
00139 complex *, real *, real *, integer *, integer *, real *, integer *
00140 , real *, complex *, integer *, complex *, real *, integer *,
00141 integer *, integer *);
00142 real rtunfl, rtovfl, ulpinv;
00143 integer mtypes, ntestt;
00144
00145
00146 static cilist io___42 = { 0, 0, 0, fmt_9999, 0 };
00147 static cilist io___49 = { 0, 0, 0, fmt_9999, 0 };
00148 static cilist io___50 = { 0, 0, 0, fmt_9999, 0 };
00149 static cilist io___57 = { 0, 0, 0, fmt_9999, 0 };
00150 static cilist io___59 = { 0, 0, 0, fmt_9999, 0 };
00151 static cilist io___60 = { 0, 0, 0, fmt_9999, 0 };
00152 static cilist io___62 = { 0, 0, 0, fmt_9999, 0 };
00153 static cilist io___63 = { 0, 0, 0, fmt_9999, 0 };
00154 static cilist io___64 = { 0, 0, 0, fmt_9999, 0 };
00155 static cilist io___67 = { 0, 0, 0, fmt_9999, 0 };
00156 static cilist io___68 = { 0, 0, 0, fmt_9999, 0 };
00157 static cilist io___69 = { 0, 0, 0, fmt_9999, 0 };
00158 static cilist io___70 = { 0, 0, 0, fmt_9999, 0 };
00159 static cilist io___71 = { 0, 0, 0, fmt_9999, 0 };
00160 static cilist io___72 = { 0, 0, 0, fmt_9999, 0 };
00161 static cilist io___73 = { 0, 0, 0, fmt_9999, 0 };
00162 static cilist io___74 = { 0, 0, 0, fmt_9999, 0 };
00163 static cilist io___76 = { 0, 0, 0, fmt_9998, 0 };
00164 static cilist io___77 = { 0, 0, 0, fmt_9998, 0 };
00165 static cilist io___78 = { 0, 0, 0, fmt_9999, 0 };
00166 static cilist io___79 = { 0, 0, 0, fmt_9998, 0 };
00167 static cilist io___80 = { 0, 0, 0, fmt_9998, 0 };
00168 static cilist io___81 = { 0, 0, 0, fmt_9998, 0 };
00169 static cilist io___82 = { 0, 0, 0, fmt_9998, 0 };
00170 static cilist io___83 = { 0, 0, 0, fmt_9998, 0 };
00171 static cilist io___84 = { 0, 0, 0, fmt_9999, 0 };
00172 static cilist io___85 = { 0, 0, 0, fmt_9999, 0 };
00173 static cilist io___86 = { 0, 0, 0, fmt_9999, 0 };
00174 static cilist io___87 = { 0, 0, 0, fmt_9999, 0 };
00175 static cilist io___88 = { 0, 0, 0, fmt_9998, 0 };
00176 static cilist io___89 = { 0, 0, 0, fmt_9998, 0 };
00177 static cilist io___90 = { 0, 0, 0, fmt_9999, 0 };
00178 static cilist io___91 = { 0, 0, 0, fmt_9999, 0 };
00179 static cilist io___92 = { 0, 0, 0, fmt_9999, 0 };
00180 static cilist io___93 = { 0, 0, 0, fmt_9999, 0 };
00181 static cilist io___94 = { 0, 0, 0, fmt_9999, 0 };
00182 static cilist io___95 = { 0, 0, 0, fmt_9999, 0 };
00183
00184
00185
00186
00187
00188
00189
00190
00191
00192
00193
00194
00195
00196
00197
00198
00199
00200
00201
00202
00203
00204
00205
00206
00207
00208
00209
00210
00211
00212
00213
00214
00215
00216
00217
00218
00219
00220
00221
00222
00223
00224
00225
00226
00227
00228
00229
00230
00231
00232
00233
00234
00235
00236
00237
00238
00239
00240
00241
00242
00243
00244
00245
00246
00247
00248
00249
00250
00251
00252
00253
00254
00255
00256
00257
00258
00259
00260
00261
00262
00263
00264
00265
00266
00267
00268
00269
00270
00271
00272
00273
00274
00275
00276
00277
00278
00279
00280
00281
00282
00283
00284
00285
00286
00287
00288
00289
00290
00291
00292
00293
00294
00295
00296
00297
00298
00299
00300
00301
00302
00303
00304
00305
00306
00307
00308
00309
00310
00311
00312
00313
00314
00315
00316
00317
00318
00319
00320
00321
00322
00323
00324
00325
00326
00327
00328
00329
00330
00331
00332
00333
00334
00335
00336
00337
00338
00339
00340
00341
00342
00343
00344
00345
00346
00347
00348
00349
00350
00351
00352
00353
00354
00355
00356
00357
00358
00359
00360
00361
00362
00363
00364
00365
00366
00367
00368
00369
00370
00371
00372
00373
00374
00375
00376
00377
00378
00379
00380
00381
00382
00383
00384
00385
00386
00387
00388
00389
00390
00391
00392
00393
00394
00395
00396
00397
00398
00399
00400
00401
00402
00403
00404
00405
00406
00407
00408
00409
00410
00411
00412
00413
00414
00415
00416
00417
00418
00419
00420
00421
00422
00423
00424
00425
00426
00427
00428
00429
00430
00431
00432
00433
00434
00435
00436
00437
00438
00439
00440
00441
00442
00443
00444
00445
00446
00447
00448
00449
00450
00451
00452
00453
00454
00455
00456
00457
00458
00459
00460
00461
00462
00463
00464
00465
00466
00467
00468
00469
00470
00471
00472
00473
00474
00475
00476
00477
00478
00479
00480
00481
00482
00483
00484
00485
00486
00487
00488
00489
00490
00491
00492
00493
00494
00495
00496
00497
00498
00499 --nn;
00500 --dotype;
00501 --iseed;
00502 a_dim1 = *lda;
00503 a_offset = 1 + a_dim1;
00504 a -= a_offset;
00505 --d1;
00506 --d2;
00507 --d3;
00508 --wa1;
00509 --wa2;
00510 --wa3;
00511 z_dim1 = *ldu;
00512 z_offset = 1 + z_dim1;
00513 z__ -= z_offset;
00514 v_dim1 = *ldu;
00515 v_offset = 1 + v_dim1;
00516 v -= v_offset;
00517 u_dim1 = *ldu;
00518 u_offset = 1 + u_dim1;
00519 u -= u_offset;
00520 --tau;
00521 --work;
00522 --rwork;
00523 --iwork;
00524 --result;
00525
00526
00527
00528
00529
00530
00531
00532 ntestt = 0;
00533 *info = 0;
00534
00535 badnn = FALSE_;
00536 nmax = 1;
00537 i__1 = *nsizes;
00538 for (j = 1; j <= i__1; ++j) {
00539
00540 i__2 = nmax, i__3 = nn[j];
00541 nmax = max(i__2,i__3);
00542 if (nn[j] < 0) {
00543 badnn = TRUE_;
00544 }
00545
00546 }
00547
00548
00549
00550 if (*nsizes < 0) {
00551 *info = -1;
00552 } else if (badnn) {
00553 *info = -2;
00554 } else if (*ntypes < 0) {
00555 *info = -3;
00556 } else if (*lda < nmax) {
00557 *info = -9;
00558 } else if (*ldu < nmax) {
00559 *info = -16;
00560 } else {
00561
00562 i__1 = max(2,nmax);
00563 if (i__1 * i__1 << 1 > *lwork) {
00564 *info = -22;
00565 }
00566 }
00567
00568 if (*info != 0) {
00569 i__1 = -(*info);
00570 xerbla_("CDRVST", &i__1);
00571 return 0;
00572 }
00573
00574
00575
00576 if (*nsizes == 0 || *ntypes == 0) {
00577 return 0;
00578 }
00579
00580
00581
00582 unfl = slamch_("Safe minimum");
00583 ovfl = slamch_("Overflow");
00584 slabad_(&unfl, &ovfl);
00585 ulp = slamch_("Epsilon") * slamch_("Base");
00586 ulpinv = 1.f / ulp;
00587 rtunfl = sqrt(unfl);
00588 rtovfl = sqrt(ovfl);
00589
00590
00591
00592 for (i__ = 1; i__ <= 4; ++i__) {
00593 iseed2[i__ - 1] = iseed[i__];
00594 iseed3[i__ - 1] = iseed[i__];
00595
00596 }
00597
00598 nerrs = 0;
00599 nmats = 0;
00600
00601 i__1 = *nsizes;
00602 for (jsize = 1; jsize <= i__1; ++jsize) {
00603 n = nn[jsize];
00604 if (n > 0) {
00605 lgn = (integer) (log((real) n) / log(2.f));
00606 if (pow_ii(&c__2, &lgn) < n) {
00607 ++lgn;
00608 }
00609 if (pow_ii(&c__2, &lgn) < n) {
00610 ++lgn;
00611 }
00612
00613 i__2 = (n << 1) + n * n, i__3 = (n << 1) * n;
00614 lwedc = max(i__2,i__3);
00615
00616 i__2 = n;
00617 lrwedc = (n << 2) + 1 + (n << 1) * lgn + i__2 * i__2 * 3;
00618 liwedc = n * 5 + 3;
00619 } else {
00620 lwedc = 2;
00621 lrwedc = 8;
00622 liwedc = 8;
00623 }
00624 aninv = 1.f / (real) max(1,n);
00625
00626 if (*nsizes != 1) {
00627 mtypes = min(18,*ntypes);
00628 } else {
00629 mtypes = min(19,*ntypes);
00630 }
00631
00632 i__2 = mtypes;
00633 for (jtype = 1; jtype <= i__2; ++jtype) {
00634 if (! dotype[jtype]) {
00635 goto L1210;
00636 }
00637 ++nmats;
00638 ntest = 0;
00639
00640 for (j = 1; j <= 4; ++j) {
00641 ioldsd[j - 1] = iseed[j];
00642
00643 }
00644
00645
00646
00647
00648
00649
00650
00651
00652
00653
00654
00655
00656
00657
00658
00659
00660 if (mtypes > 18) {
00661 goto L110;
00662 }
00663
00664 itype = ktype[jtype - 1];
00665 imode = kmode[jtype - 1];
00666
00667
00668
00669 switch (kmagn[jtype - 1]) {
00670 case 1: goto L40;
00671 case 2: goto L50;
00672 case 3: goto L60;
00673 }
00674
00675 L40:
00676 anorm = 1.f;
00677 goto L70;
00678
00679 L50:
00680 anorm = rtovfl * ulp * aninv;
00681 goto L70;
00682
00683 L60:
00684 anorm = rtunfl * n * ulpinv;
00685 goto L70;
00686
00687 L70:
00688
00689 claset_("Full", lda, &n, &c_b1, &c_b1, &a[a_offset], lda);
00690 iinfo = 0;
00691 cond = ulpinv;
00692
00693
00694
00695
00696
00697 if (itype == 1) {
00698 iinfo = 0;
00699
00700 } else if (itype == 2) {
00701
00702
00703
00704 i__3 = n;
00705 for (jcol = 1; jcol <= i__3; ++jcol) {
00706 i__4 = jcol + jcol * a_dim1;
00707 a[i__4].r = anorm, a[i__4].i = 0.f;
00708
00709 }
00710
00711 } else if (itype == 4) {
00712
00713
00714
00715 clatms_(&n, &n, "S", &iseed[1], "H", &rwork[1], &imode, &cond,
00716 &anorm, &c__0, &c__0, "N", &a[a_offset], lda, &work[
00717 1], &iinfo);
00718
00719 } else if (itype == 5) {
00720
00721
00722
00723 clatms_(&n, &n, "S", &iseed[1], "H", &rwork[1], &imode, &cond,
00724 &anorm, &n, &n, "N", &a[a_offset], lda, &work[1], &
00725 iinfo);
00726
00727 } else if (itype == 7) {
00728
00729
00730
00731 clatmr_(&n, &n, "S", &iseed[1], "H", &work[1], &c__6, &c_b34,
00732 &c_b2, "T", "N", &work[n + 1], &c__1, &c_b34, &work[(
00733 n << 1) + 1], &c__1, &c_b34, "N", idumma, &c__0, &
00734 c__0, &c_b44, &anorm, "NO", &a[a_offset], lda, &iwork[
00735 1], &iinfo);
00736
00737 } else if (itype == 8) {
00738
00739
00740
00741 clatmr_(&n, &n, "S", &iseed[1], "H", &work[1], &c__6, &c_b34,
00742 &c_b2, "T", "N", &work[n + 1], &c__1, &c_b34, &work[(
00743 n << 1) + 1], &c__1, &c_b34, "N", idumma, &n, &n, &
00744 c_b44, &anorm, "NO", &a[a_offset], lda, &iwork[1], &
00745 iinfo);
00746
00747 } else if (itype == 9) {
00748
00749
00750
00751 ihbw = (integer) ((n - 1) * slarnd_(&c__1, iseed3));
00752 clatms_(&n, &n, "S", &iseed[1], "H", &rwork[1], &imode, &cond,
00753 &anorm, &ihbw, &ihbw, "Z", &u[u_offset], ldu, &work[
00754 1], &iinfo);
00755
00756
00757
00758 claset_("Full", lda, &n, &c_b1, &c_b1, &a[a_offset], lda);
00759 i__3 = ihbw;
00760 for (idiag = -ihbw; idiag <= i__3; ++idiag) {
00761 irow = ihbw - idiag + 1;
00762
00763 i__4 = 1, i__5 = idiag + 1;
00764 j1 = max(i__4,i__5);
00765
00766 i__4 = n, i__5 = n + idiag;
00767 j2 = min(i__4,i__5);
00768 i__4 = j2;
00769 for (j = j1; j <= i__4; ++j) {
00770 i__ = j - idiag;
00771 i__5 = i__ + j * a_dim1;
00772 i__6 = irow + j * u_dim1;
00773 a[i__5].r = u[i__6].r, a[i__5].i = u[i__6].i;
00774
00775 }
00776
00777 }
00778 } else {
00779 iinfo = 1;
00780 }
00781
00782 if (iinfo != 0) {
00783 io___42.ciunit = *nounit;
00784 s_wsfe(&io___42);
00785 do_fio(&c__1, "Generator", (ftnlen)9);
00786 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00787 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00788 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00789 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
00790 e_wsfe();
00791 *info = abs(iinfo);
00792 return 0;
00793 }
00794
00795 L110:
00796
00797 abstol = unfl + unfl;
00798 if (n <= 1) {
00799 il = 1;
00800 iu = n;
00801 } else {
00802 il = (integer) ((n - 1) * slarnd_(&c__1, iseed2)) + 1;
00803 iu = (integer) ((n - 1) * slarnd_(&c__1, iseed2)) + 1;
00804 if (il > iu) {
00805 itemp = il;
00806 il = iu;
00807 iu = itemp;
00808 }
00809 }
00810
00811
00812
00813
00814 for (iuplo = 0; iuplo <= 1; ++iuplo) {
00815 if (iuplo == 0) {
00816 *(unsigned char *)uplo = 'L';
00817 } else {
00818 *(unsigned char *)uplo = 'U';
00819 }
00820
00821
00822
00823 clacpy_(" ", &n, &n, &a[a_offset], lda, &v[v_offset], ldu);
00824
00825 ++ntest;
00826 cheevd_("V", uplo, &n, &a[a_offset], ldu, &d1[1], &work[1], &
00827 lwedc, &rwork[1], &lrwedc, &iwork[1], &liwedc, &iinfo);
00828 if (iinfo != 0) {
00829 io___49.ciunit = *nounit;
00830 s_wsfe(&io___49);
00831
00832 i__7[0] = 9, a__1[0] = "CHEEVD(V,";
00833 i__7[1] = 1, a__1[1] = uplo;
00834 i__7[2] = 1, a__1[2] = ")";
00835 s_cat(ch__1, a__1, i__7, &c__3, (ftnlen)11);
00836 do_fio(&c__1, ch__1, (ftnlen)11);
00837 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00838 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00839 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00840 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
00841 ;
00842 e_wsfe();
00843 *info = abs(iinfo);
00844 if (iinfo < 0) {
00845 return 0;
00846 } else {
00847 result[ntest] = ulpinv;
00848 result[ntest + 1] = ulpinv;
00849 result[ntest + 2] = ulpinv;
00850 goto L130;
00851 }
00852 }
00853
00854
00855
00856 chet21_(&c__1, uplo, &n, &c__0, &v[v_offset], ldu, &d1[1], &
00857 d2[1], &a[a_offset], ldu, &z__[z_offset], ldu, &tau[1]
00858 , &work[1], &rwork[1], &result[ntest]);
00859
00860 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
00861
00862 ntest += 2;
00863 cheevd_("N", uplo, &n, &a[a_offset], ldu, &d3[1], &work[1], &
00864 lwedc, &rwork[1], &lrwedc, &iwork[1], &liwedc, &iinfo);
00865 if (iinfo != 0) {
00866 io___50.ciunit = *nounit;
00867 s_wsfe(&io___50);
00868
00869 i__7[0] = 9, a__1[0] = "CHEEVD(N,";
00870 i__7[1] = 1, a__1[1] = uplo;
00871 i__7[2] = 1, a__1[2] = ")";
00872 s_cat(ch__1, a__1, i__7, &c__3, (ftnlen)11);
00873 do_fio(&c__1, ch__1, (ftnlen)11);
00874 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00875 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00876 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00877 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
00878 ;
00879 e_wsfe();
00880 *info = abs(iinfo);
00881 if (iinfo < 0) {
00882 return 0;
00883 } else {
00884 result[ntest] = ulpinv;
00885 goto L130;
00886 }
00887 }
00888
00889
00890
00891 temp1 = 0.f;
00892 temp2 = 0.f;
00893 i__3 = n;
00894 for (j = 1; j <= i__3; ++j) {
00895
00896 r__3 = temp1, r__4 = (r__1 = d1[j], dabs(r__1)), r__3 =
00897 max(r__3,r__4), r__4 = (r__2 = d3[j], dabs(r__2));
00898 temp1 = dmax(r__3,r__4);
00899
00900 r__2 = temp2, r__3 = (r__1 = d1[j] - d3[j], dabs(r__1));
00901 temp2 = dmax(r__2,r__3);
00902
00903 }
00904
00905 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
00906 result[ntest] = temp2 / dmax(r__1,r__2);
00907
00908 L130:
00909 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
00910
00911 ++ntest;
00912
00913 if (n > 0) {
00914
00915 r__2 = dabs(d1[1]), r__3 = (r__1 = d1[n], dabs(r__1));
00916 temp3 = dmax(r__2,r__3);
00917 if (il != 1) {
00918
00919 r__1 = (d1[il] - d1[il - 1]) * .5f, r__2 = ulp * 10.f
00920 * temp3, r__1 = max(r__1,r__2), r__2 = rtunfl
00921 * 10.f;
00922 vl = d1[il] - dmax(r__1,r__2);
00923 } else if (n > 0) {
00924
00925 r__1 = (d1[n] - d1[1]) * .5f, r__2 = ulp * 10.f *
00926 temp3, r__1 = max(r__1,r__2), r__2 = rtunfl *
00927 10.f;
00928 vl = d1[1] - dmax(r__1,r__2);
00929 }
00930 if (iu != n) {
00931
00932 r__1 = (d1[iu + 1] - d1[iu]) * .5f, r__2 = ulp * 10.f
00933 * temp3, r__1 = max(r__1,r__2), r__2 = rtunfl
00934 * 10.f;
00935 vu = d1[iu] + dmax(r__1,r__2);
00936 } else if (n > 0) {
00937
00938 r__1 = (d1[n] - d1[1]) * .5f, r__2 = ulp * 10.f *
00939 temp3, r__1 = max(r__1,r__2), r__2 = rtunfl *
00940 10.f;
00941 vu = d1[n] + dmax(r__1,r__2);
00942 }
00943 } else {
00944 temp3 = 0.f;
00945 vl = 0.f;
00946 vu = 1.f;
00947 }
00948
00949 cheevx_("V", "A", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il,
00950 &iu, &abstol, &m, &wa1[1], &z__[z_offset], ldu, &work[
00951 1], lwork, &rwork[1], &iwork[1], &iwork[n * 5 + 1], &
00952 iinfo);
00953 if (iinfo != 0) {
00954 io___57.ciunit = *nounit;
00955 s_wsfe(&io___57);
00956
00957 i__7[0] = 11, a__1[0] = "CHEEVX(V,A,";
00958 i__7[1] = 1, a__1[1] = uplo;
00959 i__7[2] = 1, a__1[2] = ")";
00960 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
00961 do_fio(&c__1, ch__2, (ftnlen)13);
00962 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00963 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00964 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00965 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
00966 ;
00967 e_wsfe();
00968 *info = abs(iinfo);
00969 if (iinfo < 0) {
00970 return 0;
00971 } else {
00972 result[ntest] = ulpinv;
00973 result[ntest + 1] = ulpinv;
00974 result[ntest + 2] = ulpinv;
00975 goto L150;
00976 }
00977 }
00978
00979
00980
00981 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
00982
00983 chet21_(&c__1, uplo, &n, &c__0, &a[a_offset], ldu, &wa1[1], &
00984 d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &tau[1]
00985 , &work[1], &rwork[1], &result[ntest]);
00986
00987 ntest += 2;
00988 cheevx_("N", "A", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il,
00989 &iu, &abstol, &m2, &wa2[1], &z__[z_offset], ldu, &
00990 work[1], lwork, &rwork[1], &iwork[1], &iwork[n * 5 +
00991 1], &iinfo);
00992 if (iinfo != 0) {
00993 io___59.ciunit = *nounit;
00994 s_wsfe(&io___59);
00995
00996 i__7[0] = 11, a__1[0] = "CHEEVX(N,A,";
00997 i__7[1] = 1, a__1[1] = uplo;
00998 i__7[2] = 1, a__1[2] = ")";
00999 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01000 do_fio(&c__1, ch__2, (ftnlen)13);
01001 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01002 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01003 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01004 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01005 ;
01006 e_wsfe();
01007 *info = abs(iinfo);
01008 if (iinfo < 0) {
01009 return 0;
01010 } else {
01011 result[ntest] = ulpinv;
01012 goto L150;
01013 }
01014 }
01015
01016
01017
01018 temp1 = 0.f;
01019 temp2 = 0.f;
01020 i__3 = n;
01021 for (j = 1; j <= i__3; ++j) {
01022
01023 r__3 = temp1, r__4 = (r__1 = wa1[j], dabs(r__1)), r__3 =
01024 max(r__3,r__4), r__4 = (r__2 = wa2[j], dabs(r__2))
01025 ;
01026 temp1 = dmax(r__3,r__4);
01027
01028 r__2 = temp2, r__3 = (r__1 = wa1[j] - wa2[j], dabs(r__1));
01029 temp2 = dmax(r__2,r__3);
01030
01031 }
01032
01033 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
01034 result[ntest] = temp2 / dmax(r__1,r__2);
01035
01036 L150:
01037 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
01038
01039 ++ntest;
01040
01041 cheevx_("V", "I", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il,
01042 &iu, &abstol, &m2, &wa2[1], &z__[z_offset], ldu, &
01043 work[1], lwork, &rwork[1], &iwork[1], &iwork[n * 5 +
01044 1], &iinfo);
01045 if (iinfo != 0) {
01046 io___60.ciunit = *nounit;
01047 s_wsfe(&io___60);
01048
01049 i__7[0] = 11, a__1[0] = "CHEEVX(V,I,";
01050 i__7[1] = 1, a__1[1] = uplo;
01051 i__7[2] = 1, a__1[2] = ")";
01052 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01053 do_fio(&c__1, ch__2, (ftnlen)13);
01054 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01055 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01056 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01057 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01058 ;
01059 e_wsfe();
01060 *info = abs(iinfo);
01061 if (iinfo < 0) {
01062 return 0;
01063 } else {
01064 result[ntest] = ulpinv;
01065 goto L160;
01066 }
01067 }
01068
01069
01070
01071 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
01072
01073 chet22_(&c__1, uplo, &n, &m2, &c__0, &a[a_offset], ldu, &wa2[
01074 1], &d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &
01075 tau[1], &work[1], &rwork[1], &result[ntest]);
01076
01077 ntest += 2;
01078
01079 cheevx_("N", "I", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il,
01080 &iu, &abstol, &m3, &wa3[1], &z__[z_offset], ldu, &
01081 work[1], lwork, &rwork[1], &iwork[1], &iwork[n * 5 +
01082 1], &iinfo);
01083 if (iinfo != 0) {
01084 io___62.ciunit = *nounit;
01085 s_wsfe(&io___62);
01086
01087 i__7[0] = 11, a__1[0] = "CHEEVX(N,I,";
01088 i__7[1] = 1, a__1[1] = uplo;
01089 i__7[2] = 1, a__1[2] = ")";
01090 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01091 do_fio(&c__1, ch__2, (ftnlen)13);
01092 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01093 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01094 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01095 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01096 ;
01097 e_wsfe();
01098 *info = abs(iinfo);
01099 if (iinfo < 0) {
01100 return 0;
01101 } else {
01102 result[ntest] = ulpinv;
01103 goto L160;
01104 }
01105 }
01106
01107
01108
01109 temp1 = ssxt1_(&c__1, &wa2[1], &m2, &wa3[1], &m3, &abstol, &
01110 ulp, &unfl);
01111 temp2 = ssxt1_(&c__1, &wa3[1], &m3, &wa2[1], &m2, &abstol, &
01112 ulp, &unfl);
01113 if (n > 0) {
01114
01115 r__2 = dabs(wa1[1]), r__3 = (r__1 = wa1[n], dabs(r__1));
01116 temp3 = dmax(r__2,r__3);
01117 } else {
01118 temp3 = 0.f;
01119 }
01120
01121 r__1 = unfl, r__2 = temp3 * ulp;
01122 result[ntest] = (temp1 + temp2) / dmax(r__1,r__2);
01123
01124 L160:
01125 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
01126
01127 ++ntest;
01128
01129 cheevx_("V", "V", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il,
01130 &iu, &abstol, &m2, &wa2[1], &z__[z_offset], ldu, &
01131 work[1], lwork, &rwork[1], &iwork[1], &iwork[n * 5 +
01132 1], &iinfo);
01133 if (iinfo != 0) {
01134 io___63.ciunit = *nounit;
01135 s_wsfe(&io___63);
01136
01137 i__7[0] = 11, a__1[0] = "CHEEVX(V,V,";
01138 i__7[1] = 1, a__1[1] = uplo;
01139 i__7[2] = 1, a__1[2] = ")";
01140 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01141 do_fio(&c__1, ch__2, (ftnlen)13);
01142 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01143 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01144 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01145 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01146 ;
01147 e_wsfe();
01148 *info = abs(iinfo);
01149 if (iinfo < 0) {
01150 return 0;
01151 } else {
01152 result[ntest] = ulpinv;
01153 goto L170;
01154 }
01155 }
01156
01157
01158
01159 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
01160
01161 chet22_(&c__1, uplo, &n, &m2, &c__0, &a[a_offset], ldu, &wa2[
01162 1], &d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &
01163 tau[1], &work[1], &rwork[1], &result[ntest]);
01164
01165 ntest += 2;
01166
01167 cheevx_("N", "V", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il,
01168 &iu, &abstol, &m3, &wa3[1], &z__[z_offset], ldu, &
01169 work[1], lwork, &rwork[1], &iwork[1], &iwork[n * 5 +
01170 1], &iinfo);
01171 if (iinfo != 0) {
01172 io___64.ciunit = *nounit;
01173 s_wsfe(&io___64);
01174
01175 i__7[0] = 11, a__1[0] = "CHEEVX(N,V,";
01176 i__7[1] = 1, a__1[1] = uplo;
01177 i__7[2] = 1, a__1[2] = ")";
01178 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01179 do_fio(&c__1, ch__2, (ftnlen)13);
01180 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01181 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01182 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01183 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01184 ;
01185 e_wsfe();
01186 *info = abs(iinfo);
01187 if (iinfo < 0) {
01188 return 0;
01189 } else {
01190 result[ntest] = ulpinv;
01191 goto L170;
01192 }
01193 }
01194
01195 if (m3 == 0 && n > 0) {
01196 result[ntest] = ulpinv;
01197 goto L170;
01198 }
01199
01200
01201
01202 temp1 = ssxt1_(&c__1, &wa2[1], &m2, &wa3[1], &m3, &abstol, &
01203 ulp, &unfl);
01204 temp2 = ssxt1_(&c__1, &wa3[1], &m3, &wa2[1], &m2, &abstol, &
01205 ulp, &unfl);
01206 if (n > 0) {
01207
01208 r__2 = dabs(wa1[1]), r__3 = (r__1 = wa1[n], dabs(r__1));
01209 temp3 = dmax(r__2,r__3);
01210 } else {
01211 temp3 = 0.f;
01212 }
01213
01214 r__1 = unfl, r__2 = temp3 * ulp;
01215 result[ntest] = (temp1 + temp2) / dmax(r__1,r__2);
01216
01217 L170:
01218
01219
01220
01221 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
01222
01223
01224
01225
01226 if (iuplo == 1) {
01227 indx = 1;
01228 i__3 = n;
01229 for (j = 1; j <= i__3; ++j) {
01230 i__4 = j;
01231 for (i__ = 1; i__ <= i__4; ++i__) {
01232 i__5 = indx;
01233 i__6 = i__ + j * a_dim1;
01234 work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01235 .i;
01236 ++indx;
01237
01238 }
01239
01240 }
01241 } else {
01242 indx = 1;
01243 i__3 = n;
01244 for (j = 1; j <= i__3; ++j) {
01245 i__4 = n;
01246 for (i__ = j; i__ <= i__4; ++i__) {
01247 i__5 = indx;
01248 i__6 = i__ + j * a_dim1;
01249 work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01250 .i;
01251 ++indx;
01252
01253 }
01254
01255 }
01256 }
01257
01258 ++ntest;
01259 indwrk = n * (n + 1) / 2 + 1;
01260 chpevd_("V", uplo, &n, &work[1], &d1[1], &z__[z_offset], ldu,
01261 &work[indwrk], &lwedc, &rwork[1], &lrwedc, &iwork[1],
01262 &liwedc, &iinfo);
01263 if (iinfo != 0) {
01264 io___67.ciunit = *nounit;
01265 s_wsfe(&io___67);
01266
01267 i__7[0] = 9, a__1[0] = "CHPEVD(V,";
01268 i__7[1] = 1, a__1[1] = uplo;
01269 i__7[2] = 1, a__1[2] = ")";
01270 s_cat(ch__1, a__1, i__7, &c__3, (ftnlen)11);
01271 do_fio(&c__1, ch__1, (ftnlen)11);
01272 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01273 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01274 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01275 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01276 ;
01277 e_wsfe();
01278 *info = abs(iinfo);
01279 if (iinfo < 0) {
01280 return 0;
01281 } else {
01282 result[ntest] = ulpinv;
01283 result[ntest + 1] = ulpinv;
01284 result[ntest + 2] = ulpinv;
01285 goto L270;
01286 }
01287 }
01288
01289
01290
01291 chet21_(&c__1, uplo, &n, &c__0, &a[a_offset], lda, &d1[1], &
01292 d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &tau[1]
01293 , &work[1], &rwork[1], &result[ntest]);
01294
01295 if (iuplo == 1) {
01296 indx = 1;
01297 i__3 = n;
01298 for (j = 1; j <= i__3; ++j) {
01299 i__4 = j;
01300 for (i__ = 1; i__ <= i__4; ++i__) {
01301 i__5 = indx;
01302 i__6 = i__ + j * a_dim1;
01303 work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01304 .i;
01305 ++indx;
01306
01307 }
01308
01309 }
01310 } else {
01311 indx = 1;
01312 i__3 = n;
01313 for (j = 1; j <= i__3; ++j) {
01314 i__4 = n;
01315 for (i__ = j; i__ <= i__4; ++i__) {
01316 i__5 = indx;
01317 i__6 = i__ + j * a_dim1;
01318 work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01319 .i;
01320 ++indx;
01321
01322 }
01323
01324 }
01325 }
01326
01327 ntest += 2;
01328 indwrk = n * (n + 1) / 2 + 1;
01329 chpevd_("N", uplo, &n, &work[1], &d3[1], &z__[z_offset], ldu,
01330 &work[indwrk], &lwedc, &rwork[1], &lrwedc, &iwork[1],
01331 &liwedc, &iinfo);
01332 if (iinfo != 0) {
01333 io___68.ciunit = *nounit;
01334 s_wsfe(&io___68);
01335
01336 i__7[0] = 9, a__1[0] = "CHPEVD(N,";
01337 i__7[1] = 1, a__1[1] = uplo;
01338 i__7[2] = 1, a__1[2] = ")";
01339 s_cat(ch__1, a__1, i__7, &c__3, (ftnlen)11);
01340 do_fio(&c__1, ch__1, (ftnlen)11);
01341 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01342 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01343 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01344 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01345 ;
01346 e_wsfe();
01347 *info = abs(iinfo);
01348 if (iinfo < 0) {
01349 return 0;
01350 } else {
01351 result[ntest] = ulpinv;
01352 goto L270;
01353 }
01354 }
01355
01356
01357
01358 temp1 = 0.f;
01359 temp2 = 0.f;
01360 i__3 = n;
01361 for (j = 1; j <= i__3; ++j) {
01362
01363 r__3 = temp1, r__4 = (r__1 = d1[j], dabs(r__1)), r__3 =
01364 max(r__3,r__4), r__4 = (r__2 = d3[j], dabs(r__2));
01365 temp1 = dmax(r__3,r__4);
01366
01367 r__2 = temp2, r__3 = (r__1 = d1[j] - d3[j], dabs(r__1));
01368 temp2 = dmax(r__2,r__3);
01369
01370 }
01371
01372 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
01373 result[ntest] = temp2 / dmax(r__1,r__2);
01374
01375
01376
01377
01378 L270:
01379 if (iuplo == 1) {
01380 indx = 1;
01381 i__3 = n;
01382 for (j = 1; j <= i__3; ++j) {
01383 i__4 = j;
01384 for (i__ = 1; i__ <= i__4; ++i__) {
01385 i__5 = indx;
01386 i__6 = i__ + j * a_dim1;
01387 work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01388 .i;
01389 ++indx;
01390
01391 }
01392
01393 }
01394 } else {
01395 indx = 1;
01396 i__3 = n;
01397 for (j = 1; j <= i__3; ++j) {
01398 i__4 = n;
01399 for (i__ = j; i__ <= i__4; ++i__) {
01400 i__5 = indx;
01401 i__6 = i__ + j * a_dim1;
01402 work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01403 .i;
01404 ++indx;
01405
01406 }
01407
01408 }
01409 }
01410
01411 ++ntest;
01412
01413 if (n > 0) {
01414
01415 r__2 = dabs(d1[1]), r__3 = (r__1 = d1[n], dabs(r__1));
01416 temp3 = dmax(r__2,r__3);
01417 if (il != 1) {
01418
01419 r__1 = (d1[il] - d1[il - 1]) * .5f, r__2 = ulp * 10.f
01420 * temp3, r__1 = max(r__1,r__2), r__2 = rtunfl
01421 * 10.f;
01422 vl = d1[il] - dmax(r__1,r__2);
01423 } else if (n > 0) {
01424
01425 r__1 = (d1[n] - d1[1]) * .5f, r__2 = ulp * 10.f *
01426 temp3, r__1 = max(r__1,r__2), r__2 = rtunfl *
01427 10.f;
01428 vl = d1[1] - dmax(r__1,r__2);
01429 }
01430 if (iu != n) {
01431
01432 r__1 = (d1[iu + 1] - d1[iu]) * .5f, r__2 = ulp * 10.f
01433 * temp3, r__1 = max(r__1,r__2), r__2 = rtunfl
01434 * 10.f;
01435 vu = d1[iu] + dmax(r__1,r__2);
01436 } else if (n > 0) {
01437
01438 r__1 = (d1[n] - d1[1]) * .5f, r__2 = ulp * 10.f *
01439 temp3, r__1 = max(r__1,r__2), r__2 = rtunfl *
01440 10.f;
01441 vu = d1[n] + dmax(r__1,r__2);
01442 }
01443 } else {
01444 temp3 = 0.f;
01445 vl = 0.f;
01446 vu = 1.f;
01447 }
01448
01449 chpevx_("V", "A", uplo, &n, &work[1], &vl, &vu, &il, &iu, &
01450 abstol, &m, &wa1[1], &z__[z_offset], ldu, &v[v_offset]
01451 , &rwork[1], &iwork[1], &iwork[n * 5 + 1], &iinfo);
01452 if (iinfo != 0) {
01453 io___69.ciunit = *nounit;
01454 s_wsfe(&io___69);
01455
01456 i__7[0] = 11, a__1[0] = "CHPEVX(V,A,";
01457 i__7[1] = 1, a__1[1] = uplo;
01458 i__7[2] = 1, a__1[2] = ")";
01459 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01460 do_fio(&c__1, ch__2, (ftnlen)13);
01461 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01462 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01463 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01464 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01465 ;
01466 e_wsfe();
01467 *info = abs(iinfo);
01468 if (iinfo < 0) {
01469 return 0;
01470 } else {
01471 result[ntest] = ulpinv;
01472 result[ntest + 1] = ulpinv;
01473 result[ntest + 2] = ulpinv;
01474 goto L370;
01475 }
01476 }
01477
01478
01479
01480 chet21_(&c__1, uplo, &n, &c__0, &a[a_offset], ldu, &wa1[1], &
01481 d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &tau[1]
01482 , &work[1], &rwork[1], &result[ntest]);
01483
01484 ntest += 2;
01485
01486 if (iuplo == 1) {
01487 indx = 1;
01488 i__3 = n;
01489 for (j = 1; j <= i__3; ++j) {
01490 i__4 = j;
01491 for (i__ = 1; i__ <= i__4; ++i__) {
01492 i__5 = indx;
01493 i__6 = i__ + j * a_dim1;
01494 work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01495 .i;
01496 ++indx;
01497
01498 }
01499
01500 }
01501 } else {
01502 indx = 1;
01503 i__3 = n;
01504 for (j = 1; j <= i__3; ++j) {
01505 i__4 = n;
01506 for (i__ = j; i__ <= i__4; ++i__) {
01507 i__5 = indx;
01508 i__6 = i__ + j * a_dim1;
01509 work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01510 .i;
01511 ++indx;
01512
01513 }
01514
01515 }
01516 }
01517
01518 chpevx_("N", "A", uplo, &n, &work[1], &vl, &vu, &il, &iu, &
01519 abstol, &m2, &wa2[1], &z__[z_offset], ldu, &v[
01520 v_offset], &rwork[1], &iwork[1], &iwork[n * 5 + 1], &
01521 iinfo);
01522 if (iinfo != 0) {
01523 io___70.ciunit = *nounit;
01524 s_wsfe(&io___70);
01525
01526 i__7[0] = 11, a__1[0] = "CHPEVX(N,A,";
01527 i__7[1] = 1, a__1[1] = uplo;
01528 i__7[2] = 1, a__1[2] = ")";
01529 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01530 do_fio(&c__1, ch__2, (ftnlen)13);
01531 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01532 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01533 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01534 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01535 ;
01536 e_wsfe();
01537 *info = abs(iinfo);
01538 if (iinfo < 0) {
01539 return 0;
01540 } else {
01541 result[ntest] = ulpinv;
01542 goto L370;
01543 }
01544 }
01545
01546
01547
01548 temp1 = 0.f;
01549 temp2 = 0.f;
01550 i__3 = n;
01551 for (j = 1; j <= i__3; ++j) {
01552
01553 r__3 = temp1, r__4 = (r__1 = wa1[j], dabs(r__1)), r__3 =
01554 max(r__3,r__4), r__4 = (r__2 = wa2[j], dabs(r__2))
01555 ;
01556 temp1 = dmax(r__3,r__4);
01557
01558 r__2 = temp2, r__3 = (r__1 = wa1[j] - wa2[j], dabs(r__1));
01559 temp2 = dmax(r__2,r__3);
01560
01561 }
01562
01563 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
01564 result[ntest] = temp2 / dmax(r__1,r__2);
01565
01566 L370:
01567 ++ntest;
01568 if (iuplo == 1) {
01569 indx = 1;
01570 i__3 = n;
01571 for (j = 1; j <= i__3; ++j) {
01572 i__4 = j;
01573 for (i__ = 1; i__ <= i__4; ++i__) {
01574 i__5 = indx;
01575 i__6 = i__ + j * a_dim1;
01576 work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01577 .i;
01578 ++indx;
01579
01580 }
01581
01582 }
01583 } else {
01584 indx = 1;
01585 i__3 = n;
01586 for (j = 1; j <= i__3; ++j) {
01587 i__4 = n;
01588 for (i__ = j; i__ <= i__4; ++i__) {
01589 i__5 = indx;
01590 i__6 = i__ + j * a_dim1;
01591 work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01592 .i;
01593 ++indx;
01594
01595 }
01596
01597 }
01598 }
01599
01600 chpevx_("V", "I", uplo, &n, &work[1], &vl, &vu, &il, &iu, &
01601 abstol, &m2, &wa2[1], &z__[z_offset], ldu, &v[
01602 v_offset], &rwork[1], &iwork[1], &iwork[n * 5 + 1], &
01603 iinfo);
01604 if (iinfo != 0) {
01605 io___71.ciunit = *nounit;
01606 s_wsfe(&io___71);
01607
01608 i__7[0] = 11, a__1[0] = "CHPEVX(V,I,";
01609 i__7[1] = 1, a__1[1] = uplo;
01610 i__7[2] = 1, a__1[2] = ")";
01611 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01612 do_fio(&c__1, ch__2, (ftnlen)13);
01613 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01614 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01615 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01616 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01617 ;
01618 e_wsfe();
01619 *info = abs(iinfo);
01620 if (iinfo < 0) {
01621 return 0;
01622 } else {
01623 result[ntest] = ulpinv;
01624 result[ntest + 1] = ulpinv;
01625 result[ntest + 2] = ulpinv;
01626 goto L460;
01627 }
01628 }
01629
01630
01631
01632 chet22_(&c__1, uplo, &n, &m2, &c__0, &a[a_offset], ldu, &wa2[
01633 1], &d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &
01634 tau[1], &work[1], &rwork[1], &result[ntest]);
01635
01636 ntest += 2;
01637
01638 if (iuplo == 1) {
01639 indx = 1;
01640 i__3 = n;
01641 for (j = 1; j <= i__3; ++j) {
01642 i__4 = j;
01643 for (i__ = 1; i__ <= i__4; ++i__) {
01644 i__5 = indx;
01645 i__6 = i__ + j * a_dim1;
01646 work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01647 .i;
01648 ++indx;
01649
01650 }
01651
01652 }
01653 } else {
01654 indx = 1;
01655 i__3 = n;
01656 for (j = 1; j <= i__3; ++j) {
01657 i__4 = n;
01658 for (i__ = j; i__ <= i__4; ++i__) {
01659 i__5 = indx;
01660 i__6 = i__ + j * a_dim1;
01661 work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01662 .i;
01663 ++indx;
01664
01665 }
01666
01667 }
01668 }
01669
01670 chpevx_("N", "I", uplo, &n, &work[1], &vl, &vu, &il, &iu, &
01671 abstol, &m3, &wa3[1], &z__[z_offset], ldu, &v[
01672 v_offset], &rwork[1], &iwork[1], &iwork[n * 5 + 1], &
01673 iinfo);
01674 if (iinfo != 0) {
01675 io___72.ciunit = *nounit;
01676 s_wsfe(&io___72);
01677
01678 i__7[0] = 11, a__1[0] = "CHPEVX(N,I,";
01679 i__7[1] = 1, a__1[1] = uplo;
01680 i__7[2] = 1, a__1[2] = ")";
01681 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01682 do_fio(&c__1, ch__2, (ftnlen)13);
01683 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01684 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01685 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01686 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01687 ;
01688 e_wsfe();
01689 *info = abs(iinfo);
01690 if (iinfo < 0) {
01691 return 0;
01692 } else {
01693 result[ntest] = ulpinv;
01694 goto L460;
01695 }
01696 }
01697
01698
01699
01700 temp1 = ssxt1_(&c__1, &wa2[1], &m2, &wa3[1], &m3, &abstol, &
01701 ulp, &unfl);
01702 temp2 = ssxt1_(&c__1, &wa3[1], &m3, &wa2[1], &m2, &abstol, &
01703 ulp, &unfl);
01704 if (n > 0) {
01705
01706 r__2 = dabs(wa1[1]), r__3 = (r__1 = wa1[n], dabs(r__1));
01707 temp3 = dmax(r__2,r__3);
01708 } else {
01709 temp3 = 0.f;
01710 }
01711
01712 r__1 = unfl, r__2 = temp3 * ulp;
01713 result[ntest] = (temp1 + temp2) / dmax(r__1,r__2);
01714
01715 L460:
01716 ++ntest;
01717 if (iuplo == 1) {
01718 indx = 1;
01719 i__3 = n;
01720 for (j = 1; j <= i__3; ++j) {
01721 i__4 = j;
01722 for (i__ = 1; i__ <= i__4; ++i__) {
01723 i__5 = indx;
01724 i__6 = i__ + j * a_dim1;
01725 work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01726 .i;
01727 ++indx;
01728
01729 }
01730
01731 }
01732 } else {
01733 indx = 1;
01734 i__3 = n;
01735 for (j = 1; j <= i__3; ++j) {
01736 i__4 = n;
01737 for (i__ = j; i__ <= i__4; ++i__) {
01738 i__5 = indx;
01739 i__6 = i__ + j * a_dim1;
01740 work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01741 .i;
01742 ++indx;
01743
01744 }
01745
01746 }
01747 }
01748
01749 chpevx_("V", "V", uplo, &n, &work[1], &vl, &vu, &il, &iu, &
01750 abstol, &m2, &wa2[1], &z__[z_offset], ldu, &v[
01751 v_offset], &rwork[1], &iwork[1], &iwork[n * 5 + 1], &
01752 iinfo);
01753 if (iinfo != 0) {
01754 io___73.ciunit = *nounit;
01755 s_wsfe(&io___73);
01756
01757 i__7[0] = 11, a__1[0] = "CHPEVX(V,V,";
01758 i__7[1] = 1, a__1[1] = uplo;
01759 i__7[2] = 1, a__1[2] = ")";
01760 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01761 do_fio(&c__1, ch__2, (ftnlen)13);
01762 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01763 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01764 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01765 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01766 ;
01767 e_wsfe();
01768 *info = abs(iinfo);
01769 if (iinfo < 0) {
01770 return 0;
01771 } else {
01772 result[ntest] = ulpinv;
01773 result[ntest + 1] = ulpinv;
01774 result[ntest + 2] = ulpinv;
01775 goto L550;
01776 }
01777 }
01778
01779
01780
01781 chet22_(&c__1, uplo, &n, &m2, &c__0, &a[a_offset], ldu, &wa2[
01782 1], &d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &
01783 tau[1], &work[1], &rwork[1], &result[ntest]);
01784
01785 ntest += 2;
01786
01787 if (iuplo == 1) {
01788 indx = 1;
01789 i__3 = n;
01790 for (j = 1; j <= i__3; ++j) {
01791 i__4 = j;
01792 for (i__ = 1; i__ <= i__4; ++i__) {
01793 i__5 = indx;
01794 i__6 = i__ + j * a_dim1;
01795 work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01796 .i;
01797 ++indx;
01798
01799 }
01800
01801 }
01802 } else {
01803 indx = 1;
01804 i__3 = n;
01805 for (j = 1; j <= i__3; ++j) {
01806 i__4 = n;
01807 for (i__ = j; i__ <= i__4; ++i__) {
01808 i__5 = indx;
01809 i__6 = i__ + j * a_dim1;
01810 work[i__5].r = a[i__6].r, work[i__5].i = a[i__6]
01811 .i;
01812 ++indx;
01813
01814 }
01815
01816 }
01817 }
01818
01819 chpevx_("N", "V", uplo, &n, &work[1], &vl, &vu, &il, &iu, &
01820 abstol, &m3, &wa3[1], &z__[z_offset], ldu, &v[
01821 v_offset], &rwork[1], &iwork[1], &iwork[n * 5 + 1], &
01822 iinfo);
01823 if (iinfo != 0) {
01824 io___74.ciunit = *nounit;
01825 s_wsfe(&io___74);
01826
01827 i__7[0] = 11, a__1[0] = "CHPEVX(N,V,";
01828 i__7[1] = 1, a__1[1] = uplo;
01829 i__7[2] = 1, a__1[2] = ")";
01830 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
01831 do_fio(&c__1, ch__2, (ftnlen)13);
01832 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01833 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01834 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01835 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01836 ;
01837 e_wsfe();
01838 *info = abs(iinfo);
01839 if (iinfo < 0) {
01840 return 0;
01841 } else {
01842 result[ntest] = ulpinv;
01843 goto L550;
01844 }
01845 }
01846
01847 if (m3 == 0 && n > 0) {
01848 result[ntest] = ulpinv;
01849 goto L550;
01850 }
01851
01852
01853
01854 temp1 = ssxt1_(&c__1, &wa2[1], &m2, &wa3[1], &m3, &abstol, &
01855 ulp, &unfl);
01856 temp2 = ssxt1_(&c__1, &wa3[1], &m3, &wa2[1], &m2, &abstol, &
01857 ulp, &unfl);
01858 if (n > 0) {
01859
01860 r__2 = dabs(wa1[1]), r__3 = (r__1 = wa1[n], dabs(r__1));
01861 temp3 = dmax(r__2,r__3);
01862 } else {
01863 temp3 = 0.f;
01864 }
01865
01866 r__1 = unfl, r__2 = temp3 * ulp;
01867 result[ntest] = (temp1 + temp2) / dmax(r__1,r__2);
01868
01869 L550:
01870
01871
01872
01873 if (jtype <= 7) {
01874 kd = 0;
01875 } else if (jtype >= 8 && jtype <= 15) {
01876
01877 i__3 = n - 1;
01878 kd = max(i__3,0);
01879 } else {
01880 kd = ihbw;
01881 }
01882
01883
01884
01885
01886 if (iuplo == 1) {
01887 i__3 = n;
01888 for (j = 1; j <= i__3; ++j) {
01889
01890 i__4 = 1, i__5 = j - kd;
01891 i__6 = j;
01892 for (i__ = max(i__4,i__5); i__ <= i__6; ++i__) {
01893 i__4 = kd + 1 + i__ - j + j * v_dim1;
01894 i__5 = i__ + j * a_dim1;
01895 v[i__4].r = a[i__5].r, v[i__4].i = a[i__5].i;
01896
01897 }
01898
01899 }
01900 } else {
01901 i__3 = n;
01902 for (j = 1; j <= i__3; ++j) {
01903
01904 i__4 = n, i__5 = j + kd;
01905 i__6 = min(i__4,i__5);
01906 for (i__ = j; i__ <= i__6; ++i__) {
01907 i__4 = i__ + 1 - j + j * v_dim1;
01908 i__5 = i__ + j * a_dim1;
01909 v[i__4].r = a[i__5].r, v[i__4].i = a[i__5].i;
01910
01911 }
01912
01913 }
01914 }
01915
01916 ++ntest;
01917 chbevd_("V", uplo, &n, &kd, &v[v_offset], ldu, &d1[1], &z__[
01918 z_offset], ldu, &work[1], &lwedc, &rwork[1], &lrwedc,
01919 &iwork[1], &liwedc, &iinfo);
01920 if (iinfo != 0) {
01921 io___76.ciunit = *nounit;
01922 s_wsfe(&io___76);
01923
01924 i__7[0] = 9, a__1[0] = "CHBEVD(V,";
01925 i__7[1] = 1, a__1[1] = uplo;
01926 i__7[2] = 1, a__1[2] = ")";
01927 s_cat(ch__1, a__1, i__7, &c__3, (ftnlen)11);
01928 do_fio(&c__1, ch__1, (ftnlen)11);
01929 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01930 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01931 do_fio(&c__1, (char *)&kd, (ftnlen)sizeof(integer));
01932 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01933 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01934 ;
01935 e_wsfe();
01936 *info = abs(iinfo);
01937 if (iinfo < 0) {
01938 return 0;
01939 } else {
01940 result[ntest] = ulpinv;
01941 result[ntest + 1] = ulpinv;
01942 result[ntest + 2] = ulpinv;
01943 goto L650;
01944 }
01945 }
01946
01947
01948
01949 chet21_(&c__1, uplo, &n, &c__0, &a[a_offset], lda, &d1[1], &
01950 d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &tau[1]
01951 , &work[1], &rwork[1], &result[ntest]);
01952
01953 if (iuplo == 1) {
01954 i__3 = n;
01955 for (j = 1; j <= i__3; ++j) {
01956
01957 i__6 = 1, i__4 = j - kd;
01958 i__5 = j;
01959 for (i__ = max(i__6,i__4); i__ <= i__5; ++i__) {
01960 i__6 = kd + 1 + i__ - j + j * v_dim1;
01961 i__4 = i__ + j * a_dim1;
01962 v[i__6].r = a[i__4].r, v[i__6].i = a[i__4].i;
01963
01964 }
01965
01966 }
01967 } else {
01968 i__3 = n;
01969 for (j = 1; j <= i__3; ++j) {
01970
01971 i__6 = n, i__4 = j + kd;
01972 i__5 = min(i__6,i__4);
01973 for (i__ = j; i__ <= i__5; ++i__) {
01974 i__6 = i__ + 1 - j + j * v_dim1;
01975 i__4 = i__ + j * a_dim1;
01976 v[i__6].r = a[i__4].r, v[i__6].i = a[i__4].i;
01977
01978 }
01979
01980 }
01981 }
01982
01983 ntest += 2;
01984 chbevd_("N", uplo, &n, &kd, &v[v_offset], ldu, &d3[1], &z__[
01985 z_offset], ldu, &work[1], &lwedc, &rwork[1], &lrwedc,
01986 &iwork[1], &liwedc, &iinfo);
01987 if (iinfo != 0) {
01988 io___77.ciunit = *nounit;
01989 s_wsfe(&io___77);
01990
01991 i__7[0] = 9, a__1[0] = "CHBEVD(N,";
01992 i__7[1] = 1, a__1[1] = uplo;
01993 i__7[2] = 1, a__1[2] = ")";
01994 s_cat(ch__1, a__1, i__7, &c__3, (ftnlen)11);
01995 do_fio(&c__1, ch__1, (ftnlen)11);
01996 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01997 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01998 do_fio(&c__1, (char *)&kd, (ftnlen)sizeof(integer));
01999 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02000 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02001 ;
02002 e_wsfe();
02003 *info = abs(iinfo);
02004 if (iinfo < 0) {
02005 return 0;
02006 } else {
02007 result[ntest] = ulpinv;
02008 goto L650;
02009 }
02010 }
02011
02012
02013
02014 temp1 = 0.f;
02015 temp2 = 0.f;
02016 i__3 = n;
02017 for (j = 1; j <= i__3; ++j) {
02018
02019 r__3 = temp1, r__4 = (r__1 = d1[j], dabs(r__1)), r__3 =
02020 max(r__3,r__4), r__4 = (r__2 = d3[j], dabs(r__2));
02021 temp1 = dmax(r__3,r__4);
02022
02023 r__2 = temp2, r__3 = (r__1 = d1[j] - d3[j], dabs(r__1));
02024 temp2 = dmax(r__2,r__3);
02025
02026 }
02027
02028 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
02029 result[ntest] = temp2 / dmax(r__1,r__2);
02030
02031
02032
02033
02034 L650:
02035 if (iuplo == 1) {
02036 i__3 = n;
02037 for (j = 1; j <= i__3; ++j) {
02038
02039 i__5 = 1, i__6 = j - kd;
02040 i__4 = j;
02041 for (i__ = max(i__5,i__6); i__ <= i__4; ++i__) {
02042 i__5 = kd + 1 + i__ - j + j * v_dim1;
02043 i__6 = i__ + j * a_dim1;
02044 v[i__5].r = a[i__6].r, v[i__5].i = a[i__6].i;
02045
02046 }
02047
02048 }
02049 } else {
02050 i__3 = n;
02051 for (j = 1; j <= i__3; ++j) {
02052
02053 i__5 = n, i__6 = j + kd;
02054 i__4 = min(i__5,i__6);
02055 for (i__ = j; i__ <= i__4; ++i__) {
02056 i__5 = i__ + 1 - j + j * v_dim1;
02057 i__6 = i__ + j * a_dim1;
02058 v[i__5].r = a[i__6].r, v[i__5].i = a[i__6].i;
02059
02060 }
02061
02062 }
02063 }
02064
02065 ++ntest;
02066 chbevx_("V", "A", uplo, &n, &kd, &v[v_offset], ldu, &u[
02067 u_offset], ldu, &vl, &vu, &il, &iu, &abstol, &m, &wa1[
02068 1], &z__[z_offset], ldu, &work[1], &rwork[1], &iwork[
02069 1], &iwork[n * 5 + 1], &iinfo);
02070 if (iinfo != 0) {
02071 io___78.ciunit = *nounit;
02072 s_wsfe(&io___78);
02073
02074 i__7[0] = 11, a__1[0] = "CHBEVX(V,A,";
02075 i__7[1] = 1, a__1[1] = uplo;
02076 i__7[2] = 1, a__1[2] = ")";
02077 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
02078 do_fio(&c__1, ch__2, (ftnlen)13);
02079 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02080 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02081 do_fio(&c__1, (char *)&kd, (ftnlen)sizeof(integer));
02082 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02083 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02084 ;
02085 e_wsfe();
02086 *info = abs(iinfo);
02087 if (iinfo < 0) {
02088 return 0;
02089 } else {
02090 result[ntest] = ulpinv;
02091 result[ntest + 1] = ulpinv;
02092 result[ntest + 2] = ulpinv;
02093 goto L750;
02094 }
02095 }
02096
02097
02098
02099 chet21_(&c__1, uplo, &n, &c__0, &a[a_offset], ldu, &wa1[1], &
02100 d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &tau[1]
02101 , &work[1], &rwork[1], &result[ntest]);
02102
02103 ntest += 2;
02104
02105 if (iuplo == 1) {
02106 i__3 = n;
02107 for (j = 1; j <= i__3; ++j) {
02108
02109 i__4 = 1, i__5 = j - kd;
02110 i__6 = j;
02111 for (i__ = max(i__4,i__5); i__ <= i__6; ++i__) {
02112 i__4 = kd + 1 + i__ - j + j * v_dim1;
02113 i__5 = i__ + j * a_dim1;
02114 v[i__4].r = a[i__5].r, v[i__4].i = a[i__5].i;
02115
02116 }
02117
02118 }
02119 } else {
02120 i__3 = n;
02121 for (j = 1; j <= i__3; ++j) {
02122
02123 i__4 = n, i__5 = j + kd;
02124 i__6 = min(i__4,i__5);
02125 for (i__ = j; i__ <= i__6; ++i__) {
02126 i__4 = i__ + 1 - j + j * v_dim1;
02127 i__5 = i__ + j * a_dim1;
02128 v[i__4].r = a[i__5].r, v[i__4].i = a[i__5].i;
02129
02130 }
02131
02132 }
02133 }
02134
02135 chbevx_("N", "A", uplo, &n, &kd, &v[v_offset], ldu, &u[
02136 u_offset], ldu, &vl, &vu, &il, &iu, &abstol, &m2, &
02137 wa2[1], &z__[z_offset], ldu, &work[1], &rwork[1], &
02138 iwork[1], &iwork[n * 5 + 1], &iinfo);
02139 if (iinfo != 0) {
02140 io___79.ciunit = *nounit;
02141 s_wsfe(&io___79);
02142
02143 i__7[0] = 11, a__1[0] = "CHBEVX(N,A,";
02144 i__7[1] = 1, a__1[1] = uplo;
02145 i__7[2] = 1, a__1[2] = ")";
02146 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
02147 do_fio(&c__1, ch__2, (ftnlen)13);
02148 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02149 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02150 do_fio(&c__1, (char *)&kd, (ftnlen)sizeof(integer));
02151 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02152 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02153 ;
02154 e_wsfe();
02155 *info = abs(iinfo);
02156 if (iinfo < 0) {
02157 return 0;
02158 } else {
02159 result[ntest] = ulpinv;
02160 goto L750;
02161 }
02162 }
02163
02164
02165
02166 temp1 = 0.f;
02167 temp2 = 0.f;
02168 i__3 = n;
02169 for (j = 1; j <= i__3; ++j) {
02170
02171 r__3 = temp1, r__4 = (r__1 = wa1[j], dabs(r__1)), r__3 =
02172 max(r__3,r__4), r__4 = (r__2 = wa2[j], dabs(r__2))
02173 ;
02174 temp1 = dmax(r__3,r__4);
02175
02176 r__2 = temp2, r__3 = (r__1 = wa1[j] - wa2[j], dabs(r__1));
02177 temp2 = dmax(r__2,r__3);
02178
02179 }
02180
02181 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
02182 result[ntest] = temp2 / dmax(r__1,r__2);
02183
02184
02185
02186
02187 L750:
02188 ++ntest;
02189 if (iuplo == 1) {
02190 i__3 = n;
02191 for (j = 1; j <= i__3; ++j) {
02192
02193 i__6 = 1, i__4 = j - kd;
02194 i__5 = j;
02195 for (i__ = max(i__6,i__4); i__ <= i__5; ++i__) {
02196 i__6 = kd + 1 + i__ - j + j * v_dim1;
02197 i__4 = i__ + j * a_dim1;
02198 v[i__6].r = a[i__4].r, v[i__6].i = a[i__4].i;
02199
02200 }
02201
02202 }
02203 } else {
02204 i__3 = n;
02205 for (j = 1; j <= i__3; ++j) {
02206
02207 i__6 = n, i__4 = j + kd;
02208 i__5 = min(i__6,i__4);
02209 for (i__ = j; i__ <= i__5; ++i__) {
02210 i__6 = i__ + 1 - j + j * v_dim1;
02211 i__4 = i__ + j * a_dim1;
02212 v[i__6].r = a[i__4].r, v[i__6].i = a[i__4].i;
02213
02214 }
02215
02216 }
02217 }
02218
02219 chbevx_("V", "I", uplo, &n, &kd, &v[v_offset], ldu, &u[
02220 u_offset], ldu, &vl, &vu, &il, &iu, &abstol, &m2, &
02221 wa2[1], &z__[z_offset], ldu, &work[1], &rwork[1], &
02222 iwork[1], &iwork[n * 5 + 1], &iinfo);
02223 if (iinfo != 0) {
02224 io___80.ciunit = *nounit;
02225 s_wsfe(&io___80);
02226
02227 i__7[0] = 11, a__1[0] = "CHBEVX(V,I,";
02228 i__7[1] = 1, a__1[1] = uplo;
02229 i__7[2] = 1, a__1[2] = ")";
02230 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
02231 do_fio(&c__1, ch__2, (ftnlen)13);
02232 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02233 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02234 do_fio(&c__1, (char *)&kd, (ftnlen)sizeof(integer));
02235 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02236 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02237 ;
02238 e_wsfe();
02239 *info = abs(iinfo);
02240 if (iinfo < 0) {
02241 return 0;
02242 } else {
02243 result[ntest] = ulpinv;
02244 result[ntest + 1] = ulpinv;
02245 result[ntest + 2] = ulpinv;
02246 goto L840;
02247 }
02248 }
02249
02250
02251
02252 chet22_(&c__1, uplo, &n, &m2, &c__0, &a[a_offset], ldu, &wa2[
02253 1], &d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &
02254 tau[1], &work[1], &rwork[1], &result[ntest]);
02255
02256 ntest += 2;
02257
02258 if (iuplo == 1) {
02259 i__3 = n;
02260 for (j = 1; j <= i__3; ++j) {
02261
02262 i__5 = 1, i__6 = j - kd;
02263 i__4 = j;
02264 for (i__ = max(i__5,i__6); i__ <= i__4; ++i__) {
02265 i__5 = kd + 1 + i__ - j + j * v_dim1;
02266 i__6 = i__ + j * a_dim1;
02267 v[i__5].r = a[i__6].r, v[i__5].i = a[i__6].i;
02268
02269 }
02270
02271 }
02272 } else {
02273 i__3 = n;
02274 for (j = 1; j <= i__3; ++j) {
02275
02276 i__5 = n, i__6 = j + kd;
02277 i__4 = min(i__5,i__6);
02278 for (i__ = j; i__ <= i__4; ++i__) {
02279 i__5 = i__ + 1 - j + j * v_dim1;
02280 i__6 = i__ + j * a_dim1;
02281 v[i__5].r = a[i__6].r, v[i__5].i = a[i__6].i;
02282
02283 }
02284
02285 }
02286 }
02287 chbevx_("N", "I", uplo, &n, &kd, &v[v_offset], ldu, &u[
02288 u_offset], ldu, &vl, &vu, &il, &iu, &abstol, &m3, &
02289 wa3[1], &z__[z_offset], ldu, &work[1], &rwork[1], &
02290 iwork[1], &iwork[n * 5 + 1], &iinfo);
02291 if (iinfo != 0) {
02292 io___81.ciunit = *nounit;
02293 s_wsfe(&io___81);
02294
02295 i__7[0] = 11, a__1[0] = "CHBEVX(N,I,";
02296 i__7[1] = 1, a__1[1] = uplo;
02297 i__7[2] = 1, a__1[2] = ")";
02298 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
02299 do_fio(&c__1, ch__2, (ftnlen)13);
02300 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02301 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02302 do_fio(&c__1, (char *)&kd, (ftnlen)sizeof(integer));
02303 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02304 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02305 ;
02306 e_wsfe();
02307 *info = abs(iinfo);
02308 if (iinfo < 0) {
02309 return 0;
02310 } else {
02311 result[ntest] = ulpinv;
02312 goto L840;
02313 }
02314 }
02315
02316
02317
02318 temp1 = ssxt1_(&c__1, &wa2[1], &m2, &wa3[1], &m3, &abstol, &
02319 ulp, &unfl);
02320 temp2 = ssxt1_(&c__1, &wa3[1], &m3, &wa2[1], &m2, &abstol, &
02321 ulp, &unfl);
02322 if (n > 0) {
02323
02324 r__2 = dabs(wa1[1]), r__3 = (r__1 = wa1[n], dabs(r__1));
02325 temp3 = dmax(r__2,r__3);
02326 } else {
02327 temp3 = 0.f;
02328 }
02329
02330 r__1 = unfl, r__2 = temp3 * ulp;
02331 result[ntest] = (temp1 + temp2) / dmax(r__1,r__2);
02332
02333
02334
02335
02336 L840:
02337 ++ntest;
02338 if (iuplo == 1) {
02339 i__3 = n;
02340 for (j = 1; j <= i__3; ++j) {
02341
02342 i__4 = 1, i__5 = j - kd;
02343 i__6 = j;
02344 for (i__ = max(i__4,i__5); i__ <= i__6; ++i__) {
02345 i__4 = kd + 1 + i__ - j + j * v_dim1;
02346 i__5 = i__ + j * a_dim1;
02347 v[i__4].r = a[i__5].r, v[i__4].i = a[i__5].i;
02348
02349 }
02350
02351 }
02352 } else {
02353 i__3 = n;
02354 for (j = 1; j <= i__3; ++j) {
02355
02356 i__4 = n, i__5 = j + kd;
02357 i__6 = min(i__4,i__5);
02358 for (i__ = j; i__ <= i__6; ++i__) {
02359 i__4 = i__ + 1 - j + j * v_dim1;
02360 i__5 = i__ + j * a_dim1;
02361 v[i__4].r = a[i__5].r, v[i__4].i = a[i__5].i;
02362
02363 }
02364
02365 }
02366 }
02367 chbevx_("V", "V", uplo, &n, &kd, &v[v_offset], ldu, &u[
02368 u_offset], ldu, &vl, &vu, &il, &iu, &abstol, &m2, &
02369 wa2[1], &z__[z_offset], ldu, &work[1], &rwork[1], &
02370 iwork[1], &iwork[n * 5 + 1], &iinfo);
02371 if (iinfo != 0) {
02372 io___82.ciunit = *nounit;
02373 s_wsfe(&io___82);
02374
02375 i__7[0] = 11, a__1[0] = "CHBEVX(V,V,";
02376 i__7[1] = 1, a__1[1] = uplo;
02377 i__7[2] = 1, a__1[2] = ")";
02378 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
02379 do_fio(&c__1, ch__2, (ftnlen)13);
02380 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02381 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02382 do_fio(&c__1, (char *)&kd, (ftnlen)sizeof(integer));
02383 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02384 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02385 ;
02386 e_wsfe();
02387 *info = abs(iinfo);
02388 if (iinfo < 0) {
02389 return 0;
02390 } else {
02391 result[ntest] = ulpinv;
02392 result[ntest + 1] = ulpinv;
02393 result[ntest + 2] = ulpinv;
02394 goto L930;
02395 }
02396 }
02397
02398
02399
02400 chet22_(&c__1, uplo, &n, &m2, &c__0, &a[a_offset], ldu, &wa2[
02401 1], &d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &
02402 tau[1], &work[1], &rwork[1], &result[ntest]);
02403
02404 ntest += 2;
02405
02406 if (iuplo == 1) {
02407 i__3 = n;
02408 for (j = 1; j <= i__3; ++j) {
02409
02410 i__6 = 1, i__4 = j - kd;
02411 i__5 = j;
02412 for (i__ = max(i__6,i__4); i__ <= i__5; ++i__) {
02413 i__6 = kd + 1 + i__ - j + j * v_dim1;
02414 i__4 = i__ + j * a_dim1;
02415 v[i__6].r = a[i__4].r, v[i__6].i = a[i__4].i;
02416
02417 }
02418
02419 }
02420 } else {
02421 i__3 = n;
02422 for (j = 1; j <= i__3; ++j) {
02423
02424 i__6 = n, i__4 = j + kd;
02425 i__5 = min(i__6,i__4);
02426 for (i__ = j; i__ <= i__5; ++i__) {
02427 i__6 = i__ + 1 - j + j * v_dim1;
02428 i__4 = i__ + j * a_dim1;
02429 v[i__6].r = a[i__4].r, v[i__6].i = a[i__4].i;
02430
02431 }
02432
02433 }
02434 }
02435 chbevx_("N", "V", uplo, &n, &kd, &v[v_offset], ldu, &u[
02436 u_offset], ldu, &vl, &vu, &il, &iu, &abstol, &m3, &
02437 wa3[1], &z__[z_offset], ldu, &work[1], &rwork[1], &
02438 iwork[1], &iwork[n * 5 + 1], &iinfo);
02439 if (iinfo != 0) {
02440 io___83.ciunit = *nounit;
02441 s_wsfe(&io___83);
02442
02443 i__7[0] = 11, a__1[0] = "CHBEVX(N,V,";
02444 i__7[1] = 1, a__1[1] = uplo;
02445 i__7[2] = 1, a__1[2] = ")";
02446 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
02447 do_fio(&c__1, ch__2, (ftnlen)13);
02448 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02449 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02450 do_fio(&c__1, (char *)&kd, (ftnlen)sizeof(integer));
02451 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02452 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02453 ;
02454 e_wsfe();
02455 *info = abs(iinfo);
02456 if (iinfo < 0) {
02457 return 0;
02458 } else {
02459 result[ntest] = ulpinv;
02460 goto L930;
02461 }
02462 }
02463
02464 if (m3 == 0 && n > 0) {
02465 result[ntest] = ulpinv;
02466 goto L930;
02467 }
02468
02469
02470
02471 temp1 = ssxt1_(&c__1, &wa2[1], &m2, &wa3[1], &m3, &abstol, &
02472 ulp, &unfl);
02473 temp2 = ssxt1_(&c__1, &wa3[1], &m3, &wa2[1], &m2, &abstol, &
02474 ulp, &unfl);
02475 if (n > 0) {
02476
02477 r__2 = dabs(wa1[1]), r__3 = (r__1 = wa1[n], dabs(r__1));
02478 temp3 = dmax(r__2,r__3);
02479 } else {
02480 temp3 = 0.f;
02481 }
02482
02483 r__1 = unfl, r__2 = temp3 * ulp;
02484 result[ntest] = (temp1 + temp2) / dmax(r__1,r__2);
02485
02486 L930:
02487
02488
02489
02490 clacpy_(" ", &n, &n, &a[a_offset], lda, &v[v_offset], ldu);
02491
02492 ++ntest;
02493 cheev_("V", uplo, &n, &a[a_offset], ldu, &d1[1], &work[1],
02494 lwork, &rwork[1], &iinfo);
02495 if (iinfo != 0) {
02496 io___84.ciunit = *nounit;
02497 s_wsfe(&io___84);
02498
02499 i__7[0] = 8, a__1[0] = "CHEEV(V,";
02500 i__7[1] = 1, a__1[1] = uplo;
02501 i__7[2] = 1, a__1[2] = ")";
02502 s_cat(ch__3, a__1, i__7, &c__3, (ftnlen)10);
02503 do_fio(&c__1, ch__3, (ftnlen)10);
02504 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02505 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02506 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02507 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02508 ;
02509 e_wsfe();
02510 *info = abs(iinfo);
02511 if (iinfo < 0) {
02512 return 0;
02513 } else {
02514 result[ntest] = ulpinv;
02515 result[ntest + 1] = ulpinv;
02516 result[ntest + 2] = ulpinv;
02517 goto L950;
02518 }
02519 }
02520
02521
02522
02523 chet21_(&c__1, uplo, &n, &c__0, &v[v_offset], ldu, &d1[1], &
02524 d2[1], &a[a_offset], ldu, &z__[z_offset], ldu, &tau[1]
02525 , &work[1], &rwork[1], &result[ntest]);
02526
02527 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
02528
02529 ntest += 2;
02530 cheev_("N", uplo, &n, &a[a_offset], ldu, &d3[1], &work[1],
02531 lwork, &rwork[1], &iinfo);
02532 if (iinfo != 0) {
02533 io___85.ciunit = *nounit;
02534 s_wsfe(&io___85);
02535
02536 i__7[0] = 8, a__1[0] = "CHEEV(N,";
02537 i__7[1] = 1, a__1[1] = uplo;
02538 i__7[2] = 1, a__1[2] = ")";
02539 s_cat(ch__3, a__1, i__7, &c__3, (ftnlen)10);
02540 do_fio(&c__1, ch__3, (ftnlen)10);
02541 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02542 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02543 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02544 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02545 ;
02546 e_wsfe();
02547 *info = abs(iinfo);
02548 if (iinfo < 0) {
02549 return 0;
02550 } else {
02551 result[ntest] = ulpinv;
02552 goto L950;
02553 }
02554 }
02555
02556
02557
02558 temp1 = 0.f;
02559 temp2 = 0.f;
02560 i__3 = n;
02561 for (j = 1; j <= i__3; ++j) {
02562
02563 r__3 = temp1, r__4 = (r__1 = d1[j], dabs(r__1)), r__3 =
02564 max(r__3,r__4), r__4 = (r__2 = d3[j], dabs(r__2));
02565 temp1 = dmax(r__3,r__4);
02566
02567 r__2 = temp2, r__3 = (r__1 = d1[j] - d3[j], dabs(r__1));
02568 temp2 = dmax(r__2,r__3);
02569
02570 }
02571
02572 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
02573 result[ntest] = temp2 / dmax(r__1,r__2);
02574
02575 L950:
02576
02577 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
02578
02579
02580
02581
02582
02583
02584 if (iuplo == 1) {
02585 indx = 1;
02586 i__3 = n;
02587 for (j = 1; j <= i__3; ++j) {
02588 i__5 = j;
02589 for (i__ = 1; i__ <= i__5; ++i__) {
02590 i__6 = indx;
02591 i__4 = i__ + j * a_dim1;
02592 work[i__6].r = a[i__4].r, work[i__6].i = a[i__4]
02593 .i;
02594 ++indx;
02595
02596 }
02597
02598 }
02599 } else {
02600 indx = 1;
02601 i__3 = n;
02602 for (j = 1; j <= i__3; ++j) {
02603 i__5 = n;
02604 for (i__ = j; i__ <= i__5; ++i__) {
02605 i__6 = indx;
02606 i__4 = i__ + j * a_dim1;
02607 work[i__6].r = a[i__4].r, work[i__6].i = a[i__4]
02608 .i;
02609 ++indx;
02610
02611 }
02612
02613 }
02614 }
02615
02616 ++ntest;
02617 indwrk = n * (n + 1) / 2 + 1;
02618 chpev_("V", uplo, &n, &work[1], &d1[1], &z__[z_offset], ldu, &
02619 work[indwrk], &rwork[1], &iinfo)
02620 ;
02621 if (iinfo != 0) {
02622 io___86.ciunit = *nounit;
02623 s_wsfe(&io___86);
02624
02625 i__7[0] = 8, a__1[0] = "CHPEV(V,";
02626 i__7[1] = 1, a__1[1] = uplo;
02627 i__7[2] = 1, a__1[2] = ")";
02628 s_cat(ch__3, a__1, i__7, &c__3, (ftnlen)10);
02629 do_fio(&c__1, ch__3, (ftnlen)10);
02630 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02631 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02632 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02633 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02634 ;
02635 e_wsfe();
02636 *info = abs(iinfo);
02637 if (iinfo < 0) {
02638 return 0;
02639 } else {
02640 result[ntest] = ulpinv;
02641 result[ntest + 1] = ulpinv;
02642 result[ntest + 2] = ulpinv;
02643 goto L1050;
02644 }
02645 }
02646
02647
02648
02649 chet21_(&c__1, uplo, &n, &c__0, &a[a_offset], lda, &d1[1], &
02650 d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &tau[1]
02651 , &work[1], &rwork[1], &result[ntest]);
02652
02653 if (iuplo == 1) {
02654 indx = 1;
02655 i__3 = n;
02656 for (j = 1; j <= i__3; ++j) {
02657 i__5 = j;
02658 for (i__ = 1; i__ <= i__5; ++i__) {
02659 i__6 = indx;
02660 i__4 = i__ + j * a_dim1;
02661 work[i__6].r = a[i__4].r, work[i__6].i = a[i__4]
02662 .i;
02663 ++indx;
02664
02665 }
02666
02667 }
02668 } else {
02669 indx = 1;
02670 i__3 = n;
02671 for (j = 1; j <= i__3; ++j) {
02672 i__5 = n;
02673 for (i__ = j; i__ <= i__5; ++i__) {
02674 i__6 = indx;
02675 i__4 = i__ + j * a_dim1;
02676 work[i__6].r = a[i__4].r, work[i__6].i = a[i__4]
02677 .i;
02678 ++indx;
02679
02680 }
02681
02682 }
02683 }
02684
02685 ntest += 2;
02686 indwrk = n * (n + 1) / 2 + 1;
02687 chpev_("N", uplo, &n, &work[1], &d3[1], &z__[z_offset], ldu, &
02688 work[indwrk], &rwork[1], &iinfo)
02689 ;
02690 if (iinfo != 0) {
02691 io___87.ciunit = *nounit;
02692 s_wsfe(&io___87);
02693
02694 i__7[0] = 8, a__1[0] = "CHPEV(N,";
02695 i__7[1] = 1, a__1[1] = uplo;
02696 i__7[2] = 1, a__1[2] = ")";
02697 s_cat(ch__3, a__1, i__7, &c__3, (ftnlen)10);
02698 do_fio(&c__1, ch__3, (ftnlen)10);
02699 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02700 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02701 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02702 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02703 ;
02704 e_wsfe();
02705 *info = abs(iinfo);
02706 if (iinfo < 0) {
02707 return 0;
02708 } else {
02709 result[ntest] = ulpinv;
02710 goto L1050;
02711 }
02712 }
02713
02714
02715
02716 temp1 = 0.f;
02717 temp2 = 0.f;
02718 i__3 = n;
02719 for (j = 1; j <= i__3; ++j) {
02720
02721 r__3 = temp1, r__4 = (r__1 = d1[j], dabs(r__1)), r__3 =
02722 max(r__3,r__4), r__4 = (r__2 = d3[j], dabs(r__2));
02723 temp1 = dmax(r__3,r__4);
02724
02725 r__2 = temp2, r__3 = (r__1 = d1[j] - d3[j], dabs(r__1));
02726 temp2 = dmax(r__2,r__3);
02727
02728 }
02729
02730 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
02731 result[ntest] = temp2 / dmax(r__1,r__2);
02732
02733 L1050:
02734
02735
02736
02737 if (jtype <= 7) {
02738 kd = 0;
02739 } else if (jtype >= 8 && jtype <= 15) {
02740
02741 i__3 = n - 1;
02742 kd = max(i__3,0);
02743 } else {
02744 kd = ihbw;
02745 }
02746
02747
02748
02749
02750 if (iuplo == 1) {
02751 i__3 = n;
02752 for (j = 1; j <= i__3; ++j) {
02753
02754 i__5 = 1, i__6 = j - kd;
02755 i__4 = j;
02756 for (i__ = max(i__5,i__6); i__ <= i__4; ++i__) {
02757 i__5 = kd + 1 + i__ - j + j * v_dim1;
02758 i__6 = i__ + j * a_dim1;
02759 v[i__5].r = a[i__6].r, v[i__5].i = a[i__6].i;
02760
02761 }
02762
02763 }
02764 } else {
02765 i__3 = n;
02766 for (j = 1; j <= i__3; ++j) {
02767
02768 i__5 = n, i__6 = j + kd;
02769 i__4 = min(i__5,i__6);
02770 for (i__ = j; i__ <= i__4; ++i__) {
02771 i__5 = i__ + 1 - j + j * v_dim1;
02772 i__6 = i__ + j * a_dim1;
02773 v[i__5].r = a[i__6].r, v[i__5].i = a[i__6].i;
02774
02775 }
02776
02777 }
02778 }
02779
02780 ++ntest;
02781 chbev_("V", uplo, &n, &kd, &v[v_offset], ldu, &d1[1], &z__[
02782 z_offset], ldu, &work[1], &rwork[1], &iinfo);
02783 if (iinfo != 0) {
02784 io___88.ciunit = *nounit;
02785 s_wsfe(&io___88);
02786
02787 i__7[0] = 8, a__1[0] = "CHBEV(V,";
02788 i__7[1] = 1, a__1[1] = uplo;
02789 i__7[2] = 1, a__1[2] = ")";
02790 s_cat(ch__3, a__1, i__7, &c__3, (ftnlen)10);
02791 do_fio(&c__1, ch__3, (ftnlen)10);
02792 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02793 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02794 do_fio(&c__1, (char *)&kd, (ftnlen)sizeof(integer));
02795 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02796 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02797 ;
02798 e_wsfe();
02799 *info = abs(iinfo);
02800 if (iinfo < 0) {
02801 return 0;
02802 } else {
02803 result[ntest] = ulpinv;
02804 result[ntest + 1] = ulpinv;
02805 result[ntest + 2] = ulpinv;
02806 goto L1140;
02807 }
02808 }
02809
02810
02811
02812 chet21_(&c__1, uplo, &n, &c__0, &a[a_offset], lda, &d1[1], &
02813 d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &tau[1]
02814 , &work[1], &rwork[1], &result[ntest]);
02815
02816 if (iuplo == 1) {
02817 i__3 = n;
02818 for (j = 1; j <= i__3; ++j) {
02819
02820 i__4 = 1, i__5 = j - kd;
02821 i__6 = j;
02822 for (i__ = max(i__4,i__5); i__ <= i__6; ++i__) {
02823 i__4 = kd + 1 + i__ - j + j * v_dim1;
02824 i__5 = i__ + j * a_dim1;
02825 v[i__4].r = a[i__5].r, v[i__4].i = a[i__5].i;
02826
02827 }
02828
02829 }
02830 } else {
02831 i__3 = n;
02832 for (j = 1; j <= i__3; ++j) {
02833
02834 i__4 = n, i__5 = j + kd;
02835 i__6 = min(i__4,i__5);
02836 for (i__ = j; i__ <= i__6; ++i__) {
02837 i__4 = i__ + 1 - j + j * v_dim1;
02838 i__5 = i__ + j * a_dim1;
02839 v[i__4].r = a[i__5].r, v[i__4].i = a[i__5].i;
02840
02841 }
02842
02843 }
02844 }
02845
02846 ntest += 2;
02847 chbev_("N", uplo, &n, &kd, &v[v_offset], ldu, &d3[1], &z__[
02848 z_offset], ldu, &work[1], &rwork[1], &iinfo);
02849 if (iinfo != 0) {
02850 io___89.ciunit = *nounit;
02851 s_wsfe(&io___89);
02852
02853 i__7[0] = 8, a__1[0] = "CHBEV(N,";
02854 i__7[1] = 1, a__1[1] = uplo;
02855 i__7[2] = 1, a__1[2] = ")";
02856 s_cat(ch__3, a__1, i__7, &c__3, (ftnlen)10);
02857 do_fio(&c__1, ch__3, (ftnlen)10);
02858 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02859 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02860 do_fio(&c__1, (char *)&kd, (ftnlen)sizeof(integer));
02861 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02862 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02863 ;
02864 e_wsfe();
02865 *info = abs(iinfo);
02866 if (iinfo < 0) {
02867 return 0;
02868 } else {
02869 result[ntest] = ulpinv;
02870 goto L1140;
02871 }
02872 }
02873
02874 L1140:
02875
02876
02877
02878 temp1 = 0.f;
02879 temp2 = 0.f;
02880 i__3 = n;
02881 for (j = 1; j <= i__3; ++j) {
02882
02883 r__3 = temp1, r__4 = (r__1 = d1[j], dabs(r__1)), r__3 =
02884 max(r__3,r__4), r__4 = (r__2 = d3[j], dabs(r__2));
02885 temp1 = dmax(r__3,r__4);
02886
02887 r__2 = temp2, r__3 = (r__1 = d1[j] - d3[j], dabs(r__1));
02888 temp2 = dmax(r__2,r__3);
02889
02890 }
02891
02892 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
02893 result[ntest] = temp2 / dmax(r__1,r__2);
02894
02895 clacpy_(" ", &n, &n, &a[a_offset], lda, &v[v_offset], ldu);
02896 ++ntest;
02897 i__3 = *liwork - (n << 1);
02898 cheevr_("V", "A", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il,
02899 &iu, &abstol, &m, &wa1[1], &z__[z_offset], ldu, &
02900 iwork[1], &work[1], lwork, &rwork[1], lrwork, &iwork[(
02901 n << 1) + 1], &i__3, &iinfo);
02902 if (iinfo != 0) {
02903 io___90.ciunit = *nounit;
02904 s_wsfe(&io___90);
02905
02906 i__7[0] = 11, a__1[0] = "CHEEVR(V,A,";
02907 i__7[1] = 1, a__1[1] = uplo;
02908 i__7[2] = 1, a__1[2] = ")";
02909 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
02910 do_fio(&c__1, ch__2, (ftnlen)13);
02911 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02912 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02913 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02914 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02915 ;
02916 e_wsfe();
02917 *info = abs(iinfo);
02918 if (iinfo < 0) {
02919 return 0;
02920 } else {
02921 result[ntest] = ulpinv;
02922 result[ntest + 1] = ulpinv;
02923 result[ntest + 2] = ulpinv;
02924 goto L1170;
02925 }
02926 }
02927
02928
02929
02930 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
02931
02932 chet21_(&c__1, uplo, &n, &c__0, &a[a_offset], ldu, &wa1[1], &
02933 d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &tau[1]
02934 , &work[1], &rwork[1], &result[ntest]);
02935
02936 ntest += 2;
02937 i__3 = *liwork - (n << 1);
02938 cheevr_("N", "A", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il,
02939 &iu, &abstol, &m2, &wa2[1], &z__[z_offset], ldu, &
02940 iwork[1], &work[1], lwork, &rwork[1], lrwork, &iwork[(
02941 n << 1) + 1], &i__3, &iinfo);
02942 if (iinfo != 0) {
02943 io___91.ciunit = *nounit;
02944 s_wsfe(&io___91);
02945
02946 i__7[0] = 11, a__1[0] = "CHEEVR(N,A,";
02947 i__7[1] = 1, a__1[1] = uplo;
02948 i__7[2] = 1, a__1[2] = ")";
02949 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
02950 do_fio(&c__1, ch__2, (ftnlen)13);
02951 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02952 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02953 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02954 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02955 ;
02956 e_wsfe();
02957 *info = abs(iinfo);
02958 if (iinfo < 0) {
02959 return 0;
02960 } else {
02961 result[ntest] = ulpinv;
02962 goto L1170;
02963 }
02964 }
02965
02966
02967
02968 temp1 = 0.f;
02969 temp2 = 0.f;
02970 i__3 = n;
02971 for (j = 1; j <= i__3; ++j) {
02972
02973 r__3 = temp1, r__4 = (r__1 = wa1[j], dabs(r__1)), r__3 =
02974 max(r__3,r__4), r__4 = (r__2 = wa2[j], dabs(r__2))
02975 ;
02976 temp1 = dmax(r__3,r__4);
02977
02978 r__2 = temp2, r__3 = (r__1 = wa1[j] - wa2[j], dabs(r__1));
02979 temp2 = dmax(r__2,r__3);
02980
02981 }
02982
02983 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
02984 result[ntest] = temp2 / dmax(r__1,r__2);
02985
02986 L1170:
02987
02988 ++ntest;
02989 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
02990 i__3 = *liwork - (n << 1);
02991 cheevr_("V", "I", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il,
02992 &iu, &abstol, &m2, &wa2[1], &z__[z_offset], ldu, &
02993 iwork[1], &work[1], lwork, &rwork[1], lrwork, &iwork[(
02994 n << 1) + 1], &i__3, &iinfo);
02995 if (iinfo != 0) {
02996 io___92.ciunit = *nounit;
02997 s_wsfe(&io___92);
02998
02999 i__7[0] = 11, a__1[0] = "CHEEVR(V,I,";
03000 i__7[1] = 1, a__1[1] = uplo;
03001 i__7[2] = 1, a__1[2] = ")";
03002 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
03003 do_fio(&c__1, ch__2, (ftnlen)13);
03004 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
03005 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
03006 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
03007 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
03008 ;
03009 e_wsfe();
03010 *info = abs(iinfo);
03011 if (iinfo < 0) {
03012 return 0;
03013 } else {
03014 result[ntest] = ulpinv;
03015 result[ntest + 1] = ulpinv;
03016 result[ntest + 2] = ulpinv;
03017 goto L1180;
03018 }
03019 }
03020
03021
03022
03023 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
03024
03025 chet22_(&c__1, uplo, &n, &m2, &c__0, &a[a_offset], ldu, &wa2[
03026 1], &d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &
03027 tau[1], &work[1], &rwork[1], &result[ntest]);
03028
03029 ntest += 2;
03030 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
03031 i__3 = *liwork - (n << 1);
03032 cheevr_("N", "I", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il,
03033 &iu, &abstol, &m3, &wa3[1], &z__[z_offset], ldu, &
03034 iwork[1], &work[1], lwork, &rwork[1], lrwork, &iwork[(
03035 n << 1) + 1], &i__3, &iinfo);
03036 if (iinfo != 0) {
03037 io___93.ciunit = *nounit;
03038 s_wsfe(&io___93);
03039
03040 i__7[0] = 11, a__1[0] = "CHEEVR(N,I,";
03041 i__7[1] = 1, a__1[1] = uplo;
03042 i__7[2] = 1, a__1[2] = ")";
03043 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
03044 do_fio(&c__1, ch__2, (ftnlen)13);
03045 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
03046 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
03047 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
03048 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
03049 ;
03050 e_wsfe();
03051 *info = abs(iinfo);
03052 if (iinfo < 0) {
03053 return 0;
03054 } else {
03055 result[ntest] = ulpinv;
03056 goto L1180;
03057 }
03058 }
03059
03060
03061
03062 temp1 = ssxt1_(&c__1, &wa2[1], &m2, &wa3[1], &m3, &abstol, &
03063 ulp, &unfl);
03064 temp2 = ssxt1_(&c__1, &wa3[1], &m3, &wa2[1], &m2, &abstol, &
03065 ulp, &unfl);
03066
03067 r__1 = unfl, r__2 = ulp * temp3;
03068 result[ntest] = (temp1 + temp2) / dmax(r__1,r__2);
03069 L1180:
03070
03071 ++ntest;
03072 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
03073 i__3 = *liwork - (n << 1);
03074 cheevr_("V", "V", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il,
03075 &iu, &abstol, &m2, &wa2[1], &z__[z_offset], ldu, &
03076 iwork[1], &work[1], lwork, &rwork[1], lrwork, &iwork[(
03077 n << 1) + 1], &i__3, &iinfo);
03078 if (iinfo != 0) {
03079 io___94.ciunit = *nounit;
03080 s_wsfe(&io___94);
03081
03082 i__7[0] = 11, a__1[0] = "CHEEVR(V,V,";
03083 i__7[1] = 1, a__1[1] = uplo;
03084 i__7[2] = 1, a__1[2] = ")";
03085 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
03086 do_fio(&c__1, ch__2, (ftnlen)13);
03087 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
03088 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
03089 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
03090 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
03091 ;
03092 e_wsfe();
03093 *info = abs(iinfo);
03094 if (iinfo < 0) {
03095 return 0;
03096 } else {
03097 result[ntest] = ulpinv;
03098 result[ntest + 1] = ulpinv;
03099 result[ntest + 2] = ulpinv;
03100 goto L1190;
03101 }
03102 }
03103
03104
03105
03106 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
03107
03108 chet22_(&c__1, uplo, &n, &m2, &c__0, &a[a_offset], ldu, &wa2[
03109 1], &d2[1], &z__[z_offset], ldu, &v[v_offset], ldu, &
03110 tau[1], &work[1], &rwork[1], &result[ntest]);
03111
03112 ntest += 2;
03113 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
03114 i__3 = *liwork - (n << 1);
03115 cheevr_("N", "V", uplo, &n, &a[a_offset], ldu, &vl, &vu, &il,
03116 &iu, &abstol, &m3, &wa3[1], &z__[z_offset], ldu, &
03117 iwork[1], &work[1], lwork, &rwork[1], lrwork, &iwork[(
03118 n << 1) + 1], &i__3, &iinfo);
03119 if (iinfo != 0) {
03120 io___95.ciunit = *nounit;
03121 s_wsfe(&io___95);
03122
03123 i__7[0] = 11, a__1[0] = "CHEEVR(N,V,";
03124 i__7[1] = 1, a__1[1] = uplo;
03125 i__7[2] = 1, a__1[2] = ")";
03126 s_cat(ch__2, a__1, i__7, &c__3, (ftnlen)13);
03127 do_fio(&c__1, ch__2, (ftnlen)13);
03128 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
03129 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
03130 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
03131 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
03132 ;
03133 e_wsfe();
03134 *info = abs(iinfo);
03135 if (iinfo < 0) {
03136 return 0;
03137 } else {
03138 result[ntest] = ulpinv;
03139 goto L1190;
03140 }
03141 }
03142
03143 if (m3 == 0 && n > 0) {
03144 result[ntest] = ulpinv;
03145 goto L1190;
03146 }
03147
03148
03149
03150 temp1 = ssxt1_(&c__1, &wa2[1], &m2, &wa3[1], &m3, &abstol, &
03151 ulp, &unfl);
03152 temp2 = ssxt1_(&c__1, &wa3[1], &m3, &wa2[1], &m2, &abstol, &
03153 ulp, &unfl);
03154 if (n > 0) {
03155
03156 r__2 = dabs(wa1[1]), r__3 = (r__1 = wa1[n], dabs(r__1));
03157 temp3 = dmax(r__2,r__3);
03158 } else {
03159 temp3 = 0.f;
03160 }
03161
03162 r__1 = unfl, r__2 = temp3 * ulp;
03163 result[ntest] = (temp1 + temp2) / dmax(r__1,r__2);
03164
03165 clacpy_(" ", &n, &n, &v[v_offset], ldu, &a[a_offset], lda);
03166
03167
03168
03169
03170
03171
03172
03173 L1190:
03174
03175
03176 ;
03177 }
03178
03179
03180
03181 ntestt += ntest;
03182 slafts_("CST", &n, &n, &jtype, &ntest, &result[1], ioldsd, thresh,
03183 nounit, &nerrs);
03184
03185 L1210:
03186 ;
03187 }
03188
03189 }
03190
03191
03192
03193 alasvm_("CST", nounit, &nerrs, &ntestt, &c__0);
03194
03195
03196 return 0;
03197
03198
03199
03200 }