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

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