LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
dget35.f
Go to the documentation of this file.
1*> \brief \b DGET35
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE DGET35( RMAX, LMAX, NINFO, KNT )
12*
13* .. Scalar Arguments ..
14* INTEGER KNT, LMAX, NINFO
15* DOUBLE PRECISION RMAX
16* ..
17*
18*
19*> \par Purpose:
20* =============
21*>
22*> \verbatim
23*>
24*> DGET35 tests DTRSYL, a routine for solving the Sylvester matrix
25*> equation
26*>
27*> op(A)*X + ISGN*X*op(B) = scale*C,
28*>
29*> A and B are assumed to be in Schur canonical form, op() represents an
30*> optional transpose, and ISGN can be -1 or +1. Scale is an output
31*> less than or equal to 1, chosen to avoid overflow in X.
32*>
33*> The test code verifies that the following residual is order 1:
34*>
35*> norm(op(A)*X + ISGN*X*op(B) - scale*C) /
36*> (EPS*max(norm(A),norm(B))*norm(X))
37*> \endverbatim
38*
39* Arguments:
40* ==========
41*
42*> \param[out] RMAX
43*> \verbatim
44*> RMAX is DOUBLE PRECISION
45*> Value of the largest test ratio.
46*> \endverbatim
47*>
48*> \param[out] LMAX
49*> \verbatim
50*> LMAX is INTEGER
51*> Example number where largest test ratio achieved.
52*> \endverbatim
53*>
54*> \param[out] NINFO
55*> \verbatim
56*> NINFO is INTEGER
57*> Number of examples where INFO is nonzero.
58*> \endverbatim
59*>
60*> \param[out] KNT
61*> \verbatim
62*> KNT is INTEGER
63*> Total number of examples tested.
64*> \endverbatim
65*
66* Authors:
67* ========
68*
69*> \author Univ. of Tennessee
70*> \author Univ. of California Berkeley
71*> \author Univ. of Colorado Denver
72*> \author NAG Ltd.
73*
74*> \ingroup double_eig
75*
76* =====================================================================
77 SUBROUTINE dget35( RMAX, LMAX, NINFO, KNT )
78*
79* -- LAPACK test routine --
80* -- LAPACK is a software package provided by Univ. of Tennessee, --
81* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
82*
83* .. Scalar Arguments ..
84 INTEGER KNT, LMAX, NINFO
85 DOUBLE PRECISION RMAX
86* ..
87*
88* =====================================================================
89*
90* .. Parameters ..
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 )
95* ..
96* .. Local Scalars ..
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,
101 $ SMLNUM, TNRM, XNRM
102* ..
103* .. Local Arrays ..
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 )
107* ..
108* .. External Functions ..
109 DOUBLE PRECISION DLAMCH, DLANGE
110 EXTERNAL dlamch, dlange
111* ..
112* .. External Subroutines ..
113 EXTERNAL dgemm, dtrsyl
114* ..
115* .. Intrinsic Functions ..
116 INTRINSIC abs, dble, max, sin, sqrt
117* ..
118* .. Data statements ..
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 /
128* ..
129* .. Executable Statements ..
130*
131* Get machine parameters
132*
133 eps = dlamch( 'P' )
134 smlnum = dlamch( 'S' )*four / eps
135 bignum = one / smlnum
136*
137* Set up test case parameters
138*
139 vm1( 1 ) = sqrt( smlnum )
140 vm1( 2 ) = one
141 vm1( 3 ) = sqrt( bignum )
142 vm2( 1 ) = one
143 vm2( 2 ) = one + two*eps
144 vm2( 3 ) = two
145*
146 knt = 0
147 ninfo = 0
148 lmax = 0
149 rmax = zero
150*
151* Begin test loop
152*
153 DO 150 itrana = 1, 2
154 DO 140 itranb = 1, 2
155 DO 130 isgn = -1, 1, 2
156 DO 120 ima = 1, 8
157 DO 110 imlda1 = 1, 3
158 DO 100 imlda2 = 1, 3
159 DO 90 imloff = 1, 2
160 DO 80 imb = 1, 8
161 DO 70 imldb1 = 1, 3
162 IF( itrana.EQ.1 )
163 $ trana = 'N'
164 IF( itrana.EQ.2 )
165 $ trana = 'T'
166 IF( itranb.EQ.1 )
167 $ tranb = 'N'
168 IF( itranb.EQ.2 )
169 $ tranb = 'T'
170 m = idim( ima )
171 n = idim( imb )
172 tnrm = zero
173 DO 20 i = 1, m
174 DO 10 j = 1, m
175 a( i, j ) = ival( i, j, ima )
176 IF( abs( i-j ).LE.1 ) THEN
177 a( i, j ) = a( i, j )*
178 $ vm1( imlda1 )
179 a( i, j ) = a( i, j )*
180 $ vm2( imlda2 )
181 ELSE
182 a( i, j ) = a( i, j )*
183 $ vm1( imloff )
184 END IF
185 tnrm = max( tnrm,
186 $ abs( a( i, j ) ) )
187 10 CONTINUE
188 20 CONTINUE
189 DO 40 i = 1, n
190 DO 30 j = 1, n
191 b( i, j ) = ival( i, j, imb )
192 IF( abs( i-j ).LE.1 ) THEN
193 b( i, j ) = b( i, j )*
194 $ vm1( imldb1 )
195 ELSE
196 b( i, j ) = b( i, j )*
197 $ vm1( imloff )
198 END IF
199 tnrm = max( tnrm,
200 $ abs( b( i, j ) ) )
201 30 CONTINUE
202 40 CONTINUE
203 cnrm = zero
204 DO 60 i = 1, m
205 DO 50 j = 1, n
206 c( i, j ) = sin( dble( i*j ) )
207 cnrm = max( cnrm, c( i, j ) )
208 cc( i, j ) = c( i, j )
209 50 CONTINUE
210 60 CONTINUE
211 knt = knt + 1
212 CALL dtrsyl( trana, tranb, isgn, m, n,
213 $ a, 6, b, 6, c, 6, scale,
214 $ info )
215 IF( info.NE.0 )
216 $ ninfo = ninfo + 1
217 xnrm = dlange( 'M', m, n, c, 6, dum )
218 rmul = one
219 IF( xnrm.GT.one .AND. tnrm.GT.one )
220 $ THEN
221 IF( xnrm.GT.bignum / tnrm ) THEN
222 rmul = one / max( xnrm, tnrm )
223 END IF
224 END IF
225 CALL dgemm( trana, 'N', m, n, m, rmul,
226 $ a, 6, c, 6, -scale*rmul,
227 $ cc, 6 )
228 CALL dgemm( 'N', tranb, m, n, n,
229 $ dble( isgn )*rmul, c, 6, b,
230 $ 6, one, cc, 6 )
231 res1 = dlange( 'M', m, n, cc, 6, dum )
232 res = res1 / max( smlnum, smlnum*xnrm,
233 $ ( ( rmul*tnrm )*eps )*xnrm )
234 IF( res.GT.rmax ) THEN
235 lmax = knt
236 rmax = res
237 END IF
238 70 CONTINUE
239 80 CONTINUE
240 90 CONTINUE
241 100 CONTINUE
242 110 CONTINUE
243 120 CONTINUE
244 130 CONTINUE
245 140 CONTINUE
246 150 CONTINUE
247*
248 RETURN
249*
250* End of DGET35
251*
252 END
dget35
subroutine dget35(rmax, lmax, ninfo, knt)
DGET35
Definition dget35.f:78
dgemm
subroutine dgemm(transa, transb, m, n, k, alpha, a, lda, b, ldb, beta, c, ldc)
DGEMM
Definition dgemm.f:188
dtrsyl
subroutine dtrsyl(trana, tranb, isgn, m, n, a, lda, b, ldb, c, ldc, scale, info)
DTRSYL
Definition dtrsyl.f:164