162 SUBROUTINE zchktr( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
163 $ THRESH, TSTERR, NMAX, A, AINV, B, X, XACT,
164 $ WORK, RWORK, NOUT )
173 INTEGER NMAX, NN, NNB, NNS, NOUT
174 DOUBLE PRECISION THRESH
178 INTEGER NBVAL( * ), NSVAL( * ), NVAL( * )
179 DOUBLE PRECISION RWORK( * )
180 COMPLEX*16 A( * ), AINV( * ), B( * ), WORK( * ), X( * ),
187 INTEGER NTYPE1, NTYPES
188 PARAMETER ( NTYPE1 = 10, ntypes = 18 )
190 parameter( ntests = 9 )
192 parameter( ntran = 3 )
193 DOUBLE PRECISION ONE, ZERO
194 parameter( one = 1.0d0, zero = 0.0d0 )
197 CHARACTER DIAG, NORM, TRANS, UPLO, XTYPE
199 INTEGER I, IDIAG, IMAT, IN, INB, INFO, IRHS, ITRAN,
200 $ iuplo, k, lda, n, nb, nerrs, nfail, nrhs, nrun
201 DOUBLE PRECISION AINVNM, ANORM, DUMMY, RCOND, RCONDC, RCONDI,
205 CHARACTER TRANSS( NTRAN ), UPLOS( 2 )
206 INTEGER ISEED( 4 ), ISEEDY( 4 )
207 DOUBLE PRECISION RESULT( NTESTS )
211 DOUBLE PRECISION ZLANTR
212 EXTERNAL lsame, zlantr
223 INTEGER INFOT, IOUNIT
226 COMMON / infoc / infot, iounit, ok, lerr
227 COMMON / srnamc / srnamt
233 DATA iseedy / 1988, 1989, 1990, 1991 /
234 DATA uplos /
'U',
'L' / , transs /
'N',
'T',
'C' /
240 path( 1: 1 ) =
'Zomplex precision'
246 iseed( i ) = iseedy( i )
252 $
CALL zerrtr( path, nout )
263 DO 80 imat = 1, ntype1
267 IF( .NOT.dotype( imat ) )
274 uplo = uplos( iuplo )
279 CALL zlattr( imat, uplo,
'No transpose', diag, iseed, n,
280 $ a, lda, x, work, rwork, info )
284 IF( lsame( diag,
'N' ) )
THEN
300 CALL zlacpy( uplo, n, n, a, lda, ainv, lda )
302 CALL ztrtri( uplo, diag, n, ainv, lda, info )
307 $
CALL alaerh( path,
'ZTRTRI', info, 0, uplo // diag,
308 $ n, n, -1, -1, nb, imat, nfail, nerrs,
313 anorm = zlantr(
'I', uplo, diag, n, n, a, lda, rwork )
314 ainvnm = zlantr(
'I', uplo, diag, n, n, ainv, lda,
316 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
319 rcondi = ( one / anorm ) / ainvnm
326 CALL ztrt01( uplo, diag, n, a, lda, ainv, lda, rcondo,
327 $ rwork, result( 1 ) )
330 IF( result( 1 ).GE.thresh )
THEN
331 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
332 $
CALL alahd( nout, path )
333 WRITE( nout, fmt = 9999 )uplo, diag, n, nb, imat,
348 DO 30 itran = 1, ntran
352 trans = transs( itran )
353 IF( itran.EQ.1 )
THEN
365 CALL zlarhs( path, xtype, uplo, trans, n, n, 0,
366 $ idiag, nrhs, a, lda, xact, lda, b,
369 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
372 CALL ztrtrs( uplo, trans, diag, n, nrhs, a, lda,
378 $
CALL alaerh( path,
'ZTRTRS', info, 0,
379 $ uplo // trans // diag, n, n, -1,
380 $ -1, nrhs, imat, nfail, nerrs,
388 CALL ztrt02( uplo, trans, diag, n, nrhs, a, lda,
389 $ x, lda, b, lda, work, rwork,
395 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
403 CALL ztrrfs( uplo, trans, diag, n, nrhs, a, lda,
404 $ b, lda, x, lda, rwork,
405 $ rwork( nrhs+1 ), work,
406 $ rwork( 2*nrhs+1 ), info )
411 $
CALL alaerh( path,
'ZTRRFS', info, 0,
412 $ uplo // trans // diag, n, n, -1,
413 $ -1, nrhs, imat, nfail, nerrs,
416 CALL zget04( n, nrhs, x, lda, xact, lda, rcondc,
418 CALL ztrt05( uplo, trans, diag, n, nrhs, a, lda,
419 $ b, lda, x, lda, xact, lda, rwork,
420 $ rwork( nrhs+1 ), result( 5 ) )
426 IF( result( k ).GE.thresh )
THEN
427 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
428 $
CALL alahd( nout, path )
429 WRITE( nout, fmt = 9998 )uplo, trans,
430 $ diag, n, nrhs, imat, k, result( k )
442 IF( itran.EQ.1 )
THEN
450 CALL ztrcon( norm, uplo, diag, n, a, lda, rcond,
451 $ work, rwork, info )
456 $
CALL alaerh( path,
'ZTRCON', info, 0,
457 $ norm // uplo // diag, n, n, -1, -1,
458 $ -1, imat, nfail, nerrs, nout )
460 CALL ztrt06( rcond, rcondc, uplo, diag, n, a, lda,
461 $ rwork, result( 7 ) )
465 IF( result( 7 ).GE.thresh )
THEN
466 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
467 $
CALL alahd( nout, path )
468 WRITE( nout, fmt = 9997 )norm, uplo, n, imat,
480 DO 110 imat = ntype1 + 1, ntypes
484 IF( .NOT.dotype( imat ) )
491 uplo = uplos( iuplo )
492 DO 90 itran = 1, ntran
496 trans = transs( itran )
501 CALL zlattr( imat, uplo, trans, diag, iseed, n, a,
502 $ lda, x, work, rwork, info )
508 CALL zcopy( n, x, 1, b, 1 )
509 CALL zlatrs( uplo, trans, diag,
'N', n, a, lda, b,
510 $ scale, rwork, info )
515 $
CALL alaerh( path,
'ZLATRS', info, 0,
516 $ uplo // trans // diag //
'N', n, n,
517 $ -1, -1, -1, imat, nfail, nerrs, nout )
519 CALL ztrt03( uplo, trans, diag, n, 1, a, lda, scale,
520 $ rwork, one, b, lda, x, lda, work,
526 CALL zcopy( n, x, 1, b( n+1 ), 1 )
527 CALL zlatrs( uplo, trans, diag,
'Y', n, a, lda,
528 $ b( n+1 ), scale, rwork, info )
533 $
CALL alaerh( path,
'ZLATRS', info, 0,
534 $ uplo // trans // diag //
'Y', n, n,
535 $ -1, -1, -1, imat, nfail, nerrs, nout )
537 CALL ztrt03( uplo, trans, diag, n, 1, a, lda, scale,
538 $ rwork, one, b( n+1 ), lda, x, lda, work,
544 IF( result( 8 ).GE.thresh )
THEN
545 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
546 $
CALL alahd( nout, path )
547 WRITE( nout, fmt = 9996 )
'ZLATRS', uplo, trans,
548 $ diag,
'N', n, imat, 8, result( 8 )
551 IF( result( 9 ).GE.thresh )
THEN
552 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
553 $
CALL alahd( nout, path )
554 WRITE( nout, fmt = 9996 )
'ZLATRS', uplo, trans,
555 $ diag,
'Y', n, imat, 9, result( 9 )
566 CALL alasum( path, nout, nfail, nrun, nerrs )
568 9999
FORMAT(
' UPLO=''', a1,
''', DIAG=''', a1,
''', N=', i5,
', NB=',
569 $ i4,
', type ', i2,
', test(', i2,
')= ', g12.5 )
570 9998
FORMAT(
' UPLO=''', a1,
''', TRANS=''', a1,
''', DIAG=''', a1,
571 $
''', N=', i5,
', NB=', i4,
', type ', i2,
',
572 $ test(', i2,
')= ', g12.5 )
573 9997
FORMAT(
' NORM=''', a1,
''', UPLO =''', a1,
''', N=', i5,
',',
574 $ 11x,
' type ', i2,
', test(', i2,
')=', g12.5 )
575 9996
FORMAT( 1x, a,
'( ''', a1,
''', ''', a1,
''', ''', a1,
''', ''',
576 $ a1,
''',', i5,
', ... ), type ', i2,
', test(', i2,
')=',