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 doublecomplex c_b1 = {0.,0.};
00019 static doublecomplex c_b2 = {1.,0.};
00020 static integer c__0 = 0;
00021 static integer c__6 = 6;
00022 static doublereal c_b33 = 1.;
00023 static integer c__1 = 1;
00024 static doublereal c_b43 = 0.;
00025 static integer c__4 = 4;
00026 static integer c__5 = 5;
00027 static doublereal c_b78 = 10.;
00028 static integer c__3 = 3;
00029
00030 int zdrvsg_(integer *nsizes, integer *nn, integer *ntypes,
00031 logical *dotype, integer *iseed, doublereal *thresh, integer *nounit,
00032 doublecomplex *a, integer *lda, doublecomplex *b, integer *ldb,
00033 doublereal *d__, doublecomplex *z__, integer *ldz, doublecomplex *ab,
00034 doublecomplex *bb, doublecomplex *ap, doublecomplex *bp,
00035 doublecomplex *work, integer *nwork, doublereal *rwork, integer *
00036 lrwork, integer *iwork, integer *liwork, doublereal *result, integer *
00037 info)
00038 {
00039
00040
00041 static integer ktype[21] = { 1,2,4,4,4,4,4,5,5,5,5,5,8,8,8,9,9,9,9,9,9 };
00042 static integer kmagn[21] = { 1,1,1,1,1,2,3,1,1,1,2,3,1,2,3,1,1,1,1,1,1 };
00043 static integer kmode[21] = { 0,0,4,3,1,4,4,4,3,1,4,4,0,0,0,4,4,4,4,4,4 };
00044
00045
00046 static char fmt_9999[] = "(\002 ZDRVSG: \002,a,\002 returned INFO=\002,i"
00047 "6,\002.\002,/9x,\002N=\002,i6,\002, JTYPE=\002,i6,\002, ISEED="
00048 "(\002,3(i5,\002,\002),i5,\002)\002)";
00049
00050
00051 address a__1[3];
00052 integer a_dim1, a_offset, ab_dim1, ab_offset, b_dim1, b_offset, bb_dim1,
00053 bb_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4, i__5, i__6[3]
00054 , i__7;
00055 char ch__1[10], ch__2[11], ch__3[12], ch__4[13];
00056
00057
00058 double sqrt(doublereal);
00059 integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
00060 int s_cat(char *, char **, integer *, integer *, ftnlen);
00061
00062
00063 integer i__, j, m, n, ka, kb, ij, il, iu;
00064 doublereal vl, vu;
00065 integer ka9, kb9;
00066 doublereal ulp, cond;
00067 integer jcol, nmax;
00068 doublereal unfl, ovfl;
00069 char uplo[1];
00070 logical badnn;
00071 integer imode;
00072 extern logical lsame_(char *, char *);
00073 integer iinfo;
00074 doublereal aninv, anorm;
00075 integer itemp;
00076 extern int zhbgv_(char *, char *, integer *, integer *,
00077 integer *, doublecomplex *, integer *, doublecomplex *, integer *,
00078 doublereal *, doublecomplex *, integer *, doublecomplex *,
00079 doublereal *, integer *);
00080 integer nmats, jsize;
00081 extern int zhegv_(integer *, char *, char *, integer *,
00082 doublecomplex *, integer *, doublecomplex *, integer *,
00083 doublereal *, doublecomplex *, integer *, doublereal *, integer *), zsgt01_(integer *, char *, integer *, integer *,
00084 doublecomplex *, integer *, doublecomplex *, integer *,
00085 doublecomplex *, integer *, doublereal *, doublecomplex *,
00086 doublereal *, doublereal *);
00087 integer nerrs, itype, jtype, ntest;
00088 extern int zhpgv_(integer *, char *, char *, integer *,
00089 doublecomplex *, doublecomplex *, doublereal *, doublecomplex *,
00090 integer *, doublecomplex *, doublereal *, integer *);
00091 integer iseed2[4];
00092 extern int dlabad_(doublereal *, doublereal *);
00093 extern doublereal dlamch_(char *), dlarnd_(integer *, integer *);
00094 integer idumma[1];
00095 extern int dlafts_(char *, integer *, integer *, integer
00096 *, integer *, doublereal *, integer *, doublereal *, integer *,
00097 integer *);
00098 integer ioldsd[4];
00099 extern int xerbla_(char *, integer *);
00100 doublereal abstol;
00101 extern int dlasum_(char *, integer *, integer *, integer
00102 *), zhbgvd_(char *, char *, integer *, integer *, integer
00103 *, doublecomplex *, integer *, doublecomplex *, integer *,
00104 doublereal *, doublecomplex *, integer *, doublecomplex *,
00105 integer *, doublereal *, integer *, integer *, integer *, integer
00106 *), zhegvd_(integer *, char *, char *, integer *,
00107 doublecomplex *, integer *, doublecomplex *, integer *,
00108 doublereal *, doublecomplex *, integer *, doublereal *, integer *,
00109 integer *, integer *, integer *);
00110 integer ibuplo, ibtype;
00111 extern int zhpgvd_(integer *, char *, char *, integer *,
00112 doublecomplex *, doublecomplex *, doublereal *, doublecomplex *,
00113 integer *, doublecomplex *, integer *, doublereal *, integer *,
00114 integer *, integer *, integer *), zlacpy_(char *,
00115 integer *, integer *, doublecomplex *, integer *, doublecomplex *,
00116 integer *), zlaset_(char *, integer *, integer *,
00117 doublecomplex *, doublecomplex *, doublecomplex *, integer *), zhbgvx_(char *, char *, char *, integer *, integer *,
00118 integer *, doublecomplex *, integer *, doublecomplex *, integer *,
00119 doublecomplex *, integer *, doublereal *, doublereal *, integer *
00120 , integer *, doublereal *, integer *, doublereal *, doublecomplex
00121 *, integer *, doublecomplex *, doublereal *, integer *, integer *,
00122 integer *), zlatmr_(integer *, integer *,
00123 char *, integer *, char *, doublecomplex *, integer *,
00124 doublereal *, doublecomplex *, char *, char *, doublecomplex *,
00125 integer *, doublereal *, doublecomplex *, integer *, doublereal *,
00126 char *, integer *, integer *, integer *, doublereal *,
00127 doublereal *, char *, doublecomplex *, integer *, integer *,
00128 integer *);
00129 doublereal rtunfl, rtovfl;
00130 integer mtypes, ntestt;
00131 doublereal ulpinv;
00132 extern int zhegvx_(integer *, char *, char *, char *,
00133 integer *, doublecomplex *, integer *, doublecomplex *, integer *,
00134 doublereal *, doublereal *, integer *, integer *, doublereal *,
00135 integer *, doublereal *, doublecomplex *, integer *,
00136 doublecomplex *, integer *, doublereal *, integer *, integer *,
00137 integer *), zhpgvx_(integer *, char *,
00138 char *, char *, integer *, doublecomplex *, doublecomplex *,
00139 doublereal *, doublereal *, integer *, integer *, doublereal *,
00140 integer *, doublereal *, doublecomplex *, integer *,
00141 doublecomplex *, doublereal *, integer *, integer *, integer *), zlatms_(integer *, integer *, char *,
00142 integer *, char *, doublereal *, integer *, doublereal *,
00143 doublereal *, integer *, integer *, char *, doublecomplex *,
00144 integer *, doublecomplex *, integer *);
00145
00146
00147 static cilist io___36 = { 0, 0, 0, fmt_9999, 0 };
00148 static cilist io___44 = { 0, 0, 0, fmt_9999, 0 };
00149 static cilist io___45 = { 0, 0, 0, fmt_9999, 0 };
00150 static cilist io___49 = { 0, 0, 0, fmt_9999, 0 };
00151 static cilist io___50 = { 0, 0, 0, fmt_9999, 0 };
00152 static cilist io___51 = { 0, 0, 0, fmt_9999, 0 };
00153 static cilist io___53 = { 0, 0, 0, fmt_9999, 0 };
00154 static cilist io___54 = { 0, 0, 0, fmt_9999, 0 };
00155 static cilist io___55 = { 0, 0, 0, fmt_9999, 0 };
00156 static cilist io___56 = { 0, 0, 0, fmt_9999, 0 };
00157 static cilist io___57 = { 0, 0, 0, fmt_9999, 0 };
00158 static cilist io___58 = { 0, 0, 0, fmt_9999, 0 };
00159 static cilist io___59 = { 0, 0, 0, fmt_9999, 0 };
00160 static cilist io___60 = { 0, 0, 0, fmt_9999, 0 };
00161 static cilist io___61 = { 0, 0, 0, fmt_9999, 0 };
00162 static cilist io___62 = { 0, 0, 0, fmt_9999, 0 };
00163
00164
00165
00166
00167
00168
00169
00170
00171
00172
00173
00174
00175
00176
00177
00178
00179
00180
00181
00182
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
00500
00501
00502
00503
00504
00505
00506
00507
00508
00509
00510
00511
00512
00513
00514
00515
00516
00517
00518
00519 --nn;
00520 --dotype;
00521 --iseed;
00522 ab_dim1 = *lda;
00523 ab_offset = 1 + ab_dim1;
00524 ab -= ab_offset;
00525 a_dim1 = *lda;
00526 a_offset = 1 + a_dim1;
00527 a -= a_offset;
00528 bb_dim1 = *ldb;
00529 bb_offset = 1 + bb_dim1;
00530 bb -= bb_offset;
00531 b_dim1 = *ldb;
00532 b_offset = 1 + b_dim1;
00533 b -= b_offset;
00534 --d__;
00535 z_dim1 = *ldz;
00536 z_offset = 1 + z_dim1;
00537 z__ -= z_offset;
00538 --ap;
00539 --bp;
00540 --work;
00541 --rwork;
00542 --iwork;
00543 --result;
00544
00545
00546
00547
00548
00549
00550
00551 ntestt = 0;
00552 *info = 0;
00553
00554 badnn = FALSE_;
00555 nmax = 0;
00556 i__1 = *nsizes;
00557 for (j = 1; j <= i__1; ++j) {
00558
00559 i__2 = nmax, i__3 = nn[j];
00560 nmax = max(i__2,i__3);
00561 if (nn[j] < 0) {
00562 badnn = TRUE_;
00563 }
00564
00565 }
00566
00567
00568
00569 if (*nsizes < 0) {
00570 *info = -1;
00571 } else if (badnn) {
00572 *info = -2;
00573 } else if (*ntypes < 0) {
00574 *info = -3;
00575 } else if (*lda <= 1 || *lda < nmax) {
00576 *info = -9;
00577 } else if (*ldz <= 1 || *ldz < nmax) {
00578 *info = -16;
00579 } else {
00580
00581 i__1 = max(nmax,2);
00582 if (i__1 * i__1 << 1 > *nwork) {
00583 *info = -21;
00584 } else {
00585
00586 i__1 = max(nmax,2);
00587 if (i__1 * i__1 << 1 > *lrwork) {
00588 *info = -23;
00589 } else {
00590
00591 i__1 = max(nmax,2);
00592 if (i__1 * i__1 << 1 > *liwork) {
00593 *info = -25;
00594 }
00595 }
00596 }
00597 }
00598
00599 if (*info != 0) {
00600 i__1 = -(*info);
00601 xerbla_("ZDRVSG", &i__1);
00602 return 0;
00603 }
00604
00605
00606
00607 if (*nsizes == 0 || *ntypes == 0) {
00608 return 0;
00609 }
00610
00611
00612
00613 unfl = dlamch_("Safe minimum");
00614 ovfl = dlamch_("Overflow");
00615 dlabad_(&unfl, &ovfl);
00616 ulp = dlamch_("Epsilon") * dlamch_("Base");
00617 ulpinv = 1. / ulp;
00618 rtunfl = sqrt(unfl);
00619 rtovfl = sqrt(ovfl);
00620
00621 for (i__ = 1; i__ <= 4; ++i__) {
00622 iseed2[i__ - 1] = iseed[i__];
00623
00624 }
00625
00626
00627
00628 nerrs = 0;
00629 nmats = 0;
00630
00631 i__1 = *nsizes;
00632 for (jsize = 1; jsize <= i__1; ++jsize) {
00633 n = nn[jsize];
00634 aninv = 1. / (doublereal) max(1,n);
00635
00636 if (*nsizes != 1) {
00637 mtypes = min(21,*ntypes);
00638 } else {
00639 mtypes = min(22,*ntypes);
00640 }
00641
00642 ka9 = 0;
00643 kb9 = 0;
00644 i__2 = mtypes;
00645 for (jtype = 1; jtype <= i__2; ++jtype) {
00646 if (! dotype[jtype]) {
00647 goto L640;
00648 }
00649 ++nmats;
00650 ntest = 0;
00651
00652 for (j = 1; j <= 4; ++j) {
00653 ioldsd[j - 1] = iseed[j];
00654
00655 }
00656
00657
00658
00659
00660
00661
00662
00663
00664
00665
00666
00667
00668
00669
00670
00671
00672 if (mtypes > 21) {
00673 goto L90;
00674 }
00675
00676 itype = ktype[jtype - 1];
00677 imode = kmode[jtype - 1];
00678
00679
00680
00681 switch (kmagn[jtype - 1]) {
00682 case 1: goto L40;
00683 case 2: goto L50;
00684 case 3: goto L60;
00685 }
00686
00687 L40:
00688 anorm = 1.;
00689 goto L70;
00690
00691 L50:
00692 anorm = rtovfl * ulp * aninv;
00693 goto L70;
00694
00695 L60:
00696 anorm = rtunfl * n * ulpinv;
00697 goto L70;
00698
00699 L70:
00700
00701 iinfo = 0;
00702 cond = ulpinv;
00703
00704
00705
00706 if (itype == 1) {
00707
00708
00709
00710 ka = 0;
00711 kb = 0;
00712 zlaset_("Full", lda, &n, &c_b1, &c_b1, &a[a_offset], lda);
00713
00714 } else if (itype == 2) {
00715
00716
00717
00718 ka = 0;
00719 kb = 0;
00720 zlaset_("Full", lda, &n, &c_b1, &c_b1, &a[a_offset], lda);
00721 i__3 = n;
00722 for (jcol = 1; jcol <= i__3; ++jcol) {
00723 i__4 = jcol + jcol * a_dim1;
00724 a[i__4].r = anorm, a[i__4].i = 0.;
00725
00726 }
00727
00728 } else if (itype == 4) {
00729
00730
00731
00732 ka = 0;
00733 kb = 0;
00734 zlatms_(&n, &n, "S", &iseed[1], "H", &rwork[1], &imode, &cond,
00735 &anorm, &c__0, &c__0, "N", &a[a_offset], lda, &work[
00736 1], &iinfo);
00737
00738 } else if (itype == 5) {
00739
00740
00741
00742
00743 i__3 = 0, i__4 = n - 1;
00744 ka = max(i__3,i__4);
00745 kb = ka;
00746 zlatms_(&n, &n, "S", &iseed[1], "H", &rwork[1], &imode, &cond,
00747 &anorm, &n, &n, "N", &a[a_offset], lda, &work[1], &
00748 iinfo);
00749
00750 } else if (itype == 7) {
00751
00752
00753
00754 ka = 0;
00755 kb = 0;
00756 zlatmr_(&n, &n, "S", &iseed[1], "H", &work[1], &c__6, &c_b33,
00757 &c_b2, "T", "N", &work[n + 1], &c__1, &c_b33, &work[(
00758 n << 1) + 1], &c__1, &c_b33, "N", idumma, &c__0, &
00759 c__0, &c_b43, &anorm, "NO", &a[a_offset], lda, &iwork[
00760 1], &iinfo);
00761
00762 } else if (itype == 8) {
00763
00764
00765
00766
00767 i__3 = 0, i__4 = n - 1;
00768 ka = max(i__3,i__4);
00769 kb = ka;
00770 zlatmr_(&n, &n, "S", &iseed[1], "H", &work[1], &c__6, &c_b33,
00771 &c_b2, "T", "N", &work[n + 1], &c__1, &c_b33, &work[(
00772 n << 1) + 1], &c__1, &c_b33, "N", idumma, &n, &n, &
00773 c_b43, &anorm, "NO", &a[a_offset], lda, &iwork[1], &
00774 iinfo);
00775
00776 } else if (itype == 9) {
00777
00778
00779
00780
00781
00782
00783
00784
00785
00786
00787
00788
00789 ++kb9;
00790 if (kb9 > ka9) {
00791 ++ka9;
00792 kb9 = 1;
00793 }
00794
00795
00796 i__5 = n - 1;
00797 i__3 = 0, i__4 = min(i__5,ka9);
00798 ka = max(i__3,i__4);
00799
00800
00801 i__5 = n - 1;
00802 i__3 = 0, i__4 = min(i__5,kb9);
00803 kb = max(i__3,i__4);
00804 zlatms_(&n, &n, "S", &iseed[1], "H", &rwork[1], &imode, &cond,
00805 &anorm, &ka, &ka, "N", &a[a_offset], lda, &work[1], &
00806 iinfo);
00807
00808 } else {
00809
00810 iinfo = 1;
00811 }
00812
00813 if (iinfo != 0) {
00814 io___36.ciunit = *nounit;
00815 s_wsfe(&io___36);
00816 do_fio(&c__1, "Generator", (ftnlen)9);
00817 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00818 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00819 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00820 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
00821 e_wsfe();
00822 *info = abs(iinfo);
00823 return 0;
00824 }
00825
00826 L90:
00827
00828 abstol = unfl + unfl;
00829 if (n <= 1) {
00830 il = 1;
00831 iu = n;
00832 } else {
00833 il = (integer) ((n - 1) * dlarnd_(&c__1, iseed2) + 1);
00834 iu = (integer) ((n - 1) * dlarnd_(&c__1, iseed2) + 1);
00835 if (il > iu) {
00836 itemp = il;
00837 il = iu;
00838 iu = itemp;
00839 }
00840 }
00841
00842
00843
00844
00845
00846
00847
00848
00849
00850 for (ibtype = 1; ibtype <= 3; ++ibtype) {
00851
00852
00853
00854 for (ibuplo = 1; ibuplo <= 2; ++ibuplo) {
00855 if (ibuplo == 1) {
00856 *(unsigned char *)uplo = 'U';
00857 }
00858 if (ibuplo == 2) {
00859 *(unsigned char *)uplo = 'L';
00860 }
00861
00862
00863
00864
00865 zlatms_(&n, &n, "U", &iseed[1], "P", &rwork[1], &c__5, &
00866 c_b78, &c_b33, &kb, &kb, uplo, &b[b_offset], ldb,
00867 &work[n + 1], &iinfo);
00868
00869
00870
00871 ++ntest;
00872
00873 zlacpy_(" ", &n, &n, &a[a_offset], lda, &z__[z_offset],
00874 ldz);
00875 zlacpy_(uplo, &n, &n, &b[b_offset], ldb, &bb[bb_offset],
00876 ldb);
00877
00878 zhegv_(&ibtype, "V", uplo, &n, &z__[z_offset], ldz, &bb[
00879 bb_offset], ldb, &d__[1], &work[1], nwork, &rwork[
00880 1], &iinfo);
00881 if (iinfo != 0) {
00882 io___44.ciunit = *nounit;
00883 s_wsfe(&io___44);
00884
00885 i__6[0] = 8, a__1[0] = "ZHEGV(V,";
00886 i__6[1] = 1, a__1[1] = uplo;
00887 i__6[2] = 1, a__1[2] = ")";
00888 s_cat(ch__1, a__1, i__6, &c__3, (ftnlen)10);
00889 do_fio(&c__1, ch__1, (ftnlen)10);
00890 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
00891 ;
00892 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00893 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
00894 ;
00895 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
00896 integer));
00897 e_wsfe();
00898 *info = abs(iinfo);
00899 if (iinfo < 0) {
00900 return 0;
00901 } else {
00902 result[ntest] = ulpinv;
00903 goto L100;
00904 }
00905 }
00906
00907
00908
00909 zsgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
00910 b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
00911 work[1], &rwork[1], &result[ntest]);
00912
00913
00914
00915 ++ntest;
00916
00917 zlacpy_(" ", &n, &n, &a[a_offset], lda, &z__[z_offset],
00918 ldz);
00919 zlacpy_(uplo, &n, &n, &b[b_offset], ldb, &bb[bb_offset],
00920 ldb);
00921
00922 zhegvd_(&ibtype, "V", uplo, &n, &z__[z_offset], ldz, &bb[
00923 bb_offset], ldb, &d__[1], &work[1], nwork, &rwork[
00924 1], lrwork, &iwork[1], liwork, &iinfo);
00925 if (iinfo != 0) {
00926 io___45.ciunit = *nounit;
00927 s_wsfe(&io___45);
00928
00929 i__6[0] = 9, a__1[0] = "ZHEGVD(V,";
00930 i__6[1] = 1, a__1[1] = uplo;
00931 i__6[2] = 1, a__1[2] = ")";
00932 s_cat(ch__2, a__1, i__6, &c__3, (ftnlen)11);
00933 do_fio(&c__1, ch__2, (ftnlen)11);
00934 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
00935 ;
00936 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00937 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
00938 ;
00939 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
00940 integer));
00941 e_wsfe();
00942 *info = abs(iinfo);
00943 if (iinfo < 0) {
00944 return 0;
00945 } else {
00946 result[ntest] = ulpinv;
00947 goto L100;
00948 }
00949 }
00950
00951
00952
00953 zsgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
00954 b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
00955 work[1], &rwork[1], &result[ntest]);
00956
00957
00958
00959 ++ntest;
00960
00961 zlacpy_(" ", &n, &n, &a[a_offset], lda, &ab[ab_offset],
00962 lda);
00963 zlacpy_(uplo, &n, &n, &b[b_offset], ldb, &bb[bb_offset],
00964 ldb);
00965
00966 zhegvx_(&ibtype, "V", "A", uplo, &n, &ab[ab_offset], lda,
00967 &bb[bb_offset], ldb, &vl, &vu, &il, &iu, &abstol,
00968 &m, &d__[1], &z__[z_offset], ldz, &work[1], nwork,
00969 &rwork[1], &iwork[n + 1], &iwork[1], &iinfo);
00970 if (iinfo != 0) {
00971 io___49.ciunit = *nounit;
00972 s_wsfe(&io___49);
00973
00974 i__6[0] = 10, a__1[0] = "ZHEGVX(V,A";
00975 i__6[1] = 1, a__1[1] = uplo;
00976 i__6[2] = 1, a__1[2] = ")";
00977 s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
00978 do_fio(&c__1, ch__3, (ftnlen)12);
00979 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
00980 ;
00981 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00982 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
00983 ;
00984 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
00985 integer));
00986 e_wsfe();
00987 *info = abs(iinfo);
00988 if (iinfo < 0) {
00989 return 0;
00990 } else {
00991 result[ntest] = ulpinv;
00992 goto L100;
00993 }
00994 }
00995
00996
00997
00998 zsgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
00999 b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01000 work[1], &rwork[1], &result[ntest]);
01001
01002 ++ntest;
01003
01004 zlacpy_(" ", &n, &n, &a[a_offset], lda, &ab[ab_offset],
01005 lda);
01006 zlacpy_(uplo, &n, &n, &b[b_offset], ldb, &bb[bb_offset],
01007 ldb);
01008
01009
01010
01011
01012
01013
01014 vl = 0.;
01015 vu = anorm;
01016 zhegvx_(&ibtype, "V", "V", uplo, &n, &ab[ab_offset], lda,
01017 &bb[bb_offset], ldb, &vl, &vu, &il, &iu, &abstol,
01018 &m, &d__[1], &z__[z_offset], ldz, &work[1], nwork,
01019 &rwork[1], &iwork[n + 1], &iwork[1], &iinfo);
01020 if (iinfo != 0) {
01021 io___50.ciunit = *nounit;
01022 s_wsfe(&io___50);
01023
01024 i__6[0] = 11, a__1[0] = "ZHEGVX(V,V,";
01025 i__6[1] = 1, a__1[1] = uplo;
01026 i__6[2] = 1, a__1[2] = ")";
01027 s_cat(ch__4, a__1, i__6, &c__3, (ftnlen)13);
01028 do_fio(&c__1, ch__4, (ftnlen)13);
01029 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01030 ;
01031 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01032 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01033 ;
01034 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01035 integer));
01036 e_wsfe();
01037 *info = abs(iinfo);
01038 if (iinfo < 0) {
01039 return 0;
01040 } else {
01041 result[ntest] = ulpinv;
01042 goto L100;
01043 }
01044 }
01045
01046
01047
01048 zsgt01_(&ibtype, uplo, &n, &m, &a[a_offset], lda, &b[
01049 b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01050 work[1], &rwork[1], &result[ntest]);
01051
01052 ++ntest;
01053
01054 zlacpy_(" ", &n, &n, &a[a_offset], lda, &ab[ab_offset],
01055 lda);
01056 zlacpy_(uplo, &n, &n, &b[b_offset], ldb, &bb[bb_offset],
01057 ldb);
01058
01059 zhegvx_(&ibtype, "V", "I", uplo, &n, &ab[ab_offset], lda,
01060 &bb[bb_offset], ldb, &vl, &vu, &il, &iu, &abstol,
01061 &m, &d__[1], &z__[z_offset], ldz, &work[1], nwork,
01062 &rwork[1], &iwork[n + 1], &iwork[1], &iinfo);
01063 if (iinfo != 0) {
01064 io___51.ciunit = *nounit;
01065 s_wsfe(&io___51);
01066
01067 i__6[0] = 11, a__1[0] = "ZHEGVX(V,I,";
01068 i__6[1] = 1, a__1[1] = uplo;
01069 i__6[2] = 1, a__1[2] = ")";
01070 s_cat(ch__4, a__1, i__6, &c__3, (ftnlen)13);
01071 do_fio(&c__1, ch__4, (ftnlen)13);
01072 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01073 ;
01074 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01075 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01076 ;
01077 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01078 integer));
01079 e_wsfe();
01080 *info = abs(iinfo);
01081 if (iinfo < 0) {
01082 return 0;
01083 } else {
01084 result[ntest] = ulpinv;
01085 goto L100;
01086 }
01087 }
01088
01089
01090
01091 zsgt01_(&ibtype, uplo, &n, &m, &a[a_offset], lda, &b[
01092 b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01093 work[1], &rwork[1], &result[ntest]);
01094
01095 L100:
01096
01097
01098
01099 ++ntest;
01100
01101
01102
01103 if (lsame_(uplo, "U")) {
01104 ij = 1;
01105 i__3 = n;
01106 for (j = 1; j <= i__3; ++j) {
01107 i__4 = j;
01108 for (i__ = 1; i__ <= i__4; ++i__) {
01109 i__5 = ij;
01110 i__7 = i__ + j * a_dim1;
01111 ap[i__5].r = a[i__7].r, ap[i__5].i = a[i__7]
01112 .i;
01113 i__5 = ij;
01114 i__7 = i__ + j * b_dim1;
01115 bp[i__5].r = b[i__7].r, bp[i__5].i = b[i__7]
01116 .i;
01117 ++ij;
01118
01119 }
01120
01121 }
01122 } else {
01123 ij = 1;
01124 i__3 = n;
01125 for (j = 1; j <= i__3; ++j) {
01126 i__4 = n;
01127 for (i__ = j; i__ <= i__4; ++i__) {
01128 i__5 = ij;
01129 i__7 = i__ + j * a_dim1;
01130 ap[i__5].r = a[i__7].r, ap[i__5].i = a[i__7]
01131 .i;
01132 i__5 = ij;
01133 i__7 = i__ + j * b_dim1;
01134 bp[i__5].r = b[i__7].r, bp[i__5].i = b[i__7]
01135 .i;
01136 ++ij;
01137
01138 }
01139
01140 }
01141 }
01142
01143 zhpgv_(&ibtype, "V", uplo, &n, &ap[1], &bp[1], &d__[1], &
01144 z__[z_offset], ldz, &work[1], &rwork[1], &iinfo);
01145 if (iinfo != 0) {
01146 io___53.ciunit = *nounit;
01147 s_wsfe(&io___53);
01148
01149 i__6[0] = 8, a__1[0] = "ZHPGV(V,";
01150 i__6[1] = 1, a__1[1] = uplo;
01151 i__6[2] = 1, a__1[2] = ")";
01152 s_cat(ch__1, a__1, i__6, &c__3, (ftnlen)10);
01153 do_fio(&c__1, ch__1, (ftnlen)10);
01154 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01155 ;
01156 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01157 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01158 ;
01159 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01160 integer));
01161 e_wsfe();
01162 *info = abs(iinfo);
01163 if (iinfo < 0) {
01164 return 0;
01165 } else {
01166 result[ntest] = ulpinv;
01167 goto L310;
01168 }
01169 }
01170
01171
01172
01173 zsgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
01174 b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01175 work[1], &rwork[1], &result[ntest]);
01176
01177
01178
01179 ++ntest;
01180
01181
01182
01183 if (lsame_(uplo, "U")) {
01184 ij = 1;
01185 i__3 = n;
01186 for (j = 1; j <= i__3; ++j) {
01187 i__4 = j;
01188 for (i__ = 1; i__ <= i__4; ++i__) {
01189 i__5 = ij;
01190 i__7 = i__ + j * a_dim1;
01191 ap[i__5].r = a[i__7].r, ap[i__5].i = a[i__7]
01192 .i;
01193 i__5 = ij;
01194 i__7 = i__ + j * b_dim1;
01195 bp[i__5].r = b[i__7].r, bp[i__5].i = b[i__7]
01196 .i;
01197 ++ij;
01198
01199 }
01200
01201 }
01202 } else {
01203 ij = 1;
01204 i__3 = n;
01205 for (j = 1; j <= i__3; ++j) {
01206 i__4 = n;
01207 for (i__ = j; i__ <= i__4; ++i__) {
01208 i__5 = ij;
01209 i__7 = i__ + j * a_dim1;
01210 ap[i__5].r = a[i__7].r, ap[i__5].i = a[i__7]
01211 .i;
01212 i__5 = ij;
01213 i__7 = i__ + j * b_dim1;
01214 bp[i__5].r = b[i__7].r, bp[i__5].i = b[i__7]
01215 .i;
01216 ++ij;
01217
01218 }
01219
01220 }
01221 }
01222
01223 zhpgvd_(&ibtype, "V", uplo, &n, &ap[1], &bp[1], &d__[1], &
01224 z__[z_offset], ldz, &work[1], nwork, &rwork[1],
01225 lrwork, &iwork[1], liwork, &iinfo);
01226 if (iinfo != 0) {
01227 io___54.ciunit = *nounit;
01228 s_wsfe(&io___54);
01229
01230 i__6[0] = 9, a__1[0] = "ZHPGVD(V,";
01231 i__6[1] = 1, a__1[1] = uplo;
01232 i__6[2] = 1, a__1[2] = ")";
01233 s_cat(ch__2, a__1, i__6, &c__3, (ftnlen)11);
01234 do_fio(&c__1, ch__2, (ftnlen)11);
01235 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01236 ;
01237 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01238 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01239 ;
01240 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01241 integer));
01242 e_wsfe();
01243 *info = abs(iinfo);
01244 if (iinfo < 0) {
01245 return 0;
01246 } else {
01247 result[ntest] = ulpinv;
01248 goto L310;
01249 }
01250 }
01251
01252
01253
01254 zsgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
01255 b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01256 work[1], &rwork[1], &result[ntest]);
01257
01258
01259
01260 ++ntest;
01261
01262
01263
01264 if (lsame_(uplo, "U")) {
01265 ij = 1;
01266 i__3 = n;
01267 for (j = 1; j <= i__3; ++j) {
01268 i__4 = j;
01269 for (i__ = 1; i__ <= i__4; ++i__) {
01270 i__5 = ij;
01271 i__7 = i__ + j * a_dim1;
01272 ap[i__5].r = a[i__7].r, ap[i__5].i = a[i__7]
01273 .i;
01274 i__5 = ij;
01275 i__7 = i__ + j * b_dim1;
01276 bp[i__5].r = b[i__7].r, bp[i__5].i = b[i__7]
01277 .i;
01278 ++ij;
01279
01280 }
01281
01282 }
01283 } else {
01284 ij = 1;
01285 i__3 = n;
01286 for (j = 1; j <= i__3; ++j) {
01287 i__4 = n;
01288 for (i__ = j; i__ <= i__4; ++i__) {
01289 i__5 = ij;
01290 i__7 = i__ + j * a_dim1;
01291 ap[i__5].r = a[i__7].r, ap[i__5].i = a[i__7]
01292 .i;
01293 i__5 = ij;
01294 i__7 = i__ + j * b_dim1;
01295 bp[i__5].r = b[i__7].r, bp[i__5].i = b[i__7]
01296 .i;
01297 ++ij;
01298
01299 }
01300
01301 }
01302 }
01303
01304 zhpgvx_(&ibtype, "V", "A", uplo, &n, &ap[1], &bp[1], &vl,
01305 &vu, &il, &iu, &abstol, &m, &d__[1], &z__[
01306 z_offset], ldz, &work[1], &rwork[1], &iwork[n + 1]
01307 , &iwork[1], info);
01308 if (iinfo != 0) {
01309 io___55.ciunit = *nounit;
01310 s_wsfe(&io___55);
01311
01312 i__6[0] = 10, a__1[0] = "ZHPGVX(V,A";
01313 i__6[1] = 1, a__1[1] = uplo;
01314 i__6[2] = 1, a__1[2] = ")";
01315 s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
01316 do_fio(&c__1, ch__3, (ftnlen)12);
01317 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01318 ;
01319 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01320 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01321 ;
01322 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01323 integer));
01324 e_wsfe();
01325 *info = abs(iinfo);
01326 if (iinfo < 0) {
01327 return 0;
01328 } else {
01329 result[ntest] = ulpinv;
01330 goto L310;
01331 }
01332 }
01333
01334
01335
01336 zsgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
01337 b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01338 work[1], &rwork[1], &result[ntest]);
01339
01340 ++ntest;
01341
01342
01343
01344 if (lsame_(uplo, "U")) {
01345 ij = 1;
01346 i__3 = n;
01347 for (j = 1; j <= i__3; ++j) {
01348 i__4 = j;
01349 for (i__ = 1; i__ <= i__4; ++i__) {
01350 i__5 = ij;
01351 i__7 = i__ + j * a_dim1;
01352 ap[i__5].r = a[i__7].r, ap[i__5].i = a[i__7]
01353 .i;
01354 i__5 = ij;
01355 i__7 = i__ + j * b_dim1;
01356 bp[i__5].r = b[i__7].r, bp[i__5].i = b[i__7]
01357 .i;
01358 ++ij;
01359
01360 }
01361
01362 }
01363 } else {
01364 ij = 1;
01365 i__3 = n;
01366 for (j = 1; j <= i__3; ++j) {
01367 i__4 = n;
01368 for (i__ = j; i__ <= i__4; ++i__) {
01369 i__5 = ij;
01370 i__7 = i__ + j * a_dim1;
01371 ap[i__5].r = a[i__7].r, ap[i__5].i = a[i__7]
01372 .i;
01373 i__5 = ij;
01374 i__7 = i__ + j * b_dim1;
01375 bp[i__5].r = b[i__7].r, bp[i__5].i = b[i__7]
01376 .i;
01377 ++ij;
01378
01379 }
01380
01381 }
01382 }
01383
01384 vl = 0.;
01385 vu = anorm;
01386 zhpgvx_(&ibtype, "V", "V", uplo, &n, &ap[1], &bp[1], &vl,
01387 &vu, &il, &iu, &abstol, &m, &d__[1], &z__[
01388 z_offset], ldz, &work[1], &rwork[1], &iwork[n + 1]
01389 , &iwork[1], info);
01390 if (iinfo != 0) {
01391 io___56.ciunit = *nounit;
01392 s_wsfe(&io___56);
01393
01394 i__6[0] = 10, a__1[0] = "ZHPGVX(V,V";
01395 i__6[1] = 1, a__1[1] = uplo;
01396 i__6[2] = 1, a__1[2] = ")";
01397 s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
01398 do_fio(&c__1, ch__3, (ftnlen)12);
01399 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01400 ;
01401 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01402 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01403 ;
01404 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01405 integer));
01406 e_wsfe();
01407 *info = abs(iinfo);
01408 if (iinfo < 0) {
01409 return 0;
01410 } else {
01411 result[ntest] = ulpinv;
01412 goto L310;
01413 }
01414 }
01415
01416
01417
01418 zsgt01_(&ibtype, uplo, &n, &m, &a[a_offset], lda, &b[
01419 b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01420 work[1], &rwork[1], &result[ntest]);
01421
01422 ++ntest;
01423
01424
01425
01426 if (lsame_(uplo, "U")) {
01427 ij = 1;
01428 i__3 = n;
01429 for (j = 1; j <= i__3; ++j) {
01430 i__4 = j;
01431 for (i__ = 1; i__ <= i__4; ++i__) {
01432 i__5 = ij;
01433 i__7 = i__ + j * a_dim1;
01434 ap[i__5].r = a[i__7].r, ap[i__5].i = a[i__7]
01435 .i;
01436 i__5 = ij;
01437 i__7 = i__ + j * b_dim1;
01438 bp[i__5].r = b[i__7].r, bp[i__5].i = b[i__7]
01439 .i;
01440 ++ij;
01441
01442 }
01443
01444 }
01445 } else {
01446 ij = 1;
01447 i__3 = n;
01448 for (j = 1; j <= i__3; ++j) {
01449 i__4 = n;
01450 for (i__ = j; i__ <= i__4; ++i__) {
01451 i__5 = ij;
01452 i__7 = i__ + j * a_dim1;
01453 ap[i__5].r = a[i__7].r, ap[i__5].i = a[i__7]
01454 .i;
01455 i__5 = ij;
01456 i__7 = i__ + j * b_dim1;
01457 bp[i__5].r = b[i__7].r, bp[i__5].i = b[i__7]
01458 .i;
01459 ++ij;
01460
01461 }
01462
01463 }
01464 }
01465
01466 zhpgvx_(&ibtype, "V", "I", uplo, &n, &ap[1], &bp[1], &vl,
01467 &vu, &il, &iu, &abstol, &m, &d__[1], &z__[
01468 z_offset], ldz, &work[1], &rwork[1], &iwork[n + 1]
01469 , &iwork[1], info);
01470 if (iinfo != 0) {
01471 io___57.ciunit = *nounit;
01472 s_wsfe(&io___57);
01473
01474 i__6[0] = 10, a__1[0] = "ZHPGVX(V,I";
01475 i__6[1] = 1, a__1[1] = uplo;
01476 i__6[2] = 1, a__1[2] = ")";
01477 s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
01478 do_fio(&c__1, ch__3, (ftnlen)12);
01479 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01480 ;
01481 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01482 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01483 ;
01484 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01485 integer));
01486 e_wsfe();
01487 *info = abs(iinfo);
01488 if (iinfo < 0) {
01489 return 0;
01490 } else {
01491 result[ntest] = ulpinv;
01492 goto L310;
01493 }
01494 }
01495
01496
01497
01498 zsgt01_(&ibtype, uplo, &n, &m, &a[a_offset], lda, &b[
01499 b_offset], ldb, &z__[z_offset], ldz, &d__[1], &
01500 work[1], &rwork[1], &result[ntest]);
01501
01502 L310:
01503
01504 if (ibtype == 1) {
01505
01506
01507
01508 ++ntest;
01509
01510
01511
01512 if (lsame_(uplo, "U")) {
01513 i__3 = n;
01514 for (j = 1; j <= i__3; ++j) {
01515
01516 i__4 = 1, i__5 = j - ka;
01517 i__7 = j;
01518 for (i__ = max(i__4,i__5); i__ <= i__7; ++i__)
01519 {
01520 i__4 = ka + 1 + i__ - j + j * ab_dim1;
01521 i__5 = i__ + j * a_dim1;
01522 ab[i__4].r = a[i__5].r, ab[i__4].i = a[
01523 i__5].i;
01524
01525 }
01526
01527 i__7 = 1, i__4 = j - kb;
01528 i__5 = j;
01529 for (i__ = max(i__7,i__4); i__ <= i__5; ++i__)
01530 {
01531 i__7 = kb + 1 + i__ - j + j * bb_dim1;
01532 i__4 = i__ + j * b_dim1;
01533 bb[i__7].r = b[i__4].r, bb[i__7].i = b[
01534 i__4].i;
01535
01536 }
01537
01538 }
01539 } else {
01540 i__3 = n;
01541 for (j = 1; j <= i__3; ++j) {
01542
01543 i__7 = n, i__4 = j + ka;
01544 i__5 = min(i__7,i__4);
01545 for (i__ = j; i__ <= i__5; ++i__) {
01546 i__7 = i__ + 1 - j + j * ab_dim1;
01547 i__4 = i__ + j * a_dim1;
01548 ab[i__7].r = a[i__4].r, ab[i__7].i = a[
01549 i__4].i;
01550
01551 }
01552
01553 i__7 = n, i__4 = j + kb;
01554 i__5 = min(i__7,i__4);
01555 for (i__ = j; i__ <= i__5; ++i__) {
01556 i__7 = i__ + 1 - j + j * bb_dim1;
01557 i__4 = i__ + j * b_dim1;
01558 bb[i__7].r = b[i__4].r, bb[i__7].i = b[
01559 i__4].i;
01560
01561 }
01562
01563 }
01564 }
01565
01566 zhbgv_("V", uplo, &n, &ka, &kb, &ab[ab_offset], lda, &
01567 bb[bb_offset], ldb, &d__[1], &z__[z_offset],
01568 ldz, &work[1], &rwork[1], &iinfo);
01569 if (iinfo != 0) {
01570 io___58.ciunit = *nounit;
01571 s_wsfe(&io___58);
01572
01573 i__6[0] = 8, a__1[0] = "ZHBGV(V,";
01574 i__6[1] = 1, a__1[1] = uplo;
01575 i__6[2] = 1, a__1[2] = ")";
01576 s_cat(ch__1, a__1, i__6, &c__3, (ftnlen)10);
01577 do_fio(&c__1, ch__1, (ftnlen)10);
01578 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(
01579 integer));
01580 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
01581 ;
01582 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(
01583 integer));
01584 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01585 integer));
01586 e_wsfe();
01587 *info = abs(iinfo);
01588 if (iinfo < 0) {
01589 return 0;
01590 } else {
01591 result[ntest] = ulpinv;
01592 goto L620;
01593 }
01594 }
01595
01596
01597
01598 zsgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
01599 b_offset], ldb, &z__[z_offset], ldz, &d__[1],
01600 &work[1], &rwork[1], &result[ntest]);
01601
01602
01603
01604 ++ntest;
01605
01606
01607
01608 if (lsame_(uplo, "U")) {
01609 i__3 = n;
01610 for (j = 1; j <= i__3; ++j) {
01611
01612 i__5 = 1, i__7 = j - ka;
01613 i__4 = j;
01614 for (i__ = max(i__5,i__7); i__ <= i__4; ++i__)
01615 {
01616 i__5 = ka + 1 + i__ - j + j * ab_dim1;
01617 i__7 = i__ + j * a_dim1;
01618 ab[i__5].r = a[i__7].r, ab[i__5].i = a[
01619 i__7].i;
01620
01621 }
01622
01623 i__4 = 1, i__5 = j - kb;
01624 i__7 = j;
01625 for (i__ = max(i__4,i__5); i__ <= i__7; ++i__)
01626 {
01627 i__4 = kb + 1 + i__ - j + j * bb_dim1;
01628 i__5 = i__ + j * b_dim1;
01629 bb[i__4].r = b[i__5].r, bb[i__4].i = b[
01630 i__5].i;
01631
01632 }
01633
01634 }
01635 } else {
01636 i__3 = n;
01637 for (j = 1; j <= i__3; ++j) {
01638
01639 i__4 = n, i__5 = j + ka;
01640 i__7 = min(i__4,i__5);
01641 for (i__ = j; i__ <= i__7; ++i__) {
01642 i__4 = i__ + 1 - j + j * ab_dim1;
01643 i__5 = i__ + j * a_dim1;
01644 ab[i__4].r = a[i__5].r, ab[i__4].i = a[
01645 i__5].i;
01646
01647 }
01648
01649 i__4 = n, i__5 = j + kb;
01650 i__7 = min(i__4,i__5);
01651 for (i__ = j; i__ <= i__7; ++i__) {
01652 i__4 = i__ + 1 - j + j * bb_dim1;
01653 i__5 = i__ + j * b_dim1;
01654 bb[i__4].r = b[i__5].r, bb[i__4].i = b[
01655 i__5].i;
01656
01657 }
01658
01659 }
01660 }
01661
01662 zhbgvd_("V", uplo, &n, &ka, &kb, &ab[ab_offset], lda,
01663 &bb[bb_offset], ldb, &d__[1], &z__[z_offset],
01664 ldz, &work[1], nwork, &rwork[1], lrwork, &
01665 iwork[1], liwork, &iinfo);
01666 if (iinfo != 0) {
01667 io___59.ciunit = *nounit;
01668 s_wsfe(&io___59);
01669
01670 i__6[0] = 9, a__1[0] = "ZHBGVD(V,";
01671 i__6[1] = 1, a__1[1] = uplo;
01672 i__6[2] = 1, a__1[2] = ")";
01673 s_cat(ch__2, a__1, i__6, &c__3, (ftnlen)11);
01674 do_fio(&c__1, ch__2, (ftnlen)11);
01675 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(
01676 integer));
01677 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
01678 ;
01679 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(
01680 integer));
01681 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01682 integer));
01683 e_wsfe();
01684 *info = abs(iinfo);
01685 if (iinfo < 0) {
01686 return 0;
01687 } else {
01688 result[ntest] = ulpinv;
01689 goto L620;
01690 }
01691 }
01692
01693
01694
01695 zsgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
01696 b_offset], ldb, &z__[z_offset], ldz, &d__[1],
01697 &work[1], &rwork[1], &result[ntest]);
01698
01699
01700
01701 ++ntest;
01702
01703
01704
01705 if (lsame_(uplo, "U")) {
01706 i__3 = n;
01707 for (j = 1; j <= i__3; ++j) {
01708
01709 i__7 = 1, i__4 = j - ka;
01710 i__5 = j;
01711 for (i__ = max(i__7,i__4); i__ <= i__5; ++i__)
01712 {
01713 i__7 = ka + 1 + i__ - j + j * ab_dim1;
01714 i__4 = i__ + j * a_dim1;
01715 ab[i__7].r = a[i__4].r, ab[i__7].i = a[
01716 i__4].i;
01717
01718 }
01719
01720 i__5 = 1, i__7 = j - kb;
01721 i__4 = j;
01722 for (i__ = max(i__5,i__7); i__ <= i__4; ++i__)
01723 {
01724 i__5 = kb + 1 + i__ - j + j * bb_dim1;
01725 i__7 = i__ + j * b_dim1;
01726 bb[i__5].r = b[i__7].r, bb[i__5].i = b[
01727 i__7].i;
01728
01729 }
01730
01731 }
01732 } else {
01733 i__3 = n;
01734 for (j = 1; j <= i__3; ++j) {
01735
01736 i__5 = n, i__7 = j + ka;
01737 i__4 = min(i__5,i__7);
01738 for (i__ = j; i__ <= i__4; ++i__) {
01739 i__5 = i__ + 1 - j + j * ab_dim1;
01740 i__7 = i__ + j * a_dim1;
01741 ab[i__5].r = a[i__7].r, ab[i__5].i = a[
01742 i__7].i;
01743
01744 }
01745
01746 i__5 = n, i__7 = j + kb;
01747 i__4 = min(i__5,i__7);
01748 for (i__ = j; i__ <= i__4; ++i__) {
01749 i__5 = i__ + 1 - j + j * bb_dim1;
01750 i__7 = i__ + j * b_dim1;
01751 bb[i__5].r = b[i__7].r, bb[i__5].i = b[
01752 i__7].i;
01753
01754 }
01755
01756 }
01757 }
01758
01759 i__3 = max(1,n);
01760 zhbgvx_("V", "A", uplo, &n, &ka, &kb, &ab[ab_offset],
01761 lda, &bb[bb_offset], ldb, &bp[1], &i__3, &vl,
01762 &vu, &il, &iu, &abstol, &m, &d__[1], &z__[
01763 z_offset], ldz, &work[1], &rwork[1], &iwork[n
01764 + 1], &iwork[1], &iinfo);
01765 if (iinfo != 0) {
01766 io___60.ciunit = *nounit;
01767 s_wsfe(&io___60);
01768
01769 i__6[0] = 10, a__1[0] = "ZHBGVX(V,A";
01770 i__6[1] = 1, a__1[1] = uplo;
01771 i__6[2] = 1, a__1[2] = ")";
01772 s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
01773 do_fio(&c__1, ch__3, (ftnlen)12);
01774 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(
01775 integer));
01776 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
01777 ;
01778 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(
01779 integer));
01780 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01781 integer));
01782 e_wsfe();
01783 *info = abs(iinfo);
01784 if (iinfo < 0) {
01785 return 0;
01786 } else {
01787 result[ntest] = ulpinv;
01788 goto L620;
01789 }
01790 }
01791
01792
01793
01794 zsgt01_(&ibtype, uplo, &n, &n, &a[a_offset], lda, &b[
01795 b_offset], ldb, &z__[z_offset], ldz, &d__[1],
01796 &work[1], &rwork[1], &result[ntest]);
01797
01798 ++ntest;
01799
01800
01801
01802 if (lsame_(uplo, "U")) {
01803 i__3 = n;
01804 for (j = 1; j <= i__3; ++j) {
01805
01806 i__4 = 1, i__5 = j - ka;
01807 i__7 = j;
01808 for (i__ = max(i__4,i__5); i__ <= i__7; ++i__)
01809 {
01810 i__4 = ka + 1 + i__ - j + j * ab_dim1;
01811 i__5 = i__ + j * a_dim1;
01812 ab[i__4].r = a[i__5].r, ab[i__4].i = a[
01813 i__5].i;
01814
01815 }
01816
01817 i__7 = 1, i__4 = j - kb;
01818 i__5 = j;
01819 for (i__ = max(i__7,i__4); i__ <= i__5; ++i__)
01820 {
01821 i__7 = kb + 1 + i__ - j + j * bb_dim1;
01822 i__4 = i__ + j * b_dim1;
01823 bb[i__7].r = b[i__4].r, bb[i__7].i = b[
01824 i__4].i;
01825
01826 }
01827
01828 }
01829 } else {
01830 i__3 = n;
01831 for (j = 1; j <= i__3; ++j) {
01832
01833 i__7 = n, i__4 = j + ka;
01834 i__5 = min(i__7,i__4);
01835 for (i__ = j; i__ <= i__5; ++i__) {
01836 i__7 = i__ + 1 - j + j * ab_dim1;
01837 i__4 = i__ + j * a_dim1;
01838 ab[i__7].r = a[i__4].r, ab[i__7].i = a[
01839 i__4].i;
01840
01841 }
01842
01843 i__7 = n, i__4 = j + kb;
01844 i__5 = min(i__7,i__4);
01845 for (i__ = j; i__ <= i__5; ++i__) {
01846 i__7 = i__ + 1 - j + j * bb_dim1;
01847 i__4 = i__ + j * b_dim1;
01848 bb[i__7].r = b[i__4].r, bb[i__7].i = b[
01849 i__4].i;
01850
01851 }
01852
01853 }
01854 }
01855
01856 vl = 0.;
01857 vu = anorm;
01858 i__3 = max(1,n);
01859 zhbgvx_("V", "V", uplo, &n, &ka, &kb, &ab[ab_offset],
01860 lda, &bb[bb_offset], ldb, &bp[1], &i__3, &vl,
01861 &vu, &il, &iu, &abstol, &m, &d__[1], &z__[
01862 z_offset], ldz, &work[1], &rwork[1], &iwork[n
01863 + 1], &iwork[1], &iinfo);
01864 if (iinfo != 0) {
01865 io___61.ciunit = *nounit;
01866 s_wsfe(&io___61);
01867
01868 i__6[0] = 10, a__1[0] = "ZHBGVX(V,V";
01869 i__6[1] = 1, a__1[1] = uplo;
01870 i__6[2] = 1, a__1[2] = ")";
01871 s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
01872 do_fio(&c__1, ch__3, (ftnlen)12);
01873 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(
01874 integer));
01875 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
01876 ;
01877 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(
01878 integer));
01879 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01880 integer));
01881 e_wsfe();
01882 *info = abs(iinfo);
01883 if (iinfo < 0) {
01884 return 0;
01885 } else {
01886 result[ntest] = ulpinv;
01887 goto L620;
01888 }
01889 }
01890
01891
01892
01893 zsgt01_(&ibtype, uplo, &n, &m, &a[a_offset], lda, &b[
01894 b_offset], ldb, &z__[z_offset], ldz, &d__[1],
01895 &work[1], &rwork[1], &result[ntest]);
01896
01897 ++ntest;
01898
01899
01900
01901 if (lsame_(uplo, "U")) {
01902 i__3 = n;
01903 for (j = 1; j <= i__3; ++j) {
01904
01905 i__5 = 1, i__7 = j - ka;
01906 i__4 = j;
01907 for (i__ = max(i__5,i__7); i__ <= i__4; ++i__)
01908 {
01909 i__5 = ka + 1 + i__ - j + j * ab_dim1;
01910 i__7 = i__ + j * a_dim1;
01911 ab[i__5].r = a[i__7].r, ab[i__5].i = a[
01912 i__7].i;
01913
01914 }
01915
01916 i__4 = 1, i__5 = j - kb;
01917 i__7 = j;
01918 for (i__ = max(i__4,i__5); i__ <= i__7; ++i__)
01919 {
01920 i__4 = kb + 1 + i__ - j + j * bb_dim1;
01921 i__5 = i__ + j * b_dim1;
01922 bb[i__4].r = b[i__5].r, bb[i__4].i = b[
01923 i__5].i;
01924
01925 }
01926
01927 }
01928 } else {
01929 i__3 = n;
01930 for (j = 1; j <= i__3; ++j) {
01931
01932 i__4 = n, i__5 = j + ka;
01933 i__7 = min(i__4,i__5);
01934 for (i__ = j; i__ <= i__7; ++i__) {
01935 i__4 = i__ + 1 - j + j * ab_dim1;
01936 i__5 = i__ + j * a_dim1;
01937 ab[i__4].r = a[i__5].r, ab[i__4].i = a[
01938 i__5].i;
01939
01940 }
01941
01942 i__4 = n, i__5 = j + kb;
01943 i__7 = min(i__4,i__5);
01944 for (i__ = j; i__ <= i__7; ++i__) {
01945 i__4 = i__ + 1 - j + j * bb_dim1;
01946 i__5 = i__ + j * b_dim1;
01947 bb[i__4].r = b[i__5].r, bb[i__4].i = b[
01948 i__5].i;
01949
01950 }
01951
01952 }
01953 }
01954
01955 i__3 = max(1,n);
01956 zhbgvx_("V", "I", uplo, &n, &ka, &kb, &ab[ab_offset],
01957 lda, &bb[bb_offset], ldb, &bp[1], &i__3, &vl,
01958 &vu, &il, &iu, &abstol, &m, &d__[1], &z__[
01959 z_offset], ldz, &work[1], &rwork[1], &iwork[n
01960 + 1], &iwork[1], &iinfo);
01961 if (iinfo != 0) {
01962 io___62.ciunit = *nounit;
01963 s_wsfe(&io___62);
01964
01965 i__6[0] = 10, a__1[0] = "ZHBGVX(V,I";
01966 i__6[1] = 1, a__1[1] = uplo;
01967 i__6[2] = 1, a__1[2] = ")";
01968 s_cat(ch__3, a__1, i__6, &c__3, (ftnlen)12);
01969 do_fio(&c__1, ch__3, (ftnlen)12);
01970 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(
01971 integer));
01972 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
01973 ;
01974 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(
01975 integer));
01976 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01977 integer));
01978 e_wsfe();
01979 *info = abs(iinfo);
01980 if (iinfo < 0) {
01981 return 0;
01982 } else {
01983 result[ntest] = ulpinv;
01984 goto L620;
01985 }
01986 }
01987
01988
01989
01990 zsgt01_(&ibtype, uplo, &n, &m, &a[a_offset], lda, &b[
01991 b_offset], ldb, &z__[z_offset], ldz, &d__[1],
01992 &work[1], &rwork[1], &result[ntest]);
01993
01994 }
01995
01996 L620:
01997 ;
01998 }
01999
02000 }
02001
02002
02003
02004 ntestt += ntest;
02005 dlafts_("ZSG", &n, &n, &jtype, &ntest, &result[1], ioldsd, thresh,
02006 nounit, &nerrs);
02007 L640:
02008 ;
02009 }
02010
02011 }
02012
02013
02014
02015 dlasum_("ZSG", nounit, &nerrs, &ntestt);
02016
02017 return 0;
02018
02019
02020
02021
02022 }