167 SUBROUTINE cchkpo( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
168 $ thresh, tsterr, nmax, a, afac, ainv, b, x,
169 $ xact, work, rwork, nout )
178 INTEGER NMAX, NN, NNB, NNS, NOUT
183 INTEGER NBVAL( * ), NSVAL( * ), NVAL( * )
185 COMPLEX A( * ), AFAC( * ), AINV( * ), B( * ),
186 $ work( * ), x( * ), xact( * )
193 parameter ( czero = ( 0.0e+0, 0.0e+0 ) )
195 parameter ( ntypes = 9 )
197 parameter ( ntests = 8 )
201 CHARACTER DIST,
TYPE, UPLO, XTYPE
203 INTEGER I, IMAT, IN, INB, INFO, IOFF, IRHS, IUPLO,
204 $ izero, k, kl, ku, lda, mode, n, nb, nerrs,
205 $ nfail, nimat, nrhs, nrun
206 REAL ANORM, CNDNUM, RCOND, RCONDC
210 INTEGER ISEED( 4 ), ISEEDY( 4 )
211 REAL RESULT( ntests )
215 EXTERNAL clanhe, sget06
229 COMMON / infoc / infot, nunit, ok, lerr
230 COMMON / srnamc / srnamt
236 DATA iseedy / 1988, 1989, 1990, 1991 /
237 DATA uplos /
'U',
'L' /
243 path( 1: 1 ) =
'Complex precision'
249 iseed( i ) = iseedy( i )
255 $
CALL cerrpo( path, nout )
269 DO 110 imat = 1, nimat
273 IF( .NOT.dotype( imat ) )
278 zerot = imat.GE.3 .AND. imat.LE.5
279 IF( zerot .AND. n.LT.imat-2 )
285 uplo = uplos( iuplo )
290 CALL clatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
294 CALL clatms( n, n, dist, iseed,
TYPE, RWORK, MODE,
295 $ cndnum, anorm, kl, ku, uplo, a, lda, work,
301 CALL alaerh( path,
'CLATMS', info, 0, uplo, n, n, -1,
302 $ -1, -1, imat, nfail, nerrs, nout )
312 ELSE IF( imat.EQ.4 )
THEN
317 ioff = ( izero-1 )*lda
321 IF( iuplo.EQ.1 )
THEN
322 DO 20 i = 1, izero - 1
332 DO 40 i = 1, izero - 1
347 CALL claipd( n, a, lda+1, 0 )
357 CALL clacpy( uplo, n, n, a, lda, afac, lda )
359 CALL cpotrf( uplo, n, afac, lda, info )
363 IF( info.NE.izero )
THEN
364 CALL alaerh( path,
'CPOTRF', info, izero, uplo, n,
365 $ n, -1, -1, nb, imat, nfail, nerrs,
378 CALL clacpy( uplo, n, n, afac, lda, ainv, lda )
379 CALL cpot01( uplo, n, a, lda, ainv, lda, rwork,
385 CALL clacpy( uplo, n, n, afac, lda, ainv, lda )
387 CALL cpotri( uplo, n, ainv, lda, info )
392 $
CALL alaerh( path,
'CPOTRI', info, 0, uplo, n, n,
393 $ -1, -1, -1, imat, nfail, nerrs, nout )
395 CALL cpot03( uplo, n, a, lda, ainv, lda, work, lda,
396 $ rwork, rcondc, result( 2 ) )
402 IF( result( k ).GE.thresh )
THEN
403 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
404 $
CALL alahd( nout, path )
405 WRITE( nout, fmt = 9999 )uplo, n, nb, imat, k,
425 CALL clarhs( path, xtype, uplo,
' ', n, n, kl, ku,
426 $ nrhs, a, lda, xact, lda, b, lda,
428 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
431 CALL cpotrs( uplo, n, nrhs, afac, lda, x, lda,
437 $
CALL alaerh( path,
'CPOTRS', info, 0, uplo, n,
438 $ n, -1, -1, nrhs, imat, nfail,
441 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda )
442 CALL cpot02( uplo, n, nrhs, a, lda, x, lda, work,
443 $ lda, rwork, result( 3 ) )
448 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
455 CALL cporfs( uplo, n, nrhs, a, lda, afac, lda, b,
456 $ lda, x, lda, rwork, rwork( nrhs+1 ),
457 $ work, rwork( 2*nrhs+1 ), info )
462 $
CALL alaerh( path,
'CPORFS', info, 0, uplo, n,
463 $ n, -1, -1, nrhs, imat, nfail,
466 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
468 CALL cpot05( uplo, n, nrhs, a, lda, b, lda, x, lda,
469 $ xact, lda, rwork, rwork( nrhs+1 ),
476 IF( result( k ).GE.thresh )
THEN
477 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
478 $
CALL alahd( nout, path )
479 WRITE( nout, fmt = 9998 )uplo, n, nrhs,
480 $ imat, k, result( k )
490 anorm = clanhe(
'1', uplo, n, a, lda, rwork )
492 CALL cpocon( uplo, n, afac, lda, anorm, rcond, work,
498 $
CALL alaerh( path,
'CPOCON', info, 0, uplo, n, n,
499 $ -1, -1, -1, imat, nfail, nerrs, nout )
501 result( 8 ) = sget06( rcond, rcondc )
505 IF( result( 8 ).GE.thresh )
THEN
506 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
507 $
CALL alahd( nout, path )
508 WRITE( nout, fmt = 9997 )uplo, n, imat, 8,
520 CALL alasum( path, nout, nfail, nrun, nerrs )
522 9999
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NB =', i4,
', type ',
523 $ i2,
', test ', i2,
', ratio =', g12.5 )
524 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS=', i3,
', type ',
525 $ i2,
', test(', i2,
') =', g12.5 )
526 9997
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
',', 10x,
' type ', i2,
527 $
', test(', i2,
') =', g12.5 )
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine cpotri(UPLO, N, A, LDA, INFO)
CPOTRI
subroutine claipd(N, A, INDA, VINDA)
CLAIPD
subroutine cporfs(UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CPORFS
subroutine cpot01(UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
CPOT01
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine cpocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
CPOCON
subroutine cpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CPOT02
subroutine cpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
CPOTRS
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 cpotrf(UPLO, N, A, LDA, INFO)
CPOTRF
subroutine cpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CPOT05
subroutine cpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
CPOT03
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 cerrpo(PATH, NUNIT)
CERRPO
subroutine cchkpo(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, NOUT)
CCHKPO
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM