59 SUBROUTINE zerrge( PATH, NUNIT )
75 parameter ( nmax = 4 )
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 )
subroutine zgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZGETRS
subroutine zgetf2(M, N, A, LDA, IPIV, INFO)
ZGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row inter...
subroutine zgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
ZGBTRS
subroutine zgeequb(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
ZGEEQUB
subroutine zgerfsx(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, RWORK, INFO)
ZGERFSX
logical function lsamen(N, CA, CB)
LSAMEN
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine zgetrf(M, N, A, LDA, IPIV, INFO)
ZGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.
subroutine zgbrfsx(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, RWORK, INFO)
ZGBRFSX
subroutine zgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, RWORK, INFO)
ZGBCON
subroutine zgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGBRFS
subroutine zgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
ZGBEQU
subroutine zgbequb(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
ZGBEQUB
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine zgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
ZGBTRF
subroutine zgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
ZGECON
subroutine zerrge(PATH, NUNIT)
ZERRGE
subroutine zgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
ZGETRI
subroutine zgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGERFS
subroutine zgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
ZGEEQU
subroutine zgbtf2(M, N, KL, KU, AB, LDAB, IPIV, INFO)
ZGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algo...