 LAPACK 3.11.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ cla_hercond_c()

 real function cla_hercond_c ( character UPLO, integer N, complex, dimension( lda, * ) A, integer LDA, complex, dimension( ldaf, * ) AF, integer LDAF, integer, dimension( * ) IPIV, real, dimension ( * ) C, logical CAPPLY, integer INFO, complex, dimension( * ) WORK, real, dimension( * ) RWORK )

CLA_HERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for Hermitian indefinite matrices.

Purpose:
```    CLA_HERCOND_C computes the infinity norm condition number of
op(A) * inv(diag(C)) where C is a REAL vector.```
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 COMPLEX 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 COMPLEX array, dimension (LDAF,N) The block diagonal matrix D and the multipliers used to obtain the factor U or L as computed by CHETRF.``` [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 CHETRF.``` [in] C ``` C is REAL array, dimension (N) The vector C in the formula op(A) * inv(diag(C)).``` [in] CAPPLY ``` CAPPLY is LOGICAL If .TRUE. then access the vector C in the formula above.``` [out] INFO ``` INFO is INTEGER = 0: Successful exit. i > 0: The ith argument is invalid.``` [out] WORK ``` WORK is COMPLEX array, dimension (2*N). Workspace.``` [out] RWORK ``` RWORK is REAL array, dimension (N). Workspace.```

Definition at line 136 of file cla_hercond_c.f.

138*
139* -- LAPACK computational routine --
140* -- LAPACK is a software package provided by Univ. of Tennessee, --
141* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
142*
143* .. Scalar Arguments ..
144 CHARACTER UPLO
145 LOGICAL CAPPLY
146 INTEGER N, LDA, LDAF, INFO
147* ..
148* .. Array Arguments ..
149 INTEGER IPIV( * )
150 COMPLEX A( LDA, * ), AF( LDAF, * ), WORK( * )
151 REAL C ( * ), RWORK( * )
152* ..
153*
154* =====================================================================
155*
156* .. Local Scalars ..
157 INTEGER KASE, I, J
158 REAL AINVNM, ANORM, TMP
159 LOGICAL UP, UPPER
160 COMPLEX ZDUM
161* ..
162* .. Local Arrays ..
163 INTEGER ISAVE( 3 )
164* ..
165* .. External Functions ..
166 LOGICAL LSAME
167 EXTERNAL lsame
168* ..
169* .. External Subroutines ..
170 EXTERNAL clacn2, chetrs, xerbla
171* ..
172* .. Intrinsic Functions ..
173 INTRINSIC abs, max
174* ..
175* .. Statement Functions ..
176 REAL CABS1
177* ..
178* .. Statement Function Definitions ..
179 cabs1( zdum ) = abs( real( zdum ) ) + abs( aimag( zdum ) )
180* ..
181* .. Executable Statements ..
182*
183 cla_hercond_c = 0.0e+0
184*
185 info = 0
186 upper = lsame( uplo, 'U' )
187 IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
188 info = -1
189 ELSE 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( 'CLA_HERCOND_C', -info )
198 RETURN
199 END IF
200 up = .false.
201 IF ( lsame( uplo, 'U' ) ) up = .true.
202*
203* Compute norm of op(A)*op2(C).
204*
205 anorm = 0.0e+0
206 IF ( up ) THEN
207 DO i = 1, n
208 tmp = 0.0e+0
209 IF ( capply ) THEN
210 DO j = 1, i
211 tmp = tmp + cabs1( a( j, i ) ) / c( j )
212 END DO
213 DO j = i+1, n
214 tmp = tmp + cabs1( a( i, j ) ) / c( j )
215 END DO
216 ELSE
217 DO j = 1, i
218 tmp = tmp + cabs1( a( j, i ) )
219 END DO
220 DO j = i+1, n
221 tmp = tmp + cabs1( a( i, j ) )
222 END DO
223 END IF
224 rwork( i ) = tmp
225 anorm = max( anorm, tmp )
226 END DO
227 ELSE
228 DO i = 1, n
229 tmp = 0.0e+0
230 IF ( capply ) THEN
231 DO j = 1, i
232 tmp = tmp + cabs1( a( i, j ) ) / c( j )
233 END DO
234 DO j = i+1, n
235 tmp = tmp + cabs1( a( j, i ) ) / c( j )
236 END DO
237 ELSE
238 DO j = 1, i
239 tmp = tmp + cabs1( a( i, j ) )
240 END DO
241 DO j = i+1, n
242 tmp = tmp + cabs1( a( j, i ) )
243 END DO
244 END IF
245 rwork( i ) = tmp
246 anorm = max( anorm, tmp )
247 END DO
248 END IF
249*
250* Quick return if possible.
251*
252 IF( n.EQ.0 ) THEN
253 cla_hercond_c = 1.0e+0
254 RETURN
255 ELSE IF( anorm .EQ. 0.0e+0 ) THEN
256 RETURN
257 END IF
258*
259* Estimate the norm of inv(op(A)).
260*
261 ainvnm = 0.0e+0
262*
263 kase = 0
264 10 CONTINUE
265 CALL clacn2( n, work( n+1 ), work, ainvnm, kase, isave )
266 IF( kase.NE.0 ) THEN
267 IF( kase.EQ.2 ) THEN
268*
269* Multiply by R.
270*
271 DO i = 1, n
272 work( i ) = work( i ) * rwork( i )
273 END DO
274*
275 IF ( up ) THEN
276 CALL chetrs( 'U', n, 1, af, ldaf, ipiv,
277 \$ work, n, info )
278 ELSE
279 CALL chetrs( 'L', n, 1, af, ldaf, ipiv,
280 \$ work, n, info )
281 ENDIF
282*
283* Multiply by inv(C).
284*
285 IF ( capply ) THEN
286 DO i = 1, n
287 work( i ) = work( i ) * c( i )
288 END DO
289 END IF
290 ELSE
291*
292* Multiply by inv(C**H).
293*
294 IF ( capply ) THEN
295 DO i = 1, n
296 work( i ) = work( i ) * c( i )
297 END DO
298 END IF
299*
300 IF ( up ) THEN
301 CALL chetrs( 'U', n, 1, af, ldaf, ipiv,
302 \$ work, n, info )
303 ELSE
304 CALL chetrs( 'L', n, 1, af, ldaf, ipiv,
305 \$ work, n, info )
306 END IF
307*
308* Multiply by R.
309*
310 DO i = 1, n
311 work( i ) = work( i ) * rwork( i )
312 END DO
313 END IF
314 GO TO 10
315 END IF
316*
317* Compute the estimate of the reciprocal condition number.
318*
319 IF( ainvnm .NE. 0.0e+0 )
320 \$ cla_hercond_c = 1.0e+0 / ainvnm
321*
322 RETURN
323*
324* End of CLA_HERCOND_C
325*
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
subroutine chetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CHETRS
Definition: chetrs.f:120
real function cla_hercond_c(UPLO, N, A, LDA, AF, LDAF, IPIV, C, CAPPLY, INFO, WORK, RWORK)
CLA_HERCOND_C computes the infinity norm condition number of op(A)*inv(diag(c)) for Hermitian indefin...
subroutine clacn2(N, V, X, EST, KASE, ISAVE)
CLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
Definition: clacn2.f:133
Here is the call graph for this function:
Here is the caller graph for this function: