LAPACK  3.6.1 LAPACK: Linear Algebra PACKage
 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.

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

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.``` [in] WORK ``` WORK is REAL array, dimension (3*N). Workspace.``` [in] IWORK ``` IWORK is INTEGER array, dimension (N). Workspace.```
Date
September 2012

Definition at line 148 of file sla_syrcond.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: