00001 SUBROUTINE ZDRVHE( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, NMAX,
00002 $ A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK,
00003 $ NOUT )
00004
00005
00006
00007
00008
00009
00010 LOGICAL TSTERR
00011 INTEGER NMAX, NN, NOUT, NRHS
00012 DOUBLE PRECISION THRESH
00013
00014
00015 LOGICAL DOTYPE( * )
00016 INTEGER IWORK( * ), NVAL( * )
00017 DOUBLE PRECISION RWORK( * )
00018 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
00019 $ WORK( * ), X( * ), XACT( * )
00020
00021
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 DOUBLE PRECISION ONE, ZERO
00086 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
00087 INTEGER NTYPES, NTESTS
00088 PARAMETER ( NTYPES = 10, NTESTS = 6 )
00089 INTEGER NFACT
00090 PARAMETER ( NFACT = 2 )
00091
00092
00093 LOGICAL ZEROT
00094 CHARACTER DIST, EQUED, FACT, TYPE, UPLO, XTYPE
00095 CHARACTER*3 PATH
00096 INTEGER I, I1, I2, IFACT, IMAT, IN, INFO, IOFF, IUPLO,
00097 $ IZERO, J, K, K1, KL, KU, LDA, LWORK, MODE, N,
00098 $ NB, NBMIN, NERRS, NFAIL, NIMAT, NRUN, NT,
00099 $ N_ERR_BNDS
00100 DOUBLE PRECISION AINVNM, ANORM, CNDNUM, RCOND, RCONDC,
00101 $ RPVGRW_SVXX
00102
00103
00104 CHARACTER FACTS( NFACT ), UPLOS( 2 )
00105 INTEGER ISEED( 4 ), ISEEDY( 4 )
00106 DOUBLE PRECISION RESULT( NTESTS ), BERR( NRHS ),
00107 $ ERRBNDS_N( NRHS, 3 ), ERRBNDS_C( NRHS, 3 )
00108
00109
00110 DOUBLE PRECISION DGET06, ZLANHE
00111 EXTERNAL DGET06, ZLANHE
00112
00113
00114 EXTERNAL ALADHD, ALAERH, ALASVM, XLAENV, ZERRVX, ZGET04,
00115 $ ZHESV, ZHESVX, ZHET01, ZHETRF, ZHETRI, ZLACPY,
00116 $ ZLAIPD, ZLARHS, ZLASET, ZLATB4, ZLATMS, ZPOT02,
00117 $ ZPOT05, ZHESVXX
00118
00119
00120 LOGICAL LERR, OK
00121 CHARACTER*32 SRNAMT
00122 INTEGER INFOT, NUNIT
00123
00124
00125 COMMON / INFOC / INFOT, NUNIT, OK, LERR
00126 COMMON / SRNAMC / SRNAMT
00127
00128
00129 INTRINSIC DCMPLX, MAX, MIN
00130
00131
00132 DATA ISEEDY / 1988, 1989, 1990, 1991 /
00133 DATA UPLOS / 'U', 'L' / , FACTS / 'F', 'N' /
00134
00135
00136
00137
00138
00139 PATH( 1: 1 ) = 'Z'
00140 PATH( 2: 3 ) = 'HE'
00141 NRUN = 0
00142 NFAIL = 0
00143 NERRS = 0
00144 DO 10 I = 1, 4
00145 ISEED( I ) = ISEEDY( I )
00146 10 CONTINUE
00147 LWORK = MAX( 2*NMAX, NMAX*NRHS )
00148
00149
00150
00151 IF( TSTERR )
00152 $ CALL ZERRVX( PATH, NOUT )
00153 INFOT = 0
00154
00155
00156
00157 NB = 1
00158 NBMIN = 2
00159 CALL XLAENV( 1, NB )
00160 CALL XLAENV( 2, NBMIN )
00161
00162
00163
00164 DO 180 IN = 1, NN
00165 N = NVAL( IN )
00166 LDA = MAX( N, 1 )
00167 XTYPE = 'N'
00168 NIMAT = NTYPES
00169 IF( N.LE.0 )
00170 $ NIMAT = 1
00171
00172 DO 170 IMAT = 1, NIMAT
00173
00174
00175
00176 IF( .NOT.DOTYPE( IMAT ) )
00177 $ GO TO 170
00178
00179
00180
00181 ZEROT = IMAT.GE.3 .AND. IMAT.LE.6
00182 IF( ZEROT .AND. N.LT.IMAT-2 )
00183 $ GO TO 170
00184
00185
00186
00187 DO 160 IUPLO = 1, 2
00188 UPLO = UPLOS( IUPLO )
00189
00190
00191
00192
00193 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
00194 $ CNDNUM, DIST )
00195
00196 SRNAMT = 'ZLATMS'
00197 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE,
00198 $ CNDNUM, ANORM, KL, KU, UPLO, A, LDA, WORK,
00199 $ INFO )
00200
00201
00202
00203 IF( INFO.NE.0 ) THEN
00204 CALL ALAERH( PATH, 'ZLATMS', INFO, 0, UPLO, N, N, -1,
00205 $ -1, -1, IMAT, NFAIL, NERRS, NOUT )
00206 GO TO 160
00207 END IF
00208
00209
00210
00211
00212 IF( ZEROT ) THEN
00213 IF( IMAT.EQ.3 ) THEN
00214 IZERO = 1
00215 ELSE IF( IMAT.EQ.4 ) THEN
00216 IZERO = N
00217 ELSE
00218 IZERO = N / 2 + 1
00219 END IF
00220
00221 IF( IMAT.LT.6 ) THEN
00222
00223
00224
00225 IF( IUPLO.EQ.1 ) THEN
00226 IOFF = ( IZERO-1 )*LDA
00227 DO 20 I = 1, IZERO - 1
00228 A( IOFF+I ) = ZERO
00229 20 CONTINUE
00230 IOFF = IOFF + IZERO
00231 DO 30 I = IZERO, N
00232 A( IOFF ) = ZERO
00233 IOFF = IOFF + LDA
00234 30 CONTINUE
00235 ELSE
00236 IOFF = IZERO
00237 DO 40 I = 1, IZERO - 1
00238 A( IOFF ) = ZERO
00239 IOFF = IOFF + LDA
00240 40 CONTINUE
00241 IOFF = IOFF - IZERO
00242 DO 50 I = IZERO, N
00243 A( IOFF+I ) = ZERO
00244 50 CONTINUE
00245 END IF
00246 ELSE
00247 IOFF = 0
00248 IF( IUPLO.EQ.1 ) THEN
00249
00250
00251
00252 DO 70 J = 1, N
00253 I2 = MIN( J, IZERO )
00254 DO 60 I = 1, I2
00255 A( IOFF+I ) = ZERO
00256 60 CONTINUE
00257 IOFF = IOFF + LDA
00258 70 CONTINUE
00259 ELSE
00260
00261
00262
00263 DO 90 J = 1, N
00264 I1 = MAX( J, IZERO )
00265 DO 80 I = I1, N
00266 A( IOFF+I ) = ZERO
00267 80 CONTINUE
00268 IOFF = IOFF + LDA
00269 90 CONTINUE
00270 END IF
00271 END IF
00272 ELSE
00273 IZERO = 0
00274 END IF
00275
00276
00277
00278 CALL ZLAIPD( N, A, LDA+1, 0 )
00279
00280 DO 150 IFACT = 1, NFACT
00281
00282
00283
00284 FACT = FACTS( IFACT )
00285
00286
00287
00288
00289 IF( ZEROT ) THEN
00290 IF( IFACT.EQ.1 )
00291 $ GO TO 150
00292 RCONDC = ZERO
00293
00294 ELSE IF( IFACT.EQ.1 ) THEN
00295
00296
00297
00298 ANORM = ZLANHE( '1', UPLO, N, A, LDA, RWORK )
00299
00300
00301
00302 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
00303 CALL ZHETRF( UPLO, N, AFAC, LDA, IWORK, WORK,
00304 $ LWORK, INFO )
00305
00306
00307
00308 CALL ZLACPY( UPLO, N, N, AFAC, LDA, AINV, LDA )
00309 CALL ZHETRI( UPLO, N, AINV, LDA, IWORK, WORK,
00310 $ INFO )
00311 AINVNM = ZLANHE( '1', UPLO, N, AINV, LDA, RWORK )
00312
00313
00314
00315 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
00316 RCONDC = ONE
00317 ELSE
00318 RCONDC = ( ONE / ANORM ) / AINVNM
00319 END IF
00320 END IF
00321
00322
00323
00324 SRNAMT = 'ZLARHS'
00325 CALL ZLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
00326 $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
00327 $ INFO )
00328 XTYPE = 'C'
00329
00330
00331
00332 IF( IFACT.EQ.2 ) THEN
00333 CALL ZLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
00334 CALL ZLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
00335
00336
00337
00338 SRNAMT = 'ZHESV '
00339 CALL ZHESV( UPLO, N, NRHS, AFAC, LDA, IWORK, X,
00340 $ LDA, WORK, LWORK, INFO )
00341
00342
00343
00344
00345 K = IZERO
00346 IF( K.GT.0 ) THEN
00347 100 CONTINUE
00348 IF( IWORK( K ).LT.0 ) THEN
00349 IF( IWORK( K ).NE.-K ) THEN
00350 K = -IWORK( K )
00351 GO TO 100
00352 END IF
00353 ELSE IF( IWORK( K ).NE.K ) THEN
00354 K = IWORK( K )
00355 GO TO 100
00356 END IF
00357 END IF
00358
00359
00360
00361 IF( INFO.NE.K ) THEN
00362 CALL ALAERH( PATH, 'ZHESV ', INFO, K, UPLO, N,
00363 $ N, -1, -1, NRHS, IMAT, NFAIL,
00364 $ NERRS, NOUT )
00365 GO TO 120
00366 ELSE IF( INFO.NE.0 ) THEN
00367 GO TO 120
00368 END IF
00369
00370
00371
00372
00373 CALL ZHET01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
00374 $ AINV, LDA, RWORK, RESULT( 1 ) )
00375
00376
00377
00378 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
00379 CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
00380 $ LDA, RWORK, RESULT( 2 ) )
00381
00382
00383
00384 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
00385 $ RESULT( 3 ) )
00386 NT = 3
00387
00388
00389
00390
00391 DO 110 K = 1, NT
00392 IF( RESULT( K ).GE.THRESH ) THEN
00393 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00394 $ CALL ALADHD( NOUT, PATH )
00395 WRITE( NOUT, FMT = 9999 )'ZHESV ', UPLO, N,
00396 $ IMAT, K, RESULT( K )
00397 NFAIL = NFAIL + 1
00398 END IF
00399 110 CONTINUE
00400 NRUN = NRUN + NT
00401 120 CONTINUE
00402 END IF
00403
00404
00405
00406 IF( IFACT.EQ.2 )
00407 $ CALL ZLASET( UPLO, N, N, DCMPLX( ZERO ),
00408 $ DCMPLX( ZERO ), AFAC, LDA )
00409 CALL ZLASET( 'Full', N, NRHS, DCMPLX( ZERO ),
00410 $ DCMPLX( ZERO ), X, LDA )
00411
00412
00413
00414
00415 SRNAMT = 'ZHESVX'
00416 CALL ZHESVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, LDA,
00417 $ IWORK, B, LDA, X, LDA, RCOND, RWORK,
00418 $ RWORK( NRHS+1 ), WORK, LWORK,
00419 $ RWORK( 2*NRHS+1 ), INFO )
00420
00421
00422
00423
00424 K = IZERO
00425 IF( K.GT.0 ) THEN
00426 130 CONTINUE
00427 IF( IWORK( K ).LT.0 ) THEN
00428 IF( IWORK( K ).NE.-K ) THEN
00429 K = -IWORK( K )
00430 GO TO 130
00431 END IF
00432 ELSE IF( IWORK( K ).NE.K ) THEN
00433 K = IWORK( K )
00434 GO TO 130
00435 END IF
00436 END IF
00437
00438
00439
00440 IF( INFO.NE.K ) THEN
00441 CALL ALAERH( PATH, 'ZHESVX', INFO, K, FACT // UPLO,
00442 $ N, N, -1, -1, NRHS, IMAT, NFAIL,
00443 $ NERRS, NOUT )
00444 GO TO 150
00445 END IF
00446
00447 IF( INFO.EQ.0 ) THEN
00448 IF( IFACT.GE.2 ) THEN
00449
00450
00451
00452
00453 CALL ZHET01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
00454 $ AINV, LDA, RWORK( 2*NRHS+1 ),
00455 $ RESULT( 1 ) )
00456 K1 = 1
00457 ELSE
00458 K1 = 2
00459 END IF
00460
00461
00462
00463 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
00464 CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
00465 $ LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
00466
00467
00468
00469 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
00470 $ RESULT( 3 ) )
00471
00472
00473
00474 CALL ZPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
00475 $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
00476 $ RESULT( 4 ) )
00477 ELSE
00478 K1 = 6
00479 END IF
00480
00481
00482
00483
00484 RESULT( 6 ) = DGET06( RCOND, RCONDC )
00485
00486
00487
00488
00489 DO 140 K = K1, 6
00490 IF( RESULT( K ).GE.THRESH ) THEN
00491 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00492 $ CALL ALADHD( NOUT, PATH )
00493 WRITE( NOUT, FMT = 9998 )'ZHESVX', FACT, UPLO,
00494 $ N, IMAT, K, RESULT( K )
00495 NFAIL = NFAIL + 1
00496 END IF
00497 140 CONTINUE
00498 NRUN = NRUN + 7 - K1
00499
00500
00501
00502
00503
00504 IF( IFACT.EQ.2 )
00505 $ CALL ZLASET( UPLO, N, N, CMPLX( ZERO ),
00506 $ CMPLX( ZERO ), AFAC, LDA )
00507 CALL ZLASET( 'Full', N, NRHS, CMPLX( ZERO ),
00508 $ CMPLX( ZERO ), X, LDA )
00509
00510
00511
00512
00513 SRNAMT = 'ZHESVXX'
00514 N_ERR_BNDS = 3
00515 EQUED = 'N'
00516 CALL ZHESVXX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
00517 $ LDA, IWORK, EQUED, WORK( N+1 ), B, LDA, X,
00518 $ LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
00519 $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
00520 $ IWORK( N+1 ), INFO )
00521
00522
00523
00524
00525 K = IZERO
00526 IF( K.GT.0 ) THEN
00527 135 CONTINUE
00528 IF( IWORK( K ).LT.0 ) THEN
00529 IF( IWORK( K ).NE.-K ) THEN
00530 K = -IWORK( K )
00531 GO TO 135
00532 END IF
00533 ELSE IF( IWORK( K ).NE.K ) THEN
00534 K = IWORK( K )
00535 GO TO 135
00536 END IF
00537 END IF
00538
00539
00540
00541 IF( INFO.NE.K ) THEN
00542 CALL ALAERH( PATH, 'ZHESVXX', INFO, K,
00543 $ FACT // UPLO, N, N, -1, -1, NRHS, IMAT, NFAIL,
00544 $ NERRS, NOUT )
00545 GO TO 150
00546 END IF
00547
00548 IF( INFO.EQ.0 ) THEN
00549 IF( IFACT.GE.2 ) THEN
00550
00551
00552
00553
00554 CALL ZHET01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
00555 $ AINV, LDA, RWORK(2*NRHS+1),
00556 $ RESULT( 1 ) )
00557 K1 = 1
00558 ELSE
00559 K1 = 2
00560 END IF
00561
00562
00563
00564 CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
00565 CALL ZPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
00566 $ LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
00567 RESULT( 2 ) = 0.0
00568
00569
00570
00571 CALL ZGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
00572 $ RESULT( 3 ) )
00573
00574
00575
00576 CALL ZPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
00577 $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
00578 $ RESULT( 4 ) )
00579 ELSE
00580 K1 = 6
00581 END IF
00582
00583
00584
00585
00586 RESULT( 6 ) = DGET06( RCOND, RCONDC )
00587
00588
00589
00590
00591 DO 85 K = K1, 6
00592 IF( RESULT( K ).GE.THRESH ) THEN
00593 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00594 $ CALL ALADHD( NOUT, PATH )
00595 WRITE( NOUT, FMT = 9998 )'ZHESVXX',
00596 $ FACT, UPLO, N, IMAT, K,
00597 $ RESULT( K )
00598 NFAIL = NFAIL + 1
00599 END IF
00600 85 CONTINUE
00601 NRUN = NRUN + 7 - K1
00602
00603 150 CONTINUE
00604
00605 160 CONTINUE
00606 170 CONTINUE
00607 180 CONTINUE
00608
00609
00610
00611 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
00612
00613
00614
00615
00616 CALL ZEBCHVXX(THRESH, PATH)
00617
00618 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
00619 $ ', test ', I2, ', ratio =', G12.5 )
00620 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N =', I5,
00621 $ ', type ', I2, ', test ', I2, ', ratio =', G12.5 )
00622 RETURN
00623
00624
00625
00626 END