77 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
78 DOUBLE PRECISION ANRM, CCOND, RCOND, BERR
82 DOUBLE PRECISION R( NMAX ), R1( NMAX ), R2( NMAX ), CS( NMAX ),
84 COMPLEX*16 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
104 COMMON / infoc / infot, nout, ok, lerr
105 COMMON / srnamc / srnamt
108 INTRINSIC dble, dcmplx
113 WRITE( nout, fmt = * )
120 a( i, j ) = dcmplx( 1.d0 / dble( i+j ),
121 $ -1.d0 / dble( i+j ) )
122 af( i, j ) = dcmplx( 1.d0 / dble( i+j ),
123 $ -1.d0 / dble( i+j ) )
139 IF( lsamen( 2, c2,
'GE' ) )
THEN
145 CALL zgetrf( -1, 0, a, 1, ip, info )
146 CALL chkxer(
'ZGETRF', infot, nout, lerr, ok )
148 CALL zgetrf( 0, -1, a, 1, ip, info )
149 CALL chkxer(
'ZGETRF', infot, nout, lerr, ok )
151 CALL zgetrf( 2, 1, a, 1, ip, info )
152 CALL chkxer(
'ZGETRF', infot, nout, lerr, ok )
158 CALL zgetf2( -1, 0, a, 1, ip, info )
159 CALL chkxer(
'ZGETF2', infot, nout, lerr, ok )
161 CALL zgetf2( 0, -1, a, 1, ip, info )
162 CALL chkxer(
'ZGETF2', infot, nout, lerr, ok )
164 CALL zgetf2( 2, 1, a, 1, ip, info )
165 CALL chkxer(
'ZGETF2', infot, nout, lerr, ok )
171 CALL zgetri( -1, a, 1, ip, w, 1, info )
172 CALL chkxer(
'ZGETRI', infot, nout, lerr, ok )
174 CALL zgetri( 2, a, 1, ip, w, 2, info )
175 CALL chkxer(
'ZGETRI', infot, nout, lerr, ok )
177 CALL zgetri( 2, a, 2, ip, w, 1, info )
178 CALL chkxer(
'ZGETRI', infot, nout, lerr, ok )
184 CALL zgetrs(
'/', 0, 0, a, 1, ip, b, 1, info )
185 CALL chkxer(
'ZGETRS', infot, nout, lerr, ok )
187 CALL zgetrs(
'N', -1, 0, a, 1, ip, b, 1, info )
188 CALL chkxer(
'ZGETRS', infot, nout, lerr, ok )
190 CALL zgetrs(
'N', 0, -1, a, 1, ip, b, 1, info )
191 CALL chkxer(
'ZGETRS', infot, nout, lerr, ok )
193 CALL zgetrs(
'N', 2, 1, a, 1, ip, b, 2, info )
194 CALL chkxer(
'ZGETRS', infot, nout, lerr, ok )
196 CALL zgetrs(
'N', 2, 1, a, 2, ip, b, 1, info )
197 CALL chkxer(
'ZGETRS', infot, nout, lerr, ok )
203 CALL zgerfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
205 CALL chkxer(
'ZGERFS', infot, nout, lerr, ok )
207 CALL zgerfs(
'N', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
209 CALL chkxer(
'ZGERFS', infot, nout, lerr, ok )
211 CALL zgerfs(
'N', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
213 CALL chkxer(
'ZGERFS', infot, nout, lerr, ok )
215 CALL zgerfs(
'N', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
217 CALL chkxer(
'ZGERFS', infot, nout, lerr, ok )
219 CALL zgerfs(
'N', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
221 CALL chkxer(
'ZGERFS', infot, nout, lerr, ok )
223 CALL zgerfs(
'N', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
225 CALL chkxer(
'ZGERFS', infot, nout, lerr, ok )
227 CALL zgerfs(
'N', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
229 CALL chkxer(
'ZGERFS', infot, nout, lerr, ok )
237 CALL zgerfsx(
'/', eq, 0, 0, a, 1, af, 1, ip, rs, cs, b, 1, x,
238 $ 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
239 $ nparams, params, w, r, info )
240 CALL chkxer(
'ZGERFSX', infot, nout, lerr, ok )
243 CALL zgerfsx(
'N', eq, 2, 1, a, 1, af, 2, ip, rs, cs, b, 2, x,
244 $ 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
245 $ nparams, params, w, r, info )
246 CALL chkxer(
'ZGERFSX', infot, nout, lerr, ok )
249 CALL zgerfsx(
'N', eq, -1, 0, a, 1, af, 1, ip, rs, cs, b, 1, x,
250 $ 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
251 $ nparams, params, w, r, info )
252 CALL chkxer(
'ZGERFSX', infot, nout, lerr, ok )
254 CALL zgerfsx(
'N', eq, 0, -1, a, 1, af, 1, ip, rs, cs, b, 1, x,
255 $ 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
256 $ nparams, params, w, r, info )
257 CALL chkxer(
'ZGERFSX', infot, nout, lerr, ok )
259 CALL zgerfsx(
'N', eq, 2, 1, a, 1, af, 2, ip, rs, cs, b, 2, x,
260 $ 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
261 $ nparams, params, w, r, info )
262 CALL chkxer(
'ZGERFSX', infot, nout, lerr, ok )
264 CALL zgerfsx(
'N', eq, 2, 1, a, 2, af, 1, ip, rs, cs, b, 2, x,
265 $ 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
266 $ nparams, params, w, r, info )
267 CALL chkxer(
'ZGERFSX', infot, nout, lerr, ok )
270 CALL zgerfsx(
'N', eq, 2, 1, a, 2, af, 2, ip, rs, cs, b, 1, x,
271 $ 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
272 $ nparams, params, w, r, info )
273 CALL chkxer(
'ZGERFSX', infot, nout, lerr, ok )
275 CALL zgerfsx(
'N', eq, 2, 1, a, 2, af, 2, ip, rs, cs, b, 2, x,
276 $ 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
277 $ nparams, params, w, r, info )
278 CALL chkxer(
'ZGERFSX', infot, nout, lerr, ok )
284 CALL zgecon(
'/', 0, a, 1, anrm, rcond, w, r, info )
285 CALL chkxer(
'ZGECON', infot, nout, lerr, ok )
287 CALL zgecon(
'1', -1, a, 1, anrm, rcond, w, r, info )
288 CALL chkxer(
'ZGECON', infot, nout, lerr, ok )
290 CALL zgecon(
'1', 2, a, 1, anrm, rcond, w, r, info )
291 CALL chkxer(
'ZGECON', infot, nout, lerr, ok )
297 CALL zgeequ( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
298 CALL chkxer(
'ZGEEQU', infot, nout, lerr, ok )
300 CALL zgeequ( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
301 CALL chkxer(
'ZGEEQU', infot, nout, lerr, ok )
303 CALL zgeequ( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
304 CALL chkxer(
'ZGEEQU', infot, nout, lerr, ok )
310 CALL zgeequb( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
311 CALL chkxer(
'ZGEEQUB', infot, nout, lerr, ok )
313 CALL zgeequb( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
314 CALL chkxer(
'ZGEEQUB', infot, nout, lerr, ok )
316 CALL zgeequb( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
317 CALL chkxer(
'ZGEEQUB', infot, nout, lerr, ok )
322 ELSE IF( lsamen( 2, c2,
'GB' ) )
THEN
328 CALL zgbtrf( -1, 0, 0, 0, a, 1, ip, info )
329 CALL chkxer(
'ZGBTRF', infot, nout, lerr, ok )
331 CALL zgbtrf( 0, -1, 0, 0, a, 1, ip, info )
332 CALL chkxer(
'ZGBTRF', infot, nout, lerr, ok )
334 CALL zgbtrf( 1, 1, -1, 0, a, 1, ip, info )
335 CALL chkxer(
'ZGBTRF', infot, nout, lerr, ok )
337 CALL zgbtrf( 1, 1, 0, -1, a, 1, ip, info )
338 CALL chkxer(
'ZGBTRF', infot, nout, lerr, ok )
340 CALL zgbtrf( 2, 2, 1, 1, a, 3, ip, info )
341 CALL chkxer(
'ZGBTRF', infot, nout, lerr, ok )
347 CALL zgbtf2( -1, 0, 0, 0, a, 1, ip, info )
348 CALL chkxer(
'ZGBTF2', infot, nout, lerr, ok )
350 CALL zgbtf2( 0, -1, 0, 0, a, 1, ip, info )
351 CALL chkxer(
'ZGBTF2', infot, nout, lerr, ok )
353 CALL zgbtf2( 1, 1, -1, 0, a, 1, ip, info )
354 CALL chkxer(
'ZGBTF2', infot, nout, lerr, ok )
356 CALL zgbtf2( 1, 1, 0, -1, a, 1, ip, info )
357 CALL chkxer(
'ZGBTF2', infot, nout, lerr, ok )
359 CALL zgbtf2( 2, 2, 1, 1, a, 3, ip, info )
360 CALL chkxer(
'ZGBTF2', infot, nout, lerr, ok )
366 CALL zgbtrs(
'/', 0, 0, 0, 1, a, 1, ip, b, 1, info )
367 CALL chkxer(
'ZGBTRS', infot, nout, lerr, ok )
369 CALL zgbtrs(
'N', -1, 0, 0, 1, a, 1, ip, b, 1, info )
370 CALL chkxer(
'ZGBTRS', infot, nout, lerr, ok )
372 CALL zgbtrs(
'N', 1, -1, 0, 1, a, 1, ip, b, 1, info )
373 CALL chkxer(
'ZGBTRS', infot, nout, lerr, ok )
375 CALL zgbtrs(
'N', 1, 0, -1, 1, a, 1, ip, b, 1, info )
376 CALL chkxer(
'ZGBTRS', infot, nout, lerr, ok )
378 CALL zgbtrs(
'N', 1, 0, 0, -1, a, 1, ip, b, 1, info )
379 CALL chkxer(
'ZGBTRS', infot, nout, lerr, ok )
381 CALL zgbtrs(
'N', 2, 1, 1, 1, a, 3, ip, b, 2, info )
382 CALL chkxer(
'ZGBTRS', infot, nout, lerr, ok )
384 CALL zgbtrs(
'N', 2, 0, 0, 1, a, 1, ip, b, 1, info )
385 CALL chkxer(
'ZGBTRS', infot, nout, lerr, ok )
391 CALL zgbrfs(
'/', 0, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
393 CALL chkxer(
'ZGBRFS', infot, nout, lerr, ok )
395 CALL zgbrfs(
'N', -1, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
397 CALL chkxer(
'ZGBRFS', infot, nout, lerr, ok )
399 CALL zgbrfs(
'N', 1, -1, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
401 CALL chkxer(
'ZGBRFS', infot, nout, lerr, ok )
403 CALL zgbrfs(
'N', 1, 0, -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
405 CALL chkxer(
'ZGBRFS', infot, nout, lerr, ok )
407 CALL zgbrfs(
'N', 1, 0, 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1,
409 CALL chkxer(
'ZGBRFS', infot, nout, lerr, ok )
411 CALL zgbrfs(
'N', 2, 1, 1, 1, a, 2, af, 4, ip, b, 2, x, 2, r1,
413 CALL chkxer(
'ZGBRFS', infot, nout, lerr, ok )
415 CALL zgbrfs(
'N', 2, 1, 1, 1, a, 3, af, 3, ip, b, 2, x, 2, r1,
417 CALL chkxer(
'ZGBRFS', infot, nout, lerr, ok )
419 CALL zgbrfs(
'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 1, x, 2, r1,
421 CALL chkxer(
'ZGBRFS', infot, nout, lerr, ok )
423 CALL zgbrfs(
'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 2, x, 1, r1,
425 CALL chkxer(
'ZGBRFS', infot, nout, lerr, ok )
433 CALL zgbrfsx(
'/', eq, 0, 0, 0, 0, a, 1, af, 1, ip, rs, cs, b,
434 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n,
435 $ err_bnds_c, nparams, params, w, r, info )
436 CALL chkxer(
'ZGBRFSX', infot, nout, lerr, ok )
439 CALL zgbrfsx(
'N', eq, 2, 1, 1, 1, a, 1, af, 2, ip, rs, cs, b,
440 $ 2, x, 2, rcond, berr, n_err_bnds, err_bnds_n,
441 $ err_bnds_c, nparams, params, w, r, info )
442 CALL chkxer(
'ZGBRFSX', infot, nout, lerr, ok )
445 CALL zgbrfsx(
'N', eq, -1, 1, 1, 0, a, 1, af, 1, ip, rs, cs, b,
446 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n,
447 $ err_bnds_c, nparams, params, w, r, info )
448 CALL chkxer(
'ZGBRFSX', infot, nout, lerr, ok )
451 CALL zgbrfsx(
'N', eq, 2, -1, 1, 1, a, 3, af, 4, ip, rs, cs, b,
452 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n,
453 $ err_bnds_c, nparams, params, w, r, info )
454 CALL chkxer(
'ZGBRFSX', infot, nout, lerr, ok )
457 CALL zgbrfsx(
'N', eq, 2, 1, -1, 1, a, 3, af, 4, ip, rs, cs, b,
458 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n,
459 $ err_bnds_c, nparams, params, w, r, info )
460 CALL chkxer(
'ZGBRFSX', infot, nout, lerr, ok )
462 CALL zgbrfsx(
'N', eq, 0, 0, 0, -1, a, 1, af, 1, ip, rs, cs, b,
463 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n,
464 $ err_bnds_c, nparams, params, w, r, info )
465 CALL chkxer(
'ZGBRFSX', infot, nout, lerr, ok )
467 CALL zgbrfsx(
'N', eq, 2, 1, 1, 1, a, 1, af, 2, ip, rs, cs, b,
468 $ 2, x, 2, rcond, berr, n_err_bnds, err_bnds_n,
469 $ err_bnds_c, nparams, params, w, r, info )
470 CALL chkxer(
'ZGBRFSX', infot, nout, lerr, ok )
472 CALL zgbrfsx(
'N', eq, 2, 1, 1, 1, a, 3, af, 3, ip, rs, cs, b,
473 $ 2, x, 2, rcond, berr, n_err_bnds, err_bnds_n,
474 $ err_bnds_c, nparams, params, w, r, info )
475 CALL chkxer(
'ZGBRFSX', infot, nout, lerr, ok )
478 CALL zgbrfsx(
'N', eq, 2, 1, 1, 1, a, 3, af, 5, ip, rs, cs, b,
479 $ 1, x, 2, rcond, berr, n_err_bnds, err_bnds_n,
480 $ err_bnds_c, nparams, params, w, r, info )
481 CALL chkxer(
'ZGBRFSX', infot, nout, lerr, ok )
483 CALL zgbrfsx(
'N', eq, 2, 1, 1, 1, a, 3, af, 5, ip, rs, cs, b,
484 $ 2, x, 1, rcond, berr, n_err_bnds, err_bnds_n,
485 $ err_bnds_c, nparams, params, w, r, info )
486 CALL chkxer(
'ZGBRFSX', infot, nout, lerr, ok )
492 CALL zgbcon(
'/', 0, 0, 0, a, 1, ip, anrm, rcond, w, r, info )
493 CALL chkxer(
'ZGBCON', infot, nout, lerr, ok )
495 CALL zgbcon(
'1', -1, 0, 0, a, 1, ip, anrm, rcond, w, r, info )
496 CALL chkxer(
'ZGBCON', infot, nout, lerr, ok )
498 CALL zgbcon(
'1', 1, -1, 0, a, 1, ip, anrm, rcond, w, r, info )
499 CALL chkxer(
'ZGBCON', infot, nout, lerr, ok )
501 CALL zgbcon(
'1', 1, 0, -1, a, 1, ip, anrm, rcond, w, r, info )
502 CALL chkxer(
'ZGBCON', infot, nout, lerr, ok )
504 CALL zgbcon(
'1', 2, 1, 1, a, 3, ip, anrm, rcond, w, r, info )
505 CALL chkxer(
'ZGBCON', infot, nout, lerr, ok )
511 CALL zgbequ( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
513 CALL chkxer(
'ZGBEQU', infot, nout, lerr, ok )
515 CALL zgbequ( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
517 CALL chkxer(
'ZGBEQU', infot, nout, lerr, ok )
519 CALL zgbequ( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
521 CALL chkxer(
'ZGBEQU', infot, nout, lerr, ok )
523 CALL zgbequ( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
525 CALL chkxer(
'ZGBEQU', infot, nout, lerr, ok )
527 CALL zgbequ( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
529 CALL chkxer(
'ZGBEQU', infot, nout, lerr, ok )
535 CALL zgbequb( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
537 CALL chkxer(
'ZGBEQUB', infot, nout, lerr, ok )
539 CALL zgbequb( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
541 CALL chkxer(
'ZGBEQUB', infot, nout, lerr, ok )
543 CALL zgbequb( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
545 CALL chkxer(
'ZGBEQUB', infot, nout, lerr, ok )
547 CALL zgbequb( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
549 CALL chkxer(
'ZGBEQUB', infot, nout, lerr, ok )
551 CALL zgbequb( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
553 CALL chkxer(
'ZGBEQUB', infot, nout, lerr, ok )
558 CALL alaesm( path, ok, nout )