LAPACK  3.7.0
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
December 2016

Definition at line 148 of file sla_syrcond.f.

148 *
149 * -- LAPACK computational routine (version 3.7.0) --
150 * -- LAPACK is a software package provided by Univ. of Tennessee, --
151 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
152 * December 2016
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  REAL slamch
177  EXTERNAL lsame, slamch
178 * ..
179 * .. External Subroutines ..
180  EXTERNAL slacn2, xerbla, ssytrs
181 * ..
182 * .. Intrinsic Functions ..
183  INTRINSIC abs, max
184 * ..
185 * .. Executable Statements ..
186 *
187  sla_syrcond = 0.0
188 *
189  info = 0
190  IF( n.LT.0 ) THEN
191  info = -2
192  ELSE IF( lda.LT.max( 1, n ) ) THEN
193  info = -4
194  ELSE IF( ldaf.LT.max( 1, n ) ) THEN
195  info = -6
196  END IF
197  IF( info.NE.0 ) THEN
198  CALL xerbla( 'SLA_SYRCOND', -info )
199  RETURN
200  END IF
201  IF( n.EQ.0 ) THEN
202  sla_syrcond = 1.0
203  RETURN
204  END IF
205  up = .false.
206  IF ( lsame( uplo, 'U' ) ) up = .true.
207 *
208 * Compute the equilibration matrix R such that
209 * inv(R)*A*C has unit 1-norm.
210 *
211  IF ( up ) THEN
212  DO i = 1, n
213  tmp = 0.0
214  IF ( cmode .EQ. 1 ) THEN
215  DO j = 1, i
216  tmp = tmp + abs( a( j, i ) * c( j ) )
217  END DO
218  DO j = i+1, n
219  tmp = tmp + abs( a( i, j ) * c( j ) )
220  END DO
221  ELSE IF ( cmode .EQ. 0 ) THEN
222  DO j = 1, i
223  tmp = tmp + abs( a( j, i ) )
224  END DO
225  DO j = i+1, n
226  tmp = tmp + abs( a( i, j ) )
227  END DO
228  ELSE
229  DO j = 1, i
230  tmp = tmp + abs( a( j, i ) / c( j ) )
231  END DO
232  DO j = i+1, n
233  tmp = tmp + abs( a( i, j ) / c( j ) )
234  END DO
235  END IF
236  work( 2*n+i ) = tmp
237  END DO
238  ELSE
239  DO i = 1, n
240  tmp = 0.0
241  IF ( cmode .EQ. 1 ) THEN
242  DO j = 1, i
243  tmp = tmp + abs( a( i, j ) * c( j ) )
244  END DO
245  DO j = i+1, n
246  tmp = tmp + abs( a( j, i ) * c( j ) )
247  END DO
248  ELSE IF ( cmode .EQ. 0 ) THEN
249  DO j = 1, i
250  tmp = tmp + abs( a( i, j ) )
251  END DO
252  DO j = i+1, n
253  tmp = tmp + abs( a( j, i ) )
254  END DO
255  ELSE
256  DO j = 1, i
257  tmp = tmp + abs( a( i, j) / c( j ) )
258  END DO
259  DO j = i+1, n
260  tmp = tmp + abs( a( j, i) / c( j ) )
261  END DO
262  END IF
263  work( 2*n+i ) = tmp
264  END DO
265  ENDIF
266 *
267 * Estimate the norm of inv(op(A)).
268 *
269  smlnum = slamch( 'Safe minimum' )
270  ainvnm = 0.0
271  normin = 'N'
272 
273  kase = 0
274  10 CONTINUE
275  CALL slacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
276  IF( kase.NE.0 ) THEN
277  IF( kase.EQ.2 ) THEN
278 *
279 * Multiply by R.
280 *
281  DO i = 1, n
282  work( i ) = work( i ) * work( 2*n+i )
283  END DO
284 
285  IF ( up ) THEN
286  CALL ssytrs( 'U', n, 1, af, ldaf, ipiv, work, n, info )
287  ELSE
288  CALL ssytrs( 'L', n, 1, af, ldaf, ipiv, work, n, 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 ssytrs( 'U', n, 1, af, ldaf, ipiv, work, n, info )
318  ELSE
319  CALL ssytrs( 'L', n, 1, af, ldaf, ipiv, work, n, info )
320  ENDIF
321 *
322 * Multiply by R.
323 *
324  DO i = 1, n
325  work( i ) = work( i ) * work( 2*n+i )
326  END DO
327  END IF
328 *
329  GO TO 10
330  END IF
331 *
332 * Compute the estimate of the reciprocal condition number.
333 *
334  IF( ainvnm .NE. 0.0 )
335  $ sla_syrcond = ( 1.0 / ainvnm )
336 *
337  RETURN
338 *
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
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
lsame
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
slamch
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
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

Here is the call graph for this function:

Here is the caller graph for this function: