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
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dppcon.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack