LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ 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)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68
Here is the call graph for this function: