1 SUBROUTINE SGET31( RMAX, LMAX, NINFO, KNT )
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER KNT, LMAX
9 REAL RMAX
10 * ..
11 * .. Array Arguments ..
12 INTEGER NINFO( 2 )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * SGET31 tests SLALN2, a routine for solving
19 *
20 * (ca A - w D)X = sB
21 *
22 * where A is an NA by NA matrix (NA=1 or 2 only), w is a real (NW=1) or
23 * complex (NW=2) constant, ca is a real constant, D is an NA by NA real
24 * diagonal matrix, and B is an NA by NW matrix (when NW=2 the second
25 * column of B contains the imaginary part of the solution). The code
26 * returns X and s, where s is a scale factor, less than or equal to 1,
27 * which is chosen to avoid overflow in X.
28 *
29 * If any singular values of ca A-w D are less than another input
30 * parameter SMIN, they are perturbed up to SMIN.
31 *
32 * The test condition is that the scaled residual
33 *
34 * norm( (ca A-w D)*X - s*B ) /
35 * ( max( ulp*norm(ca A-w D), SMIN )*norm(X) )
36 *
37 * should be on the order of 1. Here, ulp is the machine precision.
38 * Also, it is verified that SCALE is less than or equal to 1, and that
39 * XNORM = infinity-norm(X).
40 *
41 * Arguments
42 * ==========
43 *
44 * RMAX (output) REAL
45 * Value of the largest test ratio.
46 *
47 * LMAX (output) INTEGER
48 * Example number where largest test ratio achieved.
49 *
50 * NINFO (output) INTEGER array, dimension (3)
51 * NINFO(1) = number of examples with INFO less than 0
52 * NINFO(2) = number of examples with INFO greater than 0
53 *
54 * KNT (output) INTEGER
55 * Total number of examples tested.
56 *
57 * =====================================================================
58 *
59 * .. Parameters ..
60 REAL ZERO, HALF, ONE
61 PARAMETER ( ZERO = 0.0E0, HALF = 0.5E0, ONE = 1.0E0 )
62 REAL TWO, THREE, FOUR
63 PARAMETER ( TWO = 2.0E0, THREE = 3.0E0, FOUR = 4.0E0 )
64 REAL SEVEN, TEN
65 PARAMETER ( SEVEN = 7.0E0, TEN = 10.0E0 )
66 REAL TWNONE
67 PARAMETER ( TWNONE = 21.0E0 )
68 * ..
69 * .. Local Scalars ..
70 INTEGER IA, IB, ICA, ID1, ID2, INFO, ISMIN, ITRANS,
71 $ IWI, IWR, NA, NW
72 REAL BIGNUM, CA, D1, D2, DEN, EPS, RES, SCALE, SMIN,
73 $ SMLNUM, TMP, UNFL, WI, WR, XNORM
74 * ..
75 * .. Local Arrays ..
76 LOGICAL LTRANS( 0: 1 )
77 REAL A( 2, 2 ), B( 2, 2 ), VAB( 3 ), VCA( 5 ),
78 $ VDD( 4 ), VSMIN( 4 ), VWI( 4 ), VWR( 4 ),
79 $ X( 2, 2 )
80 * ..
81 * .. External Functions ..
82 REAL SLAMCH
83 EXTERNAL SLAMCH
84 * ..
85 * .. External Subroutines ..
86 EXTERNAL SLABAD, SLALN2
87 * ..
88 * .. Intrinsic Functions ..
89 INTRINSIC ABS, MAX, SQRT
90 * ..
91 * .. Data statements ..
92 DATA LTRANS / .FALSE., .TRUE. /
93 * ..
94 * .. Executable Statements ..
95 *
96 * Get machine parameters
97 *
98 EPS = SLAMCH( 'P' )
99 UNFL = SLAMCH( 'U' )
100 SMLNUM = SLAMCH( 'S' ) / EPS
101 BIGNUM = ONE / SMLNUM
102 CALL SLABAD( SMLNUM, BIGNUM )
103 *
104 * Set up test case parameters
105 *
106 VSMIN( 1 ) = SMLNUM
107 VSMIN( 2 ) = EPS
108 VSMIN( 3 ) = ONE / ( TEN*TEN )
109 VSMIN( 4 ) = ONE / EPS
110 VAB( 1 ) = SQRT( SMLNUM )
111 VAB( 2 ) = ONE
112 VAB( 3 ) = SQRT( BIGNUM )
113 VWR( 1 ) = ZERO
114 VWR( 2 ) = HALF
115 VWR( 3 ) = TWO
116 VWR( 4 ) = ONE
117 VWI( 1 ) = SMLNUM
118 VWI( 2 ) = EPS
119 VWI( 3 ) = ONE
120 VWI( 4 ) = TWO
121 VDD( 1 ) = SQRT( SMLNUM )
122 VDD( 2 ) = ONE
123 VDD( 3 ) = TWO
124 VDD( 4 ) = SQRT( BIGNUM )
125 VCA( 1 ) = ZERO
126 VCA( 2 ) = SQRT( SMLNUM )
127 VCA( 3 ) = EPS
128 VCA( 4 ) = HALF
129 VCA( 5 ) = ONE
130 *
131 KNT = 0
132 NINFO( 1 ) = 0
133 NINFO( 2 ) = 0
134 LMAX = 0
135 RMAX = ZERO
136 *
137 * Begin test loop
138 *
139 DO 190 ID1 = 1, 4
140 D1 = VDD( ID1 )
141 DO 180 ID2 = 1, 4
142 D2 = VDD( ID2 )
143 DO 170 ICA = 1, 5
144 CA = VCA( ICA )
145 DO 160 ITRANS = 0, 1
146 DO 150 ISMIN = 1, 4
147 SMIN = VSMIN( ISMIN )
148 *
149 NA = 1
150 NW = 1
151 DO 30 IA = 1, 3
152 A( 1, 1 ) = VAB( IA )
153 DO 20 IB = 1, 3
154 B( 1, 1 ) = VAB( IB )
155 DO 10 IWR = 1, 4
156 IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND. CA.EQ.
157 $ ONE ) THEN
158 WR = VWR( IWR )*A( 1, 1 )
159 ELSE
160 WR = VWR( IWR )
161 END IF
162 WI = ZERO
163 CALL SLALN2( LTRANS( ITRANS ), NA, NW,
164 $ SMIN, CA, A, 2, D1, D2, B, 2,
165 $ WR, WI, X, 2, SCALE, XNORM,
166 $ INFO )
167 IF( INFO.LT.0 )
168 $ NINFO( 1 ) = NINFO( 1 ) + 1
169 IF( INFO.GT.0 )
170 $ NINFO( 2 ) = NINFO( 2 ) + 1
171 RES = ABS( ( CA*A( 1, 1 )-WR*D1 )*
172 $ X( 1, 1 )-SCALE*B( 1, 1 ) )
173 IF( INFO.EQ.0 ) THEN
174 DEN = MAX( EPS*( ABS( ( CA*A( 1,
175 $ 1 )-WR*D1 )*X( 1, 1 ) ) ),
176 $ SMLNUM )
177 ELSE
178 DEN = MAX( SMIN*ABS( X( 1, 1 ) ),
179 $ SMLNUM )
180 END IF
181 RES = RES / DEN
182 IF( ABS( X( 1, 1 ) ).LT.UNFL .AND.
183 $ ABS( B( 1, 1 ) ).LE.SMLNUM*
184 $ ABS( CA*A( 1, 1 )-WR*D1 ) )RES = ZERO
185 IF( SCALE.GT.ONE )
186 $ RES = RES + ONE / EPS
187 RES = RES + ABS( XNORM-ABS( X( 1, 1 ) ) )
188 $ / MAX( SMLNUM, XNORM ) / EPS
189 IF( INFO.NE.0 .AND. INFO.NE.1 )
190 $ RES = RES + ONE / EPS
191 KNT = KNT + 1
192 IF( RES.GT.RMAX ) THEN
193 LMAX = KNT
194 RMAX = RES
195 END IF
196 10 CONTINUE
197 20 CONTINUE
198 30 CONTINUE
199 *
200 NA = 1
201 NW = 2
202 DO 70 IA = 1, 3
203 A( 1, 1 ) = VAB( IA )
204 DO 60 IB = 1, 3
205 B( 1, 1 ) = VAB( IB )
206 B( 1, 2 ) = -HALF*VAB( IB )
207 DO 50 IWR = 1, 4
208 IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND. CA.EQ.
209 $ ONE ) THEN
210 WR = VWR( IWR )*A( 1, 1 )
211 ELSE
212 WR = VWR( IWR )
213 END IF
214 DO 40 IWI = 1, 4
215 IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND.
216 $ CA.EQ.ONE ) THEN
217 WI = VWI( IWI )*A( 1, 1 )
218 ELSE
219 WI = VWI( IWI )
220 END IF
221 CALL SLALN2( LTRANS( ITRANS ), NA, NW,
222 $ SMIN, CA, A, 2, D1, D2, B,
223 $ 2, WR, WI, X, 2, SCALE,
224 $ XNORM, INFO )
225 IF( INFO.LT.0 )
226 $ NINFO( 1 ) = NINFO( 1 ) + 1
227 IF( INFO.GT.0 )
228 $ NINFO( 2 ) = NINFO( 2 ) + 1
229 RES = ABS( ( CA*A( 1, 1 )-WR*D1 )*
230 $ X( 1, 1 )+( WI*D1 )*X( 1, 2 )-
231 $ SCALE*B( 1, 1 ) )
232 RES = RES + ABS( ( -WI*D1 )*X( 1, 1 )+
233 $ ( CA*A( 1, 1 )-WR*D1 )*X( 1, 2 )-
234 $ SCALE*B( 1, 2 ) )
235 IF( INFO.EQ.0 ) THEN
236 DEN = MAX( EPS*( MAX( ABS( CA*A( 1,
237 $ 1 )-WR*D1 ), ABS( D1*WI ) )*
238 $ ( ABS( X( 1, 1 ) )+ABS( X( 1,
239 $ 2 ) ) ) ), SMLNUM )
240 ELSE
241 DEN = MAX( SMIN*( ABS( X( 1,
242 $ 1 ) )+ABS( X( 1, 2 ) ) ),
243 $ SMLNUM )
244 END IF
245 RES = RES / DEN
246 IF( ABS( X( 1, 1 ) ).LT.UNFL .AND.
247 $ ABS( X( 1, 2 ) ).LT.UNFL .AND.
248 $ ABS( B( 1, 1 ) ).LE.SMLNUM*
249 $ ABS( CA*A( 1, 1 )-WR*D1 ) )
250 $ RES = ZERO
251 IF( SCALE.GT.ONE )
252 $ RES = RES + ONE / EPS
253 RES = RES + ABS( XNORM-
254 $ ABS( X( 1, 1 ) )-
255 $ ABS( X( 1, 2 ) ) ) /
256 $ MAX( SMLNUM, XNORM ) / EPS
257 IF( INFO.NE.0 .AND. INFO.NE.1 )
258 $ RES = RES + ONE / EPS
259 KNT = KNT + 1
260 IF( RES.GT.RMAX ) THEN
261 LMAX = KNT
262 RMAX = RES
263 END IF
264 40 CONTINUE
265 50 CONTINUE
266 60 CONTINUE
267 70 CONTINUE
268 *
269 NA = 2
270 NW = 1
271 DO 100 IA = 1, 3
272 A( 1, 1 ) = VAB( IA )
273 A( 1, 2 ) = -THREE*VAB( IA )
274 A( 2, 1 ) = -SEVEN*VAB( IA )
275 A( 2, 2 ) = TWNONE*VAB( IA )
276 DO 90 IB = 1, 3
277 B( 1, 1 ) = VAB( IB )
278 B( 2, 1 ) = -TWO*VAB( IB )
279 DO 80 IWR = 1, 4
280 IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND. CA.EQ.
281 $ ONE ) THEN
282 WR = VWR( IWR )*A( 1, 1 )
283 ELSE
284 WR = VWR( IWR )
285 END IF
286 WI = ZERO
287 CALL SLALN2( LTRANS( ITRANS ), NA, NW,
288 $ SMIN, CA, A, 2, D1, D2, B, 2,
289 $ WR, WI, X, 2, SCALE, XNORM,
290 $ INFO )
291 IF( INFO.LT.0 )
292 $ NINFO( 1 ) = NINFO( 1 ) + 1
293 IF( INFO.GT.0 )
294 $ NINFO( 2 ) = NINFO( 2 ) + 1
295 IF( ITRANS.EQ.1 ) THEN
296 TMP = A( 1, 2 )
297 A( 1, 2 ) = A( 2, 1 )
298 A( 2, 1 ) = TMP
299 END IF
300 RES = ABS( ( CA*A( 1, 1 )-WR*D1 )*
301 $ X( 1, 1 )+( CA*A( 1, 2 ) )*
302 $ X( 2, 1 )-SCALE*B( 1, 1 ) )
303 RES = RES + ABS( ( CA*A( 2, 1 ) )*
304 $ X( 1, 1 )+( CA*A( 2, 2 )-WR*D2 )*
305 $ X( 2, 1 )-SCALE*B( 2, 1 ) )
306 IF( INFO.EQ.0 ) THEN
307 DEN = MAX( EPS*( MAX( ABS( CA*A( 1,
308 $ 1 )-WR*D1 )+ABS( CA*A( 1, 2 ) ),
309 $ ABS( CA*A( 2, 1 ) )+ABS( CA*A( 2,
310 $ 2 )-WR*D2 ) )*MAX( ABS( X( 1,
311 $ 1 ) ), ABS( X( 2, 1 ) ) ) ),
312 $ SMLNUM )
313 ELSE
314 DEN = MAX( EPS*( MAX( SMIN / EPS,
315 $ MAX( ABS( CA*A( 1,
316 $ 1 )-WR*D1 )+ABS( CA*A( 1, 2 ) ),
317 $ ABS( CA*A( 2, 1 ) )+ABS( CA*A( 2,
318 $ 2 )-WR*D2 ) ) )*MAX( ABS( X( 1,
319 $ 1 ) ), ABS( X( 2, 1 ) ) ) ),
320 $ SMLNUM )
321 END IF
322 RES = RES / DEN
323 IF( ABS( X( 1, 1 ) ).LT.UNFL .AND.
324 $ ABS( X( 2, 1 ) ).LT.UNFL .AND.
325 $ ABS( B( 1, 1 ) )+ABS( B( 2, 1 ) ).LE.
326 $ SMLNUM*( ABS( CA*A( 1,
327 $ 1 )-WR*D1 )+ABS( CA*A( 1,
328 $ 2 ) )+ABS( CA*A( 2,
329 $ 1 ) )+ABS( CA*A( 2, 2 )-WR*D2 ) ) )
330 $ RES = ZERO
331 IF( SCALE.GT.ONE )
332 $ RES = RES + ONE / EPS
333 RES = RES + ABS( XNORM-
334 $ MAX( ABS( X( 1, 1 ) ), ABS( X( 2,
335 $ 1 ) ) ) ) / MAX( SMLNUM, XNORM ) /
336 $ EPS
337 IF( INFO.NE.0 .AND. INFO.NE.1 )
338 $ RES = RES + ONE / EPS
339 KNT = KNT + 1
340 IF( RES.GT.RMAX ) THEN
341 LMAX = KNT
342 RMAX = RES
343 END IF
344 80 CONTINUE
345 90 CONTINUE
346 100 CONTINUE
347 *
348 NA = 2
349 NW = 2
350 DO 140 IA = 1, 3
351 A( 1, 1 ) = VAB( IA )*TWO
352 A( 1, 2 ) = -THREE*VAB( IA )
353 A( 2, 1 ) = -SEVEN*VAB( IA )
354 A( 2, 2 ) = TWNONE*VAB( IA )
355 DO 130 IB = 1, 3
356 B( 1, 1 ) = VAB( IB )
357 B( 2, 1 ) = -TWO*VAB( IB )
358 B( 1, 2 ) = FOUR*VAB( IB )
359 B( 2, 2 ) = -SEVEN*VAB( IB )
360 DO 120 IWR = 1, 4
361 IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND. CA.EQ.
362 $ ONE ) THEN
363 WR = VWR( IWR )*A( 1, 1 )
364 ELSE
365 WR = VWR( IWR )
366 END IF
367 DO 110 IWI = 1, 4
368 IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND.
369 $ CA.EQ.ONE ) THEN
370 WI = VWI( IWI )*A( 1, 1 )
371 ELSE
372 WI = VWI( IWI )
373 END IF
374 CALL SLALN2( LTRANS( ITRANS ), NA, NW,
375 $ SMIN, CA, A, 2, D1, D2, B,
376 $ 2, WR, WI, X, 2, SCALE,
377 $ XNORM, INFO )
378 IF( INFO.LT.0 )
379 $ NINFO( 1 ) = NINFO( 1 ) + 1
380 IF( INFO.GT.0 )
381 $ NINFO( 2 ) = NINFO( 2 ) + 1
382 IF( ITRANS.EQ.1 ) THEN
383 TMP = A( 1, 2 )
384 A( 1, 2 ) = A( 2, 1 )
385 A( 2, 1 ) = TMP
386 END IF
387 RES = ABS( ( CA*A( 1, 1 )-WR*D1 )*
388 $ X( 1, 1 )+( CA*A( 1, 2 ) )*
389 $ X( 2, 1 )+( WI*D1 )*X( 1, 2 )-
390 $ SCALE*B( 1, 1 ) )
391 RES = RES + ABS( ( CA*A( 1,
392 $ 1 )-WR*D1 )*X( 1, 2 )+
393 $ ( CA*A( 1, 2 ) )*X( 2, 2 )-
394 $ ( WI*D1 )*X( 1, 1 )-SCALE*
395 $ B( 1, 2 ) )
396 RES = RES + ABS( ( CA*A( 2, 1 ) )*
397 $ X( 1, 1 )+( CA*A( 2, 2 )-WR*D2 )*
398 $ X( 2, 1 )+( WI*D2 )*X( 2, 2 )-
399 $ SCALE*B( 2, 1 ) )
400 RES = RES + ABS( ( CA*A( 2, 1 ) )*
401 $ X( 1, 2 )+( CA*A( 2, 2 )-WR*D2 )*
402 $ X( 2, 2 )-( WI*D2 )*X( 2, 1 )-
403 $ SCALE*B( 2, 2 ) )
404 IF( INFO.EQ.0 ) THEN
405 DEN = MAX( EPS*( MAX( ABS( CA*A( 1,
406 $ 1 )-WR*D1 )+ABS( CA*A( 1,
407 $ 2 ) )+ABS( WI*D1 ),
408 $ ABS( CA*A( 2,
409 $ 1 ) )+ABS( CA*A( 2,
410 $ 2 )-WR*D2 )+ABS( WI*D2 ) )*
411 $ MAX( ABS( X( 1,
412 $ 1 ) )+ABS( X( 2, 1 ) ),
413 $ ABS( X( 1, 2 ) )+ABS( X( 2,
414 $ 2 ) ) ) ), SMLNUM )
415 ELSE
416 DEN = MAX( EPS*( MAX( SMIN / EPS,
417 $ MAX( ABS( CA*A( 1,
418 $ 1 )-WR*D1 )+ABS( CA*A( 1,
419 $ 2 ) )+ABS( WI*D1 ),
420 $ ABS( CA*A( 2,
421 $ 1 ) )+ABS( CA*A( 2,
422 $ 2 )-WR*D2 )+ABS( WI*D2 ) ) )*
423 $ MAX( ABS( X( 1,
424 $ 1 ) )+ABS( X( 2, 1 ) ),
425 $ ABS( X( 1, 2 ) )+ABS( X( 2,
426 $ 2 ) ) ) ), SMLNUM )
427 END IF
428 RES = RES / DEN
429 IF( ABS( X( 1, 1 ) ).LT.UNFL .AND.
430 $ ABS( X( 2, 1 ) ).LT.UNFL .AND.
431 $ ABS( X( 1, 2 ) ).LT.UNFL .AND.
432 $ ABS( X( 2, 2 ) ).LT.UNFL .AND.
433 $ ABS( B( 1, 1 ) )+
434 $ ABS( B( 2, 1 ) ).LE.SMLNUM*
435 $ ( ABS( CA*A( 1, 1 )-WR*D1 )+
436 $ ABS( CA*A( 1, 2 ) )+ABS( CA*A( 2,
437 $ 1 ) )+ABS( CA*A( 2,
438 $ 2 )-WR*D2 )+ABS( WI*D2 )+ABS( WI*
439 $ D1 ) ) )RES = ZERO
440 IF( SCALE.GT.ONE )
441 $ RES = RES + ONE / EPS
442 RES = RES + ABS( XNORM-
443 $ MAX( ABS( X( 1, 1 ) )+ABS( X( 1,
444 $ 2 ) ), ABS( X( 2,
445 $ 1 ) )+ABS( X( 2, 2 ) ) ) ) /
446 $ MAX( SMLNUM, XNORM ) / EPS
447 IF( INFO.NE.0 .AND. INFO.NE.1 )
448 $ RES = RES + ONE / EPS
449 KNT = KNT + 1
450 IF( RES.GT.RMAX ) THEN
451 LMAX = KNT
452 RMAX = RES
453 END IF
454 110 CONTINUE
455 120 CONTINUE
456 130 CONTINUE
457 140 CONTINUE
458 150 CONTINUE
459 160 CONTINUE
460 170 CONTINUE
461 180 CONTINUE
462 190 CONTINUE
463 *
464 RETURN
465 *
466 * End of SGET31
467 *
468 END
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER KNT, LMAX
9 REAL RMAX
10 * ..
11 * .. Array Arguments ..
12 INTEGER NINFO( 2 )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * SGET31 tests SLALN2, a routine for solving
19 *
20 * (ca A - w D)X = sB
21 *
22 * where A is an NA by NA matrix (NA=1 or 2 only), w is a real (NW=1) or
23 * complex (NW=2) constant, ca is a real constant, D is an NA by NA real
24 * diagonal matrix, and B is an NA by NW matrix (when NW=2 the second
25 * column of B contains the imaginary part of the solution). The code
26 * returns X and s, where s is a scale factor, less than or equal to 1,
27 * which is chosen to avoid overflow in X.
28 *
29 * If any singular values of ca A-w D are less than another input
30 * parameter SMIN, they are perturbed up to SMIN.
31 *
32 * The test condition is that the scaled residual
33 *
34 * norm( (ca A-w D)*X - s*B ) /
35 * ( max( ulp*norm(ca A-w D), SMIN )*norm(X) )
36 *
37 * should be on the order of 1. Here, ulp is the machine precision.
38 * Also, it is verified that SCALE is less than or equal to 1, and that
39 * XNORM = infinity-norm(X).
40 *
41 * Arguments
42 * ==========
43 *
44 * RMAX (output) REAL
45 * Value of the largest test ratio.
46 *
47 * LMAX (output) INTEGER
48 * Example number where largest test ratio achieved.
49 *
50 * NINFO (output) INTEGER array, dimension (3)
51 * NINFO(1) = number of examples with INFO less than 0
52 * NINFO(2) = number of examples with INFO greater than 0
53 *
54 * KNT (output) INTEGER
55 * Total number of examples tested.
56 *
57 * =====================================================================
58 *
59 * .. Parameters ..
60 REAL ZERO, HALF, ONE
61 PARAMETER ( ZERO = 0.0E0, HALF = 0.5E0, ONE = 1.0E0 )
62 REAL TWO, THREE, FOUR
63 PARAMETER ( TWO = 2.0E0, THREE = 3.0E0, FOUR = 4.0E0 )
64 REAL SEVEN, TEN
65 PARAMETER ( SEVEN = 7.0E0, TEN = 10.0E0 )
66 REAL TWNONE
67 PARAMETER ( TWNONE = 21.0E0 )
68 * ..
69 * .. Local Scalars ..
70 INTEGER IA, IB, ICA, ID1, ID2, INFO, ISMIN, ITRANS,
71 $ IWI, IWR, NA, NW
72 REAL BIGNUM, CA, D1, D2, DEN, EPS, RES, SCALE, SMIN,
73 $ SMLNUM, TMP, UNFL, WI, WR, XNORM
74 * ..
75 * .. Local Arrays ..
76 LOGICAL LTRANS( 0: 1 )
77 REAL A( 2, 2 ), B( 2, 2 ), VAB( 3 ), VCA( 5 ),
78 $ VDD( 4 ), VSMIN( 4 ), VWI( 4 ), VWR( 4 ),
79 $ X( 2, 2 )
80 * ..
81 * .. External Functions ..
82 REAL SLAMCH
83 EXTERNAL SLAMCH
84 * ..
85 * .. External Subroutines ..
86 EXTERNAL SLABAD, SLALN2
87 * ..
88 * .. Intrinsic Functions ..
89 INTRINSIC ABS, MAX, SQRT
90 * ..
91 * .. Data statements ..
92 DATA LTRANS / .FALSE., .TRUE. /
93 * ..
94 * .. Executable Statements ..
95 *
96 * Get machine parameters
97 *
98 EPS = SLAMCH( 'P' )
99 UNFL = SLAMCH( 'U' )
100 SMLNUM = SLAMCH( 'S' ) / EPS
101 BIGNUM = ONE / SMLNUM
102 CALL SLABAD( SMLNUM, BIGNUM )
103 *
104 * Set up test case parameters
105 *
106 VSMIN( 1 ) = SMLNUM
107 VSMIN( 2 ) = EPS
108 VSMIN( 3 ) = ONE / ( TEN*TEN )
109 VSMIN( 4 ) = ONE / EPS
110 VAB( 1 ) = SQRT( SMLNUM )
111 VAB( 2 ) = ONE
112 VAB( 3 ) = SQRT( BIGNUM )
113 VWR( 1 ) = ZERO
114 VWR( 2 ) = HALF
115 VWR( 3 ) = TWO
116 VWR( 4 ) = ONE
117 VWI( 1 ) = SMLNUM
118 VWI( 2 ) = EPS
119 VWI( 3 ) = ONE
120 VWI( 4 ) = TWO
121 VDD( 1 ) = SQRT( SMLNUM )
122 VDD( 2 ) = ONE
123 VDD( 3 ) = TWO
124 VDD( 4 ) = SQRT( BIGNUM )
125 VCA( 1 ) = ZERO
126 VCA( 2 ) = SQRT( SMLNUM )
127 VCA( 3 ) = EPS
128 VCA( 4 ) = HALF
129 VCA( 5 ) = ONE
130 *
131 KNT = 0
132 NINFO( 1 ) = 0
133 NINFO( 2 ) = 0
134 LMAX = 0
135 RMAX = ZERO
136 *
137 * Begin test loop
138 *
139 DO 190 ID1 = 1, 4
140 D1 = VDD( ID1 )
141 DO 180 ID2 = 1, 4
142 D2 = VDD( ID2 )
143 DO 170 ICA = 1, 5
144 CA = VCA( ICA )
145 DO 160 ITRANS = 0, 1
146 DO 150 ISMIN = 1, 4
147 SMIN = VSMIN( ISMIN )
148 *
149 NA = 1
150 NW = 1
151 DO 30 IA = 1, 3
152 A( 1, 1 ) = VAB( IA )
153 DO 20 IB = 1, 3
154 B( 1, 1 ) = VAB( IB )
155 DO 10 IWR = 1, 4
156 IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND. CA.EQ.
157 $ ONE ) THEN
158 WR = VWR( IWR )*A( 1, 1 )
159 ELSE
160 WR = VWR( IWR )
161 END IF
162 WI = ZERO
163 CALL SLALN2( LTRANS( ITRANS ), NA, NW,
164 $ SMIN, CA, A, 2, D1, D2, B, 2,
165 $ WR, WI, X, 2, SCALE, XNORM,
166 $ INFO )
167 IF( INFO.LT.0 )
168 $ NINFO( 1 ) = NINFO( 1 ) + 1
169 IF( INFO.GT.0 )
170 $ NINFO( 2 ) = NINFO( 2 ) + 1
171 RES = ABS( ( CA*A( 1, 1 )-WR*D1 )*
172 $ X( 1, 1 )-SCALE*B( 1, 1 ) )
173 IF( INFO.EQ.0 ) THEN
174 DEN = MAX( EPS*( ABS( ( CA*A( 1,
175 $ 1 )-WR*D1 )*X( 1, 1 ) ) ),
176 $ SMLNUM )
177 ELSE
178 DEN = MAX( SMIN*ABS( X( 1, 1 ) ),
179 $ SMLNUM )
180 END IF
181 RES = RES / DEN
182 IF( ABS( X( 1, 1 ) ).LT.UNFL .AND.
183 $ ABS( B( 1, 1 ) ).LE.SMLNUM*
184 $ ABS( CA*A( 1, 1 )-WR*D1 ) )RES = ZERO
185 IF( SCALE.GT.ONE )
186 $ RES = RES + ONE / EPS
187 RES = RES + ABS( XNORM-ABS( X( 1, 1 ) ) )
188 $ / MAX( SMLNUM, XNORM ) / EPS
189 IF( INFO.NE.0 .AND. INFO.NE.1 )
190 $ RES = RES + ONE / EPS
191 KNT = KNT + 1
192 IF( RES.GT.RMAX ) THEN
193 LMAX = KNT
194 RMAX = RES
195 END IF
196 10 CONTINUE
197 20 CONTINUE
198 30 CONTINUE
199 *
200 NA = 1
201 NW = 2
202 DO 70 IA = 1, 3
203 A( 1, 1 ) = VAB( IA )
204 DO 60 IB = 1, 3
205 B( 1, 1 ) = VAB( IB )
206 B( 1, 2 ) = -HALF*VAB( IB )
207 DO 50 IWR = 1, 4
208 IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND. CA.EQ.
209 $ ONE ) THEN
210 WR = VWR( IWR )*A( 1, 1 )
211 ELSE
212 WR = VWR( IWR )
213 END IF
214 DO 40 IWI = 1, 4
215 IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND.
216 $ CA.EQ.ONE ) THEN
217 WI = VWI( IWI )*A( 1, 1 )
218 ELSE
219 WI = VWI( IWI )
220 END IF
221 CALL SLALN2( LTRANS( ITRANS ), NA, NW,
222 $ SMIN, CA, A, 2, D1, D2, B,
223 $ 2, WR, WI, X, 2, SCALE,
224 $ XNORM, INFO )
225 IF( INFO.LT.0 )
226 $ NINFO( 1 ) = NINFO( 1 ) + 1
227 IF( INFO.GT.0 )
228 $ NINFO( 2 ) = NINFO( 2 ) + 1
229 RES = ABS( ( CA*A( 1, 1 )-WR*D1 )*
230 $ X( 1, 1 )+( WI*D1 )*X( 1, 2 )-
231 $ SCALE*B( 1, 1 ) )
232 RES = RES + ABS( ( -WI*D1 )*X( 1, 1 )+
233 $ ( CA*A( 1, 1 )-WR*D1 )*X( 1, 2 )-
234 $ SCALE*B( 1, 2 ) )
235 IF( INFO.EQ.0 ) THEN
236 DEN = MAX( EPS*( MAX( ABS( CA*A( 1,
237 $ 1 )-WR*D1 ), ABS( D1*WI ) )*
238 $ ( ABS( X( 1, 1 ) )+ABS( X( 1,
239 $ 2 ) ) ) ), SMLNUM )
240 ELSE
241 DEN = MAX( SMIN*( ABS( X( 1,
242 $ 1 ) )+ABS( X( 1, 2 ) ) ),
243 $ SMLNUM )
244 END IF
245 RES = RES / DEN
246 IF( ABS( X( 1, 1 ) ).LT.UNFL .AND.
247 $ ABS( X( 1, 2 ) ).LT.UNFL .AND.
248 $ ABS( B( 1, 1 ) ).LE.SMLNUM*
249 $ ABS( CA*A( 1, 1 )-WR*D1 ) )
250 $ RES = ZERO
251 IF( SCALE.GT.ONE )
252 $ RES = RES + ONE / EPS
253 RES = RES + ABS( XNORM-
254 $ ABS( X( 1, 1 ) )-
255 $ ABS( X( 1, 2 ) ) ) /
256 $ MAX( SMLNUM, XNORM ) / EPS
257 IF( INFO.NE.0 .AND. INFO.NE.1 )
258 $ RES = RES + ONE / EPS
259 KNT = KNT + 1
260 IF( RES.GT.RMAX ) THEN
261 LMAX = KNT
262 RMAX = RES
263 END IF
264 40 CONTINUE
265 50 CONTINUE
266 60 CONTINUE
267 70 CONTINUE
268 *
269 NA = 2
270 NW = 1
271 DO 100 IA = 1, 3
272 A( 1, 1 ) = VAB( IA )
273 A( 1, 2 ) = -THREE*VAB( IA )
274 A( 2, 1 ) = -SEVEN*VAB( IA )
275 A( 2, 2 ) = TWNONE*VAB( IA )
276 DO 90 IB = 1, 3
277 B( 1, 1 ) = VAB( IB )
278 B( 2, 1 ) = -TWO*VAB( IB )
279 DO 80 IWR = 1, 4
280 IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND. CA.EQ.
281 $ ONE ) THEN
282 WR = VWR( IWR )*A( 1, 1 )
283 ELSE
284 WR = VWR( IWR )
285 END IF
286 WI = ZERO
287 CALL SLALN2( LTRANS( ITRANS ), NA, NW,
288 $ SMIN, CA, A, 2, D1, D2, B, 2,
289 $ WR, WI, X, 2, SCALE, XNORM,
290 $ INFO )
291 IF( INFO.LT.0 )
292 $ NINFO( 1 ) = NINFO( 1 ) + 1
293 IF( INFO.GT.0 )
294 $ NINFO( 2 ) = NINFO( 2 ) + 1
295 IF( ITRANS.EQ.1 ) THEN
296 TMP = A( 1, 2 )
297 A( 1, 2 ) = A( 2, 1 )
298 A( 2, 1 ) = TMP
299 END IF
300 RES = ABS( ( CA*A( 1, 1 )-WR*D1 )*
301 $ X( 1, 1 )+( CA*A( 1, 2 ) )*
302 $ X( 2, 1 )-SCALE*B( 1, 1 ) )
303 RES = RES + ABS( ( CA*A( 2, 1 ) )*
304 $ X( 1, 1 )+( CA*A( 2, 2 )-WR*D2 )*
305 $ X( 2, 1 )-SCALE*B( 2, 1 ) )
306 IF( INFO.EQ.0 ) THEN
307 DEN = MAX( EPS*( MAX( ABS( CA*A( 1,
308 $ 1 )-WR*D1 )+ABS( CA*A( 1, 2 ) ),
309 $ ABS( CA*A( 2, 1 ) )+ABS( CA*A( 2,
310 $ 2 )-WR*D2 ) )*MAX( ABS( X( 1,
311 $ 1 ) ), ABS( X( 2, 1 ) ) ) ),
312 $ SMLNUM )
313 ELSE
314 DEN = MAX( EPS*( MAX( SMIN / EPS,
315 $ MAX( ABS( CA*A( 1,
316 $ 1 )-WR*D1 )+ABS( CA*A( 1, 2 ) ),
317 $ ABS( CA*A( 2, 1 ) )+ABS( CA*A( 2,
318 $ 2 )-WR*D2 ) ) )*MAX( ABS( X( 1,
319 $ 1 ) ), ABS( X( 2, 1 ) ) ) ),
320 $ SMLNUM )
321 END IF
322 RES = RES / DEN
323 IF( ABS( X( 1, 1 ) ).LT.UNFL .AND.
324 $ ABS( X( 2, 1 ) ).LT.UNFL .AND.
325 $ ABS( B( 1, 1 ) )+ABS( B( 2, 1 ) ).LE.
326 $ SMLNUM*( ABS( CA*A( 1,
327 $ 1 )-WR*D1 )+ABS( CA*A( 1,
328 $ 2 ) )+ABS( CA*A( 2,
329 $ 1 ) )+ABS( CA*A( 2, 2 )-WR*D2 ) ) )
330 $ RES = ZERO
331 IF( SCALE.GT.ONE )
332 $ RES = RES + ONE / EPS
333 RES = RES + ABS( XNORM-
334 $ MAX( ABS( X( 1, 1 ) ), ABS( X( 2,
335 $ 1 ) ) ) ) / MAX( SMLNUM, XNORM ) /
336 $ EPS
337 IF( INFO.NE.0 .AND. INFO.NE.1 )
338 $ RES = RES + ONE / EPS
339 KNT = KNT + 1
340 IF( RES.GT.RMAX ) THEN
341 LMAX = KNT
342 RMAX = RES
343 END IF
344 80 CONTINUE
345 90 CONTINUE
346 100 CONTINUE
347 *
348 NA = 2
349 NW = 2
350 DO 140 IA = 1, 3
351 A( 1, 1 ) = VAB( IA )*TWO
352 A( 1, 2 ) = -THREE*VAB( IA )
353 A( 2, 1 ) = -SEVEN*VAB( IA )
354 A( 2, 2 ) = TWNONE*VAB( IA )
355 DO 130 IB = 1, 3
356 B( 1, 1 ) = VAB( IB )
357 B( 2, 1 ) = -TWO*VAB( IB )
358 B( 1, 2 ) = FOUR*VAB( IB )
359 B( 2, 2 ) = -SEVEN*VAB( IB )
360 DO 120 IWR = 1, 4
361 IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND. CA.EQ.
362 $ ONE ) THEN
363 WR = VWR( IWR )*A( 1, 1 )
364 ELSE
365 WR = VWR( IWR )
366 END IF
367 DO 110 IWI = 1, 4
368 IF( D1.EQ.ONE .AND. D2.EQ.ONE .AND.
369 $ CA.EQ.ONE ) THEN
370 WI = VWI( IWI )*A( 1, 1 )
371 ELSE
372 WI = VWI( IWI )
373 END IF
374 CALL SLALN2( LTRANS( ITRANS ), NA, NW,
375 $ SMIN, CA, A, 2, D1, D2, B,
376 $ 2, WR, WI, X, 2, SCALE,
377 $ XNORM, INFO )
378 IF( INFO.LT.0 )
379 $ NINFO( 1 ) = NINFO( 1 ) + 1
380 IF( INFO.GT.0 )
381 $ NINFO( 2 ) = NINFO( 2 ) + 1
382 IF( ITRANS.EQ.1 ) THEN
383 TMP = A( 1, 2 )
384 A( 1, 2 ) = A( 2, 1 )
385 A( 2, 1 ) = TMP
386 END IF
387 RES = ABS( ( CA*A( 1, 1 )-WR*D1 )*
388 $ X( 1, 1 )+( CA*A( 1, 2 ) )*
389 $ X( 2, 1 )+( WI*D1 )*X( 1, 2 )-
390 $ SCALE*B( 1, 1 ) )
391 RES = RES + ABS( ( CA*A( 1,
392 $ 1 )-WR*D1 )*X( 1, 2 )+
393 $ ( CA*A( 1, 2 ) )*X( 2, 2 )-
394 $ ( WI*D1 )*X( 1, 1 )-SCALE*
395 $ B( 1, 2 ) )
396 RES = RES + ABS( ( CA*A( 2, 1 ) )*
397 $ X( 1, 1 )+( CA*A( 2, 2 )-WR*D2 )*
398 $ X( 2, 1 )+( WI*D2 )*X( 2, 2 )-
399 $ SCALE*B( 2, 1 ) )
400 RES = RES + ABS( ( CA*A( 2, 1 ) )*
401 $ X( 1, 2 )+( CA*A( 2, 2 )-WR*D2 )*
402 $ X( 2, 2 )-( WI*D2 )*X( 2, 1 )-
403 $ SCALE*B( 2, 2 ) )
404 IF( INFO.EQ.0 ) THEN
405 DEN = MAX( EPS*( MAX( ABS( CA*A( 1,
406 $ 1 )-WR*D1 )+ABS( CA*A( 1,
407 $ 2 ) )+ABS( WI*D1 ),
408 $ ABS( CA*A( 2,
409 $ 1 ) )+ABS( CA*A( 2,
410 $ 2 )-WR*D2 )+ABS( WI*D2 ) )*
411 $ MAX( ABS( X( 1,
412 $ 1 ) )+ABS( X( 2, 1 ) ),
413 $ ABS( X( 1, 2 ) )+ABS( X( 2,
414 $ 2 ) ) ) ), SMLNUM )
415 ELSE
416 DEN = MAX( EPS*( MAX( SMIN / EPS,
417 $ MAX( ABS( CA*A( 1,
418 $ 1 )-WR*D1 )+ABS( CA*A( 1,
419 $ 2 ) )+ABS( WI*D1 ),
420 $ ABS( CA*A( 2,
421 $ 1 ) )+ABS( CA*A( 2,
422 $ 2 )-WR*D2 )+ABS( WI*D2 ) ) )*
423 $ MAX( ABS( X( 1,
424 $ 1 ) )+ABS( X( 2, 1 ) ),
425 $ ABS( X( 1, 2 ) )+ABS( X( 2,
426 $ 2 ) ) ) ), SMLNUM )
427 END IF
428 RES = RES / DEN
429 IF( ABS( X( 1, 1 ) ).LT.UNFL .AND.
430 $ ABS( X( 2, 1 ) ).LT.UNFL .AND.
431 $ ABS( X( 1, 2 ) ).LT.UNFL .AND.
432 $ ABS( X( 2, 2 ) ).LT.UNFL .AND.
433 $ ABS( B( 1, 1 ) )+
434 $ ABS( B( 2, 1 ) ).LE.SMLNUM*
435 $ ( ABS( CA*A( 1, 1 )-WR*D1 )+
436 $ ABS( CA*A( 1, 2 ) )+ABS( CA*A( 2,
437 $ 1 ) )+ABS( CA*A( 2,
438 $ 2 )-WR*D2 )+ABS( WI*D2 )+ABS( WI*
439 $ D1 ) ) )RES = ZERO
440 IF( SCALE.GT.ONE )
441 $ RES = RES + ONE / EPS
442 RES = RES + ABS( XNORM-
443 $ MAX( ABS( X( 1, 1 ) )+ABS( X( 1,
444 $ 2 ) ), ABS( X( 2,
445 $ 1 ) )+ABS( X( 2, 2 ) ) ) ) /
446 $ MAX( SMLNUM, XNORM ) / EPS
447 IF( INFO.NE.0 .AND. INFO.NE.1 )
448 $ RES = RES + ONE / EPS
449 KNT = KNT + 1
450 IF( RES.GT.RMAX ) THEN
451 LMAX = KNT
452 RMAX = RES
453 END IF
454 110 CONTINUE
455 120 CONTINUE
456 130 CONTINUE
457 140 CONTINUE
458 150 CONTINUE
459 160 CONTINUE
460 170 CONTINUE
461 180 CONTINUE
462 190 CONTINUE
463 *
464 RETURN
465 *
466 * End of SGET31
467 *
468 END