150 SUBROUTINE ddrvab( DOTYPE, NM, MVAL, NNS,
151 $ nsval, thresh, nmax, a, afac,
b,
152 $
x, work, rwork, swork, iwork, nout )
160 INTEGER nm, nmax, nns, nout
161 DOUBLE PRECISION thresh
165 INTEGER mval( * ), nsval( * ), iwork( * )
167 DOUBLE PRECISION a( * ), afac( * ),
b( * ),
168 $ rwork( * ), work( * ),
x( * )
174 DOUBLE PRECISION zero
175 parameter( zero = 0.0d+0 )
177 parameter( ntypes = 11 )
179 parameter( ntests = 1 )
183 CHARACTER dist, trans, type, xtype
185 INTEGER i, im, imat, info, ioff, irhs,
186 $ izero, kl, ku, lda, m, mode, n,
187 $ nerrs, nfail, nimat, nrhs, nrun
188 DOUBLE PRECISION anorm, cndnum
191 INTEGER iseed( 4 ), iseedy( 4 )
192 DOUBLE PRECISION result( ntests )
202 INTRINSIC dble, max, min, sqrt
210 COMMON / infoc / infot, nunit, ok, lerr
211 COMMON / srnamc / srnamt
214 DATA iseedy / 2006, 2007, 2008, 2009 /
221 path( 1: 1 ) =
'Double precision'
227 iseed( i ) = iseedy( i )
240 IF( m.LE.0 .OR. n.LE.0 )
243 DO 100 imat = 1, nimat
247 IF( .NOT.dotype( imat ) )
252 zerot = imat.GE.5 .AND. imat.LE.7
253 IF( zerot .AND. n.LT.imat-4 )
259 CALL
dlatb4( path, imat, m, n, type, kl, ku, anorm, mode,
263 CALL
dlatms( m, n, dist, iseed, type, rwork, mode,
264 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
270 CALL
alaerh( path,
'DLATMS', info, 0,
' ', m, n, -1,
271 $ -1, -1, imat, nfail, nerrs, nout )
281 ELSE IF( imat.EQ.6 )
THEN
284 izero = min( m, n ) / 2 + 1
286 ioff = ( izero-1 )*lda
292 CALL
dlaset(
'Full', m, n-izero+1, zero, zero,
305 CALL
dlarhs( path, xtype,
' ', trans, n, n, kl,
306 $ ku, nrhs, a, lda,
x, lda,
b,
313 CALL
dlacpy(
'Full', m, n, a, lda, afac, lda )
315 CALL
dsgesv( n, nrhs, a, lda, iwork,
b, lda,
x, lda,
316 $ work, swork, iter, info)
319 CALL
dlacpy(
'Full', m, n, afac, lda, a, lda )
325 IF( info.NE.izero )
THEN
327 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
328 $ CALL
alahd( nout, path )
331 IF( info.NE.izero .AND. izero.NE.0 )
THEN
332 WRITE( nout, fmt = 9988 )
'DSGESV',info,
335 WRITE( nout, fmt = 9975 )
'DSGESV',info,
347 CALL
dlacpy(
'Full', n, nrhs,
b, lda, work, lda )
349 CALL
dget08( trans, n, n, nrhs, a, lda,
x, lda, work,
350 $ lda, rwork, result( 1 ) )
364 IF ((thresh.LE.0.0e+00)
365 $ .OR.((iter.GE.0).AND.(n.GT.0)
366 $ .AND.(result(1).GE.sqrt(dble(n))))
367 $ .OR.((iter.LT.0).AND.(result(1).GE.thresh)))
THEN
369 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
THEN
370 WRITE( nout, fmt = 8999 )
'DGE'
371 WRITE( nout, fmt =
'( '' Matrix types:'' )' )
372 WRITE( nout, fmt = 8979 )
373 WRITE( nout, fmt =
'( '' Test ratios:'' )' )
374 WRITE( nout, fmt = 8960 )1
375 WRITE( nout, fmt =
'( '' Messages:'' )' )
378 WRITE( nout, fmt = 9998 )trans, n, nrhs,
379 $ imat, 1, result( 1 )
389 IF( nfail.GT.0 )
THEN
390 WRITE( nout, fmt = 9996 )
'DSGESV', nfail, nrun
392 WRITE( nout, fmt = 9995 )
'DSGESV', nrun
394 IF( nerrs.GT.0 )
THEN
395 WRITE( nout, fmt = 9994 )nerrs
398 9998
FORMAT(
' TRANS=''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
399 $ i2,
', test(', i2,
') =', g12.5 )
400 9996
FORMAT( 1
x, a6,
': ', i6,
' out of ', i6,
401 $
' tests failed to pass the threshold' )
402 9995
FORMAT( /1
x,
'All tests for ', a6,
403 $
' routines passed the threshold ( ', i6,
' tests run)' )
404 9994
FORMAT( 6
x, i6,
' error messages recorded' )
408 9988
FORMAT(
' *** ', a6,
' returned with INFO =', i5,
' instead of ',
409 $ i5, /
' ==> M =', i5,
', type ',
414 9975
FORMAT(
' *** Error code from ', a6,
'=', i5,
' for M=', i5,
416 8999
FORMAT( / 1
x, a3,
': General dense matrices' )
417 8979
FORMAT( 4
x,
'1. Diagonal', 24
x,
'7. Last n/2 columns zero', / 4
x,
418 $
'2. Upper triangular', 16
x,
419 $
'8. Random, CNDNUM = sqrt(0.1/EPS)', / 4
x,
420 $
'3. Lower triangular', 16
x,
'9. Random, CNDNUM = 0.1/EPS',
421 $ / 4
x,
'4. Random, CNDNUM = 2', 13
x,
422 $
'10. Scaled near underflow', / 4
x,
'5. First column zero',
423 $ 14
x,
'11. Scaled near overflow', / 4
x,
424 $
'6. Last column zero' )
425 8960
FORMAT( 3
x, i2,
': norm_1( B - A * X ) / ',
426 $
'( norm_1(A) * norm_1(X) * EPS * SQRT(N) ) > 1 if ITERREF',
427 $ / 4
x,
'or norm_1( B - A * X ) / ',
428 $
'( norm_1(A) * norm_1(X) * EPS ) > THRES if DGETRF' )
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
subroutine ddrvab(DOTYPE, NM, MVAL, NNS, NSVAL, THRESH, NMAX, A, AFAC, B, X, WORK, RWORK, SWORK, IWORK, NOUT)
DDRVAB
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine dlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
DLARHS
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine dget08(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DGET08
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine dsgesv(N, NRHS, A, LDA, IPIV, B, LDB, X, LDX, WORK, SWORK, ITER, INFO)
DSGESV computes the solution to system of linear equations A * X = B for GE matrices (mixed precisio...