141 DOUBLE PRECISION FUNCTION dla_porcond( UPLO, N, A, LDA, AF, LDAF,
142 $ cmode, c, info, work,
152 INTEGER N, LDA, LDAF, INFO, CMODE
153 DOUBLE PRECISION A( lda, * ), AF( ldaf, * ), WORK( * ),
164 DOUBLE PRECISION AINVNM, TMP
189 CALL xerbla(
'DLA_PORCOND', -info )
198 IF ( lsame( uplo,
'U' ) ) up = .true.
206 IF ( cmode .EQ. 1 )
THEN
208 tmp = tmp + abs( a( j, i ) * c( j ) )
211 tmp = tmp + abs( a( i, j ) * c( j ) )
213 ELSE IF ( cmode .EQ. 0 )
THEN
215 tmp = tmp + abs( a( j, i ) )
218 tmp = tmp + abs( a( i, j ) )
222 tmp = tmp + abs( a( j ,i ) / c( j ) )
225 tmp = tmp + abs( a( i, j ) / c( j ) )
233 IF ( cmode .EQ. 1 )
THEN
235 tmp = tmp + abs( a( i, j ) * c( j ) )
238 tmp = tmp + abs( a( j, i ) * c( j ) )
240 ELSE IF ( cmode .EQ. 0 )
THEN
242 tmp = tmp + abs( a( i, j ) )
245 tmp = tmp + abs( a( j, i ) )
249 tmp = tmp + abs( a( i, j ) / c( j ) )
252 tmp = tmp + abs( a( j, i ) / c( j ) )
265 CALL dlacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
272 work( i ) = work( i ) * work( 2*n+i )
276 CALL dpotrs(
'Upper', n, 1, af, ldaf, work, n, info )
278 CALL dpotrs(
'Lower', n, 1, af, ldaf, work, n, info )
283 IF ( cmode .EQ. 1 )
THEN
285 work( i ) = work( i ) / c( i )
287 ELSE IF ( cmode .EQ. -1 )
THEN
289 work( i ) = work( i ) * c( i )
296 IF ( cmode .EQ. 1 )
THEN
298 work( i ) = work( i ) / c( i )
300 ELSE IF ( cmode .EQ. -1 )
THEN
302 work( i ) = work( i ) * c( i )
307 CALL dpotrs(
'Upper', n, 1, af, ldaf, work, n, info )
309 CALL dpotrs(
'Lower', n, 1, af, ldaf, work, n, info )
315 work( i ) = work( i ) * work( 2*n+i )
323 IF( ainvnm .NE. 0.0d+0 )
double precision function dla_porcond(UPLO, N, A, LDA, AF, LDAF, CMODE, C, INFO, WORK, IWORK)
DLA_PORCOND estimates the Skeel condition number for a symmetric positive-definite matrix...
subroutine dlacn2(N, V, X, ISGN, EST, KASE, ISAVE)
DLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
subroutine dpotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
DPOTRS
subroutine xerbla(SRNAME, INFO)
XERBLA