LAPACK  3.10.1 LAPACK: Linear Algebra PACKage
ddisna.f
Go to the documentation of this file.
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
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
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine ddisna(JOB, M, N, D, SEP, INFO)
DDISNA
Definition: ddisna.f:117