179 SUBROUTINE cporfs( UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X,
180 $ LDX, FERR, BERR, WORK, RWORK, INFO )
188 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
191 REAL BERR( * ), FERR( * ), RWORK( * )
192 COMPLEX A( LDA, * ), AF( LDAF, * ), B( LDB, * ),
193 $ work( * ), x( ldx, * )
200 parameter( itmax = 5 )
202 parameter( zero = 0.0e+0 )
204 parameter( one = ( 1.0e+0, 0.0e+0 ) )
206 parameter( two = 2.0e+0 )
208 parameter( three = 3.0e+0 )
212 INTEGER COUNT, I, J, K, KASE, NZ
213 REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
224 INTRINSIC abs, aimag, max, real
229 EXTERNAL lsame, slamch
235 cabs1( zdum ) = abs( real( zdum ) ) + abs( aimag( zdum ) )
242 upper = lsame( uplo,
'U' )
243 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
245 ELSE IF( n.LT.0 )
THEN
247 ELSE IF( nrhs.LT.0 )
THEN
249 ELSE IF( lda.LT.max( 1, n ) )
THEN
251 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
253 ELSE IF( ldb.LT.max( 1, n ) )
THEN
255 ELSE IF( ldx.LT.max( 1, n ) )
THEN
259 CALL xerbla(
'CPORFS', -info )
265 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
276 eps = slamch(
'Epsilon' )
277 safmin = slamch(
'Safe minimum' )
278 safe1 = real( nz )*safmin
293 CALL ccopy( n, b( 1, j ), 1, work, 1 )
294 CALL chemv( uplo, n, -one, a, lda, x( 1, j ), 1, one, work,
307 rwork( i ) = cabs1( b( i, j ) )
315 xk = cabs1( x( k, j ) )
317 rwork( i ) = rwork( i ) + cabs1( a( i, k ) )*xk
318 s = s + cabs1( a( i, k ) )*cabs1( x( i, j ) )
320 rwork( k ) = rwork( k ) + abs( real( a( k, k ) ) )*xk + s
325 xk = cabs1( x( k, j ) )
326 rwork( k ) = rwork( k ) + abs( real( a( k, k ) ) )*xk
328 rwork( i ) = rwork( i ) + cabs1( a( i, k ) )*xk
329 s = s + cabs1( a( i, k ) )*cabs1( x( i, j ) )
331 rwork( k ) = rwork( k ) + s
336 IF( rwork( i ).GT.safe2 )
THEN
337 s = max( s, cabs1( work( i ) ) / rwork( i ) )
339 s = max( s, ( cabs1( work( i ) )+safe1 ) /
340 $ ( rwork( i )+safe1 ) )
351 IF( berr( j ).GT.eps .AND. two*berr( j ).LE.lstres .AND.
352 $ count.LE.itmax )
THEN
356 CALL cpotrs( uplo, n, 1, af, ldaf, work, n, info )
357 CALL caxpy( n, one, work, 1, x( 1, j ), 1 )
386 IF( rwork( i ).GT.safe2 )
THEN
387 rwork( i ) = cabs1( work( i ) ) + real( nz )*
390 rwork( i ) = cabs1( work( i ) ) + real( nz )*
391 $ eps*rwork( i ) + safe1
397 CALL clacn2( n, work( n+1 ), work, ferr( j ), kase, isave )
403 CALL cpotrs( uplo, n, 1, af, ldaf, work, n, info )
405 work( i ) = rwork( i )*work( i )
407 ELSE IF( kase.EQ.2 )
THEN
412 work( i ) = rwork( i )*work( i )
414 CALL cpotrs( uplo, n, 1, af, ldaf, work, n, info )
423 lstres = max( lstres, cabs1( x( i, j ) ) )
426 $ ferr( j ) = ferr( j ) / lstres
subroutine cporfs(uplo, n, nrhs, a, lda, af, ldaf, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CPORFS