 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.

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: