156 SUBROUTINE slag2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1,
166 REAL SAFMIN, SCALE1, SCALE2, WI, WR1, WR2
169 REAL A( lda, * ), B( ldb, * )
176 parameter ( zero = 0.0e+0, one = 1.0e+0, two = 2.0e+0 )
178 parameter ( half = one / two )
180 parameter ( fuzzy1 = one+1.0e-5 )
183 REAL A11, A12, A21, A22, ABI22, ANORM, AS11, AS12,
184 $ as22, ascale, b11, b12, b22, binv11, binv22,
185 $ bmin, bnorm, bscale, bsize, c1, c2, c3, c4, c5,
186 $ diff, discr, pp, qq, r, rtmax, rtmin, s1, s2,
187 $ safmax, shift, ss, sum, wabs, wbig, wdet,
188 $ wscale, wsize, wsmall
191 INTRINSIC abs, max, min, sign, sqrt
195 rtmin = sqrt( safmin )
197 safmax = one / safmin
201 anorm = max( abs( a( 1, 1 ) )+abs( a( 2, 1 ) ),
202 $ abs( a( 1, 2 ) )+abs( a( 2, 2 ) ), safmin )
204 a11 = ascale*a( 1, 1 )
205 a21 = ascale*a( 2, 1 )
206 a12 = ascale*a( 1, 2 )
207 a22 = ascale*a( 2, 2 )
214 bmin = rtmin*max( abs( b11 ), abs( b12 ), abs( b22 ), rtmin )
215 IF( abs( b11 ).LT.bmin )
216 $ b11 = sign( bmin, b11 )
217 IF( abs( b22 ).LT.bmin )
218 $ b22 = sign( bmin, b22 )
222 bnorm = max( abs( b11 ), abs( b12 )+abs( b22 ), safmin )
223 bsize = max( abs( b11 ), abs( b22 ) )
237 IF( abs( s1 ).LE.abs( s2 ) )
THEN
240 ss = a21*( binv11*binv22 )
241 abi22 = as22*binv22 - ss*b12
247 ss = a21*( binv11*binv22 )
249 pp = half*( as11*binv11+abi22 )
253 IF( abs( pp*rtmin ).GE.one )
THEN
254 discr = ( rtmin*pp )**2 + qq*safmin
255 r = sqrt( abs( discr ) )*rtmax
257 IF( pp**2+abs( qq ).LE.safmin )
THEN
258 discr = ( rtmax*pp )**2 + qq*safmax
259 r = sqrt( abs( discr ) )*rtmin
262 r = sqrt( abs( discr ) )
272 IF( discr.GE.zero .OR. r.EQ.zero )
THEN
273 sum = pp + sign( r, pp )
274 diff = pp - sign( r, pp )
279 wsmall = shift + diff
280 IF( half*abs( wbig ).GT.max( abs( wsmall ), safmin ) )
THEN
281 wdet = ( a11*a22-a12*a21 )*( binv11*binv22 )
288 IF( pp.GT.abi22 )
THEN
289 wr1 = min( wbig, wsmall )
290 wr2 = max( wbig, wsmall )
292 wr1 = max( wbig, wsmall )
293 wr2 = min( wbig, wsmall )
317 c1 = bsize*( safmin*max( one, ascale ) )
318 c2 = safmin*max( one, bnorm )
320 IF( ascale.LE.one .AND. bsize.LE.one )
THEN
321 c4 = min( one, ( ascale / safmin )*bsize )
325 IF( ascale.LE.one .OR. bsize.LE.one )
THEN
326 c5 = min( one, ascale*bsize )
333 wabs = abs( wr1 ) + abs( wi )
334 wsize = max( safmin, c1, fuzzy1*( wabs*c2+c3 ),
335 $ min( c4, half*max( wabs, c5 ) ) )
336 IF( wsize.NE.one )
THEN
338 IF( wsize.GT.one )
THEN
339 scale1 = ( max( ascale, bsize )*wscale )*
340 $ min( ascale, bsize )
342 scale1 = ( min( ascale, bsize )*wscale )*
343 $ max( ascale, bsize )
346 IF( wi.NE.zero )
THEN
352 scale1 = ascale*bsize
358 IF( wi.EQ.zero )
THEN
359 wsize = max( safmin, c1, fuzzy1*( abs( wr2 )*c2+c3 ),
360 $ min( c4, half*max( abs( wr2 ), c5 ) ) )
361 IF( wsize.NE.one )
THEN
363 IF( wsize.GT.one )
THEN
364 scale2 = ( max( ascale, bsize )*wscale )*
365 $ min( ascale, bsize )
367 scale2 = ( min( ascale, bsize )*wscale )*
368 $ max( ascale, bsize )
372 scale2 = ascale*bsize
subroutine slag2(A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1, WR2, WI)
SLAG2 computes the eigenvalues of a 2-by-2 generalized eigenvalue problem, with scaling as necessary ...