170 SUBROUTINE cchksy( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
171 $ thresh, tsterr, nmax, a, afac, ainv, b, x,
172 $ xact, work, rwork, iwork, nout )
181 INTEGER NMAX, NN, NNB, NNS, NOUT
186 INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
188 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
189 $ work( * ), x( * ), xact( * )
196 parameter( zero = 0.0e+0 )
198 parameter( czero = ( 0.0e+0, 0.0e+0 ) )
200 parameter( ntypes = 11 )
202 parameter( ntests = 9 )
205 LOGICAL TRFCON, ZEROT
206 CHARACTER DIST,
TYPE, UPLO, XTYPE
208 INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
209 $ iuplo, izero, j, k, kl, ku, lda, lwork, mode,
210 $ n, nb, nerrs, nfail, nimat, nrhs, nrun, nt
211 REAL ANORM, CNDNUM, RCOND, RCONDC
215 INTEGER ISEED( 4 ), ISEEDY( 4 )
216 REAL RESULT( ntests )
220 EXTERNAL sget06, clansy
237 COMMON / infoc / infot, nunit, ok, lerr
238 COMMON / srnamc / srnamt
241 DATA iseedy / 1988, 1989, 1990, 1991 /
242 DATA uplos /
'U',
'L' /
248 path( 1: 1 ) =
'Complex precision'
254 iseed( i ) = iseedy( i )
260 $ CALL
cerrsy( path, nout )
282 DO 170 imat = 1, nimat
286 IF( .NOT.dotype( imat ) )
291 zerot = imat.GE.3 .AND. imat.LE.6
292 IF( zerot .AND. n.LT.imat-2 )
298 uplo = uplos( iuplo )
302 IF( imat.NE.ntypes )
THEN
307 CALL
clatb4( path, imat, n, n,
TYPE, KL, KU, ANORM,
308 $ mode, cndnum, dist )
313 CALL
clatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
314 $ cndnum, anorm, kl, ku,
'N', a, lda, work,
320 CALL
alaerh( path,
'CLATMS', info, 0, uplo, n, n,
321 $ -1, -1, -1, imat, nfail, nerrs, nout )
335 ELSE IF( imat.EQ.4 )
THEN
345 IF( iuplo.EQ.1 )
THEN
346 ioff = ( izero-1 )*lda
347 DO 20 i = 1, izero - 1
357 DO 40 i = 1, izero - 1
367 IF( iuplo.EQ.1 )
THEN
403 CALL
clatsy( uplo, n, a, lda, iseed )
424 CALL
clacpy( uplo, n, n, a, lda, afac, lda )
431 lwork = max( 2, nb )*lda
433 CALL
csytrf( uplo, n, afac, lda, iwork, ainv, lwork,
442 IF( iwork( k ).LT.0 )
THEN
443 IF( iwork( k ).NE.-k )
THEN
447 ELSE IF( iwork( k ).NE.k )
THEN
456 $ CALL
alaerh( path,
'CSYTRF', info, k, uplo, n, n,
457 $ -1, -1, nb, imat, nfail, nerrs, nout )
470 CALL
csyt01( uplo, n, a, lda, afac, lda, iwork, ainv,
471 $ lda, rwork, result( 1 ) )
480 IF( inb.EQ.1 .AND. .NOT.trfcon )
THEN
481 CALL
clacpy( uplo, n, n, afac, lda, ainv, lda )
483 lwork = (n+nb+1)*(nb+3)
484 CALL
csytri2( uplo, n, ainv, lda, iwork, work,
490 $ CALL
alaerh( path,
'CSYTRI2', info, 0, uplo, n,
491 $ n, -1, -1, -1, imat, nfail, nerrs,
497 CALL
csyt03( uplo, n, a, lda, ainv, lda, work, lda,
498 $ rwork, rcondc, result( 2 ) )
506 IF( result( k ).GE.thresh )
THEN
507 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
508 $ CALL
alahd( nout, path )
509 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
541 CALL
clarhs( path, xtype, uplo,
' ', n, n, kl, ku,
542 $ nrhs, a, lda, xact, lda, b, lda,
544 CALL
clacpy(
'Full', n, nrhs, b, lda, x, lda )
547 CALL
csytrs( uplo, n, nrhs, afac, lda, iwork, x,
553 $ CALL
alaerh( path,
'CSYTRS', info, 0, uplo, n,
554 $ n, -1, -1, nrhs, imat, nfail,
557 CALL
clacpy(
'Full', n, nrhs, b, lda, work, lda )
561 CALL
csyt02( uplo, n, nrhs, a, lda, x, lda, work,
562 $ lda, rwork, result( 3 ) )
571 CALL
clarhs( path, xtype, uplo,
' ', n, n, kl, ku,
572 $ nrhs, a, lda, xact, lda, b, lda,
574 CALL
clacpy(
'Full', n, nrhs, b, lda, x, lda )
577 CALL
csytrs2( uplo, n, nrhs, afac, lda, iwork, x,
583 $ CALL
alaerh( path,
'CSYTRS2', info, 0, uplo, n,
584 $ n, -1, -1, nrhs, imat, nfail,
587 CALL
clacpy(
'Full', n, nrhs, b, lda, work, lda )
591 CALL
csyt02( uplo, n, nrhs, a, lda, x, lda, work,
592 $ lda, rwork, result( 4 ) )
597 CALL
cget04( n, nrhs, x, lda, xact, lda, rcondc,
604 CALL
csyrfs( uplo, n, nrhs, a, lda, afac, lda,
605 $ iwork, b, lda, x, lda, rwork,
606 $ rwork( nrhs+1 ), work,
607 $ rwork( 2*nrhs+1 ), info )
612 $ CALL
alaerh( path,
'CSYRFS', info, 0, uplo, n,
613 $ n, -1, -1, nrhs, imat, nfail,
616 CALL
cget04( n, nrhs, x, lda, xact, lda, rcondc,
618 CALL
cpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
619 $ xact, lda, rwork, rwork( nrhs+1 ),
626 IF( result( k ).GE.thresh )
THEN
627 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
628 $ CALL
alahd( nout, path )
629 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
630 $ imat, k, result( k )
644 anorm = clansy(
'1', uplo, n, a, lda, rwork )
646 CALL
csycon( uplo, n, afac, lda, iwork, anorm, rcond,
652 $ CALL
alaerh( path,
'CSYCON', info, 0, uplo, n, n,
653 $ -1, -1, -1, imat, nfail, nerrs, nout )
657 result( 9 ) = sget06( rcond, rcondc )
662 IF( result( 9 ).GE.thresh )
THEN
663 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
664 $ CALL
alahd( nout, path )
665 WRITE( nout, fmt = 9997 )uplo, n, imat, 9,
677 CALL
alasum( path, nout, nfail, nrun, nerrs )
679 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
680 $ i2,
', test ', i2,
', ratio =', g12.5 )
681 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
682 $ i2,
', test(', i2,
') =', g12.5 )
683 9997
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
684 $
', test(', i2,
') =', g12.5 )
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine clatsy(UPLO, N, X, LDX, ISEED)
CLATSY
subroutine csyt03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
CSYT03
subroutine csyt01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CSYT01
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine csytrs2(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO)
CSYTRS2
subroutine cpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CPOT05
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine cerrsy(PATH, NUNIT)
CERRSY
subroutine cchksy(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
CCHKSY
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine csyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CSYRFS
subroutine csytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CSYTRS
subroutine csyt02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CSYT02
subroutine csytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
subroutine csycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CSYCON
subroutine csytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRI2