72 parameter ( nmax = 2 )
81 REAL a( nmax, nmax ), b( nmax ), r1( nmax ),
82 $ r2( nmax ), w( nmax ), x( nmax )
99 COMMON / infoc / infot, nout, ok, lerr
100 COMMON / srnamc / srnamt
105 WRITE( nout, fmt = * )
113 IF(
lsamen( 2, c2,
'TR' ) )
THEN
121 CALL strtri(
'/',
'N', 0, a, 1, info )
122 CALL chkxer(
'STRTRI', infot, nout, lerr, ok )
124 CALL strtri(
'U',
'/', 0, a, 1, info )
125 CALL chkxer(
'STRTRI', infot, nout, lerr, ok )
127 CALL strtri(
'U',
'N', -1, a, 1, info )
128 CALL chkxer(
'STRTRI', infot, nout, lerr, ok )
130 CALL strtri(
'U',
'N', 2, a, 1, info )
131 CALL chkxer(
'STRTRI', infot, nout, lerr, ok )
137 CALL strti2(
'/',
'N', 0, a, 1, info )
138 CALL chkxer(
'STRTI2', infot, nout, lerr, ok )
140 CALL strti2(
'U',
'/', 0, a, 1, info )
141 CALL chkxer(
'STRTI2', infot, nout, lerr, ok )
143 CALL strti2(
'U',
'N', -1, a, 1, info )
144 CALL chkxer(
'STRTI2', infot, nout, lerr, ok )
146 CALL strti2(
'U',
'N', 2, a, 1, info )
147 CALL chkxer(
'STRTI2', infot, nout, lerr, ok )
153 CALL strtrs(
'/',
'N',
'N', 0, 0, a, 1, x, 1, info )
154 CALL chkxer(
'STRTRS', infot, nout, lerr, ok )
156 CALL strtrs(
'U',
'/',
'N', 0, 0, a, 1, x, 1, info )
157 CALL chkxer(
'STRTRS', infot, nout, lerr, ok )
159 CALL strtrs(
'U',
'N',
'/', 0, 0, a, 1, x, 1, info )
160 CALL chkxer(
'STRTRS', infot, nout, lerr, ok )
162 CALL strtrs(
'U',
'N',
'N', -1, 0, a, 1, x, 1, info )
163 CALL chkxer(
'STRTRS', infot, nout, lerr, ok )
165 CALL strtrs(
'U',
'N',
'N', 0, -1, a, 1, x, 1, info )
166 CALL chkxer(
'STRTRS', infot, nout, lerr, ok )
168 CALL strtrs(
'U',
'N',
'N', 2, 1, a, 1, x, 2, info )
169 CALL chkxer(
'STRTRS', infot, nout, lerr, ok )
171 CALL strtrs(
'U',
'N',
'N', 2, 1, a, 2, x, 1, info )
172 CALL chkxer(
'STRTRS', infot, nout, lerr, ok )
178 CALL strrfs(
'/',
'N',
'N', 0, 0, a, 1, b, 1, x, 1, r1, r2, w,
180 CALL chkxer(
'STRRFS', infot, nout, lerr, ok )
182 CALL strrfs(
'U',
'/',
'N', 0, 0, a, 1, b, 1, x, 1, r1, r2, w,
184 CALL chkxer(
'STRRFS', infot, nout, lerr, ok )
186 CALL strrfs(
'U',
'N',
'/', 0, 0, a, 1, b, 1, x, 1, r1, r2, w,
188 CALL chkxer(
'STRRFS', infot, nout, lerr, ok )
190 CALL strrfs(
'U',
'N',
'N', -1, 0, a, 1, b, 1, x, 1, r1, r2, w,
192 CALL chkxer(
'STRRFS', infot, nout, lerr, ok )
194 CALL strrfs(
'U',
'N',
'N', 0, -1, a, 1, b, 1, x, 1, r1, r2, w,
196 CALL chkxer(
'STRRFS', infot, nout, lerr, ok )
198 CALL strrfs(
'U',
'N',
'N', 2, 1, a, 1, b, 2, x, 2, r1, r2, w,
200 CALL chkxer(
'STRRFS', infot, nout, lerr, ok )
202 CALL strrfs(
'U',
'N',
'N', 2, 1, a, 2, b, 1, x, 2, r1, r2, w,
204 CALL chkxer(
'STRRFS', infot, nout, lerr, ok )
206 CALL strrfs(
'U',
'N',
'N', 2, 1, a, 2, b, 2, x, 1, r1, r2, w,
208 CALL chkxer(
'STRRFS', infot, nout, lerr, ok )
214 CALL strcon(
'/',
'U',
'N', 0, a, 1, rcond, w, iw, info )
215 CALL chkxer(
'STRCON', infot, nout, lerr, ok )
217 CALL strcon(
'1',
'/',
'N', 0, a, 1, rcond, w, iw, info )
218 CALL chkxer(
'STRCON', infot, nout, lerr, ok )
220 CALL strcon(
'1',
'U',
'/', 0, a, 1, rcond, w, iw, info )
221 CALL chkxer(
'STRCON', infot, nout, lerr, ok )
223 CALL strcon(
'1',
'U',
'N', -1, a, 1, rcond, w, iw, info )
224 CALL chkxer(
'STRCON', infot, nout, lerr, ok )
226 CALL strcon(
'1',
'U',
'N', 2, a, 1, rcond, w, iw, info )
227 CALL chkxer(
'STRCON', infot, nout, lerr, ok )
233 CALL slatrs(
'/',
'N',
'N',
'N', 0, a, 1, x, scale, w, info )
234 CALL chkxer(
'SLATRS', infot, nout, lerr, ok )
236 CALL slatrs(
'U',
'/',
'N',
'N', 0, a, 1, x, scale, w, info )
237 CALL chkxer(
'SLATRS', infot, nout, lerr, ok )
239 CALL slatrs(
'U',
'N',
'/',
'N', 0, a, 1, x, scale, w, info )
240 CALL chkxer(
'SLATRS', infot, nout, lerr, ok )
242 CALL slatrs(
'U',
'N',
'N',
'/', 0, a, 1, x, scale, w, info )
243 CALL chkxer(
'SLATRS', infot, nout, lerr, ok )
245 CALL slatrs(
'U',
'N',
'N',
'N', -1, a, 1, x, scale, w, info )
246 CALL chkxer(
'SLATRS', infot, nout, lerr, ok )
248 CALL slatrs(
'U',
'N',
'N',
'N', 2, a, 1, x, scale, w, info )
249 CALL chkxer(
'SLATRS', infot, nout, lerr, ok )
251 ELSE IF(
lsamen( 2, c2,
'TP' ) )
THEN
259 CALL stptri(
'/',
'N', 0, a, info )
260 CALL chkxer(
'STPTRI', infot, nout, lerr, ok )
262 CALL stptri(
'U',
'/', 0, a, info )
263 CALL chkxer(
'STPTRI', infot, nout, lerr, ok )
265 CALL stptri(
'U',
'N', -1, a, info )
266 CALL chkxer(
'STPTRI', infot, nout, lerr, ok )
272 CALL stptrs(
'/',
'N',
'N', 0, 0, a, x, 1, info )
273 CALL chkxer(
'STPTRS', infot, nout, lerr, ok )
275 CALL stptrs(
'U',
'/',
'N', 0, 0, a, x, 1, info )
276 CALL chkxer(
'STPTRS', infot, nout, lerr, ok )
278 CALL stptrs(
'U',
'N',
'/', 0, 0, a, x, 1, info )
279 CALL chkxer(
'STPTRS', infot, nout, lerr, ok )
281 CALL stptrs(
'U',
'N',
'N', -1, 0, a, x, 1, info )
282 CALL chkxer(
'STPTRS', infot, nout, lerr, ok )
284 CALL stptrs(
'U',
'N',
'N', 0, -1, a, x, 1, info )
285 CALL chkxer(
'STPTRS', infot, nout, lerr, ok )
287 CALL stptrs(
'U',
'N',
'N', 2, 1, a, x, 1, info )
288 CALL chkxer(
'STPTRS', infot, nout, lerr, ok )
294 CALL stprfs(
'/',
'N',
'N', 0, 0, a, b, 1, x, 1, r1, r2, w, iw,
296 CALL chkxer(
'STPRFS', infot, nout, lerr, ok )
298 CALL stprfs(
'U',
'/',
'N', 0, 0, a, b, 1, x, 1, r1, r2, w, iw,
300 CALL chkxer(
'STPRFS', infot, nout, lerr, ok )
302 CALL stprfs(
'U',
'N',
'/', 0, 0, a, b, 1, x, 1, r1, r2, w, iw,
304 CALL chkxer(
'STPRFS', infot, nout, lerr, ok )
306 CALL stprfs(
'U',
'N',
'N', -1, 0, a, b, 1, x, 1, r1, r2, w,
308 CALL chkxer(
'STPRFS', infot, nout, lerr, ok )
310 CALL stprfs(
'U',
'N',
'N', 0, -1, a, b, 1, x, 1, r1, r2, w,
312 CALL chkxer(
'STPRFS', infot, nout, lerr, ok )
314 CALL stprfs(
'U',
'N',
'N', 2, 1, a, b, 1, x, 2, r1, r2, w, iw,
316 CALL chkxer(
'STPRFS', infot, nout, lerr, ok )
318 CALL stprfs(
'U',
'N',
'N', 2, 1, a, b, 2, x, 1, r1, r2, w, iw,
320 CALL chkxer(
'STPRFS', infot, nout, lerr, ok )
326 CALL stpcon(
'/',
'U',
'N', 0, a, rcond, w, iw, info )
327 CALL chkxer(
'STPCON', infot, nout, lerr, ok )
329 CALL stpcon(
'1',
'/',
'N', 0, a, rcond, w, iw, info )
330 CALL chkxer(
'STPCON', infot, nout, lerr, ok )
332 CALL stpcon(
'1',
'U',
'/', 0, a, rcond, w, iw, info )
333 CALL chkxer(
'STPCON', infot, nout, lerr, ok )
335 CALL stpcon(
'1',
'U',
'N', -1, a, rcond, w, iw, info )
336 CALL chkxer(
'STPCON', infot, nout, lerr, ok )
342 CALL slatps(
'/',
'N',
'N',
'N', 0, a, x, scale, w, info )
343 CALL chkxer(
'SLATPS', infot, nout, lerr, ok )
345 CALL slatps(
'U',
'/',
'N',
'N', 0, a, x, scale, w, info )
346 CALL chkxer(
'SLATPS', infot, nout, lerr, ok )
348 CALL slatps(
'U',
'N',
'/',
'N', 0, a, x, scale, w, info )
349 CALL chkxer(
'SLATPS', infot, nout, lerr, ok )
351 CALL slatps(
'U',
'N',
'N',
'/', 0, a, x, scale, w, info )
352 CALL chkxer(
'SLATPS', infot, nout, lerr, ok )
354 CALL slatps(
'U',
'N',
'N',
'N', -1, a, x, scale, w, info )
355 CALL chkxer(
'SLATPS', infot, nout, lerr, ok )
357 ELSE IF(
lsamen( 2, c2,
'TB' ) )
THEN
365 CALL stbtrs(
'/',
'N',
'N', 0, 0, 0, a, 1, x, 1, info )
366 CALL chkxer(
'STBTRS', infot, nout, lerr, ok )
368 CALL stbtrs(
'U',
'/',
'N', 0, 0, 0, a, 1, x, 1, info )
369 CALL chkxer(
'STBTRS', infot, nout, lerr, ok )
371 CALL stbtrs(
'U',
'N',
'/', 0, 0, 0, a, 1, x, 1, info )
372 CALL chkxer(
'STBTRS', infot, nout, lerr, ok )
374 CALL stbtrs(
'U',
'N',
'N', -1, 0, 0, a, 1, x, 1, info )
375 CALL chkxer(
'STBTRS', infot, nout, lerr, ok )
377 CALL stbtrs(
'U',
'N',
'N', 0, -1, 0, a, 1, x, 1, info )
378 CALL chkxer(
'STBTRS', infot, nout, lerr, ok )
380 CALL stbtrs(
'U',
'N',
'N', 0, 0, -1, a, 1, x, 1, info )
381 CALL chkxer(
'STBTRS', infot, nout, lerr, ok )
383 CALL stbtrs(
'U',
'N',
'N', 2, 1, 1, a, 1, x, 2, info )
384 CALL chkxer(
'STBTRS', infot, nout, lerr, ok )
386 CALL stbtrs(
'U',
'N',
'N', 2, 0, 1, a, 1, x, 1, info )
387 CALL chkxer(
'STBTRS', infot, nout, lerr, ok )
393 CALL stbrfs(
'/',
'N',
'N', 0, 0, 0, a, 1, b, 1, x, 1, r1, r2,
395 CALL chkxer(
'STBRFS', infot, nout, lerr, ok )
397 CALL stbrfs(
'U',
'/',
'N', 0, 0, 0, a, 1, b, 1, x, 1, r1, r2,
399 CALL chkxer(
'STBRFS', infot, nout, lerr, ok )
401 CALL stbrfs(
'U',
'N',
'/', 0, 0, 0, a, 1, b, 1, x, 1, r1, r2,
403 CALL chkxer(
'STBRFS', infot, nout, lerr, ok )
405 CALL stbrfs(
'U',
'N',
'N', -1, 0, 0, a, 1, b, 1, x, 1, r1, r2,
407 CALL chkxer(
'STBRFS', infot, nout, lerr, ok )
409 CALL stbrfs(
'U',
'N',
'N', 0, -1, 0, a, 1, b, 1, x, 1, r1, r2,
411 CALL chkxer(
'STBRFS', infot, nout, lerr, ok )
413 CALL stbrfs(
'U',
'N',
'N', 0, 0, -1, a, 1, b, 1, x, 1, r1, r2,
415 CALL chkxer(
'STBRFS', infot, nout, lerr, ok )
417 CALL stbrfs(
'U',
'N',
'N', 2, 1, 1, a, 1, b, 2, x, 2, r1, r2,
419 CALL chkxer(
'STBRFS', infot, nout, lerr, ok )
421 CALL stbrfs(
'U',
'N',
'N', 2, 1, 1, a, 2, b, 1, x, 2, r1, r2,
423 CALL chkxer(
'STBRFS', infot, nout, lerr, ok )
425 CALL stbrfs(
'U',
'N',
'N', 2, 1, 1, a, 2, b, 2, x, 1, r1, r2,
427 CALL chkxer(
'STBRFS', infot, nout, lerr, ok )
433 CALL stbcon(
'/',
'U',
'N', 0, 0, a, 1, rcond, w, iw, info )
434 CALL chkxer(
'STBCON', infot, nout, lerr, ok )
436 CALL stbcon(
'1',
'/',
'N', 0, 0, a, 1, rcond, w, iw, info )
437 CALL chkxer(
'STBCON', infot, nout, lerr, ok )
439 CALL stbcon(
'1',
'U',
'/', 0, 0, a, 1, rcond, w, iw, info )
440 CALL chkxer(
'STBCON', infot, nout, lerr, ok )
442 CALL stbcon(
'1',
'U',
'N', -1, 0, a, 1, rcond, w, iw, info )
443 CALL chkxer(
'STBCON', infot, nout, lerr, ok )
445 CALL stbcon(
'1',
'U',
'N', 0, -1, a, 1, rcond, w, iw, info )
446 CALL chkxer(
'STBCON', infot, nout, lerr, ok )
448 CALL stbcon(
'1',
'U',
'N', 2, 1, a, 1, rcond, w, iw, info )
449 CALL chkxer(
'STBCON', infot, nout, lerr, ok )
455 CALL slatbs(
'/',
'N',
'N',
'N', 0, 0, a, 1, x, scale, w,
457 CALL chkxer(
'SLATBS', infot, nout, lerr, ok )
459 CALL slatbs(
'U',
'/',
'N',
'N', 0, 0, a, 1, x, scale, w,
461 CALL chkxer(
'SLATBS', infot, nout, lerr, ok )
463 CALL slatbs(
'U',
'N',
'/',
'N', 0, 0, a, 1, x, scale, w,
465 CALL chkxer(
'SLATBS', infot, nout, lerr, ok )
467 CALL slatbs(
'U',
'N',
'N',
'/', 0, 0, a, 1, x, scale, w,
469 CALL chkxer(
'SLATBS', infot, nout, lerr, ok )
471 CALL slatbs(
'U',
'N',
'N',
'N', -1, 0, a, 1, x, scale, w,
473 CALL chkxer(
'SLATBS', infot, nout, lerr, ok )
475 CALL slatbs(
'U',
'N',
'N',
'N', 1, -1, a, 1, x, scale, w,
477 CALL chkxer(
'SLATBS', infot, nout, lerr, ok )
479 CALL slatbs(
'U',
'N',
'N',
'N', 2, 1, a, 1, x, scale, w,
481 CALL chkxer(
'SLATBS', infot, nout, lerr, ok )
486 CALL alaesm( path, ok, nout )
subroutine stpcon(NORM, UPLO, DIAG, N, AP, RCOND, WORK, IWORK, INFO)
STPCON
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine stptrs(UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO)
STPTRS
subroutine stprfs(UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
STPRFS
subroutine slatps(UPLO, TRANS, DIAG, NORMIN, N, AP, X, SCALE, CNORM, INFO)
SLATPS solves a triangular system of equations with the matrix held in packed storage.
subroutine strrfs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
STRRFS
subroutine stbcon(NORM, UPLO, DIAG, N, KD, AB, LDAB, RCOND, WORK, IWORK, INFO)
STBCON
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine strcon(NORM, UPLO, DIAG, N, A, LDA, RCOND, WORK, IWORK, INFO)
STRCON
subroutine strtrs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, INFO)
STRTRS
logical function lsamen(N, CA, CB)
LSAMEN
subroutine slatbs(UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X, SCALE, CNORM, INFO)
SLATBS solves a triangular banded system of equations.
subroutine stptri(UPLO, DIAG, N, AP, INFO)
STPTRI
subroutine slatrs(UPLO, TRANS, DIAG, NORMIN, N, A, LDA, X, SCALE, CNORM, INFO)
SLATRS solves a triangular system of equations with the scale factor set to prevent overflow...
subroutine strtri(UPLO, DIAG, N, A, LDA, INFO)
STRTRI
subroutine stbrfs(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
STBRFS
subroutine stbtrs(UPLO, TRANS, DIAG, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
STBTRS
subroutine strti2(UPLO, DIAG, N, A, LDA, INFO)
STRTI2 computes the inverse of a triangular matrix (unblocked algorithm).