157 SUBROUTINE zppt05( UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT,
158 $ ldxact, ferr, berr, reslts )
167 INTEGER ldb, ldx, ldxact, n, nrhs
170 DOUBLE PRECISION berr( * ), ferr( * ), reslts( * )
171 COMPLEX*16 ap( * ),
b( ldb, * ),
x( ldx, * ),
178 DOUBLE PRECISION zero, one
179 parameter( zero = 0.0d+0, one = 1.0d+0 )
183 INTEGER i, imax,
j, jc, k
184 DOUBLE PRECISION axbi, diff, eps, errbnd, ovfl, tmp, unfl, xnorm
194 INTRINSIC abs, dble, dimag, max, min
197 DOUBLE PRECISION cabs1
200 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
206 IF( n.LE.0 .OR. nrhs.LE.0 )
THEN
213 unfl =
dlamch(
'Safe minimum' )
215 upper =
lsame( uplo,
'U' )
224 xnorm = max( cabs1(
x( imax,
j ) ), unfl )
227 diff = max( diff, cabs1(
x( i,
j )-xact( i,
j ) ) )
230 IF( xnorm.GT.one )
THEN
232 ELSE IF( diff.LE.ovfl*xnorm )
THEN
240 IF( diff / xnorm.LE.ferr(
j ) )
THEN
241 errbnd = max( errbnd, ( diff / xnorm ) / ferr(
j ) )
253 tmp = cabs1(
b( i, k ) )
255 jc = ( ( i-1 )*i ) / 2
257 tmp = tmp + cabs1( ap( jc+
j ) )*cabs1(
x(
j, k ) )
259 tmp = tmp + abs( dble( ap( jc+i ) ) )*cabs1(
x( i, k ) )
262 tmp = tmp + cabs1( ap( jc ) )*cabs1(
x(
j, k ) )
268 tmp = tmp + cabs1( ap( jc ) )*cabs1(
x(
j, k ) )
271 tmp = tmp + abs( dble( ap( jc ) ) )*cabs1(
x( i, k ) )
273 tmp = tmp + cabs1( ap( jc+
j-i ) )*cabs1(
x(
j, k ) )
279 axbi = min( axbi, tmp )
282 tmp = berr( k ) / ( ( n+1 )*eps+( n+1 )*unfl /
283 $ max( axbi, ( n+1 )*unfl ) )
287 reslts( 2 ) = max( reslts( 2 ), tmp )
LOGICAL function lsame(CA, CB)
LSAME
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zppt05(UPLO, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZPPT05
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
INTEGER function izamax(N, ZX, INCX)
IZAMAX