subroutine dget53	(	double precision, dimension( lda, * )	A,
		integer	LDA,
		double precision, dimension( ldb, * )	B,
		integer	LDB,
		double precision	SCALE,
		double precision	WR,
		double precision	WI,
		double precision	RESULT,
		integer	INFO
	)

DGET53

Purpose:

 DGET53  checks the generalized eigenvalues computed by DLAG2.

 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION The "scale factor" s in the formula s A - w B . It is assumed to be non-negative.
[in]	WR	WR is DOUBLE PRECISION The real part of the eigenvalue w in the formula s A - w B .
[in]	WI	WI is DOUBLE PRECISION The imaginary part of the eigenvalue w in the formula s A - w B .
[out]	RESULT	RESULT is DOUBLE PRECISION 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.

Date

November 2011

Definition at line 128 of file dget53.f.

*
*  -- LAPACK test routine (version 3.4.0) --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*     November 2011
*
*     .. Scalar Arguments ..
      INTEGER            info, lda, ldb
      DOUBLE PRECISION   result, scale, wi, wr
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION   a( lda, * ), b( ldb, * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      DOUBLE PRECISION   zero, one
      parameter                ( zero = 0.0d0, one = 1.0d0 )
*     ..
*     .. Local Scalars ..
      DOUBLE PRECISION   absw, anorm, bnorm, ci11, ci12, ci22, cnorm,
     $                   cr11, cr12, cr21, cr22, cscale, deti, detr, s1,
     $                   safmin, scales, sigmin, temp, ulp, wis, wrs
*     ..
*     .. External Functions ..
      DOUBLE PRECISION   dlamch
      EXTERNAL           dlamch
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, max, sqrt
*     ..
*     .. Executable Statements ..
*
*     Initialize
*
      info = 0
      result = zero
      scales = scale
      wrs = wr
      wis = wi
*
*     Machine constants and norms
*
      safmin = dlamch( 'Safe minimum' )
      ulp = dlamch( 'Epsilon' )*dlamch( '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 DGET53
*

Here is the caller graph for this function: