LAPACK  3.10.1 LAPACK: Linear Algebra PACKage
sget35.f
Go to the documentation of this file.
1 *> \brief \b SGET35
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 SGET35( RMAX, LMAX, NINFO, KNT )
12 *
13 * .. Scalar Arguments ..
14 * INTEGER KNT, LMAX, NINFO
15 * REAL RMAX
16 * ..
17 *
18 *
19 *> \par Purpose:
20 * =============
21 *>
22 *> \verbatim
23 *>
24 *> SGET35 tests STRSYL, 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 REAL
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 single_eig
75 *
76 * =====================================================================
77  SUBROUTINE sget35( 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  REAL RMAX
86 * ..
87 *
88 * =====================================================================
89 *
90 * .. Parameters ..
91  REAL ZERO, ONE
92  parameter( zero = 0.0e0, one = 1.0e0 )
93  REAL TWO, FOUR
94  parameter( two = 2.0e0, four = 4.0e0 )
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  REAL BIGNUM, CNRM, EPS, RES, RES1, RMUL, SCALE,
101  \$ SMLNUM, TNRM, XNRM
102 * ..
103 * .. Local Arrays ..
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 )
107 * ..
108 * .. External Functions ..
109  REAL SLAMCH, SLANGE
110  EXTERNAL slamch, slange
111 * ..
112 * .. External Subroutines ..
113  EXTERNAL sgemm, strsyl
114 * ..
115 * .. Intrinsic Functions ..
116  INTRINSIC abs, max, real, 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 = slamch( 'P' )
134  smlnum = slamch( 'S' )*four / eps
135  bignum = one / smlnum
136  CALL slabad( smlnum, bignum )
137 *
138 * Set up test case parameters
139 *
140  vm1( 1 ) = sqrt( smlnum )
141  vm1( 2 ) = one
142  vm1( 3 ) = sqrt( bignum )
143  vm2( 1 ) = one
144  vm2( 2 ) = one + two*eps
145  vm2( 3 ) = two
146 *
147  knt = 0
148  ninfo = 0
149  lmax = 0
150  rmax = zero
151 *
152 * Begin test loop
153 *
154  DO 150 itrana = 1, 2
155  DO 140 itranb = 1, 2
156  DO 130 isgn = -1, 1, 2
157  DO 120 ima = 1, 8
158  DO 110 imlda1 = 1, 3
159  DO 100 imlda2 = 1, 3
160  DO 90 imloff = 1, 2
161  DO 80 imb = 1, 8
162  DO 70 imldb1 = 1, 3
163  IF( itrana.EQ.1 )
164  \$ trana = 'N'
165  IF( itrana.EQ.2 )
166  \$ trana = 'T'
167  IF( itranb.EQ.1 )
168  \$ tranb = 'N'
169  IF( itranb.EQ.2 )
170  \$ tranb = 'T'
171  m = idim( ima )
172  n = idim( imb )
173  tnrm = zero
174  DO 20 i = 1, m
175  DO 10 j = 1, m
176  a( i, j ) = ival( i, j, ima )
177  IF( abs( i-j ).LE.1 ) THEN
178  a( i, j ) = a( i, j )*
179  \$ vm1( imlda1 )
180  a( i, j ) = a( i, j )*
181  \$ vm2( imlda2 )
182  ELSE
183  a( i, j ) = a( i, j )*
184  \$ vm1( imloff )
185  END IF
186  tnrm = max( tnrm,
187  \$ abs( a( i, j ) ) )
188  10 CONTINUE
189  20 CONTINUE
190  DO 40 i = 1, n
191  DO 30 j = 1, n
192  b( i, j ) = ival( i, j, imb )
193  IF( abs( i-j ).LE.1 ) THEN
194  b( i, j ) = b( i, j )*
195  \$ vm1( imldb1 )
196  ELSE
197  b( i, j ) = b( i, j )*
198  \$ vm1( imloff )
199  END IF
200  tnrm = max( tnrm,
201  \$ abs( b( i, j ) ) )
202  30 CONTINUE
203  40 CONTINUE
204  cnrm = zero
205  DO 60 i = 1, m
206  DO 50 j = 1, n
207  c( i, j ) = sin( real( i*j ) )
208  cnrm = max( cnrm, c( i, j ) )
209  cc( i, j ) = c( i, j )
210  50 CONTINUE
211  60 CONTINUE
212  knt = knt + 1
213  CALL strsyl( trana, tranb, isgn, m, n,
214  \$ a, 6, b, 6, c, 6, scale,
215  \$ info )
216  IF( info.NE.0 )
217  \$ ninfo = ninfo + 1
218  xnrm = slange( 'M', m, n, c, 6, dum )
219  rmul = one
220  IF( xnrm.GT.one .AND. tnrm.GT.one )
221  \$ THEN
222  IF( xnrm.GT.bignum / tnrm ) THEN
223  rmul = one / max( xnrm, tnrm )
224  END IF
225  END IF
226  CALL sgemm( trana, 'N', m, n, m, rmul,
227  \$ a, 6, c, 6, -scale*rmul,
228  \$ cc, 6 )
229  CALL sgemm( 'N', tranb, m, n, n,
230  \$ real( isgn )*rmul, c, 6, b,
231  \$ 6, one, cc, 6 )
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
236  lmax = knt
237  rmax = res
238  END IF
239  70 CONTINUE
240  80 CONTINUE
241  90 CONTINUE
242  100 CONTINUE
243  110 CONTINUE
244  120 CONTINUE
245  130 CONTINUE
246  140 CONTINUE
247  150 CONTINUE
248 *
249  RETURN
250 *
251 * End of SGET35
252 *
253  END