151 DOUBLE PRECISION FUNCTION dla_gercond ( TRANS, N, A, LDA, AF,
152 $ ldaf, ipiv, cmode, c,
153 $ info, work, iwork )
162 INTEGER N, LDA, LDAF, INFO, CMODE
165 INTEGER IPIV( * ), IWORK( * )
166 DOUBLE PRECISION A( lda, * ), AF( ldaf, * ), WORK( * ),
175 DOUBLE PRECISION AINVNM, TMP
195 notrans = lsame( trans,
'N' )
196 IF ( .NOT. notrans .AND. .NOT. lsame(trans,
'T')
197 $ .AND. .NOT. lsame(trans,
'C') )
THEN
199 ELSE IF( n.LT.0 )
THEN
201 ELSE IF( lda.LT.max( 1, n ) )
THEN
203 ELSE IF( ldaf.LT.max( 1, n ) )
THEN
207 CALL
xerbla(
'DLA_GERCOND', -info )
221 IF ( cmode .EQ. 1 )
THEN
223 tmp = tmp + abs( a( i, j ) * c( j ) )
225 ELSE IF ( cmode .EQ. 0 )
THEN
227 tmp = tmp + abs( a( i, j ) )
231 tmp = tmp + abs( a( i, j ) / c( j ) )
239 IF ( cmode .EQ. 1 )
THEN
241 tmp = tmp + abs( a( j, i ) * c( j ) )
243 ELSE IF ( cmode .EQ. 0 )
THEN
245 tmp = tmp + abs( a( j, i ) )
249 tmp = tmp + abs( a( j, i ) / c( j ) )
262 CALL
dlacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
269 work(i) = work(i) * work(2*n+i)
273 CALL
dgetrs(
'No transpose', n, 1, af, ldaf, ipiv,
276 CALL
dgetrs(
'Transpose', n, 1, af, ldaf, ipiv,
282 IF ( cmode .EQ. 1 )
THEN
284 work( i ) = work( i ) / c( i )
286 ELSE IF ( cmode .EQ. -1 )
THEN
288 work( i ) = work( i ) * c( i )
295 IF ( cmode .EQ. 1 )
THEN
297 work( i ) = work( i ) / c( i )
299 ELSE IF ( cmode .EQ. -1 )
THEN
301 work( i ) = work( i ) * c( i )
306 CALL
dgetrs(
'Transpose', n, 1, af, ldaf, ipiv,
309 CALL
dgetrs(
'No transpose', n, 1, af, ldaf, ipiv,
316 work( i ) = work( i ) * work( 2*n+i )
324 IF( ainvnm .NE. 0.0d+0 )
325 $ dla_gercond = ( 1.0d+0 / ainvnm )
subroutine dgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DGETRS
subroutine xerbla(SRNAME, INFO)
XERBLA
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...