LAPACK  3.6.1 LAPACK: Linear Algebra PACKage
 subroutine zget35 ( double precision RMAX, integer LMAX, integer NINFO, integer KNT, integer NIN )

ZGET35

Purpose:
ZGET35 tests ZTRSYL, a routine for solving the Sylvester matrix
equation

op(A)*X + ISGN*X*op(B) = scale*C,

A and B are assumed to be in Schur canonical form, op() represents an
optional transpose, and ISGN can be -1 or +1.  Scale is an output
less than or equal to 1, chosen to avoid overflow in X.

The test code verifies that the following residual is order 1:

norm(op(A)*X + ISGN*X*op(B) - scale*C) /
(EPS*max(norm(A),norm(B))*norm(X))
Parameters
 [out] RMAX RMAX is DOUBLE PRECISION Value of the largest test ratio. [out] LMAX LMAX is INTEGER Example number where largest test ratio achieved. [out] NINFO NINFO is INTEGER Number of examples where INFO is nonzero. [out] KNT KNT is INTEGER Total number of examples tested. [in] NIN NIN is INTEGER Input logical unit number.
Date
November 2011

Definition at line 86 of file zget35.f.

86 *
87 * -- LAPACK test routine (version 3.4.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 * November 2011
91 *
92 * .. Scalar Arguments ..
93  INTEGER knt, lmax, nin, ninfo
94  DOUBLE PRECISION rmax
95 * ..
96 *
97 * =====================================================================
98 *
99 * .. Parameters ..
100  INTEGER ldt
101  parameter ( ldt = 10 )
102  DOUBLE PRECISION zero, one, two
103  parameter ( zero = 0.0d0, one = 1.0d0, two = 2.0d0 )
104  DOUBLE PRECISION large
105  parameter ( large = 1.0d6 )
106  COMPLEX*16 cone
107  parameter ( cone = 1.0d0 )
108 * ..
109 * .. Local Scalars ..
110  CHARACTER trana, tranb
111  INTEGER i, imla, imlad, imlb, imlc, info, isgn, itrana,
112  \$ itranb, j, m, n
113  DOUBLE PRECISION bignum, eps, res, res1, scale, smlnum, tnrm,
114  \$ xnrm
115  COMPLEX*16 rmul
116 * ..
117 * .. Local Arrays ..
118  DOUBLE PRECISION dum( 1 ), vm1( 3 ), vm2( 3 )
119  COMPLEX*16 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  DOUBLE PRECISION dlamch, zlange
125  EXTERNAL dlamch, zlange
126 * ..
127 * .. External Subroutines ..
129 * ..
130 * .. Intrinsic Functions ..
131  INTRINSIC abs, dble, max, sqrt
132 * ..
133 * .. Executable Statements ..
134 *
135 * Get machine parameters
136 *
137  eps = dlamch( 'P' )
138  smlnum = dlamch( 'S' ) / eps
139  bignum = one / smlnum
140  CALL dlabad( 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 ztrsyl( 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 = zlange( '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 zgemm( trana, 'N', m, n, m, rmul, a,
224  \$ ldt, c, ldt, -scale*rmul, csav,
225  \$ ldt )
226  CALL zgemm( 'N', tranb, m, n, n,
227  \$ dble( isgn )*rmul, c, ldt, b,
228  \$ ldt, cone, csav, ldt )
229  res1 = zlange( '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 ZGET35
246 *
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
Definition: zgemm.f:189