77 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
78 REAL ANRM, CCOND, RCOND, BERR
82 REAL R( NMAX ), R1( NMAX ), R2( NMAX ), CS( NMAX ),
84 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
85 $ W( 2*NMAX ), X( NMAX ), ERR_BNDS_N( NMAX, 3 ),
86 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
104 COMMON / infoc / infot, nout, ok, lerr
105 COMMON / srnamc / srnamt
108 INTRINSIC cmplx, real
113 WRITE( nout, fmt = * )
120 a( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
121 af( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
137 IF( lsamen( 2, c2,
'GE' ) )
THEN
143 CALL cgetrf( -1, 0, a, 1, ip, info )
144 CALL chkxer(
'CGETRF', infot, nout, lerr, ok )
146 CALL cgetrf( 0, -1, a, 1, ip, info )
147 CALL chkxer(
'CGETRF', infot, nout, lerr, ok )
149 CALL cgetrf( 2, 1, a, 1, ip, info )
150 CALL chkxer(
'CGETRF', infot, nout, lerr, ok )
156 CALL cgetf2( -1, 0, a, 1, ip, info )
157 CALL chkxer(
'CGETF2', infot, nout, lerr, ok )
159 CALL cgetf2( 0, -1, a, 1, ip, info )
160 CALL chkxer(
'CGETF2', infot, nout, lerr, ok )
162 CALL cgetf2( 2, 1, a, 1, ip, info )
163 CALL chkxer(
'CGETF2', infot, nout, lerr, ok )
169 CALL cgetri( -1, a, 1, ip, w, 1, info )
170 CALL chkxer(
'CGETRI', infot, nout, lerr, ok )
172 CALL cgetri( 2, a, 1, ip, w, 2, info )
173 CALL chkxer(
'CGETRI', infot, nout, lerr, ok )
175 CALL cgetri( 2, a, 2, ip, w, 1, info )
176 CALL chkxer(
'CGETRI', infot, nout, lerr, ok )
182 CALL cgetrs(
'/', 0, 0, a, 1, ip, b, 1, info )
183 CALL chkxer(
'CGETRS', infot, nout, lerr, ok )
185 CALL cgetrs(
'N', -1, 0, a, 1, ip, b, 1, info )
186 CALL chkxer(
'CGETRS', infot, nout, lerr, ok )
188 CALL cgetrs(
'N', 0, -1, a, 1, ip, b, 1, info )
189 CALL chkxer(
'CGETRS', infot, nout, lerr, ok )
191 CALL cgetrs(
'N', 2, 1, a, 1, ip, b, 2, info )
192 CALL chkxer(
'CGETRS', infot, nout, lerr, ok )
194 CALL cgetrs(
'N', 2, 1, a, 2, ip, b, 1, info )
195 CALL chkxer(
'CGETRS', infot, nout, lerr, ok )
201 CALL cgerfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
203 CALL chkxer(
'CGERFS', infot, nout, lerr, ok )
205 CALL cgerfs(
'N', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
207 CALL chkxer(
'CGERFS', infot, nout, lerr, ok )
209 CALL cgerfs(
'N', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
211 CALL chkxer(
'CGERFS', infot, nout, lerr, ok )
213 CALL cgerfs(
'N', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
215 CALL chkxer(
'CGERFS', infot, nout, lerr, ok )
217 CALL cgerfs(
'N', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
219 CALL chkxer(
'CGERFS', infot, nout, lerr, ok )
221 CALL cgerfs(
'N', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
223 CALL chkxer(
'CGERFS', infot, nout, lerr, ok )
225 CALL cgerfs(
'N', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
227 CALL chkxer(
'CGERFS', infot, nout, lerr, ok )
235 CALL cgerfsx(
'/', eq, 0, 0, a, 1, af, 1, ip, rs, cs, b, 1, x,
236 $ 1, rcond, berr, n_err_bnds, err_bnds_n,
237 $ err_bnds_c, nparams, params, w, r, info )
238 CALL chkxer(
'CGERFSX', infot, nout, lerr, ok )
241 CALL cgerfsx(
'N', eq, 2, 1, a, 1, af, 2, ip, rs, cs, b, 2, x,
242 $ 2, rcond, berr, n_err_bnds, err_bnds_n,
243 $ err_bnds_c, nparams, params, w, r, info )
244 CALL chkxer(
'CGERFSX', infot, nout, lerr, ok )
247 CALL cgerfsx(
'N', eq, -1, 0, a, 1, af, 1, ip, rs, cs, b, 1, x,
248 $ 1, rcond, berr, n_err_bnds, err_bnds_n,
249 $ err_bnds_c, nparams, params, w, r, info )
250 CALL chkxer(
'CGERFSX', infot, nout, lerr, ok )
252 CALL cgerfsx(
'N', eq, 0, -1, a, 1, af, 1, ip, rs, cs, b, 1, x,
253 $ 1, rcond, berr, n_err_bnds, err_bnds_n,
254 $ err_bnds_c, nparams, params, w, r, info )
255 CALL chkxer(
'CGERFSX', infot, nout, lerr, ok )
257 CALL cgerfsx(
'N', eq, 2, 1, a, 1, af, 2, ip, rs, cs, b, 2, x,
258 $ 2, rcond, berr, n_err_bnds, err_bnds_n,
259 $ err_bnds_c, nparams, params, w, r, info )
260 CALL chkxer(
'CGERFSX', infot, nout, lerr, ok )
262 CALL cgerfsx(
'N', eq, 2, 1, a, 2, af, 1, ip, rs, cs, b, 2, x,
263 $ 2, rcond, berr, n_err_bnds, err_bnds_n,
264 $ err_bnds_c, nparams, params, w, r, info )
265 CALL chkxer(
'CGERFSX', infot, nout, lerr, ok )
268 CALL cgerfsx(
'N', eq, 2, 1, a, 2, af, 2, ip, rs, cs, b, 1, x,
269 $ 2, rcond, berr, n_err_bnds, err_bnds_n,
270 $ err_bnds_c, nparams, params, w, r, info )
271 CALL chkxer(
'CGERFSX', infot, nout, lerr, ok )
273 CALL cgerfsx(
'N', eq, 2, 1, a, 2, af, 2, ip, rs, cs, b, 2, x,
274 $ 1, rcond, berr, n_err_bnds, err_bnds_n,
275 $ err_bnds_c, nparams, params, w, r, info )
276 CALL chkxer(
'CGERFSX', infot, nout, lerr, ok )
282 CALL cgecon(
'/', 0, a, 1, anrm, rcond, w, r, info )
283 CALL chkxer(
'CGECON', infot, nout, lerr, ok )
285 CALL cgecon(
'1', -1, a, 1, anrm, rcond, w, r, info )
286 CALL chkxer(
'CGECON', infot, nout, lerr, ok )
288 CALL cgecon(
'1', 2, a, 1, anrm, rcond, w, r, info )
289 CALL chkxer(
'CGECON', infot, nout, lerr, ok )
295 CALL cgeequ( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
296 CALL chkxer(
'CGEEQU', infot, nout, lerr, ok )
298 CALL cgeequ( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
299 CALL chkxer(
'CGEEQU', infot, nout, lerr, ok )
301 CALL cgeequ( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
302 CALL chkxer(
'CGEEQU', infot, nout, lerr, ok )
308 CALL cgeequb( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
309 CALL chkxer(
'CGEEQUB', infot, nout, lerr, ok )
311 CALL cgeequb( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
312 CALL chkxer(
'CGEEQUB', infot, nout, lerr, ok )
314 CALL cgeequb( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
315 CALL chkxer(
'CGEEQUB', infot, nout, lerr, ok )
320 ELSE IF( lsamen( 2, c2,
'GB' ) )
THEN
326 CALL cgbtrf( -1, 0, 0, 0, a, 1, ip, info )
327 CALL chkxer(
'CGBTRF', infot, nout, lerr, ok )
329 CALL cgbtrf( 0, -1, 0, 0, a, 1, ip, info )
330 CALL chkxer(
'CGBTRF', infot, nout, lerr, ok )
332 CALL cgbtrf( 1, 1, -1, 0, a, 1, ip, info )
333 CALL chkxer(
'CGBTRF', infot, nout, lerr, ok )
335 CALL cgbtrf( 1, 1, 0, -1, a, 1, ip, info )
336 CALL chkxer(
'CGBTRF', infot, nout, lerr, ok )
338 CALL cgbtrf( 2, 2, 1, 1, a, 3, ip, info )
339 CALL chkxer(
'CGBTRF', infot, nout, lerr, ok )
345 CALL cgbtf2( -1, 0, 0, 0, a, 1, ip, info )
346 CALL chkxer(
'CGBTF2', infot, nout, lerr, ok )
348 CALL cgbtf2( 0, -1, 0, 0, a, 1, ip, info )
349 CALL chkxer(
'CGBTF2', infot, nout, lerr, ok )
351 CALL cgbtf2( 1, 1, -1, 0, a, 1, ip, info )
352 CALL chkxer(
'CGBTF2', infot, nout, lerr, ok )
354 CALL cgbtf2( 1, 1, 0, -1, a, 1, ip, info )
355 CALL chkxer(
'CGBTF2', infot, nout, lerr, ok )
357 CALL cgbtf2( 2, 2, 1, 1, a, 3, ip, info )
358 CALL chkxer(
'CGBTF2', infot, nout, lerr, ok )
364 CALL cgbtrs(
'/', 0, 0, 0, 1, a, 1, ip, b, 1, info )
365 CALL chkxer(
'CGBTRS', infot, nout, lerr, ok )
367 CALL cgbtrs(
'N', -1, 0, 0, 1, a, 1, ip, b, 1, info )
368 CALL chkxer(
'CGBTRS', infot, nout, lerr, ok )
370 CALL cgbtrs(
'N', 1, -1, 0, 1, a, 1, ip, b, 1, info )
371 CALL chkxer(
'CGBTRS', infot, nout, lerr, ok )
373 CALL cgbtrs(
'N', 1, 0, -1, 1, a, 1, ip, b, 1, info )
374 CALL chkxer(
'CGBTRS', infot, nout, lerr, ok )
376 CALL cgbtrs(
'N', 1, 0, 0, -1, a, 1, ip, b, 1, info )
377 CALL chkxer(
'CGBTRS', infot, nout, lerr, ok )
379 CALL cgbtrs(
'N', 2, 1, 1, 1, a, 3, ip, b, 2, info )
380 CALL chkxer(
'CGBTRS', infot, nout, lerr, ok )
382 CALL cgbtrs(
'N', 2, 0, 0, 1, a, 1, ip, b, 1, info )
383 CALL chkxer(
'CGBTRS', infot, nout, lerr, ok )
389 CALL cgbrfs(
'/', 0, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
391 CALL chkxer(
'CGBRFS', infot, nout, lerr, ok )
393 CALL cgbrfs(
'N', -1, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
395 CALL chkxer(
'CGBRFS', infot, nout, lerr, ok )
397 CALL cgbrfs(
'N', 1, -1, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
399 CALL chkxer(
'CGBRFS', infot, nout, lerr, ok )
401 CALL cgbrfs(
'N', 1, 0, -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
403 CALL chkxer(
'CGBRFS', infot, nout, lerr, ok )
405 CALL cgbrfs(
'N', 1, 0, 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1,
407 CALL chkxer(
'CGBRFS', infot, nout, lerr, ok )
409 CALL cgbrfs(
'N', 2, 1, 1, 1, a, 2, af, 4, ip, b, 2, x, 2, r1,
411 CALL chkxer(
'CGBRFS', infot, nout, lerr, ok )
413 CALL cgbrfs(
'N', 2, 1, 1, 1, a, 3, af, 3, ip, b, 2, x, 2, r1,
415 CALL chkxer(
'CGBRFS', infot, nout, lerr, ok )
417 CALL cgbrfs(
'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 1, x, 2, r1,
419 CALL chkxer(
'CGBRFS', infot, nout, lerr, ok )
421 CALL cgbrfs(
'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 2, x, 1, r1,
423 CALL chkxer(
'CGBRFS', infot, nout, lerr, ok )
431 CALL cgbrfsx(
'/', eq, 0, 0, 0, 0, a, 1, af, 1, ip, rs, cs, b,
432 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n,
433 $ err_bnds_c, nparams, params, w, r, info )
434 CALL chkxer(
'CGBRFSX', infot, nout, lerr, ok )
437 CALL cgbrfsx(
'N', eq, 2, 1, 1, 1, a, 1, af, 2, ip, rs, cs, b,
438 $ 2, x, 2, rcond, berr, n_err_bnds, err_bnds_n,
439 $ err_bnds_c, nparams, params, w, r, info )
440 CALL chkxer(
'CGBRFSX', infot, nout, lerr, ok )
443 CALL cgbrfsx(
'N', eq, -1, 1, 1, 0, a, 1, af, 1, ip, rs, cs, b,
444 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n,
445 $ err_bnds_c, nparams, params, w, r, info )
446 CALL chkxer(
'CGBRFSX', infot, nout, lerr, ok )
449 CALL cgbrfsx(
'N', eq, 2, -1, 1, 1, a, 3, af, 4, ip, rs, cs, b,
450 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n,
451 $ err_bnds_c, nparams, params, w, r, info )
452 CALL chkxer(
'CGBRFSX', infot, nout, lerr, ok )
455 CALL cgbrfsx(
'N', eq, 2, 1, -1, 1, a, 3, af, 4, ip, rs, cs, b,
456 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n,
457 $ err_bnds_c, nparams, params, w, r, info )
458 CALL chkxer(
'CGBRFSX', infot, nout, lerr, ok )
460 CALL cgbrfsx(
'N', eq, 0, 0, 0, -1, a, 1, af, 1, ip, rs, cs, b,
461 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n,
462 $ err_bnds_c, nparams, params, w, r, info )
463 CALL chkxer(
'CGBRFSX', infot, nout, lerr, ok )
465 CALL cgbrfsx(
'N', eq, 2, 1, 1, 1, a, 1, af, 2, ip, rs, cs, b,
466 $ 2, x, 2, rcond, berr, n_err_bnds, err_bnds_n,
467 $ err_bnds_c, nparams, params, w, r, info )
468 CALL chkxer(
'CGBRFSX', infot, nout, lerr, ok )
470 CALL cgbrfsx(
'N', eq, 2, 1, 1, 1, a, 3, af, 3, ip, rs, cs, b,
471 $ 2, x, 2, rcond, berr, n_err_bnds, err_bnds_n,
472 $ err_bnds_c, nparams, params, w, r, info )
473 CALL chkxer(
'CGBRFSX', infot, nout, lerr, ok )
476 CALL cgbrfsx(
'N', eq, 2, 1, 1, 1, a, 3, af, 5, ip, rs, cs, b,
477 $ 1, x, 2, rcond, berr, n_err_bnds, err_bnds_n,
478 $ err_bnds_c, nparams, params, w, r, info )
479 CALL chkxer(
'CGBRFSX', infot, nout, lerr, ok )
481 CALL cgbrfsx(
'N', eq, 2, 1, 1, 1, a, 3, af, 5, ip, rs, cs, b,
482 $ 2, x, 1, rcond, berr, n_err_bnds, err_bnds_n,
483 $ err_bnds_c, nparams, params, w, r, info )
484 CALL chkxer(
'CGBRFSX', infot, nout, lerr, ok )
490 CALL cgbcon(
'/', 0, 0, 0, a, 1, ip, anrm, rcond, w, r, info )
491 CALL chkxer(
'CGBCON', infot, nout, lerr, ok )
493 CALL cgbcon(
'1', -1, 0, 0, a, 1, ip, anrm, rcond, w, r, info )
494 CALL chkxer(
'CGBCON', infot, nout, lerr, ok )
496 CALL cgbcon(
'1', 1, -1, 0, a, 1, ip, anrm, rcond, w, r, info )
497 CALL chkxer(
'CGBCON', infot, nout, lerr, ok )
499 CALL cgbcon(
'1', 1, 0, -1, a, 1, ip, anrm, rcond, w, r, info )
500 CALL chkxer(
'CGBCON', infot, nout, lerr, ok )
502 CALL cgbcon(
'1', 2, 1, 1, a, 3, ip, anrm, rcond, w, r, info )
503 CALL chkxer(
'CGBCON', infot, nout, lerr, ok )
509 CALL cgbequ( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
511 CALL chkxer(
'CGBEQU', infot, nout, lerr, ok )
513 CALL cgbequ( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
515 CALL chkxer(
'CGBEQU', infot, nout, lerr, ok )
517 CALL cgbequ( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
519 CALL chkxer(
'CGBEQU', infot, nout, lerr, ok )
521 CALL cgbequ( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
523 CALL chkxer(
'CGBEQU', infot, nout, lerr, ok )
525 CALL cgbequ( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
527 CALL chkxer(
'CGBEQU', infot, nout, lerr, ok )
533 CALL cgbequb( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
535 CALL chkxer(
'CGBEQUB', infot, nout, lerr, ok )
537 CALL cgbequb( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
539 CALL chkxer(
'CGBEQUB', infot, nout, lerr, ok )
541 CALL cgbequb( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
543 CALL chkxer(
'CGBEQUB', infot, nout, lerr, ok )
545 CALL cgbequb( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
547 CALL chkxer(
'CGBEQUB', infot, nout, lerr, ok )
549 CALL cgbequb( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
551 CALL chkxer(
'CGBEQUB', infot, nout, lerr, ok )
556 CALL alaesm( path, ok, nout )