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 )
113 EXTERNAL slamch, slange
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
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
subroutine slabad(SMALL, LARGE)
SLABAD