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
136 INTRINSIC abs, aimag, cmplx, conjg, int, log, max,
REAL,
149 abs1( ff ) = max( abs(
REAL( FF ) ), abs( aimag( ff ) ) )
150 abssq( ff ) =
REAL( ff )**2 + aimag( ff )**2
157 safmn2 =
slamch(
'B' )**int( log( safmin / eps ) /
158 $ log(
slamch(
'B' ) ) / two )
159 safmx2 = one / safmn2
162 scale = max( abs1( f ), abs1( g ) )
166 IF( scale.GE.safmx2 )
THEN
172 IF( scale.GE.safmx2 )
174 ELSE IF( scale.LE.safmn2 )
THEN
175 IF( g.EQ.czero )
THEN
186 IF( scale.LE.safmn2 )
191 IF( f2.LE.max( g2, one )*safmin )
THEN
195 IF( f.EQ.czero )
THEN
197 r =
slapy2(
REAL( G ), aimag( g ) )
199 d =
slapy2(
REAL( GS ), aimag( gs ) )
200 sn = cmplx(
REAL( GS ) / d, -aimag( gs ) / d )
203 f2s =
slapy2(
REAL( FS ), aimag( fs ) )
217 IF( abs1( f ).GT.one )
THEN
218 d =
slapy2(
REAL( F ), aimag( f ) )
219 ff = cmplx(
REAL( F ) / d, aimag( f ) / d )
221 dr = safmx2*
REAL( f )
222 di = safmx2*aimag( f )
224 ff = cmplx( dr / d, di / d )
226 sn = ff*cmplx(
REAL( GS ) / g2s, -aimag( gs ) / g2s )
234 f2s = sqrt( one+g2 / f2 )
236 r = cmplx( f2s*
REAL( FS ), f2s*aimag( fs ) )
240 sn = cmplx(
REAL( R ) / d, aimag( r ) / d )
242 IF( count.NE.0 )
THEN
243 IF( count.GT.0 )
THEN