128 SUBROUTINE slanv2( A, B, C, D, RT1R, RT1I, RT2R, RT2I, CS, SN )
136 REAL a, b, c, cs, d, rt1i, rt1r, rt2i, rt2r, sn
143 parameter( zero = 0.0e+0, half = 0.5e+0, one = 1.0e+0 )
145 parameter( multpl = 4.0e+0 )
148 REAL aa, bb, bcmax, bcmis, cc, cs1, dd, eps, p, sab,
149 $ sac, scale, sigma, sn1, tau, temp, z
156 INTRINSIC abs, max, min, sign, sqrt
166 ELSE IF( b.EQ.zero )
THEN
178 ELSE IF( (a-d).EQ.zero .AND. sign( one, b ).NE.
179 $ sign( one, c ) )
THEN
187 bcmax = max( abs( b ), abs( c ) )
188 bcmis = min( abs( b ), abs( c ) )*sign( one, b )*sign( one, c )
189 scale = max( abs( p ), bcmax )
190 z = ( p / scale )*p + ( bcmax / scale )*bcmis
195 IF( z.GE.multpl*eps )
THEN
199 z = p + sign( sqrt( scale )*sqrt( z ), p )
201 d = d - ( bcmax / z )*bcmis
216 tau =
slapy2( sigma, temp )
217 cs = sqrt( half*( one+abs( sigma ) / tau ) )
218 sn = -( p / ( tau*cs ) )*sign( one, sigma )
242 IF( sign( one, b ).EQ.sign( one, c ) )
THEN
246 sab = sqrt( abs( b ) )
247 sac = sqrt( abs( c ) )
248 p = sign( sab*sac, c )
249 tau = one / sqrt( abs( b+c ) )
256 temp = cs*cs1 - sn*sn1
282 rt1i = sqrt( abs( b ) )*sqrt( abs( c ) )