156 SUBROUTINE dppt05( UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT,
157 $ ldxact, ferr, berr, reslts )
166 INTEGER ldb, ldx, ldxact, n, nrhs
169 DOUBLE PRECISION ap( * ), b( ldb, * ), berr( * ), ferr( * ),
170 $ reslts( * ), x( ldx, * ), xact( ldxact, * )
176 DOUBLE PRECISION zero, one
177 parameter( zero = 0.0d+0, one = 1.0d+0 )
181 INTEGER i, imax, j, jc, k
182 DOUBLE PRECISION axbi, diff, eps, errbnd, ovfl, tmp, unfl, xnorm
191 INTRINSIC abs, max, min
197 IF( n.LE.0 .OR. nrhs.LE.0 )
THEN
204 unfl =
dlamch(
'Safe minimum' )
206 upper =
lsame( uplo,
'U' )
214 imax =
idamax( n, x( 1, j ), 1 )
215 xnorm = max( abs( x( imax, j ) ), unfl )
218 diff = max( diff, abs( x( i, j )-xact( i, j ) ) )
221 IF( xnorm.GT.one )
THEN
223 ELSE IF( diff.LE.ovfl*xnorm )
THEN
231 IF( diff / xnorm.LE.ferr( j ) )
THEN
232 errbnd = max( errbnd, ( diff / xnorm ) / ferr( j ) )
244 tmp = abs( b( i, k ) )
246 jc = ( ( i-1 )*i ) / 2
248 tmp = tmp + abs( ap( jc+j ) )*abs( x( j, k ) )
252 tmp = tmp + abs( ap( jc ) )*abs( x( j, k ) )
258 tmp = tmp + abs( ap( jc ) )*abs( x( j, k ) )
262 tmp = tmp + abs( ap( jc+j-i ) )*abs( x( j, k ) )
268 axbi = min( axbi, tmp )
271 tmp = berr( k ) / ( ( n+1 )*eps+( n+1 )*unfl /
272 $ max( axbi, ( n+1 )*unfl ) )
276 reslts( 2 ) = max( reslts( 2 ), tmp )