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
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
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
real function slamch(CMACH)
SLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine sget35(RMAX, LMAX, NINFO, KNT)
SGET35