LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
sget32.f
Go to the documentation of this file.
1 *> \brief \b SGET32
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 SGET32( RMAX, LMAX, NINFO, KNT )
12 *
13 * .. Scalar Arguments ..
14 * INTEGER KNT, LMAX, NINFO
15 * REAL RMAX
16 * ..
17 *
18 *
19 *> \par Purpose:
20 * =============
21 *>
22 *> \verbatim
23 *>
24 *> SGET32 tests SLASY2, a routine for solving
25 *>
26 *> op(TL)*X + ISGN*X*op(TR) = SCALE*B
27 *>
28 *> where TL is N1 by N1, TR is N2 by N2, and N1,N2 =1 or 2 only.
29 *> X and B are N1 by N2, op() is an optional transpose, an
30 *> ISGN = 1 or -1. SCALE is chosen less than or equal to 1 to
31 *> avoid overflow in X.
32 *>
33 *> The test condition is that the scaled residual
34 *>
35 *> norm( op(TL)*X + ISGN*X*op(TR) = SCALE*B )
36 *> / ( max( ulp*norm(TL), ulp*norm(TR)) * norm(X), SMLNUM )
37 *>
38 *> should be on the order of 1. Here, ulp is the machine precision.
39 *> Also, it is verified that SCALE is less than or equal to 1, and
40 *> that XNORM = infinity-norm(X).
41 *> \endverbatim
42 *
43 * Arguments:
44 * ==========
45 *
46 *> \param[out] RMAX
47 *> \verbatim
48 *> RMAX is REAL
49 *> Value of the largest test ratio.
50 *> \endverbatim
51 *>
52 *> \param[out] LMAX
53 *> \verbatim
54 *> LMAX is INTEGER
55 *> Example number where largest test ratio achieved.
56 *> \endverbatim
57 *>
58 *> \param[out] NINFO
59 *> \verbatim
60 *> NINFO is INTEGER
61 *> Number of examples returned with INFO.NE.0.
62 *> \endverbatim
63 *>
64 *> \param[out] KNT
65 *> \verbatim
66 *> KNT is INTEGER
67 *> Total number of examples tested.
68 *> \endverbatim
69 *
70 * Authors:
71 * ========
72 *
73 *> \author Univ. of Tennessee
74 *> \author Univ. of California Berkeley
75 *> \author Univ. of Colorado Denver
76 *> \author NAG Ltd.
77 *
78 *> \date November 2011
79 *
80 *> \ingroup single_eig
81 *
82 * =====================================================================
83  SUBROUTINE sget32( RMAX, LMAX, NINFO, KNT )
84 *
85 * -- LAPACK test routine (version 3.4.0) --
86 * -- LAPACK is a software package provided by Univ. of Tennessee, --
87 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
88 * November 2011
89 *
90 * .. Scalar Arguments ..
91  INTEGER KNT, LMAX, NINFO
92  REAL RMAX
93 * ..
94 *
95 * =====================================================================
96 *
97 * .. Parameters ..
98  REAL ZERO, ONE
99  parameter ( zero = 0.0e0, one = 1.0e0 )
100  REAL TWO, FOUR, EIGHT
101  parameter ( two = 2.0e0, four = 4.0e0, eight = 8.0e0 )
102 * ..
103 * .. Local Scalars ..
104  LOGICAL LTRANL, LTRANR
105  INTEGER IB, IB1, IB2, IB3, INFO, ISGN, ITL, ITLSCL,
106  $ itr, itranl, itranr, itrscl, n1, n2
107  REAL BIGNUM, DEN, EPS, RES, SCALE, SGN, SMLNUM, TMP,
108  $ tnrm, xnorm, xnrm
109 * ..
110 * .. Local Arrays ..
111  INTEGER ITVAL( 2, 2, 8 )
112  REAL B( 2, 2 ), TL( 2, 2 ), TR( 2, 2 ), VAL( 3 ),
113  $ x( 2, 2 )
114 * ..
115 * .. External Functions ..
116  REAL SLAMCH
117  EXTERNAL slamch
118 * ..
119 * .. External Subroutines ..
120  EXTERNAL slabad, slasy2
121 * ..
122 * .. Intrinsic Functions ..
123  INTRINSIC abs, max, min, sqrt
124 * ..
125 * .. Data statements ..
126  DATA itval / 8, 4, 2, 1, 4, 8, 1, 2, 2, 1, 8, 4, 1,
127  $ 2, 4, 8, 9, 4, 2, 1, 4, 9, 1, 2, 2, 1, 9, 4, 1,
128  $ 2, 4, 9 /
129 * ..
130 * .. Executable Statements ..
131 *
132 * Get machine parameters
133 *
134  eps = slamch( 'P' )
135  smlnum = slamch( 'S' ) / eps
136  bignum = one / smlnum
137  CALL slabad( smlnum, bignum )
138 *
139 * Set up test case parameters
140 *
141  val( 1 ) = sqrt( smlnum )
142  val( 2 ) = one
143  val( 3 ) = sqrt( bignum )
144 *
145  knt = 0
146  ninfo = 0
147  lmax = 0
148  rmax = zero
149 *
150 * Begin test loop
151 *
152  DO 230 itranl = 0, 1
153  DO 220 itranr = 0, 1
154  DO 210 isgn = -1, 1, 2
155  sgn = isgn
156  ltranl = itranl.EQ.1
157  ltranr = itranr.EQ.1
158 *
159  n1 = 1
160  n2 = 1
161  DO 30 itl = 1, 3
162  DO 20 itr = 1, 3
163  DO 10 ib = 1, 3
164  tl( 1, 1 ) = val( itl )
165  tr( 1, 1 ) = val( itr )
166  b( 1, 1 ) = val( ib )
167  knt = knt + 1
168  CALL slasy2( ltranl, ltranr, isgn, n1, n2, tl,
169  $ 2, tr, 2, b, 2, scale, x, 2, xnorm,
170  $ info )
171  IF( info.NE.0 )
172  $ ninfo = ninfo + 1
173  res = abs( ( tl( 1, 1 )+sgn*tr( 1, 1 ) )*
174  $ x( 1, 1 )-scale*b( 1, 1 ) )
175  IF( info.EQ.0 ) THEN
176  den = max( eps*( ( abs( tr( 1,
177  $ 1 ) )+abs( tl( 1, 1 ) ) )*abs( x( 1,
178  $ 1 ) ) ), smlnum )
179  ELSE
180  den = smlnum*max( abs( x( 1, 1 ) ), one )
181  END IF
182  res = res / den
183  IF( scale.GT.one )
184  $ res = res + one / eps
185  res = res + abs( xnorm-abs( x( 1, 1 ) ) ) /
186  $ max( smlnum, xnorm ) / eps
187  IF( info.NE.0 .AND. info.NE.1 )
188  $ res = res + one / eps
189  IF( res.GT.rmax ) THEN
190  lmax = knt
191  rmax = res
192  END IF
193  10 CONTINUE
194  20 CONTINUE
195  30 CONTINUE
196 *
197  n1 = 2
198  n2 = 1
199  DO 80 itl = 1, 8
200  DO 70 itlscl = 1, 3
201  DO 60 itr = 1, 3
202  DO 50 ib1 = 1, 3
203  DO 40 ib2 = 1, 3
204  b( 1, 1 ) = val( ib1 )
205  b( 2, 1 ) = -four*val( ib2 )
206  tl( 1, 1 ) = itval( 1, 1, itl )*
207  $ val( itlscl )
208  tl( 2, 1 ) = itval( 2, 1, itl )*
209  $ val( itlscl )
210  tl( 1, 2 ) = itval( 1, 2, itl )*
211  $ val( itlscl )
212  tl( 2, 2 ) = itval( 2, 2, itl )*
213  $ val( itlscl )
214  tr( 1, 1 ) = val( itr )
215  knt = knt + 1
216  CALL slasy2( ltranl, ltranr, isgn, n1, n2,
217  $ tl, 2, tr, 2, b, 2, scale, x,
218  $ 2, xnorm, info )
219  IF( info.NE.0 )
220  $ ninfo = ninfo + 1
221  IF( ltranl ) THEN
222  tmp = tl( 1, 2 )
223  tl( 1, 2 ) = tl( 2, 1 )
224  tl( 2, 1 ) = tmp
225  END IF
226  res = abs( ( tl( 1, 1 )+sgn*tr( 1, 1 ) )*
227  $ x( 1, 1 )+tl( 1, 2 )*x( 2, 1 )-
228  $ scale*b( 1, 1 ) )
229  res = res + abs( ( tl( 2, 2 )+sgn*tr( 1,
230  $ 1 ) )*x( 2, 1 )+tl( 2, 1 )*
231  $ x( 1, 1 )-scale*b( 2, 1 ) )
232  tnrm = abs( tr( 1, 1 ) ) +
233  $ abs( tl( 1, 1 ) ) +
234  $ abs( tl( 1, 2 ) ) +
235  $ abs( tl( 2, 1 ) ) +
236  $ abs( tl( 2, 2 ) )
237  xnrm = max( abs( x( 1, 1 ) ),
238  $ abs( x( 2, 1 ) ) )
239  den = max( smlnum, smlnum*xnrm,
240  $ ( tnrm*eps )*xnrm )
241  res = res / den
242  IF( scale.GT.one )
243  $ res = res + one / eps
244  res = res + abs( xnorm-xnrm ) /
245  $ max( smlnum, xnorm ) / eps
246  IF( res.GT.rmax ) THEN
247  lmax = knt
248  rmax = res
249  END IF
250  40 CONTINUE
251  50 CONTINUE
252  60 CONTINUE
253  70 CONTINUE
254  80 CONTINUE
255 *
256  n1 = 1
257  n2 = 2
258  DO 130 itr = 1, 8
259  DO 120 itrscl = 1, 3
260  DO 110 itl = 1, 3
261  DO 100 ib1 = 1, 3
262  DO 90 ib2 = 1, 3
263  b( 1, 1 ) = val( ib1 )
264  b( 1, 2 ) = -two*val( ib2 )
265  tr( 1, 1 ) = itval( 1, 1, itr )*
266  $ val( itrscl )
267  tr( 2, 1 ) = itval( 2, 1, itr )*
268  $ val( itrscl )
269  tr( 1, 2 ) = itval( 1, 2, itr )*
270  $ val( itrscl )
271  tr( 2, 2 ) = itval( 2, 2, itr )*
272  $ val( itrscl )
273  tl( 1, 1 ) = val( itl )
274  knt = knt + 1
275  CALL slasy2( ltranl, ltranr, isgn, n1, n2,
276  $ tl, 2, tr, 2, b, 2, scale, x,
277  $ 2, xnorm, info )
278  IF( info.NE.0 )
279  $ ninfo = ninfo + 1
280  IF( ltranr ) THEN
281  tmp = tr( 1, 2 )
282  tr( 1, 2 ) = tr( 2, 1 )
283  tr( 2, 1 ) = tmp
284  END IF
285  tnrm = abs( tl( 1, 1 ) ) +
286  $ abs( tr( 1, 1 ) ) +
287  $ abs( tr( 1, 2 ) ) +
288  $ abs( tr( 2, 2 ) ) +
289  $ abs( tr( 2, 1 ) )
290  xnrm = abs( x( 1, 1 ) ) + abs( x( 1, 2 ) )
291  res = abs( ( ( tl( 1, 1 )+sgn*tr( 1,
292  $ 1 ) ) )*( x( 1, 1 ) )+
293  $ ( sgn*tr( 2, 1 ) )*( x( 1, 2 ) )-
294  $ ( scale*b( 1, 1 ) ) )
295  res = res + abs( ( ( tl( 1, 1 )+sgn*tr( 2,
296  $ 2 ) ) )*( x( 1, 2 ) )+
297  $ ( sgn*tr( 1, 2 ) )*( x( 1, 1 ) )-
298  $ ( scale*b( 1, 2 ) ) )
299  den = max( smlnum, smlnum*xnrm,
300  $ ( tnrm*eps )*xnrm )
301  res = res / den
302  IF( scale.GT.one )
303  $ res = res + one / eps
304  res = res + abs( xnorm-xnrm ) /
305  $ max( smlnum, xnorm ) / eps
306  IF( res.GT.rmax ) THEN
307  lmax = knt
308  rmax = res
309  END IF
310  90 CONTINUE
311  100 CONTINUE
312  110 CONTINUE
313  120 CONTINUE
314  130 CONTINUE
315 *
316  n1 = 2
317  n2 = 2
318  DO 200 itr = 1, 8
319  DO 190 itrscl = 1, 3
320  DO 180 itl = 1, 8
321  DO 170 itlscl = 1, 3
322  DO 160 ib1 = 1, 3
323  DO 150 ib2 = 1, 3
324  DO 140 ib3 = 1, 3
325  b( 1, 1 ) = val( ib1 )
326  b( 2, 1 ) = -four*val( ib2 )
327  b( 1, 2 ) = -two*val( ib3 )
328  b( 2, 2 ) = eight*
329  $ min( val( ib1 ), val
330  $ ( ib2 ), val( ib3 ) )
331  tr( 1, 1 ) = itval( 1, 1, itr )*
332  $ val( itrscl )
333  tr( 2, 1 ) = itval( 2, 1, itr )*
334  $ val( itrscl )
335  tr( 1, 2 ) = itval( 1, 2, itr )*
336  $ val( itrscl )
337  tr( 2, 2 ) = itval( 2, 2, itr )*
338  $ val( itrscl )
339  tl( 1, 1 ) = itval( 1, 1, itl )*
340  $ val( itlscl )
341  tl( 2, 1 ) = itval( 2, 1, itl )*
342  $ val( itlscl )
343  tl( 1, 2 ) = itval( 1, 2, itl )*
344  $ val( itlscl )
345  tl( 2, 2 ) = itval( 2, 2, itl )*
346  $ val( itlscl )
347  knt = knt + 1
348  CALL slasy2( ltranl, ltranr, isgn,
349  $ n1, n2, tl, 2, tr, 2,
350  $ b, 2, scale, x, 2,
351  $ xnorm, info )
352  IF( info.NE.0 )
353  $ ninfo = ninfo + 1
354  IF( ltranr ) THEN
355  tmp = tr( 1, 2 )
356  tr( 1, 2 ) = tr( 2, 1 )
357  tr( 2, 1 ) = tmp
358  END IF
359  IF( ltranl ) THEN
360  tmp = tl( 1, 2 )
361  tl( 1, 2 ) = tl( 2, 1 )
362  tl( 2, 1 ) = tmp
363  END IF
364  tnrm = abs( tr( 1, 1 ) ) +
365  $ abs( tr( 2, 1 ) ) +
366  $ abs( tr( 1, 2 ) ) +
367  $ abs( tr( 2, 2 ) ) +
368  $ abs( tl( 1, 1 ) ) +
369  $ abs( tl( 2, 1 ) ) +
370  $ abs( tl( 1, 2 ) ) +
371  $ abs( tl( 2, 2 ) )
372  xnrm = max( abs( x( 1, 1 ) )+
373  $ abs( x( 1, 2 ) ),
374  $ abs( x( 2, 1 ) )+
375  $ abs( x( 2, 2 ) ) )
376  res = abs( ( ( tl( 1, 1 )+sgn*tr( 1,
377  $ 1 ) ) )*( x( 1, 1 ) )+
378  $ ( sgn*tr( 2, 1 ) )*
379  $ ( x( 1, 2 ) )+( tl( 1, 2 ) )*
380  $ ( x( 2, 1 ) )-
381  $ ( scale*b( 1, 1 ) ) )
382  res = res + abs( ( tl( 1, 1 ) )*
383  $ ( x( 1, 2 ) )+
384  $ ( sgn*tr( 1, 2 ) )*
385  $ ( x( 1, 1 ) )+
386  $ ( sgn*tr( 2, 2 ) )*
387  $ ( x( 1, 2 ) )+( tl( 1, 2 ) )*
388  $ ( x( 2, 2 ) )-
389  $ ( scale*b( 1, 2 ) ) )
390  res = res + abs( ( tl( 2, 1 ) )*
391  $ ( x( 1, 1 ) )+
392  $ ( sgn*tr( 1, 1 ) )*
393  $ ( x( 2, 1 ) )+
394  $ ( sgn*tr( 2, 1 ) )*
395  $ ( x( 2, 2 ) )+( tl( 2, 2 ) )*
396  $ ( x( 2, 1 ) )-
397  $ ( scale*b( 2, 1 ) ) )
398  res = res + abs( ( ( tl( 2,
399  $ 2 )+sgn*tr( 2, 2 ) ) )*
400  $ ( x( 2, 2 ) )+
401  $ ( sgn*tr( 1, 2 ) )*
402  $ ( x( 2, 1 ) )+( tl( 2, 1 ) )*
403  $ ( x( 1, 2 ) )-
404  $ ( scale*b( 2, 2 ) ) )
405  den = max( smlnum, smlnum*xnrm,
406  $ ( tnrm*eps )*xnrm )
407  res = res / den
408  IF( scale.GT.one )
409  $ res = res + one / eps
410  res = res + abs( xnorm-xnrm ) /
411  $ max( smlnum, xnorm ) / eps
412  IF( res.GT.rmax ) THEN
413  lmax = knt
414  rmax = res
415  END IF
416  140 CONTINUE
417  150 CONTINUE
418  160 CONTINUE
419  170 CONTINUE
420  180 CONTINUE
421  190 CONTINUE
422  200 CONTINUE
423  210 CONTINUE
424  220 CONTINUE
425  230 CONTINUE
426 *
427  RETURN
428 *
429 * End of SGET32
430 *
431  END
slasy2
subroutine slasy2(LTRANL, LTRANR, ISGN, N1, N2, TL, LDTL, TR, LDTR, B, LDB, SCALE, X, LDX, XNORM, INFO)
SLASY2 solves the Sylvester matrix equation where the matrices are of order 1 or 2.
Definition: slasy2.f:176
slabad
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
sget32
subroutine sget32(RMAX, LMAX, NINFO, KNT)
SGET32
Definition: sget32.f:84