LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ dla_syrcond()

double precision function dla_syrcond ( character uplo,
integer n,
double precision, dimension( lda, * ) a,
integer lda,
double precision, dimension( ldaf, * ) af,
integer ldaf,
integer, dimension( * ) ipiv,
integer cmode,
double precision, dimension( * ) c,
integer info,
double precision, dimension( * ) work,
integer, dimension( * ) iwork )

DLA_SYRCOND estimates the Skeel condition number for a symmetric indefinite matrix.

Download DLA_SYRCOND + dependencies [TGZ] [ZIP] [TXT]

Purpose:
!>
!>    DLA_SYRCOND estimates the Skeel condition number of  op(A) * op2(C)
!>    where op2 is determined by CMODE as follows
!>    CMODE =  1    op2(C) = C
!>    CMODE =  0    op2(C) = I
!>    CMODE = -1    op2(C) = inv(C)
!>    The Skeel condition number cond(A) = norminf( |inv(A)||A| )
!>    is computed by computing scaling factors R such that
!>    diag(R)*A*op2(C) is row equilibrated and computing the standard
!>    infinity-norm condition number.
!>
Parameters
[in]UPLO
!>          UPLO is CHARACTER*1
!>       = 'U':  Upper triangle of A is stored;
!>       = 'L':  Lower triangle of A is stored.
!>
[in]N
!>          N is INTEGER
!>     The number of linear equations, i.e., the order of the
!>     matrix A.  N >= 0.
!>
[in]A
!>          A is DOUBLE PRECISION array, dimension (LDA,N)
!>     On entry, the N-by-N matrix A.
!>
[in]LDA
!>          LDA is INTEGER
!>     The leading dimension of the array A.  LDA >= max(1,N).
!>
[in]AF
!>          AF is DOUBLE PRECISION array, dimension (LDAF,N)
!>     The block diagonal matrix D and the multipliers used to
!>     obtain the factor U or L as computed by DSYTRF.
!>
[in]LDAF
!>          LDAF is INTEGER
!>     The leading dimension of the array AF.  LDAF >= max(1,N).
!>
[in]IPIV
!>          IPIV is INTEGER array, dimension (N)
!>     Details of the interchanges and the block structure of D
!>     as determined by DSYTRF.
!>
[in]CMODE
!>          CMODE is INTEGER
!>     Determines op2(C) in the formula op(A) * op2(C) as follows:
!>     CMODE =  1    op2(C) = C
!>     CMODE =  0    op2(C) = I
!>     CMODE = -1    op2(C) = inv(C)
!>
[in]C
!>          C is DOUBLE PRECISION array, dimension (N)
!>     The vector C in the formula op(A) * op2(C).
!>
[out]INFO
!>          INFO is INTEGER
!>       = 0:  Successful exit.
!>     i > 0:  The ith argument is invalid.
!>
[out]WORK
!>          WORK is DOUBLE PRECISION array, dimension (3*N).
!>     Workspace.
!>
[out]IWORK
!>          IWORK is INTEGER array, dimension (N).
!>     Workspace.
!>
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 143 of file dla_syrcond.f.

