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 ctptri(UPLO, DIAG, N, AP, INFO)
CTPTRI
subroutine ctbtrs(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
CTBTRS
subroutine ctrtri(UPLO, DIAG, N, A, LDA, INFO)
CTRTRI
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 cerrtr(PATH, NUNIT)
CERRTR
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine ctrrfs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CTRRFS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine ctprfs(UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CTPRFS
subroutine ctrtrs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, INFO)
CTRTRS
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 ctrti2(UPLO, DIAG, N, A, LDA, INFO)
CTRTI2 computes the inverse of a triangular matrix (unblocked algorithm).
subroutine ctpcon(NORM, UPLO, DIAG, N, AP, RCOND, WORK, RWORK, INFO)
CTPCON
LOGICAL function lsamen(N, CA, CB)
LSAMEN
subroutine ctptrs(UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO)
CTPTRS
subroutine alaesm(PATH, OK, NOUT)
ALAESM
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 ctbcon(NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK, RWORK, INFO)
CTBCON