77 SUBROUTINE sget35( RMAX, LMAX, NINFO, KNT )
84 INTEGER KNT, LMAX, NINFO
92 parameter( zero = 0.0e0, one = 1.0e0 )
94 parameter( two = 2.0e0, four = 4.0e0 )
97 CHARACTER TRANA, TRANB
98 INTEGER I, IMA, IMB, IMLDA1, IMLDA2, IMLDB1, IMLOFF,
99 $ INFO, ISGN, ITRANA, ITRANB, J, M, N
100 REAL BIGNUM, CNRM, EPS, RES, RES1, RMUL, SCALE,
104 INTEGER IDIM( 8 ), IVAL( 6, 6, 8 )
105 REAL A( 6, 6 ), B( 6, 6 ), C( 6, 6 ), CC( 6, 6 ),
106 $ DUM( 1 ), VM1( 3 ), VM2( 3 )
110 EXTERNAL slamch, slange
116 INTRINSIC abs, max, real, sin, sqrt
119 DATA idim / 1, 2, 3, 4, 3, 3, 6, 4 /
120 DATA ival / 1, 35*0, 1, 2, 4*0, -2, 0, 28*0, 1, 5*0,
121 $ 5, 1, 2, 3*0, -8, -2, 1, 21*0, 3, 4, 4*0, -5,
122 $ 3, 4*0, 1, 2, 1, 4, 2*0, -3, -9, -1, 1, 14*0,
123 $ 1, 5*0, 2, 3, 4*0, 5, 6, 7, 21*0, 1, 5*0, 1, 3,
124 $ -4, 3*0, 2, 5, 2, 21*0, 1, 2, 4*0, -2, 0, 4*0,
125 $ 5, 6, 3, 4, 2*0, -1, -9, -5, 2, 2*0, 4*8, 5, 6,
126 $ 4*9, -7, 5, 1, 5*0, 1, 5, 2, 3*0, 2, -21, 5,
127 $ 3*0, 1, 2, 3, 4, 14*0 /
134 smlnum = slamch(
'S' )*four / eps
135 bignum = one / smlnum
136 CALL slabad( smlnum, bignum )
140 vm1( 1 ) = sqrt( smlnum )
142 vm1( 3 ) = sqrt( bignum )
144 vm2( 2 ) = one + two*eps
156 DO 130 isgn = -1, 1, 2
176 a( i, j ) = ival( i, j, ima )
177 IF( abs( i-j ).LE.1 )
THEN
178 a( i, j ) = a( i, j )*
180 a( i, j ) = a( i, j )*
183 a( i, j ) = a( i, j )*
192 b( i, j ) = ival( i, j, imb )
193 IF( abs( i-j ).LE.1 )
THEN
194 b( i, j ) = b( i, j )*
197 b( i, j ) = b( i, j )*
207 c( i, j ) = sin( real( i*j ) )
208 cnrm = max( cnrm, c( i, j ) )
209 cc( i, j ) = c( i, j )
213 CALL strsyl( trana, tranb, isgn, m, n,
214 $ a, 6, b, 6, c, 6, scale,
218 xnrm = slange(
'M', m, n, c, 6, dum )
220 IF( xnrm.GT.one .AND. tnrm.GT.one )
222 IF( xnrm.GT.bignum / tnrm )
THEN
223 rmul = one / max( xnrm, tnrm )
226 CALL sgemm( trana,
'N', m, n, m, rmul,
227 $ a, 6, c, 6, -scale*rmul,
229 CALL sgemm(
'N', tranb, m, n, n,
230 $ real( isgn )*rmul, c, 6, b,
232 res1 = slange(
'M', m, n, cc, 6, dum )
233 res = res1 / max( smlnum, smlnum*xnrm,
234 $ ( ( rmul*tnrm )*eps )*xnrm )
235 IF( res.GT.rmax )
THEN
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine strsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
STRSYL
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
subroutine sget35(RMAX, LMAX, NINFO, KNT)
SGET35