104 SUBROUTINE clartg( F, G, CS, SN, R )
120 parameter ( two = 2.0e+0, one = 1.0e+0, zero = 0.0e+0 )
122 parameter ( czero = ( 0.0e+0, 0.0e+0 ) )
127 REAL D, DI, DR, EPS, F2, F2S, G2, G2S, SAFMIN,
128 $ safmn2, safmx2, scale
134 EXTERNAL slamch, slapy2, sisnan
137 INTRINSIC abs, aimag, cmplx, conjg, int, log, max,
REAL,
144 abs1( ff ) = max( abs(
REAL( FF ) ), abs( AIMAG( ff ) ) )
145 abssq( ff ) =
REAL( ff )**2 + AIMAG( ff )**2
149 safmin = slamch(
'S' )
151 safmn2 = slamch(
'B' )**int( log( safmin / eps ) /
152 $ log( slamch(
'B' ) ) / two )
153 safmx2 = one / safmn2
154 scale = max( abs1( f ), abs1( g ) )
158 IF( scale.GE.safmx2 )
THEN
164 IF( scale.GE.safmx2 )
166 ELSE IF( scale.LE.safmn2 )
THEN
167 IF( g.EQ.czero.OR.sisnan( abs( g ) ) )
THEN
178 IF( scale.LE.safmn2 )
183 IF( f2.LE.max( g2, one )*safmin )
THEN
187 IF( f.EQ.czero )
THEN
189 r = slapy2(
REAL( G ), AIMAG( g ) )
191 d = slapy2(
REAL( GS ), AIMAG( gs ) )
192 sn = cmplx(
REAL( GS ) / D, -AIMAG( gs ) / D )
195 f2s = slapy2(
REAL( FS ), AIMAG( fs ) )
209 IF( abs1( f ).GT.one )
THEN
210 d = slapy2(
REAL( F ), AIMAG( f ) )
211 ff = cmplx(
REAL( F ) / D, AIMAG( f ) / D )
213 dr = safmx2*
REAL( f )
214 di = safmx2*aimag( f )
216 ff = cmplx( dr / d, di / d )
218 sn = ff*cmplx(
REAL( GS ) / G2S, -AIMAG( gs ) / G2S )
226 f2s = sqrt( one+g2 / f2 )
228 r = cmplx( f2s*
REAL( FS ), F2S*AIMAG( fs ) )
232 sn = cmplx(
REAL( R ) / D, AIMAG( r ) / D )
234 IF( count.NE.0 )
THEN
235 IF( count.GT.0 )
THEN
subroutine clartg(F, G, CS, SN, R)
CLARTG generates a plane rotation with real cosine and complex sine.