LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
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 disna
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)
Definition cblat2.f:3285
subroutine sdisna(job, m, n, d, sep, info)
SDISNA
Definition sdisna.f:117