LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cpocon.f
Go to the documentation of this file.
1*> \brief \b CPOCON
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CPOCON + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/cpocon.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/cpocon.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/cpocon.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE CPOCON( UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK,
22* INFO )
23*
24* .. Scalar Arguments ..
25* CHARACTER UPLO
26* INTEGER INFO, LDA, N
27* REAL ANORM, RCOND
28* ..
29* .. Array Arguments ..
30* REAL RWORK( * )
31* COMPLEX A( LDA, * ), WORK( * )
32* ..
33*
34*
35*> \par Purpose:
36* =============
37*>
38*> \verbatim
39*>
40*> CPOCON estimates the reciprocal of the condition number (in the
41*> 1-norm) of a complex Hermitian positive definite matrix using the
42*> Cholesky factorization A = U**H*U or A = L*L**H computed by CPOTRF.
43*>
44*> An estimate is obtained for norm(inv(A)), and the reciprocal of the
45*> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
46*> \endverbatim
47*
48* Arguments:
49* ==========
50*
51*> \param[in] UPLO
52*> \verbatim
53*> UPLO is CHARACTER*1
54*> = 'U': Upper triangle of A is stored;
55*> = 'L': Lower triangle of A is stored.
56*> \endverbatim
57*>
58*> \param[in] N
59*> \verbatim
60*> N is INTEGER
61*> The order of the matrix A. N >= 0.
62*> \endverbatim
63*>
64*> \param[in] A
65*> \verbatim
66*> A is COMPLEX array, dimension (LDA,N)
67*> The triangular factor U or L from the Cholesky factorization
68*> A = U**H*U or A = L*L**H, as computed by CPOTRF.
69*> \endverbatim
70*>
71*> \param[in] LDA
72*> \verbatim
73*> LDA is INTEGER
74*> The leading dimension of the array A. LDA >= max(1,N).
75*> \endverbatim
76*>
77*> \param[in] ANORM
78*> \verbatim
79*> ANORM is REAL
80*> The 1-norm (or infinity-norm) of the Hermitian matrix A.
81*> \endverbatim
82*>
83*> \param[out] RCOND
84*> \verbatim
85*> RCOND is REAL
86*> The reciprocal of the condition number of the matrix A,
87*> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
88*> estimate of the 1-norm of inv(A) computed in this routine.
89*> \endverbatim
90*>
91*> \param[out] WORK
92*> \verbatim
93*> WORK is COMPLEX array, dimension (2*N)
94*> \endverbatim
95*>
96*> \param[out] RWORK
97*> \verbatim
98*> RWORK is REAL array, dimension (N)
99*> \endverbatim
100*>
101*> \param[out] INFO
102*> \verbatim
103*> INFO is INTEGER
104*> = 0: successful exit
105*> < 0: if INFO = -i, the i-th argument had an illegal value
106*> \endverbatim
107*
108* Authors:
109* ========
110*
111*> \author Univ. of Tennessee
112*> \author Univ. of California Berkeley
113*> \author Univ. of Colorado Denver
114*> \author NAG Ltd.
115*
116*> \ingroup pocon
117*
118* =====================================================================
119 SUBROUTINE cpocon( UPLO, N, A, LDA, ANORM, RCOND, WORK, RWORK,
120 $ INFO )
121*
122* -- LAPACK computational routine --
123* -- LAPACK is a software package provided by Univ. of Tennessee, --
124* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
125*
126* .. Scalar Arguments ..
127 CHARACTER UPLO
128 INTEGER INFO, LDA, N
129 REAL ANORM, RCOND
130* ..
131* .. Array Arguments ..
132 REAL RWORK( * )
133 COMPLEX A( LDA, * ), WORK( * )
134* ..
135*
136* =====================================================================
137*
138* .. Parameters ..
139 REAL ONE, ZERO
140 parameter( one = 1.0e+0, zero = 0.0e+0 )
141* ..
142* .. Local Scalars ..
143 LOGICAL UPPER
144 CHARACTER NORMIN
145 INTEGER IX, KASE
146 REAL AINVNM, SCALE, SCALEL, SCALEU, SMLNUM
147 COMPLEX ZDUM
148* ..
149* .. Local Arrays ..
150 INTEGER ISAVE( 3 )
151* ..
152* .. External Functions ..
153 LOGICAL LSAME
154 INTEGER ICAMAX
155 REAL SLAMCH
156 EXTERNAL lsame, icamax, slamch
157* ..
158* .. External Subroutines ..
159 EXTERNAL clacn2, clatrs, csrscl, xerbla
160* ..
161* .. Intrinsic Functions ..
162 INTRINSIC abs, aimag, max, real
163* ..
164* .. Statement Functions ..
165 REAL CABS1
166* ..
167* .. Statement Function definitions ..
168 cabs1( zdum ) = abs( real( zdum ) ) + abs( aimag( zdum ) )
169* ..
170* .. Executable Statements ..
171*
172* Test the input parameters.
173*
174 info = 0
175 upper = lsame( uplo, 'U' )
176 IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
177 info = -1
178 ELSE IF( n.LT.0 ) THEN
179 info = -2
180 ELSE IF( lda.LT.max( 1, n ) ) THEN
181 info = -4
182 ELSE IF( anorm.LT.zero ) THEN
183 info = -5
184 END IF
185 IF( info.NE.0 ) THEN
186 CALL xerbla( 'CPOCON', -info )
187 RETURN
188 END IF
189*
190* Quick return if possible
191*
192 rcond = zero
193 IF( n.EQ.0 ) THEN
194 rcond = one
195 RETURN
196 ELSE IF( anorm.EQ.zero ) THEN
197 RETURN
198 END IF
199*
200 smlnum = slamch( 'Safe minimum' )
201*
202* Estimate the 1-norm of inv(A).
203*
204 kase = 0
205 normin = 'N'
206 10 CONTINUE
207 CALL clacn2( n, work( n+1 ), work, ainvnm, kase, isave )
208 IF( kase.NE.0 ) THEN
209 IF( upper ) THEN
210*
211* Multiply by inv(U**H).
212*
213 CALL clatrs( 'Upper', 'Conjugate transpose', 'Non-unit',
214 $ normin, n, a, lda, work, scalel, rwork, info )
215 normin = 'Y'
216*
217* Multiply by inv(U).
218*
219 CALL clatrs( 'Upper', 'No transpose', 'Non-unit', normin, n,
220 $ a, lda, work, scaleu, rwork, info )
221 ELSE
222*
223* Multiply by inv(L).
224*
225 CALL clatrs( 'Lower', 'No transpose', 'Non-unit', normin, n,
226 $ a, lda, work, scalel, rwork, info )
227 normin = 'Y'
228*
229* Multiply by inv(L**H).
230*
231 CALL clatrs( 'Lower', 'Conjugate transpose', 'Non-unit',
232 $ normin, n, a, lda, work, scaleu, rwork, info )
233 END IF
234*
235* Multiply by 1/SCALE if doing so will not cause overflow.
236*
237 scale = scalel*scaleu
238 IF( scale.NE.one ) THEN
239 ix = icamax( n, work, 1 )
240 IF( scale.LT.cabs1( work( ix ) )*smlnum .OR. scale.EQ.zero )
241 $ GO TO 20
242 CALL csrscl( n, scale, work, 1 )
243 END IF
244 GO TO 10
245 END IF
246*
247* Compute the estimate of the reciprocal condition number.
248*
249 IF( ainvnm.NE.zero )
250 $ rcond = ( one / ainvnm ) / anorm
251*
252 20 CONTINUE
253 RETURN
254*
255* End of CPOCON
256*
257 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
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
subroutine clatrs(uplo, trans, diag, normin, n, a, lda, x, scale, cnorm, info)
CLATRS solves a triangular system of equations with the scale factor set to prevent overflow.
Definition clatrs.f:239
subroutine cpocon(uplo, n, a, lda, anorm, rcond, work, rwork, info)
CPOCON
Definition cpocon.f:121
subroutine csrscl(n, sa, sx, incx)
CSRSCL multiplies a vector by the reciprocal of a real scalar.
Definition csrscl.f:84