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