LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ dget32()

subroutine dget32 ( double precision  RMAX,
integer  LMAX,
integer  NINFO,
integer  KNT 
)

DGET32

Purpose:
 DGET32 tests DLASY2, 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 DOUBLE PRECISION
          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 dget32.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 DOUBLE PRECISION RMAX
90* ..
91*
92* =====================================================================
93*
94* .. Parameters ..
95 DOUBLE PRECISION ZERO, ONE
96 parameter( zero = 0.0d0, one = 1.0d0 )
97 DOUBLE PRECISION TWO, FOUR, EIGHT
98 parameter( two = 2.0d0, four = 4.0d0, eight = 8.0d0 )
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 DOUBLE PRECISION BIGNUM, DEN, EPS, RES, SCALE, SGN, SMLNUM, TMP,
105 $ TNRM, XNORM, XNRM
106* ..
107* .. Local Arrays ..
108 INTEGER ITVAL( 2, 2, 8 )
109 DOUBLE PRECISION B( 2, 2 ), TL( 2, 2 ), TR( 2, 2 ), VAL( 3 ),
110 $ X( 2, 2 )
111* ..
112* .. External Functions ..
113 DOUBLE PRECISION DLAMCH
114 EXTERNAL dlamch
115* ..
116* .. External Subroutines ..
117 EXTERNAL dlabad, dlasy2
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 = dlamch( 'P' )
132 smlnum = dlamch( 'S' ) / eps
133 bignum = one / smlnum
134 CALL dlabad( 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 dlasy2( 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 dlasy2( 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 dlasy2( 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 dlasy2( 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 DGET32
427*
dlamch
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:69
dlabad
subroutine dlabad(SMALL, LARGE)
DLABAD
Definition: dlabad.f:74
dlasy2
subroutine dlasy2(LTRANL, LTRANR, ISGN, N1, N2, TL, LDTL, TR, LDTR, B, LDB, SCALE, X, LDX, XNORM, INFO)
DLASY2 solves the Sylvester matrix equation where the matrices are of order 1 or 2.
Definition: dlasy2.f:174
Here is the call graph for this function:
Here is the caller graph for this function: