LAPACK 3.11.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ sla_syrcond()

 real function sla_syrcond ( character UPLO, integer N, real, dimension( lda, * ) A, integer LDA, real, dimension( ldaf, * ) AF, integer LDAF, integer, dimension( * ) IPIV, integer CMODE, real, dimension( * ) C, integer INFO, real, dimension( * ) WORK, integer, dimension( * ) IWORK )

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

Purpose:
```    SLA_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 REAL 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 REAL array, dimension (LDAF,N) The block diagonal matrix D and the multipliers used to obtain the factor U or L as computed by SSYTRF.``` [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 SSYTRF.``` [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 REAL 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 REAL array, dimension (3*N). Workspace.``` [out] IWORK ``` IWORK is INTEGER array, dimension (N). Workspace.```

Definition at line 144 of file sla_syrcond.f.

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