LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

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

126 *
127 * -- LAPACK test routine --
128 * -- LAPACK is a software package provided by Univ. of Tennessee, --
129 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
130 *
131 * .. Scalar Arguments ..
132  INTEGER INFO, LDA, LDB
133  REAL RESULT, SCALE, WI, WR
134 * ..
135 * .. Array Arguments ..
136  REAL A( LDA, * ), B( LDB, * )
137 * ..
138 *
139 * =====================================================================
140 *
141 * .. Parameters ..
142  REAL ZERO, ONE
143  parameter( zero = 0.0, one = 1.0 )
144 * ..
145 * .. Local Scalars ..
146  REAL ABSW, ANORM, BNORM, CI11, CI12, CI22, CNORM,
147  $ CR11, CR12, CR21, CR22, CSCALE, DETI, DETR, S1,
148  $ SAFMIN, SCALES, SIGMIN, TEMP, ULP, WIS, WRS
149 * ..
150 * .. External Functions ..
151  REAL SLAMCH
152  EXTERNAL slamch
153 * ..
154 * .. Intrinsic Functions ..
155  INTRINSIC abs, max, sqrt
156 * ..
157 * .. Executable Statements ..
158 *
159 * Initialize
160 *
161  info = 0
162  result = zero
163  scales = scale
164  wrs = wr
165  wis = wi
166 *
167 * Machine constants and norms
168 *
169  safmin = slamch( 'Safe minimum' )
170  ulp = slamch( 'Epsilon' )*slamch( 'Base' )
171  absw = abs( wrs ) + abs( wis )
172  anorm = max( abs( a( 1, 1 ) )+abs( a( 2, 1 ) ),
173  $ abs( a( 1, 2 ) )+abs( a( 2, 2 ) ), safmin )
174  bnorm = max( abs( b( 1, 1 ) ), abs( b( 1, 2 ) )+abs( b( 2, 2 ) ),
175  $ safmin )
176 *
177 * Check for possible overflow.
178 *
179  temp = ( safmin*bnorm )*absw + ( safmin*anorm )*scales
180  IF( temp.GE.one ) THEN
181 *
182 * Scale down to avoid overflow
183 *
184  info = 1
185  temp = one / temp
186  scales = scales*temp
187  wrs = wrs*temp
188  wis = wis*temp
189  absw = abs( wrs ) + abs( wis )
190  END IF
191  s1 = max( ulp*max( scales*anorm, absw*bnorm ),
192  $ safmin*max( scales, absw ) )
193 *
194 * Check for W and SCALE essentially zero.
195 *
196  IF( s1.LT.safmin ) THEN
197  info = 2
198  IF( scales.LT.safmin .AND. absw.LT.safmin ) THEN
199  info = 3
200  result = one / ulp
201  RETURN
202  END IF
203 *
204 * Scale up to avoid underflow
205 *
206  temp = one / max( scales*anorm+absw*bnorm, safmin )
207  scales = scales*temp
208  wrs = wrs*temp
209  wis = wis*temp
210  absw = abs( wrs ) + abs( wis )
211  s1 = max( ulp*max( scales*anorm, absw*bnorm ),
212  $ safmin*max( scales, absw ) )
213  IF( s1.LT.safmin ) THEN
214  info = 3
215  result = one / ulp
216  RETURN
217  END IF
218  END IF
219 *
220 * Compute C = s A - w B
221 *
222  cr11 = scales*a( 1, 1 ) - wrs*b( 1, 1 )
223  ci11 = -wis*b( 1, 1 )
224  cr21 = scales*a( 2, 1 )
225  cr12 = scales*a( 1, 2 ) - wrs*b( 1, 2 )
226  ci12 = -wis*b( 1, 2 )
227  cr22 = scales*a( 2, 2 ) - wrs*b( 2, 2 )
228  ci22 = -wis*b( 2, 2 )
229 *
230 * Compute the smallest singular value of s A - w B:
231 *
232 * |det( s A - w B )|
233 * sigma_min = ------------------
234 * norm( s A - w B )
235 *
236  cnorm = max( abs( cr11 )+abs( ci11 )+abs( cr21 ),
237  $ abs( cr12 )+abs( ci12 )+abs( cr22 )+abs( ci22 ), safmin )
238  cscale = one / sqrt( cnorm )
239  detr = ( cscale*cr11 )*( cscale*cr22 ) -
240  $ ( cscale*ci11 )*( cscale*ci22 ) -
241  $ ( cscale*cr12 )*( cscale*cr21 )
242  deti = ( cscale*cr11 )*( cscale*ci22 ) +
243  $ ( cscale*ci11 )*( cscale*cr22 ) -
244  $ ( cscale*ci12 )*( cscale*cr21 )
245  sigmin = abs( detr ) + abs( deti )
246  result = sigmin / s1
247  RETURN
248 *
249 * End of SGET53
250 *
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68
Here is the caller graph for this function: