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

SGET35

Purpose: 
 SGET35 tests STRSYL, 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.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 80 of file sget35.f.

80 *
81 * -- LAPACK test routine (version 3.4.0) --
82 * -- LAPACK is a software package provided by Univ. of Tennessee, --
83 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
84 * November 2011
85 *
86 * .. Scalar Arguments ..
87  INTEGER knt, lmax, ninfo
88  REAL rmax
89 * ..
90 *
91 * =====================================================================
92 *
93 * .. Parameters ..
94  REAL zero, one
95  parameter ( zero = 0.0e0, one = 1.0e0 )
96  REAL two, four
97  parameter ( two = 2.0e0, four = 4.0e0 )
98 * ..
99 * .. Local Scalars ..
100  CHARACTER trana, tranb
101  INTEGER i, ima, imb, imlda1, imlda2, imldb1, imloff,
102  $ info, isgn, itrana, itranb, j, m, n
103  REAL bignum, cnrm, eps, res, res1, rmul, scale,
104  $ smlnum, tnrm, xnrm
105 * ..
106 * .. Local Arrays ..
107  INTEGER idim( 8 ), ival( 6, 6, 8 )
108  REAL a( 6, 6 ), b( 6, 6 ), c( 6, 6 ), cc( 6, 6 ),
109  $ dum( 1 ), vm1( 3 ), vm2( 3 )
110 * ..
111 * .. External Functions ..
112  REAL slamch, slange
113  EXTERNAL slamch, slange
114 * ..
115 * .. External Subroutines ..
116  EXTERNAL sgemm, strsyl
117 * ..
118 * .. Intrinsic Functions ..
119  INTRINSIC abs, max, REAL, sin, sqrt
120 * ..
121 * .. Data statements ..
122  DATA idim / 1, 2, 3, 4, 3, 3, 6, 4 /
123  DATA ival / 1, 35*0, 1, 2, 4*0, -2, 0, 28*0, 1, 5*0,
124  $ 5, 1, 2, 3*0, -8, -2, 1, 21*0, 3, 4, 4*0, -5,
125  $ 3, 4*0, 1, 2, 1, 4, 2*0, -3, -9, -1, 1, 14*0,
126  $ 1, 5*0, 2, 3, 4*0, 5, 6, 7, 21*0, 1, 5*0, 1, 3,
127  $ -4, 3*0, 2, 5, 2, 21*0, 1, 2, 4*0, -2, 0, 4*0,
128  $ 5, 6, 3, 4, 2*0, -1, -9, -5, 2, 2*0, 4*8, 5, 6,
129  $ 4*9, -7, 5, 1, 5*0, 1, 5, 2, 3*0, 2, -21, 5,
130  $ 3*0, 1, 2, 3, 4, 14*0 /
131 * ..
132 * .. Executable Statements ..
133 *
134 * Get machine parameters
135 *
136  eps = slamch( 'P' )
137  smlnum = slamch( 'S' )*four / eps
138  bignum = one / smlnum
139  CALL slabad( smlnum, bignum )
140 *
141 * Set up test case parameters
142 *
143  vm1( 1 ) = sqrt( smlnum )
144  vm1( 2 ) = one
145  vm1( 3 ) = sqrt( bignum )
146  vm2( 1 ) = one
147  vm2( 2 ) = one + two*eps
148  vm2( 3 ) = two
149 *
150  knt = 0
151  ninfo = 0
152  lmax = 0
153  rmax = zero
154 *
155 * Begin test loop
156 *
157  DO 150 itrana = 1, 2
158  DO 140 itranb = 1, 2
159  DO 130 isgn = -1, 1, 2
160  DO 120 ima = 1, 8
161  DO 110 imlda1 = 1, 3
162  DO 100 imlda2 = 1, 3
163  DO 90 imloff = 1, 2
164  DO 80 imb = 1, 8
165  DO 70 imldb1 = 1, 3
166  IF( itrana.EQ.1 )
167  $ trana = 'N'
168  IF( itrana.EQ.2 )
169  $ trana = 'T'
170  IF( itranb.EQ.1 )
171  $ tranb = 'N'
172  IF( itranb.EQ.2 )
173  $ tranb = 'T'
174  m = idim( ima )
175  n = idim( imb )
176  tnrm = zero
177  DO 20 i = 1, m
178  DO 10 j = 1, m
179  a( i, j ) = ival( i, j, ima )
180  IF( abs( i-j ).LE.1 ) THEN
181  a( i, j ) = a( i, j )*
182  $ vm1( imlda1 )
183  a( i, j ) = a( i, j )*
184  $ vm2( imlda2 )
185  ELSE
186  a( i, j ) = a( i, j )*
187  $ vm1( imloff )
188  END IF
189  tnrm = max( tnrm,
190  $ abs( a( i, j ) ) )
191  10 CONTINUE
192  20 CONTINUE
193  DO 40 i = 1, n
194  DO 30 j = 1, n
195  b( i, j ) = ival( i, j, imb )
196  IF( abs( i-j ).LE.1 ) THEN
197  b( i, j ) = b( i, j )*
198  $ vm1( imldb1 )
199  ELSE
200  b( i, j ) = b( i, j )*
201  $ vm1( imloff )
202  END IF
203  tnrm = max( tnrm,
204  $ abs( b( i, j ) ) )
205  30 CONTINUE
206  40 CONTINUE
207  cnrm = zero
208  DO 60 i = 1, m
209  DO 50 j = 1, n
210  c( i, j ) = sin( REAL( I*J ) )
211  cnrm = max( cnrm, c( i, j ) )
212  cc( i, j ) = c( i, j )
213  50 CONTINUE
214  60 CONTINUE
215  knt = knt + 1
216  CALL strsyl( trana, tranb, isgn, m, n,
217  $ a, 6, b, 6, c, 6, scale,
218  $ info )
219  IF( info.NE.0 )
220  $ ninfo = ninfo + 1
221  xnrm = slange( 'M', m, n, c, 6, dum )
222  rmul = one
223  IF( xnrm.GT.one .AND. tnrm.GT.one )
224  $ THEN
225  IF( xnrm.GT.bignum / tnrm ) THEN
226  rmul = one / max( xnrm, tnrm )
227  END IF
228  END IF
229  CALL sgemm( trana, 'N', m, n, m, rmul,
230  $ a, 6, c, 6, -scale*rmul,
231  $ cc, 6 )
232  CALL sgemm( 'N', tranb, m, n, n,
233  $ REAL( isgn )*rmul, c, 6, b,
234  $ 6, one, cc, 6 )
235  res1 = slange( 'M', m, n, cc, 6, dum )
236  res = res1 / max( smlnum, smlnum*xnrm,
237  $ ( ( rmul*tnrm )*eps )*xnrm )
238  IF( res.GT.rmax ) THEN
239  lmax = knt
240  rmax = res
241  END IF
242  70 CONTINUE
243  80 CONTINUE
244  90 CONTINUE
245  100 CONTINUE
246  110 CONTINUE
247  120 CONTINUE
248  130 CONTINUE
249  140 CONTINUE
250  150 CONTINUE
251 *
252  RETURN
253 *
254 * End of SGET35
255 *
strsyl
subroutine strsyl(TRANA, TRANB, ISGN, M, N, A, LDA, B, LDB, C, LDC, SCALE, INFO)
STRSYL
Definition: strsyl.f:166
slabad
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
sgemm
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
Definition: sgemm.f:189
slange
real function slange(NORM, M, N, A, LDA, WORK)
SLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition: slange.f:116
slamch
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69

Here is the call graph for this function:

Here is the caller graph for this function: