1 SUBROUTINE DERRGE( PATH, NUNIT )
2 *
3 * -- LAPACK test routine (version 3.2.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * April 2009
6 *
7 * .. Scalar Arguments ..
8 CHARACTER*3 PATH
9 INTEGER NUNIT
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * DERRGE tests the error exits for the DOUBLE PRECISION routines
16 * for general matrices.
17 *
18 * Note that this file is used only when the XBLAS are available,
19 * otherwise derrge.f defines this subroutine.
20 *
21 * Arguments
22 * =========
23 *
24 * PATH (input) CHARACTER*3
25 * The LAPACK path name for the routines to be tested.
26 *
27 * NUNIT (input) INTEGER
28 * The unit number for output.
29 *
30 * =====================================================================
31 *
32 * .. Parameters ..
33 INTEGER NMAX, LW
34 PARAMETER ( NMAX = 4, LW = 3*NMAX )
35 * ..
36 * .. Local Scalars ..
37 CHARACTER EQ
38 CHARACTER*2 C2
39 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
40 DOUBLE PRECISION ANRM, CCOND, RCOND, BERR
41 * ..
42 * .. Local Arrays ..
43 INTEGER IP( NMAX ), IW( NMAX )
44 DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
45 $ C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
46 $ W( LW ), X( NMAX ), ERR_BNDS_N( NMAX, 3 ),
47 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
48 * ..
49 * .. External Functions ..
50 LOGICAL LSAMEN
51 EXTERNAL LSAMEN
52 * ..
53 * .. External Subroutines ..
54 EXTERNAL ALAESM, CHKXER, DGBCON, DGBEQU, DGBRFS, DGBTF2,
55 $ DGBTRF, DGBTRS, DGECON, DGEEQU, DGERFS, DGETF2,
56 $ DGETRF, DGETRI, DGETRS, DGEEQUB, DGERFSX,
57 $ DGBEQUB, DGBRFSX
58 * ..
59 * .. Scalars in Common ..
60 LOGICAL LERR, OK
61 CHARACTER*32 SRNAMT
62 INTEGER INFOT, NOUT
63 * ..
64 * .. Common blocks ..
65 COMMON / INFOC / INFOT, NOUT, OK, LERR
66 COMMON / SRNAMC / SRNAMT
67 * ..
68 * .. Intrinsic Functions ..
69 INTRINSIC DBLE
70 * ..
71 * .. Executable Statements ..
72 *
73 NOUT = NUNIT
74 WRITE( NOUT, FMT = * )
75 C2 = PATH( 2: 3 )
76 *
77 * Set the variables to innocuous values.
78 *
79 DO 20 J = 1, NMAX
80 DO 10 I = 1, NMAX
81 A( I, J ) = 1.D0 / DBLE( I+J )
82 AF( I, J ) = 1.D0 / DBLE( I+J )
83 10 CONTINUE
84 B( J ) = 0.D0
85 R1( J ) = 0.D0
86 R2( J ) = 0.D0
87 W( J ) = 0.D0
88 X( J ) = 0.D0
89 C( J ) = 0.D0
90 R( J ) = 0.D0
91 IP( J ) = J
92 IW( J ) = J
93 20 CONTINUE
94 OK = .TRUE.
95 *
96 IF( LSAMEN( 2, C2, 'GE' ) ) THEN
97 *
98 * Test error exits of the routines that use the LU decomposition
99 * of a general matrix.
100 *
101 * DGETRF
102 *
103 SRNAMT = 'DGETRF'
104 INFOT = 1
105 CALL DGETRF( -1, 0, A, 1, IP, INFO )
106 CALL CHKXER( 'DGETRF', INFOT, NOUT, LERR, OK )
107 INFOT = 2
108 CALL DGETRF( 0, -1, A, 1, IP, INFO )
109 CALL CHKXER( 'DGETRF', INFOT, NOUT, LERR, OK )
110 INFOT = 4
111 CALL DGETRF( 2, 1, A, 1, IP, INFO )
112 CALL CHKXER( 'DGETRF', INFOT, NOUT, LERR, OK )
113 *
114 * DGETF2
115 *
116 SRNAMT = 'DGETF2'
117 INFOT = 1
118 CALL DGETF2( -1, 0, A, 1, IP, INFO )
119 CALL CHKXER( 'DGETF2', INFOT, NOUT, LERR, OK )
120 INFOT = 2
121 CALL DGETF2( 0, -1, A, 1, IP, INFO )
122 CALL CHKXER( 'DGETF2', INFOT, NOUT, LERR, OK )
123 INFOT = 4
124 CALL DGETF2( 2, 1, A, 1, IP, INFO )
125 CALL CHKXER( 'DGETF2', INFOT, NOUT, LERR, OK )
126 *
127 * DGETRI
128 *
129 SRNAMT = 'DGETRI'
130 INFOT = 1
131 CALL DGETRI( -1, A, 1, IP, W, LW, INFO )
132 CALL CHKXER( 'DGETRI', INFOT, NOUT, LERR, OK )
133 INFOT = 3
134 CALL DGETRI( 2, A, 1, IP, W, LW, INFO )
135 CALL CHKXER( 'DGETRI', INFOT, NOUT, LERR, OK )
136 *
137 * DGETRS
138 *
139 SRNAMT = 'DGETRS'
140 INFOT = 1
141 CALL DGETRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
142 CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK )
143 INFOT = 2
144 CALL DGETRS( 'N', -1, 0, A, 1, IP, B, 1, INFO )
145 CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK )
146 INFOT = 3
147 CALL DGETRS( 'N', 0, -1, A, 1, IP, B, 1, INFO )
148 CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK )
149 INFOT = 5
150 CALL DGETRS( 'N', 2, 1, A, 1, IP, B, 2, INFO )
151 CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK )
152 INFOT = 8
153 CALL DGETRS( 'N', 2, 1, A, 2, IP, B, 1, INFO )
154 CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK )
155 *
156 * DGERFS
157 *
158 SRNAMT = 'DGERFS'
159 INFOT = 1
160 CALL DGERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
161 $ IW, INFO )
162 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
163 INFOT = 2
164 CALL DGERFS( 'N', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
165 $ W, IW, INFO )
166 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
167 INFOT = 3
168 CALL DGERFS( 'N', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
169 $ W, IW, INFO )
170 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
171 INFOT = 5
172 CALL DGERFS( 'N', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
173 $ IW, INFO )
174 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
175 INFOT = 7
176 CALL DGERFS( 'N', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
177 $ IW, INFO )
178 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
179 INFOT = 10
180 CALL DGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
181 $ IW, INFO )
182 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
183 INFOT = 12
184 CALL DGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
185 $ IW, INFO )
186 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
187 *
188 * DGERFSX
189 *
190 N_ERR_BNDS = 3
191 NPARAMS = 0
192 SRNAMT = 'DGERFSX'
193 INFOT = 1
194 CALL DGERFSX( '/', EQ, 0, 0, A, 1, AF, 1, IP, R, C, B, 1, X,
195 $ 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
196 $ NPARAMS, PARAMS, W, IW, INFO )
197 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK )
198 INFOT = 2
199 EQ = '/'
200 CALL DGERFSX( 'N', EQ, 2, 1, A, 1, AF, 2, IP, R, C, B, 2, X,
201 $ 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
202 $ NPARAMS, PARAMS, W, IW, INFO )
203 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK )
204 INFOT = 3
205 EQ = 'R'
206 CALL DGERFSX( 'N', EQ, -1, 0, A, 1, AF, 1, IP, R, C, B, 1, X,
207 $ 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
208 $ NPARAMS, PARAMS, W, IW, INFO )
209 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK )
210 INFOT = 4
211 CALL DGERFSX( 'N', EQ, 0, -1, A, 1, AF, 1, IP, R, C, B, 1, X,
212 $ 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
213 $ NPARAMS, PARAMS, W, IW, INFO )
214 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK )
215 INFOT = 6
216 CALL DGERFSX( 'N', EQ, 2, 1, A, 1, AF, 2, IP, R, C, B, 2, X,
217 $ 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
218 $ NPARAMS, PARAMS, W, IW, INFO )
219 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK )
220 INFOT = 8
221 CALL DGERFSX( 'N', EQ, 2, 1, A, 2, AF, 1, IP, R, C, B, 2, X,
222 $ 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
223 $ NPARAMS, PARAMS, W, IW, INFO )
224 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK )
225 INFOT = 13
226 EQ = 'C'
227 CALL DGERFSX( 'N', EQ, 2, 1, A, 2, AF, 2, IP, R, C, B, 1, X,
228 $ 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
229 $ NPARAMS, PARAMS, W, IW, INFO )
230 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK )
231 INFOT = 15
232 CALL DGERFSX( 'N', EQ, 2, 1, A, 2, AF, 2, IP, R, C, B, 2, X,
233 $ 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
234 $ NPARAMS, PARAMS, W, IW, INFO )
235 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK )
236 *
237 * DGECON
238 *
239 SRNAMT = 'DGECON'
240 INFOT = 1
241 CALL DGECON( '/', 0, A, 1, ANRM, RCOND, W, IW, INFO )
242 CALL CHKXER( 'DGECON', INFOT, NOUT, LERR, OK )
243 INFOT = 2
244 CALL DGECON( '1', -1, A, 1, ANRM, RCOND, W, IW, INFO )
245 CALL CHKXER( 'DGECON', INFOT, NOUT, LERR, OK )
246 INFOT = 4
247 CALL DGECON( '1', 2, A, 1, ANRM, RCOND, W, IW, INFO )
248 CALL CHKXER( 'DGECON', INFOT, NOUT, LERR, OK )
249 *
250 * DGEEQU
251 *
252 SRNAMT = 'DGEEQU'
253 INFOT = 1
254 CALL DGEEQU( -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
255 CALL CHKXER( 'DGEEQU', INFOT, NOUT, LERR, OK )
256 INFOT = 2
257 CALL DGEEQU( 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
258 CALL CHKXER( 'DGEEQU', INFOT, NOUT, LERR, OK )
259 INFOT = 4
260 CALL DGEEQU( 2, 2, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
261 CALL CHKXER( 'DGEEQU', INFOT, NOUT, LERR, OK )
262 *
263 * DGEEQUB
264 *
265 SRNAMT = 'DGEEQUB'
266 INFOT = 1
267 CALL DGEEQUB( -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
268 CALL CHKXER( 'DGEEQUB', INFOT, NOUT, LERR, OK )
269 INFOT = 2
270 CALL DGEEQUB( 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
271 CALL CHKXER( 'DGEEQUB', INFOT, NOUT, LERR, OK )
272 INFOT = 4
273 CALL DGEEQUB( 2, 2, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
274 CALL CHKXER( 'DGEEQUB', INFOT, NOUT, LERR, OK )
275 *
276 ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN
277 *
278 * Test error exits of the routines that use the LU decomposition
279 * of a general band matrix.
280 *
281 * DGBTRF
282 *
283 SRNAMT = 'DGBTRF'
284 INFOT = 1
285 CALL DGBTRF( -1, 0, 0, 0, A, 1, IP, INFO )
286 CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK )
287 INFOT = 2
288 CALL DGBTRF( 0, -1, 0, 0, A, 1, IP, INFO )
289 CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK )
290 INFOT = 3
291 CALL DGBTRF( 1, 1, -1, 0, A, 1, IP, INFO )
292 CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK )
293 INFOT = 4
294 CALL DGBTRF( 1, 1, 0, -1, A, 1, IP, INFO )
295 CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK )
296 INFOT = 6
297 CALL DGBTRF( 2, 2, 1, 1, A, 3, IP, INFO )
298 CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK )
299 *
300 * DGBTF2
301 *
302 SRNAMT = 'DGBTF2'
303 INFOT = 1
304 CALL DGBTF2( -1, 0, 0, 0, A, 1, IP, INFO )
305 CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK )
306 INFOT = 2
307 CALL DGBTF2( 0, -1, 0, 0, A, 1, IP, INFO )
308 CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK )
309 INFOT = 3
310 CALL DGBTF2( 1, 1, -1, 0, A, 1, IP, INFO )
311 CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK )
312 INFOT = 4
313 CALL DGBTF2( 1, 1, 0, -1, A, 1, IP, INFO )
314 CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK )
315 INFOT = 6
316 CALL DGBTF2( 2, 2, 1, 1, A, 3, IP, INFO )
317 CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK )
318 *
319 * DGBTRS
320 *
321 SRNAMT = 'DGBTRS'
322 INFOT = 1
323 CALL DGBTRS( '/', 0, 0, 0, 1, A, 1, IP, B, 1, INFO )
324 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
325 INFOT = 2
326 CALL DGBTRS( 'N', -1, 0, 0, 1, A, 1, IP, B, 1, INFO )
327 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
328 INFOT = 3
329 CALL DGBTRS( 'N', 1, -1, 0, 1, A, 1, IP, B, 1, INFO )
330 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
331 INFOT = 4
332 CALL DGBTRS( 'N', 1, 0, -1, 1, A, 1, IP, B, 1, INFO )
333 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
334 INFOT = 5
335 CALL DGBTRS( 'N', 1, 0, 0, -1, A, 1, IP, B, 1, INFO )
336 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
337 INFOT = 7
338 CALL DGBTRS( 'N', 2, 1, 1, 1, A, 3, IP, B, 2, INFO )
339 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
340 INFOT = 10
341 CALL DGBTRS( 'N', 2, 0, 0, 1, A, 1, IP, B, 1, INFO )
342 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
343 *
344 * DGBRFS
345 *
346 SRNAMT = 'DGBRFS'
347 INFOT = 1
348 CALL DGBRFS( '/', 0, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1,
349 $ R2, W, IW, INFO )
350 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
351 INFOT = 2
352 CALL DGBRFS( 'N', -1, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1,
353 $ R2, W, IW, INFO )
354 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
355 INFOT = 3
356 CALL DGBRFS( 'N', 1, -1, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1,
357 $ R2, W, IW, INFO )
358 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
359 INFOT = 4
360 CALL DGBRFS( 'N', 1, 0, -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1,
361 $ R2, W, IW, INFO )
362 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
363 INFOT = 5
364 CALL DGBRFS( 'N', 1, 0, 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1,
365 $ R2, W, IW, INFO )
366 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
367 INFOT = 7
368 CALL DGBRFS( 'N', 2, 1, 1, 1, A, 2, AF, 4, IP, B, 2, X, 2, R1,
369 $ R2, W, IW, INFO )
370 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
371 INFOT = 9
372 CALL DGBRFS( 'N', 2, 1, 1, 1, A, 3, AF, 3, IP, B, 2, X, 2, R1,
373 $ R2, W, IW, INFO )
374 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
375 INFOT = 12
376 CALL DGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 1, X, 2, R1,
377 $ R2, W, IW, INFO )
378 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
379 INFOT = 14
380 CALL DGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 2, X, 1, R1,
381 $ R2, W, IW, INFO )
382 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
383 *
384 * DGBRFSX
385 *
386 N_ERR_BNDS = 3
387 NPARAMS = 0
388 SRNAMT = 'DGBRFSX'
389 INFOT = 1
390 CALL DGBRFSX( '/', EQ, 0, 0, 0, 0, A, 1, AF, 1, IP, R, C, B, 1,
391 $ X, 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
392 $ NPARAMS, PARAMS, W, IW, INFO )
393 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK )
394 INFOT = 2
395 EQ = '/'
396 CALL DGBRFSX( 'N', EQ, 2, 1, 1, 1, A, 1, AF, 2, IP, R, C, B, 2,
397 $ X, 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
398 $ NPARAMS, PARAMS, W, IW, INFO )
399 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK )
400 INFOT = 3
401 EQ = 'R'
402 CALL DGBRFSX( 'N', EQ, -1, 1, 1, 0, A, 1, AF, 1, IP, R, C, B,
403 $ 1, X, 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
404 $ NPARAMS, PARAMS, W, IW, INFO )
405 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK )
406 INFOT = 4
407 EQ = 'R'
408 CALL DGBRFSX( 'N', EQ, 2, -1, 1, 1, A, 3, AF, 4, IP, R, C, B,
409 $ 1, X, 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
410 $ NPARAMS, PARAMS, W, IW, INFO )
411 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK )
412 INFOT = 5
413 EQ = 'R'
414 CALL DGBRFSX( 'N', EQ, 2, 1, -1, 1, A, 3, AF, 4, IP, R, C, B,
415 $ 1, X, 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
416 $ NPARAMS, PARAMS, W, IW, INFO )
417 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK )
418 INFOT = 6
419 CALL DGBRFSX( 'N', EQ, 0, 0, 0, -1, A, 1, AF, 1, IP, R, C, B,
420 $ 1, X, 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
421 $ NPARAMS, PARAMS, W, IW, INFO )
422 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK )
423 INFOT = 8
424 CALL DGBRFSX( 'N', EQ, 2, 1, 1, 1, A, 1, AF, 2, IP, R, C, B,
425 $ 2, X, 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
426 $ NPARAMS, PARAMS, W, IW, INFO )
427 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK )
428 INFOT = 10
429 CALL DGBRFSX( 'N', EQ, 2, 1, 1, 1, A, 3, AF, 3, IP, R, C, B, 2,
430 $ X, 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
431 $ NPARAMS, PARAMS, W, IW, INFO )
432 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK )
433 INFOT = 13
434 EQ = 'C'
435 CALL DGBRFSX( 'N', EQ, 2, 1, 1, 1, A, 3, AF, 5, IP, R, C, B,
436 $ 1, X, 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
437 $ NPARAMS, PARAMS, W, IW, INFO )
438 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK )
439 INFOT = 15
440 CALL DGBRFSX( 'N', EQ, 2, 1, 1, 1, A, 3, AF, 5, IP, R, C, B, 2,
441 $ X, 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
442 $ NPARAMS, PARAMS, W, IW, INFO )
443 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK )
444 *
445 * DGBCON
446 *
447 SRNAMT = 'DGBCON'
448 INFOT = 1
449 CALL DGBCON( '/', 0, 0, 0, A, 1, IP, ANRM, RCOND, W, IW, INFO )
450 CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK )
451 INFOT = 2
452 CALL DGBCON( '1', -1, 0, 0, A, 1, IP, ANRM, RCOND, W, IW,
453 $ INFO )
454 CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK )
455 INFOT = 3
456 CALL DGBCON( '1', 1, -1, 0, A, 1, IP, ANRM, RCOND, W, IW,
457 $ INFO )
458 CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK )
459 INFOT = 4
460 CALL DGBCON( '1', 1, 0, -1, A, 1, IP, ANRM, RCOND, W, IW,
461 $ INFO )
462 CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK )
463 INFOT = 6
464 CALL DGBCON( '1', 2, 1, 1, A, 3, IP, ANRM, RCOND, W, IW, INFO )
465 CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK )
466 *
467 * DGBEQU
468 *
469 SRNAMT = 'DGBEQU'
470 INFOT = 1
471 CALL DGBEQU( -1, 0, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM,
472 $ INFO )
473 CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK )
474 INFOT = 2
475 CALL DGBEQU( 0, -1, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM,
476 $ INFO )
477 CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK )
478 INFOT = 3
479 CALL DGBEQU( 1, 1, -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM,
480 $ INFO )
481 CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK )
482 INFOT = 4
483 CALL DGBEQU( 1, 1, 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM,
484 $ INFO )
485 CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK )
486 INFOT = 6
487 CALL DGBEQU( 2, 2, 1, 1, A, 2, R1, R2, RCOND, CCOND, ANRM,
488 $ INFO )
489 CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK )
490 *
491 * DGBEQUB
492 *
493 SRNAMT = 'DGBEQUB'
494 INFOT = 1
495 CALL DGBEQUB( -1, 0, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM,
496 $ INFO )
497 CALL CHKXER( 'DGBEQUB', INFOT, NOUT, LERR, OK )
498 INFOT = 2
499 CALL DGBEQUB( 0, -1, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM,
500 $ INFO )
501 CALL CHKXER( 'DGBEQUB', INFOT, NOUT, LERR, OK )
502 INFOT = 3
503 CALL DGBEQUB( 1, 1, -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM,
504 $ INFO )
505 CALL CHKXER( 'DGBEQUB', INFOT, NOUT, LERR, OK )
506 INFOT = 4
507 CALL DGBEQUB( 1, 1, 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM,
508 $ INFO )
509 CALL CHKXER( 'DGBEQUB', INFOT, NOUT, LERR, OK )
510 INFOT = 6
511 CALL DGBEQUB( 2, 2, 1, 1, A, 2, R1, R2, RCOND, CCOND, ANRM,
512 $ INFO )
513 CALL CHKXER( 'DGBEQUB', INFOT, NOUT, LERR, OK )
514 END IF
515 *
516 * Print a summary line.
517 *
518 CALL ALAESM( PATH, OK, NOUT )
519 *
520 RETURN
521 *
522 * End of DERRGE
523 *
524 END
2 *
3 * -- LAPACK test routine (version 3.2.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * April 2009
6 *
7 * .. Scalar Arguments ..
8 CHARACTER*3 PATH
9 INTEGER NUNIT
10 * ..
11 *
12 * Purpose
13 * =======
14 *
15 * DERRGE tests the error exits for the DOUBLE PRECISION routines
16 * for general matrices.
17 *
18 * Note that this file is used only when the XBLAS are available,
19 * otherwise derrge.f defines this subroutine.
20 *
21 * Arguments
22 * =========
23 *
24 * PATH (input) CHARACTER*3
25 * The LAPACK path name for the routines to be tested.
26 *
27 * NUNIT (input) INTEGER
28 * The unit number for output.
29 *
30 * =====================================================================
31 *
32 * .. Parameters ..
33 INTEGER NMAX, LW
34 PARAMETER ( NMAX = 4, LW = 3*NMAX )
35 * ..
36 * .. Local Scalars ..
37 CHARACTER EQ
38 CHARACTER*2 C2
39 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
40 DOUBLE PRECISION ANRM, CCOND, RCOND, BERR
41 * ..
42 * .. Local Arrays ..
43 INTEGER IP( NMAX ), IW( NMAX )
44 DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
45 $ C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
46 $ W( LW ), X( NMAX ), ERR_BNDS_N( NMAX, 3 ),
47 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
48 * ..
49 * .. External Functions ..
50 LOGICAL LSAMEN
51 EXTERNAL LSAMEN
52 * ..
53 * .. External Subroutines ..
54 EXTERNAL ALAESM, CHKXER, DGBCON, DGBEQU, DGBRFS, DGBTF2,
55 $ DGBTRF, DGBTRS, DGECON, DGEEQU, DGERFS, DGETF2,
56 $ DGETRF, DGETRI, DGETRS, DGEEQUB, DGERFSX,
57 $ DGBEQUB, DGBRFSX
58 * ..
59 * .. Scalars in Common ..
60 LOGICAL LERR, OK
61 CHARACTER*32 SRNAMT
62 INTEGER INFOT, NOUT
63 * ..
64 * .. Common blocks ..
65 COMMON / INFOC / INFOT, NOUT, OK, LERR
66 COMMON / SRNAMC / SRNAMT
67 * ..
68 * .. Intrinsic Functions ..
69 INTRINSIC DBLE
70 * ..
71 * .. Executable Statements ..
72 *
73 NOUT = NUNIT
74 WRITE( NOUT, FMT = * )
75 C2 = PATH( 2: 3 )
76 *
77 * Set the variables to innocuous values.
78 *
79 DO 20 J = 1, NMAX
80 DO 10 I = 1, NMAX
81 A( I, J ) = 1.D0 / DBLE( I+J )
82 AF( I, J ) = 1.D0 / DBLE( I+J )
83 10 CONTINUE
84 B( J ) = 0.D0
85 R1( J ) = 0.D0
86 R2( J ) = 0.D0
87 W( J ) = 0.D0
88 X( J ) = 0.D0
89 C( J ) = 0.D0
90 R( J ) = 0.D0
91 IP( J ) = J
92 IW( J ) = J
93 20 CONTINUE
94 OK = .TRUE.
95 *
96 IF( LSAMEN( 2, C2, 'GE' ) ) THEN
97 *
98 * Test error exits of the routines that use the LU decomposition
99 * of a general matrix.
100 *
101 * DGETRF
102 *
103 SRNAMT = 'DGETRF'
104 INFOT = 1
105 CALL DGETRF( -1, 0, A, 1, IP, INFO )
106 CALL CHKXER( 'DGETRF', INFOT, NOUT, LERR, OK )
107 INFOT = 2
108 CALL DGETRF( 0, -1, A, 1, IP, INFO )
109 CALL CHKXER( 'DGETRF', INFOT, NOUT, LERR, OK )
110 INFOT = 4
111 CALL DGETRF( 2, 1, A, 1, IP, INFO )
112 CALL CHKXER( 'DGETRF', INFOT, NOUT, LERR, OK )
113 *
114 * DGETF2
115 *
116 SRNAMT = 'DGETF2'
117 INFOT = 1
118 CALL DGETF2( -1, 0, A, 1, IP, INFO )
119 CALL CHKXER( 'DGETF2', INFOT, NOUT, LERR, OK )
120 INFOT = 2
121 CALL DGETF2( 0, -1, A, 1, IP, INFO )
122 CALL CHKXER( 'DGETF2', INFOT, NOUT, LERR, OK )
123 INFOT = 4
124 CALL DGETF2( 2, 1, A, 1, IP, INFO )
125 CALL CHKXER( 'DGETF2', INFOT, NOUT, LERR, OK )
126 *
127 * DGETRI
128 *
129 SRNAMT = 'DGETRI'
130 INFOT = 1
131 CALL DGETRI( -1, A, 1, IP, W, LW, INFO )
132 CALL CHKXER( 'DGETRI', INFOT, NOUT, LERR, OK )
133 INFOT = 3
134 CALL DGETRI( 2, A, 1, IP, W, LW, INFO )
135 CALL CHKXER( 'DGETRI', INFOT, NOUT, LERR, OK )
136 *
137 * DGETRS
138 *
139 SRNAMT = 'DGETRS'
140 INFOT = 1
141 CALL DGETRS( '/', 0, 0, A, 1, IP, B, 1, INFO )
142 CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK )
143 INFOT = 2
144 CALL DGETRS( 'N', -1, 0, A, 1, IP, B, 1, INFO )
145 CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK )
146 INFOT = 3
147 CALL DGETRS( 'N', 0, -1, A, 1, IP, B, 1, INFO )
148 CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK )
149 INFOT = 5
150 CALL DGETRS( 'N', 2, 1, A, 1, IP, B, 2, INFO )
151 CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK )
152 INFOT = 8
153 CALL DGETRS( 'N', 2, 1, A, 2, IP, B, 1, INFO )
154 CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK )
155 *
156 * DGERFS
157 *
158 SRNAMT = 'DGERFS'
159 INFOT = 1
160 CALL DGERFS( '/', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
161 $ IW, INFO )
162 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
163 INFOT = 2
164 CALL DGERFS( 'N', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
165 $ W, IW, INFO )
166 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
167 INFOT = 3
168 CALL DGERFS( 'N', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
169 $ W, IW, INFO )
170 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
171 INFOT = 5
172 CALL DGERFS( 'N', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
173 $ IW, INFO )
174 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
175 INFOT = 7
176 CALL DGERFS( 'N', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
177 $ IW, INFO )
178 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
179 INFOT = 10
180 CALL DGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
181 $ IW, INFO )
182 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
183 INFOT = 12
184 CALL DGERFS( 'N', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
185 $ IW, INFO )
186 CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
187 *
188 * DGERFSX
189 *
190 N_ERR_BNDS = 3
191 NPARAMS = 0
192 SRNAMT = 'DGERFSX'
193 INFOT = 1
194 CALL DGERFSX( '/', EQ, 0, 0, A, 1, AF, 1, IP, R, C, B, 1, X,
195 $ 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
196 $ NPARAMS, PARAMS, W, IW, INFO )
197 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK )
198 INFOT = 2
199 EQ = '/'
200 CALL DGERFSX( 'N', EQ, 2, 1, A, 1, AF, 2, IP, R, C, B, 2, X,
201 $ 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
202 $ NPARAMS, PARAMS, W, IW, INFO )
203 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK )
204 INFOT = 3
205 EQ = 'R'
206 CALL DGERFSX( 'N', EQ, -1, 0, A, 1, AF, 1, IP, R, C, B, 1, X,
207 $ 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
208 $ NPARAMS, PARAMS, W, IW, INFO )
209 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK )
210 INFOT = 4
211 CALL DGERFSX( 'N', EQ, 0, -1, A, 1, AF, 1, IP, R, C, B, 1, X,
212 $ 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
213 $ NPARAMS, PARAMS, W, IW, INFO )
214 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK )
215 INFOT = 6
216 CALL DGERFSX( 'N', EQ, 2, 1, A, 1, AF, 2, IP, R, C, B, 2, X,
217 $ 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
218 $ NPARAMS, PARAMS, W, IW, INFO )
219 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK )
220 INFOT = 8
221 CALL DGERFSX( 'N', EQ, 2, 1, A, 2, AF, 1, IP, R, C, B, 2, X,
222 $ 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
223 $ NPARAMS, PARAMS, W, IW, INFO )
224 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK )
225 INFOT = 13
226 EQ = 'C'
227 CALL DGERFSX( 'N', EQ, 2, 1, A, 2, AF, 2, IP, R, C, B, 1, X,
228 $ 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
229 $ NPARAMS, PARAMS, W, IW, INFO )
230 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK )
231 INFOT = 15
232 CALL DGERFSX( 'N', EQ, 2, 1, A, 2, AF, 2, IP, R, C, B, 2, X,
233 $ 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
234 $ NPARAMS, PARAMS, W, IW, INFO )
235 CALL CHKXER( 'DGERFSX', INFOT, NOUT, LERR, OK )
236 *
237 * DGECON
238 *
239 SRNAMT = 'DGECON'
240 INFOT = 1
241 CALL DGECON( '/', 0, A, 1, ANRM, RCOND, W, IW, INFO )
242 CALL CHKXER( 'DGECON', INFOT, NOUT, LERR, OK )
243 INFOT = 2
244 CALL DGECON( '1', -1, A, 1, ANRM, RCOND, W, IW, INFO )
245 CALL CHKXER( 'DGECON', INFOT, NOUT, LERR, OK )
246 INFOT = 4
247 CALL DGECON( '1', 2, A, 1, ANRM, RCOND, W, IW, INFO )
248 CALL CHKXER( 'DGECON', INFOT, NOUT, LERR, OK )
249 *
250 * DGEEQU
251 *
252 SRNAMT = 'DGEEQU'
253 INFOT = 1
254 CALL DGEEQU( -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
255 CALL CHKXER( 'DGEEQU', INFOT, NOUT, LERR, OK )
256 INFOT = 2
257 CALL DGEEQU( 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
258 CALL CHKXER( 'DGEEQU', INFOT, NOUT, LERR, OK )
259 INFOT = 4
260 CALL DGEEQU( 2, 2, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
261 CALL CHKXER( 'DGEEQU', INFOT, NOUT, LERR, OK )
262 *
263 * DGEEQUB
264 *
265 SRNAMT = 'DGEEQUB'
266 INFOT = 1
267 CALL DGEEQUB( -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
268 CALL CHKXER( 'DGEEQUB', INFOT, NOUT, LERR, OK )
269 INFOT = 2
270 CALL DGEEQUB( 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
271 CALL CHKXER( 'DGEEQUB', INFOT, NOUT, LERR, OK )
272 INFOT = 4
273 CALL DGEEQUB( 2, 2, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
274 CALL CHKXER( 'DGEEQUB', INFOT, NOUT, LERR, OK )
275 *
276 ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN
277 *
278 * Test error exits of the routines that use the LU decomposition
279 * of a general band matrix.
280 *
281 * DGBTRF
282 *
283 SRNAMT = 'DGBTRF'
284 INFOT = 1
285 CALL DGBTRF( -1, 0, 0, 0, A, 1, IP, INFO )
286 CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK )
287 INFOT = 2
288 CALL DGBTRF( 0, -1, 0, 0, A, 1, IP, INFO )
289 CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK )
290 INFOT = 3
291 CALL DGBTRF( 1, 1, -1, 0, A, 1, IP, INFO )
292 CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK )
293 INFOT = 4
294 CALL DGBTRF( 1, 1, 0, -1, A, 1, IP, INFO )
295 CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK )
296 INFOT = 6
297 CALL DGBTRF( 2, 2, 1, 1, A, 3, IP, INFO )
298 CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK )
299 *
300 * DGBTF2
301 *
302 SRNAMT = 'DGBTF2'
303 INFOT = 1
304 CALL DGBTF2( -1, 0, 0, 0, A, 1, IP, INFO )
305 CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK )
306 INFOT = 2
307 CALL DGBTF2( 0, -1, 0, 0, A, 1, IP, INFO )
308 CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK )
309 INFOT = 3
310 CALL DGBTF2( 1, 1, -1, 0, A, 1, IP, INFO )
311 CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK )
312 INFOT = 4
313 CALL DGBTF2( 1, 1, 0, -1, A, 1, IP, INFO )
314 CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK )
315 INFOT = 6
316 CALL DGBTF2( 2, 2, 1, 1, A, 3, IP, INFO )
317 CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK )
318 *
319 * DGBTRS
320 *
321 SRNAMT = 'DGBTRS'
322 INFOT = 1
323 CALL DGBTRS( '/', 0, 0, 0, 1, A, 1, IP, B, 1, INFO )
324 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
325 INFOT = 2
326 CALL DGBTRS( 'N', -1, 0, 0, 1, A, 1, IP, B, 1, INFO )
327 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
328 INFOT = 3
329 CALL DGBTRS( 'N', 1, -1, 0, 1, A, 1, IP, B, 1, INFO )
330 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
331 INFOT = 4
332 CALL DGBTRS( 'N', 1, 0, -1, 1, A, 1, IP, B, 1, INFO )
333 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
334 INFOT = 5
335 CALL DGBTRS( 'N', 1, 0, 0, -1, A, 1, IP, B, 1, INFO )
336 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
337 INFOT = 7
338 CALL DGBTRS( 'N', 2, 1, 1, 1, A, 3, IP, B, 2, INFO )
339 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
340 INFOT = 10
341 CALL DGBTRS( 'N', 2, 0, 0, 1, A, 1, IP, B, 1, INFO )
342 CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
343 *
344 * DGBRFS
345 *
346 SRNAMT = 'DGBRFS'
347 INFOT = 1
348 CALL DGBRFS( '/', 0, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1,
349 $ R2, W, IW, INFO )
350 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
351 INFOT = 2
352 CALL DGBRFS( 'N', -1, 0, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1,
353 $ R2, W, IW, INFO )
354 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
355 INFOT = 3
356 CALL DGBRFS( 'N', 1, -1, 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1,
357 $ R2, W, IW, INFO )
358 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
359 INFOT = 4
360 CALL DGBRFS( 'N', 1, 0, -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1,
361 $ R2, W, IW, INFO )
362 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
363 INFOT = 5
364 CALL DGBRFS( 'N', 1, 0, 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1,
365 $ R2, W, IW, INFO )
366 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
367 INFOT = 7
368 CALL DGBRFS( 'N', 2, 1, 1, 1, A, 2, AF, 4, IP, B, 2, X, 2, R1,
369 $ R2, W, IW, INFO )
370 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
371 INFOT = 9
372 CALL DGBRFS( 'N', 2, 1, 1, 1, A, 3, AF, 3, IP, B, 2, X, 2, R1,
373 $ R2, W, IW, INFO )
374 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
375 INFOT = 12
376 CALL DGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 1, X, 2, R1,
377 $ R2, W, IW, INFO )
378 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
379 INFOT = 14
380 CALL DGBRFS( 'N', 2, 0, 0, 1, A, 1, AF, 1, IP, B, 2, X, 1, R1,
381 $ R2, W, IW, INFO )
382 CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
383 *
384 * DGBRFSX
385 *
386 N_ERR_BNDS = 3
387 NPARAMS = 0
388 SRNAMT = 'DGBRFSX'
389 INFOT = 1
390 CALL DGBRFSX( '/', EQ, 0, 0, 0, 0, A, 1, AF, 1, IP, R, C, B, 1,
391 $ X, 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
392 $ NPARAMS, PARAMS, W, IW, INFO )
393 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK )
394 INFOT = 2
395 EQ = '/'
396 CALL DGBRFSX( 'N', EQ, 2, 1, 1, 1, A, 1, AF, 2, IP, R, C, B, 2,
397 $ X, 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
398 $ NPARAMS, PARAMS, W, IW, INFO )
399 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK )
400 INFOT = 3
401 EQ = 'R'
402 CALL DGBRFSX( 'N', EQ, -1, 1, 1, 0, A, 1, AF, 1, IP, R, C, B,
403 $ 1, X, 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
404 $ NPARAMS, PARAMS, W, IW, INFO )
405 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK )
406 INFOT = 4
407 EQ = 'R'
408 CALL DGBRFSX( 'N', EQ, 2, -1, 1, 1, A, 3, AF, 4, IP, R, C, B,
409 $ 1, X, 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
410 $ NPARAMS, PARAMS, W, IW, INFO )
411 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK )
412 INFOT = 5
413 EQ = 'R'
414 CALL DGBRFSX( 'N', EQ, 2, 1, -1, 1, A, 3, AF, 4, IP, R, C, B,
415 $ 1, X, 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
416 $ NPARAMS, PARAMS, W, IW, INFO )
417 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK )
418 INFOT = 6
419 CALL DGBRFSX( 'N', EQ, 0, 0, 0, -1, A, 1, AF, 1, IP, R, C, B,
420 $ 1, X, 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
421 $ NPARAMS, PARAMS, W, IW, INFO )
422 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK )
423 INFOT = 8
424 CALL DGBRFSX( 'N', EQ, 2, 1, 1, 1, A, 1, AF, 2, IP, R, C, B,
425 $ 2, X, 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
426 $ NPARAMS, PARAMS, W, IW, INFO )
427 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK )
428 INFOT = 10
429 CALL DGBRFSX( 'N', EQ, 2, 1, 1, 1, A, 3, AF, 3, IP, R, C, B, 2,
430 $ X, 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
431 $ NPARAMS, PARAMS, W, IW, INFO )
432 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK )
433 INFOT = 13
434 EQ = 'C'
435 CALL DGBRFSX( 'N', EQ, 2, 1, 1, 1, A, 3, AF, 5, IP, R, C, B,
436 $ 1, X, 2, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
437 $ NPARAMS, PARAMS, W, IW, INFO )
438 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK )
439 INFOT = 15
440 CALL DGBRFSX( 'N', EQ, 2, 1, 1, 1, A, 3, AF, 5, IP, R, C, B, 2,
441 $ X, 1, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C,
442 $ NPARAMS, PARAMS, W, IW, INFO )
443 CALL CHKXER( 'DGBRFSX', INFOT, NOUT, LERR, OK )
444 *
445 * DGBCON
446 *
447 SRNAMT = 'DGBCON'
448 INFOT = 1
449 CALL DGBCON( '/', 0, 0, 0, A, 1, IP, ANRM, RCOND, W, IW, INFO )
450 CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK )
451 INFOT = 2
452 CALL DGBCON( '1', -1, 0, 0, A, 1, IP, ANRM, RCOND, W, IW,
453 $ INFO )
454 CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK )
455 INFOT = 3
456 CALL DGBCON( '1', 1, -1, 0, A, 1, IP, ANRM, RCOND, W, IW,
457 $ INFO )
458 CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK )
459 INFOT = 4
460 CALL DGBCON( '1', 1, 0, -1, A, 1, IP, ANRM, RCOND, W, IW,
461 $ INFO )
462 CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK )
463 INFOT = 6
464 CALL DGBCON( '1', 2, 1, 1, A, 3, IP, ANRM, RCOND, W, IW, INFO )
465 CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK )
466 *
467 * DGBEQU
468 *
469 SRNAMT = 'DGBEQU'
470 INFOT = 1
471 CALL DGBEQU( -1, 0, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM,
472 $ INFO )
473 CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK )
474 INFOT = 2
475 CALL DGBEQU( 0, -1, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM,
476 $ INFO )
477 CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK )
478 INFOT = 3
479 CALL DGBEQU( 1, 1, -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM,
480 $ INFO )
481 CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK )
482 INFOT = 4
483 CALL DGBEQU( 1, 1, 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM,
484 $ INFO )
485 CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK )
486 INFOT = 6
487 CALL DGBEQU( 2, 2, 1, 1, A, 2, R1, R2, RCOND, CCOND, ANRM,
488 $ INFO )
489 CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK )
490 *
491 * DGBEQUB
492 *
493 SRNAMT = 'DGBEQUB'
494 INFOT = 1
495 CALL DGBEQUB( -1, 0, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM,
496 $ INFO )
497 CALL CHKXER( 'DGBEQUB', INFOT, NOUT, LERR, OK )
498 INFOT = 2
499 CALL DGBEQUB( 0, -1, 0, 0, A, 1, R1, R2, RCOND, CCOND, ANRM,
500 $ INFO )
501 CALL CHKXER( 'DGBEQUB', INFOT, NOUT, LERR, OK )
502 INFOT = 3
503 CALL DGBEQUB( 1, 1, -1, 0, A, 1, R1, R2, RCOND, CCOND, ANRM,
504 $ INFO )
505 CALL CHKXER( 'DGBEQUB', INFOT, NOUT, LERR, OK )
506 INFOT = 4
507 CALL DGBEQUB( 1, 1, 0, -1, A, 1, R1, R2, RCOND, CCOND, ANRM,
508 $ INFO )
509 CALL CHKXER( 'DGBEQUB', INFOT, NOUT, LERR, OK )
510 INFOT = 6
511 CALL DGBEQUB( 2, 2, 1, 1, A, 2, R1, R2, RCOND, CCOND, ANRM,
512 $ INFO )
513 CALL CHKXER( 'DGBEQUB', INFOT, NOUT, LERR, OK )
514 END IF
515 *
516 * Print a summary line.
517 *
518 CALL ALAESM( PATH, OK, NOUT )
519 *
520 RETURN
521 *
522 * End of DERRGE
523 *
524 END