183 SUBROUTINE zchkge( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS,
184 $ NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B,
185 $ X, XACT, WORK, RWORK, IWORK, NOUT )
193 INTEGER NM, NMAX, NN, NNB, NNS, NOUT
194 DOUBLE PRECISION THRESH
198 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ),
200 DOUBLE PRECISION RWORK( * )
201 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
202 $ work( * ), x( * ), xact( * )
208 DOUBLE PRECISION ONE, ZERO
209 PARAMETER ( ONE = 1.0d+0, zero = 0.0d+0 )
211 parameter( ntypes = 11 )
213 parameter( ntests = 8 )
215 parameter( ntran = 3 )
218 LOGICAL TRFCON, ZEROT
219 CHARACTER DIST, NORM, TRANS,
TYPE, XTYPE
221 INTEGER I, IM, IMAT, IN, INB, INFO, IOFF, IRHS, ITRAN,
222 $ izero, k, kl, ku, lda, lwork, m, mode, n, nb,
223 $ nerrs, nfail, nimat, nrhs, nrun, nt
224 DOUBLE PRECISION AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, DUMMY,
225 $ RCOND, RCONDC, RCONDI, RCONDO
228 CHARACTER TRANSS( NTRAN )
229 INTEGER ISEED( 4 ), ISEEDY( 4 )
230 DOUBLE PRECISION RESULT( NTESTS )
233 DOUBLE PRECISION DGET06, ZLANGE
234 EXTERNAL DGET06, ZLANGE
243 INTRINSIC dcmplx, max, min
251 COMMON / infoc / infot, nunit, ok, lerr
252 COMMON / srnamc / srnamt
255 DATA iseedy / 1988, 1989, 1990, 1991 / ,
256 $ transs /
'N',
'T',
'C' /
262 path( 1: 1 ) =
'Zomplex precision'
268 iseed( i ) = iseedy( i )
275 $
CALL zerrge( path, nout )
291 IF( m.LE.0 .OR. n.LE.0 )
294 DO 100 imat = 1, nimat
298 IF( .NOT.dotype( imat ) )
303 zerot = imat.GE.5 .AND. imat.LE.7
304 IF( zerot .AND. n.LT.imat-4 )
310 CALL zlatb4( path, imat, m, n,
TYPE, kl, ku, anorm, mode,
314 CALL zlatms( m, n, dist, iseed,
TYPE, rwork, mode,
315 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
321 CALL alaerh( path,
'ZLATMS', info, 0,
' ', m, n, -1,
322 $ -1, -1, imat, nfail, nerrs, nout )
332 ELSE IF( imat.EQ.6 )
THEN
335 izero = min( m, n ) / 2 + 1
337 ioff = ( izero-1 )*lda
343 CALL zlaset(
'Full', m, n-izero+1, dcmplx( zero ),
344 $ dcmplx( zero ), a( ioff+1 ), lda )
364 CALL zlacpy(
'Full', m, n, a, lda, afac, lda )
366 CALL zgetrf( m, n, afac, lda, iwork, info )
371 $
CALL alaerh( path,
'ZGETRF', info, izero,
' ', m,
372 $ n, -1, -1, nb, imat, nfail, nerrs,
379 CALL zlacpy(
'Full', m, n, afac, lda, ainv, lda )
380 CALL zget01( m, n, a, lda, ainv, lda, iwork, rwork,
388 IF( m.EQ.n .AND. info.EQ.0 )
THEN
389 CALL zlacpy(
'Full', n, n, afac, lda, ainv, lda )
392 lwork = nmax*max( 3, nrhs )
393 CALL zgetri( n, ainv, lda, iwork, work, lwork,
399 $
CALL alaerh( path,
'ZGETRI', info, 0,
' ', n, n,
400 $ -1, -1, nb, imat, nfail, nerrs,
407 CALL zget03( n, a, lda, ainv, lda, work, lda,
408 $ rwork, rcondo, result( 2 ) )
409 anormo = zlange(
'O', m, n, a, lda, rwork )
413 anormi = zlange(
'I', m, n, a, lda, rwork )
414 ainvnm = zlange(
'I', n, n, ainv, lda, rwork )
415 IF( anormi.LE.zero .OR. ainvnm.LE.zero )
THEN
418 rcondi = ( one / anormi ) / ainvnm
426 anormo = zlange(
'O', m, n, a, lda, rwork )
427 anormi = zlange(
'I', m, n, a, lda, rwork )
436 IF( result( k ).GE.thresh )
THEN
437 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
438 $
CALL alahd( nout, path )
439 WRITE( nout, fmt = 9999 )m, n, nb, imat, k,
450 IF( inb.GT.1 .OR. m.NE.n )
459 DO 50 itran = 1, ntran
460 trans = transs( itran )
461 IF( itran.EQ.1 )
THEN
471 CALL zlarhs( path, xtype,
' ', trans, n, n, kl,
472 $ ku, nrhs, a, lda, xact, lda, b,
476 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
478 CALL zgetrs( trans, n, nrhs, afac, lda, iwork,
484 $
CALL alaerh( path,
'ZGETRS', info, 0, trans,
485 $ n, n, -1, -1, nrhs, imat, nfail,
488 CALL zlacpy(
'Full', n, nrhs, b, lda, work,
490 CALL zget02( trans, n, n, nrhs, a, lda, x, lda,
491 $ work, lda, rwork, result( 3 ) )
496 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
504 CALL zgerfs( trans, n, nrhs, a, lda, afac, lda,
505 $ iwork, b, lda, x, lda, rwork,
506 $ rwork( nrhs+1 ), work,
507 $ rwork( 2*nrhs+1 ), info )
512 $
CALL alaerh( path,
'ZGERFS', info, 0, trans,
513 $ n, n, -1, -1, nrhs, imat, nfail,
516 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
518 CALL zget07( trans, n, nrhs, a, lda, b, lda, x,
519 $ lda, xact, lda, rwork, .true.,
520 $ rwork( nrhs+1 ), result( 6 ) )
526 IF( result( k ).GE.thresh )
THEN
527 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
528 $
CALL alahd( nout, path )
529 WRITE( nout, fmt = 9998 )trans, n, nrhs,
530 $ imat, k, result( k )
543 IF( itran.EQ.1 )
THEN
553 CALL zgecon( norm, n, afac, lda, anorm, rcond,
554 $ work, rwork, info )
559 $
CALL alaerh( path,
'ZGECON', info, 0, norm, n,
560 $ n, -1, -1, -1, imat, nfail, nerrs,
567 result( 8 ) = dget06( rcond, rcondc )
572 IF( result( 8 ).GE.thresh )
THEN
573 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
574 $
CALL alahd( nout, path )
575 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 alasum(type, nout, nfail, nrun, nerrs)
ALASUM
subroutine xlaenv(ispec, nvalue)
XLAENV
subroutine zget02(trans, m, n, nrhs, a, lda, x, ldx, b, ldb, rwork, resid)
ZGET02
subroutine zlarhs(path, xtype, uplo, trans, m, n, kl, ku, nrhs, a, lda, x, ldx, b, ldb, iseed, info)
ZLARHS
subroutine alaerh(path, subnam, info, infoe, opts, m, n, kl, ku, n5, imat, nfail, nerrs, nout)
ALAERH
subroutine alahd(iounit, path)
ALAHD
subroutine zgecon(norm, n, a, lda, anorm, rcond, work, rwork, info)
ZGECON
subroutine zgerfs(trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
ZGERFS
subroutine zgetrf(m, n, a, lda, ipiv, info)
ZGETRF
subroutine zgetri(n, a, lda, ipiv, work, lwork, info)
ZGETRI
subroutine zgetrs(trans, n, nrhs, a, lda, ipiv, b, ldb, info)
ZGETRS
subroutine zlacpy(uplo, m, n, a, lda, b, ldb)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zlaset(uplo, m, n, alpha, beta, a, lda)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
subroutine zchkge(dotype, nm, mval, nn, nval, nnb, nbval, nns, nsval, thresh, tsterr, nmax, a, afac, ainv, b, x, xact, work, rwork, iwork, nout)
ZCHKGE
subroutine zerrge(path, nunit)
ZERRGE
subroutine zget01(m, n, a, lda, afac, ldafac, ipiv, rwork, resid)
ZGET01
subroutine zget03(n, a, lda, ainv, ldainv, work, ldwork, rwork, rcond, resid)
ZGET03
subroutine zget04(n, nrhs, x, ldx, xact, ldxact, rcond, resid)
ZGET04
subroutine zget07(trans, n, nrhs, a, lda, b, ldb, x, ldx, xact, ldxact, ferr, chkferr, berr, reslts)
ZGET07
subroutine zlatb4(path, imat, m, n, type, kl, ku, anorm, mode, cndnum, dist)
ZLATB4
subroutine zlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, lda, work, info)
ZLATMS