72 parameter( nmax = 4, lw = 3*nmax )
77 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
78 REAL ANRM, CCOND, RCOND, BERR
81 INTEGER IP( NMAX ), IW( NMAX )
82 REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
83 $ C( NMAX ), R( NMAX ), R1( NMAX ), R2( NMAX ),
84 $ W( LW ), X( NMAX ), ERR_BNDS_N( NMAX, 3 ),
85 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
103 COMMON / infoc / infot, nout, ok, lerr
104 COMMON / srnamc / srnamt
112 WRITE( nout, fmt = * )
119 a( i, j ) = 1. / real( i+j )
120 af( i, j ) = 1. / real( i+j )
134 IF( lsamen( 2, c2,
'GE' ) )
THEN
143 CALL sgetrf( -1, 0, a, 1, ip, info )
144 CALL chkxer(
'SGETRF', infot, nout, lerr, ok )
146 CALL sgetrf( 0, -1, a, 1, ip, info )
147 CALL chkxer(
'SGETRF', infot, nout, lerr, ok )
149 CALL sgetrf( 2, 1, a, 1, ip, info )
150 CALL chkxer(
'SGETRF', infot, nout, lerr, ok )
156 CALL sgetf2( -1, 0, a, 1, ip, info )
157 CALL chkxer(
'SGETF2', infot, nout, lerr, ok )
159 CALL sgetf2( 0, -1, a, 1, ip, info )
160 CALL chkxer(
'SGETF2', infot, nout, lerr, ok )
162 CALL sgetf2( 2, 1, a, 1, ip, info )
163 CALL chkxer(
'SGETF2', infot, nout, lerr, ok )
169 CALL sgetri( -1, a, 1, ip, w, lw, info )
170 CALL chkxer(
'SGETRI', infot, nout, lerr, ok )
172 CALL sgetri( 2, a, 1, ip, w, lw, info )
173 CALL chkxer(
'SGETRI', infot, nout, lerr, ok )
179 CALL sgetrs(
'/', 0, 0, a, 1, ip, b, 1, info )
180 CALL chkxer(
'SGETRS', infot, nout, lerr, ok )
182 CALL sgetrs(
'N', -1, 0, a, 1, ip, b, 1, info )
183 CALL chkxer(
'SGETRS', infot, nout, lerr, ok )
185 CALL sgetrs(
'N', 0, -1, a, 1, ip, b, 1, info )
186 CALL chkxer(
'SGETRS', infot, nout, lerr, ok )
188 CALL sgetrs(
'N', 2, 1, a, 1, ip, b, 2, info )
189 CALL chkxer(
'SGETRS', infot, nout, lerr, ok )
191 CALL sgetrs(
'N', 2, 1, a, 2, ip, b, 1, info )
192 CALL chkxer(
'SGETRS', infot, nout, lerr, ok )
198 CALL sgerfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
200 CALL chkxer(
'SGERFS', infot, nout, lerr, ok )
202 CALL sgerfs(
'N', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
204 CALL chkxer(
'SGERFS', infot, nout, lerr, ok )
206 CALL sgerfs(
'N', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
208 CALL chkxer(
'SGERFS', infot, nout, lerr, ok )
210 CALL sgerfs(
'N', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
212 CALL chkxer(
'SGERFS', infot, nout, lerr, ok )
214 CALL sgerfs(
'N', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
216 CALL chkxer(
'SGERFS', infot, nout, lerr, ok )
218 CALL sgerfs(
'N', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
220 CALL chkxer(
'SGERFS', infot, nout, lerr, ok )
222 CALL sgerfs(
'N', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
224 CALL chkxer(
'SGERFS', infot, nout, lerr, ok )
232 CALL sgerfsx(
'/', eq, 0, 0, a, 1, af, 1, ip, r, c, b, 1, x,
233 $ 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
234 $ nparams, params, w, iw, info )
235 CALL chkxer(
'SGERFSX', infot, nout, lerr, ok )
238 CALL sgerfsx(
'N', eq, 2, 1, a, 1, af, 2, ip, r, c, b, 2, x,
239 $ 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
240 $ nparams, params, w, iw, info )
241 CALL chkxer(
'SGERFSX', infot, nout, lerr, ok )
244 CALL sgerfsx(
'N', eq, -1, 0, a, 1, af, 1, ip, r, c, b, 1, x,
245 $ 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
246 $ nparams, params, w, iw, info )
247 CALL chkxer(
'SGERFSX', infot, nout, lerr, ok )
249 CALL sgerfsx(
'N', eq, 0, -1, a, 1, af, 1, ip, r, c, b, 1, x,
250 $ 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
251 $ nparams, params, w, iw, info )
252 CALL chkxer(
'SGERFSX', infot, nout, lerr, ok )
254 CALL sgerfsx(
'N', eq, 2, 1, a, 1, af, 2, ip, r, c, b, 2, x,
255 $ 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
256 $ nparams, params, w, iw, info )
257 CALL chkxer(
'SGERFSX', infot, nout, lerr, ok )
259 CALL sgerfsx(
'N', eq, 2, 1, a, 2, af, 1, ip, r, c, b, 2, x,
260 $ 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
261 $ nparams, params, w, iw, info )
262 CALL chkxer(
'SGERFSX', infot, nout, lerr, ok )
265 CALL sgerfsx(
'N', eq, 2, 1, a, 2, af, 2, ip, r, c, b, 1, x,
266 $ 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
267 $ nparams, params, w, iw, info )
268 CALL chkxer(
'SGERFSX', infot, nout, lerr, ok )
270 CALL sgerfsx(
'N', eq, 2, 1, a, 2, af, 2, ip, r, c, b, 2, x,
271 $ 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
272 $ nparams, params, w, iw, info )
273 CALL chkxer(
'SGERFSX', infot, nout, lerr, ok )
279 CALL sgecon(
'/', 0, a, 1, anrm, rcond, w, iw, info )
280 CALL chkxer(
'SGECON', infot, nout, lerr, ok )
282 CALL sgecon(
'1', -1, a, 1, anrm, rcond, w, iw, info )
283 CALL chkxer(
'SGECON', infot, nout, lerr, ok )
285 CALL sgecon(
'1', 2, a, 1, anrm, rcond, w, iw, info )
286 CALL chkxer(
'SGECON', infot, nout, lerr, ok )
292 CALL sgeequ( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
293 CALL chkxer(
'SGEEQU', infot, nout, lerr, ok )
295 CALL sgeequ( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
296 CALL chkxer(
'SGEEQU', infot, nout, lerr, ok )
298 CALL sgeequ( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
299 CALL chkxer(
'SGEEQU', infot, nout, lerr, ok )
305 CALL sgeequb( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
306 CALL chkxer(
'SGEEQUB', infot, nout, lerr, ok )
308 CALL sgeequb( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
309 CALL chkxer(
'SGEEQUB', infot, nout, lerr, ok )
311 CALL sgeequb( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
312 CALL chkxer(
'SGEEQUB', infot, nout, lerr, ok )
314 ELSE IF( lsamen( 2, c2,
'GB' ) )
THEN
323 CALL sgbtrf( -1, 0, 0, 0, a, 1, ip, info )
324 CALL chkxer(
'SGBTRF', infot, nout, lerr, ok )
326 CALL sgbtrf( 0, -1, 0, 0, a, 1, ip, info )
327 CALL chkxer(
'SGBTRF', infot, nout, lerr, ok )
329 CALL sgbtrf( 1, 1, -1, 0, a, 1, ip, info )
330 CALL chkxer(
'SGBTRF', infot, nout, lerr, ok )
332 CALL sgbtrf( 1, 1, 0, -1, a, 1, ip, info )
333 CALL chkxer(
'SGBTRF', infot, nout, lerr, ok )
335 CALL sgbtrf( 2, 2, 1, 1, a, 3, ip, info )
336 CALL chkxer(
'SGBTRF', infot, nout, lerr, ok )
342 CALL sgbtf2( -1, 0, 0, 0, a, 1, ip, info )
343 CALL chkxer(
'SGBTF2', infot, nout, lerr, ok )
345 CALL sgbtf2( 0, -1, 0, 0, a, 1, ip, info )
346 CALL chkxer(
'SGBTF2', infot, nout, lerr, ok )
348 CALL sgbtf2( 1, 1, -1, 0, a, 1, ip, info )
349 CALL chkxer(
'SGBTF2', infot, nout, lerr, ok )
351 CALL sgbtf2( 1, 1, 0, -1, a, 1, ip, info )
352 CALL chkxer(
'SGBTF2', infot, nout, lerr, ok )
354 CALL sgbtf2( 2, 2, 1, 1, a, 3, ip, info )
355 CALL chkxer(
'SGBTF2', infot, nout, lerr, ok )
361 CALL sgbtrs(
'/', 0, 0, 0, 1, a, 1, ip, b, 1, info )
362 CALL chkxer(
'SGBTRS', infot, nout, lerr, ok )
364 CALL sgbtrs(
'N', -1, 0, 0, 1, a, 1, ip, b, 1, info )
365 CALL chkxer(
'SGBTRS', infot, nout, lerr, ok )
367 CALL sgbtrs(
'N', 1, -1, 0, 1, a, 1, ip, b, 1, info )
368 CALL chkxer(
'SGBTRS', infot, nout, lerr, ok )
370 CALL sgbtrs(
'N', 1, 0, -1, 1, a, 1, ip, b, 1, info )
371 CALL chkxer(
'SGBTRS', infot, nout, lerr, ok )
373 CALL sgbtrs(
'N', 1, 0, 0, -1, a, 1, ip, b, 1, info )
374 CALL chkxer(
'SGBTRS', infot, nout, lerr, ok )
376 CALL sgbtrs(
'N', 2, 1, 1, 1, a, 3, ip, b, 2, info )
377 CALL chkxer(
'SGBTRS', infot, nout, lerr, ok )
379 CALL sgbtrs(
'N', 2, 0, 0, 1, a, 1, ip, b, 1, info )
380 CALL chkxer(
'SGBTRS', infot, nout, lerr, ok )
386 CALL sgbrfs(
'/', 0, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
388 CALL chkxer(
'SGBRFS', infot, nout, lerr, ok )
390 CALL sgbrfs(
'N', -1, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
392 CALL chkxer(
'SGBRFS', infot, nout, lerr, ok )
394 CALL sgbrfs(
'N', 1, -1, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
396 CALL chkxer(
'SGBRFS', infot, nout, lerr, ok )
398 CALL sgbrfs(
'N', 1, 0, -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
400 CALL chkxer(
'SGBRFS', infot, nout, lerr, ok )
402 CALL sgbrfs(
'N', 1, 0, 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1,
404 CALL chkxer(
'SGBRFS', infot, nout, lerr, ok )
406 CALL sgbrfs(
'N', 2, 1, 1, 1, a, 2, af, 4, ip, b, 2, x, 2, r1,
408 CALL chkxer(
'SGBRFS', infot, nout, lerr, ok )
410 CALL sgbrfs(
'N', 2, 1, 1, 1, a, 3, af, 3, ip, b, 2, x, 2, r1,
412 CALL chkxer(
'SGBRFS', infot, nout, lerr, ok )
414 CALL sgbrfs(
'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 1, x, 2, r1,
416 CALL chkxer(
'SGBRFS', infot, nout, lerr, ok )
418 CALL sgbrfs(
'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 2, x, 1, r1,
420 CALL chkxer(
'SGBRFS', infot, nout, lerr, ok )
428 CALL sgbrfsx(
'/', eq, 0, 0, 0, 0, a, 1, af, 1, ip, r, c, b, 1,
429 $ x, 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
430 $ nparams, params, w, iw, info )
431 CALL chkxer(
'SGBRFSX', infot, nout, lerr, ok )
434 CALL sgbrfsx(
'N', eq, 2, 1, 1, 1, a, 1, af, 2, ip, r, c, b, 2,
435 $ x, 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
436 $ nparams, params, w, iw, info )
437 CALL chkxer(
'SGBRFSX', infot, nout, lerr, ok )
440 CALL sgbrfsx(
'N', eq, -1, 1, 1, 0, a, 1, af, 1, ip, r, c, b,
441 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
442 $ nparams, params, w, iw, info )
443 CALL chkxer(
'SGBRFSX', infot, nout, lerr, ok )
446 CALL sgbrfsx(
'N', eq, 2, -1, 1, 1, a, 3, af, 4, ip, r, c, b,
447 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
448 $ nparams, params, w, iw, info )
449 CALL chkxer(
'SGBRFSX', infot, nout, lerr, ok )
452 CALL sgbrfsx(
'N', eq, 2, 1, -1, 1, a, 3, af, 4, ip, r, c, b,
453 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
454 $ nparams, params, w, iw, info )
455 CALL chkxer(
'SGBRFSX', infot, nout, lerr, ok )
457 CALL sgbrfsx(
'N', eq, 0, 0, 0, -1, a, 1, af, 1, ip, r, c, b,
458 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
459 $ nparams, params, w, iw, info )
460 CALL chkxer(
'SGBRFSX', infot, nout, lerr, ok )
462 CALL sgbrfsx(
'N', eq, 2, 1, 1, 1, a, 1, af, 2, ip, r, c, b,
463 $ 2, x, 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
464 $ nparams, params, w, iw, info )
465 CALL chkxer(
'SGBRFSX', infot, nout, lerr, ok )
467 CALL sgbrfsx(
'N', eq, 2, 1, 1, 1, a, 3, af, 3, ip, r, c, b, 2,
468 $ x, 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
469 $ nparams, params, w, iw, info )
470 CALL chkxer(
'SGBRFSX', infot, nout, lerr, ok )
473 CALL sgbrfsx(
'N', eq, 2, 1, 1, 1, a, 3, af, 5, ip, r, c, b,
474 $ 1, x, 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
475 $ nparams, params, w, iw, info )
476 CALL chkxer(
'SGBRFSX', infot, nout, lerr, ok )
478 CALL sgbrfsx(
'N', eq, 2, 1, 1, 1, a, 3, af, 5, ip, r, c, b, 2,
479 $ x, 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
480 $ nparams, params, w, iw, info )
481 CALL chkxer(
'SGBRFSX', infot, nout, lerr, ok )
487 CALL sgbcon(
'/', 0, 0, 0, a, 1, ip, anrm, rcond, w, iw, info )
488 CALL chkxer(
'SGBCON', infot, nout, lerr, ok )
490 CALL sgbcon(
'1', -1, 0, 0, a, 1, ip, anrm, rcond, w, iw,
492 CALL chkxer(
'SGBCON', infot, nout, lerr, ok )
494 CALL sgbcon(
'1', 1, -1, 0, a, 1, ip, anrm, rcond, w, iw,
496 CALL chkxer(
'SGBCON', infot, nout, lerr, ok )
498 CALL sgbcon(
'1', 1, 0, -1, a, 1, ip, anrm, rcond, w, iw,
500 CALL chkxer(
'SGBCON', infot, nout, lerr, ok )
502 CALL sgbcon(
'1', 2, 1, 1, a, 3, ip, anrm, rcond, w, iw, info )
503 CALL chkxer(
'SGBCON', infot, nout, lerr, ok )
509 CALL sgbequ( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
511 CALL chkxer(
'SGBEQU', infot, nout, lerr, ok )
513 CALL sgbequ( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
515 CALL chkxer(
'SGBEQU', infot, nout, lerr, ok )
517 CALL sgbequ( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
519 CALL chkxer(
'SGBEQU', infot, nout, lerr, ok )
521 CALL sgbequ( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
523 CALL chkxer(
'SGBEQU', infot, nout, lerr, ok )
525 CALL sgbequ( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
527 CALL chkxer(
'SGBEQU', infot, nout, lerr, ok )
533 CALL sgbequb( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
535 CALL chkxer(
'SGBEQUB', infot, nout, lerr, ok )
537 CALL sgbequb( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
539 CALL chkxer(
'SGBEQUB', infot, nout, lerr, ok )
541 CALL sgbequb( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
543 CALL chkxer(
'SGBEQUB', infot, nout, lerr, ok )
545 CALL sgbequb( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
547 CALL chkxer(
'SGBEQUB', infot, nout, lerr, ok )
549 CALL sgbequb( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
551 CALL chkxer(
'SGBEQUB', infot, nout, lerr, ok )
556 CALL alaesm( path, ok, nout )
subroutine alaesm(path, ok, nout)
ALAESM
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine sgbcon(norm, n, kl, ku, ab, ldab, ipiv, anorm, rcond, work, iwork, info)
SGBCON
subroutine sgbequ(m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax, info)
SGBEQU
subroutine sgbequb(m, n, kl, ku, ab, ldab, r, c, rowcnd, colcnd, amax, info)
SGBEQUB
subroutine sgbrfs(trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
SGBRFS
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 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...
subroutine sgbtrf(m, n, kl, ku, ab, ldab, ipiv, info)
SGBTRF
subroutine sgbtrs(trans, n, kl, ku, nrhs, ab, ldab, ipiv, b, ldb, info)
SGBTRS
subroutine sgecon(norm, n, a, lda, anorm, rcond, work, iwork, info)
SGECON
subroutine sgeequ(m, n, a, lda, r, c, rowcnd, colcnd, amax, info)
SGEEQU
subroutine sgeequb(m, n, a, lda, r, c, rowcnd, colcnd, amax, info)
SGEEQUB
subroutine sgerfs(trans, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, iwork, info)
SGERFS
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 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 sgetrf(m, n, a, lda, ipiv, info)
SGETRF
subroutine sgetri(n, a, lda, ipiv, work, lwork, info)
SGETRI
subroutine sgetrs(trans, n, nrhs, a, lda, ipiv, b, ldb, info)
SGETRS
subroutine serrge(path, nunit)
SERRGE