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