LAPACK  3.8.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 *> \date December 2016
114 *
115 *> \ingroup auxOTHERcomputational
116 *
117 * =====================================================================
118  SUBROUTINE sdisna( JOB, M, N, D, SEP, INFO )
119 *
120 * -- LAPACK computational routine (version 3.7.0) --
121 * -- LAPACK is a software package provided by Univ. of Tennessee, --
122 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
123 * December 2016
124 *
125 * .. Scalar Arguments ..
126  CHARACTER JOB
127  INTEGER INFO, M, N
128 * ..
129 * .. Array Arguments ..
130  REAL D( * ), SEP( * )
131 * ..
132 *
133 * =====================================================================
134 *
135 * .. Parameters ..
136  REAL ZERO
137  parameter( zero = 0.0e+0 )
138 * ..
139 * .. Local Scalars ..
140  LOGICAL DECR, EIGEN, INCR, LEFT, RIGHT, SING
141  INTEGER I, K
142  REAL ANORM, EPS, NEWGAP, OLDGAP, SAFMIN, THRESH
143 * ..
144 * .. External Functions ..
145  LOGICAL LSAME
146  REAL SLAMCH
147  EXTERNAL lsame, slamch
148 * ..
149 * .. Intrinsic Functions ..
150  INTRINSIC abs, max, min
151 * ..
152 * .. External Subroutines ..
153  EXTERNAL xerbla
154 * ..
155 * .. Executable Statements ..
156 *
157 * Test the input arguments
158 *
159  info = 0
160  eigen = lsame( job, 'E' )
161  left = lsame( job, 'L' )
162  right = lsame( job, 'R' )
163  sing = left .OR. right
164  IF( eigen ) THEN
165  k = m
166  ELSE IF( sing ) THEN
167  k = min( m, n )
168  END IF
169  IF( .NOT.eigen .AND. .NOT.sing ) THEN
170  info = -1
171  ELSE IF( m.LT.0 ) THEN
172  info = -2
173  ELSE IF( k.LT.0 ) THEN
174  info = -3
175  ELSE
176  incr = .true.
177  decr = .true.
178  DO 10 i = 1, k - 1
179  IF( incr )
180  $ incr = incr .AND. d( i ).LE.d( i+1 )
181  IF( decr )
182  $ decr = decr .AND. d( i ).GE.d( i+1 )
183  10 CONTINUE
184  IF( sing .AND. k.GT.0 ) THEN
185  IF( incr )
186  $ incr = incr .AND. zero.LE.d( 1 )
187  IF( decr )
188  $ decr = decr .AND. d( k ).GE.zero
189  END IF
190  IF( .NOT.( incr .OR. decr ) )
191  $ info = -4
192  END IF
193  IF( info.NE.0 ) THEN
194  CALL xerbla( 'SDISNA', -info )
195  RETURN
196  END IF
197 *
198 * Quick return if possible
199 *
200  IF( k.EQ.0 )
201  $ RETURN
202 *
203 * Compute reciprocal condition numbers
204 *
205  IF( k.EQ.1 ) THEN
206  sep( 1 ) = slamch( 'O' )
207  ELSE
208  oldgap = abs( d( 2 )-d( 1 ) )
209  sep( 1 ) = oldgap
210  DO 20 i = 2, k - 1
211  newgap = abs( d( i+1 )-d( i ) )
212  sep( i ) = min( oldgap, newgap )
213  oldgap = newgap
214  20 CONTINUE
215  sep( k ) = oldgap
216  END IF
217  IF( sing ) THEN
218  IF( ( left .AND. m.GT.n ) .OR. ( right .AND. m.LT.n ) ) THEN
219  IF( incr )
220  $ sep( 1 ) = min( sep( 1 ), d( 1 ) )
221  IF( decr )
222  $ sep( k ) = min( sep( k ), d( k ) )
223  END IF
224  END IF
225 *
226 * Ensure that reciprocal condition numbers are not less than
227 * threshold, in order to limit the size of the error bound
228 *
229  eps = slamch( 'E' )
230  safmin = slamch( 'S' )
231  anorm = max( abs( d( 1 ) ), abs( d( k ) ) )
232  IF( anorm.EQ.zero ) THEN
233  thresh = eps
234  ELSE
235  thresh = max( eps*anorm, safmin )
236  END IF
237  DO 30 i = 1, k
238  sep( i ) = max( sep( i ), thresh )
239  30 CONTINUE
240 *
241  RETURN
242 *
243 * End of SDISNA
244 *
245  END
subroutine sdisna(JOB, M, N, D, SEP, INFO)
SDISNA
Definition: sdisna.f:119
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62