LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
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[in] WORK
100 *> \verbatim
101 *> WORK is COMPLEX*16 array, dimension (2*N).
102 *> Workspace.
103 *> \endverbatim
104 *>
105 *> \param[in] 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 *> \date September 2012
120 *
121 *> \ingroup complex16POcomputational
122 *
123 * =====================================================================
124  DOUBLE PRECISION FUNCTION zla_porcond_x( UPLO, N, A, LDA, AF,
125  $ ldaf, x, info, work,
126  $ rwork )
127 *
128 * -- LAPACK computational routine (version 3.4.2) --
129 * -- LAPACK is a software package provided by Univ. of Tennessee, --
130 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
131 * September 2012
132 *
133 * .. Scalar Arguments ..
134  CHARACTER uplo
135  INTEGER n, lda, ldaf, info
136 * ..
137 * .. Array Arguments ..
138  COMPLEX*16 a( lda, * ), af( ldaf, * ), work( * ), x( * )
139  DOUBLE PRECISION rwork( * )
140 * ..
141 *
142 * =====================================================================
143 *
144 * .. Local Scalars ..
145  INTEGER kase, i, j
146  DOUBLE PRECISION ainvnm, anorm, tmp
147  LOGICAL up, upper
148  COMPLEX*16 zdum
149 * ..
150 * .. Local Arrays ..
151  INTEGER isave( 3 )
152 * ..
153 * .. External Functions ..
154  LOGICAL lsame
155  EXTERNAL lsame
156 * ..
157 * .. External Subroutines ..
158  EXTERNAL zlacn2, zpotrs, xerbla
159 * ..
160 * .. Intrinsic Functions ..
161  INTRINSIC abs, max, REAL, dimag
162 * ..
163 * .. Statement Functions ..
164  DOUBLE PRECISION cabs1
165 * ..
166 * .. Statement Function Definitions ..
167  cabs1( zdum ) = abs( dble( zdum ) ) + abs( dimag( zdum ) )
168 * ..
169 * .. Executable Statements ..
170 *
171  zla_porcond_x = 0.0d+0
172 *
173  info = 0
174  upper = lsame( uplo, 'U' )
175  IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
176  info = -1
177  ELSE IF ( n.LT.0 ) THEN
178  info = -2
179  ELSE IF( lda.LT.max( 1, n ) ) THEN
180  info = -4
181  ELSE IF( ldaf.LT.max( 1, n ) ) THEN
182  info = -6
183  END IF
184  IF( info.NE.0 ) THEN
185  CALL xerbla( 'ZLA_PORCOND_X', -info )
186  RETURN
187  END IF
188  up = .false.
189  IF ( lsame( uplo, 'U' ) ) up = .true.
190 *
191 * Compute norm of op(A)*op2(C).
192 *
193  anorm = 0.0d+0
194  IF ( up ) THEN
195  DO i = 1, n
196  tmp = 0.0d+0
197  DO j = 1, i
198  tmp = tmp + cabs1( a( j, i ) * x( j ) )
199  END DO
200  DO j = i+1, n
201  tmp = tmp + cabs1( a( i, j ) * x( j ) )
202  END DO
203  rwork( i ) = tmp
204  anorm = max( anorm, tmp )
205  END DO
206  ELSE
207  DO i = 1, n
208  tmp = 0.0d+0
209  DO j = 1, i
210  tmp = tmp + cabs1( a( i, j ) * x( j ) )
211  END DO
212  DO j = i+1, n
213  tmp = tmp + cabs1( a( j, i ) * x( j ) )
214  END DO
215  rwork( i ) = tmp
216  anorm = max( anorm, tmp )
217  END DO
218  END IF
219 *
220 * Quick return if possible.
221 *
222  IF( n.EQ.0 ) THEN
223  zla_porcond_x = 1.0d+0
224  RETURN
225  ELSE IF( anorm .EQ. 0.0d+0 ) THEN
226  RETURN
227  END IF
228 *
229 * Estimate the norm of inv(op(A)).
230 *
231  ainvnm = 0.0d+0
232 *
233  kase = 0
234  10 CONTINUE
235  CALL zlacn2( n, work( n+1 ), work, ainvnm, kase, isave )
236  IF( kase.NE.0 ) THEN
237  IF( kase.EQ.2 ) THEN
238 *
239 * Multiply by R.
240 *
241  DO i = 1, n
242  work( i ) = work( i ) * rwork( i )
243  END DO
244 *
245  IF ( up ) THEN
246  CALL zpotrs( 'U', n, 1, af, ldaf,
247  $ work, n, info )
248  ELSE
249  CALL zpotrs( 'L', n, 1, af, ldaf,
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 ( up ) THEN
267  CALL zpotrs( 'U', n, 1, af, ldaf,
268  $ work, n, info )
269  ELSE
270  CALL zpotrs( 'L', n, 1, af, ldaf,
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.0d+0 )
286  $ zla_porcond_x = 1.0d+0 / ainvnm
287 *
288  RETURN
289 *
290  END