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 )