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 dgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
DGETRI
subroutine dgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
DGECON
subroutine dgeequb(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
DGEEQUB
subroutine dgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DGERFS
subroutine dgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DGETRS
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine dgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
DGEEQU
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine dgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
DGBTRF
subroutine dgbequb(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
DGBEQUB
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 dgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
DGBTRS
subroutine dgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
DGBEQU
subroutine dgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DGBCON
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...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
LOGICAL function lsamen(N, CA, CB)
LSAMEN
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine derrge(PATH, NUNIT)
DERRGE
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 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 dgetrf(M, N, A, LDA, IPIV, INFO)
DGETRF
subroutine dgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DGBRFS