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

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.
[out]WORK
          WORK is REAL 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 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*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
ssytrs
subroutine ssytrs(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
SSYTRS
Definition ssytrs.f:120
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:146
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:136
slamch
real function slamch(cmach)
SLAMCH
Definition slamch.f:68
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: