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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
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 *
srscl
subroutine srscl(N, SA, SX, INCX)
SRSCL multiplies a vector by the reciprocal of a real scalar.
Definition: srscl.f:86
sla_syrcond
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
isamax
integer function isamax(N, SX, INCX)
ISAMAX
Definition: isamax.f:53
ssytrs
subroutine ssytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SSYTRS
Definition: ssytrs.f:122
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
slacn2
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
slatrs
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
slamch
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
lsame
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: