LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ sget32()

subroutine sget32 ( real  RMAX,
integer  LMAX,
integer  NINFO,
integer  KNT 
)

SGET32

Purpose:
 SGET32 tests SLASY2, a routine for solving

         op(TL)*X + ISGN*X*op(TR) = SCALE*B

 where TL is N1 by N1, TR is N2 by N2, and N1,N2 =1 or 2 only.
 X and B are N1 by N2, op() is an optional transpose, an
 ISGN = 1 or -1. SCALE is chosen less than or equal to 1 to
 avoid overflow in X.

 The test condition is that the scaled residual

 norm( op(TL)*X + ISGN*X*op(TR) = SCALE*B )
      / ( max( ulp*norm(TL), ulp*norm(TR)) * norm(X), SMLNUM )

 should be on the order of 1. Here, ulp is the machine precision.
 Also, it is verified that SCALE is less than or equal to 1, and
 that XNORM = infinity-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 returned with INFO.NE.0.
[out]KNT
          KNT is INTEGER
          Total number of examples tested.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 81 of file sget32.f.

82 *
83 * -- LAPACK test routine --
84 * -- LAPACK is a software package provided by Univ. of Tennessee, --
85 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
86 *
87 * .. Scalar Arguments ..
88  INTEGER KNT, LMAX, NINFO
89  REAL RMAX
90 * ..
91 *
92 * =====================================================================
93 *
94 * .. Parameters ..
95  REAL ZERO, ONE
96  parameter( zero = 0.0e0, one = 1.0e0 )
97  REAL TWO, FOUR, EIGHT
98  parameter( two = 2.0e0, four = 4.0e0, eight = 8.0e0 )
99 * ..
100 * .. Local Scalars ..
101  LOGICAL LTRANL, LTRANR
102  INTEGER IB, IB1, IB2, IB3, INFO, ISGN, ITL, ITLSCL,
103  $ ITR, ITRANL, ITRANR, ITRSCL, N1, N2
104  REAL BIGNUM, DEN, EPS, RES, SCALE, SGN, SMLNUM, TMP,
105  $ TNRM, XNORM, XNRM
106 * ..
107 * .. Local Arrays ..
108  INTEGER ITVAL( 2, 2, 8 )
109  REAL B( 2, 2 ), TL( 2, 2 ), TR( 2, 2 ), VAL( 3 ),
110  $ X( 2, 2 )
111 * ..
112 * .. External Functions ..
113  REAL SLAMCH
114  EXTERNAL slamch
115 * ..
116 * .. External Subroutines ..
117  EXTERNAL slabad, slasy2
118 * ..
119 * .. Intrinsic Functions ..
120  INTRINSIC abs, max, min, sqrt
121 * ..
122 * .. Data statements ..
123  DATA itval / 8, 4, 2, 1, 4, 8, 1, 2, 2, 1, 8, 4, 1,
124  $ 2, 4, 8, 9, 4, 2, 1, 4, 9, 1, 2, 2, 1, 9, 4, 1,
125  $ 2, 4, 9 /
126 * ..
127 * .. Executable Statements ..
128 *
129 * Get machine parameters
130 *
131  eps = slamch( 'P' )
132  smlnum = slamch( 'S' ) / eps
133  bignum = one / smlnum
134  CALL slabad( smlnum, bignum )
135 *
136 * Set up test case parameters
137 *
138  val( 1 ) = sqrt( smlnum )
139  val( 2 ) = one
140  val( 3 ) = sqrt( bignum )
141 *
142  knt = 0
143  ninfo = 0
144  lmax = 0
145  rmax = zero
146 *
147 * Begin test loop
148 *
149  DO 230 itranl = 0, 1
150  DO 220 itranr = 0, 1
151  DO 210 isgn = -1, 1, 2
152  sgn = isgn
153  ltranl = itranl.EQ.1
154  ltranr = itranr.EQ.1
155 *
156  n1 = 1
157  n2 = 1
158  DO 30 itl = 1, 3
159  DO 20 itr = 1, 3
160  DO 10 ib = 1, 3
161  tl( 1, 1 ) = val( itl )
162  tr( 1, 1 ) = val( itr )
163  b( 1, 1 ) = val( ib )
164  knt = knt + 1
165  CALL slasy2( ltranl, ltranr, isgn, n1, n2, tl,
166  $ 2, tr, 2, b, 2, scale, x, 2, xnorm,
167  $ info )
168  IF( info.NE.0 )
169  $ ninfo = ninfo + 1
170  res = abs( ( tl( 1, 1 )+sgn*tr( 1, 1 ) )*
171  $ x( 1, 1 )-scale*b( 1, 1 ) )
172  IF( info.EQ.0 ) THEN
173  den = max( eps*( ( abs( tr( 1,
174  $ 1 ) )+abs( tl( 1, 1 ) ) )*abs( x( 1,
175  $ 1 ) ) ), smlnum )
176  ELSE
177  den = smlnum*max( abs( x( 1, 1 ) ), one )
178  END IF
179  res = res / den
180  IF( scale.GT.one )
181  $ res = res + one / eps
182  res = res + abs( xnorm-abs( x( 1, 1 ) ) ) /
183  $ max( smlnum, xnorm ) / eps
184  IF( info.NE.0 .AND. info.NE.1 )
185  $ res = res + one / eps
186  IF( res.GT.rmax ) THEN
187  lmax = knt
188  rmax = res
189  END IF
190  10 CONTINUE
191  20 CONTINUE
192  30 CONTINUE
193 *
194  n1 = 2
195  n2 = 1
196  DO 80 itl = 1, 8
197  DO 70 itlscl = 1, 3
198  DO 60 itr = 1, 3
199  DO 50 ib1 = 1, 3
200  DO 40 ib2 = 1, 3
201  b( 1, 1 ) = val( ib1 )
202  b( 2, 1 ) = -four*val( ib2 )
203  tl( 1, 1 ) = itval( 1, 1, itl )*
204  $ val( itlscl )
205  tl( 2, 1 ) = itval( 2, 1, itl )*
206  $ val( itlscl )
207  tl( 1, 2 ) = itval( 1, 2, itl )*
208  $ val( itlscl )
209  tl( 2, 2 ) = itval( 2, 2, itl )*
210  $ val( itlscl )
211  tr( 1, 1 ) = val( itr )
212  knt = knt + 1
213  CALL slasy2( ltranl, ltranr, isgn, n1, n2,
214  $ tl, 2, tr, 2, b, 2, scale, x,
215  $ 2, xnorm, info )
216  IF( info.NE.0 )
217  $ ninfo = ninfo + 1
218  IF( ltranl ) THEN
219  tmp = tl( 1, 2 )
220  tl( 1, 2 ) = tl( 2, 1 )
221  tl( 2, 1 ) = tmp
222  END IF
223  res = abs( ( tl( 1, 1 )+sgn*tr( 1, 1 ) )*
224  $ x( 1, 1 )+tl( 1, 2 )*x( 2, 1 )-
225  $ scale*b( 1, 1 ) )
226  res = res + abs( ( tl( 2, 2 )+sgn*tr( 1,
227  $ 1 ) )*x( 2, 1 )+tl( 2, 1 )*
228  $ x( 1, 1 )-scale*b( 2, 1 ) )
229  tnrm = abs( tr( 1, 1 ) ) +
230  $ abs( tl( 1, 1 ) ) +
231  $ abs( tl( 1, 2 ) ) +
232  $ abs( tl( 2, 1 ) ) +
233  $ abs( tl( 2, 2 ) )
234  xnrm = max( abs( x( 1, 1 ) ),
235  $ abs( x( 2, 1 ) ) )
236  den = max( smlnum, smlnum*xnrm,
237  $ ( tnrm*eps )*xnrm )
238  res = res / den
239  IF( scale.GT.one )
240  $ res = res + one / eps
241  res = res + abs( xnorm-xnrm ) /
242  $ max( smlnum, xnorm ) / eps
243  IF( res.GT.rmax ) THEN
244  lmax = knt
245  rmax = res
246  END IF
247  40 CONTINUE
248  50 CONTINUE
249  60 CONTINUE
250  70 CONTINUE
251  80 CONTINUE
252 *
253  n1 = 1
254  n2 = 2
255  DO 130 itr = 1, 8
256  DO 120 itrscl = 1, 3
257  DO 110 itl = 1, 3
258  DO 100 ib1 = 1, 3
259  DO 90 ib2 = 1, 3
260  b( 1, 1 ) = val( ib1 )
261  b( 1, 2 ) = -two*val( ib2 )
262  tr( 1, 1 ) = itval( 1, 1, itr )*
263  $ val( itrscl )
264  tr( 2, 1 ) = itval( 2, 1, itr )*
265  $ val( itrscl )
266  tr( 1, 2 ) = itval( 1, 2, itr )*
267  $ val( itrscl )
268  tr( 2, 2 ) = itval( 2, 2, itr )*
269  $ val( itrscl )
270  tl( 1, 1 ) = val( itl )
271  knt = knt + 1
272  CALL slasy2( ltranl, ltranr, isgn, n1, n2,
273  $ tl, 2, tr, 2, b, 2, scale, x,
274  $ 2, xnorm, info )
275  IF( info.NE.0 )
276  $ ninfo = ninfo + 1
277  IF( ltranr ) THEN
278  tmp = tr( 1, 2 )
279  tr( 1, 2 ) = tr( 2, 1 )
280  tr( 2, 1 ) = tmp
281  END IF
282  tnrm = abs( tl( 1, 1 ) ) +
283  $ abs( tr( 1, 1 ) ) +
284  $ abs( tr( 1, 2 ) ) +
285  $ abs( tr( 2, 2 ) ) +
286  $ abs( tr( 2, 1 ) )
287  xnrm = abs( x( 1, 1 ) ) + abs( x( 1, 2 ) )
288  res = abs( ( ( tl( 1, 1 )+sgn*tr( 1,
289  $ 1 ) ) )*( x( 1, 1 ) )+
290  $ ( sgn*tr( 2, 1 ) )*( x( 1, 2 ) )-
291  $ ( scale*b( 1, 1 ) ) )
292  res = res + abs( ( ( tl( 1, 1 )+sgn*tr( 2,
293  $ 2 ) ) )*( x( 1, 2 ) )+
294  $ ( sgn*tr( 1, 2 ) )*( x( 1, 1 ) )-
295  $ ( scale*b( 1, 2 ) ) )
296  den = max( smlnum, smlnum*xnrm,
297  $ ( tnrm*eps )*xnrm )
298  res = res / den
299  IF( scale.GT.one )
300  $ res = res + one / eps
301  res = res + abs( xnorm-xnrm ) /
302  $ max( smlnum, xnorm ) / eps
303  IF( res.GT.rmax ) THEN
304  lmax = knt
305  rmax = res
306  END IF
307  90 CONTINUE
308  100 CONTINUE
309  110 CONTINUE
310  120 CONTINUE
311  130 CONTINUE
312 *
313  n1 = 2
314  n2 = 2
315  DO 200 itr = 1, 8
316  DO 190 itrscl = 1, 3
317  DO 180 itl = 1, 8
318  DO 170 itlscl = 1, 3
319  DO 160 ib1 = 1, 3
320  DO 150 ib2 = 1, 3
321  DO 140 ib3 = 1, 3
322  b( 1, 1 ) = val( ib1 )
323  b( 2, 1 ) = -four*val( ib2 )
324  b( 1, 2 ) = -two*val( ib3 )
325  b( 2, 2 ) = eight*
326  $ min( val( ib1 ), val
327  $ ( ib2 ), val( ib3 ) )
328  tr( 1, 1 ) = itval( 1, 1, itr )*
329  $ val( itrscl )
330  tr( 2, 1 ) = itval( 2, 1, itr )*
331  $ val( itrscl )
332  tr( 1, 2 ) = itval( 1, 2, itr )*
333  $ val( itrscl )
334  tr( 2, 2 ) = itval( 2, 2, itr )*
335  $ val( itrscl )
336  tl( 1, 1 ) = itval( 1, 1, itl )*
337  $ val( itlscl )
338  tl( 2, 1 ) = itval( 2, 1, itl )*
339  $ val( itlscl )
340  tl( 1, 2 ) = itval( 1, 2, itl )*
341  $ val( itlscl )
342  tl( 2, 2 ) = itval( 2, 2, itl )*
343  $ val( itlscl )
344  knt = knt + 1
345  CALL slasy2( ltranl, ltranr, isgn,
346  $ n1, n2, tl, 2, tr, 2,
347  $ b, 2, scale, x, 2,
348  $ xnorm, info )
349  IF( info.NE.0 )
350  $ ninfo = ninfo + 1
351  IF( ltranr ) THEN
352  tmp = tr( 1, 2 )
353  tr( 1, 2 ) = tr( 2, 1 )
354  tr( 2, 1 ) = tmp
355  END IF
356  IF( ltranl ) THEN
357  tmp = tl( 1, 2 )
358  tl( 1, 2 ) = tl( 2, 1 )
359  tl( 2, 1 ) = tmp
360  END IF
361  tnrm = abs( tr( 1, 1 ) ) +
362  $ abs( tr( 2, 1 ) ) +
363  $ abs( tr( 1, 2 ) ) +
364  $ abs( tr( 2, 2 ) ) +
365  $ abs( tl( 1, 1 ) ) +
366  $ abs( tl( 2, 1 ) ) +
367  $ abs( tl( 1, 2 ) ) +
368  $ abs( tl( 2, 2 ) )
369  xnrm = max( abs( x( 1, 1 ) )+
370  $ abs( x( 1, 2 ) ),
371  $ abs( x( 2, 1 ) )+
372  $ abs( x( 2, 2 ) ) )
373  res = abs( ( ( tl( 1, 1 )+sgn*tr( 1,
374  $ 1 ) ) )*( x( 1, 1 ) )+
375  $ ( sgn*tr( 2, 1 ) )*
376  $ ( x( 1, 2 ) )+( tl( 1, 2 ) )*
377  $ ( x( 2, 1 ) )-
378  $ ( scale*b( 1, 1 ) ) )
379  res = res + abs( ( tl( 1, 1 ) )*
380  $ ( x( 1, 2 ) )+
381  $ ( sgn*tr( 1, 2 ) )*
382  $ ( x( 1, 1 ) )+
383  $ ( sgn*tr( 2, 2 ) )*
384  $ ( x( 1, 2 ) )+( tl( 1, 2 ) )*
385  $ ( x( 2, 2 ) )-
386  $ ( scale*b( 1, 2 ) ) )
387  res = res + abs( ( tl( 2, 1 ) )*
388  $ ( x( 1, 1 ) )+
389  $ ( sgn*tr( 1, 1 ) )*
390  $ ( x( 2, 1 ) )+
391  $ ( sgn*tr( 2, 1 ) )*
392  $ ( x( 2, 2 ) )+( tl( 2, 2 ) )*
393  $ ( x( 2, 1 ) )-
394  $ ( scale*b( 2, 1 ) ) )
395  res = res + abs( ( ( tl( 2,
396  $ 2 )+sgn*tr( 2, 2 ) ) )*
397  $ ( x( 2, 2 ) )+
398  $ ( sgn*tr( 1, 2 ) )*
399  $ ( x( 2, 1 ) )+( tl( 2, 1 ) )*
400  $ ( x( 1, 2 ) )-
401  $ ( scale*b( 2, 2 ) ) )
402  den = max( smlnum, smlnum*xnrm,
403  $ ( tnrm*eps )*xnrm )
404  res = res / den
405  IF( scale.GT.one )
406  $ res = res + one / eps
407  res = res + abs( xnorm-xnrm ) /
408  $ max( smlnum, xnorm ) / eps
409  IF( res.GT.rmax ) THEN
410  lmax = knt
411  rmax = res
412  END IF
413  140 CONTINUE
414  150 CONTINUE
415  160 CONTINUE
416  170 CONTINUE
417  180 CONTINUE
418  190 CONTINUE
419  200 CONTINUE
420  210 CONTINUE
421  220 CONTINUE
422  230 CONTINUE
423 *
424  RETURN
425 *
426 * End of SGET32
427 *
slabad
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:74
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:174
slamch
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68
Here is the call graph for this function:
Here is the caller graph for this function: