174 SUBROUTINE stpt05( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX,
175 $ xact, ldxact, ferr, berr, reslts )
183 CHARACTER diag, trans, uplo
184 INTEGER ldb, ldx, ldxact, n, nrhs
187 REAL ap( * ),
b( ldb, * ), berr( * ), ferr( * ),
188 $ reslts( * ),
x( ldx, * ), xact( ldxact, * )
195 parameter( zero = 0.0e+0, one = 1.0e+0 )
198 LOGICAL notran, unit, upper
199 INTEGER i, ifu, imax,
j, jc, k
200 REAL axbi, diff, eps, errbnd, ovfl, tmp, unfl, xnorm
209 INTRINSIC abs, max, min
215 IF( n.LE.0 .OR. nrhs.LE.0 )
THEN
222 unfl =
slamch(
'Safe minimum' )
224 upper =
lsame( uplo,
'U' )
225 notran =
lsame( trans,
'N' )
226 unit =
lsame( diag,
'U' )
235 xnorm = max( abs(
x( imax,
j ) ), unfl )
238 diff = max( diff, abs(
x( i,
j )-xact( i,
j ) ) )
241 IF( xnorm.GT.one )
THEN
243 ELSE IF( diff.LE.ovfl*xnorm )
THEN
251 IF( diff / xnorm.LE.ferr(
j ) )
THEN
252 errbnd = max( errbnd, ( diff / xnorm ) / ferr(
j ) )
267 tmp = abs(
b( i, k ) )
269 jc = ( ( i-1 )*i ) / 2
270 IF( .NOT.notran )
THEN
272 tmp = tmp + abs( ap( jc+
j ) )*abs(
x(
j, k ) )
275 $ tmp = tmp + abs(
x( i, k ) )
279 tmp = tmp + abs(
x( i, k ) )
283 tmp = tmp + abs( ap( jc ) )*abs(
x(
j, k ) )
291 tmp = tmp + abs( ap( jc ) )*abs(
x(
j, k ) )
295 $ tmp = tmp + abs(
x( i, k ) )
297 jc = ( i-1 )*( n-i ) + ( i*( i+1 ) ) / 2
299 $ tmp = tmp + abs(
x( i, k ) )
301 tmp = tmp + abs( ap( jc+
j-i ) )*abs(
x(
j, k ) )
308 axbi = min( axbi, tmp )
311 tmp = berr( k ) / ( ( n+1 )*eps+( n+1 )*unfl /
312 $ max( axbi, ( n+1 )*unfl ) )
316 reslts( 2 ) = max( reslts( 2 ), tmp )
LOGICAL function lsame(CA, CB)
LSAME
INTEGER function isamax(N, SX, INCX)
ISAMAX
REAL function slamch(CMACH)
SLAMCH
subroutine stpt05(UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
STPT05
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j