161 SUBROUTINE cchksp( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
162 $ NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK,
171 INTEGER NMAX, NN, NNS, NOUT
176 INTEGER IWORK( * ), NSVAL( * ), NVAL( * )
178 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
179 $ work( * ), x( * ), xact( * )
186 PARAMETER ( ZERO = 0.0e+0 )
188 parameter( ntypes = 11 )
190 parameter( ntests = 8 )
193 LOGICAL TRFCON, ZEROT
194 CHARACTER DIST, PACKIT,
TYPE, UPLO, XTYPE
196 INTEGER I, I1, I2, IMAT, IN, INFO, IOFF, IRHS, IUPLO,
197 $ izero, j, k, kl, ku, lda, mode, n, nerrs,
198 $ nfail, nimat, npp, nrhs, nrun, nt
199 REAL ANORM, CNDNUM, RCOND, RCONDC
203 INTEGER ISEED( 4 ), ISEEDY( 4 )
204 REAL RESULT( NTESTS )
209 EXTERNAL lsame, clansp, sget06
226 COMMON / infoc / infot, nunit, ok, lerr
227 COMMON / srnamc / srnamt
230 DATA iseedy / 1988, 1989, 1990, 1991 /
231 DATA uplos /
'U',
'L' /
237 path( 1: 1 ) =
'Complex precision'
243 iseed( i ) = iseedy( i )
249 $
CALL cerrsy( path, nout )
262 DO 160 imat = 1, nimat
266 IF( .NOT.dotype( imat ) )
271 zerot = imat.GE.3 .AND. imat.LE.6
272 IF( zerot .AND. n.LT.imat-2 )
278 uplo = uplos( iuplo )
279 IF( lsame( uplo,
'U' ) )
THEN
285 IF( imat.NE.ntypes )
THEN
290 CALL clatb4( path, imat, n, n,
TYPE, kl, ku, anorm,
291 $ mode, cndnum, dist )
294 CALL clatms( n, n, dist, iseed,
TYPE, rwork, mode,
295 $ cndnum, anorm, kl, ku, packit, a, lda,
301 CALL alaerh( path,
'CLATMS', info, 0, uplo, n, n,
302 $ -1, -1, -1, imat, nfail, nerrs, nout )
312 ELSE IF( imat.EQ.4 )
THEN
322 IF( iuplo.EQ.1 )
THEN
323 ioff = ( izero-1 )*izero / 2
324 DO 20 i = 1, izero - 1
334 DO 40 i = 1, izero - 1
344 IF( iuplo.EQ.1 )
THEN
378 CALL clatsp( uplo, n, a, iseed )
384 CALL ccopy( npp, a, 1, afac, 1 )
386 CALL csptrf( uplo, n, afac, iwork, info )
394 IF( iwork( k ).LT.0 )
THEN
395 IF( iwork( k ).NE.-k )
THEN
399 ELSE IF( iwork( k ).NE.k )
THEN
408 $
CALL alaerh( path,
'CSPTRF', info, k, uplo, n, n, -1,
409 $ -1, -1, imat, nfail, nerrs, nout )
419 CALL cspt01( uplo, n, a, afac, iwork, ainv, lda, rwork,
426 IF( .NOT.trfcon )
THEN
427 CALL ccopy( npp, afac, 1, ainv, 1 )
429 CALL csptri( uplo, n, ainv, iwork, work, info )
434 $
CALL alaerh( path,
'CSPTRI', info, 0, uplo, n, n,
435 $ -1, -1, -1, imat, nfail, nerrs, nout )
437 CALL cspt03( uplo, n, a, ainv, work, lda, rwork,
438 $ rcondc, result( 2 ) )
446 IF( result( k ).GE.thresh )
THEN
447 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
448 $
CALL alahd( nout, path )
449 WRITE( nout, fmt = 9999 )uplo, n, imat, k,
470 CALL clarhs( path, xtype, uplo,
' ', n, n, kl, ku,
471 $ nrhs, a, lda, xact, lda, b, lda, iseed,
473 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
476 CALL csptrs( uplo, n, nrhs, afac, iwork, x, lda,
482 $
CALL alaerh( path,
'CSPTRS', info, 0, uplo, n, n,
483 $ -1, -1, nrhs, imat, nfail, nerrs,
486 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda )
487 CALL cspt02( uplo, n, nrhs, a, x, lda, work, lda,
488 $ rwork, result( 3 ) )
493 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
500 CALL csprfs( uplo, n, nrhs, a, afac, iwork, b, lda, x,
501 $ lda, rwork, rwork( nrhs+1 ), work,
502 $ rwork( 2*nrhs+1 ), info )
507 $
CALL alaerh( path,
'CSPRFS', info, 0, uplo, n, n,
508 $ -1, -1, nrhs, imat, nfail, nerrs,
511 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
513 CALL cppt05( uplo, n, nrhs, a, b, lda, x, lda, xact,
514 $ lda, rwork, rwork( nrhs+1 ),
521 IF( result( k ).GE.thresh )
THEN
522 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
523 $
CALL alahd( nout, path )
524 WRITE( nout, fmt = 9998 )uplo, n, nrhs, imat,
536 anorm = clansp(
'1', uplo, n, a, rwork )
538 CALL cspcon( uplo, n, afac, iwork, anorm, rcond, work,
544 $
CALL alaerh( path,
'CSPCON', info, 0, uplo, n, n, -1,
545 $ -1, -1, imat, nfail, nerrs, nout )
547 result( 8 ) = sget06( rcond, rcondc )
551 IF( result( 8 ).GE.thresh )
THEN
552 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
553 $
CALL alahd( nout, path )
554 WRITE( nout, fmt = 9999 )uplo, n, imat, 8,
565 CALL alasum( path, nout, nfail, nrun, nerrs )
567 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', type ', i2,
', test ',
568 $ i2,
', ratio =', g12.5 )
569 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
570 $ i2,
', test(', i2,
') =', g12.5 )
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine clatsp(UPLO, N, X, ISEED)
CLATSP
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine cspt02(UPLO, N, NRHS, A, X, LDX, B, LDB, RWORK, RESID)
CSPT02
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04
subroutine cerrsy(PATH, NUNIT)
CERRSY
subroutine cspt03(UPLO, N, A, AINV, WORK, LDW, RWORK, RCOND, RESID)
CSPT03
subroutine cspt01(UPLO, N, A, AFAC, IPIV, C, LDC, RWORK, RESID)
CSPT01
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 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 csprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CSPRFS
subroutine csptri(UPLO, N, AP, IPIV, WORK, INFO)
CSPTRI
subroutine csptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
CSPTRS
subroutine csptrf(UPLO, N, AP, IPIV, INFO)
CSPTRF
subroutine cspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
CSPCON