59 SUBROUTINE zerrge( PATH, NUNIT )
80 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
81 DOUBLE PRECISION ANRM, CCOND, RCOND, BERR
85 DOUBLE PRECISION R( NMAX ), R1( NMAX ), R2( NMAX ), CS( NMAX ),
87 COMPLEX*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
88 $ W( 2*NMAX ), X( NMAX ), ERR_BNDS_N( NMAX, 3 ),
89 $ ERR_BNDS_C( NMAX, 3 ), PARAMS
107 COMMON / infoc / infot, nout, ok, lerr
108 COMMON / srnamc / srnamt
111 INTRINSIC dble, dcmplx
116 WRITE( nout, fmt = * )
123 a( i, j ) = dcmplx( 1.d0 / dble( i+j ),
124 $ -1.d0 / dble( i+j ) )
125 af( i, j ) = dcmplx( 1.d0 / dble( i+j ),
126 $ -1.d0 / dble( i+j ) )
142 IF( lsamen( 2, c2,
'GE' ) )
THEN
148 CALL zgetrf( -1, 0, a, 1, ip, info )
149 CALL chkxer(
'ZGETRF', infot, nout, lerr, ok )
151 CALL zgetrf( 0, -1, a, 1, ip, info )
152 CALL chkxer(
'ZGETRF', infot, nout, lerr, ok )
154 CALL zgetrf( 2, 1, a, 1, ip, info )
155 CALL chkxer(
'ZGETRF', infot, nout, lerr, ok )
161 CALL zgetf2( -1, 0, a, 1, ip, info )
162 CALL chkxer(
'ZGETF2', infot, nout, lerr, ok )
164 CALL zgetf2( 0, -1, a, 1, ip, info )
165 CALL chkxer(
'ZGETF2', infot, nout, lerr, ok )
167 CALL zgetf2( 2, 1, a, 1, ip, info )
168 CALL chkxer(
'ZGETF2', infot, nout, lerr, ok )
174 CALL zgetri( -1, a, 1, ip, w, 1, info )
175 CALL chkxer(
'ZGETRI', infot, nout, lerr, ok )
177 CALL zgetri( 2, a, 1, ip, w, 2, info )
178 CALL chkxer(
'ZGETRI', infot, nout, lerr, ok )
180 CALL zgetri( 2, a, 2, ip, w, 1, info )
181 CALL chkxer(
'ZGETRI', infot, nout, lerr, ok )
187 CALL zgetrs(
'/', 0, 0, a, 1, ip, b, 1, info )
188 CALL chkxer(
'ZGETRS', infot, nout, lerr, ok )
190 CALL zgetrs(
'N', -1, 0, a, 1, ip, b, 1, info )
191 CALL chkxer(
'ZGETRS', infot, nout, lerr, ok )
193 CALL zgetrs(
'N', 0, -1, a, 1, ip, b, 1, info )
194 CALL chkxer(
'ZGETRS', infot, nout, lerr, ok )
196 CALL zgetrs(
'N', 2, 1, a, 1, ip, b, 2, info )
197 CALL chkxer(
'ZGETRS', infot, nout, lerr, ok )
199 CALL zgetrs(
'N', 2, 1, a, 2, ip, b, 1, info )
200 CALL chkxer(
'ZGETRS', infot, nout, lerr, ok )
206 CALL zgerfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
208 CALL chkxer(
'ZGERFS', infot, nout, lerr, ok )
210 CALL zgerfs(
'N', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
212 CALL chkxer(
'ZGERFS', infot, nout, lerr, ok )
214 CALL zgerfs(
'N', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
216 CALL chkxer(
'ZGERFS', infot, nout, lerr, ok )
218 CALL zgerfs(
'N', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
220 CALL chkxer(
'ZGERFS', infot, nout, lerr, ok )
222 CALL zgerfs(
'N', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
224 CALL chkxer(
'ZGERFS', infot, nout, lerr, ok )
226 CALL zgerfs(
'N', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
228 CALL chkxer(
'ZGERFS', infot, nout, lerr, ok )
230 CALL zgerfs(
'N', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
232 CALL chkxer(
'ZGERFS', infot, nout, lerr, ok )
240 CALL zgerfsx(
'/', eq, 0, 0, a, 1, af, 1, ip, rs, cs, b, 1, x,
241 $ 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
242 $ nparams, params, w, r, info )
243 CALL chkxer(
'ZGERFSX', infot, nout, lerr, ok )
246 CALL zgerfsx(
'N', eq, 2, 1, a, 1, af, 2, ip, rs, cs, b, 2, x,
247 $ 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
248 $ nparams, params, w, r, info )
249 CALL chkxer(
'ZGERFSX', infot, nout, lerr, ok )
252 CALL zgerfsx(
'N', eq, -1, 0, a, 1, af, 1, ip, rs, cs, b, 1, x,
253 $ 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
254 $ nparams, params, w, r, info )
255 CALL chkxer(
'ZGERFSX', infot, nout, lerr, ok )
257 CALL zgerfsx(
'N', eq, 0, -1, a, 1, af, 1, ip, rs, cs, b, 1, x,
258 $ 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
259 $ nparams, params, w, r, info )
260 CALL chkxer(
'ZGERFSX', infot, nout, lerr, ok )
262 CALL zgerfsx(
'N', eq, 2, 1, a, 1, af, 2, ip, rs, cs, b, 2, x,
263 $ 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
264 $ nparams, params, w, r, info )
265 CALL chkxer(
'ZGERFSX', infot, nout, lerr, ok )
267 CALL zgerfsx(
'N', eq, 2, 1, a, 2, af, 1, ip, rs, cs, b, 2, x,
268 $ 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
269 $ nparams, params, w, r, info )
270 CALL chkxer(
'ZGERFSX', infot, nout, lerr, ok )
273 CALL zgerfsx(
'N', eq, 2, 1, a, 2, af, 2, ip, rs, cs, b, 1, x,
274 $ 2, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
275 $ nparams, params, w, r, info )
276 CALL chkxer(
'ZGERFSX', infot, nout, lerr, ok )
278 CALL zgerfsx(
'N', eq, 2, 1, a, 2, af, 2, ip, rs, cs, b, 2, x,
279 $ 1, rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c,
280 $ nparams, params, w, r, info )
281 CALL chkxer(
'ZGERFSX', infot, nout, lerr, ok )
287 CALL zgecon(
'/', 0, a, 1, anrm, rcond, w, r, info )
288 CALL chkxer(
'ZGECON', infot, nout, lerr, ok )
290 CALL zgecon(
'1', -1, a, 1, anrm, rcond, w, r, info )
291 CALL chkxer(
'ZGECON', infot, nout, lerr, ok )
293 CALL zgecon(
'1', 2, a, 1, anrm, rcond, w, r, info )
294 CALL chkxer(
'ZGECON', infot, nout, lerr, ok )
300 CALL zgeequ( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
301 CALL chkxer(
'ZGEEQU', infot, nout, lerr, ok )
303 CALL zgeequ( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
304 CALL chkxer(
'ZGEEQU', infot, nout, lerr, ok )
306 CALL zgeequ( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
307 CALL chkxer(
'ZGEEQU', infot, nout, lerr, ok )
313 CALL zgeequb( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
314 CALL chkxer(
'ZGEEQUB', infot, nout, lerr, ok )
316 CALL zgeequb( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
317 CALL chkxer(
'ZGEEQUB', infot, nout, lerr, ok )
319 CALL zgeequb( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
320 CALL chkxer(
'ZGEEQUB', infot, nout, lerr, ok )
325 ELSE IF( lsamen( 2, c2,
'GB' ) )
THEN
331 CALL zgbtrf( -1, 0, 0, 0, a, 1, ip, info )
332 CALL chkxer(
'ZGBTRF', infot, nout, lerr, ok )
334 CALL zgbtrf( 0, -1, 0, 0, a, 1, ip, info )
335 CALL chkxer(
'ZGBTRF', infot, nout, lerr, ok )
337 CALL zgbtrf( 1, 1, -1, 0, a, 1, ip, info )
338 CALL chkxer(
'ZGBTRF', infot, nout, lerr, ok )
340 CALL zgbtrf( 1, 1, 0, -1, a, 1, ip, info )
341 CALL chkxer(
'ZGBTRF', infot, nout, lerr, ok )
343 CALL zgbtrf( 2, 2, 1, 1, a, 3, ip, info )
344 CALL chkxer(
'ZGBTRF', infot, nout, lerr, ok )
350 CALL zgbtf2( -1, 0, 0, 0, a, 1, ip, info )
351 CALL chkxer(
'ZGBTF2', infot, nout, lerr, ok )
353 CALL zgbtf2( 0, -1, 0, 0, a, 1, ip, info )
354 CALL chkxer(
'ZGBTF2', infot, nout, lerr, ok )
356 CALL zgbtf2( 1, 1, -1, 0, a, 1, ip, info )
357 CALL chkxer(
'ZGBTF2', infot, nout, lerr, ok )
359 CALL zgbtf2( 1, 1, 0, -1, a, 1, ip, info )
360 CALL chkxer(
'ZGBTF2', infot, nout, lerr, ok )
362 CALL zgbtf2( 2, 2, 1, 1, a, 3, ip, info )
363 CALL chkxer(
'ZGBTF2', infot, nout, lerr, ok )
369 CALL zgbtrs(
'/', 0, 0, 0, 1, a, 1, ip, b, 1, info )
370 CALL chkxer(
'ZGBTRS', infot, nout, lerr, ok )
372 CALL zgbtrs(
'N', -1, 0, 0, 1, a, 1, ip, b, 1, info )
373 CALL chkxer(
'ZGBTRS', infot, nout, lerr, ok )
375 CALL zgbtrs(
'N', 1, -1, 0, 1, a, 1, ip, b, 1, info )
376 CALL chkxer(
'ZGBTRS', infot, nout, lerr, ok )
378 CALL zgbtrs(
'N', 1, 0, -1, 1, a, 1, ip, b, 1, info )
379 CALL chkxer(
'ZGBTRS', infot, nout, lerr, ok )
381 CALL zgbtrs(
'N', 1, 0, 0, -1, a, 1, ip, b, 1, info )
382 CALL chkxer(
'ZGBTRS', infot, nout, lerr, ok )
384 CALL zgbtrs(
'N', 2, 1, 1, 1, a, 3, ip, b, 2, info )
385 CALL chkxer(
'ZGBTRS', infot, nout, lerr, ok )
387 CALL zgbtrs(
'N', 2, 0, 0, 1, a, 1, ip, b, 1, info )
388 CALL chkxer(
'ZGBTRS', infot, nout, lerr, ok )
394 CALL zgbrfs(
'/', 0, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
396 CALL chkxer(
'ZGBRFS', infot, nout, lerr, ok )
398 CALL zgbrfs(
'N', -1, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
400 CALL chkxer(
'ZGBRFS', infot, nout, lerr, ok )
402 CALL zgbrfs(
'N', 1, -1, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
404 CALL chkxer(
'ZGBRFS', infot, nout, lerr, ok )
406 CALL zgbrfs(
'N', 1, 0, -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
408 CALL chkxer(
'ZGBRFS', infot, nout, lerr, ok )
410 CALL zgbrfs(
'N', 1, 0, 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1,
412 CALL chkxer(
'ZGBRFS', infot, nout, lerr, ok )
414 CALL zgbrfs(
'N', 2, 1, 1, 1, a, 2, af, 4, ip, b, 2, x, 2, r1,
416 CALL chkxer(
'ZGBRFS', infot, nout, lerr, ok )
418 CALL zgbrfs(
'N', 2, 1, 1, 1, a, 3, af, 3, ip, b, 2, x, 2, r1,
420 CALL chkxer(
'ZGBRFS', infot, nout, lerr, ok )
422 CALL zgbrfs(
'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 1, x, 2, r1,
424 CALL chkxer(
'ZGBRFS', infot, nout, lerr, ok )
426 CALL zgbrfs(
'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 2, x, 1, r1,
428 CALL chkxer(
'ZGBRFS', infot, nout, lerr, ok )
436 CALL zgbrfsx(
'/', eq, 0, 0, 0, 0, a, 1, af, 1, ip, rs, cs, b,
437 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n,
438 $ err_bnds_c, nparams, params, w, r, info )
439 CALL chkxer(
'ZGBRFSX', infot, nout, lerr, ok )
442 CALL zgbrfsx(
'N', eq, 2, 1, 1, 1, a, 1, af, 2, ip, rs, cs, b,
443 $ 2, x, 2, rcond, berr, n_err_bnds, err_bnds_n,
444 $ err_bnds_c, nparams, params, w, r, info )
445 CALL chkxer(
'ZGBRFSX', infot, nout, lerr, ok )
448 CALL zgbrfsx(
'N', eq, -1, 1, 1, 0, a, 1, af, 1, ip, rs, cs, b,
449 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n,
450 $ err_bnds_c, nparams, params, w, r, info )
451 CALL chkxer(
'ZGBRFSX', infot, nout, lerr, ok )
454 CALL zgbrfsx(
'N', eq, 2, -1, 1, 1, a, 3, af, 4, ip, rs, cs, b,
455 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n,
456 $ err_bnds_c, nparams, params, w, r, info )
457 CALL chkxer(
'ZGBRFSX', infot, nout, lerr, ok )
460 CALL zgbrfsx(
'N', eq, 2, 1, -1, 1, a, 3, af, 4, 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(
'ZGBRFSX', infot, nout, lerr, ok )
465 CALL zgbrfsx(
'N', eq, 0, 0, 0, -1, a, 1, af, 1, ip, rs, cs, b,
466 $ 1, x, 1, rcond, berr, n_err_bnds, err_bnds_n,
467 $ err_bnds_c, nparams, params, w, r, info )
468 CALL chkxer(
'ZGBRFSX', infot, nout, lerr, ok )
470 CALL zgbrfsx(
'N', eq, 2, 1, 1, 1, a, 1, af, 2, 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(
'ZGBRFSX', infot, nout, lerr, ok )
475 CALL zgbrfsx(
'N', eq, 2, 1, 1, 1, a, 3, af, 3, ip, rs, cs, b,
476 $ 2, x, 2, rcond, berr, n_err_bnds, err_bnds_n,
477 $ err_bnds_c, nparams, params, w, r, info )
478 CALL chkxer(
'ZGBRFSX', infot, nout, lerr, ok )
481 CALL zgbrfsx(
'N', eq, 2, 1, 1, 1, a, 3, af, 5, ip, rs, cs, b,
482 $ 1, x, 2, rcond, berr, n_err_bnds, err_bnds_n,
483 $ err_bnds_c, nparams, params, w, r, info )
484 CALL chkxer(
'ZGBRFSX', infot, nout, lerr, ok )
486 CALL zgbrfsx(
'N', eq, 2, 1, 1, 1, a, 3, af, 5, ip, rs, cs, b,
487 $ 2, x, 1, rcond, berr, n_err_bnds, err_bnds_n,
488 $ err_bnds_c, nparams, params, w, r, info )
489 CALL chkxer(
'ZGBRFSX', infot, nout, lerr, ok )
495 CALL zgbcon(
'/', 0, 0, 0, a, 1, ip, anrm, rcond, w, r, info )
496 CALL chkxer(
'ZGBCON', infot, nout, lerr, ok )
498 CALL zgbcon(
'1', -1, 0, 0, a, 1, ip, anrm, rcond, w, r, info )
499 CALL chkxer(
'ZGBCON', infot, nout, lerr, ok )
501 CALL zgbcon(
'1', 1, -1, 0, a, 1, ip, anrm, rcond, w, r, info )
502 CALL chkxer(
'ZGBCON', infot, nout, lerr, ok )
504 CALL zgbcon(
'1', 1, 0, -1, a, 1, ip, anrm, rcond, w, r, info )
505 CALL chkxer(
'ZGBCON', infot, nout, lerr, ok )
507 CALL zgbcon(
'1', 2, 1, 1, a, 3, ip, anrm, rcond, w, r, info )
508 CALL chkxer(
'ZGBCON', infot, nout, lerr, ok )
514 CALL zgbequ( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
516 CALL chkxer(
'ZGBEQU', infot, nout, lerr, ok )
518 CALL zgbequ( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
520 CALL chkxer(
'ZGBEQU', infot, nout, lerr, ok )
522 CALL zgbequ( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
524 CALL chkxer(
'ZGBEQU', infot, nout, lerr, ok )
526 CALL zgbequ( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
528 CALL chkxer(
'ZGBEQU', infot, nout, lerr, ok )
530 CALL zgbequ( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
532 CALL chkxer(
'ZGBEQU', infot, nout, lerr, ok )
538 CALL zgbequb( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
540 CALL chkxer(
'ZGBEQUB', infot, nout, lerr, ok )
542 CALL zgbequb( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
544 CALL chkxer(
'ZGBEQUB', infot, nout, lerr, ok )
546 CALL zgbequb( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
548 CALL chkxer(
'ZGBEQUB', infot, nout, lerr, ok )
550 CALL zgbequb( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
552 CALL chkxer(
'ZGBEQUB', infot, nout, lerr, ok )
554 CALL zgbequb( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
556 CALL chkxer(
'ZGBEQUB', infot, nout, lerr, ok )
561 CALL alaesm( path, ok, nout )