1 SUBROUTINE dlanv2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN )
9 DOUBLE PRECISION A, B, C, CS, D, RT1I, RT1R, RT2I, RT2R, SN
59 DOUBLE PRECISION ZERO, HALF, ONE
60 parameter( zero = 0.0d+0, half = 0.5d+0, one = 1.0d+0 )
61 DOUBLE PRECISION MULTPL
62 parameter( multpl = 4.0d+0 )
65 DOUBLE PRECISION AA, BB, BCMAX, BCMIS, CC, CS1, DD, EPS, P, SAB,
66 $ SAC, SCALE, SIGMA, SN1, TAU, TEMP, Z
69 DOUBLE PRECISION DLAMCH, DLAPY2
70 EXTERNAL dlamch, dlapy2
73 INTRINSIC abs, max, min, sign, sqrt
83 ELSE IF( b.EQ.zero )
THEN
95 ELSE IF( ( a-d ).EQ.zero .AND. sign( one, b ).NE.sign( one, c ) )
104 bcmax = max( abs( b ), abs( c ) )
105 bcmis = min( abs( b ), abs( c ) )*sign( one, b )*sign( one, c )
106 scale = max( abs( p ), bcmax )
107 z = ( p / scale )*p + ( bcmax / scale )*bcmis
112 IF( z.GE.multpl*eps )
THEN
116 z = p + sign( sqrt( scale )*sqrt( z ), p )
118 d = d - ( bcmax / z )*bcmis
133 tau = dlapy2( sigma, temp )
134 cs = sqrt( half*( one+abs( sigma ) / tau ) )
135 sn = -( p / ( tau*cs ) )*sign( one, sigma )
159 IF( sign( one, b ).EQ.sign( one, c ) )
THEN
163 sab = sqrt( abs( b ) )
164 sac = sqrt( abs( c ) )
165 p = sign( sab*sac, c )
166 tau = one / sqrt( abs( b+c ) )
173 temp = cs*cs1 - sn*sn1
199 rt1i = sqrt( abs( b ) )*sqrt( abs( c ) )
subroutine dlanv2(A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN)