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 zsycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZSYCON
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine zerrsy(PATH, NUNIT)
ZERRSY
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
subroutine zsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRI2
subroutine zsyt01(UPLO, N, A, LDA, AFAC, LDAFAC, IPIV, C, LDC, RWORK, RESID)
ZSYT01
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine zsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRF
subroutine zsytrs2(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, INFO)
ZSYTRS2
subroutine zlatsy(UPLO, N, X, LDX, ISEED)
ZLATSY
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4
subroutine zsyt03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
ZSYT03
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 zsyt02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
ZSYT02
double precision function dget06(RCOND, RCONDC)
DGET06
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPOT05
subroutine zsyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZSYRFS
subroutine zsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZSYTRS
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM