sget53()

subroutine sget53	(	real, dimension( lda, * )	a,
		integer	lda,
		real, dimension( ldb, * )	b,
		integer	ldb,
		real	scale,
		real	wr,
		real	wi,
		real	result,
		integer	info
	)

SGET53

Purpose:

 SGET53  checks the generalized eigenvalues computed by SLAG2.

 The basic test for an eigenvalue is:

                              | det( s A - w B ) |
     RESULT =  ---------------------------------------------------
               ulp max( s norm(A), |w| norm(B) )*norm( s A - w B )

 Two "safety checks" are performed:

 (1)  ulp*max( s*norm(A), |w|*norm(B) )  must be at least
      safe_minimum.  This insures that the test performed is
      not essentially  det(0*A + 0*B)=0.

 (2)  s*norm(A) + |w|*norm(B) must be less than 1/safe_minimum.
      This insures that  s*A - w*B  will not overflow.

 If these tests are not passed, then  s  and  w  are scaled and
 tested anyway, if this is possible.

Parameters

[in]	A	A is REAL array, dimension (LDA, 2) The 2x2 matrix A.
[in]	LDA	LDA is INTEGER The leading dimension of A. It must be at least 2.
[in]	B	B is REAL array, dimension (LDB, N) The 2x2 upper-triangular matrix B.
[in]	LDB	LDB is INTEGER The leading dimension of B. It must be at least 2.
[in]	SCALE	SCALE is REAL The "scale factor" s in the formula s A - w B . It is assumed to be non-negative.
[in]	WR	WR is REAL The real part of the eigenvalue w in the formula s A - w B .
[in]	WI	WI is REAL The imaginary part of the eigenvalue w in the formula s A - w B .
[out]	RESULT	RESULT is REAL If INFO is 2 or less, the value computed by the test described above. If INFO=3, this will just be 1/ulp.
[out]	INFO	INFO is INTEGER =0: The input data pass the "safety checks". =1: s*norm(A) + |w|*norm(B) > 1/safe_minimum. =2: ulp*max( s*norm(A), |w|*norm(B) ) < safe_minimum =3: same as INFO=2, but s and w could not be scaled so as to compute the test.

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Definition at line 125 of file sget53.f.

*
*  -- LAPACK test routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      INTEGER            INFO, LDA, LDB
      REAL               RESULT, SCALE, WI, WR
*     ..
*     .. Array Arguments ..
      REAL               A( LDA, * ), B( LDB, * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ZERO, ONE
      parameter( zero = 0.0, one = 1.0 )
*     ..
*     .. Local Scalars ..
      REAL               ABSW, ANORM, BNORM, CI11, CI12, CI22, CNORM,
     $                   CR11, CR12, CR21, CR22, CSCALE, DETI, DETR, S1,
     $                   SAFMIN, SCALES, SIGMIN, TEMP, ULP, WIS, WRS
*     ..
*     .. External Functions ..
      REAL               SLAMCH
      EXTERNAL           slamch
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, max, sqrt
*     ..
*     .. Executable Statements ..
*
*     Initialize
*
      info = 0
      result = zero
      scales = scale
      wrs = wr
      wis = wi
*
*     Machine constants and norms
*
      safmin = slamch( 'Safe minimum' )
      ulp = slamch( 'Epsilon' )*slamch( 'Base' )
      absw = abs( wrs ) + abs( wis )
      anorm = max( abs( a( 1, 1 ) )+abs( a( 2, 1 ) ),
     $        abs( a( 1, 2 ) )+abs( a( 2, 2 ) ), safmin )
      bnorm = max( abs( b( 1, 1 ) ), abs( b( 1, 2 ) )+abs( b( 2, 2 ) ),
     $        safmin )
*
*     Check for possible overflow.
*
      temp = ( safmin*bnorm )*absw + ( safmin*anorm )*scales
      IF( temp.GE.one ) THEN
*
*        Scale down to avoid overflow
*
         info = 1
         temp = one / temp
         scales = scales*temp
         wrs = wrs*temp
         wis = wis*temp
         absw = abs( wrs ) + abs( wis )
      END IF
      s1 = max( ulp*max( scales*anorm, absw*bnorm ),
     $     safmin*max( scales, absw ) )
*
*     Check for W and SCALE essentially zero.
*
      IF( s1.LT.safmin ) THEN
         info = 2
         IF( scales.LT.safmin .AND. absw.LT.safmin ) THEN
            info = 3
            result = one / ulp
            RETURN
         END IF
*
*        Scale up to avoid underflow
*
         temp = one / max( scales*anorm+absw*bnorm, safmin )
         scales = scales*temp
         wrs = wrs*temp
         wis = wis*temp
         absw = abs( wrs ) + abs( wis )
         s1 = max( ulp*max( scales*anorm, absw*bnorm ),
     $        safmin*max( scales, absw ) )
         IF( s1.LT.safmin ) THEN
            info = 3
            result = one / ulp
            RETURN
         END IF
      END IF
*
*     Compute C = s A - w B
*
      cr11 = scales*a( 1, 1 ) - wrs*b( 1, 1 )
      ci11 = -wis*b( 1, 1 )
      cr21 = scales*a( 2, 1 )
      cr12 = scales*a( 1, 2 ) - wrs*b( 1, 2 )
      ci12 = -wis*b( 1, 2 )
      cr22 = scales*a( 2, 2 ) - wrs*b( 2, 2 )
      ci22 = -wis*b( 2, 2 )
*
*     Compute the smallest singular value of s A - w B:
*
*                 |det( s A - w B )|
*     sigma_min = ------------------
*                 norm( s A - w B )
*
      cnorm = max( abs( cr11 )+abs( ci11 )+abs( cr21 ),
     $        abs( cr12 )+abs( ci12 )+abs( cr22 )+abs( ci22 ), safmin )
      cscale = one / sqrt( cnorm )
      detr = ( cscale*cr11 )*( cscale*cr22 ) -
     $       ( cscale*ci11 )*( cscale*ci22 ) -
     $       ( cscale*cr12 )*( cscale*cr21 )
      deti = ( cscale*cr11 )*( cscale*ci22 ) +
     $       ( cscale*ci11 )*( cscale*cr22 ) -
     $       ( cscale*ci12 )*( cscale*cr21 )
      sigmin = abs( detr ) + abs( deti )
      result = sigmin / s1
      RETURN
*
*     End of SGET53
*

Here is the caller graph for this function: