71 parameter ( nmax = 2 )
76 DOUBLE PRECISION rcond, scale
79 DOUBLE PRECISION r1( nmax ), r2( nmax ), rw( nmax )
80 COMPLEX*16 a( nmax, nmax ), b( nmax ), w( nmax ),
98 COMMON / infoc / infot, nout, ok, lerr
99 COMMON / srnamc / srnamt
104 WRITE( nout, fmt = * )
114 IF(
lsamen( 2, c2,
'TR' ) )
THEN
120 CALL ztrtri(
'/',
'N', 0, a, 1, info )
121 CALL chkxer(
'ZTRTRI', infot, nout, lerr, ok )
123 CALL ztrtri(
'U',
'/', 0, a, 1, info )
124 CALL chkxer(
'ZTRTRI', infot, nout, lerr, ok )
126 CALL ztrtri(
'U',
'N', -1, a, 1, info )
127 CALL chkxer(
'ZTRTRI', infot, nout, lerr, ok )
129 CALL ztrtri(
'U',
'N', 2, a, 1, info )
130 CALL chkxer(
'ZTRTRI', infot, nout, lerr, ok )
136 CALL ztrti2(
'/',
'N', 0, a, 1, info )
137 CALL chkxer(
'ZTRTI2', infot, nout, lerr, ok )
139 CALL ztrti2(
'U',
'/', 0, a, 1, info )
140 CALL chkxer(
'ZTRTI2', infot, nout, lerr, ok )
142 CALL ztrti2(
'U',
'N', -1, a, 1, info )
143 CALL chkxer(
'ZTRTI2', infot, nout, lerr, ok )
145 CALL ztrti2(
'U',
'N', 2, a, 1, info )
146 CALL chkxer(
'ZTRTI2', infot, nout, lerr, ok )
153 CALL ztrtrs(
'/',
'N',
'N', 0, 0, a, 1, x, 1, info )
154 CALL chkxer(
'ZTRTRS', infot, nout, lerr, ok )
156 CALL ztrtrs(
'U',
'/',
'N', 0, 0, a, 1, x, 1, info )
157 CALL chkxer(
'ZTRTRS', infot, nout, lerr, ok )
159 CALL ztrtrs(
'U',
'N',
'/', 0, 0, a, 1, x, 1, info )
160 CALL chkxer(
'ZTRTRS', infot, nout, lerr, ok )
162 CALL ztrtrs(
'U',
'N',
'N', -1, 0, a, 1, x, 1, info )
163 CALL chkxer(
'ZTRTRS', infot, nout, lerr, ok )
165 CALL ztrtrs(
'U',
'N',
'N', 0, -1, a, 1, x, 1, info )
166 CALL chkxer(
'ZTRTRS', infot, nout, lerr, ok )
173 CALL ztrrfs(
'/',
'N',
'N', 0, 0, a, 1, b, 1, x, 1, r1, r2, w,
175 CALL chkxer(
'ZTRRFS', infot, nout, lerr, ok )
177 CALL ztrrfs(
'U',
'/',
'N', 0, 0, a, 1, b, 1, x, 1, r1, r2, w,
179 CALL chkxer(
'ZTRRFS', infot, nout, lerr, ok )
181 CALL ztrrfs(
'U',
'N',
'/', 0, 0, a, 1, b, 1, x, 1, r1, r2, w,
183 CALL chkxer(
'ZTRRFS', infot, nout, lerr, ok )
185 CALL ztrrfs(
'U',
'N',
'N', -1, 0, a, 1, b, 1, x, 1, r1, r2, w,
187 CALL chkxer(
'ZTRRFS', infot, nout, lerr, ok )
189 CALL ztrrfs(
'U',
'N',
'N', 0, -1, a, 1, b, 1, x, 1, r1, r2, w,
191 CALL chkxer(
'ZTRRFS', infot, nout, lerr, ok )
193 CALL ztrrfs(
'U',
'N',
'N', 2, 1, a, 1, b, 2, x, 2, r1, r2, w,
195 CALL chkxer(
'ZTRRFS', infot, nout, lerr, ok )
197 CALL ztrrfs(
'U',
'N',
'N', 2, 1, a, 2, b, 1, x, 2, r1, r2, w,
199 CALL chkxer(
'ZTRRFS', infot, nout, lerr, ok )
201 CALL ztrrfs(
'U',
'N',
'N', 2, 1, a, 2, b, 2, x, 1, r1, r2, w,
203 CALL chkxer(
'ZTRRFS', infot, nout, lerr, ok )
209 CALL ztrcon(
'/',
'U',
'N', 0, a, 1, rcond, w, rw, info )
210 CALL chkxer(
'ZTRCON', infot, nout, lerr, ok )
212 CALL ztrcon(
'1',
'/',
'N', 0, a, 1, rcond, w, rw, info )
213 CALL chkxer(
'ZTRCON', infot, nout, lerr, ok )
215 CALL ztrcon(
'1',
'U',
'/', 0, a, 1, rcond, w, rw, info )
216 CALL chkxer(
'ZTRCON', infot, nout, lerr, ok )
218 CALL ztrcon(
'1',
'U',
'N', -1, a, 1, rcond, w, rw, info )
219 CALL chkxer(
'ZTRCON', infot, nout, lerr, ok )
221 CALL ztrcon(
'1',
'U',
'N', 2, a, 1, rcond, w, rw, info )
222 CALL chkxer(
'ZTRCON', infot, nout, lerr, ok )
228 CALL zlatrs(
'/',
'N',
'N',
'N', 0, a, 1, x, scale, rw, info )
229 CALL chkxer(
'ZLATRS', infot, nout, lerr, ok )
231 CALL zlatrs(
'U',
'/',
'N',
'N', 0, a, 1, x, scale, rw, info )
232 CALL chkxer(
'ZLATRS', infot, nout, lerr, ok )
234 CALL zlatrs(
'U',
'N',
'/',
'N', 0, a, 1, x, scale, rw, info )
235 CALL chkxer(
'ZLATRS', infot, nout, lerr, ok )
237 CALL zlatrs(
'U',
'N',
'N',
'/', 0, a, 1, x, scale, rw, info )
238 CALL chkxer(
'ZLATRS', infot, nout, lerr, ok )
240 CALL zlatrs(
'U',
'N',
'N',
'N', -1, a, 1, x, scale, rw, info )
241 CALL chkxer(
'ZLATRS', infot, nout, lerr, ok )
243 CALL zlatrs(
'U',
'N',
'N',
'N', 2, a, 1, x, scale, rw, info )
244 CALL chkxer(
'ZLATRS', infot, nout, lerr, ok )
248 ELSE IF(
lsamen( 2, c2,
'TP' ) )
THEN
254 CALL ztptri(
'/',
'N', 0, a, info )
255 CALL chkxer(
'ZTPTRI', infot, nout, lerr, ok )
257 CALL ztptri(
'U',
'/', 0, a, info )
258 CALL chkxer(
'ZTPTRI', infot, nout, lerr, ok )
260 CALL ztptri(
'U',
'N', -1, a, info )
261 CALL chkxer(
'ZTPTRI', infot, nout, lerr, ok )
267 CALL ztptrs(
'/',
'N',
'N', 0, 0, a, x, 1, info )
268 CALL chkxer(
'ZTPTRS', infot, nout, lerr, ok )
270 CALL ztptrs(
'U',
'/',
'N', 0, 0, a, x, 1, info )
271 CALL chkxer(
'ZTPTRS', infot, nout, lerr, ok )
273 CALL ztptrs(
'U',
'N',
'/', 0, 0, a, x, 1, info )
274 CALL chkxer(
'ZTPTRS', infot, nout, lerr, ok )
276 CALL ztptrs(
'U',
'N',
'N', -1, 0, a, x, 1, info )
277 CALL chkxer(
'ZTPTRS', infot, nout, lerr, ok )
279 CALL ztptrs(
'U',
'N',
'N', 0, -1, a, x, 1, info )
280 CALL chkxer(
'ZTPTRS', infot, nout, lerr, ok )
282 CALL ztptrs(
'U',
'N',
'N', 2, 1, a, x, 1, info )
283 CALL chkxer(
'ZTPTRS', infot, nout, lerr, ok )
289 CALL ztprfs(
'/',
'N',
'N', 0, 0, a, b, 1, x, 1, r1, r2, w, rw,
291 CALL chkxer(
'ZTPRFS', infot, nout, lerr, ok )
293 CALL ztprfs(
'U',
'/',
'N', 0, 0, a, b, 1, x, 1, r1, r2, w, rw,
295 CALL chkxer(
'ZTPRFS', infot, nout, lerr, ok )
297 CALL ztprfs(
'U',
'N',
'/', 0, 0, a, b, 1, x, 1, r1, r2, w, rw,
299 CALL chkxer(
'ZTPRFS', infot, nout, lerr, ok )
301 CALL ztprfs(
'U',
'N',
'N', -1, 0, a, b, 1, x, 1, r1, r2, w,
303 CALL chkxer(
'ZTPRFS', infot, nout, lerr, ok )
305 CALL ztprfs(
'U',
'N',
'N', 0, -1, a, b, 1, x, 1, r1, r2, w,
307 CALL chkxer(
'ZTPRFS', infot, nout, lerr, ok )
309 CALL ztprfs(
'U',
'N',
'N', 2, 1, a, b, 1, x, 2, r1, r2, w, rw,
311 CALL chkxer(
'ZTPRFS', infot, nout, lerr, ok )
313 CALL ztprfs(
'U',
'N',
'N', 2, 1, a, b, 2, x, 1, r1, r2, w, rw,
315 CALL chkxer(
'ZTPRFS', infot, nout, lerr, ok )
321 CALL ztpcon(
'/',
'U',
'N', 0, a, rcond, w, rw, info )
322 CALL chkxer(
'ZTPCON', infot, nout, lerr, ok )
324 CALL ztpcon(
'1',
'/',
'N', 0, a, rcond, w, rw, info )
325 CALL chkxer(
'ZTPCON', infot, nout, lerr, ok )
327 CALL ztpcon(
'1',
'U',
'/', 0, a, rcond, w, rw, info )
328 CALL chkxer(
'ZTPCON', infot, nout, lerr, ok )
330 CALL ztpcon(
'1',
'U',
'N', -1, a, rcond, w, rw, info )
331 CALL chkxer(
'ZTPCON', infot, nout, lerr, ok )
337 CALL zlatps(
'/',
'N',
'N',
'N', 0, a, x, scale, rw, info )
338 CALL chkxer(
'ZLATPS', infot, nout, lerr, ok )
340 CALL zlatps(
'U',
'/',
'N',
'N', 0, a, x, scale, rw, info )
341 CALL chkxer(
'ZLATPS', infot, nout, lerr, ok )
343 CALL zlatps(
'U',
'N',
'/',
'N', 0, a, x, scale, rw, info )
344 CALL chkxer(
'ZLATPS', infot, nout, lerr, ok )
346 CALL zlatps(
'U',
'N',
'N',
'/', 0, a, x, scale, rw, info )
347 CALL chkxer(
'ZLATPS', infot, nout, lerr, ok )
349 CALL zlatps(
'U',
'N',
'N',
'N', -1, a, x, scale, rw, info )
350 CALL chkxer(
'ZLATPS', infot, nout, lerr, ok )
354 ELSE IF(
lsamen( 2, c2,
'TB' ) )
THEN
360 CALL ztbtrs(
'/',
'N',
'N', 0, 0, 0, a, 1, x, 1, info )
361 CALL chkxer(
'ZTBTRS', infot, nout, lerr, ok )
363 CALL ztbtrs(
'U',
'/',
'N', 0, 0, 0, a, 1, x, 1, info )
364 CALL chkxer(
'ZTBTRS', infot, nout, lerr, ok )
366 CALL ztbtrs(
'U',
'N',
'/', 0, 0, 0, a, 1, x, 1, info )
367 CALL chkxer(
'ZTBTRS', infot, nout, lerr, ok )
369 CALL ztbtrs(
'U',
'N',
'N', -1, 0, 0, a, 1, x, 1, info )
370 CALL chkxer(
'ZTBTRS', infot, nout, lerr, ok )
372 CALL ztbtrs(
'U',
'N',
'N', 0, -1, 0, a, 1, x, 1, info )
373 CALL chkxer(
'ZTBTRS', infot, nout, lerr, ok )
375 CALL ztbtrs(
'U',
'N',
'N', 0, 0, -1, a, 1, x, 1, info )
376 CALL chkxer(
'ZTBTRS', infot, nout, lerr, ok )
378 CALL ztbtrs(
'U',
'N',
'N', 2, 1, 1, a, 1, x, 2, info )
379 CALL chkxer(
'ZTBTRS', infot, nout, lerr, ok )
381 CALL ztbtrs(
'U',
'N',
'N', 2, 0, 1, a, 1, x, 1, info )
382 CALL chkxer(
'ZTBTRS', infot, nout, lerr, ok )
388 CALL ztbrfs(
'/',
'N',
'N', 0, 0, 0, a, 1, b, 1, x, 1, r1, r2,
390 CALL chkxer(
'ZTBRFS', infot, nout, lerr, ok )
392 CALL ztbrfs(
'U',
'/',
'N', 0, 0, 0, a, 1, b, 1, x, 1, r1, r2,
394 CALL chkxer(
'ZTBRFS', infot, nout, lerr, ok )
396 CALL ztbrfs(
'U',
'N',
'/', 0, 0, 0, a, 1, b, 1, x, 1, r1, r2,
398 CALL chkxer(
'ZTBRFS', infot, nout, lerr, ok )
400 CALL ztbrfs(
'U',
'N',
'N', -1, 0, 0, a, 1, b, 1, x, 1, r1, r2,
402 CALL chkxer(
'ZTBRFS', infot, nout, lerr, ok )
404 CALL ztbrfs(
'U',
'N',
'N', 0, -1, 0, a, 1, b, 1, x, 1, r1, r2,
406 CALL chkxer(
'ZTBRFS', infot, nout, lerr, ok )
408 CALL ztbrfs(
'U',
'N',
'N', 0, 0, -1, a, 1, b, 1, x, 1, r1, r2,
410 CALL chkxer(
'ZTBRFS', infot, nout, lerr, ok )
412 CALL ztbrfs(
'U',
'N',
'N', 2, 1, 1, a, 1, b, 2, x, 2, r1, r2,
414 CALL chkxer(
'ZTBRFS', infot, nout, lerr, ok )
416 CALL ztbrfs(
'U',
'N',
'N', 2, 1, 1, a, 2, b, 1, x, 2, r1, r2,
418 CALL chkxer(
'ZTBRFS', infot, nout, lerr, ok )
420 CALL ztbrfs(
'U',
'N',
'N', 2, 1, 1, a, 2, b, 2, x, 1, r1, r2,
422 CALL chkxer(
'ZTBRFS', infot, nout, lerr, ok )
428 CALL ztbcon(
'/',
'U',
'N', 0, 0, a, 1, rcond, w, rw, info )
429 CALL chkxer(
'ZTBCON', infot, nout, lerr, ok )
431 CALL ztbcon(
'1',
'/',
'N', 0, 0, a, 1, rcond, w, rw, info )
432 CALL chkxer(
'ZTBCON', infot, nout, lerr, ok )
434 CALL ztbcon(
'1',
'U',
'/', 0, 0, a, 1, rcond, w, rw, info )
435 CALL chkxer(
'ZTBCON', infot, nout, lerr, ok )
437 CALL ztbcon(
'1',
'U',
'N', -1, 0, a, 1, rcond, w, rw, info )
438 CALL chkxer(
'ZTBCON', infot, nout, lerr, ok )
440 CALL ztbcon(
'1',
'U',
'N', 0, -1, a, 1, rcond, w, rw, info )
441 CALL chkxer(
'ZTBCON', infot, nout, lerr, ok )
443 CALL ztbcon(
'1',
'U',
'N', 2, 1, a, 1, rcond, w, rw, info )
444 CALL chkxer(
'ZTBCON', infot, nout, lerr, ok )
450 CALL zlatbs(
'/',
'N',
'N',
'N', 0, 0, a, 1, x, scale, rw,
452 CALL chkxer(
'ZLATBS', infot, nout, lerr, ok )
454 CALL zlatbs(
'U',
'/',
'N',
'N', 0, 0, a, 1, x, scale, rw,
456 CALL chkxer(
'ZLATBS', infot, nout, lerr, ok )
458 CALL zlatbs(
'U',
'N',
'/',
'N', 0, 0, a, 1, x, scale, rw,
460 CALL chkxer(
'ZLATBS', infot, nout, lerr, ok )
462 CALL zlatbs(
'U',
'N',
'N',
'/', 0, 0, a, 1, x, scale, rw,
464 CALL chkxer(
'ZLATBS', infot, nout, lerr, ok )
466 CALL zlatbs(
'U',
'N',
'N',
'N', -1, 0, a, 1, x, scale, rw,
468 CALL chkxer(
'ZLATBS', infot, nout, lerr, ok )
470 CALL zlatbs(
'U',
'N',
'N',
'N', 1, -1, a, 1, x, scale, rw,
472 CALL chkxer(
'ZLATBS', infot, nout, lerr, ok )
474 CALL zlatbs(
'U',
'N',
'N',
'N', 2, 1, a, 1, x, scale, rw,
476 CALL chkxer(
'ZLATBS', infot, nout, lerr, ok )
481 CALL alaesm( path, ok, nout )
subroutine ztptri(UPLO, DIAG, N, AP, INFO)
ZTPTRI
subroutine ztrtrs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, INFO)
ZTRTRS
subroutine ztbcon(NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK, RWORK, INFO)
ZTBCON
logical function lsamen(N, CA, CB)
LSAMEN
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine ztrtri(UPLO, DIAG, N, A, LDA, INFO)
ZTRTRI
subroutine zlatbs(UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, SCALE, CNORM, INFO)
ZLATBS solves a triangular banded system of equations.
subroutine ztrcon(NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK, RWORK, INFO)
ZTRCON
subroutine ztpcon(NORM, UPLO, DIAG, N, AP, RCOND, WORK, RWORK, INFO)
ZTPCON
subroutine ztptrs(UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO)
ZTPTRS
subroutine zlatps(UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE, CNORM, INFO)
ZLATPS solves a triangular system of equations with the matrix held in packed storage.
subroutine ztprfs(UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZTPRFS
subroutine ztbrfs(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZTBRFS
subroutine ztrrfs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZTRRFS
subroutine ztbtrs(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
ZTBTRS
subroutine zlatrs(UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, CNORM, INFO)
ZLATRS solves a triangular system of equations with the scale factor set to prevent overflow...
subroutine ztrti2(UPLO, DIAG, N, A, LDA, INFO)
ZTRTI2 computes the inverse of a triangular matrix (unblocked algorithm).