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 )
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 cerrpo(PATH, NUNIT)
CERRPO
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
subroutine alahd(IOUNIT, PATH)
ALAHD
real function clanhe(NORM, UPLO, N, A, LDA, WORK)
CLANHE 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 Hermitian matrix.
subroutine cpot01(UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID)
CPOT01
subroutine claipd(N, A, INDA, VINDA)
CLAIPD
real function sget06(RCOND, RCONDC)
SGET06
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine cpocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
CPOCON
subroutine cpot05(UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CPOT05
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine cchkpo(DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL, THRESH, TSTERR, NMAX, A, AFAC, AINV, B, X, XACT, WORK, RWORK, NOUT)
CCHKPO
subroutine cpot03(UPLO, N, A, LDA, AINV, LDAINV, WORK, LDWORK, RWORK, RCOND, RESID)
CPOT03
subroutine cpotri(UPLO, N, A, LDA, INFO)
CPOTRI
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
subroutine cpot02(UPLO, N, NRHS, A, LDA, X, LDX, B, LDB, RWORK, RESID)
CPOT02
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine clatb4(PATH, IMAT, M, N, TYPE, KL, KU, ANORM, MODE, CNDNUM, DIST)
CLATB4
subroutine xlaenv(ISPEC, NVALUE)
XLAENV
subroutine cporfs(UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CPORFS
subroutine cpotrf(UPLO, N, A, LDA, INFO)
CPOTRF
subroutine cpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
CPOTRS
subroutine cget04(N, NRHS, X, LDX, XACT, LDXACT, RCOND, RESID)
CGET04