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 114 of file sdisna.f.

*
*  -- LAPACK computational routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      CHARACTER          JOB
      INTEGER            INFO, M, N
*     ..
*     .. Array Arguments ..
      REAL               D( * ), SEP( * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ZERO
      parameter( zero = 0.0e+0 )
*     ..
*     .. Local Scalars ..
      LOGICAL            DECR, EIGEN, INCR, LEFT, RIGHT, SING
      INTEGER            I, K
      REAL               ANORM, EPS, NEWGAP, OLDGAP, SAFMIN, THRESH
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      REAL               SLAMCH
      EXTERNAL           lsame, slamch
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, max, min
*     ..
*     .. External Subroutines ..
      EXTERNAL           xerbla
*     ..
*     .. Executable Statements ..
*
*     Test the input arguments
*
      info = 0
      eigen = lsame( job, 'E' )
      left = lsame( job, 'L' )
      right = lsame( job, 'R' )
      sing = left .OR. right
      IF( eigen ) THEN
         k = m
      ELSE IF( sing ) THEN
         k = min( m, n )
      END IF
      IF( .NOT.eigen .AND. .NOT.sing ) THEN
         info = -1
      ELSE IF( m.LT.0 ) THEN
         info = -2
      ELSE IF( k.LT.0 ) THEN
         info = -3
      ELSE
         incr = .true.
         decr = .true.
         DO 10 i = 1, k - 1
            IF( incr )
     $         incr = incr .AND. d( i ).LE.d( i+1 )
            IF( decr )
     $         decr = decr .AND. d( i ).GE.d( i+1 )
   10    CONTINUE
         IF( sing .AND. k.GT.0 ) THEN
            IF( incr )
     $         incr = incr .AND. zero.LE.d( 1 )
            IF( decr )
     $         decr = decr .AND. d( k ).GE.zero
         END IF
         IF( .NOT.( incr .OR. decr ) )
     $      info = -4
      END IF
      IF( info.NE.0 ) THEN
         CALL xerbla( 'SDISNA', -info )
         RETURN
      END IF
*
*     Quick return if possible
*
      IF( k.EQ.0 )
     $   RETURN
*
*     Compute reciprocal condition numbers
*
      IF( k.EQ.1 ) THEN
         sep( 1 ) = slamch( 'O' )
      ELSE
         oldgap = abs( d( 2 )-d( 1 ) )
         sep( 1 ) = oldgap
         DO 20 i = 2, k - 1
            newgap = abs( d( i+1 )-d( i ) )
            sep( i ) = min( oldgap, newgap )
            oldgap = newgap
   20    CONTINUE
         sep( k ) = oldgap
      END IF
      IF( sing ) THEN
         IF( ( left .AND. m.GT.n ) .OR. ( right .AND. m.LT.n ) ) THEN
            IF( incr )
     $         sep( 1 ) = min( sep( 1 ), d( 1 ) )
            IF( decr )
     $         sep( k ) = min( sep( k ), d( k ) )
         END IF
      END IF
*
*     Ensure that reciprocal condition numbers are not less than
*     threshold, in order to limit the size of the error bound
*
      eps = slamch( 'E' )
      safmin = slamch( 'S' )
      anorm = max( abs( d( 1 ) ), abs( d( k ) ) )
      IF( anorm.EQ.zero ) THEN
         thresh = eps
      ELSE
         thresh = max( eps*anorm, safmin )
      END IF
      DO 30 i = 1, k
         sep( i ) = max( sep( i ), thresh )
   30 CONTINUE
*
      RETURN
*
*     End of SDISNA
*

Here is the call graph for this function: