59 SUBROUTINE serrge( PATH, NUNIT )
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 sgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SGETRS
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine sgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
SGECON
subroutine serrge(PATH, NUNIT)
SERRGE
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 chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine sgetrf(M, N, A, LDA, IPIV, INFO)
SGETRF
subroutine sgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SGBCON
logical function lsamen(N, CA, CB)
LSAMEN
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 sgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
SGBEQU
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 sgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SGERFS
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 sgeequb(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
SGEEQUB
subroutine sgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
SGETRI
subroutine sgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SGBRFS
subroutine sgbequb(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
SGBEQUB
subroutine sgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
SGBTRF
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