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