192 SUBROUTINE csyrfs( UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB,
193 $ x, ldx, ferr, berr, work, rwork, info )
202 INTEGER INFO, LDA, LDAF, LDB, LDX, N, NRHS
206 REAL BERR( * ), FERR( * ), RWORK( * )
207 COMPLEX A( lda, * ), AF( ldaf, * ), B( ldb, * ),
208 $ work( * ), x( ldx, * )
215 parameter ( itmax = 5 )
217 parameter ( zero = 0.0e+0 )
219 parameter ( one = ( 1.0e+0, 0.0e+0 ) )
221 parameter ( two = 2.0e+0 )
223 parameter ( three = 3.0e+0 )
227 INTEGER COUNT, I, J, K, KASE, NZ
228 REAL EPS, LSTRES, S, SAFE1, SAFE2, SAFMIN, XK
238 INTRINSIC abs, aimag, max, real
243 EXTERNAL lsame, slamch
249 cabs1( zdum ) = abs(
REAL( ZDUM ) ) + abs( AIMAG( zdum ) )
256 upper = lsame( uplo,
'U' )
257 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
259 ELSE IF( n.LT.0 )
THEN
261 ELSE IF( nrhs.LT.0 )
THEN
263 ELSE IF( lda.LT.max( 1, n ) )
THEN
265 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
267 ELSE IF( ldb.LT.max( 1, n ) )
THEN
269 ELSE IF( ldx.LT.max( 1, n ) )
THEN
273 CALL xerbla(
'CSYRFS', -info )
279 IF( n.EQ.0 .OR. nrhs.EQ.0 )
THEN
290 eps = slamch(
'Epsilon' )
291 safmin = slamch(
'Safe minimum' )
307 CALL ccopy( n, b( 1, j ), 1, work, 1 )
308 CALL csymv( uplo, n, -one, a, lda, x( 1, j ), 1, one, work, 1 )
320 rwork( i ) = cabs1( b( i, j ) )
328 xk = cabs1( x( k, j ) )
330 rwork( i ) = rwork( i ) + cabs1( a( i, k ) )*xk
331 s = s + cabs1( a( i, k ) )*cabs1( x( i, j ) )
333 rwork( k ) = rwork( k ) + cabs1( a( k, k ) )*xk + s
338 xk = cabs1( x( k, j ) )
339 rwork( k ) = rwork( k ) + cabs1( a( k, k ) )*xk
341 rwork( i ) = rwork( i ) + cabs1( a( i, k ) )*xk
342 s = s + cabs1( a( i, k ) )*cabs1( x( i, j ) )
344 rwork( k ) = rwork( k ) + s
349 IF( rwork( i ).GT.safe2 )
THEN
350 s = max( s, cabs1( work( i ) ) / rwork( i ) )
352 s = max( s, ( cabs1( work( i ) )+safe1 ) /
353 $ ( rwork( i )+safe1 ) )
364 IF( berr( j ).GT.eps .AND. two*berr( j ).LE.lstres .AND.
365 $ count.LE.itmax )
THEN
369 CALL csytrs( uplo, n, 1, af, ldaf, ipiv, work, n, info )
370 CALL caxpy( n, one, work, 1, x( 1, j ), 1 )
399 IF( rwork( i ).GT.safe2 )
THEN
400 rwork( i ) = cabs1( work( i ) ) + nz*eps*rwork( i )
402 rwork( i ) = cabs1( work( i ) ) + nz*eps*rwork( i ) +
409 CALL clacn2( n, work( n+1 ), work, ferr( j ), kase, isave )
415 CALL csytrs( uplo, n, 1, af, ldaf, ipiv, work, n, info )
417 work( i ) = rwork( i )*work( i )
419 ELSE IF( kase.EQ.2 )
THEN
424 work( i ) = rwork( i )*work( i )
426 CALL csytrs( uplo, n, 1, af, ldaf, ipiv, work, n, info )
435 lstres = max( lstres, cabs1( x( i, j ) ) )
438 $ ferr( j ) = ferr( j ) / lstres
subroutine csyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CSYRFS
subroutine csymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CSYMV computes a matrix-vector product for a complex symmetric matrix.
subroutine csytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CSYTRS
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine clacn2(N, V, X, EST, KASE, ISAVE)
CLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY