75 parameter( nmax = 4, lw = 3*nmax )
80 INTEGER i, info,
j, n_err_bnds, nparams
81 REAL anrm, ccond, rcond, berr
84 INTEGER ip( nmax ), iw( nmax )
85 REAL 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. /
REAL( i+
j )
123 af( i,
j ) = 1. /
REAL( i+
j )
137 IF(
lsamen( 2, c2,
'GE' ) )
THEN
146 CALL
sgetrf( -1, 0, a, 1, ip, info )
147 CALL
chkxer(
'SGETRF', infot, nout, lerr, ok )
149 CALL
sgetrf( 0, -1, a, 1, ip, info )
150 CALL
chkxer(
'SGETRF', infot, nout, lerr, ok )
152 CALL
sgetrf( 2, 1, a, 1, ip, info )
153 CALL
chkxer(
'SGETRF', infot, nout, lerr, ok )
159 CALL
sgetf2( -1, 0, a, 1, ip, info )
160 CALL
chkxer(
'SGETF2', infot, nout, lerr, ok )
162 CALL
sgetf2( 0, -1, a, 1, ip, info )
163 CALL
chkxer(
'SGETF2', infot, nout, lerr, ok )
165 CALL
sgetf2( 2, 1, a, 1, ip, info )
166 CALL
chkxer(
'SGETF2', infot, nout, lerr, ok )
172 CALL
sgetri( -1, a, 1, ip, w, lw, info )
173 CALL
chkxer(
'SGETRI', infot, nout, lerr, ok )
175 CALL
sgetri( 2, a, 1, ip, w, lw, info )
176 CALL
chkxer(
'SGETRI', infot, nout, lerr, ok )
182 CALL
sgetrs(
'/', 0, 0, a, 1, ip,
b, 1, info )
183 CALL
chkxer(
'SGETRS', infot, nout, lerr, ok )
185 CALL
sgetrs(
'N', -1, 0, a, 1, ip,
b, 1, info )
186 CALL
chkxer(
'SGETRS', infot, nout, lerr, ok )
188 CALL
sgetrs(
'N', 0, -1, a, 1, ip,
b, 1, info )
189 CALL
chkxer(
'SGETRS', infot, nout, lerr, ok )
191 CALL
sgetrs(
'N', 2, 1, a, 1, ip,
b, 2, info )
192 CALL
chkxer(
'SGETRS', infot, nout, lerr, ok )
194 CALL
sgetrs(
'N', 2, 1, a, 2, ip,
b, 1, info )
195 CALL
chkxer(
'SGETRS', infot, nout, lerr, ok )
201 CALL
sgerfs(
'/', 0, 0, a, 1, af, 1, ip,
b, 1,
x, 1, r1, r2, w,
203 CALL
chkxer(
'SGERFS', infot, nout, lerr, ok )
205 CALL
sgerfs(
'N', -1, 0, a, 1, af, 1, ip,
b, 1,
x, 1, r1, r2,
207 CALL
chkxer(
'SGERFS', infot, nout, lerr, ok )
209 CALL
sgerfs(
'N', 0, -1, a, 1, af, 1, ip,
b, 1,
x, 1, r1, r2,
211 CALL
chkxer(
'SGERFS', infot, nout, lerr, ok )
213 CALL
sgerfs(
'N', 2, 1, a, 1, af, 2, ip,
b, 2,
x, 2, r1, r2, w,
215 CALL
chkxer(
'SGERFS', infot, nout, lerr, ok )
217 CALL
sgerfs(
'N', 2, 1, a, 2, af, 1, ip,
b, 2,
x, 2, r1, r2, w,
219 CALL
chkxer(
'SGERFS', infot, nout, lerr, ok )
221 CALL
sgerfs(
'N', 2, 1, a, 2, af, 2, ip,
b, 1,
x, 2, r1, r2, w,
223 CALL
chkxer(
'SGERFS', infot, nout, lerr, ok )
225 CALL
sgerfs(
'N', 2, 1, a, 2, af, 2, ip,
b, 2,
x, 1, r1, r2, w,
227 CALL
chkxer(
'SGERFS', infot, nout, lerr, ok )
235 CALL
sgerfsx(
'/', 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(
'SGERFSX', infot, nout, lerr, ok )
241 CALL
sgerfsx(
'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(
'SGERFSX', infot, nout, lerr, ok )
247 CALL
sgerfsx(
'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(
'SGERFSX', infot, nout, lerr, ok )
252 CALL
sgerfsx(
'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(
'SGERFSX', infot, nout, lerr, ok )
257 CALL
sgerfsx(
'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(
'SGERFSX', infot, nout, lerr, ok )
262 CALL
sgerfsx(
'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(
'SGERFSX', infot, nout, lerr, ok )
268 CALL
sgerfsx(
'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(
'SGERFSX', infot, nout, lerr, ok )
273 CALL
sgerfsx(
'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(
'SGERFSX', infot, nout, lerr, ok )
282 CALL
sgecon(
'/', 0, a, 1, anrm, rcond, w, iw, info )
283 CALL
chkxer(
'SGECON', infot, nout, lerr, ok )
285 CALL
sgecon(
'1', -1, a, 1, anrm, rcond, w, iw, info )
286 CALL
chkxer(
'SGECON', infot, nout, lerr, ok )
288 CALL
sgecon(
'1', 2, a, 1, anrm, rcond, w, iw, info )
289 CALL
chkxer(
'SGECON', infot, nout, lerr, ok )
295 CALL
sgeequ( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
296 CALL
chkxer(
'SGEEQU', infot, nout, lerr, ok )
298 CALL
sgeequ( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
299 CALL
chkxer(
'SGEEQU', infot, nout, lerr, ok )
301 CALL
sgeequ( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
302 CALL
chkxer(
'SGEEQU', infot, nout, lerr, ok )
308 CALL
sgeequb( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
309 CALL
chkxer(
'SGEEQUB', infot, nout, lerr, ok )
311 CALL
sgeequb( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
312 CALL
chkxer(
'SGEEQUB', infot, nout, lerr, ok )
314 CALL
sgeequb( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
315 CALL
chkxer(
'SGEEQUB', infot, nout, lerr, ok )
317 ELSE IF(
lsamen( 2, c2,
'GB' ) )
THEN
326 CALL
sgbtrf( -1, 0, 0, 0, a, 1, ip, info )
327 CALL
chkxer(
'SGBTRF', infot, nout, lerr, ok )
329 CALL
sgbtrf( 0, -1, 0, 0, a, 1, ip, info )
330 CALL
chkxer(
'SGBTRF', infot, nout, lerr, ok )
332 CALL
sgbtrf( 1, 1, -1, 0, a, 1, ip, info )
333 CALL
chkxer(
'SGBTRF', infot, nout, lerr, ok )
335 CALL
sgbtrf( 1, 1, 0, -1, a, 1, ip, info )
336 CALL
chkxer(
'SGBTRF', infot, nout, lerr, ok )
338 CALL
sgbtrf( 2, 2, 1, 1, a, 3, ip, info )
339 CALL
chkxer(
'SGBTRF', infot, nout, lerr, ok )
345 CALL
sgbtf2( -1, 0, 0, 0, a, 1, ip, info )
346 CALL
chkxer(
'SGBTF2', infot, nout, lerr, ok )
348 CALL
sgbtf2( 0, -1, 0, 0, a, 1, ip, info )
349 CALL
chkxer(
'SGBTF2', infot, nout, lerr, ok )
351 CALL
sgbtf2( 1, 1, -1, 0, a, 1, ip, info )
352 CALL
chkxer(
'SGBTF2', infot, nout, lerr, ok )
354 CALL
sgbtf2( 1, 1, 0, -1, a, 1, ip, info )
355 CALL
chkxer(
'SGBTF2', infot, nout, lerr, ok )
357 CALL
sgbtf2( 2, 2, 1, 1, a, 3, ip, info )
358 CALL
chkxer(
'SGBTF2', infot, nout, lerr, ok )
364 CALL
sgbtrs(
'/', 0, 0, 0, 1, a, 1, ip,
b, 1, info )
365 CALL
chkxer(
'SGBTRS', infot, nout, lerr, ok )
367 CALL
sgbtrs(
'N', -1, 0, 0, 1, a, 1, ip,
b, 1, info )
368 CALL
chkxer(
'SGBTRS', infot, nout, lerr, ok )
370 CALL
sgbtrs(
'N', 1, -1, 0, 1, a, 1, ip,
b, 1, info )
371 CALL
chkxer(
'SGBTRS', infot, nout, lerr, ok )
373 CALL
sgbtrs(
'N', 1, 0, -1, 1, a, 1, ip,
b, 1, info )
374 CALL
chkxer(
'SGBTRS', infot, nout, lerr, ok )
376 CALL
sgbtrs(
'N', 1, 0, 0, -1, a, 1, ip,
b, 1, info )
377 CALL
chkxer(
'SGBTRS', infot, nout, lerr, ok )
379 CALL
sgbtrs(
'N', 2, 1, 1, 1, a, 3, ip,
b, 2, info )
380 CALL
chkxer(
'SGBTRS', infot, nout, lerr, ok )
382 CALL
sgbtrs(
'N', 2, 0, 0, 1, a, 1, ip,
b, 1, info )
383 CALL
chkxer(
'SGBTRS', infot, nout, lerr, ok )
389 CALL
sgbrfs(
'/', 0, 0, 0, 0, a, 1, af, 1, ip,
b, 1,
x, 1, r1,
391 CALL
chkxer(
'SGBRFS', infot, nout, lerr, ok )
393 CALL
sgbrfs(
'N', -1, 0, 0, 0, a, 1, af, 1, ip,
b, 1,
x, 1, r1,
395 CALL
chkxer(
'SGBRFS', infot, nout, lerr, ok )
397 CALL
sgbrfs(
'N', 1, -1, 0, 0, a, 1, af, 1, ip,
b, 1,
x, 1, r1,
399 CALL
chkxer(
'SGBRFS', infot, nout, lerr, ok )
401 CALL
sgbrfs(
'N', 1, 0, -1, 0, a, 1, af, 1, ip,
b, 1,
x, 1, r1,
403 CALL
chkxer(
'SGBRFS', infot, nout, lerr, ok )
405 CALL
sgbrfs(
'N', 1, 0, 0, -1, a, 1, af, 1, ip,
b, 1,
x, 1, r1,
407 CALL
chkxer(
'SGBRFS', infot, nout, lerr, ok )
409 CALL
sgbrfs(
'N', 2, 1, 1, 1, a, 2, af, 4, ip,
b, 2,
x, 2, r1,
411 CALL
chkxer(
'SGBRFS', infot, nout, lerr, ok )
413 CALL
sgbrfs(
'N', 2, 1, 1, 1, a, 3, af, 3, ip,
b, 2,
x, 2, r1,
415 CALL
chkxer(
'SGBRFS', infot, nout, lerr, ok )
417 CALL
sgbrfs(
'N', 2, 0, 0, 1, a, 1, af, 1, ip,
b, 1,
x, 2, r1,
419 CALL
chkxer(
'SGBRFS', infot, nout, lerr, ok )
421 CALL
sgbrfs(
'N', 2, 0, 0, 1, a, 1, af, 1, ip,
b, 2,
x, 1, r1,
423 CALL
chkxer(
'SGBRFS', infot, nout, lerr, ok )
431 CALL
sgbrfsx(
'/', 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(
'SGBRFSX', infot, nout, lerr, ok )
437 CALL
sgbrfsx(
'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(
'SGBRFSX', infot, nout, lerr, ok )
443 CALL
sgbrfsx(
'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(
'SGBRFSX', infot, nout, lerr, ok )
449 CALL
sgbrfsx(
'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(
'SGBRFSX', infot, nout, lerr, ok )
455 CALL
sgbrfsx(
'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(
'SGBRFSX', infot, nout, lerr, ok )
460 CALL
sgbrfsx(
'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(
'SGBRFSX', infot, nout, lerr, ok )
465 CALL
sgbrfsx(
'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(
'SGBRFSX', infot, nout, lerr, ok )
470 CALL
sgbrfsx(
'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(
'SGBRFSX', infot, nout, lerr, ok )
476 CALL
sgbrfsx(
'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(
'SGBRFSX', infot, nout, lerr, ok )
481 CALL
sgbrfsx(
'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(
'SGBRFSX', infot, nout, lerr, ok )
490 CALL
sgbcon(
'/', 0, 0, 0, a, 1, ip, anrm, rcond, w, iw, info )
491 CALL
chkxer(
'SGBCON', infot, nout, lerr, ok )
493 CALL
sgbcon(
'1', -1, 0, 0, a, 1, ip, anrm, rcond, w, iw,
495 CALL
chkxer(
'SGBCON', infot, nout, lerr, ok )
497 CALL
sgbcon(
'1', 1, -1, 0, a, 1, ip, anrm, rcond, w, iw,
499 CALL
chkxer(
'SGBCON', infot, nout, lerr, ok )
501 CALL
sgbcon(
'1', 1, 0, -1, a, 1, ip, anrm, rcond, w, iw,
503 CALL
chkxer(
'SGBCON', infot, nout, lerr, ok )
505 CALL
sgbcon(
'1', 2, 1, 1, a, 3, ip, anrm, rcond, w, iw, info )
506 CALL
chkxer(
'SGBCON', infot, nout, lerr, ok )
512 CALL
sgbequ( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
514 CALL
chkxer(
'SGBEQU', infot, nout, lerr, ok )
516 CALL
sgbequ( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
518 CALL
chkxer(
'SGBEQU', infot, nout, lerr, ok )
520 CALL
sgbequ( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
522 CALL
chkxer(
'SGBEQU', infot, nout, lerr, ok )
524 CALL
sgbequ( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
526 CALL
chkxer(
'SGBEQU', infot, nout, lerr, ok )
528 CALL
sgbequ( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
530 CALL
chkxer(
'SGBEQU', infot, nout, lerr, ok )
536 CALL
sgbequb( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
538 CALL
chkxer(
'SGBEQUB', infot, nout, lerr, ok )
540 CALL
sgbequb( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
542 CALL
chkxer(
'SGBEQUB', infot, nout, lerr, ok )
544 CALL
sgbequb( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
546 CALL
chkxer(
'SGBEQUB', infot, nout, lerr, ok )
548 CALL
sgbequb( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
550 CALL
chkxer(
'SGBEQUB', infot, nout, lerr, ok )
552 CALL
sgbequb( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
554 CALL
chkxer(
'SGBEQUB', infot, nout, lerr, ok )
559 CALL
alaesm( path, ok, nout )
subroutine serrge(PATH, NUNIT)
SERRGE
subroutine sgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SGETRS
subroutine sgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
SGETRI
subroutine sgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
SGBEQU
subroutine sgetrf(M, N, A, LDA, IPIV, INFO)
SGETRF
subroutine sgerfsx(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)
SGERFSX
subroutine sgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
SGBTRF
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine sgbrfsx(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)
SGBRFSX
subroutine sgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SGBCON
subroutine sgbequb(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
SGBEQUB
subroutine sgeequb(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
SGEEQUB
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine sgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
SGECON
LOGICAL function lsamen(N, CA, CB)
LSAMEN
subroutine sgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SGBRFS
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine sgetf2(M, N, A, LDA, IPIV, INFO)
SGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row inter...
subroutine sgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
SGEEQU
subroutine sgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
SGBTRS
subroutine sgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SGERFS
subroutine sgbtf2(M, N, KL, KU, AB, LDAB, IPIV, INFO)
SGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algo...