LAPACK  3.7.0 LAPACK: Linear Algebra PACKage
cget35.f
Go to the documentation of this file.
1 *> \brief \b CGET35
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 CGET35( RMAX, LMAX, NINFO, KNT, NIN )
12 *
13 * .. Scalar Arguments ..
14 * INTEGER KNT, LMAX, NIN, NINFO
15 * REAL RMAX
16 * ..
17 *
18 *
19 *> \par Purpose:
20 * =============
21 *>
22 *> \verbatim
23 *>
24 *> CGET35 tests CTRSYL, 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 *> \param[in] NIN
67 *> \verbatim
68 *> NIN is INTEGER
69 *> Input logical unit number.
70 *> \endverbatim
71 *
72 * Authors:
73 * ========
74 *
75 *> \author Univ. of Tennessee
76 *> \author Univ. of California Berkeley
77 *> \author Univ. of Colorado Denver
78 *> \author NAG Ltd.
79 *
80 *> \date December 2016
81 *
82 *> \ingroup complex_eig
83 *
84 * =====================================================================
85  SUBROUTINE cget35( RMAX, LMAX, NINFO, KNT, NIN )
86 *
87 * -- LAPACK test routine (version 3.7.0) --
88 * -- LAPACK is a software package provided by Univ. of Tennessee, --
89 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
90 * December 2016
91 *
92 * .. Scalar Arguments ..
93  INTEGER KNT, LMAX, NIN, NINFO
94  REAL RMAX
95 * ..
96 *
97 * =====================================================================
98 *
99 * .. Parameters ..
100  INTEGER LDT
101  parameter ( ldt = 10 )
102  REAL ZERO, ONE, TWO
103  parameter ( zero = 0.0e0, one = 1.0e0, two = 2.0e0 )
104  REAL LARGE
105  parameter ( large = 1.0e6 )
106  COMPLEX CONE
107  parameter ( cone = 1.0e0 )
108 * ..
109 * .. Local Scalars ..
110  CHARACTER TRANA, TRANB
111  INTEGER I, IMLA, IMLAD, IMLB, IMLC, INFO, ISGN, ITRANA,
112  \$ itranb, j, m, n
113  REAL BIGNUM, EPS, RES, RES1, SCALE, SMLNUM, TNRM,
114  \$ xnrm
115  COMPLEX RMUL
116 * ..
117 * .. Local Arrays ..
118  REAL DUM( 1 ), VM1( 3 ), VM2( 3 )
119  COMPLEX A( ldt, ldt ), ATMP( ldt, ldt ), B( ldt, ldt ),
120  \$ btmp( ldt, ldt ), c( ldt, ldt ),
121  \$ csav( ldt, ldt ), ctmp( ldt, ldt )
122 * ..
123 * .. External Functions ..
124  REAL CLANGE, SLAMCH
125  EXTERNAL clange, slamch
126 * ..
127 * .. External Subroutines ..
128  EXTERNAL cgemm, ctrsyl
129 * ..
130 * .. Intrinsic Functions ..
131  INTRINSIC abs, max, REAL, SQRT
132 * ..
133 * .. Executable Statements ..
134 *
135 * Get machine parameters
136 *
137  eps = slamch( 'P' )
138  smlnum = slamch( 'S' ) / eps
139  bignum = one / smlnum
140  CALL slabad( smlnum, bignum )
141 *
142 * Set up test case parameters
143 *
144  vm1( 1 ) = sqrt( smlnum )
145  vm1( 2 ) = one
146  vm1( 3 ) = large
147  vm2( 1 ) = one
148  vm2( 2 ) = one + two*eps
149  vm2( 3 ) = two
150 *
151  knt = 0
152  ninfo = 0
153  lmax = 0
154  rmax = zero
155 *
156 * Begin test loop
157 *
158  10 CONTINUE
159  READ( nin, fmt = * )m, n
160  IF( n.EQ.0 )
161  \$ RETURN
162  DO 20 i = 1, m
163  READ( nin, fmt = * )( atmp( i, j ), j = 1, m )
164  20 CONTINUE
165  DO 30 i = 1, n
166  READ( nin, fmt = * )( btmp( i, j ), j = 1, n )
167  30 CONTINUE
168  DO 40 i = 1, m
169  READ( nin, fmt = * )( ctmp( i, j ), j = 1, n )
170  40 CONTINUE
171  DO 170 imla = 1, 3
172  DO 160 imlad = 1, 3
173  DO 150 imlb = 1, 3
174  DO 140 imlc = 1, 3
175  DO 130 itrana = 1, 2
176  DO 120 itranb = 1, 2
177  DO 110 isgn = -1, 1, 2
178  IF( itrana.EQ.1 )
179  \$ trana = 'N'
180  IF( itrana.EQ.2 )
181  \$ trana = 'C'
182  IF( itranb.EQ.1 )
183  \$ tranb = 'N'
184  IF( itranb.EQ.2 )
185  \$ tranb = 'C'
186  tnrm = zero
187  DO 60 i = 1, m
188  DO 50 j = 1, m
189  a( i, j ) = atmp( i, j )*vm1( imla )
190  tnrm = max( tnrm, abs( a( i, j ) ) )
191  50 CONTINUE
192  a( i, i ) = a( i, i )*vm2( imlad )
193  tnrm = max( tnrm, abs( a( i, i ) ) )
194  60 CONTINUE
195  DO 80 i = 1, n
196  DO 70 j = 1, n
197  b( i, j ) = btmp( i, j )*vm1( imlb )
198  tnrm = max( tnrm, abs( b( i, j ) ) )
199  70 CONTINUE
200  80 CONTINUE
201  IF( tnrm.EQ.zero )
202  \$ tnrm = one
203  DO 100 i = 1, m
204  DO 90 j = 1, n
205  c( i, j ) = ctmp( i, j )*vm1( imlc )
206  csav( i, j ) = c( i, j )
207  90 CONTINUE
208  100 CONTINUE
209  knt = knt + 1
210  CALL ctrsyl( trana, tranb, isgn, m, n, a,
211  \$ ldt, b, ldt, c, ldt, scale,
212  \$ info )
213  IF( info.NE.0 )
214  \$ ninfo = ninfo + 1
215  xnrm = clange( 'M', m, n, c, ldt, dum )
216  rmul = cone
217  IF( xnrm.GT.one .AND. tnrm.GT.one ) THEN
218  IF( xnrm.GT.bignum / tnrm ) THEN
219  rmul = max( xnrm, tnrm )
220  rmul = cone / rmul
221  END IF
222  END IF
223  CALL cgemm( trana, 'N', m, n, m, rmul, a,
224  \$ ldt, c, ldt, -scale*rmul, csav,
225  \$ ldt )
226  CALL cgemm( 'N', tranb, m, n, n,
227  \$ REAL( isgn )*RMUL, C, LDT, B,
228  \$ ldt, cone, csav, ldt )
229  res1 = clange( 'M', m, n, csav, ldt, dum )
230  res = res1 / max( smlnum, smlnum*xnrm,
231  \$ ( ( abs( rmul )*tnrm )*eps )*xnrm )
232  IF( res.GT.rmax ) THEN
233  lmax = knt
234  rmax = res
235  END IF
236  110 CONTINUE
237  120 CONTINUE
238  130 CONTINUE
239  140 CONTINUE
240  150 CONTINUE
241  160 CONTINUE
242  170 CONTINUE
243  GO TO 10
244 *
245 * End of CGET35
246 *
247  END
subroutine ctrsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
CTRSYL
Definition: ctrsyl.f:159
subroutine cget35(RMAX, LMAX, NINFO, KNT, NIN)
CGET35
Definition: cget35.f:86