00001 SUBROUTINE SDRVST( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
00002 $ NOUNIT, A, LDA, D1, D2, D3, D4, EVEIGS, WA1,
00003 $ WA2, WA3, U, LDU, V, TAU, Z, WORK, LWORK,
00004 $ IWORK, LIWORK, RESULT, INFO )
00005
00006
00007
00008
00009
00010
00011 INTEGER INFO, LDA, LDU, LIWORK, LWORK, NOUNIT, NSIZES,
00012 $ NTYPES
00013 REAL THRESH
00014
00015
00016 LOGICAL DOTYPE( * )
00017 INTEGER ISEED( 4 ), IWORK( * ), NN( * )
00018 REAL A( LDA, * ), D1( * ), D2( * ), D3( * ),
00019 $ D4( * ), EVEIGS( * ), RESULT( * ), TAU( * ),
00020 $ U( LDU, * ), V( LDU, * ), WA1( * ), WA2( * ),
00021 $ WA3( * ), WORK( * ), Z( LDU, * )
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105
00106
00107
00108
00109
00110
00111
00112
00113
00114
00115
00116
00117
00118
00119
00120
00121
00122
00123
00124
00125
00126
00127
00128
00129
00130
00131
00132
00133
00134
00135
00136
00137
00138
00139
00140
00141
00142
00143
00144
00145
00146
00147
00148
00149
00150
00151
00152
00153
00154
00155
00156
00157
00158
00159
00160
00161
00162
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 REAL ZERO, ONE, TWO, TEN
00431 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, TWO = 2.0E0,
00432 $ TEN = 10.0E0 )
00433 REAL HALF
00434 PARAMETER ( HALF = 0.5E0 )
00435 INTEGER MAXTYP
00436 PARAMETER ( MAXTYP = 18 )
00437
00438
00439 LOGICAL BADNN
00440 CHARACTER UPLO
00441 INTEGER I, IDIAG, IHBW, IINFO, IL, IMODE, INDX, IROW,
00442 $ ITEMP, ITYPE, IU, IUPLO, J, J1, J2, JCOL,
00443 $ JSIZE, JTYPE, KD, LGN, LIWEDC, LWEDC, M, M2,
00444 $ M3, MTYPES, N, NERRS, NMATS, NMAX, NTEST,
00445 $ NTESTT
00446 REAL ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
00447 $ RTUNFL, TEMP1, TEMP2, TEMP3, ULP, ULPINV, UNFL,
00448 $ VL, VU
00449
00450
00451 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
00452 $ ISEED3( 4 ), KMAGN( MAXTYP ), KMODE( MAXTYP ),
00453 $ KTYPE( MAXTYP )
00454
00455
00456 REAL SLAMCH, SLARND, SSXT1
00457 EXTERNAL SLAMCH, SLARND, SSXT1
00458
00459
00460 EXTERNAL ALASVM, SLABAD, SLACPY, SLAFTS, SLASET, SLATMR,
00461 $ SLATMS, SSBEV, SSBEVD, SSBEVX, SSPEV, SSPEVD,
00462 $ SSPEVX, SSTEV, SSTEVD, SSTEVR, SSTEVX, SSTT21,
00463 $ SSTT22, SSYEV, SSYEVD, SSYEVR, SSYEVX, SSYT21,
00464 $ SSYT22, XERBLA
00465
00466
00467 CHARACTER*32 SRNAMT
00468
00469
00470 COMMON / SRNAMC / SRNAMT
00471
00472
00473 INTRINSIC ABS, INT, LOG, MAX, MIN, REAL, SQRT
00474
00475
00476 DATA KTYPE / 1, 2, 5*4, 5*5, 3*8, 3*9 /
00477 DATA KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
00478 $ 2, 3, 1, 2, 3 /
00479 DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
00480 $ 0, 0, 4, 4, 4 /
00481
00482
00483
00484
00485
00486 VL = ZERO
00487 VU = ZERO
00488
00489
00490
00491 NTESTT = 0
00492 INFO = 0
00493
00494 BADNN = .FALSE.
00495 NMAX = 1
00496 DO 10 J = 1, NSIZES
00497 NMAX = MAX( NMAX, NN( J ) )
00498 IF( NN( J ).LT.0 )
00499 $ BADNN = .TRUE.
00500 10 CONTINUE
00501
00502
00503
00504 IF( NSIZES.LT.0 ) THEN
00505 INFO = -1
00506 ELSE IF( BADNN ) THEN
00507 INFO = -2
00508 ELSE IF( NTYPES.LT.0 ) THEN
00509 INFO = -3
00510 ELSE IF( LDA.LT.NMAX ) THEN
00511 INFO = -9
00512 ELSE IF( LDU.LT.NMAX ) THEN
00513 INFO = -16
00514 ELSE IF( 2*MAX( 2, NMAX )**2.GT.LWORK ) THEN
00515 INFO = -21
00516 END IF
00517
00518 IF( INFO.NE.0 ) THEN
00519 CALL XERBLA( 'SDRVST', -INFO )
00520 RETURN
00521 END IF
00522
00523
00524
00525 IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
00526 $ RETURN
00527
00528
00529
00530 UNFL = SLAMCH( 'Safe minimum' )
00531 OVFL = SLAMCH( 'Overflow' )
00532 CALL SLABAD( UNFL, OVFL )
00533 ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
00534 ULPINV = ONE / ULP
00535 RTUNFL = SQRT( UNFL )
00536 RTOVFL = SQRT( OVFL )
00537
00538
00539
00540 DO 20 I = 1, 4
00541 ISEED2( I ) = ISEED( I )
00542 ISEED3( I ) = ISEED( I )
00543 20 CONTINUE
00544
00545 NERRS = 0
00546 NMATS = 0
00547
00548
00549 DO 1740 JSIZE = 1, NSIZES
00550 N = NN( JSIZE )
00551 IF( N.GT.0 ) THEN
00552 LGN = INT( LOG( REAL( N ) ) / LOG( TWO ) )
00553 IF( 2**LGN.LT.N )
00554 $ LGN = LGN + 1
00555 IF( 2**LGN.LT.N )
00556 $ LGN = LGN + 1
00557 LWEDC = 1 + 4*N + 2*N*LGN + 4*N**2
00558
00559 LIWEDC = 3 + 5*N
00560 ELSE
00561 LWEDC = 9
00562
00563 LIWEDC = 8
00564 END IF
00565 ANINV = ONE / REAL( MAX( 1, N ) )
00566
00567 IF( NSIZES.NE.1 ) THEN
00568 MTYPES = MIN( MAXTYP, NTYPES )
00569 ELSE
00570 MTYPES = MIN( MAXTYP+1, NTYPES )
00571 END IF
00572
00573 DO 1730 JTYPE = 1, MTYPES
00574
00575 IF( .NOT.DOTYPE( JTYPE ) )
00576 $ GO TO 1730
00577 NMATS = NMATS + 1
00578 NTEST = 0
00579
00580 DO 30 J = 1, 4
00581 IOLDSD( J ) = ISEED( J )
00582 30 CONTINUE
00583
00584
00585
00586
00587
00588
00589
00590
00591
00592
00593
00594
00595
00596
00597
00598
00599 IF( MTYPES.GT.MAXTYP )
00600 $ GO TO 110
00601
00602 ITYPE = KTYPE( JTYPE )
00603 IMODE = KMODE( JTYPE )
00604
00605
00606
00607 GO TO ( 40, 50, 60 )KMAGN( JTYPE )
00608
00609 40 CONTINUE
00610 ANORM = ONE
00611 GO TO 70
00612
00613 50 CONTINUE
00614 ANORM = ( RTOVFL*ULP )*ANINV
00615 GO TO 70
00616
00617 60 CONTINUE
00618 ANORM = RTUNFL*N*ULPINV
00619 GO TO 70
00620
00621 70 CONTINUE
00622
00623 CALL SLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
00624 IINFO = 0
00625 COND = ULPINV
00626
00627
00628
00629
00630
00631 IF( ITYPE.EQ.1 ) THEN
00632 IINFO = 0
00633
00634 ELSE IF( ITYPE.EQ.2 ) THEN
00635
00636
00637
00638 DO 80 JCOL = 1, N
00639 A( JCOL, JCOL ) = ANORM
00640 80 CONTINUE
00641
00642 ELSE IF( ITYPE.EQ.4 ) THEN
00643
00644
00645
00646 CALL SLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
00647 $ ANORM, 0, 0, 'N', A, LDA, WORK( N+1 ),
00648 $ IINFO )
00649
00650 ELSE IF( ITYPE.EQ.5 ) THEN
00651
00652
00653
00654 CALL SLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
00655 $ ANORM, N, N, 'N', A, LDA, WORK( N+1 ),
00656 $ IINFO )
00657
00658 ELSE IF( ITYPE.EQ.7 ) THEN
00659
00660
00661
00662 IDUMMA( 1 ) = 1
00663 CALL SLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE,
00664 $ 'T', 'N', WORK( N+1 ), 1, ONE,
00665 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
00666 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
00667
00668 ELSE IF( ITYPE.EQ.8 ) THEN
00669
00670
00671
00672 IDUMMA( 1 ) = 1
00673 CALL SLATMR( N, N, 'S', ISEED, 'S', WORK, 6, ONE, ONE,
00674 $ 'T', 'N', WORK( N+1 ), 1, ONE,
00675 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
00676 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
00677
00678 ELSE IF( ITYPE.EQ.9 ) THEN
00679
00680
00681
00682 IHBW = INT( ( N-1 )*SLARND( 1, ISEED3 ) )
00683 CALL SLATMS( N, N, 'S', ISEED, 'S', WORK, IMODE, COND,
00684 $ ANORM, IHBW, IHBW, 'Z', U, LDU, WORK( N+1 ),
00685 $ IINFO )
00686
00687
00688
00689 CALL SLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA )
00690 DO 100 IDIAG = -IHBW, IHBW
00691 IROW = IHBW - IDIAG + 1
00692 J1 = MAX( 1, IDIAG+1 )
00693 J2 = MIN( N, N+IDIAG )
00694 DO 90 J = J1, J2
00695 I = J - IDIAG
00696 A( I, J ) = U( IROW, J )
00697 90 CONTINUE
00698 100 CONTINUE
00699 ELSE
00700 IINFO = 1
00701 END IF
00702
00703 IF( IINFO.NE.0 ) THEN
00704 WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
00705 $ IOLDSD
00706 INFO = ABS( IINFO )
00707 RETURN
00708 END IF
00709
00710 110 CONTINUE
00711
00712 ABSTOL = UNFL + UNFL
00713 IF( N.LE.1 ) THEN
00714 IL = 1
00715 IU = N
00716 ELSE
00717 IL = 1 + INT( ( N-1 )*SLARND( 1, ISEED2 ) )
00718 IU = 1 + INT( ( N-1 )*SLARND( 1, ISEED2 ) )
00719 IF( IL.GT.IU ) THEN
00720 ITEMP = IL
00721 IL = IU
00722 IU = ITEMP
00723 END IF
00724 END IF
00725
00726
00727
00728 IF( JTYPE.LE.7 ) THEN
00729 NTEST = 1
00730 DO 120 I = 1, N
00731 D1( I ) = REAL( A( I, I ) )
00732 120 CONTINUE
00733 DO 130 I = 1, N - 1
00734 D2( I ) = REAL( A( I+1, I ) )
00735 130 CONTINUE
00736 SRNAMT = 'SSTEV'
00737 CALL SSTEV( 'V', N, D1, D2, Z, LDU, WORK, IINFO )
00738 IF( IINFO.NE.0 ) THEN
00739 WRITE( NOUNIT, FMT = 9999 )'SSTEV(V)', IINFO, N,
00740 $ JTYPE, IOLDSD
00741 INFO = ABS( IINFO )
00742 IF( IINFO.LT.0 ) THEN
00743 RETURN
00744 ELSE
00745 RESULT( 1 ) = ULPINV
00746 RESULT( 2 ) = ULPINV
00747 RESULT( 3 ) = ULPINV
00748 GO TO 180
00749 END IF
00750 END IF
00751
00752
00753
00754 DO 140 I = 1, N
00755 D3( I ) = REAL( A( I, I ) )
00756 140 CONTINUE
00757 DO 150 I = 1, N - 1
00758 D4( I ) = REAL( A( I+1, I ) )
00759 150 CONTINUE
00760 CALL SSTT21( N, 0, D3, D4, D1, D2, Z, LDU, WORK,
00761 $ RESULT( 1 ) )
00762
00763 NTEST = 3
00764 DO 160 I = 1, N - 1
00765 D4( I ) = REAL( A( I+1, I ) )
00766 160 CONTINUE
00767 SRNAMT = 'SSTEV'
00768 CALL SSTEV( 'N', N, D3, D4, Z, LDU, WORK, IINFO )
00769 IF( IINFO.NE.0 ) THEN
00770 WRITE( NOUNIT, FMT = 9999 )'SSTEV(N)', IINFO, N,
00771 $ JTYPE, IOLDSD
00772 INFO = ABS( IINFO )
00773 IF( IINFO.LT.0 ) THEN
00774 RETURN
00775 ELSE
00776 RESULT( 3 ) = ULPINV
00777 GO TO 180
00778 END IF
00779 END IF
00780
00781
00782
00783 TEMP1 = ZERO
00784 TEMP2 = ZERO
00785 DO 170 J = 1, N
00786 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
00787 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
00788 170 CONTINUE
00789 RESULT( 3 ) = TEMP2 / MAX( UNFL,
00790 $ ULP*MAX( TEMP1, TEMP2 ) )
00791
00792 180 CONTINUE
00793
00794 NTEST = 4
00795 DO 190 I = 1, N
00796 EVEIGS( I ) = D3( I )
00797 D1( I ) = REAL( A( I, I ) )
00798 190 CONTINUE
00799 DO 200 I = 1, N - 1
00800 D2( I ) = REAL( A( I+1, I ) )
00801 200 CONTINUE
00802 SRNAMT = 'SSTEVX'
00803 CALL SSTEVX( 'V', 'A', N, D1, D2, VL, VU, IL, IU, ABSTOL,
00804 $ M, WA1, Z, LDU, WORK, IWORK, IWORK( 5*N+1 ),
00805 $ IINFO )
00806 IF( IINFO.NE.0 ) THEN
00807 WRITE( NOUNIT, FMT = 9999 )'SSTEVX(V,A)', IINFO, N,
00808 $ JTYPE, IOLDSD
00809 INFO = ABS( IINFO )
00810 IF( IINFO.LT.0 ) THEN
00811 RETURN
00812 ELSE
00813 RESULT( 4 ) = ULPINV
00814 RESULT( 5 ) = ULPINV
00815 RESULT( 6 ) = ULPINV
00816 GO TO 250
00817 END IF
00818 END IF
00819 IF( N.GT.0 ) THEN
00820 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
00821 ELSE
00822 TEMP3 = ZERO
00823 END IF
00824
00825
00826
00827 DO 210 I = 1, N
00828 D3( I ) = REAL( A( I, I ) )
00829 210 CONTINUE
00830 DO 220 I = 1, N - 1
00831 D4( I ) = REAL( A( I+1, I ) )
00832 220 CONTINUE
00833 CALL SSTT21( N, 0, D3, D4, WA1, D2, Z, LDU, WORK,
00834 $ RESULT( 4 ) )
00835
00836 NTEST = 6
00837 DO 230 I = 1, N - 1
00838 D4( I ) = REAL( A( I+1, I ) )
00839 230 CONTINUE
00840 SRNAMT = 'SSTEVX'
00841 CALL SSTEVX( 'N', 'A', N, D3, D4, VL, VU, IL, IU, ABSTOL,
00842 $ M2, WA2, Z, LDU, WORK, IWORK,
00843 $ IWORK( 5*N+1 ), IINFO )
00844 IF( IINFO.NE.0 ) THEN
00845 WRITE( NOUNIT, FMT = 9999 )'SSTEVX(N,A)', IINFO, N,
00846 $ JTYPE, IOLDSD
00847 INFO = ABS( IINFO )
00848 IF( IINFO.LT.0 ) THEN
00849 RETURN
00850 ELSE
00851 RESULT( 6 ) = ULPINV
00852 GO TO 250
00853 END IF
00854 END IF
00855
00856
00857
00858 TEMP1 = ZERO
00859 TEMP2 = ZERO
00860 DO 240 J = 1, N
00861 TEMP1 = MAX( TEMP1, ABS( WA2( J ) ),
00862 $ ABS( EVEIGS( J ) ) )
00863 TEMP2 = MAX( TEMP2, ABS( WA2( J )-EVEIGS( J ) ) )
00864 240 CONTINUE
00865 RESULT( 6 ) = TEMP2 / MAX( UNFL,
00866 $ ULP*MAX( TEMP1, TEMP2 ) )
00867
00868 250 CONTINUE
00869
00870 NTEST = 7
00871 DO 260 I = 1, N
00872 D1( I ) = REAL( A( I, I ) )
00873 260 CONTINUE
00874 DO 270 I = 1, N - 1
00875 D2( I ) = REAL( A( I+1, I ) )
00876 270 CONTINUE
00877 SRNAMT = 'SSTEVR'
00878 CALL SSTEVR( 'V', 'A', N, D1, D2, VL, VU, IL, IU, ABSTOL,
00879 $ M, WA1, Z, LDU, IWORK, WORK, LWORK,
00880 $ IWORK(2*N+1), LIWORK-2*N, IINFO )
00881 IF( IINFO.NE.0 ) THEN
00882 WRITE( NOUNIT, FMT = 9999 )'SSTEVR(V,A)', IINFO, N,
00883 $ JTYPE, IOLDSD
00884 INFO = ABS( IINFO )
00885 IF( IINFO.LT.0 ) THEN
00886 RETURN
00887 ELSE
00888 RESULT( 7 ) = ULPINV
00889 RESULT( 8 ) = ULPINV
00890 GO TO 320
00891 END IF
00892 END IF
00893 IF( N.GT.0 ) THEN
00894 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
00895 ELSE
00896 TEMP3 = ZERO
00897 END IF
00898
00899
00900
00901 DO 280 I = 1, N
00902 D3( I ) = REAL( A( I, I ) )
00903 280 CONTINUE
00904 DO 290 I = 1, N - 1
00905 D4( I ) = REAL( A( I+1, I ) )
00906 290 CONTINUE
00907 CALL SSTT21( N, 0, D3, D4, WA1, D2, Z, LDU, WORK,
00908 $ RESULT( 7 ) )
00909
00910 NTEST = 9
00911 DO 300 I = 1, N - 1
00912 D4( I ) = REAL( A( I+1, I ) )
00913 300 CONTINUE
00914 SRNAMT = 'SSTEVR'
00915 CALL SSTEVR( 'N', 'A', N, D3, D4, VL, VU, IL, IU, ABSTOL,
00916 $ M2, WA2, Z, LDU, IWORK, WORK, LWORK,
00917 $ IWORK(2*N+1), LIWORK-2*N, IINFO )
00918 IF( IINFO.NE.0 ) THEN
00919 WRITE( NOUNIT, FMT = 9999 )'SSTEVR(N,A)', IINFO, N,
00920 $ JTYPE, IOLDSD
00921 INFO = ABS( IINFO )
00922 IF( IINFO.LT.0 ) THEN
00923 RETURN
00924 ELSE
00925 RESULT( 9 ) = ULPINV
00926 GO TO 320
00927 END IF
00928 END IF
00929
00930
00931
00932 TEMP1 = ZERO
00933 TEMP2 = ZERO
00934 DO 310 J = 1, N
00935 TEMP1 = MAX( TEMP1, ABS( WA2( J ) ),
00936 $ ABS( EVEIGS( J ) ) )
00937 TEMP2 = MAX( TEMP2, ABS( WA2( J )-EVEIGS( J ) ) )
00938 310 CONTINUE
00939 RESULT( 9 ) = TEMP2 / MAX( UNFL,
00940 $ ULP*MAX( TEMP1, TEMP2 ) )
00941
00942 320 CONTINUE
00943
00944
00945 NTEST = 10
00946 DO 330 I = 1, N
00947 D1( I ) = REAL( A( I, I ) )
00948 330 CONTINUE
00949 DO 340 I = 1, N - 1
00950 D2( I ) = REAL( A( I+1, I ) )
00951 340 CONTINUE
00952 SRNAMT = 'SSTEVX'
00953 CALL SSTEVX( 'V', 'I', N, D1, D2, VL, VU, IL, IU, ABSTOL,
00954 $ M2, WA2, Z, LDU, WORK, IWORK,
00955 $ IWORK( 5*N+1 ), IINFO )
00956 IF( IINFO.NE.0 ) THEN
00957 WRITE( NOUNIT, FMT = 9999 )'SSTEVX(V,I)', IINFO, N,
00958 $ JTYPE, IOLDSD
00959 INFO = ABS( IINFO )
00960 IF( IINFO.LT.0 ) THEN
00961 RETURN
00962 ELSE
00963 RESULT( 10 ) = ULPINV
00964 RESULT( 11 ) = ULPINV
00965 RESULT( 12 ) = ULPINV
00966 GO TO 380
00967 END IF
00968 END IF
00969
00970
00971
00972 DO 350 I = 1, N
00973 D3( I ) = REAL( A( I, I ) )
00974 350 CONTINUE
00975 DO 360 I = 1, N - 1
00976 D4( I ) = REAL( A( I+1, I ) )
00977 360 CONTINUE
00978 CALL SSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK,
00979 $ MAX( 1, M2 ), RESULT( 10 ) )
00980
00981
00982 NTEST = 12
00983 DO 370 I = 1, N - 1
00984 D4( I ) = REAL( A( I+1, I ) )
00985 370 CONTINUE
00986 SRNAMT = 'SSTEVX'
00987 CALL SSTEVX( 'N', 'I', N, D3, D4, VL, VU, IL, IU, ABSTOL,
00988 $ M3, WA3, Z, LDU, WORK, IWORK,
00989 $ IWORK( 5*N+1 ), IINFO )
00990 IF( IINFO.NE.0 ) THEN
00991 WRITE( NOUNIT, FMT = 9999 )'SSTEVX(N,I)', IINFO, N,
00992 $ JTYPE, IOLDSD
00993 INFO = ABS( IINFO )
00994 IF( IINFO.LT.0 ) THEN
00995 RETURN
00996 ELSE
00997 RESULT( 12 ) = ULPINV
00998 GO TO 380
00999 END IF
01000 END IF
01001
01002
01003
01004 TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
01005 TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
01006 RESULT( 12 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, ULP*TEMP3 )
01007
01008 380 CONTINUE
01009
01010 NTEST = 12
01011 IF( N.GT.0 ) THEN
01012 IF( IL.NE.1 ) THEN
01013 VL = WA1( IL ) - MAX( HALF*
01014 $ ( WA1( IL )-WA1( IL-1 ) ), TEN*ULP*TEMP3,
01015 $ TEN*RTUNFL )
01016 ELSE
01017 VL = WA1( 1 ) - MAX( HALF*( WA1( N )-WA1( 1 ) ),
01018 $ TEN*ULP*TEMP3, TEN*RTUNFL )
01019 END IF
01020 IF( IU.NE.N ) THEN
01021 VU = WA1( IU ) + MAX( HALF*
01022 $ ( WA1( IU+1 )-WA1( IU ) ), TEN*ULP*TEMP3,
01023 $ TEN*RTUNFL )
01024 ELSE
01025 VU = WA1( N ) + MAX( HALF*( WA1( N )-WA1( 1 ) ),
01026 $ TEN*ULP*TEMP3, TEN*RTUNFL )
01027 END IF
01028 ELSE
01029 VL = ZERO
01030 VU = ONE
01031 END IF
01032
01033 DO 390 I = 1, N
01034 D1( I ) = REAL( A( I, I ) )
01035 390 CONTINUE
01036 DO 400 I = 1, N - 1
01037 D2( I ) = REAL( A( I+1, I ) )
01038 400 CONTINUE
01039 SRNAMT = 'SSTEVX'
01040 CALL SSTEVX( 'V', 'V', N, D1, D2, VL, VU, IL, IU, ABSTOL,
01041 $ M2, WA2, Z, LDU, WORK, IWORK,
01042 $ IWORK( 5*N+1 ), IINFO )
01043 IF( IINFO.NE.0 ) THEN
01044 WRITE( NOUNIT, FMT = 9999 )'SSTEVX(V,V)', IINFO, N,
01045 $ JTYPE, IOLDSD
01046 INFO = ABS( IINFO )
01047 IF( IINFO.LT.0 ) THEN
01048 RETURN
01049 ELSE
01050 RESULT( 13 ) = ULPINV
01051 RESULT( 14 ) = ULPINV
01052 RESULT( 15 ) = ULPINV
01053 GO TO 440
01054 END IF
01055 END IF
01056
01057 IF( M2.EQ.0 .AND. N.GT.0 ) THEN
01058 RESULT( 13 ) = ULPINV
01059 RESULT( 14 ) = ULPINV
01060 RESULT( 15 ) = ULPINV
01061 GO TO 440
01062 END IF
01063
01064
01065
01066 DO 410 I = 1, N
01067 D3( I ) = REAL( A( I, I ) )
01068 410 CONTINUE
01069 DO 420 I = 1, N - 1
01070 D4( I ) = REAL( A( I+1, I ) )
01071 420 CONTINUE
01072 CALL SSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK,
01073 $ MAX( 1, M2 ), RESULT( 13 ) )
01074
01075 NTEST = 15
01076 DO 430 I = 1, N - 1
01077 D4( I ) = REAL( A( I+1, I ) )
01078 430 CONTINUE
01079 SRNAMT = 'SSTEVX'
01080 CALL SSTEVX( 'N', 'V', N, D3, D4, VL, VU, IL, IU, ABSTOL,
01081 $ M3, WA3, Z, LDU, WORK, IWORK,
01082 $ IWORK( 5*N+1 ), IINFO )
01083 IF( IINFO.NE.0 ) THEN
01084 WRITE( NOUNIT, FMT = 9999 )'SSTEVX(N,V)', IINFO, N,
01085 $ JTYPE, IOLDSD
01086 INFO = ABS( IINFO )
01087 IF( IINFO.LT.0 ) THEN
01088 RETURN
01089 ELSE
01090 RESULT( 15 ) = ULPINV
01091 GO TO 440
01092 END IF
01093 END IF
01094
01095
01096
01097 TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
01098 TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
01099 RESULT( 15 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, TEMP3*ULP )
01100
01101 440 CONTINUE
01102
01103 NTEST = 16
01104 DO 450 I = 1, N
01105 D1( I ) = REAL( A( I, I ) )
01106 450 CONTINUE
01107 DO 460 I = 1, N - 1
01108 D2( I ) = REAL( A( I+1, I ) )
01109 460 CONTINUE
01110 SRNAMT = 'SSTEVD'
01111 CALL SSTEVD( 'V', N, D1, D2, Z, LDU, WORK, LWEDC, IWORK,
01112 $ LIWEDC, IINFO )
01113 IF( IINFO.NE.0 ) THEN
01114 WRITE( NOUNIT, FMT = 9999 )'SSTEVD(V)', IINFO, N,
01115 $ JTYPE, IOLDSD
01116 INFO = ABS( IINFO )
01117 IF( IINFO.LT.0 ) THEN
01118 RETURN
01119 ELSE
01120 RESULT( 16 ) = ULPINV
01121 RESULT( 17 ) = ULPINV
01122 RESULT( 18 ) = ULPINV
01123 GO TO 510
01124 END IF
01125 END IF
01126
01127
01128
01129 DO 470 I = 1, N
01130 D3( I ) = REAL( A( I, I ) )
01131 470 CONTINUE
01132 DO 480 I = 1, N - 1
01133 D4( I ) = REAL( A( I+1, I ) )
01134 480 CONTINUE
01135 CALL SSTT21( N, 0, D3, D4, D1, D2, Z, LDU, WORK,
01136 $ RESULT( 16 ) )
01137
01138 NTEST = 18
01139 DO 490 I = 1, N - 1
01140 D4( I ) = REAL( A( I+1, I ) )
01141 490 CONTINUE
01142 SRNAMT = 'SSTEVD'
01143 CALL SSTEVD( 'N', N, D3, D4, Z, LDU, WORK, LWEDC, IWORK,
01144 $ LIWEDC, IINFO )
01145 IF( IINFO.NE.0 ) THEN
01146 WRITE( NOUNIT, FMT = 9999 )'SSTEVD(N)', IINFO, N,
01147 $ JTYPE, IOLDSD
01148 INFO = ABS( IINFO )
01149 IF( IINFO.LT.0 ) THEN
01150 RETURN
01151 ELSE
01152 RESULT( 18 ) = ULPINV
01153 GO TO 510
01154 END IF
01155 END IF
01156
01157
01158
01159 TEMP1 = ZERO
01160 TEMP2 = ZERO
01161 DO 500 J = 1, N
01162 TEMP1 = MAX( TEMP1, ABS( EVEIGS( J ) ),
01163 $ ABS( D3( J ) ) )
01164 TEMP2 = MAX( TEMP2, ABS( EVEIGS( J )-D3( J ) ) )
01165 500 CONTINUE
01166 RESULT( 18 ) = TEMP2 / MAX( UNFL,
01167 $ ULP*MAX( TEMP1, TEMP2 ) )
01168
01169 510 CONTINUE
01170
01171 NTEST = 19
01172 DO 520 I = 1, N
01173 D1( I ) = REAL( A( I, I ) )
01174 520 CONTINUE
01175 DO 530 I = 1, N - 1
01176 D2( I ) = REAL( A( I+1, I ) )
01177 530 CONTINUE
01178 SRNAMT = 'SSTEVR'
01179 CALL SSTEVR( 'V', 'I', N, D1, D2, VL, VU, IL, IU, ABSTOL,
01180 $ M2, WA2, Z, LDU, IWORK, WORK, LWORK,
01181 $ IWORK(2*N+1), LIWORK-2*N, IINFO )
01182 IF( IINFO.NE.0 ) THEN
01183 WRITE( NOUNIT, FMT = 9999 )'SSTEVR(V,I)', IINFO, N,
01184 $ JTYPE, IOLDSD
01185 INFO = ABS( IINFO )
01186 IF( IINFO.LT.0 ) THEN
01187 RETURN
01188 ELSE
01189 RESULT( 19 ) = ULPINV
01190 RESULT( 20 ) = ULPINV
01191 RESULT( 21 ) = ULPINV
01192 GO TO 570
01193 END IF
01194 END IF
01195
01196
01197
01198 DO 540 I = 1, N
01199 D3( I ) = REAL( A( I, I ) )
01200 540 CONTINUE
01201 DO 550 I = 1, N - 1
01202 D4( I ) = REAL( A( I+1, I ) )
01203 550 CONTINUE
01204 CALL SSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK,
01205 $ MAX( 1, M2 ), RESULT( 19 ) )
01206
01207
01208 NTEST = 21
01209 DO 560 I = 1, N - 1
01210 D4( I ) = REAL( A( I+1, I ) )
01211 560 CONTINUE
01212 SRNAMT = 'SSTEVR'
01213 CALL SSTEVR( 'N', 'I', N, D3, D4, VL, VU, IL, IU, ABSTOL,
01214 $ M3, WA3, Z, LDU, IWORK, WORK, LWORK,
01215 $ IWORK(2*N+1), LIWORK-2*N, IINFO )
01216 IF( IINFO.NE.0 ) THEN
01217 WRITE( NOUNIT, FMT = 9999 )'SSTEVR(N,I)', IINFO, N,
01218 $ JTYPE, IOLDSD
01219 INFO = ABS( IINFO )
01220 IF( IINFO.LT.0 ) THEN
01221 RETURN
01222 ELSE
01223 RESULT( 21 ) = ULPINV
01224 GO TO 570
01225 END IF
01226 END IF
01227
01228
01229
01230 TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
01231 TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
01232 RESULT( 21 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, ULP*TEMP3 )
01233
01234 570 CONTINUE
01235
01236 NTEST = 21
01237 IF( N.GT.0 ) THEN
01238 IF( IL.NE.1 ) THEN
01239 VL = WA1( IL ) - MAX( HALF*
01240 $ ( WA1( IL )-WA1( IL-1 ) ), TEN*ULP*TEMP3,
01241 $ TEN*RTUNFL )
01242 ELSE
01243 VL = WA1( 1 ) - MAX( HALF*( WA1( N )-WA1( 1 ) ),
01244 $ TEN*ULP*TEMP3, TEN*RTUNFL )
01245 END IF
01246 IF( IU.NE.N ) THEN
01247 VU = WA1( IU ) + MAX( HALF*
01248 $ ( WA1( IU+1 )-WA1( IU ) ), TEN*ULP*TEMP3,
01249 $ TEN*RTUNFL )
01250 ELSE
01251 VU = WA1( N ) + MAX( HALF*( WA1( N )-WA1( 1 ) ),
01252 $ TEN*ULP*TEMP3, TEN*RTUNFL )
01253 END IF
01254 ELSE
01255 VL = ZERO
01256 VU = ONE
01257 END IF
01258
01259 DO 580 I = 1, N
01260 D1( I ) = REAL( A( I, I ) )
01261 580 CONTINUE
01262 DO 590 I = 1, N - 1
01263 D2( I ) = REAL( A( I+1, I ) )
01264 590 CONTINUE
01265 SRNAMT = 'SSTEVR'
01266 CALL SSTEVR( 'V', 'V', N, D1, D2, VL, VU, IL, IU, ABSTOL,
01267 $ M2, WA2, Z, LDU, IWORK, WORK, LWORK,
01268 $ IWORK(2*N+1), LIWORK-2*N, IINFO )
01269 IF( IINFO.NE.0 ) THEN
01270 WRITE( NOUNIT, FMT = 9999 )'SSTEVR(V,V)', IINFO, N,
01271 $ JTYPE, IOLDSD
01272 INFO = ABS( IINFO )
01273 IF( IINFO.LT.0 ) THEN
01274 RETURN
01275 ELSE
01276 RESULT( 22 ) = ULPINV
01277 RESULT( 23 ) = ULPINV
01278 RESULT( 24 ) = ULPINV
01279 GO TO 630
01280 END IF
01281 END IF
01282
01283 IF( M2.EQ.0 .AND. N.GT.0 ) THEN
01284 RESULT( 22 ) = ULPINV
01285 RESULT( 23 ) = ULPINV
01286 RESULT( 24 ) = ULPINV
01287 GO TO 630
01288 END IF
01289
01290
01291
01292 DO 600 I = 1, N
01293 D3( I ) = REAL( A( I, I ) )
01294 600 CONTINUE
01295 DO 610 I = 1, N - 1
01296 D4( I ) = REAL( A( I+1, I ) )
01297 610 CONTINUE
01298 CALL SSTT22( N, M2, 0, D3, D4, WA2, D2, Z, LDU, WORK,
01299 $ MAX( 1, M2 ), RESULT( 22 ) )
01300
01301 NTEST = 24
01302 DO 620 I = 1, N - 1
01303 D4( I ) = REAL( A( I+1, I ) )
01304 620 CONTINUE
01305 SRNAMT = 'SSTEVR'
01306 CALL SSTEVR( 'N', 'V', N, D3, D4, VL, VU, IL, IU, ABSTOL,
01307 $ M3, WA3, Z, LDU, IWORK, WORK, LWORK,
01308 $ IWORK(2*N+1), LIWORK-2*N, IINFO )
01309 IF( IINFO.NE.0 ) THEN
01310 WRITE( NOUNIT, FMT = 9999 )'SSTEVR(N,V)', IINFO, N,
01311 $ JTYPE, IOLDSD
01312 INFO = ABS( IINFO )
01313 IF( IINFO.LT.0 ) THEN
01314 RETURN
01315 ELSE
01316 RESULT( 24 ) = ULPINV
01317 GO TO 630
01318 END IF
01319 END IF
01320
01321
01322
01323 TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
01324 TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
01325 RESULT( 24 ) = ( TEMP1+TEMP2 ) / MAX( UNFL, TEMP3*ULP )
01326
01327 630 CONTINUE
01328
01329
01330
01331 ELSE
01332
01333 DO 640 I = 1, 24
01334 RESULT( I ) = ZERO
01335 640 CONTINUE
01336 NTEST = 24
01337 END IF
01338
01339
01340
01341
01342 DO 1720 IUPLO = 0, 1
01343 IF( IUPLO.EQ.0 ) THEN
01344 UPLO = 'L'
01345 ELSE
01346 UPLO = 'U'
01347 END IF
01348
01349
01350
01351 CALL SLACPY( ' ', N, N, A, LDA, V, LDU )
01352
01353 NTEST = NTEST + 1
01354 SRNAMT = 'SSYEV'
01355 CALL SSYEV( 'V', UPLO, N, A, LDU, D1, WORK, LWORK,
01356 $ IINFO )
01357 IF( IINFO.NE.0 ) THEN
01358 WRITE( NOUNIT, FMT = 9999 )'SSYEV(V,' // UPLO // ')',
01359 $ IINFO, N, JTYPE, IOLDSD
01360 INFO = ABS( IINFO )
01361 IF( IINFO.LT.0 ) THEN
01362 RETURN
01363 ELSE
01364 RESULT( NTEST ) = ULPINV
01365 RESULT( NTEST+1 ) = ULPINV
01366 RESULT( NTEST+2 ) = ULPINV
01367 GO TO 660
01368 END IF
01369 END IF
01370
01371
01372
01373 CALL SSYT21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z,
01374 $ LDU, TAU, WORK, RESULT( NTEST ) )
01375
01376 CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
01377
01378 NTEST = NTEST + 2
01379 SRNAMT = 'SSYEV'
01380 CALL SSYEV( 'N', UPLO, N, A, LDU, D3, WORK, LWORK,
01381 $ IINFO )
01382 IF( IINFO.NE.0 ) THEN
01383 WRITE( NOUNIT, FMT = 9999 )'SSYEV(N,' // UPLO // ')',
01384 $ IINFO, N, JTYPE, IOLDSD
01385 INFO = ABS( IINFO )
01386 IF( IINFO.LT.0 ) THEN
01387 RETURN
01388 ELSE
01389 RESULT( NTEST ) = ULPINV
01390 GO TO 660
01391 END IF
01392 END IF
01393
01394
01395
01396 TEMP1 = ZERO
01397 TEMP2 = ZERO
01398 DO 650 J = 1, N
01399 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
01400 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
01401 650 CONTINUE
01402 RESULT( NTEST ) = TEMP2 / MAX( UNFL,
01403 $ ULP*MAX( TEMP1, TEMP2 ) )
01404
01405 660 CONTINUE
01406 CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
01407
01408 NTEST = NTEST + 1
01409
01410 IF( N.GT.0 ) THEN
01411 TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) )
01412 IF( IL.NE.1 ) THEN
01413 VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ),
01414 $ TEN*ULP*TEMP3, TEN*RTUNFL )
01415 ELSE IF( N.GT.0 ) THEN
01416 VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ),
01417 $ TEN*ULP*TEMP3, TEN*RTUNFL )
01418 END IF
01419 IF( IU.NE.N ) THEN
01420 VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ),
01421 $ TEN*ULP*TEMP3, TEN*RTUNFL )
01422 ELSE IF( N.GT.0 ) THEN
01423 VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ),
01424 $ TEN*ULP*TEMP3, TEN*RTUNFL )
01425 END IF
01426 ELSE
01427 TEMP3 = ZERO
01428 VL = ZERO
01429 VU = ONE
01430 END IF
01431
01432 SRNAMT = 'SSYEVX'
01433 CALL SSYEVX( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU,
01434 $ ABSTOL, M, WA1, Z, LDU, WORK, LWORK, IWORK,
01435 $ IWORK( 5*N+1 ), IINFO )
01436 IF( IINFO.NE.0 ) THEN
01437 WRITE( NOUNIT, FMT = 9999 )'SSYEVX(V,A,' // UPLO //
01438 $ ')', IINFO, N, JTYPE, IOLDSD
01439 INFO = ABS( IINFO )
01440 IF( IINFO.LT.0 ) THEN
01441 RETURN
01442 ELSE
01443 RESULT( NTEST ) = ULPINV
01444 RESULT( NTEST+1 ) = ULPINV
01445 RESULT( NTEST+2 ) = ULPINV
01446 GO TO 680
01447 END IF
01448 END IF
01449
01450
01451
01452 CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
01453
01454 CALL SSYT21( 1, UPLO, N, 0, A, LDU, D1, D2, Z, LDU, V,
01455 $ LDU, TAU, WORK, RESULT( NTEST ) )
01456
01457 NTEST = NTEST + 2
01458 SRNAMT = 'SSYEVX'
01459 CALL SSYEVX( 'N', 'A', UPLO, N, A, LDU, VL, VU, IL, IU,
01460 $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, IWORK,
01461 $ IWORK( 5*N+1 ), IINFO )
01462 IF( IINFO.NE.0 ) THEN
01463 WRITE( NOUNIT, FMT = 9999 )'SSYEVX(N,A,' // UPLO //
01464 $ ')', IINFO, N, JTYPE, IOLDSD
01465 INFO = ABS( IINFO )
01466 IF( IINFO.LT.0 ) THEN
01467 RETURN
01468 ELSE
01469 RESULT( NTEST ) = ULPINV
01470 GO TO 680
01471 END IF
01472 END IF
01473
01474
01475
01476 TEMP1 = ZERO
01477 TEMP2 = ZERO
01478 DO 670 J = 1, N
01479 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
01480 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
01481 670 CONTINUE
01482 RESULT( NTEST ) = TEMP2 / MAX( UNFL,
01483 $ ULP*MAX( TEMP1, TEMP2 ) )
01484
01485 680 CONTINUE
01486
01487 NTEST = NTEST + 1
01488 CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
01489 SRNAMT = 'SSYEVX'
01490 CALL SSYEVX( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU,
01491 $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, IWORK,
01492 $ IWORK( 5*N+1 ), IINFO )
01493 IF( IINFO.NE.0 ) THEN
01494 WRITE( NOUNIT, FMT = 9999 )'SSYEVX(V,I,' // UPLO //
01495 $ ')', IINFO, N, JTYPE, IOLDSD
01496 INFO = ABS( IINFO )
01497 IF( IINFO.LT.0 ) THEN
01498 RETURN
01499 ELSE
01500 RESULT( NTEST ) = ULPINV
01501 RESULT( NTEST+1 ) = ULPINV
01502 RESULT( NTEST+2 ) = ULPINV
01503 GO TO 690
01504 END IF
01505 END IF
01506
01507
01508
01509 CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
01510
01511 CALL SSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
01512 $ V, LDU, TAU, WORK, RESULT( NTEST ) )
01513
01514 NTEST = NTEST + 2
01515 CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
01516 SRNAMT = 'SSYEVX'
01517 CALL SSYEVX( 'N', 'I', UPLO, N, A, LDU, VL, VU, IL, IU,
01518 $ ABSTOL, M3, WA3, Z, LDU, WORK, LWORK, IWORK,
01519 $ IWORK( 5*N+1 ), IINFO )
01520 IF( IINFO.NE.0 ) THEN
01521 WRITE( NOUNIT, FMT = 9999 )'SSYEVX(N,I,' // UPLO //
01522 $ ')', IINFO, N, JTYPE, IOLDSD
01523 INFO = ABS( IINFO )
01524 IF( IINFO.LT.0 ) THEN
01525 RETURN
01526 ELSE
01527 RESULT( NTEST ) = ULPINV
01528 GO TO 690
01529 END IF
01530 END IF
01531
01532
01533
01534 TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
01535 TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
01536 RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
01537 $ MAX( UNFL, ULP*TEMP3 )
01538 690 CONTINUE
01539
01540 NTEST = NTEST + 1
01541 CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
01542 SRNAMT = 'SSYEVX'
01543 CALL SSYEVX( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU,
01544 $ ABSTOL, M2, WA2, Z, LDU, WORK, LWORK, IWORK,
01545 $ IWORK( 5*N+1 ), IINFO )
01546 IF( IINFO.NE.0 ) THEN
01547 WRITE( NOUNIT, FMT = 9999 )'SSYEVX(V,V,' // UPLO //
01548 $ ')', IINFO, N, JTYPE, IOLDSD
01549 INFO = ABS( IINFO )
01550 IF( IINFO.LT.0 ) THEN
01551 RETURN
01552 ELSE
01553 RESULT( NTEST ) = ULPINV
01554 RESULT( NTEST+1 ) = ULPINV
01555 RESULT( NTEST+2 ) = ULPINV
01556 GO TO 700
01557 END IF
01558 END IF
01559
01560
01561
01562 CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
01563
01564 CALL SSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
01565 $ V, LDU, TAU, WORK, RESULT( NTEST ) )
01566
01567 NTEST = NTEST + 2
01568 CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
01569 SRNAMT = 'SSYEVX'
01570 CALL SSYEVX( 'N', 'V', UPLO, N, A, LDU, VL, VU, IL, IU,
01571 $ ABSTOL, M3, WA3, Z, LDU, WORK, LWORK, IWORK,
01572 $ IWORK( 5*N+1 ), IINFO )
01573 IF( IINFO.NE.0 ) THEN
01574 WRITE( NOUNIT, FMT = 9999 )'SSYEVX(N,V,' // UPLO //
01575 $ ')', IINFO, N, JTYPE, IOLDSD
01576 INFO = ABS( IINFO )
01577 IF( IINFO.LT.0 ) THEN
01578 RETURN
01579 ELSE
01580 RESULT( NTEST ) = ULPINV
01581 GO TO 700
01582 END IF
01583 END IF
01584
01585 IF( M3.EQ.0 .AND. N.GT.0 ) THEN
01586 RESULT( NTEST ) = ULPINV
01587 GO TO 700
01588 END IF
01589
01590
01591
01592 TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
01593 TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
01594 IF( N.GT.0 ) THEN
01595 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
01596 ELSE
01597 TEMP3 = ZERO
01598 END IF
01599 RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
01600 $ MAX( UNFL, TEMP3*ULP )
01601
01602 700 CONTINUE
01603
01604
01605
01606 CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
01607
01608
01609
01610
01611 IF( IUPLO.EQ.1 ) THEN
01612 INDX = 1
01613 DO 720 J = 1, N
01614 DO 710 I = 1, J
01615 WORK( INDX ) = A( I, J )
01616 INDX = INDX + 1
01617 710 CONTINUE
01618 720 CONTINUE
01619 ELSE
01620 INDX = 1
01621 DO 740 J = 1, N
01622 DO 730 I = J, N
01623 WORK( INDX ) = A( I, J )
01624 INDX = INDX + 1
01625 730 CONTINUE
01626 740 CONTINUE
01627 END IF
01628
01629 NTEST = NTEST + 1
01630 SRNAMT = 'SSPEV'
01631 CALL SSPEV( 'V', UPLO, N, WORK, D1, Z, LDU, V, IINFO )
01632 IF( IINFO.NE.0 ) THEN
01633 WRITE( NOUNIT, FMT = 9999 )'SSPEV(V,' // UPLO // ')',
01634 $ IINFO, N, JTYPE, IOLDSD
01635 INFO = ABS( IINFO )
01636 IF( IINFO.LT.0 ) THEN
01637 RETURN
01638 ELSE
01639 RESULT( NTEST ) = ULPINV
01640 RESULT( NTEST+1 ) = ULPINV
01641 RESULT( NTEST+2 ) = ULPINV
01642 GO TO 800
01643 END IF
01644 END IF
01645
01646
01647
01648 CALL SSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
01649 $ LDU, TAU, WORK, RESULT( NTEST ) )
01650
01651 IF( IUPLO.EQ.1 ) THEN
01652 INDX = 1
01653 DO 760 J = 1, N
01654 DO 750 I = 1, J
01655 WORK( INDX ) = A( I, J )
01656 INDX = INDX + 1
01657 750 CONTINUE
01658 760 CONTINUE
01659 ELSE
01660 INDX = 1
01661 DO 780 J = 1, N
01662 DO 770 I = J, N
01663 WORK( INDX ) = A( I, J )
01664 INDX = INDX + 1
01665 770 CONTINUE
01666 780 CONTINUE
01667 END IF
01668
01669 NTEST = NTEST + 2
01670 SRNAMT = 'SSPEV'
01671 CALL SSPEV( 'N', UPLO, N, WORK, D3, Z, LDU, V, IINFO )
01672 IF( IINFO.NE.0 ) THEN
01673 WRITE( NOUNIT, FMT = 9999 )'SSPEV(N,' // UPLO // ')',
01674 $ IINFO, N, JTYPE, IOLDSD
01675 INFO = ABS( IINFO )
01676 IF( IINFO.LT.0 ) THEN
01677 RETURN
01678 ELSE
01679 RESULT( NTEST ) = ULPINV
01680 GO TO 800
01681 END IF
01682 END IF
01683
01684
01685
01686 TEMP1 = ZERO
01687 TEMP2 = ZERO
01688 DO 790 J = 1, N
01689 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
01690 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
01691 790 CONTINUE
01692 RESULT( NTEST ) = TEMP2 / MAX( UNFL,
01693 $ ULP*MAX( TEMP1, TEMP2 ) )
01694
01695
01696
01697
01698 800 CONTINUE
01699 IF( IUPLO.EQ.1 ) THEN
01700 INDX = 1
01701 DO 820 J = 1, N
01702 DO 810 I = 1, J
01703 WORK( INDX ) = A( I, J )
01704 INDX = INDX + 1
01705 810 CONTINUE
01706 820 CONTINUE
01707 ELSE
01708 INDX = 1
01709 DO 840 J = 1, N
01710 DO 830 I = J, N
01711 WORK( INDX ) = A( I, J )
01712 INDX = INDX + 1
01713 830 CONTINUE
01714 840 CONTINUE
01715 END IF
01716
01717 NTEST = NTEST + 1
01718
01719 IF( N.GT.0 ) THEN
01720 TEMP3 = MAX( ABS( D1( 1 ) ), ABS( D1( N ) ) )
01721 IF( IL.NE.1 ) THEN
01722 VL = D1( IL ) - MAX( HALF*( D1( IL )-D1( IL-1 ) ),
01723 $ TEN*ULP*TEMP3, TEN*RTUNFL )
01724 ELSE IF( N.GT.0 ) THEN
01725 VL = D1( 1 ) - MAX( HALF*( D1( N )-D1( 1 ) ),
01726 $ TEN*ULP*TEMP3, TEN*RTUNFL )
01727 END IF
01728 IF( IU.NE.N ) THEN
01729 VU = D1( IU ) + MAX( HALF*( D1( IU+1 )-D1( IU ) ),
01730 $ TEN*ULP*TEMP3, TEN*RTUNFL )
01731 ELSE IF( N.GT.0 ) THEN
01732 VU = D1( N ) + MAX( HALF*( D1( N )-D1( 1 ) ),
01733 $ TEN*ULP*TEMP3, TEN*RTUNFL )
01734 END IF
01735 ELSE
01736 TEMP3 = ZERO
01737 VL = ZERO
01738 VU = ONE
01739 END IF
01740
01741 SRNAMT = 'SSPEVX'
01742 CALL SSPEVX( 'V', 'A', UPLO, N, WORK, VL, VU, IL, IU,
01743 $ ABSTOL, M, WA1, Z, LDU, V, IWORK,
01744 $ IWORK( 5*N+1 ), IINFO )
01745 IF( IINFO.NE.0 ) THEN
01746 WRITE( NOUNIT, FMT = 9999 )'SSPEVX(V,A,' // UPLO //
01747 $ ')', IINFO, N, JTYPE, IOLDSD
01748 INFO = ABS( IINFO )
01749 IF( IINFO.LT.0 ) THEN
01750 RETURN
01751 ELSE
01752 RESULT( NTEST ) = ULPINV
01753 RESULT( NTEST+1 ) = ULPINV
01754 RESULT( NTEST+2 ) = ULPINV
01755 GO TO 900
01756 END IF
01757 END IF
01758
01759
01760
01761 CALL SSYT21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V,
01762 $ LDU, TAU, WORK, RESULT( NTEST ) )
01763
01764 NTEST = NTEST + 2
01765
01766 IF( IUPLO.EQ.1 ) THEN
01767 INDX = 1
01768 DO 860 J = 1, N
01769 DO 850 I = 1, J
01770 WORK( INDX ) = A( I, J )
01771 INDX = INDX + 1
01772 850 CONTINUE
01773 860 CONTINUE
01774 ELSE
01775 INDX = 1
01776 DO 880 J = 1, N
01777 DO 870 I = J, N
01778 WORK( INDX ) = A( I, J )
01779 INDX = INDX + 1
01780 870 CONTINUE
01781 880 CONTINUE
01782 END IF
01783
01784 SRNAMT = 'SSPEVX'
01785 CALL SSPEVX( 'N', 'A', UPLO, N, WORK, VL, VU, IL, IU,
01786 $ ABSTOL, M2, WA2, Z, LDU, V, IWORK,
01787 $ IWORK( 5*N+1 ), IINFO )
01788 IF( IINFO.NE.0 ) THEN
01789 WRITE( NOUNIT, FMT = 9999 )'SSPEVX(N,A,' // UPLO //
01790 $ ')', IINFO, N, JTYPE, IOLDSD
01791 INFO = ABS( IINFO )
01792 IF( IINFO.LT.0 ) THEN
01793 RETURN
01794 ELSE
01795 RESULT( NTEST ) = ULPINV
01796 GO TO 900
01797 END IF
01798 END IF
01799
01800
01801
01802 TEMP1 = ZERO
01803 TEMP2 = ZERO
01804 DO 890 J = 1, N
01805 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
01806 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
01807 890 CONTINUE
01808 RESULT( NTEST ) = TEMP2 / MAX( UNFL,
01809 $ ULP*MAX( TEMP1, TEMP2 ) )
01810
01811 900 CONTINUE
01812 IF( IUPLO.EQ.1 ) THEN
01813 INDX = 1
01814 DO 920 J = 1, N
01815 DO 910 I = 1, J
01816 WORK( INDX ) = A( I, J )
01817 INDX = INDX + 1
01818 910 CONTINUE
01819 920 CONTINUE
01820 ELSE
01821 INDX = 1
01822 DO 940 J = 1, N
01823 DO 930 I = J, N
01824 WORK( INDX ) = A( I, J )
01825 INDX = INDX + 1
01826 930 CONTINUE
01827 940 CONTINUE
01828 END IF
01829
01830 NTEST = NTEST + 1
01831
01832 SRNAMT = 'SSPEVX'
01833 CALL SSPEVX( 'V', 'I', UPLO, N, WORK, VL, VU, IL, IU,
01834 $ ABSTOL, M2, WA2, Z, LDU, V, IWORK,
01835 $ IWORK( 5*N+1 ), IINFO )
01836 IF( IINFO.NE.0 ) THEN
01837 WRITE( NOUNIT, FMT = 9999 )'SSPEVX(V,I,' // UPLO //
01838 $ ')', IINFO, N, JTYPE, IOLDSD
01839 INFO = ABS( IINFO )
01840 IF( IINFO.LT.0 ) THEN
01841 RETURN
01842 ELSE
01843 RESULT( NTEST ) = ULPINV
01844 RESULT( NTEST+1 ) = ULPINV
01845 RESULT( NTEST+2 ) = ULPINV
01846 GO TO 990
01847 END IF
01848 END IF
01849
01850
01851
01852 CALL SSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
01853 $ V, LDU, TAU, WORK, RESULT( NTEST ) )
01854
01855 NTEST = NTEST + 2
01856
01857 IF( IUPLO.EQ.1 ) THEN
01858 INDX = 1
01859 DO 960 J = 1, N
01860 DO 950 I = 1, J
01861 WORK( INDX ) = A( I, J )
01862 INDX = INDX + 1
01863 950 CONTINUE
01864 960 CONTINUE
01865 ELSE
01866 INDX = 1
01867 DO 980 J = 1, N
01868 DO 970 I = J, N
01869 WORK( INDX ) = A( I, J )
01870 INDX = INDX + 1
01871 970 CONTINUE
01872 980 CONTINUE
01873 END IF
01874
01875 SRNAMT = 'SSPEVX'
01876 CALL SSPEVX( 'N', 'I', UPLO, N, WORK, VL, VU, IL, IU,
01877 $ ABSTOL, M3, WA3, Z, LDU, V, IWORK,
01878 $ IWORK( 5*N+1 ), IINFO )
01879 IF( IINFO.NE.0 ) THEN
01880 WRITE( NOUNIT, FMT = 9999 )'SSPEVX(N,I,' // UPLO //
01881 $ ')', IINFO, N, JTYPE, IOLDSD
01882 INFO = ABS( IINFO )
01883 IF( IINFO.LT.0 ) THEN
01884 RETURN
01885 ELSE
01886 RESULT( NTEST ) = ULPINV
01887 GO TO 990
01888 END IF
01889 END IF
01890
01891 IF( M3.EQ.0 .AND. N.GT.0 ) THEN
01892 RESULT( NTEST ) = ULPINV
01893 GO TO 990
01894 END IF
01895
01896
01897
01898 TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
01899 TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
01900 IF( N.GT.0 ) THEN
01901 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
01902 ELSE
01903 TEMP3 = ZERO
01904 END IF
01905 RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
01906 $ MAX( UNFL, TEMP3*ULP )
01907
01908 990 CONTINUE
01909 IF( IUPLO.EQ.1 ) THEN
01910 INDX = 1
01911 DO 1010 J = 1, N
01912 DO 1000 I = 1, J
01913 WORK( INDX ) = A( I, J )
01914 INDX = INDX + 1
01915 1000 CONTINUE
01916 1010 CONTINUE
01917 ELSE
01918 INDX = 1
01919 DO 1030 J = 1, N
01920 DO 1020 I = J, N
01921 WORK( INDX ) = A( I, J )
01922 INDX = INDX + 1
01923 1020 CONTINUE
01924 1030 CONTINUE
01925 END IF
01926
01927 NTEST = NTEST + 1
01928
01929 SRNAMT = 'SSPEVX'
01930 CALL SSPEVX( 'V', 'V', UPLO, N, WORK, VL, VU, IL, IU,
01931 $ ABSTOL, M2, WA2, Z, LDU, V, IWORK,
01932 $ IWORK( 5*N+1 ), IINFO )
01933 IF( IINFO.NE.0 ) THEN
01934 WRITE( NOUNIT, FMT = 9999 )'SSPEVX(V,V,' // UPLO //
01935 $ ')', IINFO, N, JTYPE, IOLDSD
01936 INFO = ABS( IINFO )
01937 IF( IINFO.LT.0 ) THEN
01938 RETURN
01939 ELSE
01940 RESULT( NTEST ) = ULPINV
01941 RESULT( NTEST+1 ) = ULPINV
01942 RESULT( NTEST+2 ) = ULPINV
01943 GO TO 1080
01944 END IF
01945 END IF
01946
01947
01948
01949 CALL SSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
01950 $ V, LDU, TAU, WORK, RESULT( NTEST ) )
01951
01952 NTEST = NTEST + 2
01953
01954 IF( IUPLO.EQ.1 ) THEN
01955 INDX = 1
01956 DO 1050 J = 1, N
01957 DO 1040 I = 1, J
01958 WORK( INDX ) = A( I, J )
01959 INDX = INDX + 1
01960 1040 CONTINUE
01961 1050 CONTINUE
01962 ELSE
01963 INDX = 1
01964 DO 1070 J = 1, N
01965 DO 1060 I = J, N
01966 WORK( INDX ) = A( I, J )
01967 INDX = INDX + 1
01968 1060 CONTINUE
01969 1070 CONTINUE
01970 END IF
01971
01972 SRNAMT = 'SSPEVX'
01973 CALL SSPEVX( 'N', 'V', UPLO, N, WORK, VL, VU, IL, IU,
01974 $ ABSTOL, M3, WA3, Z, LDU, V, IWORK,
01975 $ IWORK( 5*N+1 ), IINFO )
01976 IF( IINFO.NE.0 ) THEN
01977 WRITE( NOUNIT, FMT = 9999 )'SSPEVX(N,V,' // UPLO //
01978 $ ')', IINFO, N, JTYPE, IOLDSD
01979 INFO = ABS( IINFO )
01980 IF( IINFO.LT.0 ) THEN
01981 RETURN
01982 ELSE
01983 RESULT( NTEST ) = ULPINV
01984 GO TO 1080
01985 END IF
01986 END IF
01987
01988 IF( M3.EQ.0 .AND. N.GT.0 ) THEN
01989 RESULT( NTEST ) = ULPINV
01990 GO TO 1080
01991 END IF
01992
01993
01994
01995 TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
01996 TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
01997 IF( N.GT.0 ) THEN
01998 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
01999 ELSE
02000 TEMP3 = ZERO
02001 END IF
02002 RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
02003 $ MAX( UNFL, TEMP3*ULP )
02004
02005 1080 CONTINUE
02006
02007
02008
02009 IF( JTYPE.LE.7 ) THEN
02010 KD = 1
02011 ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN
02012 KD = MAX( N-1, 0 )
02013 ELSE
02014 KD = IHBW
02015 END IF
02016
02017
02018
02019
02020 IF( IUPLO.EQ.1 ) THEN
02021 DO 1100 J = 1, N
02022 DO 1090 I = MAX( 1, J-KD ), J
02023 V( KD+1+I-J, J ) = A( I, J )
02024 1090 CONTINUE
02025 1100 CONTINUE
02026 ELSE
02027 DO 1120 J = 1, N
02028 DO 1110 I = J, MIN( N, J+KD )
02029 V( 1+I-J, J ) = A( I, J )
02030 1110 CONTINUE
02031 1120 CONTINUE
02032 END IF
02033
02034 NTEST = NTEST + 1
02035 SRNAMT = 'SSBEV'
02036 CALL SSBEV( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK,
02037 $ IINFO )
02038 IF( IINFO.NE.0 ) THEN
02039 WRITE( NOUNIT, FMT = 9999 )'SSBEV(V,' // UPLO // ')',
02040 $ IINFO, N, JTYPE, IOLDSD
02041 INFO = ABS( IINFO )
02042 IF( IINFO.LT.0 ) THEN
02043 RETURN
02044 ELSE
02045 RESULT( NTEST ) = ULPINV
02046 RESULT( NTEST+1 ) = ULPINV
02047 RESULT( NTEST+2 ) = ULPINV
02048 GO TO 1180
02049 END IF
02050 END IF
02051
02052
02053
02054 CALL SSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
02055 $ LDU, TAU, WORK, RESULT( NTEST ) )
02056
02057 IF( IUPLO.EQ.1 ) THEN
02058 DO 1140 J = 1, N
02059 DO 1130 I = MAX( 1, J-KD ), J
02060 V( KD+1+I-J, J ) = A( I, J )
02061 1130 CONTINUE
02062 1140 CONTINUE
02063 ELSE
02064 DO 1160 J = 1, N
02065 DO 1150 I = J, MIN( N, J+KD )
02066 V( 1+I-J, J ) = A( I, J )
02067 1150 CONTINUE
02068 1160 CONTINUE
02069 END IF
02070
02071 NTEST = NTEST + 2
02072 SRNAMT = 'SSBEV'
02073 CALL SSBEV( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU, WORK,
02074 $ IINFO )
02075 IF( IINFO.NE.0 ) THEN
02076 WRITE( NOUNIT, FMT = 9999 )'SSBEV(N,' // UPLO // ')',
02077 $ IINFO, N, JTYPE, IOLDSD
02078 INFO = ABS( IINFO )
02079 IF( IINFO.LT.0 ) THEN
02080 RETURN
02081 ELSE
02082 RESULT( NTEST ) = ULPINV
02083 GO TO 1180
02084 END IF
02085 END IF
02086
02087
02088
02089 TEMP1 = ZERO
02090 TEMP2 = ZERO
02091 DO 1170 J = 1, N
02092 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
02093 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
02094 1170 CONTINUE
02095 RESULT( NTEST ) = TEMP2 / MAX( UNFL,
02096 $ ULP*MAX( TEMP1, TEMP2 ) )
02097
02098
02099
02100
02101 1180 CONTINUE
02102 IF( IUPLO.EQ.1 ) THEN
02103 DO 1200 J = 1, N
02104 DO 1190 I = MAX( 1, J-KD ), J
02105 V( KD+1+I-J, J ) = A( I, J )
02106 1190 CONTINUE
02107 1200 CONTINUE
02108 ELSE
02109 DO 1220 J = 1, N
02110 DO 1210 I = J, MIN( N, J+KD )
02111 V( 1+I-J, J ) = A( I, J )
02112 1210 CONTINUE
02113 1220 CONTINUE
02114 END IF
02115
02116 NTEST = NTEST + 1
02117 SRNAMT = 'SSBEVX'
02118 CALL SSBEVX( 'V', 'A', UPLO, N, KD, V, LDU, U, LDU, VL,
02119 $ VU, IL, IU, ABSTOL, M, WA2, Z, LDU, WORK,
02120 $ IWORK, IWORK( 5*N+1 ), IINFO )
02121 IF( IINFO.NE.0 ) THEN
02122 WRITE( NOUNIT, FMT = 9999 )'SSBEVX(V,A,' // UPLO //
02123 $ ')', IINFO, N, JTYPE, IOLDSD
02124 INFO = ABS( IINFO )
02125 IF( IINFO.LT.0 ) THEN
02126 RETURN
02127 ELSE
02128 RESULT( NTEST ) = ULPINV
02129 RESULT( NTEST+1 ) = ULPINV
02130 RESULT( NTEST+2 ) = ULPINV
02131 GO TO 1280
02132 END IF
02133 END IF
02134
02135
02136
02137 CALL SSYT21( 1, UPLO, N, 0, A, LDU, WA2, D2, Z, LDU, V,
02138 $ LDU, TAU, WORK, RESULT( NTEST ) )
02139
02140 NTEST = NTEST + 2
02141
02142 IF( IUPLO.EQ.1 ) THEN
02143 DO 1240 J = 1, N
02144 DO 1230 I = MAX( 1, J-KD ), J
02145 V( KD+1+I-J, J ) = A( I, J )
02146 1230 CONTINUE
02147 1240 CONTINUE
02148 ELSE
02149 DO 1260 J = 1, N
02150 DO 1250 I = J, MIN( N, J+KD )
02151 V( 1+I-J, J ) = A( I, J )
02152 1250 CONTINUE
02153 1260 CONTINUE
02154 END IF
02155
02156 SRNAMT = 'SSBEVX'
02157 CALL SSBEVX( 'N', 'A', UPLO, N, KD, V, LDU, U, LDU, VL,
02158 $ VU, IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK,
02159 $ IWORK, IWORK( 5*N+1 ), IINFO )
02160 IF( IINFO.NE.0 ) THEN
02161 WRITE( NOUNIT, FMT = 9999 )'SSBEVX(N,A,' // UPLO //
02162 $ ')', IINFO, N, JTYPE, IOLDSD
02163 INFO = ABS( IINFO )
02164 IF( IINFO.LT.0 ) THEN
02165 RETURN
02166 ELSE
02167 RESULT( NTEST ) = ULPINV
02168 GO TO 1280
02169 END IF
02170 END IF
02171
02172
02173
02174 TEMP1 = ZERO
02175 TEMP2 = ZERO
02176 DO 1270 J = 1, N
02177 TEMP1 = MAX( TEMP1, ABS( WA2( J ) ), ABS( WA3( J ) ) )
02178 TEMP2 = MAX( TEMP2, ABS( WA2( J )-WA3( J ) ) )
02179 1270 CONTINUE
02180 RESULT( NTEST ) = TEMP2 / MAX( UNFL,
02181 $ ULP*MAX( TEMP1, TEMP2 ) )
02182
02183 1280 CONTINUE
02184 NTEST = NTEST + 1
02185 IF( IUPLO.EQ.1 ) THEN
02186 DO 1300 J = 1, N
02187 DO 1290 I = MAX( 1, J-KD ), J
02188 V( KD+1+I-J, J ) = A( I, J )
02189 1290 CONTINUE
02190 1300 CONTINUE
02191 ELSE
02192 DO 1320 J = 1, N
02193 DO 1310 I = J, MIN( N, J+KD )
02194 V( 1+I-J, J ) = A( I, J )
02195 1310 CONTINUE
02196 1320 CONTINUE
02197 END IF
02198
02199 SRNAMT = 'SSBEVX'
02200 CALL SSBEVX( 'V', 'I', UPLO, N, KD, V, LDU, U, LDU, VL,
02201 $ VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK,
02202 $ IWORK, IWORK( 5*N+1 ), IINFO )
02203 IF( IINFO.NE.0 ) THEN
02204 WRITE( NOUNIT, FMT = 9999 )'SSBEVX(V,I,' // UPLO //
02205 $ ')', IINFO, N, JTYPE, IOLDSD
02206 INFO = ABS( IINFO )
02207 IF( IINFO.LT.0 ) THEN
02208 RETURN
02209 ELSE
02210 RESULT( NTEST ) = ULPINV
02211 RESULT( NTEST+1 ) = ULPINV
02212 RESULT( NTEST+2 ) = ULPINV
02213 GO TO 1370
02214 END IF
02215 END IF
02216
02217
02218
02219 CALL SSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
02220 $ V, LDU, TAU, WORK, RESULT( NTEST ) )
02221
02222 NTEST = NTEST + 2
02223
02224 IF( IUPLO.EQ.1 ) THEN
02225 DO 1340 J = 1, N
02226 DO 1330 I = MAX( 1, J-KD ), J
02227 V( KD+1+I-J, J ) = A( I, J )
02228 1330 CONTINUE
02229 1340 CONTINUE
02230 ELSE
02231 DO 1360 J = 1, N
02232 DO 1350 I = J, MIN( N, J+KD )
02233 V( 1+I-J, J ) = A( I, J )
02234 1350 CONTINUE
02235 1360 CONTINUE
02236 END IF
02237
02238 SRNAMT = 'SSBEVX'
02239 CALL SSBEVX( 'N', 'I', UPLO, N, KD, V, LDU, U, LDU, VL,
02240 $ VU, IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK,
02241 $ IWORK, IWORK( 5*N+1 ), IINFO )
02242 IF( IINFO.NE.0 ) THEN
02243 WRITE( NOUNIT, FMT = 9999 )'SSBEVX(N,I,' // UPLO //
02244 $ ')', IINFO, N, JTYPE, IOLDSD
02245 INFO = ABS( IINFO )
02246 IF( IINFO.LT.0 ) THEN
02247 RETURN
02248 ELSE
02249 RESULT( NTEST ) = ULPINV
02250 GO TO 1370
02251 END IF
02252 END IF
02253
02254
02255
02256 TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
02257 TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
02258 IF( N.GT.0 ) THEN
02259 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
02260 ELSE
02261 TEMP3 = ZERO
02262 END IF
02263 RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
02264 $ MAX( UNFL, TEMP3*ULP )
02265
02266 1370 CONTINUE
02267 NTEST = NTEST + 1
02268 IF( IUPLO.EQ.1 ) THEN
02269 DO 1390 J = 1, N
02270 DO 1380 I = MAX( 1, J-KD ), J
02271 V( KD+1+I-J, J ) = A( I, J )
02272 1380 CONTINUE
02273 1390 CONTINUE
02274 ELSE
02275 DO 1410 J = 1, N
02276 DO 1400 I = J, MIN( N, J+KD )
02277 V( 1+I-J, J ) = A( I, J )
02278 1400 CONTINUE
02279 1410 CONTINUE
02280 END IF
02281
02282 SRNAMT = 'SSBEVX'
02283 CALL SSBEVX( 'V', 'V', UPLO, N, KD, V, LDU, U, LDU, VL,
02284 $ VU, IL, IU, ABSTOL, M2, WA2, Z, LDU, WORK,
02285 $ IWORK, IWORK( 5*N+1 ), IINFO )
02286 IF( IINFO.NE.0 ) THEN
02287 WRITE( NOUNIT, FMT = 9999 )'SSBEVX(V,V,' // UPLO //
02288 $ ')', IINFO, N, JTYPE, IOLDSD
02289 INFO = ABS( IINFO )
02290 IF( IINFO.LT.0 ) THEN
02291 RETURN
02292 ELSE
02293 RESULT( NTEST ) = ULPINV
02294 RESULT( NTEST+1 ) = ULPINV
02295 RESULT( NTEST+2 ) = ULPINV
02296 GO TO 1460
02297 END IF
02298 END IF
02299
02300
02301
02302 CALL SSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
02303 $ V, LDU, TAU, WORK, RESULT( NTEST ) )
02304
02305 NTEST = NTEST + 2
02306
02307 IF( IUPLO.EQ.1 ) THEN
02308 DO 1430 J = 1, N
02309 DO 1420 I = MAX( 1, J-KD ), J
02310 V( KD+1+I-J, J ) = A( I, J )
02311 1420 CONTINUE
02312 1430 CONTINUE
02313 ELSE
02314 DO 1450 J = 1, N
02315 DO 1440 I = J, MIN( N, J+KD )
02316 V( 1+I-J, J ) = A( I, J )
02317 1440 CONTINUE
02318 1450 CONTINUE
02319 END IF
02320
02321 SRNAMT = 'SSBEVX'
02322 CALL SSBEVX( 'N', 'V', UPLO, N, KD, V, LDU, U, LDU, VL,
02323 $ VU, IL, IU, ABSTOL, M3, WA3, Z, LDU, WORK,
02324 $ IWORK, IWORK( 5*N+1 ), IINFO )
02325 IF( IINFO.NE.0 ) THEN
02326 WRITE( NOUNIT, FMT = 9999 )'SSBEVX(N,V,' // UPLO //
02327 $ ')', IINFO, N, JTYPE, IOLDSD
02328 INFO = ABS( IINFO )
02329 IF( IINFO.LT.0 ) THEN
02330 RETURN
02331 ELSE
02332 RESULT( NTEST ) = ULPINV
02333 GO TO 1460
02334 END IF
02335 END IF
02336
02337 IF( M3.EQ.0 .AND. N.GT.0 ) THEN
02338 RESULT( NTEST ) = ULPINV
02339 GO TO 1460
02340 END IF
02341
02342
02343
02344 TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
02345 TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
02346 IF( N.GT.0 ) THEN
02347 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
02348 ELSE
02349 TEMP3 = ZERO
02350 END IF
02351 RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
02352 $ MAX( UNFL, TEMP3*ULP )
02353
02354 1460 CONTINUE
02355
02356
02357
02358 CALL SLACPY( ' ', N, N, A, LDA, V, LDU )
02359
02360 NTEST = NTEST + 1
02361 SRNAMT = 'SSYEVD'
02362 CALL SSYEVD( 'V', UPLO, N, A, LDU, D1, WORK, LWEDC,
02363 $ IWORK, LIWEDC, IINFO )
02364 IF( IINFO.NE.0 ) THEN
02365 WRITE( NOUNIT, FMT = 9999 )'SSYEVD(V,' // UPLO //
02366 $ ')', IINFO, N, JTYPE, IOLDSD
02367 INFO = ABS( IINFO )
02368 IF( IINFO.LT.0 ) THEN
02369 RETURN
02370 ELSE
02371 RESULT( NTEST ) = ULPINV
02372 RESULT( NTEST+1 ) = ULPINV
02373 RESULT( NTEST+2 ) = ULPINV
02374 GO TO 1480
02375 END IF
02376 END IF
02377
02378
02379
02380 CALL SSYT21( 1, UPLO, N, 0, V, LDU, D1, D2, A, LDU, Z,
02381 $ LDU, TAU, WORK, RESULT( NTEST ) )
02382
02383 CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
02384
02385 NTEST = NTEST + 2
02386 SRNAMT = 'SSYEVD'
02387 CALL SSYEVD( 'N', UPLO, N, A, LDU, D3, WORK, LWEDC,
02388 $ IWORK, LIWEDC, IINFO )
02389 IF( IINFO.NE.0 ) THEN
02390 WRITE( NOUNIT, FMT = 9999 )'SSYEVD(N,' // UPLO //
02391 $ ')', IINFO, N, JTYPE, IOLDSD
02392 INFO = ABS( IINFO )
02393 IF( IINFO.LT.0 ) THEN
02394 RETURN
02395 ELSE
02396 RESULT( NTEST ) = ULPINV
02397 GO TO 1480
02398 END IF
02399 END IF
02400
02401
02402
02403 TEMP1 = ZERO
02404 TEMP2 = ZERO
02405 DO 1470 J = 1, N
02406 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
02407 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
02408 1470 CONTINUE
02409 RESULT( NTEST ) = TEMP2 / MAX( UNFL,
02410 $ ULP*MAX( TEMP1, TEMP2 ) )
02411
02412 1480 CONTINUE
02413
02414
02415
02416 CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
02417
02418
02419
02420
02421 IF( IUPLO.EQ.1 ) THEN
02422 INDX = 1
02423 DO 1500 J = 1, N
02424 DO 1490 I = 1, J
02425 WORK( INDX ) = A( I, J )
02426 INDX = INDX + 1
02427 1490 CONTINUE
02428 1500 CONTINUE
02429 ELSE
02430 INDX = 1
02431 DO 1520 J = 1, N
02432 DO 1510 I = J, N
02433 WORK( INDX ) = A( I, J )
02434 INDX = INDX + 1
02435 1510 CONTINUE
02436 1520 CONTINUE
02437 END IF
02438
02439 NTEST = NTEST + 1
02440 SRNAMT = 'SSPEVD'
02441 CALL SSPEVD( 'V', UPLO, N, WORK, D1, Z, LDU,
02442 $ WORK( INDX ), LWEDC-INDX+1, IWORK, LIWEDC,
02443 $ IINFO )
02444 IF( IINFO.NE.0 ) THEN
02445 WRITE( NOUNIT, FMT = 9999 )'SSPEVD(V,' // UPLO //
02446 $ ')', IINFO, N, JTYPE, IOLDSD
02447 INFO = ABS( IINFO )
02448 IF( IINFO.LT.0 ) THEN
02449 RETURN
02450 ELSE
02451 RESULT( NTEST ) = ULPINV
02452 RESULT( NTEST+1 ) = ULPINV
02453 RESULT( NTEST+2 ) = ULPINV
02454 GO TO 1580
02455 END IF
02456 END IF
02457
02458
02459
02460 CALL SSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
02461 $ LDU, TAU, WORK, RESULT( NTEST ) )
02462
02463 IF( IUPLO.EQ.1 ) THEN
02464 INDX = 1
02465 DO 1540 J = 1, N
02466 DO 1530 I = 1, J
02467
02468 WORK( INDX ) = A( I, J )
02469 INDX = INDX + 1
02470 1530 CONTINUE
02471 1540 CONTINUE
02472 ELSE
02473 INDX = 1
02474 DO 1560 J = 1, N
02475 DO 1550 I = J, N
02476 WORK( INDX ) = A( I, J )
02477 INDX = INDX + 1
02478 1550 CONTINUE
02479 1560 CONTINUE
02480 END IF
02481
02482 NTEST = NTEST + 2
02483 SRNAMT = 'SSPEVD'
02484 CALL SSPEVD( 'N', UPLO, N, WORK, D3, Z, LDU,
02485 $ WORK( INDX ), LWEDC-INDX+1, IWORK, LIWEDC,
02486 $ IINFO )
02487 IF( IINFO.NE.0 ) THEN
02488 WRITE( NOUNIT, FMT = 9999 )'SSPEVD(N,' // UPLO //
02489 $ ')', IINFO, N, JTYPE, IOLDSD
02490 INFO = ABS( IINFO )
02491 IF( IINFO.LT.0 ) THEN
02492 RETURN
02493 ELSE
02494 RESULT( NTEST ) = ULPINV
02495 GO TO 1580
02496 END IF
02497 END IF
02498
02499
02500
02501 TEMP1 = ZERO
02502 TEMP2 = ZERO
02503 DO 1570 J = 1, N
02504 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
02505 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
02506 1570 CONTINUE
02507 RESULT( NTEST ) = TEMP2 / MAX( UNFL,
02508 $ ULP*MAX( TEMP1, TEMP2 ) )
02509 1580 CONTINUE
02510
02511
02512
02513 IF( JTYPE.LE.7 ) THEN
02514 KD = 1
02515 ELSE IF( JTYPE.GE.8 .AND. JTYPE.LE.15 ) THEN
02516 KD = MAX( N-1, 0 )
02517 ELSE
02518 KD = IHBW
02519 END IF
02520
02521
02522
02523
02524 IF( IUPLO.EQ.1 ) THEN
02525 DO 1600 J = 1, N
02526 DO 1590 I = MAX( 1, J-KD ), J
02527 V( KD+1+I-J, J ) = A( I, J )
02528 1590 CONTINUE
02529 1600 CONTINUE
02530 ELSE
02531 DO 1620 J = 1, N
02532 DO 1610 I = J, MIN( N, J+KD )
02533 V( 1+I-J, J ) = A( I, J )
02534 1610 CONTINUE
02535 1620 CONTINUE
02536 END IF
02537
02538 NTEST = NTEST + 1
02539 SRNAMT = 'SSBEVD'
02540 CALL SSBEVD( 'V', UPLO, N, KD, V, LDU, D1, Z, LDU, WORK,
02541 $ LWEDC, IWORK, LIWEDC, IINFO )
02542 IF( IINFO.NE.0 ) THEN
02543 WRITE( NOUNIT, FMT = 9999 )'SSBEVD(V,' // UPLO //
02544 $ ')', IINFO, N, JTYPE, IOLDSD
02545 INFO = ABS( IINFO )
02546 IF( IINFO.LT.0 ) THEN
02547 RETURN
02548 ELSE
02549 RESULT( NTEST ) = ULPINV
02550 RESULT( NTEST+1 ) = ULPINV
02551 RESULT( NTEST+2 ) = ULPINV
02552 GO TO 1680
02553 END IF
02554 END IF
02555
02556
02557
02558 CALL SSYT21( 1, UPLO, N, 0, A, LDA, D1, D2, Z, LDU, V,
02559 $ LDU, TAU, WORK, RESULT( NTEST ) )
02560
02561 IF( IUPLO.EQ.1 ) THEN
02562 DO 1640 J = 1, N
02563 DO 1630 I = MAX( 1, J-KD ), J
02564 V( KD+1+I-J, J ) = A( I, J )
02565 1630 CONTINUE
02566 1640 CONTINUE
02567 ELSE
02568 DO 1660 J = 1, N
02569 DO 1650 I = J, MIN( N, J+KD )
02570 V( 1+I-J, J ) = A( I, J )
02571 1650 CONTINUE
02572 1660 CONTINUE
02573 END IF
02574
02575 NTEST = NTEST + 2
02576 SRNAMT = 'SSBEVD'
02577 CALL SSBEVD( 'N', UPLO, N, KD, V, LDU, D3, Z, LDU, WORK,
02578 $ LWEDC, IWORK, LIWEDC, IINFO )
02579 IF( IINFO.NE.0 ) THEN
02580 WRITE( NOUNIT, FMT = 9999 )'SSBEVD(N,' // UPLO //
02581 $ ')', IINFO, N, JTYPE, IOLDSD
02582 INFO = ABS( IINFO )
02583 IF( IINFO.LT.0 ) THEN
02584 RETURN
02585 ELSE
02586 RESULT( NTEST ) = ULPINV
02587 GO TO 1680
02588 END IF
02589 END IF
02590
02591
02592
02593 TEMP1 = ZERO
02594 TEMP2 = ZERO
02595 DO 1670 J = 1, N
02596 TEMP1 = MAX( TEMP1, ABS( D1( J ) ), ABS( D3( J ) ) )
02597 TEMP2 = MAX( TEMP2, ABS( D1( J )-D3( J ) ) )
02598 1670 CONTINUE
02599 RESULT( NTEST ) = TEMP2 / MAX( UNFL,
02600 $ ULP*MAX( TEMP1, TEMP2 ) )
02601
02602 1680 CONTINUE
02603
02604
02605 CALL SLACPY( ' ', N, N, A, LDA, V, LDU )
02606 NTEST = NTEST + 1
02607 SRNAMT = 'SSYEVR'
02608 CALL SSYEVR( 'V', 'A', UPLO, N, A, LDU, VL, VU, IL, IU,
02609 $ ABSTOL, M, WA1, Z, LDU, IWORK, WORK, LWORK,
02610 $ IWORK(2*N+1), LIWORK-2*N, IINFO )
02611 IF( IINFO.NE.0 ) THEN
02612 WRITE( NOUNIT, FMT = 9999 )'SSYEVR(V,A,' // UPLO //
02613 $ ')', IINFO, N, JTYPE, IOLDSD
02614 INFO = ABS( IINFO )
02615 IF( IINFO.LT.0 ) THEN
02616 RETURN
02617 ELSE
02618 RESULT( NTEST ) = ULPINV
02619 RESULT( NTEST+1 ) = ULPINV
02620 RESULT( NTEST+2 ) = ULPINV
02621 GO TO 1700
02622 END IF
02623 END IF
02624
02625
02626
02627 CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
02628
02629 CALL SSYT21( 1, UPLO, N, 0, A, LDU, WA1, D2, Z, LDU, V,
02630 $ LDU, TAU, WORK, RESULT( NTEST ) )
02631
02632 NTEST = NTEST + 2
02633 SRNAMT = 'SSYEVR'
02634 CALL SSYEVR( 'N', 'A', UPLO, N, A, LDU, VL, VU, IL, IU,
02635 $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK,
02636 $ IWORK(2*N+1), LIWORK-2*N, IINFO )
02637 IF( IINFO.NE.0 ) THEN
02638 WRITE( NOUNIT, FMT = 9999 )'SSYEVR(N,A,' // UPLO //
02639 $ ')', IINFO, N, JTYPE, IOLDSD
02640 INFO = ABS( IINFO )
02641 IF( IINFO.LT.0 ) THEN
02642 RETURN
02643 ELSE
02644 RESULT( NTEST ) = ULPINV
02645 GO TO 1700
02646 END IF
02647 END IF
02648
02649
02650
02651 TEMP1 = ZERO
02652 TEMP2 = ZERO
02653 DO 1690 J = 1, N
02654 TEMP1 = MAX( TEMP1, ABS( WA1( J ) ), ABS( WA2( J ) ) )
02655 TEMP2 = MAX( TEMP2, ABS( WA1( J )-WA2( J ) ) )
02656 1690 CONTINUE
02657 RESULT( NTEST ) = TEMP2 / MAX( UNFL,
02658 $ ULP*MAX( TEMP1, TEMP2 ) )
02659
02660 1700 CONTINUE
02661
02662 NTEST = NTEST + 1
02663 CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
02664 SRNAMT = 'SSYEVR'
02665 CALL SSYEVR( 'V', 'I', UPLO, N, A, LDU, VL, VU, IL, IU,
02666 $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK,
02667 $ IWORK(2*N+1), LIWORK-2*N, IINFO )
02668 IF( IINFO.NE.0 ) THEN
02669 WRITE( NOUNIT, FMT = 9999 )'SSYEVR(V,I,' // UPLO //
02670 $ ')', IINFO, N, JTYPE, IOLDSD
02671 INFO = ABS( IINFO )
02672 IF( IINFO.LT.0 ) THEN
02673 RETURN
02674 ELSE
02675 RESULT( NTEST ) = ULPINV
02676 RESULT( NTEST+1 ) = ULPINV
02677 RESULT( NTEST+2 ) = ULPINV
02678 GO TO 1710
02679 END IF
02680 END IF
02681
02682
02683
02684 CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
02685
02686 CALL SSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
02687 $ V, LDU, TAU, WORK, RESULT( NTEST ) )
02688
02689 NTEST = NTEST + 2
02690 CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
02691 SRNAMT = 'SSYEVR'
02692 CALL SSYEVR( 'N', 'I', UPLO, N, A, LDU, VL, VU, IL, IU,
02693 $ ABSTOL, M3, WA3, Z, LDU, IWORK, WORK, LWORK,
02694 $ IWORK(2*N+1), LIWORK-2*N, IINFO )
02695 IF( IINFO.NE.0 ) THEN
02696 WRITE( NOUNIT, FMT = 9999 )'SSYEVR(N,I,' // UPLO //
02697 $ ')', IINFO, N, JTYPE, IOLDSD
02698 INFO = ABS( IINFO )
02699 IF( IINFO.LT.0 ) THEN
02700 RETURN
02701 ELSE
02702 RESULT( NTEST ) = ULPINV
02703 GO TO 1710
02704 END IF
02705 END IF
02706
02707
02708
02709 TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
02710 TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
02711 RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
02712 $ MAX( UNFL, ULP*TEMP3 )
02713 1710 CONTINUE
02714
02715 NTEST = NTEST + 1
02716 CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
02717 SRNAMT = 'SSYEVR'
02718 CALL SSYEVR( 'V', 'V', UPLO, N, A, LDU, VL, VU, IL, IU,
02719 $ ABSTOL, M2, WA2, Z, LDU, IWORK, WORK, LWORK,
02720 $ IWORK(2*N+1), LIWORK-2*N, IINFO )
02721 IF( IINFO.NE.0 ) THEN
02722 WRITE( NOUNIT, FMT = 9999 )'SSYEVR(V,V,' // UPLO //
02723 $ ')', IINFO, N, JTYPE, IOLDSD
02724 INFO = ABS( IINFO )
02725 IF( IINFO.LT.0 ) THEN
02726 RETURN
02727 ELSE
02728 RESULT( NTEST ) = ULPINV
02729 RESULT( NTEST+1 ) = ULPINV
02730 RESULT( NTEST+2 ) = ULPINV
02731 GO TO 700
02732 END IF
02733 END IF
02734
02735
02736
02737 CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
02738
02739 CALL SSYT22( 1, UPLO, N, M2, 0, A, LDU, WA2, D2, Z, LDU,
02740 $ V, LDU, TAU, WORK, RESULT( NTEST ) )
02741
02742 NTEST = NTEST + 2
02743 CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
02744 SRNAMT = 'SSYEVR'
02745 CALL SSYEVR( 'N', 'V', UPLO, N, A, LDU, VL, VU, IL, IU,
02746 $ ABSTOL, M3, WA3, Z, LDU, IWORK, WORK, LWORK,
02747 $ IWORK(2*N+1), LIWORK-2*N, IINFO )
02748 IF( IINFO.NE.0 ) THEN
02749 WRITE( NOUNIT, FMT = 9999 )'SSYEVR(N,V,' // UPLO //
02750 $ ')', IINFO, N, JTYPE, IOLDSD
02751 INFO = ABS( IINFO )
02752 IF( IINFO.LT.0 ) THEN
02753 RETURN
02754 ELSE
02755 RESULT( NTEST ) = ULPINV
02756 GO TO 700
02757 END IF
02758 END IF
02759
02760 IF( M3.EQ.0 .AND. N.GT.0 ) THEN
02761 RESULT( NTEST ) = ULPINV
02762 GO TO 700
02763 END IF
02764
02765
02766
02767 TEMP1 = SSXT1( 1, WA2, M2, WA3, M3, ABSTOL, ULP, UNFL )
02768 TEMP2 = SSXT1( 1, WA3, M3, WA2, M2, ABSTOL, ULP, UNFL )
02769 IF( N.GT.0 ) THEN
02770 TEMP3 = MAX( ABS( WA1( 1 ) ), ABS( WA1( N ) ) )
02771 ELSE
02772 TEMP3 = ZERO
02773 END IF
02774 RESULT( NTEST ) = ( TEMP1+TEMP2 ) /
02775 $ MAX( UNFL, TEMP3*ULP )
02776
02777 CALL SLACPY( ' ', N, N, V, LDU, A, LDA )
02778
02779 1720 CONTINUE
02780
02781
02782
02783 NTESTT = NTESTT + NTEST
02784
02785 CALL SLAFTS( 'SST', N, N, JTYPE, NTEST, RESULT, IOLDSD,
02786 $ THRESH, NOUNIT, NERRS )
02787
02788 1730 CONTINUE
02789 1740 CONTINUE
02790
02791
02792
02793 CALL ALASVM( 'SST', NOUNIT, NERRS, NTESTT, 0 )
02794
02795 9999 FORMAT( ' SDRVST: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
02796 $ I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
02797
02798 RETURN
02799
02800
02801
02802 END