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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
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 ..
128  EXTERNAL dlabad, zgemm, ztrsyl
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 *
dlamch
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:65
zgemm
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
Definition: zgemm.f:189
dlabad
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:76
zlange
double precision function zlange(NORM, M, N, A, LDA, WORK)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: zlange.f:117
ztrsyl
subroutine ztrsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
ZTRSYL
Definition: ztrsyl.f:159

Here is the call graph for this function:

Here is the caller graph for this function: