LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
zla_gercond_x.f
Go to the documentation of this file.
1 *> \brief \b ZLA_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
9 *> Download ZLA_GERCOND_X + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zla_gercond_x.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zla_gercond_x.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zla_gercond_x.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * DOUBLE PRECISION FUNCTION ZLA_GERCOND_X( TRANS, N, A, LDA, AF,
22 * LDAF, IPIV, X, INFO,
23 * WORK, RWORK )
24 *
25 * .. Scalar Arguments ..
26 * CHARACTER TRANS
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_GERCOND_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] 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*16 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*16 array, dimension (LDAF,N)
79 *> The factors L and U from the factorization
80 *> A = P*L*U as computed by ZGETRF.
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 ZGETRF; 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*16 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[in] WORK
111 *> \verbatim
112 *> WORK is COMPLEX*16 array, dimension (2*N).
113 *> Workspace.
114 *> \endverbatim
115 *>
116 *> \param[in] RWORK
117 *> \verbatim
118 *> RWORK is DOUBLE PRECISION 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 *> \date September 2012
131 *
132 *> \ingroup complex16GEcomputational
133 *
134 * =====================================================================
135  DOUBLE PRECISION FUNCTION zla_gercond_x( TRANS, N, A, LDA, AF,
136  $ ldaf, ipiv, x, info,
137  $ work, rwork )
138 *
139 * -- LAPACK computational routine (version 3.4.2) --
140 * -- LAPACK is a software package provided by Univ. of Tennessee, --
141 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
142 * September 2012
143 *
144 * .. Scalar Arguments ..
145  CHARACTER trans
146  INTEGER n, lda, ldaf, info
147 * ..
148 * .. Array Arguments ..
149  INTEGER ipiv( * )
150  COMPLEX*16 a( lda, * ), af( ldaf, * ), work( * ), x( * )
151  DOUBLE PRECISION rwork( * )
152 * ..
153 *
154 * =====================================================================
155 *
156 * .. Local Scalars ..
157  LOGICAL notrans
158  INTEGER kase
159  DOUBLE PRECISION ainvnm, anorm, tmp
160  INTEGER i, j
161  COMPLEX*16 zdum
162 * ..
163 * .. Local Arrays ..
164  INTEGER isave( 3 )
165 * ..
166 * .. External Functions ..
167  LOGICAL lsame
168  EXTERNAL lsame
169 * ..
170 * .. External Subroutines ..
171  EXTERNAL zlacn2, zgetrs, xerbla
172 * ..
173 * .. Intrinsic Functions ..
174  INTRINSIC abs, max, REAL, dimag
175 * ..
176 * .. Statement Functions ..
177  DOUBLE PRECISION cabs1
178 * ..
179 * .. Statement Function Definitions ..
180  cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
181 * ..
182 * .. Executable Statements ..
183 *
184  zla_gercond_x = 0.0d+0
185 *
186  info = 0
187  notrans = lsame( trans, 'N' )
188  IF ( .NOT. notrans .AND. .NOT. lsame( trans, 'T' ) .AND. .NOT.
189  $ lsame( trans, 'C' ) ) THEN
190  info = -1
191  ELSE IF( n.LT.0 ) THEN
192  info = -2
193  ELSE IF( lda.LT.max( 1, n ) ) THEN
194  info = -4
195  ELSE IF( ldaf.LT.max( 1, n ) ) THEN
196  info = -6
197  END IF
198  IF( info.NE.0 ) THEN
199  CALL xerbla( 'ZLA_GERCOND_X', -info )
200  RETURN
201  END IF
202 *
203 * Compute norm of op(A)*op2(C).
204 *
205  anorm = 0.0d+0
206  IF ( notrans ) THEN
207  DO i = 1, n
208  tmp = 0.0d+0
209  DO j = 1, n
210  tmp = tmp + cabs1( a( i, j ) * x( j ) )
211  END DO
212  rwork( i ) = tmp
213  anorm = max( anorm, tmp )
214  END DO
215  ELSE
216  DO i = 1, n
217  tmp = 0.0d+0
218  DO j = 1, n
219  tmp = tmp + cabs1( a( j, i ) * x( j ) )
220  END DO
221  rwork( i ) = tmp
222  anorm = max( anorm, tmp )
223  END DO
224  END IF
225 *
226 * Quick return if possible.
227 *
228  IF( n.EQ.0 ) THEN
229  zla_gercond_x = 1.0d+0
230  RETURN
231  ELSE IF( anorm .EQ. 0.0d+0 ) THEN
232  RETURN
233  END IF
234 *
235 * Estimate the norm of inv(op(A)).
236 *
237  ainvnm = 0.0d+0
238 *
239  kase = 0
240  10 CONTINUE
241  CALL zlacn2( n, work( n+1 ), work, ainvnm, kase, isave )
242  IF( kase.NE.0 ) THEN
243  IF( kase.EQ.2 ) THEN
244 * Multiply by R.
245  DO i = 1, n
246  work( i ) = work( i ) * rwork( i )
247  END DO
248 *
249  IF ( notrans ) THEN
250  CALL zgetrs( 'No transpose', n, 1, af, ldaf, ipiv,
251  $ work, n, info )
252  ELSE
253  CALL zgetrs( 'Conjugate transpose', n, 1, af, ldaf, ipiv,
254  $ work, n, info )
255  ENDIF
256 *
257 * Multiply by inv(X).
258 *
259  DO i = 1, n
260  work( i ) = work( i ) / x( i )
261  END DO
262  ELSE
263 *
264 * Multiply by inv(X**H).
265 *
266  DO i = 1, n
267  work( i ) = work( i ) / x( i )
268  END DO
269 *
270  IF ( notrans ) THEN
271  CALL zgetrs( 'Conjugate transpose', n, 1, af, ldaf, ipiv,
272  $ work, n, info )
273  ELSE
274  CALL zgetrs( 'No transpose', n, 1, af, ldaf, ipiv,
275  $ work, n, info )
276  END IF
277 *
278 * Multiply by R.
279 *
280  DO i = 1, n
281  work( i ) = work( i ) * rwork( i )
282  END DO
283  END IF
284  go to 10
285  END IF
286 *
287 * Compute the estimate of the reciprocal condition number.
288 *
289  IF( ainvnm .NE. 0.0d+0 )
290  $ zla_gercond_x = 1.0d+0 / ainvnm
291 *
292  RETURN
293 *
294  END