LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ dget53()

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
December 2016

Definition at line 128 of file dget53.f.

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