LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
dppcon.f
Go to the documentation of this file.
1*> \brief \b DPPCON
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download DPPCON + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dppcon.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dppcon.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dppcon.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE DPPCON( UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO )
22*
23* .. Scalar Arguments ..
24* CHARACTER UPLO
25* INTEGER INFO, N
26* DOUBLE PRECISION ANORM, RCOND
27* ..
28* .. Array Arguments ..
29* INTEGER IWORK( * )
30* DOUBLE PRECISION AP( * ), WORK( * )
31* ..
32*
33*
34*> \par Purpose:
35* =============
36*>
37*> \verbatim
38*>
39*> DPPCON estimates the reciprocal of the condition number (in the
40*> 1-norm) of a real symmetric positive definite packed matrix using
41*> the Cholesky factorization A = U**T*U or A = L*L**T computed by
42*> DPPTRF.
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] AP
65*> \verbatim
66*> AP is DOUBLE PRECISION array, dimension (N*(N+1)/2)
67*> The triangular factor U or L from the Cholesky factorization
68*> A = U**T*U or A = L*L**T, packed columnwise in a linear
69*> array. The j-th column of U or L is stored in the array AP
70*> as follows:
71*> if UPLO = 'U', AP(i + (j-1)*j/2) = U(i,j) for 1<=i<=j;
72*> if UPLO = 'L', AP(i + (j-1)*(2n-j)/2) = L(i,j) for j<=i<=n.
73*> \endverbatim
74*>
75*> \param[in] ANORM
76*> \verbatim
77*> ANORM is DOUBLE PRECISION
78*> The 1-norm (or infinity-norm) of the symmetric matrix A.
79*> \endverbatim
80*>
81*> \param[out] RCOND
82*> \verbatim
83*> RCOND is DOUBLE PRECISION
84*> The reciprocal of the condition number of the matrix A,
85*> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
86*> estimate of the 1-norm of inv(A) computed in this routine.
87*> \endverbatim
88*>
89*> \param[out] WORK
90*> \verbatim
91*> WORK is DOUBLE PRECISION array, dimension (3*N)
92*> \endverbatim
93*>
94*> \param[out] IWORK
95*> \verbatim
96*> IWORK is INTEGER array, dimension (N)
97*> \endverbatim
98*>
99*> \param[out] INFO
100*> \verbatim
101*> INFO is INTEGER
102*> = 0: successful exit
103*> < 0: if INFO = -i, the i-th argument had an illegal value
104*> \endverbatim
105*
106* Authors:
107* ========
108*
109*> \author Univ. of Tennessee
110*> \author Univ. of California Berkeley
111*> \author Univ. of Colorado Denver
112*> \author NAG Ltd.
113*
114*> \ingroup doubleOTHERcomputational
115*
116* =====================================================================
117 SUBROUTINE dppcon( UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO )
118*
119* -- LAPACK computational routine --
120* -- LAPACK is a software package provided by Univ. of Tennessee, --
121* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
122*
123* .. Scalar Arguments ..
124 CHARACTER UPLO
125 INTEGER INFO, N
126 DOUBLE PRECISION ANORM, RCOND
127* ..
128* .. Array Arguments ..
129 INTEGER IWORK( * )
130 DOUBLE PRECISION AP( * ), WORK( * )
131* ..
132*
133* =====================================================================
134*
135* .. Parameters ..
136 DOUBLE PRECISION ONE, ZERO
137 parameter( one = 1.0d+0, zero = 0.0d+0 )
138* ..
139* .. Local Scalars ..
140 LOGICAL UPPER
141 CHARACTER NORMIN
142 INTEGER IX, KASE
143 DOUBLE PRECISION AINVNM, SCALE, SCALEL, SCALEU, SMLNUM
144* ..
145* .. Local Arrays ..
146 INTEGER ISAVE( 3 )
147* ..
148* .. External Functions ..
149 LOGICAL LSAME
150 INTEGER IDAMAX
151 DOUBLE PRECISION DLAMCH
152 EXTERNAL lsame, idamax, dlamch
153* ..
154* .. External Subroutines ..
155 EXTERNAL dlacn2, dlatps, drscl, xerbla
156* ..
157* .. Intrinsic Functions ..
158 INTRINSIC abs
159* ..
160* .. Executable Statements ..
161*
162* Test the input parameters.
163*
164 info = 0
165 upper = lsame( uplo, 'U' )
166 IF( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
167 info = -1
168 ELSE IF( n.LT.0 ) THEN
169 info = -2
170 ELSE IF( anorm.LT.zero ) THEN
171 info = -4
172 END IF
173 IF( info.NE.0 ) THEN
174 CALL xerbla( 'DPPCON', -info )
175 RETURN
176 END IF
177*
178* Quick return if possible
179*
180 rcond = zero
181 IF( n.EQ.0 ) THEN
182 rcond = one
183 RETURN
184 ELSE IF( anorm.EQ.zero ) THEN
185 RETURN
186 END IF
187*
188 smlnum = dlamch( 'Safe minimum' )
189*
190* Estimate the 1-norm of the inverse.
191*
192 kase = 0
193 normin = 'N'
194 10 CONTINUE
195 CALL dlacn2( n, work( n+1 ), work, iwork, ainvnm, kase, isave )
196 IF( kase.NE.0 ) THEN
197 IF( upper ) THEN
198*
199* Multiply by inv(U**T).
200*
201 CALL dlatps( 'Upper', 'Transpose', 'Non-unit', normin, n,
202 $ ap, work, scalel, work( 2*n+1 ), info )
203 normin = 'Y'
204*
205* Multiply by inv(U).
206*
207 CALL dlatps( 'Upper', 'No transpose', 'Non-unit', normin, n,
208 $ ap, work, scaleu, work( 2*n+1 ), info )
209 ELSE
210*
211* Multiply by inv(L).
212*
213 CALL dlatps( 'Lower', 'No transpose', 'Non-unit', normin, n,
214 $ ap, work, scalel, work( 2*n+1 ), info )
215 normin = 'Y'
216*
217* Multiply by inv(L**T).
218*
219 CALL dlatps( 'Lower', 'Transpose', 'Non-unit', normin, n,
220 $ ap, work, scaleu, work( 2*n+1 ), info )
221 END IF
222*
223* Multiply by 1/SCALE if doing so will not cause overflow.
224*
225 scale = scalel*scaleu
226 IF( scale.NE.one ) THEN
227 ix = idamax( n, work, 1 )
228 IF( scale.LT.abs( work( ix ) )*smlnum .OR. scale.EQ.zero )
229 $ GO TO 20
230 CALL drscl( n, scale, work, 1 )
231 END IF
232 GO TO 10
233 END IF
234*
235* Compute the estimate of the reciprocal condition number.
236*
237 IF( ainvnm.NE.zero )
238 $ rcond = ( one / ainvnm ) / anorm
239*
240 20 CONTINUE
241 RETURN
242*
243* End of DPPCON
244*
245 END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine drscl(N, SA, SX, INCX)
DRSCL multiplies a vector by the reciprocal of a real scalar.
Definition: drscl.f:84
subroutine dlatps(UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE, CNORM, INFO)
DLATPS solves a triangular system of equations with the matrix held in packed storage.
Definition: dlatps.f:229
subroutine dlacn2(N, V, X, ISGN, EST, KASE, ISAVE)
DLACN2 estimates the 1-norm of a square matrix, using reverse communication for evaluating matrix-vec...
Definition: dlacn2.f:136
subroutine dppcon(UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO)
DPPCON
Definition: dppcon.f:118