LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ ddisna()

subroutine ddisna ( character  JOB,
integer  M,
integer  N,
double precision, dimension( * )  D,
double precision, dimension( * )  SEP,
integer  INFO 
)

DDISNA

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

Purpose:
 DDISNA 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

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

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

 DDISNA 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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.
Date
December 2016

Definition at line 119 of file ddisna.f.

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  DOUBLE PRECISION d( * ), sep( * )
131 * ..
132 *
133 * =====================================================================
134 *
135 * .. Parameters ..
136  DOUBLE PRECISION zero
137  parameter( zero = 0.0d+0 )
138 * ..
139 * .. Local Scalars ..
140  LOGICAL decr, eigen, incr, left, right, sing
141  INTEGER i, k
142  DOUBLE PRECISION anorm, eps, newgap, oldgap, safmin, thresh
143 * ..
144 * .. External Functions ..
145  LOGICAL lsame
146  DOUBLE PRECISION dlamch
147  EXTERNAL lsame, dlamch
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( 'DDISNA', -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 ) = dlamch( '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 = dlamch( 'E' )
230  safmin = dlamch( '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 DDISNA
244 *
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
Here is the call graph for this function: