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 integer c__1 = 1;
00019 static integer c_n1 = -1;
00020 static integer c__2 = 2;
00021 static real c_b25 = 0.f;
00022 static integer c__0 = 0;
00023 static integer c__6 = 6;
00024 static real c_b39 = 1.f;
00025 static integer c__4 = 4;
00026 static integer c__3 = 3;
00027 static integer c__10 = 10;
00028 static integer c__11 = 11;
00029
00030 int schkst_(integer *nsizes, integer *nn, integer *ntypes,
00031 logical *dotype, integer *iseed, real *thresh, integer *nounit, real *
00032 a, integer *lda, real *ap, real *sd, real *se, real *d1, real *d2,
00033 real *d3, real *d4, real *d5, real *wa1, real *wa2, real *wa3, real *
00034 wr, real *u, integer *ldu, real *v, real *vp, real *tau, real *z__,
00035 real *work, integer *lwork, integer *iwork, integer *liwork, real *
00036 result, integer *info)
00037 {
00038
00039
00040 static integer ktype[21] = { 1,2,4,4,4,4,4,5,5,5,5,5,8,8,8,9,9,9,9,9,10 };
00041 static integer kmagn[21] = { 1,1,1,1,1,2,3,1,1,1,2,3,1,2,3,1,1,1,2,3,1 };
00042 static integer kmode[21] = { 0,0,4,3,1,4,4,4,3,1,4,4,0,0,0,4,3,1,4,4,3 };
00043
00044
00045 static char fmt_9999[] = "(\002 SCHKST: \002,a,\002 returned INFO=\002,i"
00046 "6,\002.\002,/9x,\002N=\002,i6,\002, JTYPE=\002,i6,\002, ISEED="
00047 "(\002,3(i5,\002,\002),i5,\002)\002)";
00048 static char fmt_9998[] = "(/1x,a3,\002 -- Real Symmetric eigenvalue prob"
00049 "lem\002)";
00050 static char fmt_9997[] = "(\002 Matrix types (see SCHKST for details):"
00051 " \002)";
00052 static char fmt_9996[] = "(/\002 Special Matrices:\002,/\002 1=Zero mat"
00053 "rix. \002,\002 5=Diagonal: clustered ent"
00054 "ries.\002,/\002 2=Identity matrix. \002,\002"
00055 " 6=Diagonal: large, evenly spaced.\002,/\002 3=Diagonal: evenl"
00056 "y spaced entries. \002,\002 7=Diagonal: small, evenly spaced."
00057 "\002,/\002 4=Diagonal: geometr. spaced entries.\002)";
00058 static char fmt_9995[] = "(\002 Dense \002,a,\002 Matrices:\002,/\002 8"
00059 "=Evenly spaced eigenvals. \002,\002 12=Small, evenly "
00060 "spaced eigenvals.\002,/\002 9=Geometrically spaced eigenvals. "
00061 " \002,\002 13=Matrix with random O(1) entries.\002,/\002 10=Cl"
00062 "ustered eigenvalues. \002,\002 14=Matrix with large"
00063 " random entries.\002,/\002 11=Large, evenly spaced eigenvals. "
00064 " \002,\002 15=Matrix with small random entries.\002)";
00065 static char fmt_9994[] = "(\002 16=Positive definite, evenly spaced eige"
00066 "nvalues\002,/\002 17=Positive definite, geometrically spaced eig"
00067 "envlaues\002,/\002 18=Positive definite, clustered eigenvalue"
00068 "s\002,/\002 19=Positive definite, small evenly spaced eigenvalues"
00069 "\002,/\002 20=Positive definite, large evenly spaced eigenvalue"
00070 "s\002,/\002 21=Diagonally dominant tridiagonal, geometrically"
00071 "\002,\002 spaced eigenvalues\002)";
00072 static char fmt_9988[] = "(/\002Test performed: see SCHKST for details"
00073 ".\002,/)";
00074 static char fmt_9990[] = "(\002 N=\002,i5,\002, seed=\002,4(i4,\002,\002"
00075 "),\002 type \002,i2,\002, test(\002,i2,\002)=\002,g10.3)";
00076
00077
00078 integer a_dim1, a_offset, u_dim1, u_offset, v_dim1, v_offset, z_dim1,
00079 z_offset, i__1, i__2, i__3, i__4;
00080 real r__1, r__2, r__3, r__4;
00081
00082
00083 double log(doublereal), sqrt(doublereal);
00084 integer pow_ii(integer *, integer *), s_wsfe(cilist *), do_fio(integer *,
00085 char *, ftnlen), e_wsfe(void);
00086
00087
00088 integer i__, j, m, n, m2, m3, jc, il, jr, iu;
00089 real vl, vu;
00090 integer nap, lgn;
00091 real ulp, cond;
00092 integer nmax;
00093 real unfl, ovfl, temp1, temp2, temp3, temp4;
00094 logical badnn;
00095 extern doublereal ssxt1_(integer *, real *, integer *, real *, integer *,
00096 real *, real *, real *);
00097 integer imode, lwedc;
00098 real dumma[1];
00099 integer iinfo;
00100 real aninv, anorm;
00101 integer itemp, nmats, jsize, nerrs, itype, jtype, ntest;
00102 extern int scopy_(integer *, real *, integer *, real *,
00103 integer *), sspt21_(integer *, char *, integer *, integer *, real
00104 *, real *, real *, real *, integer *, real *, real *, real *,
00105 real *), sstt21_(integer *, integer *, real *, real *,
00106 real *, real *, real *, integer *, real *, real *), sstt22_(
00107 integer *, integer *, integer *, real *, real *, real *, real *,
00108 real *, integer *, real *, integer *, real *), ssyt21_(integer *,
00109 char *, integer *, integer *, real *, integer *, real *, real *,
00110 real *, integer *, real *, integer *, real *, real *, real *);
00111 integer iseed2[4], log2ui;
00112 extern int slabad_(real *, real *);
00113 integer liwedc, nblock;
00114 extern doublereal slamch_(char *);
00115 integer idumma[1];
00116 extern int xerbla_(char *, integer *);
00117 integer ioldsd[4];
00118 extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
00119 integer *, integer *);
00120 extern doublereal slarnd_(integer *, integer *);
00121 real abstol;
00122 extern int sstedc_(char *, integer *, real *, real *,
00123 real *, integer *, real *, integer *, integer *, integer *,
00124 integer *), sstech_(integer *, real *, real *, real *,
00125 real *, real *, integer *), slacpy_(char *, integer *, integer *,
00126 real *, integer *, real *, integer *), slaset_(char *,
00127 integer *, integer *, real *, real *, real *, integer *),
00128 slatmr_(integer *, integer *, char *, integer *, char *, real *,
00129 integer *, real *, real *, char *, char *, real *, integer *,
00130 real *, real *, integer *, real *, char *, integer *, integer *,
00131 integer *, real *, real *, char *, real *, integer *, integer *,
00132 integer *),
00133 slatms_(integer *, integer *, char *, integer *, char *, real *,
00134 integer *, real *, real *, integer *, integer *, char *, real *,
00135 integer *, real *, integer *);
00136 logical tryrac;
00137 extern int slasum_(char *, integer *, integer *, integer
00138 *), sstein_(integer *, real *, real *, integer *, real *,
00139 integer *, integer *, real *, integer *, real *, integer *,
00140 integer *, integer *);
00141 integer nsplit;
00142 real rtunfl, rtovfl, ulpinv;
00143 extern int sopgtr_(char *, integer *, real *, real *,
00144 real *, integer *, real *, integer *);
00145 integer mtypes, ntestt;
00146 extern int sorgtr_(char *, integer *, real *, integer *,
00147 real *, real *, integer *, integer *), spteqr_(char *,
00148 integer *, real *, real *, real *, integer *, real *, integer *), ssptrd_(char *, integer *, real *, real *, real *, real *
00149 , integer *), sstebz_(char *, char *, integer *, real *,
00150 real *, integer *, integer *, real *, real *, real *, integer *,
00151 integer *, real *, integer *, integer *, real *, integer *,
00152 integer *), sstemr_(char *, char *, integer *,
00153 real *, real *, real *, real *, integer *, integer *, integer *,
00154 real *, real *, integer *, integer *, integer *, logical *, real *
00155 , integer *, integer *, integer *, integer *),
00156 ssteqr_(char *, integer *, real *, real *, real *, integer *,
00157 real *, integer *), ssterf_(integer *, real *, real *,
00158 integer *), ssytrd_(char *, integer *, real *, integer *, real *,
00159 real *, real *, real *, integer *, integer *);
00160
00161
00162 static cilist io___40 = { 0, 0, 0, fmt_9999, 0 };
00163 static cilist io___41 = { 0, 0, 0, fmt_9999, 0 };
00164 static cilist io___42 = { 0, 0, 0, fmt_9999, 0 };
00165 static cilist io___43 = { 0, 0, 0, fmt_9999, 0 };
00166 static cilist io___44 = { 0, 0, 0, fmt_9999, 0 };
00167 static cilist io___46 = { 0, 0, 0, fmt_9999, 0 };
00168 static cilist io___47 = { 0, 0, 0, fmt_9999, 0 };
00169 static cilist io___48 = { 0, 0, 0, fmt_9999, 0 };
00170 static cilist io___49 = { 0, 0, 0, fmt_9999, 0 };
00171 static cilist io___50 = { 0, 0, 0, fmt_9999, 0 };
00172 static cilist io___51 = { 0, 0, 0, fmt_9999, 0 };
00173 static cilist io___52 = { 0, 0, 0, fmt_9999, 0 };
00174 static cilist io___57 = { 0, 0, 0, fmt_9999, 0 };
00175 static cilist io___58 = { 0, 0, 0, fmt_9999, 0 };
00176 static cilist io___66 = { 0, 0, 0, fmt_9999, 0 };
00177 static cilist io___67 = { 0, 0, 0, fmt_9999, 0 };
00178 static cilist io___70 = { 0, 0, 0, fmt_9999, 0 };
00179 static cilist io___72 = { 0, 0, 0, fmt_9999, 0 };
00180 static cilist io___73 = { 0, 0, 0, fmt_9999, 0 };
00181 static cilist io___74 = { 0, 0, 0, fmt_9999, 0 };
00182 static cilist io___75 = { 0, 0, 0, fmt_9999, 0 };
00183 static cilist io___76 = { 0, 0, 0, fmt_9999, 0 };
00184 static cilist io___77 = { 0, 0, 0, fmt_9999, 0 };
00185 static cilist io___78 = { 0, 0, 0, fmt_9999, 0 };
00186 static cilist io___79 = { 0, 0, 0, fmt_9999, 0 };
00187 static cilist io___80 = { 0, 0, 0, fmt_9999, 0 };
00188 static cilist io___81 = { 0, 0, 0, fmt_9999, 0 };
00189 static cilist io___82 = { 0, 0, 0, fmt_9999, 0 };
00190 static cilist io___83 = { 0, 0, 0, fmt_9999, 0 };
00191 static cilist io___84 = { 0, 0, 0, fmt_9999, 0 };
00192 static cilist io___85 = { 0, 0, 0, fmt_9999, 0 };
00193 static cilist io___86 = { 0, 0, 0, fmt_9998, 0 };
00194 static cilist io___87 = { 0, 0, 0, fmt_9997, 0 };
00195 static cilist io___88 = { 0, 0, 0, fmt_9996, 0 };
00196 static cilist io___89 = { 0, 0, 0, fmt_9995, 0 };
00197 static cilist io___90 = { 0, 0, 0, fmt_9994, 0 };
00198 static cilist io___91 = { 0, 0, 0, fmt_9988, 0 };
00199 static cilist io___92 = { 0, 0, 0, fmt_9990, 0 };
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
00520
00521
00522
00523
00524
00525
00526
00527
00528
00529
00530
00531
00532
00533
00534
00535
00536
00537
00538
00539
00540
00541
00542
00543
00544
00545
00546
00547
00548
00549
00550
00551
00552
00553
00554
00555
00556
00557
00558
00559
00560
00561
00562
00563
00564
00565
00566
00567
00568
00569
00570
00571
00572
00573
00574
00575
00576
00577
00578
00579
00580
00581
00582
00583
00584
00585
00586
00587
00588
00589
00590
00591
00592
00593
00594
00595
00596
00597
00598
00599
00600
00601
00602
00603
00604
00605
00606
00607
00608
00609
00610
00611
00612
00613
00614
00615
00616
00617
00618
00619
00620
00621
00622
00623
00624
00625
00626
00627 --nn;
00628 --dotype;
00629 --iseed;
00630 a_dim1 = *lda;
00631 a_offset = 1 + a_dim1;
00632 a -= a_offset;
00633 --ap;
00634 --sd;
00635 --se;
00636 --d1;
00637 --d2;
00638 --d3;
00639 --d4;
00640 --d5;
00641 --wa1;
00642 --wa2;
00643 --wa3;
00644 --wr;
00645 z_dim1 = *ldu;
00646 z_offset = 1 + z_dim1;
00647 z__ -= z_offset;
00648 v_dim1 = *ldu;
00649 v_offset = 1 + v_dim1;
00650 v -= v_offset;
00651 u_dim1 = *ldu;
00652 u_offset = 1 + u_dim1;
00653 u -= u_offset;
00654 --vp;
00655 --tau;
00656 --work;
00657 --iwork;
00658 --result;
00659
00660
00661
00662
00663
00664
00665 idumma[0] = 1;
00666
00667
00668
00669 ntestt = 0;
00670 *info = 0;
00671
00672
00673
00674 badnn = FALSE_;
00675 tryrac = TRUE_;
00676 nmax = 1;
00677 i__1 = *nsizes;
00678 for (j = 1; j <= i__1; ++j) {
00679
00680 i__2 = nmax, i__3 = nn[j];
00681 nmax = max(i__2,i__3);
00682 if (nn[j] < 0) {
00683 badnn = TRUE_;
00684 }
00685
00686 }
00687
00688 nblock = ilaenv_(&c__1, "SSYTRD", "L", &nmax, &c_n1, &c_n1, &c_n1);
00689
00690 i__1 = nmax, i__2 = max(1,nblock);
00691 nblock = min(i__1,i__2);
00692
00693
00694
00695 if (*nsizes < 0) {
00696 *info = -1;
00697 } else if (badnn) {
00698 *info = -2;
00699 } else if (*ntypes < 0) {
00700 *info = -3;
00701 } else if (*lda < nmax) {
00702 *info = -9;
00703 } else if (*ldu < nmax) {
00704 *info = -23;
00705 } else {
00706
00707 i__1 = max(2,nmax);
00708 if (i__1 * i__1 << 1 > *lwork) {
00709 *info = -29;
00710 }
00711 }
00712
00713 if (*info != 0) {
00714 i__1 = -(*info);
00715 xerbla_("SCHKST", &i__1);
00716 return 0;
00717 }
00718
00719
00720
00721 if (*nsizes == 0 || *ntypes == 0) {
00722 return 0;
00723 }
00724
00725
00726
00727 unfl = slamch_("Safe minimum");
00728 ovfl = 1.f / unfl;
00729 slabad_(&unfl, &ovfl);
00730 ulp = slamch_("Epsilon") * slamch_("Base");
00731 ulpinv = 1.f / ulp;
00732 log2ui = (integer) (log(ulpinv) / log(2.f));
00733 rtunfl = sqrt(unfl);
00734 rtovfl = sqrt(ovfl);
00735
00736
00737
00738 for (i__ = 1; i__ <= 4; ++i__) {
00739 iseed2[i__ - 1] = iseed[i__];
00740
00741 }
00742 nerrs = 0;
00743 nmats = 0;
00744
00745 i__1 = *nsizes;
00746 for (jsize = 1; jsize <= i__1; ++jsize) {
00747 n = nn[jsize];
00748 if (n > 0) {
00749 lgn = (integer) (log((real) n) / log(2.f));
00750 if (pow_ii(&c__2, &lgn) < n) {
00751 ++lgn;
00752 }
00753 if (pow_ii(&c__2, &lgn) < n) {
00754 ++lgn;
00755 }
00756
00757 i__2 = n;
00758 lwedc = (n << 2) + 1 + (n << 1) * lgn + i__2 * i__2 * 3;
00759 liwedc = n * 6 + 6 + n * 5 * lgn;
00760 } else {
00761 lwedc = 8;
00762 liwedc = 12;
00763 }
00764 nap = n * (n + 1) / 2;
00765 aninv = 1.f / (real) max(1,n);
00766
00767 if (*nsizes != 1) {
00768 mtypes = min(21,*ntypes);
00769 } else {
00770 mtypes = min(22,*ntypes);
00771 }
00772
00773 i__2 = mtypes;
00774 for (jtype = 1; jtype <= i__2; ++jtype) {
00775 if (! dotype[jtype]) {
00776 goto L300;
00777 }
00778 ++nmats;
00779 ntest = 0;
00780
00781 for (j = 1; j <= 4; ++j) {
00782 ioldsd[j - 1] = iseed[j];
00783
00784 }
00785
00786
00787
00788
00789
00790
00791
00792
00793
00794
00795
00796
00797
00798
00799
00800
00801
00802 if (mtypes > 21) {
00803 goto L100;
00804 }
00805
00806 itype = ktype[jtype - 1];
00807 imode = kmode[jtype - 1];
00808
00809
00810
00811 switch (kmagn[jtype - 1]) {
00812 case 1: goto L40;
00813 case 2: goto L50;
00814 case 3: goto L60;
00815 }
00816
00817 L40:
00818 anorm = 1.f;
00819 goto L70;
00820
00821 L50:
00822 anorm = rtovfl * ulp * aninv;
00823 goto L70;
00824
00825 L60:
00826 anorm = rtunfl * n * ulpinv;
00827 goto L70;
00828
00829 L70:
00830
00831 slaset_("Full", lda, &n, &c_b25, &c_b25, &a[a_offset], lda);
00832 iinfo = 0;
00833 if (jtype <= 15) {
00834 cond = ulpinv;
00835 } else {
00836 cond = ulpinv * aninv / 10.f;
00837 }
00838
00839
00840
00841
00842
00843 if (itype == 1) {
00844 iinfo = 0;
00845
00846 } else if (itype == 2) {
00847
00848
00849
00850 i__3 = n;
00851 for (jc = 1; jc <= i__3; ++jc) {
00852 a[jc + jc * a_dim1] = anorm;
00853
00854 }
00855
00856 } else if (itype == 4) {
00857
00858
00859
00860 slatms_(&n, &n, "S", &iseed[1], "S", &work[1], &imode, &cond,
00861 &anorm, &c__0, &c__0, "N", &a[a_offset], lda, &work[n
00862 + 1], &iinfo);
00863
00864
00865 } else if (itype == 5) {
00866
00867
00868
00869 slatms_(&n, &n, "S", &iseed[1], "S", &work[1], &imode, &cond,
00870 &anorm, &n, &n, "N", &a[a_offset], lda, &work[n + 1],
00871 &iinfo);
00872
00873 } else if (itype == 7) {
00874
00875
00876
00877 slatmr_(&n, &n, "S", &iseed[1], "S", &work[1], &c__6, &c_b39,
00878 &c_b39, "T", "N", &work[n + 1], &c__1, &c_b39, &work[(
00879 n << 1) + 1], &c__1, &c_b39, "N", idumma, &c__0, &
00880 c__0, &c_b25, &anorm, "NO", &a[a_offset], lda, &iwork[
00881 1], &iinfo);
00882
00883 } else if (itype == 8) {
00884
00885
00886
00887 slatmr_(&n, &n, "S", &iseed[1], "S", &work[1], &c__6, &c_b39,
00888 &c_b39, "T", "N", &work[n + 1], &c__1, &c_b39, &work[(
00889 n << 1) + 1], &c__1, &c_b39, "N", idumma, &n, &n, &
00890 c_b25, &anorm, "NO", &a[a_offset], lda, &iwork[1], &
00891 iinfo);
00892
00893 } else if (itype == 9) {
00894
00895
00896
00897 slatms_(&n, &n, "S", &iseed[1], "P", &work[1], &imode, &cond,
00898 &anorm, &n, &n, "N", &a[a_offset], lda, &work[n + 1],
00899 &iinfo);
00900
00901 } else if (itype == 10) {
00902
00903
00904
00905 slatms_(&n, &n, "S", &iseed[1], "P", &work[1], &imode, &cond,
00906 &anorm, &c__1, &c__1, "N", &a[a_offset], lda, &work[n
00907 + 1], &iinfo);
00908 i__3 = n;
00909 for (i__ = 2; i__ <= i__3; ++i__) {
00910 temp1 = (r__1 = a[i__ - 1 + i__ * a_dim1], dabs(r__1)) /
00911 sqrt((r__2 = a[i__ - 1 + (i__ - 1) * a_dim1] * a[
00912 i__ + i__ * a_dim1], dabs(r__2)));
00913 if (temp1 > .5f) {
00914 a[i__ - 1 + i__ * a_dim1] = sqrt((r__1 = a[i__ - 1 + (
00915 i__ - 1) * a_dim1] * a[i__ + i__ * a_dim1],
00916 dabs(r__1))) * .5f;
00917 a[i__ + (i__ - 1) * a_dim1] = a[i__ - 1 + i__ *
00918 a_dim1];
00919 }
00920
00921 }
00922
00923 } else {
00924
00925 iinfo = 1;
00926 }
00927
00928 if (iinfo != 0) {
00929 io___40.ciunit = *nounit;
00930 s_wsfe(&io___40);
00931 do_fio(&c__1, "Generator", (ftnlen)9);
00932 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00933 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00934 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00935 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
00936 e_wsfe();
00937 *info = abs(iinfo);
00938 return 0;
00939 }
00940
00941 L100:
00942
00943
00944
00945
00946 slacpy_("U", &n, &n, &a[a_offset], lda, &v[v_offset], ldu);
00947
00948 ntest = 1;
00949 ssytrd_("U", &n, &v[v_offset], ldu, &sd[1], &se[1], &tau[1], &
00950 work[1], lwork, &iinfo);
00951
00952 if (iinfo != 0) {
00953 io___41.ciunit = *nounit;
00954 s_wsfe(&io___41);
00955 do_fio(&c__1, "SSYTRD(U)", (ftnlen)9);
00956 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00957 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00958 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00959 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
00960 e_wsfe();
00961 *info = abs(iinfo);
00962 if (iinfo < 0) {
00963 return 0;
00964 } else {
00965 result[1] = ulpinv;
00966 goto L280;
00967 }
00968 }
00969
00970 slacpy_("U", &n, &n, &v[v_offset], ldu, &u[u_offset], ldu);
00971
00972 ntest = 2;
00973 sorgtr_("U", &n, &u[u_offset], ldu, &tau[1], &work[1], lwork, &
00974 iinfo);
00975 if (iinfo != 0) {
00976 io___42.ciunit = *nounit;
00977 s_wsfe(&io___42);
00978 do_fio(&c__1, "SORGTR(U)", (ftnlen)9);
00979 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
00980 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
00981 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
00982 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
00983 e_wsfe();
00984 *info = abs(iinfo);
00985 if (iinfo < 0) {
00986 return 0;
00987 } else {
00988 result[2] = ulpinv;
00989 goto L280;
00990 }
00991 }
00992
00993
00994
00995 ssyt21_(&c__2, "Upper", &n, &c__1, &a[a_offset], lda, &sd[1], &se[
00996 1], &u[u_offset], ldu, &v[v_offset], ldu, &tau[1], &work[
00997 1], &result[1]);
00998 ssyt21_(&c__3, "Upper", &n, &c__1, &a[a_offset], lda, &sd[1], &se[
00999 1], &u[u_offset], ldu, &v[v_offset], ldu, &tau[1], &work[
01000 1], &result[2]);
01001
01002
01003
01004
01005 slacpy_("L", &n, &n, &a[a_offset], lda, &v[v_offset], ldu);
01006
01007 ntest = 3;
01008 ssytrd_("L", &n, &v[v_offset], ldu, &sd[1], &se[1], &tau[1], &
01009 work[1], lwork, &iinfo);
01010
01011 if (iinfo != 0) {
01012 io___43.ciunit = *nounit;
01013 s_wsfe(&io___43);
01014 do_fio(&c__1, "SSYTRD(L)", (ftnlen)9);
01015 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01016 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01017 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01018 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
01019 e_wsfe();
01020 *info = abs(iinfo);
01021 if (iinfo < 0) {
01022 return 0;
01023 } else {
01024 result[3] = ulpinv;
01025 goto L280;
01026 }
01027 }
01028
01029 slacpy_("L", &n, &n, &v[v_offset], ldu, &u[u_offset], ldu);
01030
01031 ntest = 4;
01032 sorgtr_("L", &n, &u[u_offset], ldu, &tau[1], &work[1], lwork, &
01033 iinfo);
01034 if (iinfo != 0) {
01035 io___44.ciunit = *nounit;
01036 s_wsfe(&io___44);
01037 do_fio(&c__1, "SORGTR(L)", (ftnlen)9);
01038 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01039 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01040 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01041 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
01042 e_wsfe();
01043 *info = abs(iinfo);
01044 if (iinfo < 0) {
01045 return 0;
01046 } else {
01047 result[4] = ulpinv;
01048 goto L280;
01049 }
01050 }
01051
01052 ssyt21_(&c__2, "Lower", &n, &c__1, &a[a_offset], lda, &sd[1], &se[
01053 1], &u[u_offset], ldu, &v[v_offset], ldu, &tau[1], &work[
01054 1], &result[3]);
01055 ssyt21_(&c__3, "Lower", &n, &c__1, &a[a_offset], lda, &sd[1], &se[
01056 1], &u[u_offset], ldu, &v[v_offset], ldu, &tau[1], &work[
01057 1], &result[4]);
01058
01059
01060
01061 i__ = 0;
01062 i__3 = n;
01063 for (jc = 1; jc <= i__3; ++jc) {
01064 i__4 = jc;
01065 for (jr = 1; jr <= i__4; ++jr) {
01066 ++i__;
01067 ap[i__] = a[jr + jc * a_dim1];
01068
01069 }
01070
01071 }
01072
01073
01074
01075 scopy_(&nap, &ap[1], &c__1, &vp[1], &c__1);
01076
01077 ntest = 5;
01078 ssptrd_("U", &n, &vp[1], &sd[1], &se[1], &tau[1], &iinfo);
01079
01080 if (iinfo != 0) {
01081 io___46.ciunit = *nounit;
01082 s_wsfe(&io___46);
01083 do_fio(&c__1, "SSPTRD(U)", (ftnlen)9);
01084 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01085 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01086 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01087 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
01088 e_wsfe();
01089 *info = abs(iinfo);
01090 if (iinfo < 0) {
01091 return 0;
01092 } else {
01093 result[5] = ulpinv;
01094 goto L280;
01095 }
01096 }
01097
01098 ntest = 6;
01099 sopgtr_("U", &n, &vp[1], &tau[1], &u[u_offset], ldu, &work[1], &
01100 iinfo);
01101 if (iinfo != 0) {
01102 io___47.ciunit = *nounit;
01103 s_wsfe(&io___47);
01104 do_fio(&c__1, "SOPGTR(U)", (ftnlen)9);
01105 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01106 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01107 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01108 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
01109 e_wsfe();
01110 *info = abs(iinfo);
01111 if (iinfo < 0) {
01112 return 0;
01113 } else {
01114 result[6] = ulpinv;
01115 goto L280;
01116 }
01117 }
01118
01119
01120
01121 sspt21_(&c__2, "Upper", &n, &c__1, &ap[1], &sd[1], &se[1], &u[
01122 u_offset], ldu, &vp[1], &tau[1], &work[1], &result[5]);
01123 sspt21_(&c__3, "Upper", &n, &c__1, &ap[1], &sd[1], &se[1], &u[
01124 u_offset], ldu, &vp[1], &tau[1], &work[1], &result[6]);
01125
01126
01127
01128 i__ = 0;
01129 i__3 = n;
01130 for (jc = 1; jc <= i__3; ++jc) {
01131 i__4 = n;
01132 for (jr = jc; jr <= i__4; ++jr) {
01133 ++i__;
01134 ap[i__] = a[jr + jc * a_dim1];
01135
01136 }
01137
01138 }
01139
01140
01141
01142 scopy_(&nap, &ap[1], &c__1, &vp[1], &c__1);
01143
01144 ntest = 7;
01145 ssptrd_("L", &n, &vp[1], &sd[1], &se[1], &tau[1], &iinfo);
01146
01147 if (iinfo != 0) {
01148 io___48.ciunit = *nounit;
01149 s_wsfe(&io___48);
01150 do_fio(&c__1, "SSPTRD(L)", (ftnlen)9);
01151 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01152 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01153 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01154 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
01155 e_wsfe();
01156 *info = abs(iinfo);
01157 if (iinfo < 0) {
01158 return 0;
01159 } else {
01160 result[7] = ulpinv;
01161 goto L280;
01162 }
01163 }
01164
01165 ntest = 8;
01166 sopgtr_("L", &n, &vp[1], &tau[1], &u[u_offset], ldu, &work[1], &
01167 iinfo);
01168 if (iinfo != 0) {
01169 io___49.ciunit = *nounit;
01170 s_wsfe(&io___49);
01171 do_fio(&c__1, "SOPGTR(L)", (ftnlen)9);
01172 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01173 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01174 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01175 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
01176 e_wsfe();
01177 *info = abs(iinfo);
01178 if (iinfo < 0) {
01179 return 0;
01180 } else {
01181 result[8] = ulpinv;
01182 goto L280;
01183 }
01184 }
01185
01186 sspt21_(&c__2, "Lower", &n, &c__1, &ap[1], &sd[1], &se[1], &u[
01187 u_offset], ldu, &vp[1], &tau[1], &work[1], &result[7]);
01188 sspt21_(&c__3, "Lower", &n, &c__1, &ap[1], &sd[1], &se[1], &u[
01189 u_offset], ldu, &vp[1], &tau[1], &work[1], &result[8]);
01190
01191
01192
01193
01194
01195 scopy_(&n, &sd[1], &c__1, &d1[1], &c__1);
01196 if (n > 0) {
01197 i__3 = n - 1;
01198 scopy_(&i__3, &se[1], &c__1, &work[1], &c__1);
01199 }
01200 slaset_("Full", &n, &n, &c_b25, &c_b39, &z__[z_offset], ldu);
01201
01202 ntest = 9;
01203 ssteqr_("V", &n, &d1[1], &work[1], &z__[z_offset], ldu, &work[n +
01204 1], &iinfo);
01205 if (iinfo != 0) {
01206 io___50.ciunit = *nounit;
01207 s_wsfe(&io___50);
01208 do_fio(&c__1, "SSTEQR(V)", (ftnlen)9);
01209 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01210 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01211 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01212 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
01213 e_wsfe();
01214 *info = abs(iinfo);
01215 if (iinfo < 0) {
01216 return 0;
01217 } else {
01218 result[9] = ulpinv;
01219 goto L280;
01220 }
01221 }
01222
01223
01224
01225 scopy_(&n, &sd[1], &c__1, &d2[1], &c__1);
01226 if (n > 0) {
01227 i__3 = n - 1;
01228 scopy_(&i__3, &se[1], &c__1, &work[1], &c__1);
01229 }
01230
01231 ntest = 11;
01232 ssteqr_("N", &n, &d2[1], &work[1], &work[n + 1], ldu, &work[n + 1]
01233 , &iinfo);
01234 if (iinfo != 0) {
01235 io___51.ciunit = *nounit;
01236 s_wsfe(&io___51);
01237 do_fio(&c__1, "SSTEQR(N)", (ftnlen)9);
01238 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01239 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01240 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01241 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
01242 e_wsfe();
01243 *info = abs(iinfo);
01244 if (iinfo < 0) {
01245 return 0;
01246 } else {
01247 result[11] = ulpinv;
01248 goto L280;
01249 }
01250 }
01251
01252
01253
01254 scopy_(&n, &sd[1], &c__1, &d3[1], &c__1);
01255 if (n > 0) {
01256 i__3 = n - 1;
01257 scopy_(&i__3, &se[1], &c__1, &work[1], &c__1);
01258 }
01259
01260 ntest = 12;
01261 ssterf_(&n, &d3[1], &work[1], &iinfo);
01262 if (iinfo != 0) {
01263 io___52.ciunit = *nounit;
01264 s_wsfe(&io___52);
01265 do_fio(&c__1, "SSTERF", (ftnlen)6);
01266 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01267 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01268 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01269 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
01270 e_wsfe();
01271 *info = abs(iinfo);
01272 if (iinfo < 0) {
01273 return 0;
01274 } else {
01275 result[12] = ulpinv;
01276 goto L280;
01277 }
01278 }
01279
01280
01281
01282 sstt21_(&n, &c__0, &sd[1], &se[1], &d1[1], dumma, &z__[z_offset],
01283 ldu, &work[1], &result[9]);
01284
01285
01286
01287 temp1 = 0.f;
01288 temp2 = 0.f;
01289 temp3 = 0.f;
01290 temp4 = 0.f;
01291
01292 i__3 = n;
01293 for (j = 1; j <= i__3; ++j) {
01294
01295 r__3 = temp1, r__4 = (r__1 = d1[j], dabs(r__1)), r__3 = max(
01296 r__3,r__4), r__4 = (r__2 = d2[j], dabs(r__2));
01297 temp1 = dmax(r__3,r__4);
01298
01299 r__2 = temp2, r__3 = (r__1 = d1[j] - d2[j], dabs(r__1));
01300 temp2 = dmax(r__2,r__3);
01301
01302 r__3 = temp3, r__4 = (r__1 = d1[j], dabs(r__1)), r__3 = max(
01303 r__3,r__4), r__4 = (r__2 = d3[j], dabs(r__2));
01304 temp3 = dmax(r__3,r__4);
01305
01306 r__2 = temp4, r__3 = (r__1 = d1[j] - d3[j], dabs(r__1));
01307 temp4 = dmax(r__2,r__3);
01308
01309 }
01310
01311
01312 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
01313 result[11] = temp2 / dmax(r__1,r__2);
01314
01315 r__1 = unfl, r__2 = ulp * dmax(temp3,temp4);
01316 result[12] = temp4 / dmax(r__1,r__2);
01317
01318
01319
01320
01321 ntest = 13;
01322 temp1 = *thresh * (.5f - ulp);
01323
01324 i__3 = log2ui;
01325 for (j = 0; j <= i__3; ++j) {
01326 sstech_(&n, &sd[1], &se[1], &d1[1], &temp1, &work[1], &iinfo);
01327 if (iinfo == 0) {
01328 goto L170;
01329 }
01330 temp1 *= 2.f;
01331
01332 }
01333
01334 L170:
01335 result[13] = temp1;
01336
01337
01338
01339
01340 if (jtype > 15) {
01341
01342
01343
01344 scopy_(&n, &sd[1], &c__1, &d4[1], &c__1);
01345 if (n > 0) {
01346 i__3 = n - 1;
01347 scopy_(&i__3, &se[1], &c__1, &work[1], &c__1);
01348 }
01349 slaset_("Full", &n, &n, &c_b25, &c_b39, &z__[z_offset], ldu);
01350
01351 ntest = 14;
01352 spteqr_("V", &n, &d4[1], &work[1], &z__[z_offset], ldu, &work[
01353 n + 1], &iinfo);
01354 if (iinfo != 0) {
01355 io___57.ciunit = *nounit;
01356 s_wsfe(&io___57);
01357 do_fio(&c__1, "SPTEQR(V)", (ftnlen)9);
01358 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01359 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01360 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01361 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01362 ;
01363 e_wsfe();
01364 *info = abs(iinfo);
01365 if (iinfo < 0) {
01366 return 0;
01367 } else {
01368 result[14] = ulpinv;
01369 goto L280;
01370 }
01371 }
01372
01373
01374
01375 sstt21_(&n, &c__0, &sd[1], &se[1], &d4[1], dumma, &z__[
01376 z_offset], ldu, &work[1], &result[14]);
01377
01378
01379
01380 scopy_(&n, &sd[1], &c__1, &d5[1], &c__1);
01381 if (n > 0) {
01382 i__3 = n - 1;
01383 scopy_(&i__3, &se[1], &c__1, &work[1], &c__1);
01384 }
01385
01386 ntest = 16;
01387 spteqr_("N", &n, &d5[1], &work[1], &z__[z_offset], ldu, &work[
01388 n + 1], &iinfo);
01389 if (iinfo != 0) {
01390 io___58.ciunit = *nounit;
01391 s_wsfe(&io___58);
01392 do_fio(&c__1, "SPTEQR(N)", (ftnlen)9);
01393 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01394 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01395 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01396 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01397 ;
01398 e_wsfe();
01399 *info = abs(iinfo);
01400 if (iinfo < 0) {
01401 return 0;
01402 } else {
01403 result[16] = ulpinv;
01404 goto L280;
01405 }
01406 }
01407
01408
01409
01410 temp1 = 0.f;
01411 temp2 = 0.f;
01412 i__3 = n;
01413 for (j = 1; j <= i__3; ++j) {
01414
01415 r__3 = temp1, r__4 = (r__1 = d4[j], dabs(r__1)), r__3 =
01416 max(r__3,r__4), r__4 = (r__2 = d5[j], dabs(r__2));
01417 temp1 = dmax(r__3,r__4);
01418
01419 r__2 = temp2, r__3 = (r__1 = d4[j] - d5[j], dabs(r__1));
01420 temp2 = dmax(r__2,r__3);
01421
01422 }
01423
01424
01425 r__1 = unfl, r__2 = ulp * 100.f * dmax(temp1,temp2);
01426 result[16] = temp2 / dmax(r__1,r__2);
01427 } else {
01428 result[14] = 0.f;
01429 result[15] = 0.f;
01430 result[16] = 0.f;
01431 }
01432
01433
01434
01435
01436
01437
01438 vl = 0.f;
01439 vu = 0.f;
01440 il = 0;
01441 iu = 0;
01442 if (jtype == 21) {
01443 ntest = 17;
01444 abstol = unfl + unfl;
01445 sstebz_("A", "E", &n, &vl, &vu, &il, &iu, &abstol, &sd[1], &
01446 se[1], &m, &nsplit, &wr[1], &iwork[1], &iwork[n + 1],
01447 &work[1], &iwork[(n << 1) + 1], &iinfo);
01448 if (iinfo != 0) {
01449 io___66.ciunit = *nounit;
01450 s_wsfe(&io___66);
01451 do_fio(&c__1, "SSTEBZ(A,rel)", (ftnlen)13);
01452 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01453 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01454 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01455 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
01456 ;
01457 e_wsfe();
01458 *info = abs(iinfo);
01459 if (iinfo < 0) {
01460 return 0;
01461 } else {
01462 result[17] = ulpinv;
01463 goto L280;
01464 }
01465 }
01466
01467
01468
01469 temp2 = (n * 2.f - 1.f) * 2.f * ulp * 3.f / .0625f;
01470
01471 temp1 = 0.f;
01472 i__3 = n;
01473 for (j = 1; j <= i__3; ++j) {
01474
01475 r__3 = temp1, r__4 = (r__2 = d4[j] - wr[n - j + 1], dabs(
01476 r__2)) / (abstol + (r__1 = d4[j], dabs(r__1)));
01477 temp1 = dmax(r__3,r__4);
01478
01479 }
01480
01481 result[17] = temp1 / temp2;
01482 } else {
01483 result[17] = 0.f;
01484 }
01485
01486
01487
01488 ntest = 18;
01489 abstol = unfl + unfl;
01490 sstebz_("A", "E", &n, &vl, &vu, &il, &iu, &abstol, &sd[1], &se[1],
01491 &m, &nsplit, &wa1[1], &iwork[1], &iwork[n + 1], &work[1],
01492 &iwork[(n << 1) + 1], &iinfo);
01493 if (iinfo != 0) {
01494 io___67.ciunit = *nounit;
01495 s_wsfe(&io___67);
01496 do_fio(&c__1, "SSTEBZ(A)", (ftnlen)9);
01497 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01498 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01499 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01500 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
01501 e_wsfe();
01502 *info = abs(iinfo);
01503 if (iinfo < 0) {
01504 return 0;
01505 } else {
01506 result[18] = ulpinv;
01507 goto L280;
01508 }
01509 }
01510
01511
01512
01513 temp1 = 0.f;
01514 temp2 = 0.f;
01515 i__3 = n;
01516 for (j = 1; j <= i__3; ++j) {
01517
01518 r__3 = temp1, r__4 = (r__1 = d3[j], dabs(r__1)), r__3 = max(
01519 r__3,r__4), r__4 = (r__2 = wa1[j], dabs(r__2));
01520 temp1 = dmax(r__3,r__4);
01521
01522 r__2 = temp2, r__3 = (r__1 = d3[j] - wa1[j], dabs(r__1));
01523 temp2 = dmax(r__2,r__3);
01524
01525 }
01526
01527
01528 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
01529 result[18] = temp2 / dmax(r__1,r__2);
01530
01531
01532
01533
01534 ntest = 19;
01535 if (n <= 1) {
01536 il = 1;
01537 iu = n;
01538 } else {
01539 il = (n - 1) * (integer) slarnd_(&c__1, iseed2) + 1;
01540 iu = (n - 1) * (integer) slarnd_(&c__1, iseed2) + 1;
01541 if (iu < il) {
01542 itemp = iu;
01543 iu = il;
01544 il = itemp;
01545 }
01546 }
01547
01548 sstebz_("I", "E", &n, &vl, &vu, &il, &iu, &abstol, &sd[1], &se[1],
01549 &m2, &nsplit, &wa2[1], &iwork[1], &iwork[n + 1], &work[1]
01550 , &iwork[(n << 1) + 1], &iinfo);
01551 if (iinfo != 0) {
01552 io___70.ciunit = *nounit;
01553 s_wsfe(&io___70);
01554 do_fio(&c__1, "SSTEBZ(I)", (ftnlen)9);
01555 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01556 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01557 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01558 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
01559 e_wsfe();
01560 *info = abs(iinfo);
01561 if (iinfo < 0) {
01562 return 0;
01563 } else {
01564 result[19] = ulpinv;
01565 goto L280;
01566 }
01567 }
01568
01569
01570
01571
01572 if (n > 0) {
01573 if (il != 1) {
01574
01575 r__1 = (wa1[il] - wa1[il - 1]) * .5f, r__2 = ulp * anorm,
01576 r__1 = max(r__1,r__2), r__2 = rtunfl * 2.f;
01577 vl = wa1[il] - dmax(r__1,r__2);
01578 } else {
01579
01580 r__1 = (wa1[n] - wa1[1]) * .5f, r__2 = ulp * anorm, r__1 =
01581 max(r__1,r__2), r__2 = rtunfl * 2.f;
01582 vl = wa1[1] - dmax(r__1,r__2);
01583 }
01584 if (iu != n) {
01585
01586 r__1 = (wa1[iu + 1] - wa1[iu]) * .5f, r__2 = ulp * anorm,
01587 r__1 = max(r__1,r__2), r__2 = rtunfl * 2.f;
01588 vu = wa1[iu] + dmax(r__1,r__2);
01589 } else {
01590
01591 r__1 = (wa1[n] - wa1[1]) * .5f, r__2 = ulp * anorm, r__1 =
01592 max(r__1,r__2), r__2 = rtunfl * 2.f;
01593 vu = wa1[n] + dmax(r__1,r__2);
01594 }
01595 } else {
01596 vl = 0.f;
01597 vu = 1.f;
01598 }
01599
01600 sstebz_("V", "E", &n, &vl, &vu, &il, &iu, &abstol, &sd[1], &se[1],
01601 &m3, &nsplit, &wa3[1], &iwork[1], &iwork[n + 1], &work[1]
01602 , &iwork[(n << 1) + 1], &iinfo);
01603 if (iinfo != 0) {
01604 io___72.ciunit = *nounit;
01605 s_wsfe(&io___72);
01606 do_fio(&c__1, "SSTEBZ(V)", (ftnlen)9);
01607 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01608 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01609 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01610 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
01611 e_wsfe();
01612 *info = abs(iinfo);
01613 if (iinfo < 0) {
01614 return 0;
01615 } else {
01616 result[19] = ulpinv;
01617 goto L280;
01618 }
01619 }
01620
01621 if (m3 == 0 && n != 0) {
01622 result[19] = ulpinv;
01623 goto L280;
01624 }
01625
01626
01627
01628 temp1 = ssxt1_(&c__1, &wa2[1], &m2, &wa3[1], &m3, &abstol, &ulp, &
01629 unfl);
01630 temp2 = ssxt1_(&c__1, &wa3[1], &m3, &wa2[1], &m2, &abstol, &ulp, &
01631 unfl);
01632 if (n > 0) {
01633
01634 r__2 = (r__1 = wa1[n], dabs(r__1)), r__3 = dabs(wa1[1]);
01635 temp3 = dmax(r__2,r__3);
01636 } else {
01637 temp3 = 0.f;
01638 }
01639
01640
01641 r__1 = unfl, r__2 = temp3 * ulp;
01642 result[19] = (temp1 + temp2) / dmax(r__1,r__2);
01643
01644
01645
01646
01647
01648 ntest = 21;
01649 sstebz_("A", "B", &n, &vl, &vu, &il, &iu, &abstol, &sd[1], &se[1],
01650 &m, &nsplit, &wa1[1], &iwork[1], &iwork[n + 1], &work[1],
01651 &iwork[(n << 1) + 1], &iinfo);
01652 if (iinfo != 0) {
01653 io___73.ciunit = *nounit;
01654 s_wsfe(&io___73);
01655 do_fio(&c__1, "SSTEBZ(A,B)", (ftnlen)11);
01656 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01657 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01658 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01659 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
01660 e_wsfe();
01661 *info = abs(iinfo);
01662 if (iinfo < 0) {
01663 return 0;
01664 } else {
01665 result[20] = ulpinv;
01666 result[21] = ulpinv;
01667 goto L280;
01668 }
01669 }
01670
01671 sstein_(&n, &sd[1], &se[1], &m, &wa1[1], &iwork[1], &iwork[n + 1],
01672 &z__[z_offset], ldu, &work[1], &iwork[(n << 1) + 1], &
01673 iwork[n * 3 + 1], &iinfo);
01674 if (iinfo != 0) {
01675 io___74.ciunit = *nounit;
01676 s_wsfe(&io___74);
01677 do_fio(&c__1, "SSTEIN", (ftnlen)6);
01678 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01679 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01680 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01681 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
01682 e_wsfe();
01683 *info = abs(iinfo);
01684 if (iinfo < 0) {
01685 return 0;
01686 } else {
01687 result[20] = ulpinv;
01688 result[21] = ulpinv;
01689 goto L280;
01690 }
01691 }
01692
01693
01694
01695 sstt21_(&n, &c__0, &sd[1], &se[1], &wa1[1], dumma, &z__[z_offset],
01696 ldu, &work[1], &result[20]);
01697
01698
01699
01700
01701
01702 scopy_(&n, &sd[1], &c__1, &d1[1], &c__1);
01703 if (n > 0) {
01704 i__3 = n - 1;
01705 scopy_(&i__3, &se[1], &c__1, &work[1], &c__1);
01706 }
01707 slaset_("Full", &n, &n, &c_b25, &c_b39, &z__[z_offset], ldu);
01708
01709 ntest = 22;
01710 i__3 = lwedc - n;
01711 sstedc_("I", &n, &d1[1], &work[1], &z__[z_offset], ldu, &work[n +
01712 1], &i__3, &iwork[1], &liwedc, &iinfo);
01713 if (iinfo != 0) {
01714 io___75.ciunit = *nounit;
01715 s_wsfe(&io___75);
01716 do_fio(&c__1, "SSTEDC(I)", (ftnlen)9);
01717 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01718 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01719 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01720 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
01721 e_wsfe();
01722 *info = abs(iinfo);
01723 if (iinfo < 0) {
01724 return 0;
01725 } else {
01726 result[22] = ulpinv;
01727 goto L280;
01728 }
01729 }
01730
01731
01732
01733 sstt21_(&n, &c__0, &sd[1], &se[1], &d1[1], dumma, &z__[z_offset],
01734 ldu, &work[1], &result[22]);
01735
01736
01737
01738
01739
01740 scopy_(&n, &sd[1], &c__1, &d1[1], &c__1);
01741 if (n > 0) {
01742 i__3 = n - 1;
01743 scopy_(&i__3, &se[1], &c__1, &work[1], &c__1);
01744 }
01745 slaset_("Full", &n, &n, &c_b25, &c_b39, &z__[z_offset], ldu);
01746
01747 ntest = 24;
01748 i__3 = lwedc - n;
01749 sstedc_("V", &n, &d1[1], &work[1], &z__[z_offset], ldu, &work[n +
01750 1], &i__3, &iwork[1], &liwedc, &iinfo);
01751 if (iinfo != 0) {
01752 io___76.ciunit = *nounit;
01753 s_wsfe(&io___76);
01754 do_fio(&c__1, "SSTEDC(V)", (ftnlen)9);
01755 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01756 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01757 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01758 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
01759 e_wsfe();
01760 *info = abs(iinfo);
01761 if (iinfo < 0) {
01762 return 0;
01763 } else {
01764 result[24] = ulpinv;
01765 goto L280;
01766 }
01767 }
01768
01769
01770
01771 sstt21_(&n, &c__0, &sd[1], &se[1], &d1[1], dumma, &z__[z_offset],
01772 ldu, &work[1], &result[24]);
01773
01774
01775
01776
01777
01778 scopy_(&n, &sd[1], &c__1, &d2[1], &c__1);
01779 if (n > 0) {
01780 i__3 = n - 1;
01781 scopy_(&i__3, &se[1], &c__1, &work[1], &c__1);
01782 }
01783 slaset_("Full", &n, &n, &c_b25, &c_b39, &z__[z_offset], ldu);
01784
01785 ntest = 26;
01786 i__3 = lwedc - n;
01787 sstedc_("N", &n, &d2[1], &work[1], &z__[z_offset], ldu, &work[n +
01788 1], &i__3, &iwork[1], &liwedc, &iinfo);
01789 if (iinfo != 0) {
01790 io___77.ciunit = *nounit;
01791 s_wsfe(&io___77);
01792 do_fio(&c__1, "SSTEDC(N)", (ftnlen)9);
01793 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
01794 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01795 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
01796 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer));
01797 e_wsfe();
01798 *info = abs(iinfo);
01799 if (iinfo < 0) {
01800 return 0;
01801 } else {
01802 result[26] = ulpinv;
01803 goto L280;
01804 }
01805 }
01806
01807
01808
01809 temp1 = 0.f;
01810 temp2 = 0.f;
01811
01812 i__3 = n;
01813 for (j = 1; j <= i__3; ++j) {
01814
01815 r__3 = temp1, r__4 = (r__1 = d1[j], dabs(r__1)), r__3 = max(
01816 r__3,r__4), r__4 = (r__2 = d2[j], dabs(r__2));
01817 temp1 = dmax(r__3,r__4);
01818
01819 r__2 = temp2, r__3 = (r__1 = d1[j] - d2[j], dabs(r__1));
01820 temp2 = dmax(r__2,r__3);
01821
01822 }
01823
01824
01825 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
01826 result[26] = temp2 / dmax(r__1,r__2);
01827
01828
01829
01830 if (ilaenv_(&c__10, "SSTEMR", "VA", &c__1, &c__0, &c__0, &c__0) == 1 && ilaenv_(&c__11, "SSTEMR",
01831 "VA", &c__1, &c__0, &c__0, &c__0) ==
01832 1) {
01833
01834
01835
01836
01837
01838
01839 vl = 0.f;
01840 vu = 0.f;
01841 il = 0;
01842 iu = 0;
01843 if (FALSE_) {
01844 ntest = 27;
01845 abstol = unfl + unfl;
01846 i__3 = *lwork - (n << 1);
01847 sstemr_("V", "A", &n, &sd[1], &se[1], &vl, &vu, &il, &iu,
01848 &m, &wr[1], &z__[z_offset], ldu, &n, &iwork[1], &
01849 tryrac, &work[1], lwork, &iwork[(n << 1) + 1], &
01850 i__3, &iinfo);
01851 if (iinfo != 0) {
01852 io___78.ciunit = *nounit;
01853 s_wsfe(&io___78);
01854 do_fio(&c__1, "SSTEMR(V,A,rel)", (ftnlen)15);
01855 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01856 ;
01857 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01858 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01859 ;
01860 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01861 integer));
01862 e_wsfe();
01863 *info = abs(iinfo);
01864 if (iinfo < 0) {
01865 return 0;
01866 } else {
01867 result[27] = ulpinv;
01868 goto L270;
01869 }
01870 }
01871
01872
01873
01874 temp2 = (n * 2.f - 1.f) * 2.f * ulp * 3.f / .0625f;
01875
01876 temp1 = 0.f;
01877 i__3 = n;
01878 for (j = 1; j <= i__3; ++j) {
01879
01880 r__3 = temp1, r__4 = (r__2 = d4[j] - wr[n - j + 1],
01881 dabs(r__2)) / (abstol + (r__1 = d4[j], dabs(
01882 r__1)));
01883 temp1 = dmax(r__3,r__4);
01884
01885 }
01886
01887 result[27] = temp1 / temp2;
01888
01889 il = (n - 1) * (integer) slarnd_(&c__1, iseed2) + 1;
01890 iu = (n - 1) * (integer) slarnd_(&c__1, iseed2) + 1;
01891 if (iu < il) {
01892 itemp = iu;
01893 iu = il;
01894 il = itemp;
01895 }
01896
01897 if (FALSE_) {
01898 ntest = 28;
01899 abstol = unfl + unfl;
01900 i__3 = *lwork - (n << 1);
01901 sstemr_("V", "I", &n, &sd[1], &se[1], &vl, &vu, &il, &
01902 iu, &m, &wr[1], &z__[z_offset], ldu, &n, &
01903 iwork[1], &tryrac, &work[1], lwork, &iwork[(n
01904 << 1) + 1], &i__3, &iinfo);
01905
01906 if (iinfo != 0) {
01907 io___79.ciunit = *nounit;
01908 s_wsfe(&io___79);
01909 do_fio(&c__1, "SSTEMR(V,I,rel)", (ftnlen)15);
01910 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(
01911 integer));
01912 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer))
01913 ;
01914 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(
01915 integer));
01916 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01917 integer));
01918 e_wsfe();
01919 *info = abs(iinfo);
01920 if (iinfo < 0) {
01921 return 0;
01922 } else {
01923 result[28] = ulpinv;
01924 goto L270;
01925 }
01926 }
01927
01928
01929
01930
01931 temp2 = (n * 2.f - 1.f) * 2.f * ulp * 3.f / .0625f;
01932
01933 temp1 = 0.f;
01934 i__3 = iu;
01935 for (j = il; j <= i__3; ++j) {
01936
01937 r__3 = temp1, r__4 = (r__2 = wr[j - il + 1] - d4[
01938 n - j + 1], dabs(r__2)) / (abstol + (r__1
01939 = wr[j - il + 1], dabs(r__1)));
01940 temp1 = dmax(r__3,r__4);
01941
01942 }
01943
01944 result[28] = temp1 / temp2;
01945 } else {
01946 result[28] = 0.f;
01947 }
01948 } else {
01949 result[27] = 0.f;
01950 result[28] = 0.f;
01951 }
01952
01953
01954
01955
01956
01957 scopy_(&n, &sd[1], &c__1, &d5[1], &c__1);
01958 if (n > 0) {
01959 i__3 = n - 1;
01960 scopy_(&i__3, &se[1], &c__1, &work[1], &c__1);
01961 }
01962 slaset_("Full", &n, &n, &c_b25, &c_b39, &z__[z_offset], ldu);
01963
01964 if (FALSE_) {
01965 ntest = 29;
01966 il = (n - 1) * (integer) slarnd_(&c__1, iseed2) + 1;
01967 iu = (n - 1) * (integer) slarnd_(&c__1, iseed2) + 1;
01968 if (iu < il) {
01969 itemp = iu;
01970 iu = il;
01971 il = itemp;
01972 }
01973 i__3 = *lwork - n;
01974 i__4 = *liwork - (n << 1);
01975 sstemr_("V", "I", &n, &d5[1], &work[1], &vl, &vu, &il, &
01976 iu, &m, &d1[1], &z__[z_offset], ldu, &n, &iwork[1]
01977 , &tryrac, &work[n + 1], &i__3, &iwork[(n << 1) +
01978 1], &i__4, &iinfo);
01979 if (iinfo != 0) {
01980 io___80.ciunit = *nounit;
01981 s_wsfe(&io___80);
01982 do_fio(&c__1, "SSTEMR(V,I)", (ftnlen)11);
01983 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
01984 ;
01985 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
01986 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
01987 ;
01988 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
01989 integer));
01990 e_wsfe();
01991 *info = abs(iinfo);
01992 if (iinfo < 0) {
01993 return 0;
01994 } else {
01995 result[29] = ulpinv;
01996 goto L280;
01997 }
01998 }
01999
02000
02001
02002 sstt22_(&n, &m, &c__0, &sd[1], &se[1], &d1[1], dumma, &
02003 z__[z_offset], ldu, &work[1], &m, &result[29]);
02004
02005
02006
02007
02008
02009 scopy_(&n, &sd[1], &c__1, &d5[1], &c__1);
02010 if (n > 0) {
02011 i__3 = n - 1;
02012 scopy_(&i__3, &se[1], &c__1, &work[1], &c__1);
02013 }
02014
02015 ntest = 31;
02016 i__3 = *lwork - n;
02017 i__4 = *liwork - (n << 1);
02018 sstemr_("N", "I", &n, &d5[1], &work[1], &vl, &vu, &il, &
02019 iu, &m, &d2[1], &z__[z_offset], ldu, &n, &iwork[1]
02020 , &tryrac, &work[n + 1], &i__3, &iwork[(n << 1) +
02021 1], &i__4, &iinfo);
02022 if (iinfo != 0) {
02023 io___81.ciunit = *nounit;
02024 s_wsfe(&io___81);
02025 do_fio(&c__1, "SSTEMR(N,I)", (ftnlen)11);
02026 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
02027 ;
02028 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02029 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
02030 ;
02031 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
02032 integer));
02033 e_wsfe();
02034 *info = abs(iinfo);
02035 if (iinfo < 0) {
02036 return 0;
02037 } else {
02038 result[31] = ulpinv;
02039 goto L280;
02040 }
02041 }
02042
02043
02044
02045 temp1 = 0.f;
02046 temp2 = 0.f;
02047
02048 i__3 = iu - il + 1;
02049 for (j = 1; j <= i__3; ++j) {
02050
02051 r__3 = temp1, r__4 = (r__1 = d1[j], dabs(r__1)), r__3
02052 = max(r__3,r__4), r__4 = (r__2 = d2[j], dabs(
02053 r__2));
02054 temp1 = dmax(r__3,r__4);
02055
02056 r__2 = temp2, r__3 = (r__1 = d1[j] - d2[j], dabs(r__1)
02057 );
02058 temp2 = dmax(r__2,r__3);
02059
02060 }
02061
02062
02063 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
02064 result[31] = temp2 / dmax(r__1,r__2);
02065
02066
02067
02068
02069
02070
02071 scopy_(&n, &sd[1], &c__1, &d5[1], &c__1);
02072 if (n > 0) {
02073 i__3 = n - 1;
02074 scopy_(&i__3, &se[1], &c__1, &work[1], &c__1);
02075 }
02076 slaset_("Full", &n, &n, &c_b25, &c_b39, &z__[z_offset],
02077 ldu);
02078
02079 ntest = 32;
02080
02081 if (n > 0) {
02082 if (il != 1) {
02083
02084 r__1 = (d2[il] - d2[il - 1]) * .5f, r__2 = ulp *
02085 anorm, r__1 = max(r__1,r__2), r__2 =
02086 rtunfl * 2.f;
02087 vl = d2[il] - dmax(r__1,r__2);
02088 } else {
02089
02090 r__1 = (d2[n] - d2[1]) * .5f, r__2 = ulp * anorm,
02091 r__1 = max(r__1,r__2), r__2 = rtunfl *
02092 2.f;
02093 vl = d2[1] - dmax(r__1,r__2);
02094 }
02095 if (iu != n) {
02096
02097 r__1 = (d2[iu + 1] - d2[iu]) * .5f, r__2 = ulp *
02098 anorm, r__1 = max(r__1,r__2), r__2 =
02099 rtunfl * 2.f;
02100 vu = d2[iu] + dmax(r__1,r__2);
02101 } else {
02102
02103 r__1 = (d2[n] - d2[1]) * .5f, r__2 = ulp * anorm,
02104 r__1 = max(r__1,r__2), r__2 = rtunfl *
02105 2.f;
02106 vu = d2[n] + dmax(r__1,r__2);
02107 }
02108 } else {
02109 vl = 0.f;
02110 vu = 1.f;
02111 }
02112
02113 i__3 = *lwork - n;
02114 i__4 = *liwork - (n << 1);
02115 sstemr_("V", "V", &n, &d5[1], &work[1], &vl, &vu, &il, &
02116 iu, &m, &d1[1], &z__[z_offset], ldu, &n, &iwork[1]
02117 , &tryrac, &work[n + 1], &i__3, &iwork[(n << 1) +
02118 1], &i__4, &iinfo);
02119 if (iinfo != 0) {
02120 io___82.ciunit = *nounit;
02121 s_wsfe(&io___82);
02122 do_fio(&c__1, "SSTEMR(V,V)", (ftnlen)11);
02123 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
02124 ;
02125 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02126 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
02127 ;
02128 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
02129 integer));
02130 e_wsfe();
02131 *info = abs(iinfo);
02132 if (iinfo < 0) {
02133 return 0;
02134 } else {
02135 result[32] = ulpinv;
02136 goto L280;
02137 }
02138 }
02139
02140
02141
02142 sstt22_(&n, &m, &c__0, &sd[1], &se[1], &d1[1], dumma, &
02143 z__[z_offset], ldu, &work[1], &m, &result[32]);
02144
02145
02146
02147
02148
02149 scopy_(&n, &sd[1], &c__1, &d5[1], &c__1);
02150 if (n > 0) {
02151 i__3 = n - 1;
02152 scopy_(&i__3, &se[1], &c__1, &work[1], &c__1);
02153 }
02154
02155 ntest = 34;
02156 i__3 = *lwork - n;
02157 i__4 = *liwork - (n << 1);
02158 sstemr_("N", "V", &n, &d5[1], &work[1], &vl, &vu, &il, &
02159 iu, &m, &d2[1], &z__[z_offset], ldu, &n, &iwork[1]
02160 , &tryrac, &work[n + 1], &i__3, &iwork[(n << 1) +
02161 1], &i__4, &iinfo);
02162 if (iinfo != 0) {
02163 io___83.ciunit = *nounit;
02164 s_wsfe(&io___83);
02165 do_fio(&c__1, "SSTEMR(N,V)", (ftnlen)11);
02166 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer))
02167 ;
02168 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02169 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer))
02170 ;
02171 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(
02172 integer));
02173 e_wsfe();
02174 *info = abs(iinfo);
02175 if (iinfo < 0) {
02176 return 0;
02177 } else {
02178 result[34] = ulpinv;
02179 goto L280;
02180 }
02181 }
02182
02183
02184
02185 temp1 = 0.f;
02186 temp2 = 0.f;
02187
02188 i__3 = iu - il + 1;
02189 for (j = 1; j <= i__3; ++j) {
02190
02191 r__3 = temp1, r__4 = (r__1 = d1[j], dabs(r__1)), r__3
02192 = max(r__3,r__4), r__4 = (r__2 = d2[j], dabs(
02193 r__2));
02194 temp1 = dmax(r__3,r__4);
02195
02196 r__2 = temp2, r__3 = (r__1 = d1[j] - d2[j], dabs(r__1)
02197 );
02198 temp2 = dmax(r__2,r__3);
02199
02200 }
02201
02202
02203 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
02204 result[34] = temp2 / dmax(r__1,r__2);
02205 } else {
02206 result[29] = 0.f;
02207 result[30] = 0.f;
02208 result[31] = 0.f;
02209 result[32] = 0.f;
02210 result[33] = 0.f;
02211 result[34] = 0.f;
02212 }
02213
02214
02215
02216
02217
02218
02219 scopy_(&n, &sd[1], &c__1, &d5[1], &c__1);
02220 if (n > 0) {
02221 i__3 = n - 1;
02222 scopy_(&i__3, &se[1], &c__1, &work[1], &c__1);
02223 }
02224
02225 ntest = 35;
02226
02227 i__3 = *lwork - n;
02228 i__4 = *liwork - (n << 1);
02229 sstemr_("V", "A", &n, &d5[1], &work[1], &vl, &vu, &il, &iu, &
02230 m, &d1[1], &z__[z_offset], ldu, &n, &iwork[1], &
02231 tryrac, &work[n + 1], &i__3, &iwork[(n << 1) + 1], &
02232 i__4, &iinfo);
02233 if (iinfo != 0) {
02234 io___84.ciunit = *nounit;
02235 s_wsfe(&io___84);
02236 do_fio(&c__1, "SSTEMR(V,A)", (ftnlen)11);
02237 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02238 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02239 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02240 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02241 ;
02242 e_wsfe();
02243 *info = abs(iinfo);
02244 if (iinfo < 0) {
02245 return 0;
02246 } else {
02247 result[35] = ulpinv;
02248 goto L280;
02249 }
02250 }
02251
02252
02253
02254 sstt22_(&n, &m, &c__0, &sd[1], &se[1], &d1[1], dumma, &z__[
02255 z_offset], ldu, &work[1], &m, &result[35]);
02256
02257
02258
02259
02260
02261 scopy_(&n, &sd[1], &c__1, &d5[1], &c__1);
02262 if (n > 0) {
02263 i__3 = n - 1;
02264 scopy_(&i__3, &se[1], &c__1, &work[1], &c__1);
02265 }
02266
02267 ntest = 37;
02268 i__3 = *lwork - n;
02269 i__4 = *liwork - (n << 1);
02270 sstemr_("N", "A", &n, &d5[1], &work[1], &vl, &vu, &il, &iu, &
02271 m, &d2[1], &z__[z_offset], ldu, &n, &iwork[1], &
02272 tryrac, &work[n + 1], &i__3, &iwork[(n << 1) + 1], &
02273 i__4, &iinfo);
02274 if (iinfo != 0) {
02275 io___85.ciunit = *nounit;
02276 s_wsfe(&io___85);
02277 do_fio(&c__1, "SSTEMR(N,A)", (ftnlen)11);
02278 do_fio(&c__1, (char *)&iinfo, (ftnlen)sizeof(integer));
02279 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02280 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02281 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02282 ;
02283 e_wsfe();
02284 *info = abs(iinfo);
02285 if (iinfo < 0) {
02286 return 0;
02287 } else {
02288 result[37] = ulpinv;
02289 goto L280;
02290 }
02291 }
02292
02293
02294
02295 temp1 = 0.f;
02296 temp2 = 0.f;
02297
02298 i__3 = n;
02299 for (j = 1; j <= i__3; ++j) {
02300
02301 r__3 = temp1, r__4 = (r__1 = d1[j], dabs(r__1)), r__3 =
02302 max(r__3,r__4), r__4 = (r__2 = d2[j], dabs(r__2));
02303 temp1 = dmax(r__3,r__4);
02304
02305 r__2 = temp2, r__3 = (r__1 = d1[j] - d2[j], dabs(r__1));
02306 temp2 = dmax(r__2,r__3);
02307
02308 }
02309
02310
02311 r__1 = unfl, r__2 = ulp * dmax(temp1,temp2);
02312 result[37] = temp2 / dmax(r__1,r__2);
02313 }
02314 L270:
02315 L280:
02316 ntestt += ntest;
02317
02318
02319
02320
02321
02322
02323 i__3 = ntest;
02324 for (jr = 1; jr <= i__3; ++jr) {
02325 if (result[jr] >= *thresh) {
02326
02327
02328
02329
02330 if (nerrs == 0) {
02331 io___86.ciunit = *nounit;
02332 s_wsfe(&io___86);
02333 do_fio(&c__1, "SST", (ftnlen)3);
02334 e_wsfe();
02335 io___87.ciunit = *nounit;
02336 s_wsfe(&io___87);
02337 e_wsfe();
02338 io___88.ciunit = *nounit;
02339 s_wsfe(&io___88);
02340 e_wsfe();
02341 io___89.ciunit = *nounit;
02342 s_wsfe(&io___89);
02343 do_fio(&c__1, "Symmetric", (ftnlen)9);
02344 e_wsfe();
02345 io___90.ciunit = *nounit;
02346 s_wsfe(&io___90);
02347 e_wsfe();
02348
02349
02350
02351 io___91.ciunit = *nounit;
02352 s_wsfe(&io___91);
02353 e_wsfe();
02354 }
02355 ++nerrs;
02356 io___92.ciunit = *nounit;
02357 s_wsfe(&io___92);
02358 do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
02359 do_fio(&c__4, (char *)&ioldsd[0], (ftnlen)sizeof(integer))
02360 ;
02361 do_fio(&c__1, (char *)&jtype, (ftnlen)sizeof(integer));
02362 do_fio(&c__1, (char *)&jr, (ftnlen)sizeof(integer));
02363 do_fio(&c__1, (char *)&result[jr], (ftnlen)sizeof(real));
02364 e_wsfe();
02365 }
02366
02367 }
02368 L300:
02369 ;
02370 }
02371
02372 }
02373
02374
02375
02376 slasum_("SST", nounit, &nerrs, &ntestt);
02377 return 0;
02378
02379
02380
02381
02382
02383
02384
02385
02386
02387
02388
02389 }