185 SUBROUTINE zchkge( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NNS,
186 $ nsval, thresh, tsterr, nmax, a, afac, ainv, b,
187 $ x, xact, work, rwork, iwork, nout )
196 INTEGER NM, NMAX, NN, NNB, NNS, NOUT
197 DOUBLE PRECISION THRESH
201 INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NSVAL( * ),
203 DOUBLE PRECISION RWORK( * )
204 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
205 $ work( * ), x( * ), xact( * )
211 DOUBLE PRECISION ONE, ZERO
212 parameter ( one = 1.0d+0, zero = 0.0d+0 )
214 parameter ( ntypes = 11 )
216 parameter ( ntests = 8 )
218 parameter ( ntran = 3 )
221 LOGICAL TRFCON, ZEROT
222 CHARACTER DIST, NORM, TRANS,
TYPE, XTYPE
224 INTEGER I, IM, IMAT, IN, INB, INFO, IOFF, IRHS, ITRAN,
225 $ izero, k, kl, ku, lda, lwork, m, mode, n, nb,
226 $ nerrs, nfail, nimat, nrhs, nrun, nt
227 DOUBLE PRECISION AINVNM, ANORM, ANORMI, ANORMO, CNDNUM, DUMMY,
228 $ rcond, rcondc, rcondi, rcondo
231 CHARACTER TRANSS( ntran )
232 INTEGER ISEED( 4 ), ISEEDY( 4 )
233 DOUBLE PRECISION RESULT( ntests )
236 DOUBLE PRECISION DGET06, ZLANGE
237 EXTERNAL dget06, zlange
246 INTRINSIC dcmplx, max, min
254 COMMON / infoc / infot, nunit, ok, lerr
255 COMMON / srnamc / srnamt
258 DATA iseedy / 1988, 1989, 1990, 1991 / ,
259 $ transs /
'N',
'T',
'C' /
265 path( 1: 1 ) =
'Zomplex precision'
271 iseed( i ) = iseedy( i )
278 $
CALL zerrge( path, nout )
294 IF( m.LE.0 .OR. n.LE.0 )
297 DO 100 imat = 1, nimat
301 IF( .NOT.dotype( imat ) )
306 zerot = imat.GE.5 .AND. imat.LE.7
307 IF( zerot .AND. n.LT.imat-4 )
313 CALL zlatb4( path, imat, m, n,
TYPE, KL, KU, ANORM, MODE,
317 CALL zlatms( m, n, dist, iseed,
TYPE, RWORK, MODE,
318 $ cndnum, anorm, kl, ku,
'No packing', a, lda,
324 CALL alaerh( path,
'ZLATMS', info, 0,
' ', m, n, -1,
325 $ -1, -1, imat, nfail, nerrs, nout )
335 ELSE IF( imat.EQ.6 )
THEN
338 izero = min( m, n ) / 2 + 1
340 ioff = ( izero-1 )*lda
346 CALL zlaset(
'Full', m, n-izero+1, dcmplx( zero ),
347 $ dcmplx( zero ), a( ioff+1 ), lda )
367 CALL zlacpy(
'Full', m, n, a, lda, afac, lda )
369 CALL zgetrf( m, n, afac, lda, iwork, info )
374 $
CALL alaerh( path,
'ZGETRF', info, izero,
' ', m,
375 $ n, -1, -1, nb, imat, nfail, nerrs,
382 CALL zlacpy(
'Full', m, n, afac, lda, ainv, lda )
383 CALL zget01( m, n, a, lda, ainv, lda, iwork, rwork,
391 IF( m.EQ.n .AND. info.EQ.0 )
THEN
392 CALL zlacpy(
'Full', n, n, afac, lda, ainv, lda )
395 lwork = nmax*max( 3, nrhs )
396 CALL zgetri( n, ainv, lda, iwork, work, lwork,
402 $
CALL alaerh( path,
'ZGETRI', info, 0,
' ', n, n,
403 $ -1, -1, nb, imat, nfail, nerrs,
410 CALL zget03( n, a, lda, ainv, lda, work, lda,
411 $ rwork, rcondo, result( 2 ) )
412 anormo = zlange(
'O', m, n, a, lda, rwork )
416 anormi = zlange(
'I', m, n, a, lda, rwork )
417 ainvnm = zlange(
'I', n, n, ainv, lda, rwork )
418 IF( anormi.LE.zero .OR. ainvnm.LE.zero )
THEN
421 rcondi = ( one / anormi ) / ainvnm
429 anormo = zlange(
'O', m, n, a, lda, rwork )
430 anormi = zlange(
'I', m, n, a, lda, rwork )
439 IF( result( k ).GE.thresh )
THEN
440 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
441 $
CALL alahd( nout, path )
442 WRITE( nout, fmt = 9999 )m, n, nb, imat, k,
453 IF( inb.GT.1 .OR. m.NE.n )
462 DO 50 itran = 1, ntran
463 trans = transs( itran )
464 IF( itran.EQ.1 )
THEN
474 CALL zlarhs( path, xtype,
' ', trans, n, n, kl,
475 $ ku, nrhs, a, lda, xact, lda, b,
479 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
481 CALL zgetrs( trans, n, nrhs, afac, lda, iwork,
487 $
CALL alaerh( path,
'ZGETRS', info, 0, trans,
488 $ n, n, -1, -1, nrhs, imat, nfail,
491 CALL zlacpy(
'Full', n, nrhs, b, lda, work,
493 CALL zget02( trans, n, n, nrhs, a, lda, x, lda,
494 $ work, lda, rwork, result( 3 ) )
499 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
507 CALL zgerfs( trans, n, nrhs, a, lda, afac, lda,
508 $ iwork, b, lda, x, lda, rwork,
509 $ rwork( nrhs+1 ), work,
510 $ rwork( 2*nrhs+1 ), info )
515 $
CALL alaerh( path,
'ZGERFS', info, 0, trans,
516 $ n, n, -1, -1, nrhs, imat, nfail,
519 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
521 CALL zget07( trans, n, nrhs, a, lda, b, lda, x,
522 $ lda, xact, lda, rwork, .true.,
523 $ rwork( nrhs+1 ), result( 6 ) )
529 IF( result( k ).GE.thresh )
THEN
530 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
531 $
CALL alahd( nout, path )
532 WRITE( nout, fmt = 9998 )trans, n, nrhs,
533 $ imat, k, result( k )
546 IF( itran.EQ.1 )
THEN
556 CALL zgecon( norm, n, afac, lda, anorm, rcond,
557 $ work, rwork, info )
562 $
CALL alaerh( path,
'ZGECON', info, 0, norm, n,
563 $ n, -1, -1, -1, imat, nfail, nerrs,
570 result( 8 ) = dget06( rcond, rcondc )
575 IF( result( 8 ).GE.thresh )
THEN
576 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
577 $
CALL alahd( nout, path )
578 WRITE( nout, fmt = 9997 )norm, n, imat, 8,
592 CALL alasum( path, nout, nfail, nrun, nerrs )
594 9999
FORMAT(
' M = ', i5,
', N =', i5,
', NB =', i4,
', type ', i2,
595 $
', test(', i2,
') =', g12.5 )
596 9998
FORMAT(
' TRANS=''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
597 $ i2,
', test(', i2,
') =', g12.5 )
598 9997
FORMAT(
' NORM =''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
599 $
', test(', i2,
') =', g12.5 )
subroutine zgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZGETRS
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
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 zget03(N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZGET03
subroutine zgetrf(M, N, A, LDA, IPIV, INFO)
ZGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.
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 zgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
ZGECON
subroutine zerrge(PATH, NUNIT)
ZERRGE
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 zgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
ZGETRI
subroutine zgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGERFS
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zget01(M, N, A, LDA, AFAC, LDAFAC, IPIV, RWORK, RESID)
ZGET01
subroutine zget02(TRANS, M, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZGET02
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM