LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ sdisna()

subroutine sdisna ( character  job,
integer  m,
integer  n,
real, dimension( * )  d,
real, dimension( * )  sep,
integer  info 
)

SDISNA

Download SDISNA + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 SDISNA computes the reciprocal condition numbers for the eigenvectors
 of a real symmetric or complex Hermitian matrix or for the left or
 right singular vectors of a general m-by-n matrix. The reciprocal
 condition number is the 'gap' between the corresponding eigenvalue or
 singular value and the nearest other one.

 The bound on the error, measured by angle in radians, in the I-th
 computed vector is given by

        SLAMCH( 'E' ) * ( ANORM / SEP( I ) )

 where ANORM = 2-norm(A) = max( abs( D(j) ) ).  SEP(I) is not allowed
 to be smaller than SLAMCH( 'E' )*ANORM in order to limit the size of
 the error bound.

 SDISNA may also be used to compute error bounds for eigenvectors of
 the generalized symmetric definite eigenproblem.
Parameters
[in]JOB
          JOB is CHARACTER*1
          Specifies for which problem the reciprocal condition numbers
          should be computed:
          = 'E':  the eigenvectors of a symmetric/Hermitian matrix;
          = 'L':  the left singular vectors of a general matrix;
          = 'R':  the right singular vectors of a general matrix.
[in]M
          M is INTEGER
          The number of rows of the matrix. M >= 0.
[in]N
          N is INTEGER
          If JOB = 'L' or 'R', the number of columns of the matrix,
          in which case N >= 0. Ignored if JOB = 'E'.
[in]D
          D is REAL array, dimension (M) if JOB = 'E'
                              dimension (min(M,N)) if JOB = 'L' or 'R'
          The eigenvalues (if JOB = 'E') or singular values (if JOB =
          'L' or 'R') of the matrix, in either increasing or decreasing
          order. If singular values, they must be non-negative.
[out]SEP
          SEP is REAL array, dimension (M) if JOB = 'E'
                               dimension (min(M,N)) if JOB = 'L' or 'R'
          The reciprocal condition numbers of the vectors.
[out]INFO
          INFO is INTEGER
          = 0:  successful exit.
          < 0:  if INFO = -i, the i-th argument had an illegal value.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 116 of file sdisna.f.

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*
subroutine xerbla(srname, info)
Definition cblat2.f:3285
real function slamch(cmach)
SLAMCH
Definition slamch.f:68
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
Here is the call graph for this function: