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