171 SUBROUTINE cchksy_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
189 INTEGER IWORK( * ), NBVAL( * ), NSVAL( * ), NVAL( * )
191 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
192 $ work( * ), x( * ), xact( * )
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
218 INTEGER ISEED( 4 ), ISEEDY( 4 )
219 REAL RESULT( ntests )
223 EXTERNAL dget06, clansy
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 ) =
'Complex precision'
258 matpath( 1: 1 ) =
'Complex precision'
259 matpath( 2: 3 ) =
'SY'
264 iseed( i ) = iseedy( i )
270 $
CALL cerrsy( 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 clatb4( matpath, imat, n, n,
TYPE, KL, KU,
322 $ anorm, mode, cndnum, dist )
327 CALL clatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
328 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
334 CALL alaerh( path,
'CLATMS', 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 clacpy( uplo, n, n, a, lda, afac, lda )
436 lwork = max( 1, n*nb + n )
437 CALL csytrf_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,
'CSYTRF_AA', info, k, uplo,
464 $ n, n, -1, -1, nb, imat, nfail, nerrs,
471 CALL csyt01_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 clarhs( matpath, xtype, uplo,
' ', n, n,
509 $ kl, ku, nrhs, a, lda, xact, lda,
510 $ b, lda, iseed, info )
511 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
514 lwork = max( 1, 3*n-2 )
515 CALL csytrs_aa( uplo, n, nrhs, afac, lda,
516 $ iwork, x, lda, work, lwork,
522 CALL alaerh( path,
'CSYTRS_AA', info, 0,
523 $ uplo, n, n, -1, -1, nrhs, imat,
524 $ nfail, nerrs, nout )
527 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda )
531 CALL csyt02( 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 csyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CSYRFS
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine csytrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CSYTRS_AA
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine csytrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF_AA
subroutine csyt02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CSYT02
subroutine cerrsy(PATH, NUNIT)
CERRSY
subroutine csyt01_aa(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
CSYT01
subroutine dsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRI2
subroutine dsycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine cchksy_aa(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
CCHKSY_AA
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM