77 SUBROUTINE sget33( RMAX, LMAX, NINFO, KNT )
85 INTEGER knt, lmax, ninfo
93 parameter( zero = 0.0e0, one = 1.0e0 )
95 parameter( two = 2.0e0, four = 4.0e0 )
98 INTEGER i1, i2, i3, i4, im1, im2, im3, im4, j1, j2, j3
99 REAL bignum, cs, eps, res, smlnum, sn, sum, tnrm,
103 REAL q( 2, 2 ), t( 2, 2 ), t1( 2, 2 ), t2( 2, 2 ),
114 INTRINSIC abs, max, sign
121 smlnum =
slamch(
'S' ) / eps
122 bignum = one / smlnum
123 CALL
slabad( smlnum, bignum )
128 val( 2 ) = one + two*eps
130 val( 4 ) = two - four*eps
150 t( 1, 1 ) = val( i1 )*vm( im1 )
151 t( 1, 2 ) = val( i2 )*vm( im2 )
152 t( 2, 1 ) = -val( i3 )*vm( im3 )
153 t( 2, 2 ) = val( i4 )*vm( im4 )
154 tnrm = max( abs( t( 1, 1 ) ),
155 $ abs( t( 1, 2 ) ), abs( t( 2, 1 ) ),
157 t1( 1, 1 ) = t( 1, 1 )
158 t1( 1, 2 ) = t( 1, 2 )
159 t1( 2, 1 ) = t( 2, 1 )
160 t1( 2, 2 ) = t( 2, 2 )
166 CALL
slanv2( t( 1, 1 ), t( 1, 2 ),
167 $ t( 2, 1 ), t( 2, 2 ), wr1,
168 $ wi1, wr2, wi2, cs, sn )
170 res = q( j1, 1 )*cs + q( j1, 2 )*sn
171 q( j1, 2 ) = -q( j1, 1 )*sn +
177 res = res + abs( q( 1, 1 )**2+
178 $ q( 1, 2 )**2-one ) / eps
179 res = res + abs( q( 2, 2 )**2+
180 $ q( 2, 1 )**2-one ) / eps
181 res = res + abs( q( 1, 1 )*q( 2, 1 )+
182 $ q( 1, 2 )*q( 2, 2 ) ) / eps
187 t2( j1, j2 ) = t2( j1, j2 ) +
197 sum = sum - q( j3, j1 )*
200 res = res + abs( sum ) / eps / tnrm
203 IF( t( 2, 1 ).NE.zero .AND.
204 $ ( t( 1, 1 ).NE.t( 2,
205 $ 2 ) .OR. sign( one, t( 1,
206 $ 2 ) )*sign( one, t( 2,
207 $ 1 ) ).GT.zero ) )res = res + one / eps
209 IF( res.GT.rmax )
THEN