1 SUBROUTINE SGET32( 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, NINFO
9 REAL RMAX
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * SGET32 tests SLASY2, a routine for solving
16 *
17 * op(TL)*X + ISGN*X*op(TR) = SCALE*B
18 *
19 * where TL is N1 by N1, TR is N2 by N2, and N1,N2 =1 or 2 only.
20 * X and B are N1 by N2, op() is an optional transpose, an
21 * ISGN = 1 or -1. SCALE is chosen less than or equal to 1 to
22 * avoid overflow in X.
23 *
24 * The test condition is that the scaled residual
25 *
26 * norm( op(TL)*X + ISGN*X*op(TR) = SCALE*B )
27 * / ( max( ulp*norm(TL), ulp*norm(TR)) * norm(X), SMLNUM )
28 *
29 * should be on the order of 1. Here, ulp is the machine precision.
30 * Also, it is verified that SCALE is less than or equal to 1, and
31 * that XNORM = infinity-norm(X).
32 *
33 * Arguments
34 * ==========
35 *
36 * RMAX (output) REAL
37 * Value of the largest test ratio.
38 *
39 * LMAX (output) INTEGER
40 * Example number where largest test ratio achieved.
41 *
42 * NINFO (output) INTEGER
43 * Number of examples returned with INFO.NE.0.
44 *
45 * KNT (output) INTEGER
46 * Total number of examples tested.
47 *
48 * =====================================================================
49 *
50 * .. Parameters ..
51 REAL ZERO, ONE
52 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
53 REAL TWO, FOUR, EIGHT
54 PARAMETER ( TWO = 2.0E0, FOUR = 4.0E0, EIGHT = 8.0E0 )
55 * ..
56 * .. Local Scalars ..
57 LOGICAL LTRANL, LTRANR
58 INTEGER IB, IB1, IB2, IB3, INFO, ISGN, ITL, ITLSCL,
59 $ ITR, ITRANL, ITRANR, ITRSCL, N1, N2
60 REAL BIGNUM, DEN, EPS, RES, SCALE, SGN, SMLNUM, TMP,
61 $ TNRM, XNORM, XNRM
62 * ..
63 * .. Local Arrays ..
64 INTEGER ITVAL( 2, 2, 8 )
65 REAL B( 2, 2 ), TL( 2, 2 ), TR( 2, 2 ), VAL( 3 ),
66 $ X( 2, 2 )
67 * ..
68 * .. External Functions ..
69 REAL SLAMCH
70 EXTERNAL SLAMCH
71 * ..
72 * .. External Subroutines ..
73 EXTERNAL SLABAD, SLASY2
74 * ..
75 * .. Intrinsic Functions ..
76 INTRINSIC ABS, MAX, MIN, SQRT
77 * ..
78 * .. Data statements ..
79 DATA ITVAL / 8, 4, 2, 1, 4, 8, 1, 2, 2, 1, 8, 4, 1,
80 $ 2, 4, 8, 9, 4, 2, 1, 4, 9, 1, 2, 2, 1, 9, 4, 1,
81 $ 2, 4, 9 /
82 * ..
83 * .. Executable Statements ..
84 *
85 * Get machine parameters
86 *
87 EPS = SLAMCH( 'P' )
88 SMLNUM = SLAMCH( 'S' ) / EPS
89 BIGNUM = ONE / SMLNUM
90 CALL SLABAD( SMLNUM, BIGNUM )
91 *
92 * Set up test case parameters
93 *
94 VAL( 1 ) = SQRT( SMLNUM )
95 VAL( 2 ) = ONE
96 VAL( 3 ) = SQRT( BIGNUM )
97 *
98 KNT = 0
99 NINFO = 0
100 LMAX = 0
101 RMAX = ZERO
102 *
103 * Begin test loop
104 *
105 DO 230 ITRANL = 0, 1
106 DO 220 ITRANR = 0, 1
107 DO 210 ISGN = -1, 1, 2
108 SGN = ISGN
109 LTRANL = ITRANL.EQ.1
110 LTRANR = ITRANR.EQ.1
111 *
112 N1 = 1
113 N2 = 1
114 DO 30 ITL = 1, 3
115 DO 20 ITR = 1, 3
116 DO 10 IB = 1, 3
117 TL( 1, 1 ) = VAL( ITL )
118 TR( 1, 1 ) = VAL( ITR )
119 B( 1, 1 ) = VAL( IB )
120 KNT = KNT + 1
121 CALL SLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL,
122 $ 2, TR, 2, B, 2, SCALE, X, 2, XNORM,
123 $ INFO )
124 IF( INFO.NE.0 )
125 $ NINFO = NINFO + 1
126 RES = ABS( ( TL( 1, 1 )+SGN*TR( 1, 1 ) )*
127 $ X( 1, 1 )-SCALE*B( 1, 1 ) )
128 IF( INFO.EQ.0 ) THEN
129 DEN = MAX( EPS*( ( ABS( TR( 1,
130 $ 1 ) )+ABS( TL( 1, 1 ) ) )*ABS( X( 1,
131 $ 1 ) ) ), SMLNUM )
132 ELSE
133 DEN = SMLNUM*MAX( ABS( X( 1, 1 ) ), ONE )
134 END IF
135 RES = RES / DEN
136 IF( SCALE.GT.ONE )
137 $ RES = RES + ONE / EPS
138 RES = RES + ABS( XNORM-ABS( X( 1, 1 ) ) ) /
139 $ MAX( SMLNUM, XNORM ) / EPS
140 IF( INFO.NE.0 .AND. INFO.NE.1 )
141 $ RES = RES + ONE / EPS
142 IF( RES.GT.RMAX ) THEN
143 LMAX = KNT
144 RMAX = RES
145 END IF
146 10 CONTINUE
147 20 CONTINUE
148 30 CONTINUE
149 *
150 N1 = 2
151 N2 = 1
152 DO 80 ITL = 1, 8
153 DO 70 ITLSCL = 1, 3
154 DO 60 ITR = 1, 3
155 DO 50 IB1 = 1, 3
156 DO 40 IB2 = 1, 3
157 B( 1, 1 ) = VAL( IB1 )
158 B( 2, 1 ) = -FOUR*VAL( IB2 )
159 TL( 1, 1 ) = ITVAL( 1, 1, ITL )*
160 $ VAL( ITLSCL )
161 TL( 2, 1 ) = ITVAL( 2, 1, ITL )*
162 $ VAL( ITLSCL )
163 TL( 1, 2 ) = ITVAL( 1, 2, ITL )*
164 $ VAL( ITLSCL )
165 TL( 2, 2 ) = ITVAL( 2, 2, ITL )*
166 $ VAL( ITLSCL )
167 TR( 1, 1 ) = VAL( ITR )
168 KNT = KNT + 1
169 CALL SLASY2( LTRANL, LTRANR, ISGN, N1, N2,
170 $ TL, 2, TR, 2, B, 2, SCALE, X,
171 $ 2, XNORM, INFO )
172 IF( INFO.NE.0 )
173 $ NINFO = NINFO + 1
174 IF( LTRANL ) THEN
175 TMP = TL( 1, 2 )
176 TL( 1, 2 ) = TL( 2, 1 )
177 TL( 2, 1 ) = TMP
178 END IF
179 RES = ABS( ( TL( 1, 1 )+SGN*TR( 1, 1 ) )*
180 $ X( 1, 1 )+TL( 1, 2 )*X( 2, 1 )-
181 $ SCALE*B( 1, 1 ) )
182 RES = RES + ABS( ( TL( 2, 2 )+SGN*TR( 1,
183 $ 1 ) )*X( 2, 1 )+TL( 2, 1 )*
184 $ X( 1, 1 )-SCALE*B( 2, 1 ) )
185 TNRM = ABS( TR( 1, 1 ) ) +
186 $ ABS( TL( 1, 1 ) ) +
187 $ ABS( TL( 1, 2 ) ) +
188 $ ABS( TL( 2, 1 ) ) +
189 $ ABS( TL( 2, 2 ) )
190 XNRM = MAX( ABS( X( 1, 1 ) ),
191 $ ABS( X( 2, 1 ) ) )
192 DEN = MAX( SMLNUM, SMLNUM*XNRM,
193 $ ( TNRM*EPS )*XNRM )
194 RES = RES / DEN
195 IF( SCALE.GT.ONE )
196 $ RES = RES + ONE / EPS
197 RES = RES + ABS( XNORM-XNRM ) /
198 $ MAX( SMLNUM, XNORM ) / EPS
199 IF( RES.GT.RMAX ) THEN
200 LMAX = KNT
201 RMAX = RES
202 END IF
203 40 CONTINUE
204 50 CONTINUE
205 60 CONTINUE
206 70 CONTINUE
207 80 CONTINUE
208 *
209 N1 = 1
210 N2 = 2
211 DO 130 ITR = 1, 8
212 DO 120 ITRSCL = 1, 3
213 DO 110 ITL = 1, 3
214 DO 100 IB1 = 1, 3
215 DO 90 IB2 = 1, 3
216 B( 1, 1 ) = VAL( IB1 )
217 B( 1, 2 ) = -TWO*VAL( IB2 )
218 TR( 1, 1 ) = ITVAL( 1, 1, ITR )*
219 $ VAL( ITRSCL )
220 TR( 2, 1 ) = ITVAL( 2, 1, ITR )*
221 $ VAL( ITRSCL )
222 TR( 1, 2 ) = ITVAL( 1, 2, ITR )*
223 $ VAL( ITRSCL )
224 TR( 2, 2 ) = ITVAL( 2, 2, ITR )*
225 $ VAL( ITRSCL )
226 TL( 1, 1 ) = VAL( ITL )
227 KNT = KNT + 1
228 CALL SLASY2( LTRANL, LTRANR, ISGN, N1, N2,
229 $ TL, 2, TR, 2, B, 2, SCALE, X,
230 $ 2, XNORM, INFO )
231 IF( INFO.NE.0 )
232 $ NINFO = NINFO + 1
233 IF( LTRANR ) THEN
234 TMP = TR( 1, 2 )
235 TR( 1, 2 ) = TR( 2, 1 )
236 TR( 2, 1 ) = TMP
237 END IF
238 TNRM = ABS( TL( 1, 1 ) ) +
239 $ ABS( TR( 1, 1 ) ) +
240 $ ABS( TR( 1, 2 ) ) +
241 $ ABS( TR( 2, 2 ) ) +
242 $ ABS( TR( 2, 1 ) )
243 XNRM = ABS( X( 1, 1 ) ) + ABS( X( 1, 2 ) )
244 RES = ABS( ( ( TL( 1, 1 )+SGN*TR( 1,
245 $ 1 ) ) )*( X( 1, 1 ) )+
246 $ ( SGN*TR( 2, 1 ) )*( X( 1, 2 ) )-
247 $ ( SCALE*B( 1, 1 ) ) )
248 RES = RES + ABS( ( ( TL( 1, 1 )+SGN*TR( 2,
249 $ 2 ) ) )*( X( 1, 2 ) )+
250 $ ( SGN*TR( 1, 2 ) )*( X( 1, 1 ) )-
251 $ ( SCALE*B( 1, 2 ) ) )
252 DEN = MAX( SMLNUM, SMLNUM*XNRM,
253 $ ( TNRM*EPS )*XNRM )
254 RES = RES / DEN
255 IF( SCALE.GT.ONE )
256 $ RES = RES + ONE / EPS
257 RES = RES + ABS( XNORM-XNRM ) /
258 $ MAX( SMLNUM, XNORM ) / EPS
259 IF( RES.GT.RMAX ) THEN
260 LMAX = KNT
261 RMAX = RES
262 END IF
263 90 CONTINUE
264 100 CONTINUE
265 110 CONTINUE
266 120 CONTINUE
267 130 CONTINUE
268 *
269 N1 = 2
270 N2 = 2
271 DO 200 ITR = 1, 8
272 DO 190 ITRSCL = 1, 3
273 DO 180 ITL = 1, 8
274 DO 170 ITLSCL = 1, 3
275 DO 160 IB1 = 1, 3
276 DO 150 IB2 = 1, 3
277 DO 140 IB3 = 1, 3
278 B( 1, 1 ) = VAL( IB1 )
279 B( 2, 1 ) = -FOUR*VAL( IB2 )
280 B( 1, 2 ) = -TWO*VAL( IB3 )
281 B( 2, 2 ) = EIGHT*
282 $ MIN( VAL( IB1 ), VAL
283 $ ( IB2 ), VAL( IB3 ) )
284 TR( 1, 1 ) = ITVAL( 1, 1, ITR )*
285 $ VAL( ITRSCL )
286 TR( 2, 1 ) = ITVAL( 2, 1, ITR )*
287 $ VAL( ITRSCL )
288 TR( 1, 2 ) = ITVAL( 1, 2, ITR )*
289 $ VAL( ITRSCL )
290 TR( 2, 2 ) = ITVAL( 2, 2, ITR )*
291 $ VAL( ITRSCL )
292 TL( 1, 1 ) = ITVAL( 1, 1, ITL )*
293 $ VAL( ITLSCL )
294 TL( 2, 1 ) = ITVAL( 2, 1, ITL )*
295 $ VAL( ITLSCL )
296 TL( 1, 2 ) = ITVAL( 1, 2, ITL )*
297 $ VAL( ITLSCL )
298 TL( 2, 2 ) = ITVAL( 2, 2, ITL )*
299 $ VAL( ITLSCL )
300 KNT = KNT + 1
301 CALL SLASY2( LTRANL, LTRANR, ISGN,
302 $ N1, N2, TL, 2, TR, 2,
303 $ B, 2, SCALE, X, 2,
304 $ XNORM, INFO )
305 IF( INFO.NE.0 )
306 $ NINFO = NINFO + 1
307 IF( LTRANR ) THEN
308 TMP = TR( 1, 2 )
309 TR( 1, 2 ) = TR( 2, 1 )
310 TR( 2, 1 ) = TMP
311 END IF
312 IF( LTRANL ) THEN
313 TMP = TL( 1, 2 )
314 TL( 1, 2 ) = TL( 2, 1 )
315 TL( 2, 1 ) = TMP
316 END IF
317 TNRM = ABS( TR( 1, 1 ) ) +
318 $ ABS( TR( 2, 1 ) ) +
319 $ ABS( TR( 1, 2 ) ) +
320 $ ABS( TR( 2, 2 ) ) +
321 $ ABS( TL( 1, 1 ) ) +
322 $ ABS( TL( 2, 1 ) ) +
323 $ ABS( TL( 1, 2 ) ) +
324 $ ABS( TL( 2, 2 ) )
325 XNRM = MAX( ABS( X( 1, 1 ) )+
326 $ ABS( X( 1, 2 ) ),
327 $ ABS( X( 2, 1 ) )+
328 $ ABS( X( 2, 2 ) ) )
329 RES = ABS( ( ( TL( 1, 1 )+SGN*TR( 1,
330 $ 1 ) ) )*( X( 1, 1 ) )+
331 $ ( SGN*TR( 2, 1 ) )*
332 $ ( X( 1, 2 ) )+( TL( 1, 2 ) )*
333 $ ( X( 2, 1 ) )-
334 $ ( SCALE*B( 1, 1 ) ) )
335 RES = RES + ABS( ( TL( 1, 1 ) )*
336 $ ( X( 1, 2 ) )+
337 $ ( SGN*TR( 1, 2 ) )*
338 $ ( X( 1, 1 ) )+
339 $ ( SGN*TR( 2, 2 ) )*
340 $ ( X( 1, 2 ) )+( TL( 1, 2 ) )*
341 $ ( X( 2, 2 ) )-
342 $ ( SCALE*B( 1, 2 ) ) )
343 RES = RES + ABS( ( TL( 2, 1 ) )*
344 $ ( X( 1, 1 ) )+
345 $ ( SGN*TR( 1, 1 ) )*
346 $ ( X( 2, 1 ) )+
347 $ ( SGN*TR( 2, 1 ) )*
348 $ ( X( 2, 2 ) )+( TL( 2, 2 ) )*
349 $ ( X( 2, 1 ) )-
350 $ ( SCALE*B( 2, 1 ) ) )
351 RES = RES + ABS( ( ( TL( 2,
352 $ 2 )+SGN*TR( 2, 2 ) ) )*
353 $ ( X( 2, 2 ) )+
354 $ ( SGN*TR( 1, 2 ) )*
355 $ ( X( 2, 1 ) )+( TL( 2, 1 ) )*
356 $ ( X( 1, 2 ) )-
357 $ ( SCALE*B( 2, 2 ) ) )
358 DEN = MAX( SMLNUM, SMLNUM*XNRM,
359 $ ( TNRM*EPS )*XNRM )
360 RES = RES / DEN
361 IF( SCALE.GT.ONE )
362 $ RES = RES + ONE / EPS
363 RES = RES + ABS( XNORM-XNRM ) /
364 $ MAX( SMLNUM, XNORM ) / EPS
365 IF( RES.GT.RMAX ) THEN
366 LMAX = KNT
367 RMAX = RES
368 END IF
369 140 CONTINUE
370 150 CONTINUE
371 160 CONTINUE
372 170 CONTINUE
373 180 CONTINUE
374 190 CONTINUE
375 200 CONTINUE
376 210 CONTINUE
377 220 CONTINUE
378 230 CONTINUE
379 *
380 RETURN
381 *
382 * End of SGET32
383 *
384 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, NINFO
9 REAL RMAX
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * SGET32 tests SLASY2, a routine for solving
16 *
17 * op(TL)*X + ISGN*X*op(TR) = SCALE*B
18 *
19 * where TL is N1 by N1, TR is N2 by N2, and N1,N2 =1 or 2 only.
20 * X and B are N1 by N2, op() is an optional transpose, an
21 * ISGN = 1 or -1. SCALE is chosen less than or equal to 1 to
22 * avoid overflow in X.
23 *
24 * The test condition is that the scaled residual
25 *
26 * norm( op(TL)*X + ISGN*X*op(TR) = SCALE*B )
27 * / ( max( ulp*norm(TL), ulp*norm(TR)) * norm(X), SMLNUM )
28 *
29 * should be on the order of 1. Here, ulp is the machine precision.
30 * Also, it is verified that SCALE is less than or equal to 1, and
31 * that XNORM = infinity-norm(X).
32 *
33 * Arguments
34 * ==========
35 *
36 * RMAX (output) REAL
37 * Value of the largest test ratio.
38 *
39 * LMAX (output) INTEGER
40 * Example number where largest test ratio achieved.
41 *
42 * NINFO (output) INTEGER
43 * Number of examples returned with INFO.NE.0.
44 *
45 * KNT (output) INTEGER
46 * Total number of examples tested.
47 *
48 * =====================================================================
49 *
50 * .. Parameters ..
51 REAL ZERO, ONE
52 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
53 REAL TWO, FOUR, EIGHT
54 PARAMETER ( TWO = 2.0E0, FOUR = 4.0E0, EIGHT = 8.0E0 )
55 * ..
56 * .. Local Scalars ..
57 LOGICAL LTRANL, LTRANR
58 INTEGER IB, IB1, IB2, IB3, INFO, ISGN, ITL, ITLSCL,
59 $ ITR, ITRANL, ITRANR, ITRSCL, N1, N2
60 REAL BIGNUM, DEN, EPS, RES, SCALE, SGN, SMLNUM, TMP,
61 $ TNRM, XNORM, XNRM
62 * ..
63 * .. Local Arrays ..
64 INTEGER ITVAL( 2, 2, 8 )
65 REAL B( 2, 2 ), TL( 2, 2 ), TR( 2, 2 ), VAL( 3 ),
66 $ X( 2, 2 )
67 * ..
68 * .. External Functions ..
69 REAL SLAMCH
70 EXTERNAL SLAMCH
71 * ..
72 * .. External Subroutines ..
73 EXTERNAL SLABAD, SLASY2
74 * ..
75 * .. Intrinsic Functions ..
76 INTRINSIC ABS, MAX, MIN, SQRT
77 * ..
78 * .. Data statements ..
79 DATA ITVAL / 8, 4, 2, 1, 4, 8, 1, 2, 2, 1, 8, 4, 1,
80 $ 2, 4, 8, 9, 4, 2, 1, 4, 9, 1, 2, 2, 1, 9, 4, 1,
81 $ 2, 4, 9 /
82 * ..
83 * .. Executable Statements ..
84 *
85 * Get machine parameters
86 *
87 EPS = SLAMCH( 'P' )
88 SMLNUM = SLAMCH( 'S' ) / EPS
89 BIGNUM = ONE / SMLNUM
90 CALL SLABAD( SMLNUM, BIGNUM )
91 *
92 * Set up test case parameters
93 *
94 VAL( 1 ) = SQRT( SMLNUM )
95 VAL( 2 ) = ONE
96 VAL( 3 ) = SQRT( BIGNUM )
97 *
98 KNT = 0
99 NINFO = 0
100 LMAX = 0
101 RMAX = ZERO
102 *
103 * Begin test loop
104 *
105 DO 230 ITRANL = 0, 1
106 DO 220 ITRANR = 0, 1
107 DO 210 ISGN = -1, 1, 2
108 SGN = ISGN
109 LTRANL = ITRANL.EQ.1
110 LTRANR = ITRANR.EQ.1
111 *
112 N1 = 1
113 N2 = 1
114 DO 30 ITL = 1, 3
115 DO 20 ITR = 1, 3
116 DO 10 IB = 1, 3
117 TL( 1, 1 ) = VAL( ITL )
118 TR( 1, 1 ) = VAL( ITR )
119 B( 1, 1 ) = VAL( IB )
120 KNT = KNT + 1
121 CALL SLASY2( LTRANL, LTRANR, ISGN, N1, N2, TL,
122 $ 2, TR, 2, B, 2, SCALE, X, 2, XNORM,
123 $ INFO )
124 IF( INFO.NE.0 )
125 $ NINFO = NINFO + 1
126 RES = ABS( ( TL( 1, 1 )+SGN*TR( 1, 1 ) )*
127 $ X( 1, 1 )-SCALE*B( 1, 1 ) )
128 IF( INFO.EQ.0 ) THEN
129 DEN = MAX( EPS*( ( ABS( TR( 1,
130 $ 1 ) )+ABS( TL( 1, 1 ) ) )*ABS( X( 1,
131 $ 1 ) ) ), SMLNUM )
132 ELSE
133 DEN = SMLNUM*MAX( ABS( X( 1, 1 ) ), ONE )
134 END IF
135 RES = RES / DEN
136 IF( SCALE.GT.ONE )
137 $ RES = RES + ONE / EPS
138 RES = RES + ABS( XNORM-ABS( X( 1, 1 ) ) ) /
139 $ MAX( SMLNUM, XNORM ) / EPS
140 IF( INFO.NE.0 .AND. INFO.NE.1 )
141 $ RES = RES + ONE / EPS
142 IF( RES.GT.RMAX ) THEN
143 LMAX = KNT
144 RMAX = RES
145 END IF
146 10 CONTINUE
147 20 CONTINUE
148 30 CONTINUE
149 *
150 N1 = 2
151 N2 = 1
152 DO 80 ITL = 1, 8
153 DO 70 ITLSCL = 1, 3
154 DO 60 ITR = 1, 3
155 DO 50 IB1 = 1, 3
156 DO 40 IB2 = 1, 3
157 B( 1, 1 ) = VAL( IB1 )
158 B( 2, 1 ) = -FOUR*VAL( IB2 )
159 TL( 1, 1 ) = ITVAL( 1, 1, ITL )*
160 $ VAL( ITLSCL )
161 TL( 2, 1 ) = ITVAL( 2, 1, ITL )*
162 $ VAL( ITLSCL )
163 TL( 1, 2 ) = ITVAL( 1, 2, ITL )*
164 $ VAL( ITLSCL )
165 TL( 2, 2 ) = ITVAL( 2, 2, ITL )*
166 $ VAL( ITLSCL )
167 TR( 1, 1 ) = VAL( ITR )
168 KNT = KNT + 1
169 CALL SLASY2( LTRANL, LTRANR, ISGN, N1, N2,
170 $ TL, 2, TR, 2, B, 2, SCALE, X,
171 $ 2, XNORM, INFO )
172 IF( INFO.NE.0 )
173 $ NINFO = NINFO + 1
174 IF( LTRANL ) THEN
175 TMP = TL( 1, 2 )
176 TL( 1, 2 ) = TL( 2, 1 )
177 TL( 2, 1 ) = TMP
178 END IF
179 RES = ABS( ( TL( 1, 1 )+SGN*TR( 1, 1 ) )*
180 $ X( 1, 1 )+TL( 1, 2 )*X( 2, 1 )-
181 $ SCALE*B( 1, 1 ) )
182 RES = RES + ABS( ( TL( 2, 2 )+SGN*TR( 1,
183 $ 1 ) )*X( 2, 1 )+TL( 2, 1 )*
184 $ X( 1, 1 )-SCALE*B( 2, 1 ) )
185 TNRM = ABS( TR( 1, 1 ) ) +
186 $ ABS( TL( 1, 1 ) ) +
187 $ ABS( TL( 1, 2 ) ) +
188 $ ABS( TL( 2, 1 ) ) +
189 $ ABS( TL( 2, 2 ) )
190 XNRM = MAX( ABS( X( 1, 1 ) ),
191 $ ABS( X( 2, 1 ) ) )
192 DEN = MAX( SMLNUM, SMLNUM*XNRM,
193 $ ( TNRM*EPS )*XNRM )
194 RES = RES / DEN
195 IF( SCALE.GT.ONE )
196 $ RES = RES + ONE / EPS
197 RES = RES + ABS( XNORM-XNRM ) /
198 $ MAX( SMLNUM, XNORM ) / EPS
199 IF( RES.GT.RMAX ) THEN
200 LMAX = KNT
201 RMAX = RES
202 END IF
203 40 CONTINUE
204 50 CONTINUE
205 60 CONTINUE
206 70 CONTINUE
207 80 CONTINUE
208 *
209 N1 = 1
210 N2 = 2
211 DO 130 ITR = 1, 8
212 DO 120 ITRSCL = 1, 3
213 DO 110 ITL = 1, 3
214 DO 100 IB1 = 1, 3
215 DO 90 IB2 = 1, 3
216 B( 1, 1 ) = VAL( IB1 )
217 B( 1, 2 ) = -TWO*VAL( IB2 )
218 TR( 1, 1 ) = ITVAL( 1, 1, ITR )*
219 $ VAL( ITRSCL )
220 TR( 2, 1 ) = ITVAL( 2, 1, ITR )*
221 $ VAL( ITRSCL )
222 TR( 1, 2 ) = ITVAL( 1, 2, ITR )*
223 $ VAL( ITRSCL )
224 TR( 2, 2 ) = ITVAL( 2, 2, ITR )*
225 $ VAL( ITRSCL )
226 TL( 1, 1 ) = VAL( ITL )
227 KNT = KNT + 1
228 CALL SLASY2( LTRANL, LTRANR, ISGN, N1, N2,
229 $ TL, 2, TR, 2, B, 2, SCALE, X,
230 $ 2, XNORM, INFO )
231 IF( INFO.NE.0 )
232 $ NINFO = NINFO + 1
233 IF( LTRANR ) THEN
234 TMP = TR( 1, 2 )
235 TR( 1, 2 ) = TR( 2, 1 )
236 TR( 2, 1 ) = TMP
237 END IF
238 TNRM = ABS( TL( 1, 1 ) ) +
239 $ ABS( TR( 1, 1 ) ) +
240 $ ABS( TR( 1, 2 ) ) +
241 $ ABS( TR( 2, 2 ) ) +
242 $ ABS( TR( 2, 1 ) )
243 XNRM = ABS( X( 1, 1 ) ) + ABS( X( 1, 2 ) )
244 RES = ABS( ( ( TL( 1, 1 )+SGN*TR( 1,
245 $ 1 ) ) )*( X( 1, 1 ) )+
246 $ ( SGN*TR( 2, 1 ) )*( X( 1, 2 ) )-
247 $ ( SCALE*B( 1, 1 ) ) )
248 RES = RES + ABS( ( ( TL( 1, 1 )+SGN*TR( 2,
249 $ 2 ) ) )*( X( 1, 2 ) )+
250 $ ( SGN*TR( 1, 2 ) )*( X( 1, 1 ) )-
251 $ ( SCALE*B( 1, 2 ) ) )
252 DEN = MAX( SMLNUM, SMLNUM*XNRM,
253 $ ( TNRM*EPS )*XNRM )
254 RES = RES / DEN
255 IF( SCALE.GT.ONE )
256 $ RES = RES + ONE / EPS
257 RES = RES + ABS( XNORM-XNRM ) /
258 $ MAX( SMLNUM, XNORM ) / EPS
259 IF( RES.GT.RMAX ) THEN
260 LMAX = KNT
261 RMAX = RES
262 END IF
263 90 CONTINUE
264 100 CONTINUE
265 110 CONTINUE
266 120 CONTINUE
267 130 CONTINUE
268 *
269 N1 = 2
270 N2 = 2
271 DO 200 ITR = 1, 8
272 DO 190 ITRSCL = 1, 3
273 DO 180 ITL = 1, 8
274 DO 170 ITLSCL = 1, 3
275 DO 160 IB1 = 1, 3
276 DO 150 IB2 = 1, 3
277 DO 140 IB3 = 1, 3
278 B( 1, 1 ) = VAL( IB1 )
279 B( 2, 1 ) = -FOUR*VAL( IB2 )
280 B( 1, 2 ) = -TWO*VAL( IB3 )
281 B( 2, 2 ) = EIGHT*
282 $ MIN( VAL( IB1 ), VAL
283 $ ( IB2 ), VAL( IB3 ) )
284 TR( 1, 1 ) = ITVAL( 1, 1, ITR )*
285 $ VAL( ITRSCL )
286 TR( 2, 1 ) = ITVAL( 2, 1, ITR )*
287 $ VAL( ITRSCL )
288 TR( 1, 2 ) = ITVAL( 1, 2, ITR )*
289 $ VAL( ITRSCL )
290 TR( 2, 2 ) = ITVAL( 2, 2, ITR )*
291 $ VAL( ITRSCL )
292 TL( 1, 1 ) = ITVAL( 1, 1, ITL )*
293 $ VAL( ITLSCL )
294 TL( 2, 1 ) = ITVAL( 2, 1, ITL )*
295 $ VAL( ITLSCL )
296 TL( 1, 2 ) = ITVAL( 1, 2, ITL )*
297 $ VAL( ITLSCL )
298 TL( 2, 2 ) = ITVAL( 2, 2, ITL )*
299 $ VAL( ITLSCL )
300 KNT = KNT + 1
301 CALL SLASY2( LTRANL, LTRANR, ISGN,
302 $ N1, N2, TL, 2, TR, 2,
303 $ B, 2, SCALE, X, 2,
304 $ XNORM, INFO )
305 IF( INFO.NE.0 )
306 $ NINFO = NINFO + 1
307 IF( LTRANR ) THEN
308 TMP = TR( 1, 2 )
309 TR( 1, 2 ) = TR( 2, 1 )
310 TR( 2, 1 ) = TMP
311 END IF
312 IF( LTRANL ) THEN
313 TMP = TL( 1, 2 )
314 TL( 1, 2 ) = TL( 2, 1 )
315 TL( 2, 1 ) = TMP
316 END IF
317 TNRM = ABS( TR( 1, 1 ) ) +
318 $ ABS( TR( 2, 1 ) ) +
319 $ ABS( TR( 1, 2 ) ) +
320 $ ABS( TR( 2, 2 ) ) +
321 $ ABS( TL( 1, 1 ) ) +
322 $ ABS( TL( 2, 1 ) ) +
323 $ ABS( TL( 1, 2 ) ) +
324 $ ABS( TL( 2, 2 ) )
325 XNRM = MAX( ABS( X( 1, 1 ) )+
326 $ ABS( X( 1, 2 ) ),
327 $ ABS( X( 2, 1 ) )+
328 $ ABS( X( 2, 2 ) ) )
329 RES = ABS( ( ( TL( 1, 1 )+SGN*TR( 1,
330 $ 1 ) ) )*( X( 1, 1 ) )+
331 $ ( SGN*TR( 2, 1 ) )*
332 $ ( X( 1, 2 ) )+( TL( 1, 2 ) )*
333 $ ( X( 2, 1 ) )-
334 $ ( SCALE*B( 1, 1 ) ) )
335 RES = RES + ABS( ( TL( 1, 1 ) )*
336 $ ( X( 1, 2 ) )+
337 $ ( SGN*TR( 1, 2 ) )*
338 $ ( X( 1, 1 ) )+
339 $ ( SGN*TR( 2, 2 ) )*
340 $ ( X( 1, 2 ) )+( TL( 1, 2 ) )*
341 $ ( X( 2, 2 ) )-
342 $ ( SCALE*B( 1, 2 ) ) )
343 RES = RES + ABS( ( TL( 2, 1 ) )*
344 $ ( X( 1, 1 ) )+
345 $ ( SGN*TR( 1, 1 ) )*
346 $ ( X( 2, 1 ) )+
347 $ ( SGN*TR( 2, 1 ) )*
348 $ ( X( 2, 2 ) )+( TL( 2, 2 ) )*
349 $ ( X( 2, 1 ) )-
350 $ ( SCALE*B( 2, 1 ) ) )
351 RES = RES + ABS( ( ( TL( 2,
352 $ 2 )+SGN*TR( 2, 2 ) ) )*
353 $ ( X( 2, 2 ) )+
354 $ ( SGN*TR( 1, 2 ) )*
355 $ ( X( 2, 1 ) )+( TL( 2, 1 ) )*
356 $ ( X( 1, 2 ) )-
357 $ ( SCALE*B( 2, 2 ) ) )
358 DEN = MAX( SMLNUM, SMLNUM*XNRM,
359 $ ( TNRM*EPS )*XNRM )
360 RES = RES / DEN
361 IF( SCALE.GT.ONE )
362 $ RES = RES + ONE / EPS
363 RES = RES + ABS( XNORM-XNRM ) /
364 $ MAX( SMLNUM, XNORM ) / EPS
365 IF( RES.GT.RMAX ) THEN
366 LMAX = KNT
367 RMAX = RES
368 END IF
369 140 CONTINUE
370 150 CONTINUE
371 160 CONTINUE
372 170 CONTINUE
373 180 CONTINUE
374 190 CONTINUE
375 200 CONTINUE
376 210 CONTINUE
377 220 CONTINUE
378 230 CONTINUE
379 *
380 RETURN
381 *
382 * End of SGET32
383 *
384 END