163 SUBROUTINE zchksp( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
164 $ nmax, a, afac, ainv,
b,
x, xact, work, rwork,
174 INTEGER nmax, nn, nns, nout
175 DOUBLE PRECISION thresh
179 INTEGER iwork( * ), nsval( * ), nval( * )
180 DOUBLE PRECISION rwork( * )
181 COMPLEX*16 a( * ), afac( * ), ainv( * ),
b( * ),
182 $ work( * ),
x( * ), xact( * )
188 DOUBLE PRECISION zero
189 parameter( zero = 0.0d+0 )
191 parameter( ntypes = 11 )
193 parameter( ntests = 8 )
196 LOGICAL trfcon, zerot
197 CHARACTER dist, packit, type, uplo, xtype
199 INTEGER i, i1, i2, imat, in, info, ioff, irhs, iuplo,
200 $ izero,
j, k, kl, ku, lda, mode, n, nerrs,
201 $ nfail, nimat, npp, nrhs, nrun, nt
202 DOUBLE PRECISION anorm, cndnum, rcond, rcondc
206 INTEGER iseed( 4 ), iseedy( 4 )
207 DOUBLE PRECISION result( ntests )
229 COMMON / infoc / infot, nunit, ok, lerr
230 COMMON / srnamc / srnamt
233 DATA iseedy / 1988, 1989, 1990, 1991 /
234 DATA uplos /
'U',
'L' /
240 path( 1: 1 ) =
'Zomplex precision'
246 iseed( i ) = iseedy( i )
252 $ CALL
zerrsy( path, nout )
265 DO 160 imat = 1, nimat
269 IF( .NOT.dotype( imat ) )
274 zerot = imat.GE.3 .AND. imat.LE.6
275 IF( zerot .AND. n.LT.imat-2 )
281 uplo = uplos( iuplo )
282 IF(
lsame( uplo,
'U' ) )
THEN
288 IF( imat.NE.ntypes )
THEN
293 CALL
zlatb4( path, imat, n, n, type, kl, ku, anorm,
294 $ mode, cndnum, dist )
297 CALL
zlatms( n, n, dist, iseed, type, rwork, mode,
298 $ cndnum, anorm, kl, ku, packit, a, lda,
304 CALL
alaerh( path,
'ZLATMS', info, 0, uplo, n, n,
305 $ -1, -1, -1, imat, nfail, nerrs, nout )
315 ELSE IF( imat.EQ.4 )
THEN
325 IF( iuplo.EQ.1 )
THEN
326 ioff = ( izero-1 )*izero / 2
327 DO 20 i = 1, izero - 1
337 DO 40 i = 1, izero - 1
347 IF( iuplo.EQ.1 )
THEN
381 CALL
zlatsp( uplo, n, a, iseed )
387 CALL
zcopy( npp, a, 1, afac, 1 )
389 CALL
zsptrf( uplo, n, afac, iwork, info )
397 IF( iwork( k ).LT.0 )
THEN
398 IF( iwork( k ).NE.-k )
THEN
402 ELSE IF( iwork( k ).NE.k )
THEN
411 $ CALL
alaerh( path,
'ZSPTRF', info, k, uplo, n, n, -1,
412 $ -1, -1, imat, nfail, nerrs, nout )
422 CALL
zspt01( uplo, n, a, afac, iwork, ainv, lda, rwork,
429 IF( .NOT.trfcon )
THEN
430 CALL
zcopy( npp, afac, 1, ainv, 1 )
432 CALL
zsptri( uplo, n, ainv, iwork, work, info )
437 $ CALL
alaerh( path,
'ZSPTRI', info, 0, uplo, n, n,
438 $ -1, -1, -1, imat, nfail, nerrs, nout )
440 CALL
zspt03( uplo, n, a, ainv, work, lda, rwork,
441 $ rcondc, result( 2 ) )
449 IF( result( k ).GE.thresh )
THEN
450 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
451 $ CALL
alahd( nout, path )
452 WRITE( nout, fmt = 9999 )uplo, n, imat, k,
473 CALL
zlarhs( path, xtype, uplo,
' ', n, n, kl, ku,
474 $ nrhs, a, lda, xact, lda,
b, lda, iseed,
476 CALL
zlacpy(
'Full', n, nrhs,
b, lda,
x, lda )
479 CALL
zsptrs( uplo, n, nrhs, afac, iwork,
x, lda,
485 $ CALL
alaerh( path,
'ZSPTRS', info, 0, uplo, n, n,
486 $ -1, -1, nrhs, imat, nfail, nerrs,
489 CALL
zlacpy(
'Full', n, nrhs,
b, lda, work, lda )
490 CALL
zspt02( uplo, n, nrhs, a,
x, lda, work, lda,
491 $ rwork, result( 3 ) )
496 CALL
zget04( n, nrhs,
x, lda, xact, lda, rcondc,
503 CALL
zsprfs( uplo, n, nrhs, a, afac, iwork,
b, lda,
x,
504 $ lda, rwork, rwork( nrhs+1 ), work,
505 $ rwork( 2*nrhs+1 ), info )
510 $ CALL
alaerh( path,
'ZSPRFS', info, 0, uplo, n, n,
511 $ -1, -1, nrhs, imat, nfail, nerrs,
514 CALL
zget04( n, nrhs,
x, lda, xact, lda, rcondc,
516 CALL
zppt05( uplo, n, nrhs, a,
b, lda,
x, lda, xact,
517 $ lda, rwork, rwork( nrhs+1 ),
524 IF( result( k ).GE.thresh )
THEN
525 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
526 $ CALL
alahd( nout, path )
527 WRITE( nout, fmt = 9998 )uplo, n, nrhs, imat,
539 anorm =
zlansp(
'1', uplo, n, a, rwork )
541 CALL
zspcon( uplo, n, afac, iwork, anorm, rcond, work,
547 $ CALL
alaerh( path,
'ZSPCON', info, 0, uplo, n, n, -1,
548 $ -1, -1, imat, nfail, nerrs, nout )
550 result( 8 ) =
dget06( rcond, rcondc )
554 IF( result( 8 ).GE.thresh )
THEN
555 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
556 $ CALL
alahd( nout, path )
557 WRITE( nout, fmt = 9999 )uplo, n, imat, 8,
568 CALL
alasum( path, nout, nfail, nrun, nerrs )
570 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', type ', i2,
', test ',
571 $ i2,
', ratio =', g12.5 )
572 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
573 $ i2,
', test(', i2,
') =', g12.5 )
subroutine zspt01(UPLO, N, A, AFAC, IPIV, C, LDC, RWORK, RESID)
ZSPT01
LOGICAL function lsame(CA, CB)
LSAME
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine zget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
ZGET04
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 zlatsp(UPLO, N, X, ISEED)
ZLATSP
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
DOUBLE PRECISION function zlansp(NORM, UPLO, N, AP, WORK)
ZLANSP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix supplied in packed form.
subroutine zspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
ZSPCON
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 zspt03(UPLO, N, A, AINV, WORK, LDW, RWORK, RCOND, RESID)
ZSPT03
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
DOUBLE PRECISION function dget06(RCOND, RCONDC)
DGET06
subroutine zppt05(UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPPT05
subroutine zsptri(UPLO, N, AP, IPIV, WORK, INFO)
ZSPTRI
subroutine zsprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZSPRFS
subroutine zsptrf(UPLO, N, AP, IPIV, INFO)
ZSPTRF
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zchksp(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
ZCHKSP
subroutine zsptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
ZSPTRS
subroutine zlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
ZLATMS
subroutine zspt02(UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
ZSPT02
subroutine zlatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
ZLATB4