162 SUBROUTINE cchktr( 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
178 INTEGER NBVAL( * ), NSVAL( * ), NVAL( * )
180 COMPLEX A( * ), AINV( * ), B( * ), WORK( * ), X( * ),
187 INTEGER NTYPE1, NTYPES
188 parameter ( ntype1 = 10, ntypes = 18 )
190 parameter ( ntests = 9 )
192 parameter ( ntran = 3 )
194 parameter ( one = 1.0e0, zero = 0.0e0 )
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 REAL AINVNM, ANORM, DUMMY, RCOND, RCONDC, RCONDI,
205 CHARACTER TRANSS( ntran ), UPLOS( 2 )
206 INTEGER ISEED( 4 ), ISEEDY( 4 )
207 REAL RESULT( ntests )
212 EXTERNAL lsame, clantr
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 ) =
'Complex precision'
246 iseed( i ) = iseedy( i )
252 $
CALL cerrtr( path, nout )
263 DO 80 imat = 1, ntype1
267 IF( .NOT.dotype( imat ) )
274 uplo = uplos( iuplo )
279 CALL clattr( imat, uplo,
'No transpose', diag, iseed, n,
280 $ a, lda, x, work, rwork, info )
284 IF( lsame( diag,
'N' ) )
THEN
300 CALL clacpy( uplo, n, n, a, lda, ainv, lda )
302 CALL ctrtri( uplo, diag, n, ainv, lda, info )
307 $
CALL alaerh( path,
'CTRTRI', info, 0, uplo // diag,
308 $ n, n, -1, -1, nb, imat, nfail, nerrs,
313 anorm = clantr(
'I', uplo, diag, n, n, a, lda, rwork )
314 ainvnm = clantr(
'I', uplo, diag, n, n, ainv, lda,
316 IF( anorm.LE.zero .OR. ainvnm.LE.zero )
THEN
319 rcondi = ( one / anorm ) / ainvnm
326 CALL ctrt01( 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 clarhs( path, xtype, uplo, trans, n, n, 0,
366 $ idiag, nrhs, a, lda, xact, lda, b,
369 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
372 CALL ctrtrs( uplo, trans, diag, n, nrhs, a, lda,
378 $
CALL alaerh( path,
'CTRTRS', info, 0,
379 $ uplo // trans // diag, n, n, -1,
380 $ -1, nrhs, imat, nfail, nerrs,
388 CALL ctrt02( uplo, trans, diag, n, nrhs, a, lda,
389 $ x, lda, b, lda, work, rwork,
395 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
403 CALL ctrrfs( 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,
'CTRRFS', info, 0,
412 $ uplo // trans // diag, n, n, -1,
413 $ -1, nrhs, imat, nfail, nerrs,
416 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
418 CALL ctrt05( 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 ctrcon( norm, uplo, diag, n, a, lda, rcond,
451 $ work, rwork, info )
456 $
CALL alaerh( path,
'CTRCON', info, 0,
457 $ norm // uplo // diag, n, n, -1, -1,
458 $ -1, imat, nfail, nerrs, nout )
460 CALL ctrt06( 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 clattr( imat, uplo, trans, diag, iseed, n, a,
502 $ lda, x, work, rwork, info )
508 CALL ccopy( n, x, 1, b, 1 )
509 CALL clatrs( uplo, trans, diag,
'N', n, a, lda, b,
510 $ scale, rwork, info )
515 $
CALL alaerh( path,
'CLATRS', info, 0,
516 $ uplo // trans // diag //
'N', n, n,
517 $ -1, -1, -1, imat, nfail, nerrs, nout )
519 CALL ctrt03( uplo, trans, diag, n, 1, a, lda, scale,
520 $ rwork, one, b, lda, x, lda, work,
526 CALL ccopy( n, x, 1, b( n+1 ), 1 )
527 CALL clatrs( uplo, trans, diag,
'Y', n, a, lda,
528 $ b( n+1 ), scale, rwork, info )
533 $
CALL alaerh( path,
'CLATRS', info, 0,
534 $ uplo // trans // diag //
'Y', n, n,
535 $ -1, -1, -1, imat, nfail, nerrs, nout )
537 CALL ctrt03( 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 )
'CLATRS', 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 )
'CLATRS', 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,
')=',
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine ctrrfs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CTRRFS
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine ctrt03(UPLO, TRANS, DIAG, N, NRHS, A, LDA, SCALE, CNORM, TSCAL, X, LDX, B, LDB, WORK, RESID)
CTRT03
subroutine ctrt02(UPLO, TRANS, DIAG, N, NRHS, A, LDA, X, LDX, B, LDB, WORK, RWORK, RESID)
CTRT02
subroutine cerrtr(PATH, NUNIT)
CERRTR
subroutine ctrtrs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, INFO)
CTRTRS
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine cchktr(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AINV, B, X, XACT, WORK, RWORK, NOUT)
CCHKTR
subroutine clatrs(UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, CNORM, INFO)
CLATRS solves a triangular system of equations with the scale factor set to prevent overflow...
subroutine ctrt06(RCOND, RCONDC, UPLO, DIAG, N, A, LDA, RWORK, RAT)
CTRT06
subroutine clattr(IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B, WORK, RWORK, INFO)
CLATTR
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine ctrcon(NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK, RWORK, INFO)
CTRCON
subroutine ctrt05(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CTRT05
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine ctrtri(UPLO, DIAG, N, A, LDA, INFO)
CTRTRI
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
subroutine ctrt01(UPLO, DIAG, N, A, LDA, AINV, LDAINV, RCOND, RWORK, RESID)
CTRT01
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM