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 )