147*
148* -- LAPACK computational routine --
149* -- LAPACK is a software package provided by Univ. of Tennessee, --
150* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
151*
152* .. Scalar Arguments ..
153 CHARACTER UPLO
154 INTEGER N, LDA, LDAF, INFO, CMODE
155* ..
156* .. Array Arguments
157 INTEGER IWORK( * ), IPIV( * )
158 DOUBLE PRECISION A( LDA, * ), AF( LDAF, * ), WORK( * ), C( * )
159* ..
160*
161* =====================================================================
162*
163* .. Local Scalars ..
164 CHARACTER NORMIN
165 INTEGER KASE, I, J
166 DOUBLE PRECISION AINVNM, SMLNUM, TMP
167 LOGICAL UP
168* ..
169* .. Local Arrays ..
170 INTEGER ISAVE( 3 )
171* ..
172* .. External Functions ..
173 LOGICAL LSAME
174 DOUBLE PRECISION DLAMCH
175 EXTERNAL lsame, dlamch
176* ..
177* .. External Subroutines ..
178 EXTERNAL dlacn2, xerbla, dsytrs
179* ..
180* .. Intrinsic Functions ..
181 INTRINSIC abs, max
182* ..
183* .. Executable Statements ..
184*
185 dla_syrcond = 0.0d+0
186*
187 info = 0
188 IF( n.LT.0 ) THEN
189 info = -2
190 ELSE IF( lda.LT.max( 1, n ) ) THEN
191 info = -4
192 ELSE IF( ldaf.LT.max( 1, n ) ) THEN
193 info = -6
194 END IF
195 IF( info.NE.0 ) THEN
196 CALL xerbla( 'DLA_SYRCOND', -info )
197 RETURN
198 END IF
199 IF( n.EQ.0 ) THEN
200 dla_syrcond = 1.0d+0
201 RETURN
202 END IF
203 up = .false.
204 IF ( lsame( uplo, 'U' ) ) up = .true.
205*
206* Compute the equilibration matrix R such that
207* inv(R)*A*C has unit 1-norm.
208*
209 IF ( up ) THEN
210 DO i = 1, n
211 tmp = 0.0d+0
212 IF ( cmode .EQ. 1 ) THEN
213 DO j = 1, i
214 tmp = tmp + abs( a( j, i ) * c( j ) )
215 END DO
216 DO j = i+1, n
217 tmp = tmp + abs( a( i, j ) * c( j ) )
218 END DO
219 ELSE IF ( cmode .EQ. 0 ) THEN
220 DO j = 1, i
221 tmp = tmp + abs( a( j, i ) )
222 END DO
223 DO j = i+1, n
224 tmp = tmp + abs( a( i, j ) )
225 END DO
226 ELSE
227 DO j = 1, i
228 tmp = tmp + abs( a( j, i ) / c( j ) )
229 END DO
230 DO j = i+1, n
231 tmp = tmp + abs( a( i, j ) / c( j ) )
232 END DO
233 END IF
234 work( 2*n+i ) = tmp
235 END DO
236 ELSE
237 DO i = 1, n
238 tmp = 0.0d+0
239 IF ( cmode .EQ. 1 ) THEN
240 DO j = 1, i
241 tmp = tmp + abs( a( i, j ) * c( j ) )
242 END DO
243 DO j = i+1, n
244 tmp = tmp + abs( a( j, i ) * c( j ) )
245 END DO
246 ELSE IF ( cmode .EQ. 0 ) THEN
247 DO j = 1, i
248 tmp = tmp + abs( a( i, j ) )
249 END DO
250 DO j = i+1, n
251 tmp = tmp + abs( a( j, i ) )
252 END DO
253 ELSE
254 DO j = 1, i
255 tmp = tmp + abs( a( i, j) / c( j ) )
256 END DO
257 DO j = i+1, n
258 tmp = tmp + abs( a( j, i) / c( j ) )
259 END DO
260 END IF
261 work( 2*n+i ) = tmp
262 END DO
263 ENDIF
264*
265* Estimate the norm of inv(op(A)).
266*
267 smlnum = dlamch( 'Safe minimum' )
268 ainvnm = 0.0d+0
269 normin = 'N'
270
271 kase = 0
272 10 CONTINUE
273 CALL dlacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
274 IF( kase.NE.0 ) THEN
275 IF( kase.EQ.2 ) THEN
276*
277* Multiply by R.
278*
279 DO i = 1, n
280 work( i ) = work( i ) * work( 2*n+i )
281 END DO
282
283 IF ( up ) THEN
284 CALL dsytrs( 'U', n, 1, af, ldaf, ipiv, work, n,
285 $ info )
286 ELSE
287 CALL dsytrs( 'L', n, 1, af, ldaf, ipiv, work, n,
288 $ info )
289 ENDIF
290*
291* Multiply by inv(C).
292*
293 IF ( cmode .EQ. 1 ) THEN
294 DO i = 1, n
295 work( i ) = work( i ) / c( i )
296 END DO
297 ELSE IF ( cmode .EQ. -1 ) THEN
298 DO i = 1, n
299 work( i ) = work( i ) * c( i )
300 END DO
301 END IF
302 ELSE
303*
304* Multiply by inv(C**T).
305*
306 IF ( cmode .EQ. 1 ) THEN
307 DO i = 1, n
308 work( i ) = work( i ) / c( i )
309 END DO
310 ELSE IF ( cmode .EQ. -1 ) THEN
311 DO i = 1, n
312 work( i ) = work( i ) * c( i )
313 END DO
314 END IF
315
316 IF ( up ) THEN
317 CALL dsytrs( 'U', n, 1, af, ldaf, ipiv, work, n,
318 $ info )
319 ELSE
320 CALL dsytrs( 'L', n, 1, af, ldaf, ipiv, work, n,
321 $ info )
322 ENDIF
323*
324* Multiply by R.
325*
326 DO i = 1, n
327 work( i ) = work( i ) * work( 2*n+i )
328 END DO
329 END IF
330*
331 GO TO 10
332 END IF
333*
334* Compute the estimate of the reciprocal condition number.
335*
336 IF( ainvnm .NE. 0.0d+0 )
337 $ dla_syrcond = ( 1.0d+0 / ainvnm )
338*
339 RETURN
340*
341* End of DLA_SYRCOND
342*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
dsytrs
subroutine dsytrs(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
DSYTRS
Definition dsytrs.f:118
dla_syrcond
double precision function dla_syrcond(uplo, n, a, lda, af, ldaf, ipiv, cmode, c, info, work, iwork)
DLA_SYRCOND estimates the Skeel condition number for a symmetric indefinite matrix.
Definition dla_syrcond.f:147
dlacn2
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...
Definition dlacn2.f:134
dlamch
double precision function dlamch(cmach)
DLAMCH
Definition dlamch.f:69
lsame
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the call graph for this function:
Here is the caller graph for this function: