170 SUBROUTINE zchksy( 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
182 DOUBLE PRECISION thresh
186 INTEGER iwork( * ), nbval( * ), nsval( * ), nval( * )
187 DOUBLE PRECISION rwork( * )
188 COMPLEX*16 a( * ), afac( * ), ainv( * ),
b( * ),
189 $ work( * ), x( * ), xact( * )
195 DOUBLE PRECISION zero
196 parameter( zero = 0.0d+0 )
198 parameter( czero = ( 0.0d+0, 0.0d+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 DOUBLE PRECISION anorm, cndnum, rcond, rcondc
215 INTEGER iseed( 4 ), iseedy( 4 )
216 DOUBLE PRECISION result( ntests )
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 ) =
'Zomplex precision'
254 iseed( i ) = iseedy( i )
260 $ CALL
zerrsy( 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
zlatb4( path, imat, n, n, type, kl, ku, anorm,
308 $ mode, cndnum, dist )
313 CALL
zlatms( n, n, dist, iseed, type, rwork, mode,
314 $ cndnum, anorm, kl, ku,
'N', a, lda, work,
320 CALL
alaerh( path,
'ZLATMS', 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
zlatsy( uplo, n, a, lda, iseed )
424 CALL
zlacpy( uplo, n, n, a, lda, afac, lda )
431 lwork = max( 2, nb )*lda
433 CALL
zsytrf( 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,
'ZSYTRF', info, k, uplo, n, n,
457 $ -1, -1, nb, imat, nfail, nerrs, nout )
470 CALL
zsyt01( uplo, n, a, lda, afac, lda, iwork, ainv,
471 $ lda, rwork, result( 1 ) )
480 IF( inb.EQ.1 .AND. .NOT.trfcon )
THEN
481 CALL
zlacpy( uplo, n, n, afac, lda, ainv, lda )
483 lwork = (n+nb+1)*(nb+3)
484 CALL
zsytri2( uplo, n, ainv, lda, iwork, work,
490 $ CALL
alaerh( path,
'ZSYTRI2', info, 0, uplo, n,
491 $ n, -1, -1, -1, imat, nfail, nerrs,
497 CALL
zsyt03( 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
zlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
542 $ nrhs, a, lda, xact, lda,
b, lda,
544 CALL
zlacpy(
'Full', n, nrhs,
b, lda, x, lda )
547 CALL
zsytrs( uplo, n, nrhs, afac, lda, iwork, x,
553 $ CALL
alaerh( path,
'ZSYTRS', info, 0, uplo, n,
554 $ n, -1, -1, nrhs, imat, nfail,
557 CALL
zlacpy(
'Full', n, nrhs,
b, lda, work, lda )
561 CALL
zsyt02( uplo, n, nrhs, a, lda, x, lda, work,
562 $ lda, rwork, result( 3 ) )
571 CALL
zlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
572 $ nrhs, a, lda, xact, lda,
b, lda,
574 CALL
zlacpy(
'Full', n, nrhs,
b, lda, x, lda )
577 CALL
zsytrs2( uplo, n, nrhs, afac, lda, iwork, x,
583 $ CALL
alaerh( path,
'ZSYTRS', info, 0, uplo, n,
584 $ n, -1, -1, nrhs, imat, nfail,
587 CALL
zlacpy(
'Full', n, nrhs,
b, lda, work, lda )
591 CALL
zsyt02( uplo, n, nrhs, a, lda, x, lda, work,
592 $ lda, rwork, result( 4 ) )
598 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
605 CALL
zsyrfs( uplo, n, nrhs, a, lda, afac, lda,
606 $ iwork,
b, lda, x, lda, rwork,
607 $ rwork( nrhs+1 ), work,
608 $ rwork( 2*nrhs+1 ), info )
613 $ CALL
alaerh( path,
'ZSYRFS', info, 0, uplo, n,
614 $ n, -1, -1, nrhs, imat, nfail,
617 CALL
zget04( n, nrhs, x, lda, xact, lda, rcondc,
619 CALL
zpot05( uplo, n, nrhs, a, lda,
b, lda, x, lda,
620 $ xact, lda, rwork, rwork( nrhs+1 ),
627 IF( result( k ).GE.thresh )
THEN
628 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
629 $ CALL
alahd( nout, path )
630 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
631 $ imat, k, result( k )
645 anorm =
zlansy(
'1', uplo, n, a, lda, rwork )
647 CALL
zsycon( uplo, n, afac, lda, iwork, anorm, rcond,
653 $ CALL
alaerh( path,
'ZSYCON', info, 0, uplo, n, n,
654 $ -1, -1, -1, imat, nfail, nerrs, nout )
658 result( 9 ) =
dget06( rcond, rcondc )
663 IF( result( 9 ).GE.thresh )
THEN
664 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
665 $ CALL
alahd( nout, path )
666 WRITE( nout, fmt = 9997 )uplo, n, imat, 9,
678 CALL
alasum( path, nout, nfail, nrun, nerrs )
680 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
681 $ i2,
', test ', i2,
', ratio =', g12.5 )
682 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
683 $ i2,
', test(', i2,
') =', g12.5 )
684 9997
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
685 $
', test(', i2,
') =', g12.5 )
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
double precision function zlansy(NORM, UPLO, N, A, LDA, WORK)
ZLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a complex symmetric matrix.
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zsyt02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZSYT02
subroutine zerrsy(PATH, NUNIT)
ZERRSY
subroutine zsytrs2(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO)
ZSYTRS2
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine zsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZSYTRS
subroutine zchksy(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
ZCHKSY
subroutine zsycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZSYCON
subroutine zpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPOT05
subroutine zlatsy(UPLO, N, X, LDX, ISEED)
ZLATSY
double precision function dget06(RCOND, RCONDC)
DGET06
subroutine zsyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZSYRFS
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine zsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRI2
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zsyt03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZSYT03
subroutine zsyt01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZSYT01
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRF
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4