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 zgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGBRFS
subroutine zgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
ZGECON
subroutine zgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
ZGEEQU
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 chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine zgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGERFS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
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...
subroutine zgeequb(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
ZGEEQUB
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 zgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, RWORK, INFO)
ZGBCON
logical function lsamen(N, CA, CB)
LSAMEN
subroutine zgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
ZGETRI
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
subroutine zgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
ZGBTRS
subroutine zerrge(PATH, NUNIT)
ZERRGE
subroutine zgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
ZGBEQU
subroutine zgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZGETRS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
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 zgbequb(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
ZGBEQUB
subroutine zgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
ZGBTRF