147 SUBROUTINE cchkpt( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
148 $ a, d, e, b, x, xact, work, rwork, nout )
157 INTEGER NN, NNS, NOUT
162 INTEGER NSVAL( * ), NVAL( * )
163 REAL D( * ), RWORK( * )
164 COMPLEX A( * ), B( * ), E( * ), WORK( * ), X( * ),
172 parameter ( one = 1.0e+0, zero = 0.0e+0 )
174 parameter ( ntypes = 12 )
176 parameter ( ntests = 7 )
180 CHARACTER DIST,
TYPE, UPLO
182 INTEGER I, IA, IMAT, IN, INFO, IRHS, IUPLO, IX, IZERO,
183 $ j, k, kl, ku, lda, mode, n, nerrs, nfail,
185 REAL AINVNM, ANORM, COND, DMAX, RCOND, RCONDC
189 INTEGER ISEED( 4 ), ISEEDY( 4 )
190 REAL RESULT( ntests )
195 REAL CLANHT, SCASUM, SGET06
196 EXTERNAL isamax, clanht, scasum, sget06
205 INTRINSIC abs, max, real
213 COMMON / infoc / infot, nunit, ok, lerr
214 COMMON / srnamc / srnamt
217 DATA iseedy / 0, 0, 0, 1 / , uplos /
'U',
'L' /
221 path( 1: 1 ) =
'Complex precision'
227 iseed( i ) = iseedy( i )
233 $
CALL cerrgt( path, nout )
246 DO 110 imat = 1, nimat
250 IF( n.GT.0 .AND. .NOT.dotype( imat ) )
255 CALL clatb4( path, imat, n, n,
TYPE, KL, KU, ANORM, MODE,
258 zerot = imat.GE.8 .AND. imat.LE.10
265 CALL clatms( n, n, dist, iseed,
TYPE, RWORK, MODE, COND,
266 $ anorm, kl, ku,
'B', a, 2, work, info )
271 CALL alaerh( path,
'CLATMS', info, 0,
' ', n, n, kl,
272 $ ku, -1, imat, nfail, nerrs, nout )
281 d( i ) =
REAL( A( IA ) )
286 $ d( n ) =
REAL( A( IA ) )
292 IF( .NOT.zerot .OR. .NOT.dotype( 7 ) )
THEN
296 CALL slarnv( 2, iseed, n, d )
297 CALL clarnv( 2, iseed, n-1, e )
302 d( 1 ) = abs( d( 1 ) )
304 d( 1 ) = abs( d( 1 ) ) + abs( e( 1 ) )
305 d( n ) = abs( d( n ) ) + abs( e( n-1 ) )
307 d( i ) = abs( d( i ) ) + abs( e( i ) ) +
314 ix = isamax( n, d, 1 )
316 CALL sscal( n, anorm / dmax, d, 1 )
317 CALL csscal( n-1, anorm / dmax, e, 1 )
319 ELSE IF( izero.GT.0 )
THEN
324 IF( izero.EQ.1 )
THEN
328 ELSE IF( izero.EQ.n )
THEN
332 e( izero-1 ) = z( 1 )
350 ELSE IF( imat.EQ.9 )
THEN
358 ELSE IF( imat.EQ.10 )
THEN
360 IF( izero.GT.1 )
THEN
361 z( 1 ) = e( izero-1 )
371 CALL scopy( n, d, 1, d( n+1 ), 1 )
373 $
CALL ccopy( n-1, e, 1, e( n+1 ), 1 )
379 CALL cpttrf( n, d( n+1 ), e( n+1 ), info )
383 IF( info.NE.izero )
THEN
384 CALL alaerh( path,
'CPTTRF', info, izero,
' ', n, n, -1,
385 $ -1, -1, imat, nfail, nerrs, nout )
394 CALL cptt01( n, d, e, d( n+1 ), e( n+1 ), work,
399 IF( result( 1 ).GE.thresh )
THEN
400 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
401 $
CALL alahd( nout, path )
402 WRITE( nout, fmt = 9999 )n, imat, 1, result( 1 )
411 anorm = clanht(
'1', n, d, e )
422 CALL cpttrs(
'Lower', n, 1, d( n+1 ), e( n+1 ), x, lda,
424 ainvnm = max( ainvnm, scasum( n, x, 1 ) )
426 rcondc = one / max( one, anorm*ainvnm )
435 CALL clarnv( 2, iseed, n, xact( ix ) )
443 uplo = uplos( iuplo )
447 CALL claptm( uplo, n, nrhs, one, d, e, xact, lda,
453 CALL clacpy(
'Full', n, nrhs, b, lda, x, lda )
454 CALL cpttrs( uplo, n, nrhs, d( n+1 ), e( n+1 ), x,
460 $
CALL alaerh( path,
'CPTTRS', info, 0, uplo, n, n,
461 $ -1, -1, nrhs, imat, nfail, nerrs,
464 CALL clacpy(
'Full', n, nrhs, b, lda, work, lda )
465 CALL cptt02( uplo, n, nrhs, d, e, x, lda, work, lda,
471 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
478 CALL cptrfs( uplo, n, nrhs, d, e, d( n+1 ), e( n+1 ),
479 $ b, lda, x, lda, rwork, rwork( nrhs+1 ),
480 $ work, rwork( 2*nrhs+1 ), info )
485 $
CALL alaerh( path,
'CPTRFS', info, 0, uplo, n, n,
486 $ -1, -1, nrhs, imat, nfail, nerrs,
489 CALL cget04( n, nrhs, x, lda, xact, lda, rcondc,
491 CALL cptt05( n, nrhs, d, e, b, lda, x, lda, xact, lda,
492 $ rwork, rwork( nrhs+1 ), result( 5 ) )
498 IF( result( k ).GE.thresh )
THEN
499 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
500 $
CALL alahd( nout, path )
501 WRITE( nout, fmt = 9998 )uplo, n, nrhs, imat,
517 CALL cptcon( n, d( n+1 ), e( n+1 ), anorm, rcond, rwork,
523 $
CALL alaerh( path,
'CPTCON', info, 0,
' ', n, n, -1, -1,
524 $ -1, imat, nfail, nerrs, nout )
526 result( 7 ) = sget06( rcond, rcondc )
530 IF( result( 7 ).GE.thresh )
THEN
531 IF( nfail.EQ.0 .AND. nerrs.EQ.0 )
532 $
CALL alahd( nout, path )
533 WRITE( nout, fmt = 9999 )n, imat, 7, result( 7 )
542 CALL alasum( path, nout, nfail, nrun, nerrs )
544 9999
FORMAT(
' N =', i5,
', type ', i2,
', test ', i2,
', ratio = ',
546 9998
FORMAT(
' UPLO = ''', a1,
''', N =', i5,
', NRHS =', i3,
547 $
', type ', i2,
', test ', i2,
', ratio = ', g12.5 )
subroutine cpttrf(N, D, E, INFO)
CPTTRF
subroutine alahd(IOUNIT, PATH)
ALAHD
subroutine alaerh(PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU, N5, IMAT, NFAIL, NERRS, NOUT)
ALAERH
subroutine cerrgt(PATH, NUNIT)
CERRGT
subroutine claptm(UPLO, N, NRHS, ALPHA, D, E, X, LDX, BETA, B, LDB)
CLAPTM
subroutine cptcon(N, D, E, ANORM, RCOND, RWORK, INFO)
CPTCON
subroutine cpttrs(UPLO, N, NRHS, D, E, B, LDB, INFO)
CPTTRS
subroutine clarnv(IDIST, ISEED, N, X)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine cptt02(UPLO, N, NRHS, D, E, X, LDX, B, LDB, RESID)
CPTT02
subroutine cptrfs(UPLO, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CPTRFS
subroutine cptt01(N, D, E, DF, EF, WORK, RESID)
CPTT01
subroutine cptt05(N, NRHS, D, E, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
CPTT05
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 slarnv(IDIST, ISEED, N, X)
SLARNV returns a vector of random numbers from a uniform or normal distribution.
subroutine cchkpt(DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR, A, D, E, B, X, XACT, WORK, RWORK, NOUT)
CCHKPT
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
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 scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
subroutine csscal(N, SA, CX, INCX)
CSSCAL