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 dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine dgetrf(M, N, A, LDA, IPIV, INFO)
DGETRF
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 dget03(N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
DGET03
subroutine dgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DGERFS
subroutine dgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
DGETRI
subroutine dget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
DGET01
subroutine dgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DGETRS
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 xlaenv(ISPEC, NVALUE)
XLAENV
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 ...
subroutine dget07(TRANS, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, CHKFERR, BERR, RESLTS)
DGET07
subroutine dget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
DGET02
subroutine dlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
DLATB4
subroutine dget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
DGET04
double precision function dget06(RCOND, RCONDC)
DGET06
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 alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM