165 SUBROUTINE cpot05( UPLO, N, NRHS, A, LDA, B, LDB, X, LDX, XACT,
166 $ ldxact, ferr, berr, reslts )
175 INTEGER lda, ldb, ldx, ldxact, n, nrhs
178 REAL berr( * ), ferr( * ), reslts( * )
179 COMPLEX a( lda, * ),
b( ldb, * ), x( ldx, * ),
187 parameter( zero = 0.0e+0, one = 1.0e+0 )
191 INTEGER i, imax,
j, k
192 REAL axbi, diff, eps, errbnd, ovfl, tmp, unfl, xnorm
202 INTRINSIC abs, aimag, max, min, real
208 cabs1( zdum ) = abs(
REAL( ZDUM ) ) + abs( aimag( zdum ) )
214 IF( n.LE.0 .OR. nrhs.LE.0 )
THEN
221 unfl =
slamch(
'Safe minimum' )
223 upper =
lsame( uplo,
'U' )
231 imax =
icamax( n, x( 1,
j ), 1 )
232 xnorm = max( cabs1( x( imax,
j ) ), unfl )
235 diff = max( diff, cabs1( x( i,
j )-xact( i,
j ) ) )
238 IF( xnorm.GT.one )
THEN
240 ELSE IF( diff.LE.ovfl*xnorm )
THEN
248 IF( diff / xnorm.LE.ferr(
j ) )
THEN
249 errbnd = max( errbnd, ( diff / xnorm ) / ferr(
j ) )
261 tmp = cabs1(
b( i, k ) )
264 tmp = tmp + cabs1( a(
j, i ) )*cabs1( x(
j, k ) )
266 tmp = tmp + abs(
REAL( A( I, I ) ) )*cabs1( x( i, k ) )
268 tmp = tmp + cabs1( a( i,
j ) )*cabs1( x(
j, k ) )
272 tmp = tmp + cabs1( a( i,
j ) )*cabs1( x(
j, k ) )
274 tmp = tmp + abs(
REAL( A( I, I ) ) )*cabs1( x( i, k ) )
276 tmp = tmp + cabs1( a(
j, i ) )*cabs1( x(
j, k ) )
282 axbi = min( axbi, tmp )
285 tmp = berr( k ) / ( ( n+1 )*eps+( n+1 )*unfl /
286 $ max( axbi, ( n+1 )*unfl ) )
290 reslts( 2 ) = max( reslts( 2 ), tmp )
integer function icamax(N, CX, INCX)
ICAMAX
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
logical function lsame(CA, CB)
LSAME
real function slamch(CMACH)
SLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j