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