163 SUBROUTINE cchksp( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
164 $ nmax, a, afac, ainv, b, x, xact, work, rwork,
174 INTEGER NMAX, NN, NNS, NOUT
179 INTEGER IWORK( * ), NSVAL( * ), NVAL( * )
181 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
182 $ work( * ), x( * ), xact( * )
189 parameter( zero = 0.0e+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 REAL ANORM, CNDNUM, RCOND, RCONDC
206 INTEGER ISEED( 4 ), ISEEDY( 4 )
207 REAL RESULT( ntests )
212 EXTERNAL lsame, clansp, sget06
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 ) =
'Complex precision'
246 iseed( i ) = iseedy( i )
252 $ CALL
cerrsy( 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
clatb4( path, imat, n, n,
TYPE, KL, KU, ANORM,
294 $ mode, cndnum, dist )
297 CALL
clatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
298 $ cndnum, anorm, kl, ku, packit, a, lda,
304 CALL
alaerh( path,
'CLATMS', 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
clatsp( uplo, n, a, iseed )
387 CALL
ccopy( npp, a, 1, afac, 1 )
389 CALL
csptrf( 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,
'CSPTRF', info, k, uplo, n, n, -1,
412 $ -1, -1, imat, nfail, nerrs, nout )
422 CALL
cspt01( uplo, n, a, afac, iwork, ainv, lda, rwork,
429 IF( .NOT.trfcon )
THEN
430 CALL
ccopy( npp, afac, 1, ainv, 1 )
432 CALL
csptri( uplo, n, ainv, iwork, work, info )
437 $ CALL
alaerh( path,
'CSPTRI', info, 0, uplo, n, n,
438 $ -1, -1, -1, imat, nfail, nerrs, nout )
440 CALL
cspt03( 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
clarhs( path, xtype, uplo,
' ', n, n, kl, ku,
474 $ nrhs, a, lda, xact, lda, b, lda, iseed,
476 CALL
clacpy(
'Full', n, nrhs, b, lda, x, lda )
479 CALL
csptrs( uplo, n, nrhs, afac, iwork, x, lda,
485 $ CALL
alaerh( path,
'CSPTRS', info, 0, uplo, n, n,
486 $ -1, -1, nrhs, imat, nfail, nerrs,
489 CALL
clacpy(
'Full', n, nrhs, b, lda, work, lda )
490 CALL
cspt02( uplo, n, nrhs, a, x, lda, work, lda,
491 $ rwork, result( 3 ) )
496 CALL
cget04( n, nrhs, x, lda, xact, lda, rcondc,
503 CALL
csprfs( 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,
'CSPRFS', info, 0, uplo, n, n,
511 $ -1, -1, nrhs, imat, nfail, nerrs,
514 CALL
cget04( n, nrhs, x, lda, xact, lda, rcondc,
516 CALL
cppt05( 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 = clansp(
'1', uplo, n, a, rwork )
541 CALL
cspcon( uplo, n, afac, iwork, anorm, rcond, work,
547 $ CALL
alaerh( path,
'CSPCON', info, 0, uplo, n, n, -1,
548 $ -1, -1, imat, nfail, nerrs, nout )
550 result( 8 ) = sget06( 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 clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine cspt03(UPLO, N, A, AINV, WORK, LDW, RWORK, RCOND, RESID)
CSPT03
subroutine csptrf(UPLO, N, AP, IPIV, INFO)
CSPTRF
subroutine clatsp(UPLO, N, X, ISEED)
CLATSP
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine cppt05(UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CPPT05
subroutine cchksp(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, IWORK, NOUT)
CCHKSP
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine cspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
CSPCON
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cspt01(UPLO, N, A, AFAC, IPIV, C, LDC, RWORK, RESID)
CSPT01
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine cspt02(UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
CSPT02
subroutine cerrsy(PATH, NUNIT)
CERRSY
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine csprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CSPRFS
subroutine csptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
CSPTRS
subroutine csptri(UPLO, N, AP, IPIV, WORK, INFO)
CSPTRI
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04