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 )
subroutine dgetf2(M, N, A, LDA, IPIV, INFO)
DGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row inter...
subroutine dgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DGBRFS
subroutine dgetrf(M, N, A, LDA, IPIV, INFO)
DGETRF
logical function lsamen(N, CA, CB)
LSAMEN
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine dgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DGERFS
subroutine dgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
DGETRI
subroutine dgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
DGEEQU
subroutine dgbrfsx(TRANS, EQUED, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, R, C, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, INFO)
DGBRFSX
subroutine dgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DGETRS
subroutine derrge(PATH, NUNIT)
DERRGE
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine dgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
DGBEQU
subroutine dgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
DGBTRF
subroutine dgbtf2(M, N, KL, KU, AB, LDAB, IPIV, INFO)
DGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algo...
subroutine dgbequb(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
DGBEQUB
subroutine dgeequb(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
DGEEQUB
subroutine dgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DGBCON
subroutine dgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
DGECON
subroutine dgerfsx(TRANS, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, R, C, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, INFO)
DGERFSX
subroutine dgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
DGBTRS