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