LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cla_hercond_x.f
Go to the documentation of this file.
1*> \brief \b CLA_HERCOND_X computes the infinity norm condition number of op(A)*diag(x) for Hermitian indefinite matrices.
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> Download CLA_HERCOND_X + dependencies
9*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cla_hercond_x.f">
10*> [TGZ]</a>
11*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cla_hercond_x.f">
12*> [ZIP]</a>
13*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cla_hercond_x.f">
14*> [TXT]</a>
15*
16* Definition:
17* ===========
18*
19* REAL FUNCTION CLA_HERCOND_X( UPLO, N, A, LDA, AF, LDAF, IPIV, X,
20* INFO, WORK, RWORK )
21*
22* .. Scalar Arguments ..
23* CHARACTER UPLO
24* INTEGER N, LDA, LDAF, INFO
25* ..
26* .. Array Arguments ..
27* INTEGER IPIV( * )
28* COMPLEX A( LDA, * ), AF( LDAF, * ), WORK( * ), X( * )
29* REAL RWORK( * )
30* ..
31*
32*
33*> \par Purpose:
34* =============
35*>
36*> \verbatim
37*>
38*> CLA_HERCOND_X computes the infinity norm condition number of
39*> op(A) * diag(X) where X is a COMPLEX vector.
40*> \endverbatim
41*
42* Arguments:
43* ==========
44*
45*> \param[in] UPLO
46*> \verbatim
47*> UPLO is CHARACTER*1
48*> = 'U': Upper triangle of A is stored;
49*> = 'L': Lower triangle of A is stored.
50*> \endverbatim
51*>
52*> \param[in] N
53*> \verbatim
54*> N is INTEGER
55*> The number of linear equations, i.e., the order of the
56*> matrix A. N >= 0.
57*> \endverbatim
58*>
59*> \param[in] A
60*> \verbatim
61*> A is COMPLEX array, dimension (LDA,N)
62*> On entry, the N-by-N matrix A.
63*> \endverbatim
64*>
65*> \param[in] LDA
66*> \verbatim
67*> LDA is INTEGER
68*> The leading dimension of the array A. LDA >= max(1,N).
69*> \endverbatim
70*>
71*> \param[in] AF
72*> \verbatim
73*> AF is COMPLEX array, dimension (LDAF,N)
74*> The block diagonal matrix D and the multipliers used to
75*> obtain the factor U or L as computed by CHETRF.
76*> \endverbatim
77*>
78*> \param[in] LDAF
79*> \verbatim
80*> LDAF is INTEGER
81*> The leading dimension of the array AF. LDAF >= max(1,N).
82*> \endverbatim
83*>
84*> \param[in] IPIV
85*> \verbatim
86*> IPIV is INTEGER array, dimension (N)
87*> Details of the interchanges and the block structure of D
88*> as determined by CHETRF.
89*> \endverbatim
90*>
91*> \param[in] X
92*> \verbatim
93*> X is COMPLEX array, dimension (N)
94*> The vector X in the formula op(A) * diag(X).
95*> \endverbatim
96*>
97*> \param[out] INFO
98*> \verbatim
99*> INFO is INTEGER
100*> = 0: Successful exit.
101*> i > 0: The ith argument is invalid.
102*> \endverbatim
103*>
104*> \param[out] WORK
105*> \verbatim
106*> WORK is COMPLEX array, dimension (2*N).
107*> Workspace.
108*> \endverbatim
109*>
110*> \param[out] RWORK
111*> \verbatim
112*> RWORK is REAL array, dimension (N).
113*> Workspace.
114*> \endverbatim
115*
116* Authors:
117* ========
118*
119*> \author Univ. of Tennessee
120*> \author Univ. of California Berkeley
121*> \author Univ. of Colorado Denver
122*> \author NAG Ltd.
123*
124*> \ingroup la_hercond
125*
126* =====================================================================
127 REAL function cla_hercond_x( uplo, n, a, lda, af, ldaf, ipiv,
128 $ x,
129 $ info, work, rwork )
130*
131* -- LAPACK computational routine --
132* -- LAPACK is a software package provided by Univ. of Tennessee, --
133* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
134*
135* .. Scalar Arguments ..
136 CHARACTER uplo
137 INTEGER n, lda, ldaf, info
138* ..
139* .. Array Arguments ..
140 INTEGER ipiv( * )
141 COMPLEX a( lda, * ), af( ldaf, * ), work( * ), x( * )
142 REAL rwork( * )
143* ..
144*
145* =====================================================================
146*
147* .. Local Scalars ..
148 INTEGER kase, i, j
149 REAL ainvnm, anorm, tmp
150 LOGICAL up, upper
151 COMPLEX zdum
152* ..
153* .. Local Arrays ..
154 INTEGER isave( 3 )
155* ..
156* .. External Functions ..
157 LOGICAL lsame
158 EXTERNAL lsame
159* ..
160* .. External Subroutines ..
161 EXTERNAL clacn2, chetrs, xerbla
162* ..
163* .. Intrinsic Functions ..
164 INTRINSIC abs, max
165* ..
166* .. Statement Functions ..
167 REAL cabs1
168* ..
169* .. Statement Function Definitions ..
170 cabs1( zdum ) = abs( real( zdum ) ) + abs( aimag( zdum ) )
171* ..
172* .. Executable Statements ..
173*
174 cla_hercond_x = 0.0e+0
175*
176 info = 0
177 upper = lsame( uplo, 'U' )
178 IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
179 info = -1
180 ELSE IF ( n.LT.0 ) THEN
181 info = -2
182 ELSE IF( lda.LT.max( 1, n ) ) THEN
183 info = -4
184 ELSE IF( ldaf.LT.max( 1, n ) ) THEN
185 info = -6
186 END IF
187 IF( info.NE.0 ) THEN
188 CALL xerbla( 'CLA_HERCOND_X', -info )
189 RETURN
190 END IF
191 up = .false.
192 IF ( lsame( uplo, 'U' ) ) up = .true.
193*
194* Compute norm of op(A)*op2(C).
195*
196 anorm = 0.0
197 IF ( up ) THEN
198 DO i = 1, n
199 tmp = 0.0e+0
200 DO j = 1, i
201 tmp = tmp + cabs1( a( j, i ) * x( j ) )
202 END DO
203 DO j = i+1, n
204 tmp = tmp + cabs1( a( i, j ) * x( j ) )
205 END DO
206 rwork( i ) = tmp
207 anorm = max( anorm, tmp )
208 END DO
209 ELSE
210 DO i = 1, n
211 tmp = 0.0e+0
212 DO j = 1, i
213 tmp = tmp + cabs1( a( i, j ) * x( j ) )
214 END DO
215 DO j = i+1, n
216 tmp = tmp + cabs1( a( j, i ) * x( j ) )
217 END DO
218 rwork( i ) = tmp
219 anorm = max( anorm, tmp )
220 END DO
221 END IF
222*
223* Quick return if possible.
224*
225 IF( n.EQ.0 ) THEN
226 cla_hercond_x = 1.0e+0
227 RETURN
228 ELSE IF( anorm .EQ. 0.0e+0 ) THEN
229 RETURN
230 END IF
231*
232* Estimate the norm of inv(op(A)).
233*
234 ainvnm = 0.0e+0
235*
236 kase = 0
237 10 CONTINUE
238 CALL clacn2( n, work( n+1 ), work, ainvnm, kase, isave )
239 IF( kase.NE.0 ) THEN
240 IF( kase.EQ.2 ) THEN
241*
242* Multiply by R.
243*
244 DO i = 1, n
245 work( i ) = work( i ) * rwork( i )
246 END DO
247*
248 IF ( up ) THEN
249 CALL chetrs( 'U', n, 1, af, ldaf, ipiv,
250 $ work, n, info )
251 ELSE
252 CALL chetrs( 'L', n, 1, af, ldaf, ipiv,
253 $ work, n, info )
254 ENDIF
255*
256* Multiply by inv(X).
257*
258 DO i = 1, n
259 work( i ) = work( i ) / x( i )
260 END DO
261 ELSE
262*
263* Multiply by inv(X**H).
264*
265 DO i = 1, n
266 work( i ) = work( i ) / x( i )
267 END DO
268*
269 IF ( up ) THEN
270 CALL chetrs( 'U', n, 1, af, ldaf, ipiv,
271 $ work, n, info )
272 ELSE
273 CALL chetrs( 'L', n, 1, af, ldaf, ipiv,
274 $ work, n, info )
275 END IF
276*
277* Multiply by R.
278*
279 DO i = 1, n
280 work( i ) = work( i ) * rwork( i )
281 END DO
282 END IF
283 GO TO 10
284 END IF
285*
286* Compute the estimate of the reciprocal condition number.
287*
288 IF( ainvnm .NE. 0.0e+0 )
289 $ cla_hercond_x = 1.0e+0 / ainvnm
290*
291 RETURN
292*
293* End of CLA_HERCOND_X
294*
295 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine chetrs(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
CHETRS
Definition chetrs.f:118
real function cla_hercond_x(uplo, n, a, lda, af, ldaf, ipiv, x, info, work, rwork)
CLA_HERCOND_X computes the infinity norm condition number of op(A)*diag(x) for Hermitian indefinite m...
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:131
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48