79 SUBROUTINE sget35( RMAX, LMAX, NINFO, KNT )
87 INTEGER knt, lmax, ninfo
95 parameter( zero = 0.0e0, one = 1.0e0 )
97 parameter( two = 2.0e0, four = 4.0e0 )
100 CHARACTER trana, tranb
101 INTEGER i, ima, imb, imlda1, imlda2, imldb1, imloff,
102 $ info, isgn, itrana, itranb, j, m, n
103 REAL bignum, cnrm, eps, res, res1, rmul, scale,
107 INTEGER idim( 8 ), ival( 6, 6, 8 )
108 REAL a( 6, 6 ), b( 6, 6 ), c( 6, 6 ), cc( 6, 6 ),
109 $ dum( 1 ), vm1( 3 ), vm2( 3 )
119 INTRINSIC abs, max,
REAL, sin, sqrt
122 DATA idim / 1, 2, 3, 4, 3, 3, 6, 4 /
123 DATA ival / 1, 35*0, 1, 2, 4*0, -2, 0, 28*0, 1, 5*0,
124 $ 5, 1, 2, 3*0, -8, -2, 1, 21*0, 3, 4, 4*0, -5,
125 $ 3, 4*0, 1, 2, 1, 4, 2*0, -3, -9, -1, 1, 14*0,
126 $ 1, 5*0, 2, 3, 4*0, 5, 6, 7, 21*0, 1, 5*0, 1, 3,
127 $ -4, 3*0, 2, 5, 2, 21*0, 1, 2, 4*0, -2, 0, 4*0,
128 $ 5, 6, 3, 4, 2*0, -1, -9, -5, 2, 2*0, 4*8, 5, 6,
129 $ 4*9, -7, 5, 1, 5*0, 1, 5, 2, 3*0, 2, -21, 5,
130 $ 3*0, 1, 2, 3, 4, 14*0 /
137 smlnum =
slamch(
'S' )*four / eps
138 bignum = one / smlnum
139 CALL
slabad( smlnum, bignum )
143 vm1( 1 ) = sqrt( smlnum )
145 vm1( 3 ) = sqrt( bignum )
147 vm2( 2 ) = one + two*eps
159 DO 130 isgn = -1, 1, 2
179 a( i, j ) = ival( i, j, ima )
180 IF( abs( i-j ).LE.1 )
THEN
181 a( i, j ) = a( i, j )*
183 a( i, j ) = a( i, j )*
186 a( i, j ) = a( i, j )*
195 b( i, j ) = ival( i, j, imb )
196 IF( abs( i-j ).LE.1 )
THEN
197 b( i, j ) = b( i, j )*
200 b( i, j ) = b( i, j )*
210 c( i, j ) = sin(
REAL( I*J ) )
211 cnrm = max( cnrm, c( i, j ) )
212 cc( i, j ) = c( i, j )
216 CALL
strsyl( trana, tranb, isgn, m, n,
217 $ a, 6, b, 6, c, 6, scale,
221 xnrm =
slange(
'M', m, n, c, 6, dum )
223 IF( xnrm.GT.one .AND. tnrm.GT.one )
225 IF( xnrm.GT.bignum / tnrm )
THEN
226 rmul = one / max( xnrm, tnrm )
229 CALL
sgemm( trana,
'N', m, n, m, rmul,
230 $ a, 6, c, 6, -scale*rmul,
232 CALL
sgemm(
'N', tranb, m, n, n,
233 $
REAL( isgn )*rmul, c, 6, b,
235 res1 =
slange(
'M', m, n, cc, 6, dum )
236 res = res1 / max( smlnum, smlnum*xnrm,
237 $ ( ( rmul*tnrm )*eps )*xnrm )
238 IF( res.GT.rmax )
THEN