154 SUBROUTINE zlags2( UPPER, A1, A2, A3, B1, B2, B3, CSU, SNU,
164 DOUBLE PRECISION A1, A3, B1, B3, CSQ, CSU, CSV
165 COMPLEX*16 A2, B2, SNQ, SNU, SNV
171 DOUBLE PRECISION ZERO, ONE
172 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0 )
175 DOUBLE PRECISION A, AUA11, AUA12, AUA21, AUA22, AVB12, AVB11,
176 $ AVB21, AVB22, CSL, CSR, D, FB, FC, S1, S2,
177 $ snl, snr, ua11r, ua22r, vb11r, vb22r
178 COMPLEX*16 B, C, D1, R, T, UA11, UA12, UA21, UA22, VB11,
185 INTRINSIC abs, dble, dcmplx, dconjg, dimag
188 DOUBLE PRECISION ABS1
191 abs1( t ) = abs( dble( t ) ) + abs( dimag( t ) )
219 CALL dlasv2( a, fb, d, s1, s2, snr, csr, snl, csl )
221 IF( abs( csl ).GE.abs( snl ) .OR. abs( csr ).GE.abs( snr ) )
228 ua12 = csl*a2 + d1*snl*a3
231 vb12 = csr*b2 + d1*snr*b3
233 aua12 = abs( csl )*abs1( a2 ) + abs( snl )*abs( a3 )
234 avb12 = abs( csr )*abs1( b2 ) + abs( snr )*abs( b3 )
238 IF( ( abs( ua11r )+abs1( ua12 ) ).EQ.zero )
THEN
239 CALL zlartg( -dcmplx( vb11r ), dconjg( vb12 ), csq,
242 ELSE IF( ( abs( vb11r )+abs1( vb12 ) ).EQ.zero )
THEN
243 CALL zlartg( -dcmplx( ua11r ), dconjg( ua12 ), csq,
246 ELSE IF( aua12 / ( abs( ua11r )+abs1( ua12 ) ).LE.avb12 /
247 $ ( abs( vb11r )+abs1( vb12 ) ) )
THEN
248 CALL zlartg( -dcmplx( ua11r ), dconjg( ua12 ), csq,
252 CALL zlartg( -dcmplx( vb11r ), dconjg( vb12 ), csq,
267 ua21 = -dconjg( d1 )*snl*a1
268 ua22 = -dconjg( d1 )*snl*a2 + csl*a3
270 vb21 = -dconjg( d1 )*snr*b1
271 vb22 = -dconjg( d1 )*snr*b2 + csr*b3
273 aua22 = abs( snl )*abs1( a2 ) + abs( csl )*abs( a3 )
274 avb22 = abs( snr )*abs1( b2 ) + abs( csr )*abs( b3 )
278 IF( ( abs1( ua21 )+abs1( ua22 ) ).EQ.zero )
THEN
279 CALL zlartg( -dconjg( vb21 ), dconjg( vb22 ), csq,
282 ELSE IF( ( abs1( vb21 )+abs( vb22 ) ).EQ.zero )
THEN
283 CALL zlartg( -dconjg( ua21 ), dconjg( ua22 ), csq,
286 ELSE IF( aua22 / ( abs1( ua21 )+abs1( ua22 ) ).LE.avb22 /
287 $ ( abs1( vb21 )+abs1( vb22 ) ) )
THEN
288 CALL zlartg( -dconjg( ua21 ), dconjg( ua22 ), csq,
292 CALL zlartg( -dconjg( vb21 ), dconjg( vb22 ), csq,
328 CALL dlasv2( a, fc, d, s1, s2, snr, csr, snl, csl )
330 IF( abs( csr ).GE.abs( snr ) .OR. abs( csl ).GE.abs( snl ) )
336 ua21 = -d1*snr*a1 + csr*a2
339 vb21 = -d1*snl*b1 + csl*b2
342 aua21 = abs( snr )*abs( a1 ) + abs( csr )*abs1( a2 )
343 avb21 = abs( snl )*abs( b1 ) + abs( csl )*abs1( b2 )
347 IF( ( abs1( ua21 )+abs( ua22r ) ).EQ.zero )
THEN
348 CALL zlartg( dcmplx( vb22r ), vb21, csq, snq, r )
349 ELSE IF( ( abs1( vb21 )+abs( vb22r ) ).EQ.zero )
THEN
350 CALL zlartg( dcmplx( ua22r ), ua21, csq, snq, r )
351 ELSE IF( aua21 / ( abs1( ua21 )+abs( ua22r ) ).LE.avb21 /
352 $ ( abs1( vb21 )+abs( vb22r ) ) )
THEN
353 CALL zlartg( dcmplx( ua22r ), ua21, csq, snq, r )
355 CALL zlartg( dcmplx( vb22r ), vb21, csq, snq, r )
359 snu = -dconjg( d1 )*snr
361 snv = -dconjg( d1 )*snl
368 ua11 = csr*a1 + dconjg( d1 )*snr*a2
369 ua12 = dconjg( d1 )*snr*a3
371 vb11 = csl*b1 + dconjg( d1 )*snl*b2
372 vb12 = dconjg( d1 )*snl*b3
374 aua11 = abs( csr )*abs( a1 ) + abs( snr )*abs1( a2 )
375 avb11 = abs( csl )*abs( b1 ) + abs( snl )*abs1( b2 )
379 IF( ( abs1( ua11 )+abs1( ua12 ) ).EQ.zero )
THEN
380 CALL zlartg( vb12, vb11, csq, snq, r )
381 ELSE IF( ( abs1( vb11 )+abs1( vb12 ) ).EQ.zero )
THEN
382 CALL zlartg( ua12, ua11, csq, snq, r )
383 ELSE IF( aua11 / ( abs1( ua11 )+abs1( ua12 ) ).LE.avb11 /
384 $ ( abs1( vb11 )+abs1( vb12 ) ) )
THEN
385 CALL zlartg( ua12, ua11, csq, snq, r )
387 CALL zlartg( vb12, vb11, csq, snq, r )
391 snu = dconjg( d1 )*csr
393 snv = dconjg( d1 )*csl