1: *> \brief \b DDISNA
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: *> \htmlonly
9: *> Download DDISNA + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ddisna.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ddisna.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ddisna.f">
15: *> [TXT]</a>
16: *> \endhtmlonly
17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE DDISNA( JOB, M, N, D, SEP, INFO )
22: *
23: * .. Scalar Arguments ..
24: * CHARACTER JOB
25: * INTEGER INFO, M, N
26: * ..
27: * .. Array Arguments ..
28: * DOUBLE PRECISION D( * ), SEP( * )
29: * ..
30: *
31: *
32: *> \par Purpose:
33: * =============
34: *>
35: *> \verbatim
36: *>
37: *> DDISNA computes the reciprocal condition numbers for the eigenvectors
38: *> of a real symmetric or complex Hermitian matrix or for the left or
39: *> right singular vectors of a general m-by-n matrix. The reciprocal
40: *> condition number is the 'gap' between the corresponding eigenvalue or
41: *> singular value and the nearest other one.
42: *>
43: *> The bound on the error, measured by angle in radians, in the I-th
44: *> computed vector is given by
45: *>
46: *> DLAMCH( 'E' ) * ( ANORM / SEP( I ) )
47: *>
48: *> where ANORM = 2-norm(A) = max( abs( D(j) ) ). SEP(I) is not allowed
49: *> to be smaller than DLAMCH( 'E' )*ANORM in order to limit the size of
50: *> the error bound.
51: *>
52: *> DDISNA may also be used to compute error bounds for eigenvectors of
53: *> the generalized symmetric definite eigenproblem.
54: *> \endverbatim
55: *
56: * Arguments:
57: * ==========
58: *
59: *> \param[in] JOB
60: *> \verbatim
61: *> JOB is CHARACTER*1
62: *> Specifies for which problem the reciprocal condition numbers
63: *> should be computed:
64: *> = 'E': the eigenvectors of a symmetric/Hermitian matrix;
65: *> = 'L': the left singular vectors of a general matrix;
66: *> = 'R': the right singular vectors of a general matrix.
67: *> \endverbatim
68: *>
69: *> \param[in] M
70: *> \verbatim
71: *> M is INTEGER
72: *> The number of rows of the matrix. M >= 0.
73: *> \endverbatim
74: *>
75: *> \param[in] N
76: *> \verbatim
77: *> N is INTEGER
78: *> If JOB = 'L' or 'R', the number of columns of the matrix,
79: *> in which case N >= 0. Ignored if JOB = 'E'.
80: *> \endverbatim
81: *>
82: *> \param[in] D
83: *> \verbatim
84: *> D is DOUBLE PRECISION array, dimension (M) if JOB = 'E'
85: *> dimension (min(M,N)) if JOB = 'L' or 'R'
86: *> The eigenvalues (if JOB = 'E') or singular values (if JOB =
87: *> 'L' or 'R') of the matrix, in either increasing or decreasing
88: *> order. If singular values, they must be non-negative.
89: *> \endverbatim
90: *>
91: *> \param[out] SEP
92: *> \verbatim
93: *> SEP is DOUBLE PRECISION array, dimension (M) if JOB = 'E'
94: *> dimension (min(M,N)) if JOB = 'L' or 'R'
95: *> The reciprocal condition numbers of the vectors.
96: *> \endverbatim
97: *>
98: *> \param[out] INFO
99: *> \verbatim
100: *> INFO is INTEGER
101: *> = 0: successful exit.
102: *> < 0: if INFO = -i, the i-th argument had an illegal value.
103: *> \endverbatim
104: *
105: * Authors:
106: * ========
107: *
108: *> \author Univ. of Tennessee
109: *> \author Univ. of California Berkeley
110: *> \author Univ. of Colorado Denver
111: *> \author NAG Ltd.
112: *
113: *> \ingroup auxOTHERcomputational
114: *
115: * =====================================================================
116: SUBROUTINE DDISNA( JOB, M, N, D, SEP, INFO )
117: *
118: * -- LAPACK computational routine --
119: * -- LAPACK is a software package provided by Univ. of Tennessee, --
120: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
121: *
122: * .. Scalar Arguments ..
123: CHARACTER JOB
124: INTEGER INFO, M, N
125: * ..
126: * .. Array Arguments ..
127: DOUBLE PRECISION D( * ), SEP( * )
128: * ..
129: *
130: * =====================================================================
131: *
132: * .. Parameters ..
133: DOUBLE PRECISION ZERO
134: PARAMETER ( ZERO = 0.0D+0 )
135: * ..
136: * .. Local Scalars ..
137: LOGICAL DECR, EIGEN, INCR, LEFT, RIGHT, SING
138: INTEGER I, K
139: DOUBLE PRECISION ANORM, EPS, NEWGAP, OLDGAP, SAFMIN, THRESH
140: * ..
141: * .. External Functions ..
142: LOGICAL LSAME
143: DOUBLE PRECISION DLAMCH
144: EXTERNAL LSAME, DLAMCH
145: * ..
146: * .. Intrinsic Functions ..
147: INTRINSIC ABS, MAX, MIN
148: * ..
149: * .. External Subroutines ..
150: EXTERNAL XERBLA
151: * ..
152: * .. Executable Statements ..
153: *
154: * Test the input arguments
155: *
156: INFO = 0
157: EIGEN = LSAME( JOB, 'E' )
158: LEFT = LSAME( JOB, 'L' )
159: RIGHT = LSAME( JOB, 'R' )
160: SING = LEFT .OR. RIGHT
161: IF( EIGEN ) THEN
162: K = M
163: ELSE IF( SING ) THEN
164: K = MIN( M, N )
165: END IF
166: IF( .NOT.EIGEN .AND. .NOT.SING ) THEN
167: INFO = -1
168: ELSE IF( M.LT.0 ) THEN
169: INFO = -2
170: ELSE IF( K.LT.0 ) THEN
171: INFO = -3
172: ELSE
173: INCR = .TRUE.
174: DECR = .TRUE.
175: DO 10 I = 1, K - 1
176: IF( INCR )
177: $ INCR = INCR .AND. D( I ).LE.D( I+1 )
178: IF( DECR )
179: $ DECR = DECR .AND. D( I ).GE.D( I+1 )
180: 10 CONTINUE
181: IF( SING .AND. K.GT.0 ) THEN
182: IF( INCR )
183: $ INCR = INCR .AND. ZERO.LE.D( 1 )
184: IF( DECR )
185: $ DECR = DECR .AND. D( K ).GE.ZERO
186: END IF
187: IF( .NOT.( INCR .OR. DECR ) )
188: $ INFO = -4
189: END IF
190: IF( INFO.NE.0 ) THEN
191: CALL XERBLA( 'DDISNA', -INFO )
192: RETURN
193: END IF
194: *
195: * Quick return if possible
196: *
197: IF( K.EQ.0 )
198: $ RETURN
199: *
200: * Compute reciprocal condition numbers
201: *
202: IF( K.EQ.1 ) THEN
203: SEP( 1 ) = DLAMCH( 'O' )
204: ELSE
205: OLDGAP = ABS( D( 2 )-D( 1 ) )
206: SEP( 1 ) = OLDGAP
207: DO 20 I = 2, K - 1
208: NEWGAP = ABS( D( I+1 )-D( I ) )
209: SEP( I ) = MIN( OLDGAP, NEWGAP )
210: OLDGAP = NEWGAP
211: 20 CONTINUE
212: SEP( K ) = OLDGAP
213: END IF
214: IF( SING ) THEN
215: IF( ( LEFT .AND. M.GT.N ) .OR. ( RIGHT .AND. M.LT.N ) ) THEN
216: IF( INCR )
217: $ SEP( 1 ) = MIN( SEP( 1 ), D( 1 ) )
218: IF( DECR )
219: $ SEP( K ) = MIN( SEP( K ), D( K ) )
220: END IF
221: END IF
222: *
223: * Ensure that reciprocal condition numbers are not less than
224: * threshold, in order to limit the size of the error bound
225: *
226: EPS = DLAMCH( 'E' )
227: SAFMIN = DLAMCH( 'S' )
228: ANORM = MAX( ABS( D( 1 ) ), ABS( D( K ) ) )
229: IF( ANORM.EQ.ZERO ) THEN
230: THRESH = EPS
231: ELSE
232: THRESH = MAX( EPS*ANORM, SAFMIN )
233: END IF
234: DO 30 I = 1, K
235: SEP( I ) = MAX( SEP( I ), THRESH )
236: 30 CONTINUE
237: *
238: RETURN
239: *
240: * End of DDISNA
241: *
242: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to ddisna.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack