59 SUBROUTINE derrge( PATH, NUNIT )
75 parameter( nmax = 4, lw = 3*nmax )
80 INTEGER i, info, j, n_err_bnds, nparams
81 DOUBLE PRECISION anrm, ccond, rcond, berr
84 INTEGER ip( nmax ), iw( nmax )
85 DOUBLE PRECISION a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
86 $ c( nmax ), r( nmax ), r1( nmax ), r2( nmax ),
87 $ w( lw ), x( nmax ), err_bnds_n( nmax, 3 ),
88 $ err_bnds_c( nmax, 3 ), params( 1 )
106 common / infoc / infot, nout, ok, lerr
107 common / srnamc / srnamt
115 WRITE( nout, fmt = * )
122 a( i, j ) = 1.d0 / dble( i+j )
123 af( i, j ) = 1.d0 / dble( i+j )
137 IF(
lsamen( 2, c2,
'GE' ) )
THEN
146 CALL
dgetrf( -1, 0, a, 1, ip, info )
147 CALL
chkxer(
'DGETRF', infot, nout, lerr, ok )
149 CALL
dgetrf( 0, -1, a, 1, ip, info )
150 CALL
chkxer(
'DGETRF', infot, nout, lerr, ok )
152 CALL
dgetrf( 2, 1, a, 1, ip, info )
153 CALL
chkxer(
'DGETRF', infot, nout, lerr, ok )
159 CALL
dgetf2( -1, 0, a, 1, ip, info )
160 CALL
chkxer(
'DGETF2', infot, nout, lerr, ok )
162 CALL
dgetf2( 0, -1, a, 1, ip, info )
163 CALL
chkxer(
'DGETF2', infot, nout, lerr, ok )
165 CALL
dgetf2( 2, 1, a, 1, ip, info )
166 CALL
chkxer(
'DGETF2', infot, nout, lerr, ok )
172 CALL
dgetri( -1, a, 1, ip, w, lw, info )
173 CALL
chkxer(
'DGETRI', infot, nout, lerr, ok )
175 CALL
dgetri( 2, a, 1, ip, w, lw, info )
176 CALL
chkxer(
'DGETRI', infot, nout, lerr, ok )
182 CALL
dgetrs(
'/', 0, 0, a, 1, ip, b, 1, info )
183 CALL
chkxer(
'DGETRS', infot, nout, lerr, ok )
185 CALL
dgetrs(
'N', -1, 0, a, 1, ip, b, 1, info )
186 CALL
chkxer(
'DGETRS', infot, nout, lerr, ok )
188 CALL
dgetrs(
'N', 0, -1, a, 1, ip, b, 1, info )
189 CALL
chkxer(
'DGETRS', infot, nout, lerr, ok )
191 CALL
dgetrs(
'N', 2, 1, a, 1, ip, b, 2, info )
192 CALL
chkxer(
'DGETRS', infot, nout, lerr, ok )
194 CALL
dgetrs(
'N', 2, 1, a, 2, ip, b, 1, info )
195 CALL
chkxer(
'DGETRS', infot, nout, lerr, ok )
201 CALL
dgerfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
203 CALL
chkxer(
'DGERFS', infot, nout, lerr, ok )
205 CALL
dgerfs(
'N', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
207 CALL
chkxer(
'DGERFS', infot, nout, lerr, ok )
209 CALL
dgerfs(
'N', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
211 CALL
chkxer(
'DGERFS', infot, nout, lerr, ok )
213 CALL
dgerfs(
'N', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
215 CALL
chkxer(
'DGERFS', infot, nout, lerr, ok )
217 CALL
dgerfs(
'N', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
219 CALL
chkxer(
'DGERFS', infot, nout, lerr, ok )
221 CALL
dgerfs(
'N', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
223 CALL
chkxer(
'DGERFS', infot, nout, lerr, ok )
225 CALL
dgerfs(
'N', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
227 CALL
chkxer(
'DGERFS', infot, nout, lerr, ok )
235 CALL
dgerfsx(
'/', eq, 0, 0, a, 1, af, 1, ip, r, c, b, 1, x,
236 $ 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
237 $ nparams, params, w, iw, info )
238 CALL
chkxer(
'DGERFSX', infot, nout, lerr, ok )
241 CALL
dgerfsx(
'N', eq, 2, 1, a, 1, af, 2, ip, r, c, b, 2, x,
242 $ 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
243 $ nparams, params, w, iw, info )
244 CALL
chkxer(
'DGERFSX', infot, nout, lerr, ok )
247 CALL
dgerfsx(
'N', eq, -1, 0, a, 1, af, 1, ip, r, c, b, 1, x,
248 $ 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
249 $ nparams, params, w, iw, info )
250 CALL
chkxer(
'DGERFSX', infot, nout, lerr, ok )
252 CALL
dgerfsx(
'N', eq, 0, -1, a, 1, af, 1, ip, r, c, b, 1, x,
253 $ 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
254 $ nparams, params, w, iw, info )
255 CALL
chkxer(
'DGERFSX', infot, nout, lerr, ok )
257 CALL
dgerfsx(
'N', eq, 2, 1, a, 1, af, 2, ip, r, c, b, 2, x,
258 $ 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
259 $ nparams, params, w, iw, info )
260 CALL
chkxer(
'DGERFSX', infot, nout, lerr, ok )
262 CALL
dgerfsx(
'N', eq, 2, 1, a, 2, af, 1, ip, r, c, b, 2, x,
263 $ 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
264 $ nparams, params, w, iw, info )
265 CALL
chkxer(
'DGERFSX', infot, nout, lerr, ok )
268 CALL
dgerfsx(
'N', eq, 2, 1, a, 2, af, 2, ip, r, c, b, 1, x,
269 $ 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
270 $ nparams, params, w, iw, info )
271 CALL
chkxer(
'DGERFSX', infot, nout, lerr, ok )
273 CALL
dgerfsx(
'N', eq, 2, 1, a, 2, af, 2, ip, r, c, b, 2, x,
274 $ 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
275 $ nparams, params, w, iw, info )
276 CALL
chkxer(
'DGERFSX', infot, nout, lerr, ok )
282 CALL
dgecon(
'/', 0, a, 1, anrm, rcond, w, iw, info )
283 CALL
chkxer(
'DGECON', infot, nout, lerr, ok )
285 CALL
dgecon(
'1', -1, a, 1, anrm, rcond, w, iw, info )
286 CALL
chkxer(
'DGECON', infot, nout, lerr, ok )
288 CALL
dgecon(
'1', 2, a, 1, anrm, rcond, w, iw, info )
289 CALL
chkxer(
'DGECON', infot, nout, lerr, ok )
295 CALL
dgeequ( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
296 CALL
chkxer(
'DGEEQU', infot, nout, lerr, ok )
298 CALL
dgeequ( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
299 CALL
chkxer(
'DGEEQU', infot, nout, lerr, ok )
301 CALL
dgeequ( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
302 CALL
chkxer(
'DGEEQU', infot, nout, lerr, ok )
308 CALL
dgeequb( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
309 CALL
chkxer(
'DGEEQUB', infot, nout, lerr, ok )
311 CALL
dgeequb( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
312 CALL
chkxer(
'DGEEQUB', infot, nout, lerr, ok )
314 CALL
dgeequb( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
315 CALL
chkxer(
'DGEEQUB', infot, nout, lerr, ok )
317 ELSE IF(
lsamen( 2, c2,
'GB' ) )
THEN
326 CALL
dgbtrf( -1, 0, 0, 0, a, 1, ip, info )
327 CALL
chkxer(
'DGBTRF', infot, nout, lerr, ok )
329 CALL
dgbtrf( 0, -1, 0, 0, a, 1, ip, info )
330 CALL
chkxer(
'DGBTRF', infot, nout, lerr, ok )
332 CALL
dgbtrf( 1, 1, -1, 0, a, 1, ip, info )
333 CALL
chkxer(
'DGBTRF', infot, nout, lerr, ok )
335 CALL
dgbtrf( 1, 1, 0, -1, a, 1, ip, info )
336 CALL
chkxer(
'DGBTRF', infot, nout, lerr, ok )
338 CALL
dgbtrf( 2, 2, 1, 1, a, 3, ip, info )
339 CALL
chkxer(
'DGBTRF', infot, nout, lerr, ok )
345 CALL
dgbtf2( -1, 0, 0, 0, a, 1, ip, info )
346 CALL
chkxer(
'DGBTF2', infot, nout, lerr, ok )
348 CALL
dgbtf2( 0, -1, 0, 0, a, 1, ip, info )
349 CALL
chkxer(
'DGBTF2', infot, nout, lerr, ok )
351 CALL
dgbtf2( 1, 1, -1, 0, a, 1, ip, info )
352 CALL
chkxer(
'DGBTF2', infot, nout, lerr, ok )
354 CALL
dgbtf2( 1, 1, 0, -1, a, 1, ip, info )
355 CALL
chkxer(
'DGBTF2', infot, nout, lerr, ok )
357 CALL
dgbtf2( 2, 2, 1, 1, a, 3, ip, info )
358 CALL
chkxer(
'DGBTF2', infot, nout, lerr, ok )
364 CALL
dgbtrs(
'/', 0, 0, 0, 1, a, 1, ip, b, 1, info )
365 CALL
chkxer(
'DGBTRS', infot, nout, lerr, ok )
367 CALL
dgbtrs(
'N', -1, 0, 0, 1, a, 1, ip, b, 1, info )
368 CALL
chkxer(
'DGBTRS', infot, nout, lerr, ok )
370 CALL
dgbtrs(
'N', 1, -1, 0, 1, a, 1, ip, b, 1, info )
371 CALL
chkxer(
'DGBTRS', infot, nout, lerr, ok )
373 CALL
dgbtrs(
'N', 1, 0, -1, 1, a, 1, ip, b, 1, info )
374 CALL
chkxer(
'DGBTRS', infot, nout, lerr, ok )
376 CALL
dgbtrs(
'N', 1, 0, 0, -1, a, 1, ip, b, 1, info )
377 CALL
chkxer(
'DGBTRS', infot, nout, lerr, ok )
379 CALL
dgbtrs(
'N', 2, 1, 1, 1, a, 3, ip, b, 2, info )
380 CALL
chkxer(
'DGBTRS', infot, nout, lerr, ok )
382 CALL
dgbtrs(
'N', 2, 0, 0, 1, a, 1, ip, b, 1, info )
383 CALL
chkxer(
'DGBTRS', infot, nout, lerr, ok )
389 CALL
dgbrfs(
'/', 0, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
391 CALL
chkxer(
'DGBRFS', infot, nout, lerr, ok )
393 CALL
dgbrfs(
'N', -1, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
395 CALL
chkxer(
'DGBRFS', infot, nout, lerr, ok )
397 CALL
dgbrfs(
'N', 1, -1, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
399 CALL
chkxer(
'DGBRFS', infot, nout, lerr, ok )
401 CALL
dgbrfs(
'N', 1, 0, -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
403 CALL
chkxer(
'DGBRFS', infot, nout, lerr, ok )
405 CALL
dgbrfs(
'N', 1, 0, 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1,
407 CALL
chkxer(
'DGBRFS', infot, nout, lerr, ok )
409 CALL
dgbrfs(
'N', 2, 1, 1, 1, a, 2, af, 4, ip, b, 2, x, 2, r1,
411 CALL
chkxer(
'DGBRFS', infot, nout, lerr, ok )
413 CALL
dgbrfs(
'N', 2, 1, 1, 1, a, 3, af, 3, ip, b, 2, x, 2, r1,
415 CALL
chkxer(
'DGBRFS', infot, nout, lerr, ok )
417 CALL
dgbrfs(
'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 1, x, 2, r1,
419 CALL
chkxer(
'DGBRFS', infot, nout, lerr, ok )
421 CALL
dgbrfs(
'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 2, x, 1, r1,
423 CALL
chkxer(
'DGBRFS', infot, nout, lerr, ok )
431 CALL
dgbrfsx(
'/', eq, 0, 0, 0, 0, a, 1, af, 1, ip, r, c, b, 1,
432 $ x, 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
433 $ nparams, params, w, iw, info )
434 CALL
chkxer(
'DGBRFSX', infot, nout, lerr, ok )
437 CALL
dgbrfsx(
'N', eq, 2, 1, 1, 1, a, 1, af, 2, ip, r, c, b, 2,
438 $ x, 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
439 $ nparams, params, w, iw, info )
440 CALL
chkxer(
'DGBRFSX', infot, nout, lerr, ok )
443 CALL
dgbrfsx(
'N', eq, -1, 1, 1, 0, a, 1, af, 1, ip, r, c, b,
444 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
445 $ nparams, params, w, iw, info )
446 CALL
chkxer(
'DGBRFSX', infot, nout, lerr, ok )
449 CALL
dgbrfsx(
'N', eq, 2, -1, 1, 1, a, 3, af, 4, ip, r, c, b,
450 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
451 $ nparams, params, w, iw, info )
452 CALL
chkxer(
'DGBRFSX', infot, nout, lerr, ok )
455 CALL
dgbrfsx(
'N', eq, 2, 1, -1, 1, a, 3, af, 4, ip, r, c, b,
456 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
457 $ nparams, params, w, iw, info )
458 CALL
chkxer(
'DGBRFSX', infot, nout, lerr, ok )
460 CALL
dgbrfsx(
'N', eq, 0, 0, 0, -1, a, 1, af, 1, ip, r, c, b,
461 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
462 $ nparams, params, w, iw, info )
463 CALL
chkxer(
'DGBRFSX', infot, nout, lerr, ok )
465 CALL
dgbrfsx(
'N', eq, 2, 1, 1, 1, a, 1, af, 2, ip, r, c, b,
466 $ 2, x, 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
467 $ nparams, params, w, iw, info )
468 CALL
chkxer(
'DGBRFSX', infot, nout, lerr, ok )
470 CALL
dgbrfsx(
'N', eq, 2, 1, 1, 1, a, 3, af, 3, ip, r, c, b, 2,
471 $ x, 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
472 $ nparams, params, w, iw, info )
473 CALL
chkxer(
'DGBRFSX', infot, nout, lerr, ok )
476 CALL
dgbrfsx(
'N', eq, 2, 1, 1, 1, a, 3, af, 5, ip, r, c, b,
477 $ 1, x, 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
478 $ nparams, params, w, iw, info )
479 CALL
chkxer(
'DGBRFSX', infot, nout, lerr, ok )
481 CALL
dgbrfsx(
'N', eq, 2, 1, 1, 1, a, 3, af, 5, ip, r, c, b, 2,
482 $ x, 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
483 $ nparams, params, w, iw, info )
484 CALL
chkxer(
'DGBRFSX', infot, nout, lerr, ok )
490 CALL
dgbcon(
'/', 0, 0, 0, a, 1, ip, anrm, rcond, w, iw, info )
491 CALL
chkxer(
'DGBCON', infot, nout, lerr, ok )
493 CALL
dgbcon(
'1', -1, 0, 0, a, 1, ip, anrm, rcond, w, iw,
495 CALL
chkxer(
'DGBCON', infot, nout, lerr, ok )
497 CALL
dgbcon(
'1', 1, -1, 0, a, 1, ip, anrm, rcond, w, iw,
499 CALL
chkxer(
'DGBCON', infot, nout, lerr, ok )
501 CALL
dgbcon(
'1', 1, 0, -1, a, 1, ip, anrm, rcond, w, iw,
503 CALL
chkxer(
'DGBCON', infot, nout, lerr, ok )
505 CALL
dgbcon(
'1', 2, 1, 1, a, 3, ip, anrm, rcond, w, iw, info )
506 CALL
chkxer(
'DGBCON', infot, nout, lerr, ok )
512 CALL
dgbequ( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
514 CALL
chkxer(
'DGBEQU', infot, nout, lerr, ok )
516 CALL
dgbequ( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
518 CALL
chkxer(
'DGBEQU', infot, nout, lerr, ok )
520 CALL
dgbequ( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
522 CALL
chkxer(
'DGBEQU', infot, nout, lerr, ok )
524 CALL
dgbequ( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
526 CALL
chkxer(
'DGBEQU', infot, nout, lerr, ok )
528 CALL
dgbequ( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
530 CALL
chkxer(
'DGBEQU', infot, nout, lerr, ok )
536 CALL
dgbequb( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
538 CALL
chkxer(
'DGBEQUB', infot, nout, lerr, ok )
540 CALL
dgbequb( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
542 CALL
chkxer(
'DGBEQUB', infot, nout, lerr, ok )
544 CALL
dgbequb( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
546 CALL
chkxer(
'DGBEQUB', infot, nout, lerr, ok )
548 CALL
dgbequb( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
550 CALL
chkxer(
'DGBEQUB', infot, nout, lerr, ok )
552 CALL
dgbequb( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
554 CALL
chkxer(
'DGBEQUB', infot, nout, lerr, ok )
559 CALL
alaesm( path, ok, nout )