71 parameter ( nmax = 2 )
79 REAL r1( nmax ), r2( nmax ), rw( nmax )
80 COMPLEX 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 ctrtri(
'/',
'N', 0, a, 1, info )
121 CALL chkxer(
'CTRTRI', infot, nout, lerr, ok )
123 CALL ctrtri(
'U',
'/', 0, a, 1, info )
124 CALL chkxer(
'CTRTRI', infot, nout, lerr, ok )
126 CALL ctrtri(
'U',
'N', -1, a, 1, info )
127 CALL chkxer(
'CTRTRI', infot, nout, lerr, ok )
129 CALL ctrtri(
'U',
'N', 2, a, 1, info )
130 CALL chkxer(
'CTRTRI', infot, nout, lerr, ok )
136 CALL ctrti2(
'/',
'N', 0, a, 1, info )
137 CALL chkxer(
'CTRTI2', infot, nout, lerr, ok )
139 CALL ctrti2(
'U',
'/', 0, a, 1, info )
140 CALL chkxer(
'CTRTI2', infot, nout, lerr, ok )
142 CALL ctrti2(
'U',
'N', -1, a, 1, info )
143 CALL chkxer(
'CTRTI2', infot, nout, lerr, ok )
145 CALL ctrti2(
'U',
'N', 2, a, 1, info )
146 CALL chkxer(
'CTRTI2', infot, nout, lerr, ok )
153 CALL ctrtrs(
'/',
'N',
'N', 0, 0, a, 1, x, 1, info )
154 CALL chkxer(
'CTRTRS', infot, nout, lerr, ok )
156 CALL ctrtrs(
'U',
'/',
'N', 0, 0, a, 1, x, 1, info )
157 CALL chkxer(
'CTRTRS', infot, nout, lerr, ok )
159 CALL ctrtrs(
'U',
'N',
'/', 0, 0, a, 1, x, 1, info )
160 CALL chkxer(
'CTRTRS', infot, nout, lerr, ok )
162 CALL ctrtrs(
'U',
'N',
'N', -1, 0, a, 1, x, 1, info )
163 CALL chkxer(
'CTRTRS', infot, nout, lerr, ok )
165 CALL ctrtrs(
'U',
'N',
'N', 0, -1, a, 1, x, 1, info )
166 CALL chkxer(
'CTRTRS', infot, nout, lerr, ok )
173 CALL ctrrfs(
'/',
'N',
'N', 0, 0, a, 1, b, 1, x, 1, r1, r2, w,
175 CALL chkxer(
'CTRRFS', infot, nout, lerr, ok )
177 CALL ctrrfs(
'U',
'/',
'N', 0, 0, a, 1, b, 1, x, 1, r1, r2, w,
179 CALL chkxer(
'CTRRFS', infot, nout, lerr, ok )
181 CALL ctrrfs(
'U',
'N',
'/', 0, 0, a, 1, b, 1, x, 1, r1, r2, w,
183 CALL chkxer(
'CTRRFS', infot, nout, lerr, ok )
185 CALL ctrrfs(
'U',
'N',
'N', -1, 0, a, 1, b, 1, x, 1, r1, r2, w,
187 CALL chkxer(
'CTRRFS', infot, nout, lerr, ok )
189 CALL ctrrfs(
'U',
'N',
'N', 0, -1, a, 1, b, 1, x, 1, r1, r2, w,
191 CALL chkxer(
'CTRRFS', infot, nout, lerr, ok )
193 CALL ctrrfs(
'U',
'N',
'N', 2, 1, a, 1, b, 2, x, 2, r1, r2, w,
195 CALL chkxer(
'CTRRFS', infot, nout, lerr, ok )
197 CALL ctrrfs(
'U',
'N',
'N', 2, 1, a, 2, b, 1, x, 2, r1, r2, w,
199 CALL chkxer(
'CTRRFS', infot, nout, lerr, ok )
201 CALL ctrrfs(
'U',
'N',
'N', 2, 1, a, 2, b, 2, x, 1, r1, r2, w,
203 CALL chkxer(
'CTRRFS', infot, nout, lerr, ok )
209 CALL ctrcon(
'/',
'U',
'N', 0, a, 1, rcond, w, rw, info )
210 CALL chkxer(
'CTRCON', infot, nout, lerr, ok )
212 CALL ctrcon(
'1',
'/',
'N', 0, a, 1, rcond, w, rw, info )
213 CALL chkxer(
'CTRCON', infot, nout, lerr, ok )
215 CALL ctrcon(
'1',
'U',
'/', 0, a, 1, rcond, w, rw, info )
216 CALL chkxer(
'CTRCON', infot, nout, lerr, ok )
218 CALL ctrcon(
'1',
'U',
'N', -1, a, 1, rcond, w, rw, info )
219 CALL chkxer(
'CTRCON', infot, nout, lerr, ok )
221 CALL ctrcon(
'1',
'U',
'N', 2, a, 1, rcond, w, rw, info )
222 CALL chkxer(
'CTRCON', infot, nout, lerr, ok )
228 CALL clatrs(
'/',
'N',
'N',
'N', 0, a, 1, x, scale, rw, info )
229 CALL chkxer(
'CLATRS', infot, nout, lerr, ok )
231 CALL clatrs(
'U',
'/',
'N',
'N', 0, a, 1, x, scale, rw, info )
232 CALL chkxer(
'CLATRS', infot, nout, lerr, ok )
234 CALL clatrs(
'U',
'N',
'/',
'N', 0, a, 1, x, scale, rw, info )
235 CALL chkxer(
'CLATRS', infot, nout, lerr, ok )
237 CALL clatrs(
'U',
'N',
'N',
'/', 0, a, 1, x, scale, rw, info )
238 CALL chkxer(
'CLATRS', infot, nout, lerr, ok )
240 CALL clatrs(
'U',
'N',
'N',
'N', -1, a, 1, x, scale, rw, info )
241 CALL chkxer(
'CLATRS', infot, nout, lerr, ok )
243 CALL clatrs(
'U',
'N',
'N',
'N', 2, a, 1, x, scale, rw, info )
244 CALL chkxer(
'CLATRS', infot, nout, lerr, ok )
248 ELSE IF(
lsamen( 2, c2,
'TP' ) )
THEN
254 CALL ctptri(
'/',
'N', 0, a, info )
255 CALL chkxer(
'CTPTRI', infot, nout, lerr, ok )
257 CALL ctptri(
'U',
'/', 0, a, info )
258 CALL chkxer(
'CTPTRI', infot, nout, lerr, ok )
260 CALL ctptri(
'U',
'N', -1, a, info )
261 CALL chkxer(
'CTPTRI', infot, nout, lerr, ok )
267 CALL ctptrs(
'/',
'N',
'N', 0, 0, a, x, 1, info )
268 CALL chkxer(
'CTPTRS', infot, nout, lerr, ok )
270 CALL ctptrs(
'U',
'/',
'N', 0, 0, a, x, 1, info )
271 CALL chkxer(
'CTPTRS', infot, nout, lerr, ok )
273 CALL ctptrs(
'U',
'N',
'/', 0, 0, a, x, 1, info )
274 CALL chkxer(
'CTPTRS', infot, nout, lerr, ok )
276 CALL ctptrs(
'U',
'N',
'N', -1, 0, a, x, 1, info )
277 CALL chkxer(
'CTPTRS', infot, nout, lerr, ok )
279 CALL ctptrs(
'U',
'N',
'N', 0, -1, a, x, 1, info )
280 CALL chkxer(
'CTPTRS', infot, nout, lerr, ok )
282 CALL ctptrs(
'U',
'N',
'N', 2, 1, a, x, 1, info )
283 CALL chkxer(
'CTPTRS', infot, nout, lerr, ok )
289 CALL ctprfs(
'/',
'N',
'N', 0, 0, a, b, 1, x, 1, r1, r2, w, rw,
291 CALL chkxer(
'CTPRFS', infot, nout, lerr, ok )
293 CALL ctprfs(
'U',
'/',
'N', 0, 0, a, b, 1, x, 1, r1, r2, w, rw,
295 CALL chkxer(
'CTPRFS', infot, nout, lerr, ok )
297 CALL ctprfs(
'U',
'N',
'/', 0, 0, a, b, 1, x, 1, r1, r2, w, rw,
299 CALL chkxer(
'CTPRFS', infot, nout, lerr, ok )
301 CALL ctprfs(
'U',
'N',
'N', -1, 0, a, b, 1, x, 1, r1, r2, w,
303 CALL chkxer(
'CTPRFS', infot, nout, lerr, ok )
305 CALL ctprfs(
'U',
'N',
'N', 0, -1, a, b, 1, x, 1, r1, r2, w,
307 CALL chkxer(
'CTPRFS', infot, nout, lerr, ok )
309 CALL ctprfs(
'U',
'N',
'N', 2, 1, a, b, 1, x, 2, r1, r2, w, rw,
311 CALL chkxer(
'CTPRFS', infot, nout, lerr, ok )
313 CALL ctprfs(
'U',
'N',
'N', 2, 1, a, b, 2, x, 1, r1, r2, w, rw,
315 CALL chkxer(
'CTPRFS', infot, nout, lerr, ok )
321 CALL ctpcon(
'/',
'U',
'N', 0, a, rcond, w, rw, info )
322 CALL chkxer(
'CTPCON', infot, nout, lerr, ok )
324 CALL ctpcon(
'1',
'/',
'N', 0, a, rcond, w, rw, info )
325 CALL chkxer(
'CTPCON', infot, nout, lerr, ok )
327 CALL ctpcon(
'1',
'U',
'/', 0, a, rcond, w, rw, info )
328 CALL chkxer(
'CTPCON', infot, nout, lerr, ok )
330 CALL ctpcon(
'1',
'U',
'N', -1, a, rcond, w, rw, info )
331 CALL chkxer(
'CTPCON', infot, nout, lerr, ok )
337 CALL clatps(
'/',
'N',
'N',
'N', 0, a, x, scale, rw, info )
338 CALL chkxer(
'CLATPS', infot, nout, lerr, ok )
340 CALL clatps(
'U',
'/',
'N',
'N', 0, a, x, scale, rw, info )
341 CALL chkxer(
'CLATPS', infot, nout, lerr, ok )
343 CALL clatps(
'U',
'N',
'/',
'N', 0, a, x, scale, rw, info )
344 CALL chkxer(
'CLATPS', infot, nout, lerr, ok )
346 CALL clatps(
'U',
'N',
'N',
'/', 0, a, x, scale, rw, info )
347 CALL chkxer(
'CLATPS', infot, nout, lerr, ok )
349 CALL clatps(
'U',
'N',
'N',
'N', -1, a, x, scale, rw, info )
350 CALL chkxer(
'CLATPS', infot, nout, lerr, ok )
354 ELSE IF(
lsamen( 2, c2,
'TB' ) )
THEN
360 CALL ctbtrs(
'/',
'N',
'N', 0, 0, 0, a, 1, x, 1, info )
361 CALL chkxer(
'CTBTRS', infot, nout, lerr, ok )
363 CALL ctbtrs(
'U',
'/',
'N', 0, 0, 0, a, 1, x, 1, info )
364 CALL chkxer(
'CTBTRS', infot, nout, lerr, ok )
366 CALL ctbtrs(
'U',
'N',
'/', 0, 0, 0, a, 1, x, 1, info )
367 CALL chkxer(
'CTBTRS', infot, nout, lerr, ok )
369 CALL ctbtrs(
'U',
'N',
'N', -1, 0, 0, a, 1, x, 1, info )
370 CALL chkxer(
'CTBTRS', infot, nout, lerr, ok )
372 CALL ctbtrs(
'U',
'N',
'N', 0, -1, 0, a, 1, x, 1, info )
373 CALL chkxer(
'CTBTRS', infot, nout, lerr, ok )
375 CALL ctbtrs(
'U',
'N',
'N', 0, 0, -1, a, 1, x, 1, info )
376 CALL chkxer(
'CTBTRS', infot, nout, lerr, ok )
378 CALL ctbtrs(
'U',
'N',
'N', 2, 1, 1, a, 1, x, 2, info )
379 CALL chkxer(
'CTBTRS', infot, nout, lerr, ok )
381 CALL ctbtrs(
'U',
'N',
'N', 2, 0, 1, a, 1, x, 1, info )
382 CALL chkxer(
'CTBTRS', infot, nout, lerr, ok )
388 CALL ctbrfs(
'/',
'N',
'N', 0, 0, 0, a, 1, b, 1, x, 1, r1, r2,
390 CALL chkxer(
'CTBRFS', infot, nout, lerr, ok )
392 CALL ctbrfs(
'U',
'/',
'N', 0, 0, 0, a, 1, b, 1, x, 1, r1, r2,
394 CALL chkxer(
'CTBRFS', infot, nout, lerr, ok )
396 CALL ctbrfs(
'U',
'N',
'/', 0, 0, 0, a, 1, b, 1, x, 1, r1, r2,
398 CALL chkxer(
'CTBRFS', infot, nout, lerr, ok )
400 CALL ctbrfs(
'U',
'N',
'N', -1, 0, 0, a, 1, b, 1, x, 1, r1, r2,
402 CALL chkxer(
'CTBRFS', infot, nout, lerr, ok )
404 CALL ctbrfs(
'U',
'N',
'N', 0, -1, 0, a, 1, b, 1, x, 1, r1, r2,
406 CALL chkxer(
'CTBRFS', infot, nout, lerr, ok )
408 CALL ctbrfs(
'U',
'N',
'N', 0, 0, -1, a, 1, b, 1, x, 1, r1, r2,
410 CALL chkxer(
'CTBRFS', infot, nout, lerr, ok )
412 CALL ctbrfs(
'U',
'N',
'N', 2, 1, 1, a, 1, b, 2, x, 2, r1, r2,
414 CALL chkxer(
'CTBRFS', infot, nout, lerr, ok )
416 CALL ctbrfs(
'U',
'N',
'N', 2, 1, 1, a, 2, b, 1, x, 2, r1, r2,
418 CALL chkxer(
'CTBRFS', infot, nout, lerr, ok )
420 CALL ctbrfs(
'U',
'N',
'N', 2, 1, 1, a, 2, b, 2, x, 1, r1, r2,
422 CALL chkxer(
'CTBRFS', infot, nout, lerr, ok )
428 CALL ctbcon(
'/',
'U',
'N', 0, 0, a, 1, rcond, w, rw, info )
429 CALL chkxer(
'CTBCON', infot, nout, lerr, ok )
431 CALL ctbcon(
'1',
'/',
'N', 0, 0, a, 1, rcond, w, rw, info )
432 CALL chkxer(
'CTBCON', infot, nout, lerr, ok )
434 CALL ctbcon(
'1',
'U',
'/', 0, 0, a, 1, rcond, w, rw, info )
435 CALL chkxer(
'CTBCON', infot, nout, lerr, ok )
437 CALL ctbcon(
'1',
'U',
'N', -1, 0, a, 1, rcond, w, rw, info )
438 CALL chkxer(
'CTBCON', infot, nout, lerr, ok )
440 CALL ctbcon(
'1',
'U',
'N', 0, -1, a, 1, rcond, w, rw, info )
441 CALL chkxer(
'CTBCON', infot, nout, lerr, ok )
443 CALL ctbcon(
'1',
'U',
'N', 2, 1, a, 1, rcond, w, rw, info )
444 CALL chkxer(
'CTBCON', infot, nout, lerr, ok )
450 CALL clatbs(
'/',
'N',
'N',
'N', 0, 0, a, 1, x, scale, rw,
452 CALL chkxer(
'CLATBS', infot, nout, lerr, ok )
454 CALL clatbs(
'U',
'/',
'N',
'N', 0, 0, a, 1, x, scale, rw,
456 CALL chkxer(
'CLATBS', infot, nout, lerr, ok )
458 CALL clatbs(
'U',
'N',
'/',
'N', 0, 0, a, 1, x, scale, rw,
460 CALL chkxer(
'CLATBS', infot, nout, lerr, ok )
462 CALL clatbs(
'U',
'N',
'N',
'/', 0, 0, a, 1, x, scale, rw,
464 CALL chkxer(
'CLATBS', infot, nout, lerr, ok )
466 CALL clatbs(
'U',
'N',
'N',
'N', -1, 0, a, 1, x, scale, rw,
468 CALL chkxer(
'CLATBS', infot, nout, lerr, ok )
470 CALL clatbs(
'U',
'N',
'N',
'N', 1, -1, a, 1, x, scale, rw,
472 CALL chkxer(
'CLATBS', infot, nout, lerr, ok )
474 CALL clatbs(
'U',
'N',
'N',
'N', 2, 1, a, 1, x, scale, rw,
476 CALL chkxer(
'CLATBS', infot, nout, lerr, ok )
481 CALL alaesm( path, ok, nout )
subroutine ctbcon(NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK, RWORK, INFO)
CTBCON
subroutine ctrrfs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CTRRFS
subroutine ctrti2(UPLO, DIAG, N, A, LDA, INFO)
CTRTI2 computes the inverse of a triangular matrix (unblocked algorithm).
subroutine ctbrfs(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CTBRFS
subroutine clatps(UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE, CNORM, INFO)
CLATPS solves a triangular system of equations with the matrix held in packed storage.
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine ctprfs(UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CTPRFS
subroutine ctptrs(UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO)
CTPTRS
subroutine ctrtrs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, INFO)
CTRTRS
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
logical function lsamen(N, CA, CB)
LSAMEN
subroutine ctbtrs(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
CTBTRS
subroutine clatrs(UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, CNORM, INFO)
CLATRS solves a triangular system of equations with the scale factor set to prevent overflow...
subroutine clatbs(UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, SCALE, CNORM, INFO)
CLATBS solves a triangular banded system of equations.
subroutine ctrcon(NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK, RWORK, INFO)
CTRCON
subroutine ctrtri(UPLO, DIAG, N, A, LDA, INFO)
CTRTRI
subroutine ctpcon(NORM, UPLO, DIAG, N, AP, RCOND, WORK, RWORK, INFO)
CTPCON
subroutine ctptri(UPLO, DIAG, N, AP, INFO)
CTPTRI