146 REAL FUNCTION sla_syrcond( UPLO, N, A, LDA, AF, LDAF, IPIV, CMODE,
147 $ c, info, work, iwork )
156 INTEGER n, lda, ldaf, info, cmode
159 INTEGER iwork( * ), ipiv( * )
160 REAL a( lda, * ), af( ldaf, * ), work( * ), c( * )
168 REAL ainvnm, smlnum, tmp
193 ELSE IF( lda.LT.max( 1, n ) )
THEN
195 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
199 CALL
xerbla(
'SLA_SYRCOND', -info )
207 IF (
lsame( uplo,
'U' ) ) up = .true.
215 IF ( cmode .EQ. 1 )
THEN
217 tmp = tmp + abs( a(
j, i ) * c(
j ) )
220 tmp = tmp + abs( a( i,
j ) * c(
j ) )
222 ELSE IF ( cmode .EQ. 0 )
THEN
224 tmp = tmp + abs( a(
j, i ) )
227 tmp = tmp + abs( a( i,
j ) )
231 tmp = tmp + abs( a(
j, i ) / c(
j ) )
234 tmp = tmp + abs( a( i,
j ) / c(
j ) )
242 IF ( cmode .EQ. 1 )
THEN
244 tmp = tmp + abs( a( i,
j ) * c(
j ) )
247 tmp = tmp + abs( a(
j, i ) * c(
j ) )
249 ELSE IF ( cmode .EQ. 0 )
THEN
251 tmp = tmp + abs( a( i,
j ) )
254 tmp = tmp + abs( a(
j, i ) )
258 tmp = tmp + abs( a( i,
j) / c(
j ) )
261 tmp = tmp + abs( a(
j, i) / c(
j ) )
270 smlnum =
slamch(
'Safe minimum' )
276 CALL
slacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
283 work( i ) = work( i ) * work( 2*n+i )
287 CALL
ssytrs(
'U', n, 1, af, ldaf, ipiv, work, n, info )
289 CALL
ssytrs(
'L', n, 1, af, ldaf, ipiv, work, n, info )
294 IF ( cmode .EQ. 1 )
THEN
296 work( i ) = work( i ) / c( i )
298 ELSE IF ( cmode .EQ. -1 )
THEN
300 work( i ) = work( i ) * c( i )
307 IF ( cmode .EQ. 1 )
THEN
309 work( i ) = work( i ) / c( i )
311 ELSE IF ( cmode .EQ. -1 )
THEN
313 work( i ) = work( i ) * c( i )
318 CALL
ssytrs(
'U', n, 1, af, ldaf, ipiv, work, n, info )
320 CALL
ssytrs(
'L', n, 1, af, ldaf, ipiv, work, n, info )
326 work( i ) = work( i ) * work( 2*n+i )
335 IF( ainvnm .NE. 0.0 )
LOGICAL function lsame(CA, CB)
LSAME
INTEGER function isamax(N, SX, INCX)
ISAMAX
REAL function slamch(CMACH)
SLAMCH
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slatrs(UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, CNORM, INFO)
SLATRS solves a triangular system of equations with the scale factor set to prevent overflow...
subroutine ssytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SSYTRS
subroutine srscl(N, SA, SX, INCX)
SRSCL multiplies a vector by the reciprocal of a real scalar.
subroutine slacn2(N, V, X, ISGN, EST, KASE, ISAVE)
SLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
REAL function sla_syrcond(UPLO, N, A, LDA, AF, LDAF, IPIV, CMODE, C, INFO, WORK, IWORK)
SLA_SYRCOND estimates the Skeel condition number for a symmetric indefinite matrix.