1 SUBROUTINE zlartg( F, G, CS, SN, R )
56 DOUBLE PRECISION two, one, zero
57 parameter( two = 2.0d+0, one = 1.0d+0, zero = 0.0d+0 )
59 parameter( czero = ( 0.0d+0, 0.0d+0 ) )
64 DOUBLE PRECISION d, di, dr, eps, f2, f2s, g2, g2s, safmin,
65 $ safmn2, safmx2, scale
69 DOUBLE PRECISION dlamch, dlapy2
70 EXTERNAL dlamch, dlapy2
73 INTRINSIC abs, dble, dcmplx, dconjg, dimag, int, log,
77 DOUBLE PRECISION abs1, abssq
86 abs1( ff ) =
max( abs( dble( ff ) ), abs( dimag( ff ) ) )
87 abssq( ff ) = dble( ff )**2 + dimag( ff )**2
92 safmin = dlamch(
'S' )
94 safmn2 = dlamch(
'B' )**int( log( safmin / eps ) /
95 $ log( dlamch(
'B' ) ) / two )
99 scale =
max( abs1( f ), abs1( g ) )
103 IF( scale.GE.safmx2 )
THEN
109 IF( scale.GE.safmx2 )
111 ELSE IF( scale.LE.safmn2 )
THEN
112 IF( g.EQ.czero )
THEN
123 IF( scale.LE.safmn2 )
128 IF( f2.LE.
max( g2, one )*safmin )
THEN
132 IF( f.EQ.czero )
THEN
134 r = dlapy2( dble( g ), dimag( g ) )
136 d = dlapy2( dble( gs ), dimag( gs ) )
137 sn = dcmplx( dble( gs ) / d, -dimag( gs ) / d )
140 f2s = dlapy2( dble( fs ), dimag( fs ) )
154 IF( abs1( f ).GT.one )
THEN
155 d = dlapy2( dble( f ), dimag( f ) )
156 ff = dcmplx( dble( f ) / d, dimag( f ) / d )
158 dr = safmx2*dble( f )
159 di = safmx2*dimag( f )
161 ff = dcmplx( dr / d, di / d )
163 sn = ff*dcmplx( dble( gs ) / g2s, -dimag( gs ) / g2s )
171 f2s = sqrt( one+g2 / f2 )
173 r = dcmplx( f2s*dble( fs ), f2s*dimag( fs ) )
177 sn = dcmplx( dble( r ) / d, dimag( r ) / d )
179 IF( count.NE.0 )
THEN
180 IF( count.GT.0 )
THEN