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