175 SUBROUTINE ztpt05( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX,
176 $ xact, ldxact, ferr, berr, reslts )
184 CHARACTER diag, trans, uplo
185 INTEGER ldb, ldx, ldxact, n, nrhs
188 DOUBLE PRECISION berr( * ), ferr( * ), reslts( * )
189 COMPLEX*16 ap( * ),
b( ldb, * ), x( ldx, * ),
196 DOUBLE PRECISION zero, one
197 parameter( zero = 0.0d+0, one = 1.0d+0 )
200 LOGICAL notran, unit, upper
201 INTEGER i, ifu, imax,
j, jc, k
202 DOUBLE PRECISION axbi, diff, eps, errbnd, ovfl, tmp, unfl, xnorm
212 INTRINSIC abs, dble, dimag, max, min
215 DOUBLE PRECISION cabs1
218 cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
224 IF( n.LE.0 .OR. nrhs.LE.0 )
THEN
231 unfl =
dlamch(
'Safe minimum' )
233 upper =
lsame( uplo,
'U' )
234 notran =
lsame( trans,
'N' )
235 unit =
lsame( diag,
'U' )
243 imax =
izamax( n, x( 1,
j ), 1 )
244 xnorm = max( cabs1( x( imax,
j ) ), unfl )
247 diff = max( diff, cabs1( x( i,
j )-xact( i,
j ) ) )
250 IF( xnorm.GT.one )
THEN
252 ELSE IF( diff.LE.ovfl*xnorm )
THEN
260 IF( diff / xnorm.LE.ferr(
j ) )
THEN
261 errbnd = max( errbnd, ( diff / xnorm ) / ferr(
j ) )
276 tmp = cabs1(
b( i, k ) )
278 jc = ( ( i-1 )*i ) / 2
279 IF( .NOT.notran )
THEN
281 tmp = tmp + cabs1( ap( jc+
j ) )*cabs1( x(
j, k ) )
284 $ tmp = tmp + cabs1( x( i, k ) )
288 tmp = tmp + cabs1( x( i, k ) )
292 tmp = tmp + cabs1( ap( jc ) )*cabs1( x(
j, k ) )
300 tmp = tmp + cabs1( ap( jc ) )*cabs1( x(
j, k ) )
304 $ tmp = tmp + cabs1( x( i, k ) )
306 jc = ( i-1 )*( n-i ) + ( i*( i+1 ) ) / 2
308 $ tmp = tmp + cabs1( x( i, k ) )
310 tmp = tmp + cabs1( ap( jc+
j-i ) )*
318 axbi = min( axbi, tmp )
321 tmp = berr( k ) / ( ( n+1 )*eps+( n+1 )*unfl /
322 $ max( axbi, ( n+1 )*unfl ) )
326 reslts( 2 ) = max( reslts( 2 ), tmp )
integer function izamax(N, ZX, INCX)
IZAMAX
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
double precision function dlamch(CMACH)
DLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine ztpt05(UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX, XACT, LDXACT, FERR, BERR, RESLTS)
ZTPT05