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

◆ 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.

Definition at line 114 of file ddisna.f.

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