SUBROUTINE SLAGV2( A, LDA, B, LDB, ALPHAR, ALPHAI, BETA, CSL, SNL,
$ CSR, SNR )
INTEGER LDA, LDB
REAL CSL, CSR, SNL, SNR
REAL A( LDA, * ), ALPHAI( 2 ), ALPHAR( 2 ),
$ B( LDB, * ), BETA( 2 )
REAL ZERO, ONE
PARAMETER ( ZERO = 0.0E+0, ONE = 1.0E+0 )
REAL ANORM, ASCALE, BNORM, BSCALE, H1, H2, H3, QQ,
$ R, RR, SAFMIN, SCALE1, SCALE2, T, ULP, WI, WR1,
$ WR2
EXTERNAL SLAG2, SLARTG, SLASV2, SROT
REAL SLAMCH, SLAPY2
EXTERNAL SLAMCH, SLAPY2
INTRINSIC ABS, MAX
SAFMIN = SLAMCH( 'S' )
ULP = SLAMCH( 'P' )
ANORM = MAX( ABS( A( 1, 1 ) )+ABS( A( 2, 1 ) ),
$ ABS( A( 1, 2 ) )+ABS( A( 2, 2 ) ), SAFMIN )
ASCALE = ONE / ANORM
A( 1, 1 ) = ASCALE*A( 1, 1 )
A( 1, 2 ) = ASCALE*A( 1, 2 )
A( 2, 1 ) = ASCALE*A( 2, 1 )
A( 2, 2 ) = ASCALE*A( 2, 2 )
BNORM = MAX( ABS( B( 1, 1 ) ), ABS( B( 1, 2 ) )+ABS( B( 2, 2 ) ),
$ SAFMIN )
BSCALE = ONE / BNORM
B( 1, 1 ) = BSCALE*B( 1, 1 )
B( 1, 2 ) = BSCALE*B( 1, 2 )
B( 2, 2 ) = BSCALE*B( 2, 2 )
IF( ABS( A( 2, 1 ) ).LE.ULP ) THEN
CSL = ONE
SNL = ZERO
CSR = ONE
SNR = ZERO
A( 2, 1 ) = ZERO
B( 2, 1 ) = ZERO
ELSE IF( ABS( B( 1, 1 ) ).LE.ULP ) THEN
CALL SLARTG( A( 1, 1 ), A( 2, 1 ), CSL, SNL, R )
CSR = ONE
SNR = ZERO
CALL SROT( 2, A( 1, 1 ), LDA, A( 2, 1 ), LDA, CSL, SNL )
CALL SROT( 2, B( 1, 1 ), LDB, B( 2, 1 ), LDB, CSL, SNL )
A( 2, 1 ) = ZERO
B( 1, 1 ) = ZERO
B( 2, 1 ) = ZERO
ELSE IF( ABS( B( 2, 2 ) ).LE.ULP ) THEN
CALL SLARTG( A( 2, 2 ), A( 2, 1 ), CSR, SNR, T )
SNR = -SNR
CALL SROT( 2, A( 1, 1 ), 1, A( 1, 2 ), 1, CSR, SNR )
CALL SROT( 2, B( 1, 1 ), 1, B( 1, 2 ), 1, CSR, SNR )
CSL = ONE
SNL = ZERO
A( 2, 1 ) = ZERO
B( 2, 1 ) = ZERO
B( 2, 2 ) = ZERO
ELSE
CALL SLAG2( A, LDA, B, LDB, SAFMIN, SCALE1, SCALE2, WR1, WR2,
$ WI )
IF( WI.EQ.ZERO ) THEN
H1 = SCALE1*A( 1, 1 ) - WR1*B( 1, 1 )
H2 = SCALE1*A( 1, 2 ) - WR1*B( 1, 2 )
H3 = SCALE1*A( 2, 2 ) - WR1*B( 2, 2 )
RR = SLAPY2( H1, H2 )
QQ = SLAPY2( SCALE1*A( 2, 1 ), H3 )
IF( RR.GT.QQ ) THEN
CALL SLARTG( H2, H1, CSR, SNR, T )
ELSE
CALL SLARTG( H3, SCALE1*A( 2, 1 ), CSR, SNR, T )
END IF
SNR = -SNR
CALL SROT( 2, A( 1, 1 ), 1, A( 1, 2 ), 1, CSR, SNR )
CALL SROT( 2, B( 1, 1 ), 1, B( 1, 2 ), 1, CSR, SNR )
H1 = MAX( ABS( A( 1, 1 ) )+ABS( A( 1, 2 ) ),
$ ABS( A( 2, 1 ) )+ABS( A( 2, 2 ) ) )
H2 = MAX( ABS( B( 1, 1 ) )+ABS( B( 1, 2 ) ),
$ ABS( B( 2, 1 ) )+ABS( B( 2, 2 ) ) )
IF( ( SCALE1*H1 ).GE.ABS( WR1 )*H2 ) THEN
CALL SLARTG( B( 1, 1 ), B( 2, 1 ), CSL, SNL, R )
ELSE
CALL SLARTG( A( 1, 1 ), A( 2, 1 ), CSL, SNL, R )
END IF
CALL SROT( 2, A( 1, 1 ), LDA, A( 2, 1 ), LDA, CSL, SNL )
CALL SROT( 2, B( 1, 1 ), LDB, B( 2, 1 ), LDB, CSL, SNL )
A( 2, 1 ) = ZERO
B( 2, 1 ) = ZERO
ELSE
CALL SLASV2( B( 1, 1 ), B( 1, 2 ), B( 2, 2 ), R, T, SNR,
$ CSR, SNL, CSL )
CALL SROT( 2, A( 1, 1 ), LDA, A( 2, 1 ), LDA, CSL, SNL )
CALL SROT( 2, B( 1, 1 ), LDB, B( 2, 1 ), LDB, CSL, SNL )
CALL SROT( 2, A( 1, 1 ), 1, A( 1, 2 ), 1, CSR, SNR )
CALL SROT( 2, B( 1, 1 ), 1, B( 1, 2 ), 1, CSR, SNR )
B( 2, 1 ) = ZERO
B( 1, 2 ) = ZERO
END IF
END IF
A( 1, 1 ) = ANORM*A( 1, 1 )
A( 2, 1 ) = ANORM*A( 2, 1 )
A( 1, 2 ) = ANORM*A( 1, 2 )
A( 2, 2 ) = ANORM*A( 2, 2 )
B( 1, 1 ) = BNORM*B( 1, 1 )
B( 2, 1 ) = BNORM*B( 2, 1 )
B( 1, 2 ) = BNORM*B( 1, 2 )
B( 2, 2 ) = BNORM*B( 2, 2 )
IF( WI.EQ.ZERO ) THEN
ALPHAR( 1 ) = A( 1, 1 )
ALPHAR( 2 ) = A( 2, 2 )
ALPHAI( 1 ) = ZERO
ALPHAI( 2 ) = ZERO
BETA( 1 ) = B( 1, 1 )
BETA( 2 ) = B( 2, 2 )
ELSE
ALPHAR( 1 ) = ANORM*WR1 / SCALE1 / BNORM
ALPHAI( 1 ) = ANORM*WI / SCALE1 / BNORM
ALPHAR( 2 ) = ALPHAR( 1 )
ALPHAI( 2 ) = -ALPHAI( 1 )
BETA( 1 ) = ONE
BETA( 2 ) = ONE
END IF
RETURN
END