77 SUBROUTINE dget35( RMAX, LMAX, NINFO, KNT )
84 INTEGER KNT, LMAX, NINFO
91 DOUBLE PRECISION ZERO, ONE
92 parameter( zero = 0.0d0, one = 1.0d0 )
93 DOUBLE PRECISION TWO, FOUR
94 parameter( two = 2.0d0, four = 4.0d0 )
97 CHARACTER TRANA, TRANB
98 INTEGER I, IMA, IMB, IMLDA1, IMLDA2, IMLDB1, IMLOFF,
99 $ INFO, ISGN, ITRANA, ITRANB, J, M, N
100 DOUBLE PRECISION BIGNUM, CNRM, EPS, RES, RES1, RMUL, SCALE,
104 INTEGER IDIM( 8 ), IVAL( 6, 6, 8 )
105 DOUBLE PRECISION A( 6, 6 ), B( 6, 6 ), C( 6, 6 ), CC( 6, 6 ),
106 $ DUM( 1 ), VM1( 3 ), VM2( 3 )
109 DOUBLE PRECISION DLAMCH, DLANGE
110 EXTERNAL dlamch, dlange
116 INTRINSIC abs, dble, max, 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 = dlamch(
'S' )*four / eps
135 bignum = one / smlnum
136 CALL dlabad( 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( dble( i*j ) )
208 cnrm = max( cnrm, c( i, j ) )
209 cc( i, j ) = c( i, j )
213 CALL dtrsyl( trana, tranb, isgn, m, n,
214 $ a, 6, b, 6, c, 6, scale,
218 xnrm = dlange(
'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 dgemm( trana,
'N', m, n, m, rmul,
227 $ a, 6, c, 6, -scale*rmul,
229 CALL dgemm(
'N', tranb, m, n, n,
230 $ dble( isgn )*rmul, c, 6, b,
232 res1 = dlange(
'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 dlabad(SMALL, LARGE)
DLABAD
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
subroutine dget35(RMAX, LMAX, NINFO, KNT)
DGET35
subroutine dtrsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
DTRSYL