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, DSYTRI2, 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 LWORK = (N+NB+1)*(NB+3)
00305 CALL DSYTRI2( UPLO, N, AINV, LDA, IWORK, WORK,
00306 $ LWORK, INFO )
00307 AINVNM = DLANSY( '1', UPLO, N, AINV, LDA, RWORK )
00308
00309
00310
00311 IF( ANORM.LE.ZERO .OR. AINVNM.LE.ZERO ) THEN
00312 RCONDC = ONE
00313 ELSE
00314 RCONDC = ( ONE / ANORM ) / AINVNM
00315 END IF
00316 END IF
00317
00318
00319
00320 SRNAMT = 'DLARHS'
00321 CALL DLARHS( PATH, XTYPE, UPLO, ' ', N, N, KL, KU,
00322 $ NRHS, A, LDA, XACT, LDA, B, LDA, ISEED,
00323 $ INFO )
00324 XTYPE = 'C'
00325
00326
00327
00328 IF( IFACT.EQ.2 ) THEN
00329 CALL DLACPY( UPLO, N, N, A, LDA, AFAC, LDA )
00330 CALL DLACPY( 'Full', N, NRHS, B, LDA, X, LDA )
00331
00332
00333
00334 SRNAMT = 'DSYSV '
00335 CALL DSYSV( UPLO, N, NRHS, AFAC, LDA, IWORK, X,
00336 $ LDA, WORK, LWORK, INFO )
00337
00338
00339
00340
00341 K = IZERO
00342 IF( K.GT.0 ) THEN
00343 100 CONTINUE
00344 IF( IWORK( K ).LT.0 ) THEN
00345 IF( IWORK( K ).NE.-K ) THEN
00346 K = -IWORK( K )
00347 GO TO 100
00348 END IF
00349 ELSE IF( IWORK( K ).NE.K ) THEN
00350 K = IWORK( K )
00351 GO TO 100
00352 END IF
00353 END IF
00354
00355
00356
00357 IF( INFO.NE.K ) THEN
00358 CALL ALAERH( PATH, 'DSYSV ', INFO, K, UPLO, N,
00359 $ N, -1, -1, NRHS, IMAT, NFAIL,
00360 $ NERRS, NOUT )
00361 GO TO 120
00362 ELSE IF( INFO.NE.0 ) THEN
00363 GO TO 120
00364 END IF
00365
00366
00367
00368
00369 CALL DSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
00370 $ AINV, LDA, RWORK, RESULT( 1 ) )
00371
00372
00373
00374 CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
00375 CALL DPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
00376 $ LDA, RWORK, RESULT( 2 ) )
00377
00378
00379
00380 CALL DGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
00381 $ RESULT( 3 ) )
00382 NT = 3
00383
00384
00385
00386
00387 DO 110 K = 1, NT
00388 IF( RESULT( K ).GE.THRESH ) THEN
00389 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00390 $ CALL ALADHD( NOUT, PATH )
00391 WRITE( NOUT, FMT = 9999 )'DSYSV ', UPLO, N,
00392 $ IMAT, K, RESULT( K )
00393 NFAIL = NFAIL + 1
00394 END IF
00395 110 CONTINUE
00396 NRUN = NRUN + NT
00397 120 CONTINUE
00398 END IF
00399
00400
00401
00402 IF( IFACT.EQ.2 )
00403 $ CALL DLASET( UPLO, N, N, ZERO, ZERO, AFAC, LDA )
00404 CALL DLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA )
00405
00406
00407
00408
00409 SRNAMT = 'DSYSVX'
00410 CALL DSYSVX( FACT, UPLO, N, NRHS, A, LDA, AFAC, LDA,
00411 $ IWORK, B, LDA, X, LDA, RCOND, RWORK,
00412 $ RWORK( NRHS+1 ), WORK, LWORK,
00413 $ IWORK( N+1 ), INFO )
00414
00415
00416
00417
00418 K = IZERO
00419 IF( K.GT.0 ) THEN
00420 130 CONTINUE
00421 IF( IWORK( K ).LT.0 ) THEN
00422 IF( IWORK( K ).NE.-K ) THEN
00423 K = -IWORK( K )
00424 GO TO 130
00425 END IF
00426 ELSE IF( IWORK( K ).NE.K ) THEN
00427 K = IWORK( K )
00428 GO TO 130
00429 END IF
00430 END IF
00431
00432
00433
00434 IF( INFO.NE.K ) THEN
00435 CALL ALAERH( PATH, 'DSYSVX', INFO, K, FACT // UPLO,
00436 $ N, N, -1, -1, NRHS, IMAT, NFAIL,
00437 $ NERRS, NOUT )
00438 GO TO 150
00439 END IF
00440
00441 IF( INFO.EQ.0 ) THEN
00442 IF( IFACT.GE.2 ) THEN
00443
00444
00445
00446
00447 CALL DSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
00448 $ AINV, LDA, RWORK( 2*NRHS+1 ),
00449 $ RESULT( 1 ) )
00450 K1 = 1
00451 ELSE
00452 K1 = 2
00453 END IF
00454
00455
00456
00457 CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
00458 CALL DPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
00459 $ LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
00460
00461
00462
00463 CALL DGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
00464 $ RESULT( 3 ) )
00465
00466
00467
00468 CALL DPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
00469 $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
00470 $ RESULT( 4 ) )
00471 ELSE
00472 K1 = 6
00473 END IF
00474
00475
00476
00477
00478 RESULT( 6 ) = DGET06( RCOND, RCONDC )
00479
00480
00481
00482
00483 DO 140 K = K1, 6
00484 IF( RESULT( K ).GE.THRESH ) THEN
00485 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00486 $ CALL ALADHD( NOUT, PATH )
00487 WRITE( NOUT, FMT = 9998 )'DSYSVX', FACT, UPLO,
00488 $ N, IMAT, K, RESULT( K )
00489 NFAIL = NFAIL + 1
00490 END IF
00491 140 CONTINUE
00492 NRUN = NRUN + 7 - K1
00493
00494
00495
00496
00497
00498 IF( IFACT.EQ.2 )
00499 $ CALL DLASET( UPLO, N, N, ZERO, ZERO, AFAC, LDA )
00500 CALL DLASET( 'Full', N, NRHS, ZERO, ZERO, X, LDA )
00501
00502
00503
00504
00505 SRNAMT = 'DSYSVXX'
00506 N_ERR_BNDS = 3
00507 EQUED = 'N'
00508 CALL DSYSVXX( FACT, UPLO, N, NRHS, A, LDA, AFAC,
00509 $ LDA, IWORK, EQUED, WORK( N+1 ), B, LDA, X,
00510 $ LDA, RCOND, RPVGRW_SVXX, BERR, N_ERR_BNDS,
00511 $ ERRBNDS_N, ERRBNDS_C, 0, ZERO, WORK,
00512 $ IWORK( N+1 ), INFO )
00513
00514
00515
00516
00517 K = IZERO
00518 IF( K.GT.0 ) THEN
00519 135 CONTINUE
00520 IF( IWORK( K ).LT.0 ) THEN
00521 IF( IWORK( K ).NE.-K ) THEN
00522 K = -IWORK( K )
00523 GO TO 135
00524 END IF
00525 ELSE IF( IWORK( K ).NE.K ) THEN
00526 K = IWORK( K )
00527 GO TO 135
00528 END IF
00529 END IF
00530
00531
00532
00533 IF( INFO.NE.K ) THEN
00534 CALL ALAERH( PATH, 'DSYSVXX', INFO, K,
00535 $ FACT // UPLO, N, N, -1, -1, NRHS, IMAT, NFAIL,
00536 $ NERRS, NOUT )
00537 GO TO 150
00538 END IF
00539
00540 IF( INFO.EQ.0 ) THEN
00541 IF( IFACT.GE.2 ) THEN
00542
00543
00544
00545
00546 CALL DSYT01( UPLO, N, A, LDA, AFAC, LDA, IWORK,
00547 $ AINV, LDA, RWORK(2*NRHS+1),
00548 $ RESULT( 1 ) )
00549 K1 = 1
00550 ELSE
00551 K1 = 2
00552 END IF
00553
00554
00555
00556 CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA )
00557 CALL DPOT02( UPLO, N, NRHS, A, LDA, X, LDA, WORK,
00558 $ LDA, RWORK( 2*NRHS+1 ), RESULT( 2 ) )
00559
00560
00561
00562 CALL DGET04( N, NRHS, X, LDA, XACT, LDA, RCONDC,
00563 $ RESULT( 3 ) )
00564
00565
00566
00567 CALL DPOT05( UPLO, N, NRHS, A, LDA, B, LDA, X, LDA,
00568 $ XACT, LDA, RWORK, RWORK( NRHS+1 ),
00569 $ RESULT( 4 ) )
00570 ELSE
00571 K1 = 6
00572 END IF
00573
00574
00575
00576
00577 RESULT( 6 ) = DGET06( RCOND, RCONDC )
00578
00579
00580
00581
00582 DO 85 K = K1, 6
00583 IF( RESULT( K ).GE.THRESH ) THEN
00584 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
00585 $ CALL ALADHD( NOUT, PATH )
00586 WRITE( NOUT, FMT = 9998 )'DSYSVXX',
00587 $ FACT, UPLO, N, IMAT, K,
00588 $ RESULT( K )
00589 NFAIL = NFAIL + 1
00590 END IF
00591 85 CONTINUE
00592 NRUN = NRUN + 7 - K1
00593
00594 150 CONTINUE
00595
00596 160 CONTINUE
00597 170 CONTINUE
00598 180 CONTINUE
00599
00600
00601
00602 CALL ALASVM( PATH, NOUT, NFAIL, NRUN, NERRS )
00603
00604
00605
00606
00607 CALL DEBCHVXX(THRESH, PATH)
00608
00609 9999 FORMAT( 1X, A, ', UPLO=''', A1, ''', N =', I5, ', type ', I2,
00610 $ ', test ', I2, ', ratio =', G12.5 )
00611 9998 FORMAT( 1X, A, ', FACT=''', A1, ''', UPLO=''', A1, ''', N =', I5,
00612 $ ', type ', I2, ', test ', I2, ', ratio =', G12.5 )
00613 RETURN
00614
00615
00616
00617 END