1 SUBROUTINE DCHKEQ( THRESH, NOUT )
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 NOUT
9 DOUBLE PRECISION THRESH
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * DCHKEQ tests DGEEQU, DGBEQU, DPOEQU, DPPEQU and DPBEQU
16 *
17 * Arguments
18 * =========
19 *
20 * THRESH (input) DOUBLE PRECISION
21 * Threshold for testing routines. Should be between 2 and 10.
22 *
23 * NOUT (input) INTEGER
24 * The unit number for output.
25 *
26 * =====================================================================
27 *
28 * .. Parameters ..
29 DOUBLE PRECISION ZERO, ONE, TEN
30 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D+0, TEN = 1.0D1 )
31 INTEGER NSZ, NSZB
32 PARAMETER ( NSZ = 5, NSZB = 3*NSZ-2 )
33 INTEGER NSZP, NPOW
34 PARAMETER ( NSZP = ( NSZ*( NSZ+1 ) ) / 2,
35 $ NPOW = 2*NSZ+1 )
36 * ..
37 * .. Local Scalars ..
38 LOGICAL OK
39 CHARACTER*3 PATH
40 INTEGER I, INFO, J, KL, KU, M, N
41 DOUBLE PRECISION CCOND, EPS, NORM, RATIO, RCMAX, RCMIN, RCOND
42 * ..
43 * .. Local Arrays ..
44 DOUBLE PRECISION A( NSZ, NSZ ), AB( NSZB, NSZ ), AP( NSZP ),
45 $ C( NSZ ), POW( NPOW ), R( NSZ ), RESLTS( 5 ),
46 $ RPOW( NPOW )
47 * ..
48 * .. External Functions ..
49 DOUBLE PRECISION DLAMCH
50 EXTERNAL DLAMCH
51 * ..
52 * .. External Subroutines ..
53 EXTERNAL DGBEQU, DGEEQU, DPBEQU, DPOEQU, DPPEQU
54 * ..
55 * .. Intrinsic Functions ..
56 INTRINSIC ABS, MAX, MIN
57 * ..
58 * .. Executable Statements ..
59 *
60 PATH( 1: 1 ) = 'Double precision'
61 PATH( 2: 3 ) = 'EQ'
62 *
63 EPS = DLAMCH( 'P' )
64 DO 10 I = 1, 5
65 RESLTS( I ) = ZERO
66 10 CONTINUE
67 DO 20 I = 1, NPOW
68 POW( I ) = TEN**( I-1 )
69 RPOW( I ) = ONE / POW( I )
70 20 CONTINUE
71 *
72 * Test DGEEQU
73 *
74 DO 80 N = 0, NSZ
75 DO 70 M = 0, NSZ
76 *
77 DO 40 J = 1, NSZ
78 DO 30 I = 1, NSZ
79 IF( I.LE.M .AND. J.LE.N ) THEN
80 A( I, J ) = POW( I+J+1 )*( -1 )**( I+J )
81 ELSE
82 A( I, J ) = ZERO
83 END IF
84 30 CONTINUE
85 40 CONTINUE
86 *
87 CALL DGEEQU( M, N, A, NSZ, R, C, RCOND, CCOND, NORM, INFO )
88 *
89 IF( INFO.NE.0 ) THEN
90 RESLTS( 1 ) = ONE
91 ELSE
92 IF( N.NE.0 .AND. M.NE.0 ) THEN
93 RESLTS( 1 ) = MAX( RESLTS( 1 ),
94 $ ABS( ( RCOND-RPOW( M ) ) / RPOW( M ) ) )
95 RESLTS( 1 ) = MAX( RESLTS( 1 ),
96 $ ABS( ( CCOND-RPOW( N ) ) / RPOW( N ) ) )
97 RESLTS( 1 ) = MAX( RESLTS( 1 ),
98 $ ABS( ( NORM-POW( N+M+1 ) ) / POW( N+M+
99 $ 1 ) ) )
100 DO 50 I = 1, M
101 RESLTS( 1 ) = MAX( RESLTS( 1 ),
102 $ ABS( ( R( I )-RPOW( I+N+1 ) ) /
103 $ RPOW( I+N+1 ) ) )
104 50 CONTINUE
105 DO 60 J = 1, N
106 RESLTS( 1 ) = MAX( RESLTS( 1 ),
107 $ ABS( ( C( J )-POW( N-J+1 ) ) /
108 $ POW( N-J+1 ) ) )
109 60 CONTINUE
110 END IF
111 END IF
112 *
113 70 CONTINUE
114 80 CONTINUE
115 *
116 * Test with zero rows and columns
117 *
118 DO 90 J = 1, NSZ
119 A( MAX( NSZ-1, 1 ), J ) = ZERO
120 90 CONTINUE
121 CALL DGEEQU( NSZ, NSZ, A, NSZ, R, C, RCOND, CCOND, NORM, INFO )
122 IF( INFO.NE.MAX( NSZ-1, 1 ) )
123 $ RESLTS( 1 ) = ONE
124 *
125 DO 100 J = 1, NSZ
126 A( MAX( NSZ-1, 1 ), J ) = ONE
127 100 CONTINUE
128 DO 110 I = 1, NSZ
129 A( I, MAX( NSZ-1, 1 ) ) = ZERO
130 110 CONTINUE
131 CALL DGEEQU( NSZ, NSZ, A, NSZ, R, C, RCOND, CCOND, NORM, INFO )
132 IF( INFO.NE.NSZ+MAX( NSZ-1, 1 ) )
133 $ RESLTS( 1 ) = ONE
134 RESLTS( 1 ) = RESLTS( 1 ) / EPS
135 *
136 * Test DGBEQU
137 *
138 DO 250 N = 0, NSZ
139 DO 240 M = 0, NSZ
140 DO 230 KL = 0, MAX( M-1, 0 )
141 DO 220 KU = 0, MAX( N-1, 0 )
142 *
143 DO 130 J = 1, NSZ
144 DO 120 I = 1, NSZB
145 AB( I, J ) = ZERO
146 120 CONTINUE
147 130 CONTINUE
148 DO 150 J = 1, N
149 DO 140 I = 1, M
150 IF( I.LE.MIN( M, J+KL ) .AND. I.GE.
151 $ MAX( 1, J-KU ) .AND. J.LE.N ) THEN
152 AB( KU+1+I-J, J ) = POW( I+J+1 )*
153 $ ( -1 )**( I+J )
154 END IF
155 140 CONTINUE
156 150 CONTINUE
157 *
158 CALL DGBEQU( M, N, KL, KU, AB, NSZB, R, C, RCOND,
159 $ CCOND, NORM, INFO )
160 *
161 IF( INFO.NE.0 ) THEN
162 IF( .NOT.( ( N+KL.LT.M .AND. INFO.EQ.N+KL+1 ) .OR.
163 $ ( M+KU.LT.N .AND. INFO.EQ.2*M+KU+1 ) ) ) THEN
164 RESLTS( 2 ) = ONE
165 END IF
166 ELSE
167 IF( N.NE.0 .AND. M.NE.0 ) THEN
168 *
169 RCMIN = R( 1 )
170 RCMAX = R( 1 )
171 DO 160 I = 1, M
172 RCMIN = MIN( RCMIN, R( I ) )
173 RCMAX = MAX( RCMAX, R( I ) )
174 160 CONTINUE
175 RATIO = RCMIN / RCMAX
176 RESLTS( 2 ) = MAX( RESLTS( 2 ),
177 $ ABS( ( RCOND-RATIO ) / RATIO ) )
178 *
179 RCMIN = C( 1 )
180 RCMAX = C( 1 )
181 DO 170 J = 1, N
182 RCMIN = MIN( RCMIN, C( J ) )
183 RCMAX = MAX( RCMAX, C( J ) )
184 170 CONTINUE
185 RATIO = RCMIN / RCMAX
186 RESLTS( 2 ) = MAX( RESLTS( 2 ),
187 $ ABS( ( CCOND-RATIO ) / RATIO ) )
188 *
189 RESLTS( 2 ) = MAX( RESLTS( 2 ),
190 $ ABS( ( NORM-POW( N+M+1 ) ) /
191 $ POW( N+M+1 ) ) )
192 DO 190 I = 1, M
193 RCMAX = ZERO
194 DO 180 J = 1, N
195 IF( I.LE.J+KL .AND. I.GE.J-KU ) THEN
196 RATIO = ABS( R( I )*POW( I+J+1 )*
197 $ C( J ) )
198 RCMAX = MAX( RCMAX, RATIO )
199 END IF
200 180 CONTINUE
201 RESLTS( 2 ) = MAX( RESLTS( 2 ),
202 $ ABS( ONE-RCMAX ) )
203 190 CONTINUE
204 *
205 DO 210 J = 1, N
206 RCMAX = ZERO
207 DO 200 I = 1, M
208 IF( I.LE.J+KL .AND. I.GE.J-KU ) THEN
209 RATIO = ABS( R( I )*POW( I+J+1 )*
210 $ C( J ) )
211 RCMAX = MAX( RCMAX, RATIO )
212 END IF
213 200 CONTINUE
214 RESLTS( 2 ) = MAX( RESLTS( 2 ),
215 $ ABS( ONE-RCMAX ) )
216 210 CONTINUE
217 END IF
218 END IF
219 *
220 220 CONTINUE
221 230 CONTINUE
222 240 CONTINUE
223 250 CONTINUE
224 RESLTS( 2 ) = RESLTS( 2 ) / EPS
225 *
226 * Test DPOEQU
227 *
228 DO 290 N = 0, NSZ
229 *
230 DO 270 I = 1, NSZ
231 DO 260 J = 1, NSZ
232 IF( I.LE.N .AND. J.EQ.I ) THEN
233 A( I, J ) = POW( I+J+1 )*( -1 )**( I+J )
234 ELSE
235 A( I, J ) = ZERO
236 END IF
237 260 CONTINUE
238 270 CONTINUE
239 *
240 CALL DPOEQU( N, A, NSZ, R, RCOND, NORM, INFO )
241 *
242 IF( INFO.NE.0 ) THEN
243 RESLTS( 3 ) = ONE
244 ELSE
245 IF( N.NE.0 ) THEN
246 RESLTS( 3 ) = MAX( RESLTS( 3 ),
247 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
248 RESLTS( 3 ) = MAX( RESLTS( 3 ),
249 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
250 $ 1 ) ) )
251 DO 280 I = 1, N
252 RESLTS( 3 ) = MAX( RESLTS( 3 ),
253 $ ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+
254 $ 1 ) ) )
255 280 CONTINUE
256 END IF
257 END IF
258 290 CONTINUE
259 A( MAX( NSZ-1, 1 ), MAX( NSZ-1, 1 ) ) = -ONE
260 CALL DPOEQU( NSZ, A, NSZ, R, RCOND, NORM, INFO )
261 IF( INFO.NE.MAX( NSZ-1, 1 ) )
262 $ RESLTS( 3 ) = ONE
263 RESLTS( 3 ) = RESLTS( 3 ) / EPS
264 *
265 * Test DPPEQU
266 *
267 DO 360 N = 0, NSZ
268 *
269 * Upper triangular packed storage
270 *
271 DO 300 I = 1, ( N*( N+1 ) ) / 2
272 AP( I ) = ZERO
273 300 CONTINUE
274 DO 310 I = 1, N
275 AP( ( I*( I+1 ) ) / 2 ) = POW( 2*I+1 )
276 310 CONTINUE
277 *
278 CALL DPPEQU( 'U', N, AP, R, RCOND, NORM, INFO )
279 *
280 IF( INFO.NE.0 ) THEN
281 RESLTS( 4 ) = ONE
282 ELSE
283 IF( N.NE.0 ) THEN
284 RESLTS( 4 ) = MAX( RESLTS( 4 ),
285 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
286 RESLTS( 4 ) = MAX( RESLTS( 4 ),
287 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
288 $ 1 ) ) )
289 DO 320 I = 1, N
290 RESLTS( 4 ) = MAX( RESLTS( 4 ),
291 $ ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+
292 $ 1 ) ) )
293 320 CONTINUE
294 END IF
295 END IF
296 *
297 * Lower triangular packed storage
298 *
299 DO 330 I = 1, ( N*( N+1 ) ) / 2
300 AP( I ) = ZERO
301 330 CONTINUE
302 J = 1
303 DO 340 I = 1, N
304 AP( J ) = POW( 2*I+1 )
305 J = J + ( N-I+1 )
306 340 CONTINUE
307 *
308 CALL DPPEQU( 'L', N, AP, R, RCOND, NORM, INFO )
309 *
310 IF( INFO.NE.0 ) THEN
311 RESLTS( 4 ) = ONE
312 ELSE
313 IF( N.NE.0 ) THEN
314 RESLTS( 4 ) = MAX( RESLTS( 4 ),
315 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
316 RESLTS( 4 ) = MAX( RESLTS( 4 ),
317 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
318 $ 1 ) ) )
319 DO 350 I = 1, N
320 RESLTS( 4 ) = MAX( RESLTS( 4 ),
321 $ ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+
322 $ 1 ) ) )
323 350 CONTINUE
324 END IF
325 END IF
326 *
327 360 CONTINUE
328 I = ( NSZ*( NSZ+1 ) ) / 2 - 2
329 AP( I ) = -ONE
330 CALL DPPEQU( 'L', NSZ, AP, R, RCOND, NORM, INFO )
331 IF( INFO.NE.MAX( NSZ-1, 1 ) )
332 $ RESLTS( 4 ) = ONE
333 RESLTS( 4 ) = RESLTS( 4 ) / EPS
334 *
335 * Test DPBEQU
336 *
337 DO 460 N = 0, NSZ
338 DO 450 KL = 0, MAX( N-1, 0 )
339 *
340 * Test upper triangular storage
341 *
342 DO 380 J = 1, NSZ
343 DO 370 I = 1, NSZB
344 AB( I, J ) = ZERO
345 370 CONTINUE
346 380 CONTINUE
347 DO 390 J = 1, N
348 AB( KL+1, J ) = POW( 2*J+1 )
349 390 CONTINUE
350 *
351 CALL DPBEQU( 'U', N, KL, AB, NSZB, R, RCOND, NORM, INFO )
352 *
353 IF( INFO.NE.0 ) THEN
354 RESLTS( 5 ) = ONE
355 ELSE
356 IF( N.NE.0 ) THEN
357 RESLTS( 5 ) = MAX( RESLTS( 5 ),
358 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
359 RESLTS( 5 ) = MAX( RESLTS( 5 ),
360 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
361 $ 1 ) ) )
362 DO 400 I = 1, N
363 RESLTS( 5 ) = MAX( RESLTS( 5 ),
364 $ ABS( ( R( I )-RPOW( I+1 ) ) /
365 $ RPOW( I+1 ) ) )
366 400 CONTINUE
367 END IF
368 END IF
369 IF( N.NE.0 ) THEN
370 AB( KL+1, MAX( N-1, 1 ) ) = -ONE
371 CALL DPBEQU( 'U', N, KL, AB, NSZB, R, RCOND, NORM, INFO )
372 IF( INFO.NE.MAX( N-1, 1 ) )
373 $ RESLTS( 5 ) = ONE
374 END IF
375 *
376 * Test lower triangular storage
377 *
378 DO 420 J = 1, NSZ
379 DO 410 I = 1, NSZB
380 AB( I, J ) = ZERO
381 410 CONTINUE
382 420 CONTINUE
383 DO 430 J = 1, N
384 AB( 1, J ) = POW( 2*J+1 )
385 430 CONTINUE
386 *
387 CALL DPBEQU( 'L', N, KL, AB, NSZB, R, RCOND, NORM, INFO )
388 *
389 IF( INFO.NE.0 ) THEN
390 RESLTS( 5 ) = ONE
391 ELSE
392 IF( N.NE.0 ) THEN
393 RESLTS( 5 ) = MAX( RESLTS( 5 ),
394 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
395 RESLTS( 5 ) = MAX( RESLTS( 5 ),
396 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
397 $ 1 ) ) )
398 DO 440 I = 1, N
399 RESLTS( 5 ) = MAX( RESLTS( 5 ),
400 $ ABS( ( R( I )-RPOW( I+1 ) ) /
401 $ RPOW( I+1 ) ) )
402 440 CONTINUE
403 END IF
404 END IF
405 IF( N.NE.0 ) THEN
406 AB( 1, MAX( N-1, 1 ) ) = -ONE
407 CALL DPBEQU( 'L', N, KL, AB, NSZB, R, RCOND, NORM, INFO )
408 IF( INFO.NE.MAX( N-1, 1 ) )
409 $ RESLTS( 5 ) = ONE
410 END IF
411 450 CONTINUE
412 460 CONTINUE
413 RESLTS( 5 ) = RESLTS( 5 ) / EPS
414 OK = ( RESLTS( 1 ).LE.THRESH ) .AND.
415 $ ( RESLTS( 2 ).LE.THRESH ) .AND.
416 $ ( RESLTS( 3 ).LE.THRESH ) .AND.
417 $ ( RESLTS( 4 ).LE.THRESH ) .AND. ( RESLTS( 5 ).LE.THRESH )
418 WRITE( NOUT, FMT = * )
419 IF( OK ) THEN
420 WRITE( NOUT, FMT = 9999 )PATH
421 ELSE
422 IF( RESLTS( 1 ).GT.THRESH )
423 $ WRITE( NOUT, FMT = 9998 )RESLTS( 1 ), THRESH
424 IF( RESLTS( 2 ).GT.THRESH )
425 $ WRITE( NOUT, FMT = 9997 )RESLTS( 2 ), THRESH
426 IF( RESLTS( 3 ).GT.THRESH )
427 $ WRITE( NOUT, FMT = 9996 )RESLTS( 3 ), THRESH
428 IF( RESLTS( 4 ).GT.THRESH )
429 $ WRITE( NOUT, FMT = 9995 )RESLTS( 4 ), THRESH
430 IF( RESLTS( 5 ).GT.THRESH )
431 $ WRITE( NOUT, FMT = 9994 )RESLTS( 5 ), THRESH
432 END IF
433 9999 FORMAT( 1X, 'All tests for ', A3,
434 $ ' routines passed the threshold' )
435 9998 FORMAT( ' DGEEQU failed test with value ', D10.3, ' exceeding',
436 $ ' threshold ', D10.3 )
437 9997 FORMAT( ' DGBEQU failed test with value ', D10.3, ' exceeding',
438 $ ' threshold ', D10.3 )
439 9996 FORMAT( ' DPOEQU failed test with value ', D10.3, ' exceeding',
440 $ ' threshold ', D10.3 )
441 9995 FORMAT( ' DPPEQU failed test with value ', D10.3, ' exceeding',
442 $ ' threshold ', D10.3 )
443 9994 FORMAT( ' DPBEQU failed test with value ', D10.3, ' exceeding',
444 $ ' threshold ', D10.3 )
445 RETURN
446 *
447 * End of DCHKEQ
448 *
449 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 NOUT
9 DOUBLE PRECISION THRESH
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * DCHKEQ tests DGEEQU, DGBEQU, DPOEQU, DPPEQU and DPBEQU
16 *
17 * Arguments
18 * =========
19 *
20 * THRESH (input) DOUBLE PRECISION
21 * Threshold for testing routines. Should be between 2 and 10.
22 *
23 * NOUT (input) INTEGER
24 * The unit number for output.
25 *
26 * =====================================================================
27 *
28 * .. Parameters ..
29 DOUBLE PRECISION ZERO, ONE, TEN
30 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D+0, TEN = 1.0D1 )
31 INTEGER NSZ, NSZB
32 PARAMETER ( NSZ = 5, NSZB = 3*NSZ-2 )
33 INTEGER NSZP, NPOW
34 PARAMETER ( NSZP = ( NSZ*( NSZ+1 ) ) / 2,
35 $ NPOW = 2*NSZ+1 )
36 * ..
37 * .. Local Scalars ..
38 LOGICAL OK
39 CHARACTER*3 PATH
40 INTEGER I, INFO, J, KL, KU, M, N
41 DOUBLE PRECISION CCOND, EPS, NORM, RATIO, RCMAX, RCMIN, RCOND
42 * ..
43 * .. Local Arrays ..
44 DOUBLE PRECISION A( NSZ, NSZ ), AB( NSZB, NSZ ), AP( NSZP ),
45 $ C( NSZ ), POW( NPOW ), R( NSZ ), RESLTS( 5 ),
46 $ RPOW( NPOW )
47 * ..
48 * .. External Functions ..
49 DOUBLE PRECISION DLAMCH
50 EXTERNAL DLAMCH
51 * ..
52 * .. External Subroutines ..
53 EXTERNAL DGBEQU, DGEEQU, DPBEQU, DPOEQU, DPPEQU
54 * ..
55 * .. Intrinsic Functions ..
56 INTRINSIC ABS, MAX, MIN
57 * ..
58 * .. Executable Statements ..
59 *
60 PATH( 1: 1 ) = 'Double precision'
61 PATH( 2: 3 ) = 'EQ'
62 *
63 EPS = DLAMCH( 'P' )
64 DO 10 I = 1, 5
65 RESLTS( I ) = ZERO
66 10 CONTINUE
67 DO 20 I = 1, NPOW
68 POW( I ) = TEN**( I-1 )
69 RPOW( I ) = ONE / POW( I )
70 20 CONTINUE
71 *
72 * Test DGEEQU
73 *
74 DO 80 N = 0, NSZ
75 DO 70 M = 0, NSZ
76 *
77 DO 40 J = 1, NSZ
78 DO 30 I = 1, NSZ
79 IF( I.LE.M .AND. J.LE.N ) THEN
80 A( I, J ) = POW( I+J+1 )*( -1 )**( I+J )
81 ELSE
82 A( I, J ) = ZERO
83 END IF
84 30 CONTINUE
85 40 CONTINUE
86 *
87 CALL DGEEQU( M, N, A, NSZ, R, C, RCOND, CCOND, NORM, INFO )
88 *
89 IF( INFO.NE.0 ) THEN
90 RESLTS( 1 ) = ONE
91 ELSE
92 IF( N.NE.0 .AND. M.NE.0 ) THEN
93 RESLTS( 1 ) = MAX( RESLTS( 1 ),
94 $ ABS( ( RCOND-RPOW( M ) ) / RPOW( M ) ) )
95 RESLTS( 1 ) = MAX( RESLTS( 1 ),
96 $ ABS( ( CCOND-RPOW( N ) ) / RPOW( N ) ) )
97 RESLTS( 1 ) = MAX( RESLTS( 1 ),
98 $ ABS( ( NORM-POW( N+M+1 ) ) / POW( N+M+
99 $ 1 ) ) )
100 DO 50 I = 1, M
101 RESLTS( 1 ) = MAX( RESLTS( 1 ),
102 $ ABS( ( R( I )-RPOW( I+N+1 ) ) /
103 $ RPOW( I+N+1 ) ) )
104 50 CONTINUE
105 DO 60 J = 1, N
106 RESLTS( 1 ) = MAX( RESLTS( 1 ),
107 $ ABS( ( C( J )-POW( N-J+1 ) ) /
108 $ POW( N-J+1 ) ) )
109 60 CONTINUE
110 END IF
111 END IF
112 *
113 70 CONTINUE
114 80 CONTINUE
115 *
116 * Test with zero rows and columns
117 *
118 DO 90 J = 1, NSZ
119 A( MAX( NSZ-1, 1 ), J ) = ZERO
120 90 CONTINUE
121 CALL DGEEQU( NSZ, NSZ, A, NSZ, R, C, RCOND, CCOND, NORM, INFO )
122 IF( INFO.NE.MAX( NSZ-1, 1 ) )
123 $ RESLTS( 1 ) = ONE
124 *
125 DO 100 J = 1, NSZ
126 A( MAX( NSZ-1, 1 ), J ) = ONE
127 100 CONTINUE
128 DO 110 I = 1, NSZ
129 A( I, MAX( NSZ-1, 1 ) ) = ZERO
130 110 CONTINUE
131 CALL DGEEQU( NSZ, NSZ, A, NSZ, R, C, RCOND, CCOND, NORM, INFO )
132 IF( INFO.NE.NSZ+MAX( NSZ-1, 1 ) )
133 $ RESLTS( 1 ) = ONE
134 RESLTS( 1 ) = RESLTS( 1 ) / EPS
135 *
136 * Test DGBEQU
137 *
138 DO 250 N = 0, NSZ
139 DO 240 M = 0, NSZ
140 DO 230 KL = 0, MAX( M-1, 0 )
141 DO 220 KU = 0, MAX( N-1, 0 )
142 *
143 DO 130 J = 1, NSZ
144 DO 120 I = 1, NSZB
145 AB( I, J ) = ZERO
146 120 CONTINUE
147 130 CONTINUE
148 DO 150 J = 1, N
149 DO 140 I = 1, M
150 IF( I.LE.MIN( M, J+KL ) .AND. I.GE.
151 $ MAX( 1, J-KU ) .AND. J.LE.N ) THEN
152 AB( KU+1+I-J, J ) = POW( I+J+1 )*
153 $ ( -1 )**( I+J )
154 END IF
155 140 CONTINUE
156 150 CONTINUE
157 *
158 CALL DGBEQU( M, N, KL, KU, AB, NSZB, R, C, RCOND,
159 $ CCOND, NORM, INFO )
160 *
161 IF( INFO.NE.0 ) THEN
162 IF( .NOT.( ( N+KL.LT.M .AND. INFO.EQ.N+KL+1 ) .OR.
163 $ ( M+KU.LT.N .AND. INFO.EQ.2*M+KU+1 ) ) ) THEN
164 RESLTS( 2 ) = ONE
165 END IF
166 ELSE
167 IF( N.NE.0 .AND. M.NE.0 ) THEN
168 *
169 RCMIN = R( 1 )
170 RCMAX = R( 1 )
171 DO 160 I = 1, M
172 RCMIN = MIN( RCMIN, R( I ) )
173 RCMAX = MAX( RCMAX, R( I ) )
174 160 CONTINUE
175 RATIO = RCMIN / RCMAX
176 RESLTS( 2 ) = MAX( RESLTS( 2 ),
177 $ ABS( ( RCOND-RATIO ) / RATIO ) )
178 *
179 RCMIN = C( 1 )
180 RCMAX = C( 1 )
181 DO 170 J = 1, N
182 RCMIN = MIN( RCMIN, C( J ) )
183 RCMAX = MAX( RCMAX, C( J ) )
184 170 CONTINUE
185 RATIO = RCMIN / RCMAX
186 RESLTS( 2 ) = MAX( RESLTS( 2 ),
187 $ ABS( ( CCOND-RATIO ) / RATIO ) )
188 *
189 RESLTS( 2 ) = MAX( RESLTS( 2 ),
190 $ ABS( ( NORM-POW( N+M+1 ) ) /
191 $ POW( N+M+1 ) ) )
192 DO 190 I = 1, M
193 RCMAX = ZERO
194 DO 180 J = 1, N
195 IF( I.LE.J+KL .AND. I.GE.J-KU ) THEN
196 RATIO = ABS( R( I )*POW( I+J+1 )*
197 $ C( J ) )
198 RCMAX = MAX( RCMAX, RATIO )
199 END IF
200 180 CONTINUE
201 RESLTS( 2 ) = MAX( RESLTS( 2 ),
202 $ ABS( ONE-RCMAX ) )
203 190 CONTINUE
204 *
205 DO 210 J = 1, N
206 RCMAX = ZERO
207 DO 200 I = 1, M
208 IF( I.LE.J+KL .AND. I.GE.J-KU ) THEN
209 RATIO = ABS( R( I )*POW( I+J+1 )*
210 $ C( J ) )
211 RCMAX = MAX( RCMAX, RATIO )
212 END IF
213 200 CONTINUE
214 RESLTS( 2 ) = MAX( RESLTS( 2 ),
215 $ ABS( ONE-RCMAX ) )
216 210 CONTINUE
217 END IF
218 END IF
219 *
220 220 CONTINUE
221 230 CONTINUE
222 240 CONTINUE
223 250 CONTINUE
224 RESLTS( 2 ) = RESLTS( 2 ) / EPS
225 *
226 * Test DPOEQU
227 *
228 DO 290 N = 0, NSZ
229 *
230 DO 270 I = 1, NSZ
231 DO 260 J = 1, NSZ
232 IF( I.LE.N .AND. J.EQ.I ) THEN
233 A( I, J ) = POW( I+J+1 )*( -1 )**( I+J )
234 ELSE
235 A( I, J ) = ZERO
236 END IF
237 260 CONTINUE
238 270 CONTINUE
239 *
240 CALL DPOEQU( N, A, NSZ, R, RCOND, NORM, INFO )
241 *
242 IF( INFO.NE.0 ) THEN
243 RESLTS( 3 ) = ONE
244 ELSE
245 IF( N.NE.0 ) THEN
246 RESLTS( 3 ) = MAX( RESLTS( 3 ),
247 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
248 RESLTS( 3 ) = MAX( RESLTS( 3 ),
249 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
250 $ 1 ) ) )
251 DO 280 I = 1, N
252 RESLTS( 3 ) = MAX( RESLTS( 3 ),
253 $ ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+
254 $ 1 ) ) )
255 280 CONTINUE
256 END IF
257 END IF
258 290 CONTINUE
259 A( MAX( NSZ-1, 1 ), MAX( NSZ-1, 1 ) ) = -ONE
260 CALL DPOEQU( NSZ, A, NSZ, R, RCOND, NORM, INFO )
261 IF( INFO.NE.MAX( NSZ-1, 1 ) )
262 $ RESLTS( 3 ) = ONE
263 RESLTS( 3 ) = RESLTS( 3 ) / EPS
264 *
265 * Test DPPEQU
266 *
267 DO 360 N = 0, NSZ
268 *
269 * Upper triangular packed storage
270 *
271 DO 300 I = 1, ( N*( N+1 ) ) / 2
272 AP( I ) = ZERO
273 300 CONTINUE
274 DO 310 I = 1, N
275 AP( ( I*( I+1 ) ) / 2 ) = POW( 2*I+1 )
276 310 CONTINUE
277 *
278 CALL DPPEQU( 'U', N, AP, R, RCOND, NORM, INFO )
279 *
280 IF( INFO.NE.0 ) THEN
281 RESLTS( 4 ) = ONE
282 ELSE
283 IF( N.NE.0 ) THEN
284 RESLTS( 4 ) = MAX( RESLTS( 4 ),
285 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
286 RESLTS( 4 ) = MAX( RESLTS( 4 ),
287 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
288 $ 1 ) ) )
289 DO 320 I = 1, N
290 RESLTS( 4 ) = MAX( RESLTS( 4 ),
291 $ ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+
292 $ 1 ) ) )
293 320 CONTINUE
294 END IF
295 END IF
296 *
297 * Lower triangular packed storage
298 *
299 DO 330 I = 1, ( N*( N+1 ) ) / 2
300 AP( I ) = ZERO
301 330 CONTINUE
302 J = 1
303 DO 340 I = 1, N
304 AP( J ) = POW( 2*I+1 )
305 J = J + ( N-I+1 )
306 340 CONTINUE
307 *
308 CALL DPPEQU( 'L', N, AP, R, RCOND, NORM, INFO )
309 *
310 IF( INFO.NE.0 ) THEN
311 RESLTS( 4 ) = ONE
312 ELSE
313 IF( N.NE.0 ) THEN
314 RESLTS( 4 ) = MAX( RESLTS( 4 ),
315 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
316 RESLTS( 4 ) = MAX( RESLTS( 4 ),
317 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
318 $ 1 ) ) )
319 DO 350 I = 1, N
320 RESLTS( 4 ) = MAX( RESLTS( 4 ),
321 $ ABS( ( R( I )-RPOW( I+1 ) ) / RPOW( I+
322 $ 1 ) ) )
323 350 CONTINUE
324 END IF
325 END IF
326 *
327 360 CONTINUE
328 I = ( NSZ*( NSZ+1 ) ) / 2 - 2
329 AP( I ) = -ONE
330 CALL DPPEQU( 'L', NSZ, AP, R, RCOND, NORM, INFO )
331 IF( INFO.NE.MAX( NSZ-1, 1 ) )
332 $ RESLTS( 4 ) = ONE
333 RESLTS( 4 ) = RESLTS( 4 ) / EPS
334 *
335 * Test DPBEQU
336 *
337 DO 460 N = 0, NSZ
338 DO 450 KL = 0, MAX( N-1, 0 )
339 *
340 * Test upper triangular storage
341 *
342 DO 380 J = 1, NSZ
343 DO 370 I = 1, NSZB
344 AB( I, J ) = ZERO
345 370 CONTINUE
346 380 CONTINUE
347 DO 390 J = 1, N
348 AB( KL+1, J ) = POW( 2*J+1 )
349 390 CONTINUE
350 *
351 CALL DPBEQU( 'U', N, KL, AB, NSZB, R, RCOND, NORM, INFO )
352 *
353 IF( INFO.NE.0 ) THEN
354 RESLTS( 5 ) = ONE
355 ELSE
356 IF( N.NE.0 ) THEN
357 RESLTS( 5 ) = MAX( RESLTS( 5 ),
358 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
359 RESLTS( 5 ) = MAX( RESLTS( 5 ),
360 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
361 $ 1 ) ) )
362 DO 400 I = 1, N
363 RESLTS( 5 ) = MAX( RESLTS( 5 ),
364 $ ABS( ( R( I )-RPOW( I+1 ) ) /
365 $ RPOW( I+1 ) ) )
366 400 CONTINUE
367 END IF
368 END IF
369 IF( N.NE.0 ) THEN
370 AB( KL+1, MAX( N-1, 1 ) ) = -ONE
371 CALL DPBEQU( 'U', N, KL, AB, NSZB, R, RCOND, NORM, INFO )
372 IF( INFO.NE.MAX( N-1, 1 ) )
373 $ RESLTS( 5 ) = ONE
374 END IF
375 *
376 * Test lower triangular storage
377 *
378 DO 420 J = 1, NSZ
379 DO 410 I = 1, NSZB
380 AB( I, J ) = ZERO
381 410 CONTINUE
382 420 CONTINUE
383 DO 430 J = 1, N
384 AB( 1, J ) = POW( 2*J+1 )
385 430 CONTINUE
386 *
387 CALL DPBEQU( 'L', N, KL, AB, NSZB, R, RCOND, NORM, INFO )
388 *
389 IF( INFO.NE.0 ) THEN
390 RESLTS( 5 ) = ONE
391 ELSE
392 IF( N.NE.0 ) THEN
393 RESLTS( 5 ) = MAX( RESLTS( 5 ),
394 $ ABS( ( RCOND-RPOW( N ) ) / RPOW( N ) ) )
395 RESLTS( 5 ) = MAX( RESLTS( 5 ),
396 $ ABS( ( NORM-POW( 2*N+1 ) ) / POW( 2*N+
397 $ 1 ) ) )
398 DO 440 I = 1, N
399 RESLTS( 5 ) = MAX( RESLTS( 5 ),
400 $ ABS( ( R( I )-RPOW( I+1 ) ) /
401 $ RPOW( I+1 ) ) )
402 440 CONTINUE
403 END IF
404 END IF
405 IF( N.NE.0 ) THEN
406 AB( 1, MAX( N-1, 1 ) ) = -ONE
407 CALL DPBEQU( 'L', N, KL, AB, NSZB, R, RCOND, NORM, INFO )
408 IF( INFO.NE.MAX( N-1, 1 ) )
409 $ RESLTS( 5 ) = ONE
410 END IF
411 450 CONTINUE
412 460 CONTINUE
413 RESLTS( 5 ) = RESLTS( 5 ) / EPS
414 OK = ( RESLTS( 1 ).LE.THRESH ) .AND.
415 $ ( RESLTS( 2 ).LE.THRESH ) .AND.
416 $ ( RESLTS( 3 ).LE.THRESH ) .AND.
417 $ ( RESLTS( 4 ).LE.THRESH ) .AND. ( RESLTS( 5 ).LE.THRESH )
418 WRITE( NOUT, FMT = * )
419 IF( OK ) THEN
420 WRITE( NOUT, FMT = 9999 )PATH
421 ELSE
422 IF( RESLTS( 1 ).GT.THRESH )
423 $ WRITE( NOUT, FMT = 9998 )RESLTS( 1 ), THRESH
424 IF( RESLTS( 2 ).GT.THRESH )
425 $ WRITE( NOUT, FMT = 9997 )RESLTS( 2 ), THRESH
426 IF( RESLTS( 3 ).GT.THRESH )
427 $ WRITE( NOUT, FMT = 9996 )RESLTS( 3 ), THRESH
428 IF( RESLTS( 4 ).GT.THRESH )
429 $ WRITE( NOUT, FMT = 9995 )RESLTS( 4 ), THRESH
430 IF( RESLTS( 5 ).GT.THRESH )
431 $ WRITE( NOUT, FMT = 9994 )RESLTS( 5 ), THRESH
432 END IF
433 9999 FORMAT( 1X, 'All tests for ', A3,
434 $ ' routines passed the threshold' )
435 9998 FORMAT( ' DGEEQU failed test with value ', D10.3, ' exceeding',
436 $ ' threshold ', D10.3 )
437 9997 FORMAT( ' DGBEQU failed test with value ', D10.3, ' exceeding',
438 $ ' threshold ', D10.3 )
439 9996 FORMAT( ' DPOEQU failed test with value ', D10.3, ' exceeding',
440 $ ' threshold ', D10.3 )
441 9995 FORMAT( ' DPPEQU failed test with value ', D10.3, ' exceeding',
442 $ ' threshold ', D10.3 )
443 9994 FORMAT( ' DPBEQU failed test with value ', D10.3, ' exceeding',
444 $ ' threshold ', D10.3 )
445 RETURN
446 *
447 * End of DCHKEQ
448 *
449 END