171 SUBROUTINE zchksy_aa( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
172 $ thresh, tsterr, nmax, a, afac, ainv, b,
173 $ x, xact, work, rwork, iwork, nout )
184 INTEGER NN, NNB, NNS, NMAX, NOUT
185 DOUBLE PRECISION THRESH
189 INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
190 DOUBLE PRECISION RWORK( * )
191 COMPLEX*16 A( * ), AFAC( * ), AINV( * ), B( * ),
192 $ work( * ), x( * ), xact( * )
198 DOUBLE PRECISION ZERO
199 parameter ( zero = 0.0d+0 )
201 parameter ( czero = 0.0e+0 )
203 parameter ( ntypes = 10 )
205 parameter ( ntests = 9 )
209 CHARACTER DIST,
TYPE, UPLO, XTYPE
210 CHARACTER*3 PATH, MATPATH
211 INTEGER I, I1, I2, IMAT, IN, INB, INFO, IOFF, IRHS,
212 $ iuplo, izero, j, k, kl, ku, lda, lwork, mode,
213 $ n, nb, nerrs, nfail, nimat, nrhs, nrun, nt
214 DOUBLE PRECISION ANORM, CNDNUM
218 INTEGER ISEED( 4 ), ISEEDY( 4 )
219 DOUBLE PRECISION RESULT( ntests )
222 DOUBLE PRECISION DGET06, ZLANSY
223 EXTERNAL dget06, zlansy
240 COMMON / infoc / infot, nunit, ok, lerr
241 COMMON / srnamc / srnamt
244 DATA iseedy / 1988, 1989, 1990, 1991 /
245 DATA uplos /
'U',
'L' /
253 path( 1: 1 ) =
'Zomplex precision'
258 matpath( 1: 1 ) =
'Zomplex precision'
259 matpath( 2: 3 ) =
'SY'
264 iseed( i ) = iseedy( i )
270 $
CALL zerrsy( path, nout )
282 IF( n .GT. nmax )
THEN
284 WRITE(nout, 9995)
'M ', n, nmax
297 DO 170 imat = 1, nimat
301 IF( .NOT.dotype( imat ) )
306 zerot = imat.GE.3 .AND. imat.LE.6
307 IF( zerot .AND. n.LT.imat-2 )
313 uplo = uplos( iuplo )
321 CALL zlatb4( matpath, imat, n, n,
TYPE, KL, KU,
322 $ anorm, mode, cndnum, dist )
327 CALL zlatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
328 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
334 CALL alaerh( path,
'ZLATMS', info, 0, uplo, n, n, -1,
335 $ -1, -1, imat, nfail, nerrs, nout )
349 ELSE IF( imat.EQ.4 )
THEN
359 IF( iuplo.EQ.1 )
THEN
360 ioff = ( izero-1 )*lda
361 DO 20 i = 1, izero - 1
371 DO 40 i = 1, izero - 1
381 IF( iuplo.EQ.1 )
THEN
428 CALL zlacpy( uplo, n, n, a, lda, afac, lda )
436 lwork = max( 1, n*nb + n )
437 CALL zsytrf_aa( uplo, n, afac, lda, iwork, ainv,
443 IF( izero.GT.0 )
THEN
449 ELSE IF( iwork( j ).EQ.k )
THEN
463 CALL alaerh( path,
'ZSYTRF_AA', info, k, uplo,
464 $ n, n, -1, -1, nb, imat, nfail, nerrs,
471 CALL zsyt01_aa( uplo, n, a, lda, afac, lda, iwork,
472 $ ainv, lda, rwork, result( 1 ) )
480 IF( result( k ).GE.thresh )
THEN
481 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
482 $
CALL alahd( nout, path )
483 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
508 CALL zlarhs( matpath, xtype, uplo,
' ', n, n,
509 $ kl, ku, nrhs, a, lda, xact, lda,
510 $ b, lda, iseed, info )
511 CALL zlacpy(
'Full', n, nrhs, b, lda, x, lda )
514 lwork = max( 1, 3*n-2 )
515 CALL zsytrs_aa( uplo, n, nrhs, afac, lda,
516 $ iwork, x, lda, work, lwork,
522 CALL alaerh( path,
'ZSYTRS_AA', info, 0,
523 $ uplo, n, n, -1, -1, nrhs, imat,
524 $ nfail, nerrs, nout )
527 CALL zlacpy(
'Full', n, nrhs, b, lda, work, lda )
531 CALL zsyt02( uplo, n, nrhs, a, lda, x, lda, work,
532 $ lda, rwork, result( 2 ) )
539 IF( result( k ).GE.thresh )
THEN
540 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
541 $
CALL alahd( nout, path )
542 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
543 $ imat, k, result( k )
560 CALL alasum( path, nout, nfail, nrun, nerrs )
562 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
563 $ i2,
', test ', i2,
', ratio =', g12.5 )
564 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
565 $ i2,
', test(', i2,
') =', g12.5 )
566 9995
FORMAT(
' Invalid input value: ', a4,
'=', i6,
'; must be <=',
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zerrsy(PATH, NUNIT)
ZERRSY
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zsytrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRF_AA
subroutine dsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRI2
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 dsycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
subroutine zsyt01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZSYT01
subroutine zsyt02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZSYT02
subroutine zchksy_aa(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
ZCHKSY_AA
subroutine zsytrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
ZSYTRS_AA
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zsyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZSYRFS
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM