LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine cget35 ( real  RMAX,
integer  LMAX,
integer  NINFO,
integer  KNT,
integer  NIN 
)

CGET35

Purpose: 
 CGET35 tests CTRSYL, 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 REAL
          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 cget35.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  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 *
slabad
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
ctrsyl
subroutine ctrsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
CTRSYL
Definition: ctrsyl.f:159
clange
real function clange(NORM, M, N, A, LDA, WORK)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: clange.f:117
slamch
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69
cgemm
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
Definition: cgemm.f:189

Here is the call graph for this function:

Here is the caller graph for this function: