184 SUBROUTINE dchkge( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS,
185 $ nsval, thresh, tsterr, nmax, a, afac, ainv,
b,
186 $ x, xact, work, rwork, iwork, nout )
195 INTEGER nm, nmax, nn, nnb, nns, nout
196 DOUBLE PRECISION thresh
200 INTEGER iwork( * ), mval( * ), nbval( * ), nsval( * ),
202 DOUBLE PRECISION a( * ), afac( * ), ainv( * ),
b( * ),
203 $ rwork( * ), work( * ), x( * ), xact( * )
209 DOUBLE PRECISION one, zero
210 parameter( one = 1.0d+0, zero = 0.0d+0 )
212 parameter( ntypes = 11 )
214 parameter( ntests = 8 )
216 parameter( ntran = 3 )
219 LOGICAL trfcon, zerot
220 CHARACTER dist, norm, trans, type, xtype
222 INTEGER i, im, imat, in, inb, info, ioff, irhs, itran,
223 $ izero, k, kl, ku, lda, lwork, m, mode, n, nb,
224 $ nerrs, nfail, nimat, nrhs, nrun, nt
225 DOUBLE PRECISION ainvnm, anorm, anormi, anormo, cndnum, dummy,
226 $ rcond, rcondc, rcondi, rcondo
229 CHARACTER transs( ntran )
230 INTEGER iseed( 4 ), iseedy( 4 )
231 DOUBLE PRECISION result( ntests )
252 COMMON / infoc / infot, nunit, ok, lerr
253 COMMON / srnamc / srnamt
256 DATA iseedy / 1988, 1989, 1990, 1991 / ,
257 $ transs /
'N',
'T',
'C' /
263 path( 1: 1 ) =
'Double precision'
269 iseed( i ) = iseedy( i )
276 $ CALL
derrge( path, nout )
292 IF( m.LE.0 .OR. n.LE.0 )
295 DO 100 imat = 1, nimat
299 IF( .NOT.dotype( imat ) )
304 zerot = imat.GE.5 .AND. imat.LE.7
305 IF( zerot .AND. n.LT.imat-4 )
311 CALL
dlatb4( path, imat, m, n, type, kl, ku, anorm, mode,
315 CALL
dlatms( m, n, dist, iseed, type, rwork, mode,
316 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
322 CALL
alaerh( path,
'DLATMS', info, 0,
' ', m, n, -1,
323 $ -1, -1, imat, nfail, nerrs, nout )
333 ELSE IF( imat.EQ.6 )
THEN
336 izero = min( m, n ) / 2 + 1
338 ioff = ( izero-1 )*lda
344 CALL
dlaset(
'Full', m, n-izero+1, zero, zero,
365 CALL
dlacpy(
'Full', m, n, a, lda, afac, lda )
367 CALL
dgetrf( m, n, afac, lda, iwork, info )
372 $ CALL
alaerh( path,
'DGETRF', info, izero,
' ', m,
373 $ n, -1, -1, nb, imat, nfail, nerrs,
380 CALL
dlacpy(
'Full', m, n, afac, lda, ainv, lda )
381 CALL
dget01( m, n, a, lda, ainv, lda, iwork, rwork,
389 IF( m.EQ.n .AND. info.EQ.0 )
THEN
390 CALL
dlacpy(
'Full', n, n, afac, lda, ainv, lda )
393 lwork = nmax*max( 3, nrhs )
394 CALL
dgetri( n, ainv, lda, iwork, work, lwork,
400 $ CALL
alaerh( path,
'DGETRI', info, 0,
' ', n, n,
401 $ -1, -1, nb, imat, nfail, nerrs,
408 CALL
dget03( n, a, lda, ainv, lda, work, lda,
409 $ rwork, rcondo, result( 2 ) )
410 anormo =
dlange(
'O', m, n, a, lda, rwork )
414 anormi =
dlange(
'I', m, n, a, lda, rwork )
415 ainvnm =
dlange(
'I', n, n, ainv, lda, rwork )
416 IF( anormi.LE.zero .OR. ainvnm.LE.zero )
THEN
419 rcondi = ( one / anormi ) / ainvnm
427 anormo =
dlange(
'O', m, n, a, lda, rwork )
428 anormi =
dlange(
'I', m, n, a, lda, rwork )
437 IF( result( k ).GE.thresh )
THEN
438 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
439 $ CALL
alahd( nout, path )
440 WRITE( nout, fmt = 9999 )m, n, nb, imat, k,
451 IF( inb.GT.1 .OR. m.NE.n )
460 DO 50 itran = 1, ntran
461 trans = transs( itran )
462 IF( itran.EQ.1 )
THEN
472 CALL
dlarhs( path, xtype,
' ', trans, n, n, kl,
473 $ ku, nrhs, a, lda, xact, lda,
b,
477 CALL
dlacpy(
'Full', n, nrhs,
b, lda, x, lda )
479 CALL
dgetrs( trans, n, nrhs, afac, lda, iwork,
485 $ CALL
alaerh( path,
'DGETRS', info, 0, trans,
486 $ n, n, -1, -1, nrhs, imat, nfail,
489 CALL
dlacpy(
'Full', n, nrhs,
b, lda, work,
491 CALL
dget02( trans, n, n, nrhs, a, lda, x, lda,
492 $ work, lda, rwork, result( 3 ) )
497 CALL
dget04( n, nrhs, x, lda, xact, lda, rcondc,
505 CALL
dgerfs( trans, n, nrhs, a, lda, afac, lda,
506 $ iwork,
b, lda, x, lda, rwork,
507 $ rwork( nrhs+1 ), work,
508 $ iwork( n+1 ), info )
513 $ CALL
alaerh( path,
'DGERFS', info, 0, trans,
514 $ n, n, -1, -1, nrhs, imat, nfail,
517 CALL
dget04( n, nrhs, x, lda, xact, lda, rcondc,
519 CALL
dget07( trans, n, nrhs, a, lda,
b, lda, x,
520 $ lda, xact, lda, rwork, .true.,
521 $ rwork( nrhs+1 ), result( 6 ) )
527 IF( result( k ).GE.thresh )
THEN
528 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
529 $ CALL
alahd( nout, path )
530 WRITE( nout, fmt = 9998 )trans, n, nrhs,
531 $ imat, k, result( k )
544 IF( itran.EQ.1 )
THEN
554 CALL
dgecon( norm, n, afac, lda, anorm, rcond,
555 $ work, iwork( n+1 ), info )
560 $ CALL
alaerh( path,
'DGECON', info, 0, norm, n,
561 $ n, -1, -1, -1, imat, nfail, nerrs,
568 result( 8 ) =
dget06( rcond, rcondc )
573 IF( result( 8 ).GE.thresh )
THEN
574 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
575 $ CALL
alahd( nout, path )
576 WRITE( nout, fmt = 9997 )norm, n, imat, 8,
589 CALL
alasum( path, nout, nfail, nrun, nerrs )
591 9999
FORMAT(
' M = ', i5,
', N =', i5,
', NB =', i4,
', type ', i2,
592 $
', test(', i2,
') =', g12.5 )
593 9998
FORMAT(
' TRANS=''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
594 $ i2,
', test(', i2,
') =', g12.5 )
595 9997
FORMAT(
' NORM =''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
596 $
', test(', i2,
') =', g12.5 )
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine dgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
DGETRI
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
subroutine dgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
DGECON
subroutine dgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DGERFS
subroutine dgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DGETRS
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 alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
double precision function dlange(NORM, M, N, A, LDA, WORK)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
double precision function dget06(RCOND, RCONDC)
DGET06
subroutine dget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
DGET01
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine dget07(TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
DGET07
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
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 derrge(PATH, NUNIT)
DERRGE
subroutine dchkge(DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
DCHKGE
subroutine dget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DGET02
subroutine dget03(N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
DGET03
subroutine dgetrf(M, N, A, LDA, IPIV, INFO)
DGETRF