00001 SUBROUTINE CDRVSG( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
00002 $ NOUNIT, A, LDA, B, LDB, D, Z, LDZ, AB, BB, AP,
00003 $ BP, WORK, NWORK, RWORK, LRWORK, IWORK, LIWORK,
00004 $ RESULT, INFO )
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020 INTEGER INFO, LDA, LDB, LDZ, LIWORK, LRWORK, NOUNIT,
00021 $ NSIZES, NTYPES, NWORK
00022 REAL THRESH
00023
00024
00025 LOGICAL DOTYPE( * )
00026 INTEGER ISEED( 4 ), IWORK( * ), NN( * )
00027 REAL D( * ), RESULT( * ), RWORK( * )
00028 COMPLEX A( LDA, * ), AB( LDA, * ), AP( * ),
00029 $ B( LDB, * ), BB( LDB, * ), BP( * ), WORK( * ),
00030 $ Z( LDZ, * )
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 REAL ZERO, ONE, TEN
00356 PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0, TEN = 10.0E+0 )
00357 COMPLEX CZERO, CONE
00358 PARAMETER ( CZERO = ( 0.0E+0, 0.0E+0 ),
00359 $ CONE = ( 1.0E+0, 0.0E+0 ) )
00360 INTEGER MAXTYP
00361 PARAMETER ( MAXTYP = 21 )
00362
00363
00364 LOGICAL BADNN
00365 CHARACTER UPLO
00366 INTEGER I, IBTYPE, IBUPLO, IINFO, IJ, IL, IMODE, ITEMP,
00367 $ ITYPE, IU, J, JCOL, JSIZE, JTYPE, KA, KA9, KB,
00368 $ KB9, M, MTYPES, N, NERRS, NMATS, NMAX, NTEST,
00369 $ NTESTT
00370 REAL ABSTOL, ANINV, ANORM, COND, OVFL, RTOVFL,
00371 $ RTUNFL, ULP, ULPINV, UNFL, VL, VU
00372
00373
00374 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), ISEED2( 4 ),
00375 $ KMAGN( MAXTYP ), KMODE( MAXTYP ),
00376 $ KTYPE( MAXTYP )
00377
00378
00379 LOGICAL LSAME
00380 REAL SLAMCH, SLARND
00381 EXTERNAL LSAME, SLAMCH, SLARND
00382
00383
00384 EXTERNAL CHBGV, CHBGVD, CHBGVX, CHEGV, CHEGVD, CHEGVX,
00385 $ CHPGV, CHPGVD, CHPGVX, CLACPY, CLASET, CLATMR,
00386 $ CLATMS, CSGT01, SLABAD, SLAFTS, SLASUM, XERBLA
00387
00388
00389 INTRINSIC ABS, MAX, MIN, REAL, SQRT
00390
00391
00392 DATA KTYPE / 1, 2, 5*4, 5*5, 3*8, 6*9 /
00393 DATA KMAGN / 2*1, 1, 1, 1, 2, 3, 1, 1, 1, 2, 3, 1,
00394 $ 2, 3, 6*1 /
00395 DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0,
00396 $ 0, 0, 6*4 /
00397
00398
00399
00400
00401
00402 NTESTT = 0
00403 INFO = 0
00404
00405 BADNN = .FALSE.
00406 NMAX = 0
00407 DO 10 J = 1, NSIZES
00408 NMAX = MAX( NMAX, NN( J ) )
00409 IF( NN( J ).LT.0 )
00410 $ BADNN = .TRUE.
00411 10 CONTINUE
00412
00413
00414
00415 IF( NSIZES.LT.0 ) THEN
00416 INFO = -1
00417 ELSE IF( BADNN ) THEN
00418 INFO = -2
00419 ELSE IF( NTYPES.LT.0 ) THEN
00420 INFO = -3
00421 ELSE IF( LDA.LE.1 .OR. LDA.LT.NMAX ) THEN
00422 INFO = -9
00423 ELSE IF( LDZ.LE.1 .OR. LDZ.LT.NMAX ) THEN
00424 INFO = -16
00425 ELSE IF( 2*MAX( NMAX, 2 )**2.GT.NWORK ) THEN
00426 INFO = -21
00427 ELSE IF( 2*MAX( NMAX, 2 )**2.GT.LRWORK ) THEN
00428 INFO = -23
00429 ELSE IF( 2*MAX( NMAX, 2 )**2.GT.LIWORK ) THEN
00430 INFO = -25
00431 END IF
00432
00433 IF( INFO.NE.0 ) THEN
00434 CALL XERBLA( 'CDRVSG', -INFO )
00435 RETURN
00436 END IF
00437
00438
00439
00440 IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 )
00441 $ RETURN
00442
00443
00444
00445 UNFL = SLAMCH( 'Safe minimum' )
00446 OVFL = SLAMCH( 'Overflow' )
00447 CALL SLABAD( UNFL, OVFL )
00448 ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
00449 ULPINV = ONE / ULP
00450 RTUNFL = SQRT( UNFL )
00451 RTOVFL = SQRT( OVFL )
00452
00453 DO 20 I = 1, 4
00454 ISEED2( I ) = ISEED( I )
00455 20 CONTINUE
00456
00457
00458
00459 NERRS = 0
00460 NMATS = 0
00461
00462 DO 650 JSIZE = 1, NSIZES
00463 N = NN( JSIZE )
00464 ANINV = ONE / REAL( MAX( 1, N ) )
00465
00466 IF( NSIZES.NE.1 ) THEN
00467 MTYPES = MIN( MAXTYP, NTYPES )
00468 ELSE
00469 MTYPES = MIN( MAXTYP+1, NTYPES )
00470 END IF
00471
00472 KA9 = 0
00473 KB9 = 0
00474 DO 640 JTYPE = 1, MTYPES
00475 IF( .NOT.DOTYPE( JTYPE ) )
00476 $ GO TO 640
00477 NMATS = NMATS + 1
00478 NTEST = 0
00479
00480 DO 30 J = 1, 4
00481 IOLDSD( J ) = ISEED( J )
00482 30 CONTINUE
00483
00484
00485
00486
00487
00488
00489
00490
00491
00492
00493
00494
00495
00496
00497
00498
00499 IF( MTYPES.GT.MAXTYP )
00500 $ GO TO 90
00501
00502 ITYPE = KTYPE( JTYPE )
00503 IMODE = KMODE( JTYPE )
00504
00505
00506
00507 GO TO ( 40, 50, 60 )KMAGN( JTYPE )
00508
00509 40 CONTINUE
00510 ANORM = ONE
00511 GO TO 70
00512
00513 50 CONTINUE
00514 ANORM = ( RTOVFL*ULP )*ANINV
00515 GO TO 70
00516
00517 60 CONTINUE
00518 ANORM = RTUNFL*N*ULPINV
00519 GO TO 70
00520
00521 70 CONTINUE
00522
00523 IINFO = 0
00524 COND = ULPINV
00525
00526
00527
00528 IF( ITYPE.EQ.1 ) THEN
00529
00530
00531
00532 KA = 0
00533 KB = 0
00534 CALL CLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
00535
00536 ELSE IF( ITYPE.EQ.2 ) THEN
00537
00538
00539
00540 KA = 0
00541 KB = 0
00542 CALL CLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA )
00543 DO 80 JCOL = 1, N
00544 A( JCOL, JCOL ) = ANORM
00545 80 CONTINUE
00546
00547 ELSE IF( ITYPE.EQ.4 ) THEN
00548
00549
00550
00551 KA = 0
00552 KB = 0
00553 CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
00554 $ ANORM, 0, 0, 'N', A, LDA, WORK, IINFO )
00555
00556 ELSE IF( ITYPE.EQ.5 ) THEN
00557
00558
00559
00560 KA = MAX( 0, N-1 )
00561 KB = KA
00562 CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
00563 $ ANORM, N, N, 'N', A, LDA, WORK, IINFO )
00564
00565 ELSE IF( ITYPE.EQ.7 ) THEN
00566
00567
00568
00569 KA = 0
00570 KB = 0
00571 CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
00572 $ 'T', 'N', WORK( N+1 ), 1, ONE,
00573 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, 0, 0,
00574 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
00575
00576 ELSE IF( ITYPE.EQ.8 ) THEN
00577
00578
00579
00580 KA = MAX( 0, N-1 )
00581 KB = KA
00582 CALL CLATMR( N, N, 'S', ISEED, 'H', WORK, 6, ONE, CONE,
00583 $ 'T', 'N', WORK( N+1 ), 1, ONE,
00584 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, N, N,
00585 $ ZERO, ANORM, 'NO', A, LDA, IWORK, IINFO )
00586
00587 ELSE IF( ITYPE.EQ.9 ) THEN
00588
00589
00590
00591
00592
00593
00594
00595
00596
00597
00598
00599
00600 KB9 = KB9 + 1
00601 IF( KB9.GT.KA9 ) THEN
00602 KA9 = KA9 + 1
00603 KB9 = 1
00604 END IF
00605 KA = MAX( 0, MIN( N-1, KA9 ) )
00606 KB = MAX( 0, MIN( N-1, KB9 ) )
00607 CALL CLATMS( N, N, 'S', ISEED, 'H', RWORK, IMODE, COND,
00608 $ ANORM, KA, KA, 'N', A, LDA, WORK, IINFO )
00609
00610 ELSE
00611
00612 IINFO = 1
00613 END IF
00614
00615 IF( IINFO.NE.0 ) THEN
00616 WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, JTYPE,
00617 $ IOLDSD
00618 INFO = ABS( IINFO )
00619 RETURN
00620 END IF
00621
00622 90 CONTINUE
00623
00624 ABSTOL = UNFL + UNFL
00625 IF( N.LE.1 ) THEN
00626 IL = 1
00627 IU = N
00628 ELSE
00629 IL = 1 + ( N-1 )*SLARND( 1, ISEED2 )
00630 IU = 1 + ( N-1 )*SLARND( 1, ISEED2 )
00631 IF( IL.GT.IU ) THEN
00632 ITEMP = IL
00633 IL = IU
00634 IU = ITEMP
00635 END IF
00636 END IF
00637
00638
00639
00640
00641
00642
00643
00644
00645
00646 DO 630 IBTYPE = 1, 3
00647
00648
00649
00650 DO 620 IBUPLO = 1, 2
00651 IF( IBUPLO.EQ.1 )
00652 $ UPLO = 'U'
00653 IF( IBUPLO.EQ.2 )
00654 $ UPLO = 'L'
00655
00656
00657
00658
00659 CALL CLATMS( N, N, 'U', ISEED, 'P', RWORK, 5, TEN,
00660 $ ONE, KB, KB, UPLO, B, LDB, WORK( N+1 ),
00661 $ IINFO )
00662
00663
00664
00665 NTEST = NTEST + 1
00666
00667 CALL CLACPY( ' ', N, N, A, LDA, Z, LDZ )
00668 CALL CLACPY( UPLO, N, N, B, LDB, BB, LDB )
00669
00670 CALL CHEGV( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D,
00671 $ WORK, NWORK, RWORK, IINFO )
00672 IF( IINFO.NE.0 ) THEN
00673 WRITE( NOUNIT, FMT = 9999 )'CHEGV(V,' // UPLO //
00674 $ ')', IINFO, N, JTYPE, IOLDSD
00675 INFO = ABS( IINFO )
00676 IF( IINFO.LT.0 ) THEN
00677 RETURN
00678 ELSE
00679 RESULT( NTEST ) = ULPINV
00680 GO TO 100
00681 END IF
00682 END IF
00683
00684
00685
00686 CALL CSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
00687 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
00688
00689
00690
00691 NTEST = NTEST + 1
00692
00693 CALL CLACPY( ' ', N, N, A, LDA, Z, LDZ )
00694 CALL CLACPY( UPLO, N, N, B, LDB, BB, LDB )
00695
00696 CALL CHEGVD( IBTYPE, 'V', UPLO, N, Z, LDZ, BB, LDB, D,
00697 $ WORK, NWORK, RWORK, LRWORK, IWORK,
00698 $ LIWORK, IINFO )
00699 IF( IINFO.NE.0 ) THEN
00700 WRITE( NOUNIT, FMT = 9999 )'CHEGVD(V,' // UPLO //
00701 $ ')', IINFO, N, JTYPE, IOLDSD
00702 INFO = ABS( IINFO )
00703 IF( IINFO.LT.0 ) THEN
00704 RETURN
00705 ELSE
00706 RESULT( NTEST ) = ULPINV
00707 GO TO 100
00708 END IF
00709 END IF
00710
00711
00712
00713 CALL CSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
00714 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
00715
00716
00717
00718 NTEST = NTEST + 1
00719
00720 CALL CLACPY( ' ', N, N, A, LDA, AB, LDA )
00721 CALL CLACPY( UPLO, N, N, B, LDB, BB, LDB )
00722
00723 CALL CHEGVX( IBTYPE, 'V', 'A', UPLO, N, AB, LDA, BB,
00724 $ LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
00725 $ LDZ, WORK, NWORK, RWORK, IWORK( N+1 ),
00726 $ IWORK, IINFO )
00727 IF( IINFO.NE.0 ) THEN
00728 WRITE( NOUNIT, FMT = 9999 )'CHEGVX(V,A' // UPLO //
00729 $ ')', IINFO, N, JTYPE, IOLDSD
00730 INFO = ABS( IINFO )
00731 IF( IINFO.LT.0 ) THEN
00732 RETURN
00733 ELSE
00734 RESULT( NTEST ) = ULPINV
00735 GO TO 100
00736 END IF
00737 END IF
00738
00739
00740
00741 CALL CSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
00742 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
00743
00744 NTEST = NTEST + 1
00745
00746 CALL CLACPY( ' ', N, N, A, LDA, AB, LDA )
00747 CALL CLACPY( UPLO, N, N, B, LDB, BB, LDB )
00748
00749
00750
00751
00752
00753
00754 VL = ZERO
00755 VU = ANORM
00756 CALL CHEGVX( IBTYPE, 'V', 'V', UPLO, N, AB, LDA, BB,
00757 $ LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
00758 $ LDZ, WORK, NWORK, RWORK, IWORK( N+1 ),
00759 $ IWORK, IINFO )
00760 IF( IINFO.NE.0 ) THEN
00761 WRITE( NOUNIT, FMT = 9999 )'CHEGVX(V,V,' //
00762 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
00763 INFO = ABS( IINFO )
00764 IF( IINFO.LT.0 ) THEN
00765 RETURN
00766 ELSE
00767 RESULT( NTEST ) = ULPINV
00768 GO TO 100
00769 END IF
00770 END IF
00771
00772
00773
00774 CALL CSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
00775 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
00776
00777 NTEST = NTEST + 1
00778
00779 CALL CLACPY( ' ', N, N, A, LDA, AB, LDA )
00780 CALL CLACPY( UPLO, N, N, B, LDB, BB, LDB )
00781
00782 CALL CHEGVX( IBTYPE, 'V', 'I', UPLO, N, AB, LDA, BB,
00783 $ LDB, VL, VU, IL, IU, ABSTOL, M, D, Z,
00784 $ LDZ, WORK, NWORK, RWORK, IWORK( N+1 ),
00785 $ IWORK, IINFO )
00786 IF( IINFO.NE.0 ) THEN
00787 WRITE( NOUNIT, FMT = 9999 )'CHEGVX(V,I,' //
00788 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
00789 INFO = ABS( IINFO )
00790 IF( IINFO.LT.0 ) THEN
00791 RETURN
00792 ELSE
00793 RESULT( NTEST ) = ULPINV
00794 GO TO 100
00795 END IF
00796 END IF
00797
00798
00799
00800 CALL CSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
00801 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
00802
00803 100 CONTINUE
00804
00805
00806
00807 NTEST = NTEST + 1
00808
00809
00810
00811 IF( LSAME( UPLO, 'U' ) ) THEN
00812 IJ = 1
00813 DO 120 J = 1, N
00814 DO 110 I = 1, J
00815 AP( IJ ) = A( I, J )
00816 BP( IJ ) = B( I, J )
00817 IJ = IJ + 1
00818 110 CONTINUE
00819 120 CONTINUE
00820 ELSE
00821 IJ = 1
00822 DO 140 J = 1, N
00823 DO 130 I = J, N
00824 AP( IJ ) = A( I, J )
00825 BP( IJ ) = B( I, J )
00826 IJ = IJ + 1
00827 130 CONTINUE
00828 140 CONTINUE
00829 END IF
00830
00831 CALL CHPGV( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ,
00832 $ WORK, RWORK, IINFO )
00833 IF( IINFO.NE.0 ) THEN
00834 WRITE( NOUNIT, FMT = 9999 )'CHPGV(V,' // UPLO //
00835 $ ')', IINFO, N, JTYPE, IOLDSD
00836 INFO = ABS( IINFO )
00837 IF( IINFO.LT.0 ) THEN
00838 RETURN
00839 ELSE
00840 RESULT( NTEST ) = ULPINV
00841 GO TO 310
00842 END IF
00843 END IF
00844
00845
00846
00847 CALL CSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
00848 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
00849
00850
00851
00852 NTEST = NTEST + 1
00853
00854
00855
00856 IF( LSAME( UPLO, 'U' ) ) THEN
00857 IJ = 1
00858 DO 160 J = 1, N
00859 DO 150 I = 1, J
00860 AP( IJ ) = A( I, J )
00861 BP( IJ ) = B( I, J )
00862 IJ = IJ + 1
00863 150 CONTINUE
00864 160 CONTINUE
00865 ELSE
00866 IJ = 1
00867 DO 180 J = 1, N
00868 DO 170 I = J, N
00869 AP( IJ ) = A( I, J )
00870 BP( IJ ) = B( I, J )
00871 IJ = IJ + 1
00872 170 CONTINUE
00873 180 CONTINUE
00874 END IF
00875
00876 CALL CHPGVD( IBTYPE, 'V', UPLO, N, AP, BP, D, Z, LDZ,
00877 $ WORK, NWORK, RWORK, LRWORK, IWORK,
00878 $ LIWORK, IINFO )
00879 IF( IINFO.NE.0 ) THEN
00880 WRITE( NOUNIT, FMT = 9999 )'CHPGVD(V,' // UPLO //
00881 $ ')', IINFO, N, JTYPE, IOLDSD
00882 INFO = ABS( IINFO )
00883 IF( IINFO.LT.0 ) THEN
00884 RETURN
00885 ELSE
00886 RESULT( NTEST ) = ULPINV
00887 GO TO 310
00888 END IF
00889 END IF
00890
00891
00892
00893 CALL CSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
00894 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
00895
00896
00897
00898 NTEST = NTEST + 1
00899
00900
00901
00902 IF( LSAME( UPLO, 'U' ) ) THEN
00903 IJ = 1
00904 DO 200 J = 1, N
00905 DO 190 I = 1, J
00906 AP( IJ ) = A( I, J )
00907 BP( IJ ) = B( I, J )
00908 IJ = IJ + 1
00909 190 CONTINUE
00910 200 CONTINUE
00911 ELSE
00912 IJ = 1
00913 DO 220 J = 1, N
00914 DO 210 I = J, N
00915 AP( IJ ) = A( I, J )
00916 BP( IJ ) = B( I, J )
00917 IJ = IJ + 1
00918 210 CONTINUE
00919 220 CONTINUE
00920 END IF
00921
00922 CALL CHPGVX( IBTYPE, 'V', 'A', UPLO, N, AP, BP, VL,
00923 $ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
00924 $ RWORK, IWORK( N+1 ), IWORK, INFO )
00925 IF( IINFO.NE.0 ) THEN
00926 WRITE( NOUNIT, FMT = 9999 )'CHPGVX(V,A' // UPLO //
00927 $ ')', IINFO, N, JTYPE, IOLDSD
00928 INFO = ABS( IINFO )
00929 IF( IINFO.LT.0 ) THEN
00930 RETURN
00931 ELSE
00932 RESULT( NTEST ) = ULPINV
00933 GO TO 310
00934 END IF
00935 END IF
00936
00937
00938
00939 CALL CSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
00940 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
00941
00942 NTEST = NTEST + 1
00943
00944
00945
00946 IF( LSAME( UPLO, 'U' ) ) THEN
00947 IJ = 1
00948 DO 240 J = 1, N
00949 DO 230 I = 1, J
00950 AP( IJ ) = A( I, J )
00951 BP( IJ ) = B( I, J )
00952 IJ = IJ + 1
00953 230 CONTINUE
00954 240 CONTINUE
00955 ELSE
00956 IJ = 1
00957 DO 260 J = 1, N
00958 DO 250 I = J, N
00959 AP( IJ ) = A( I, J )
00960 BP( IJ ) = B( I, J )
00961 IJ = IJ + 1
00962 250 CONTINUE
00963 260 CONTINUE
00964 END IF
00965
00966 VL = ZERO
00967 VU = ANORM
00968 CALL CHPGVX( IBTYPE, 'V', 'V', UPLO, N, AP, BP, VL,
00969 $ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
00970 $ RWORK, IWORK( N+1 ), IWORK, INFO )
00971 IF( IINFO.NE.0 ) THEN
00972 WRITE( NOUNIT, FMT = 9999 )'CHPGVX(V,V' // UPLO //
00973 $ ')', IINFO, N, JTYPE, IOLDSD
00974 INFO = ABS( IINFO )
00975 IF( IINFO.LT.0 ) THEN
00976 RETURN
00977 ELSE
00978 RESULT( NTEST ) = ULPINV
00979 GO TO 310
00980 END IF
00981 END IF
00982
00983
00984
00985 CALL CSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
00986 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
00987
00988 NTEST = NTEST + 1
00989
00990
00991
00992 IF( LSAME( UPLO, 'U' ) ) THEN
00993 IJ = 1
00994 DO 280 J = 1, N
00995 DO 270 I = 1, J
00996 AP( IJ ) = A( I, J )
00997 BP( IJ ) = B( I, J )
00998 IJ = IJ + 1
00999 270 CONTINUE
01000 280 CONTINUE
01001 ELSE
01002 IJ = 1
01003 DO 300 J = 1, N
01004 DO 290 I = J, N
01005 AP( IJ ) = A( I, J )
01006 BP( IJ ) = B( I, J )
01007 IJ = IJ + 1
01008 290 CONTINUE
01009 300 CONTINUE
01010 END IF
01011
01012 CALL CHPGVX( IBTYPE, 'V', 'I', UPLO, N, AP, BP, VL,
01013 $ VU, IL, IU, ABSTOL, M, D, Z, LDZ, WORK,
01014 $ RWORK, IWORK( N+1 ), IWORK, INFO )
01015 IF( IINFO.NE.0 ) THEN
01016 WRITE( NOUNIT, FMT = 9999 )'CHPGVX(V,I' // UPLO //
01017 $ ')', IINFO, N, JTYPE, IOLDSD
01018 INFO = ABS( IINFO )
01019 IF( IINFO.LT.0 ) THEN
01020 RETURN
01021 ELSE
01022 RESULT( NTEST ) = ULPINV
01023 GO TO 310
01024 END IF
01025 END IF
01026
01027
01028
01029 CALL CSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
01030 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
01031
01032 310 CONTINUE
01033
01034 IF( IBTYPE.EQ.1 ) THEN
01035
01036
01037
01038 NTEST = NTEST + 1
01039
01040
01041
01042 IF( LSAME( UPLO, 'U' ) ) THEN
01043 DO 340 J = 1, N
01044 DO 320 I = MAX( 1, J-KA ), J
01045 AB( KA+1+I-J, J ) = A( I, J )
01046 320 CONTINUE
01047 DO 330 I = MAX( 1, J-KB ), J
01048 BB( KB+1+I-J, J ) = B( I, J )
01049 330 CONTINUE
01050 340 CONTINUE
01051 ELSE
01052 DO 370 J = 1, N
01053 DO 350 I = J, MIN( N, J+KA )
01054 AB( 1+I-J, J ) = A( I, J )
01055 350 CONTINUE
01056 DO 360 I = J, MIN( N, J+KB )
01057 BB( 1+I-J, J ) = B( I, J )
01058 360 CONTINUE
01059 370 CONTINUE
01060 END IF
01061
01062 CALL CHBGV( 'V', UPLO, N, KA, KB, AB, LDA, BB, LDB,
01063 $ D, Z, LDZ, WORK, RWORK, IINFO )
01064 IF( IINFO.NE.0 ) THEN
01065 WRITE( NOUNIT, FMT = 9999 )'CHBGV(V,' //
01066 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
01067 INFO = ABS( IINFO )
01068 IF( IINFO.LT.0 ) THEN
01069 RETURN
01070 ELSE
01071 RESULT( NTEST ) = ULPINV
01072 GO TO 620
01073 END IF
01074 END IF
01075
01076
01077
01078 CALL CSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
01079 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
01080
01081
01082
01083 NTEST = NTEST + 1
01084
01085
01086
01087 IF( LSAME( UPLO, 'U' ) ) THEN
01088 DO 400 J = 1, N
01089 DO 380 I = MAX( 1, J-KA ), J
01090 AB( KA+1+I-J, J ) = A( I, J )
01091 380 CONTINUE
01092 DO 390 I = MAX( 1, J-KB ), J
01093 BB( KB+1+I-J, J ) = B( I, J )
01094 390 CONTINUE
01095 400 CONTINUE
01096 ELSE
01097 DO 430 J = 1, N
01098 DO 410 I = J, MIN( N, J+KA )
01099 AB( 1+I-J, J ) = A( I, J )
01100 410 CONTINUE
01101 DO 420 I = J, MIN( N, J+KB )
01102 BB( 1+I-J, J ) = B( I, J )
01103 420 CONTINUE
01104 430 CONTINUE
01105 END IF
01106
01107 CALL CHBGVD( 'V', UPLO, N, KA, KB, AB, LDA, BB,
01108 $ LDB, D, Z, LDZ, WORK, NWORK, RWORK,
01109 $ LRWORK, IWORK, LIWORK, IINFO )
01110 IF( IINFO.NE.0 ) THEN
01111 WRITE( NOUNIT, FMT = 9999 )'CHBGVD(V,' //
01112 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
01113 INFO = ABS( IINFO )
01114 IF( IINFO.LT.0 ) THEN
01115 RETURN
01116 ELSE
01117 RESULT( NTEST ) = ULPINV
01118 GO TO 620
01119 END IF
01120 END IF
01121
01122
01123
01124 CALL CSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
01125 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
01126
01127
01128
01129 NTEST = NTEST + 1
01130
01131
01132
01133 IF( LSAME( UPLO, 'U' ) ) THEN
01134 DO 460 J = 1, N
01135 DO 440 I = MAX( 1, J-KA ), J
01136 AB( KA+1+I-J, J ) = A( I, J )
01137 440 CONTINUE
01138 DO 450 I = MAX( 1, J-KB ), J
01139 BB( KB+1+I-J, J ) = B( I, J )
01140 450 CONTINUE
01141 460 CONTINUE
01142 ELSE
01143 DO 490 J = 1, N
01144 DO 470 I = J, MIN( N, J+KA )
01145 AB( 1+I-J, J ) = A( I, J )
01146 470 CONTINUE
01147 DO 480 I = J, MIN( N, J+KB )
01148 BB( 1+I-J, J ) = B( I, J )
01149 480 CONTINUE
01150 490 CONTINUE
01151 END IF
01152
01153 CALL CHBGVX( 'V', 'A', UPLO, N, KA, KB, AB, LDA,
01154 $ BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
01155 $ IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK,
01156 $ IWORK( N+1 ), IWORK, IINFO )
01157 IF( IINFO.NE.0 ) THEN
01158 WRITE( NOUNIT, FMT = 9999 )'CHBGVX(V,A' //
01159 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
01160 INFO = ABS( IINFO )
01161 IF( IINFO.LT.0 ) THEN
01162 RETURN
01163 ELSE
01164 RESULT( NTEST ) = ULPINV
01165 GO TO 620
01166 END IF
01167 END IF
01168
01169
01170
01171 CALL CSGT01( IBTYPE, UPLO, N, N, A, LDA, B, LDB, Z,
01172 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
01173
01174 NTEST = NTEST + 1
01175
01176
01177
01178 IF( LSAME( UPLO, 'U' ) ) THEN
01179 DO 520 J = 1, N
01180 DO 500 I = MAX( 1, J-KA ), J
01181 AB( KA+1+I-J, J ) = A( I, J )
01182 500 CONTINUE
01183 DO 510 I = MAX( 1, J-KB ), J
01184 BB( KB+1+I-J, J ) = B( I, J )
01185 510 CONTINUE
01186 520 CONTINUE
01187 ELSE
01188 DO 550 J = 1, N
01189 DO 530 I = J, MIN( N, J+KA )
01190 AB( 1+I-J, J ) = A( I, J )
01191 530 CONTINUE
01192 DO 540 I = J, MIN( N, J+KB )
01193 BB( 1+I-J, J ) = B( I, J )
01194 540 CONTINUE
01195 550 CONTINUE
01196 END IF
01197
01198 VL = ZERO
01199 VU = ANORM
01200 CALL CHBGVX( 'V', 'V', UPLO, N, KA, KB, AB, LDA,
01201 $ BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
01202 $ IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK,
01203 $ IWORK( N+1 ), IWORK, IINFO )
01204 IF( IINFO.NE.0 ) THEN
01205 WRITE( NOUNIT, FMT = 9999 )'CHBGVX(V,V' //
01206 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
01207 INFO = ABS( IINFO )
01208 IF( IINFO.LT.0 ) THEN
01209 RETURN
01210 ELSE
01211 RESULT( NTEST ) = ULPINV
01212 GO TO 620
01213 END IF
01214 END IF
01215
01216
01217
01218 CALL CSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
01219 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
01220
01221 NTEST = NTEST + 1
01222
01223
01224
01225 IF( LSAME( UPLO, 'U' ) ) THEN
01226 DO 580 J = 1, N
01227 DO 560 I = MAX( 1, J-KA ), J
01228 AB( KA+1+I-J, J ) = A( I, J )
01229 560 CONTINUE
01230 DO 570 I = MAX( 1, J-KB ), J
01231 BB( KB+1+I-J, J ) = B( I, J )
01232 570 CONTINUE
01233 580 CONTINUE
01234 ELSE
01235 DO 610 J = 1, N
01236 DO 590 I = J, MIN( N, J+KA )
01237 AB( 1+I-J, J ) = A( I, J )
01238 590 CONTINUE
01239 DO 600 I = J, MIN( N, J+KB )
01240 BB( 1+I-J, J ) = B( I, J )
01241 600 CONTINUE
01242 610 CONTINUE
01243 END IF
01244
01245 CALL CHBGVX( 'V', 'I', UPLO, N, KA, KB, AB, LDA,
01246 $ BB, LDB, BP, MAX( 1, N ), VL, VU, IL,
01247 $ IU, ABSTOL, M, D, Z, LDZ, WORK, RWORK,
01248 $ IWORK( N+1 ), IWORK, IINFO )
01249 IF( IINFO.NE.0 ) THEN
01250 WRITE( NOUNIT, FMT = 9999 )'CHBGVX(V,I' //
01251 $ UPLO // ')', IINFO, N, JTYPE, IOLDSD
01252 INFO = ABS( IINFO )
01253 IF( IINFO.LT.0 ) THEN
01254 RETURN
01255 ELSE
01256 RESULT( NTEST ) = ULPINV
01257 GO TO 620
01258 END IF
01259 END IF
01260
01261
01262
01263 CALL CSGT01( IBTYPE, UPLO, N, M, A, LDA, B, LDB, Z,
01264 $ LDZ, D, WORK, RWORK, RESULT( NTEST ) )
01265
01266 END IF
01267
01268 620 CONTINUE
01269 630 CONTINUE
01270
01271
01272
01273 NTESTT = NTESTT + NTEST
01274 CALL SLAFTS( 'CSG', N, N, JTYPE, NTEST, RESULT, IOLDSD,
01275 $ THRESH, NOUNIT, NERRS )
01276 640 CONTINUE
01277 650 CONTINUE
01278
01279
01280
01281 CALL SLASUM( 'CSG', NOUNIT, NERRS, NTESTT )
01282
01283 RETURN
01284
01285 9999 FORMAT( ' CDRVSG: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
01286 $ I6, ', JTYPE=', I6, ', ISEED=(', 3( I5, ',' ), I5, ')' )
01287
01288
01289
01290 END