LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
sdisna.f
Go to the documentation of this file.
1 *> \brief \b SDISNA
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download SDISNA + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sdisna.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sdisna.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sdisna.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE SDISNA( JOB, M, N, D, SEP, INFO )
22 *
23 * .. Scalar Arguments ..
24 * CHARACTER JOB
25 * INTEGER INFO, M, N
26 * ..
27 * .. Array Arguments ..
28 * REAL D( * ), SEP( * )
29 * ..
30 *
31 *
32 *> \par Purpose:
33 * =============
34 *>
35 *> \verbatim
36 *>
37 *> SDISNA 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 *> SLAMCH( '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 SLAMCH( 'E' )*ANORM in order to limit the size of
50 *> the error bound.
51 *>
52 *> SDISNA 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 REAL 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 REAL 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 sdisna( 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  REAL D( * ), SEP( * )
128 * ..
129 *
130 * =====================================================================
131 *
132 * .. Parameters ..
133  REAL ZERO
134  parameter( zero = 0.0e+0 )
135 * ..
136 * .. Local Scalars ..
137  LOGICAL DECR, EIGEN, INCR, LEFT, RIGHT, SING
138  INTEGER I, K
139  REAL ANORM, EPS, NEWGAP, OLDGAP, SAFMIN, THRESH
140 * ..
141 * .. External Functions ..
142  LOGICAL LSAME
143  REAL SLAMCH
144  EXTERNAL lsame, slamch
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( 'SDISNA', -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 ) = slamch( '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 = slamch( 'E' )
227  safmin = slamch( '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 SDISNA
241 *
242  END
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine sdisna(JOB, M, N, D, SEP, INFO)
SDISNA
Definition: sdisna.f:117