LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ dla_syrcond()

double precision function dla_syrcond ( character  uplo,
integer  n,
double precision, dimension( lda, * )  a,
integer  lda,
double precision, dimension( ldaf, * )  af,
integer  ldaf,
integer, dimension( * )  ipiv,
integer  cmode,
double precision, dimension( * )  c,
integer  info,
double precision, dimension( * )  work,
integer, dimension( * )  iwork 
)

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

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

Purpose:
    DLA_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 DOUBLE PRECISION 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 DOUBLE PRECISION array, dimension (LDAF,N)
     The block diagonal matrix D and the multipliers used to
     obtain the factor U or L as computed by DSYTRF.
[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 DSYTRF.
[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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 145 of file dla_syrcond.f.

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