72 parameter ( nmax = 4, lw = 3*nmax )
77 REAL anrm, ccond, rcond
80 INTEGER ip( nmax ), iw( nmax )
81 REAL a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
82 $ r1( nmax ), r2( nmax ), w( lw ), x( nmax )
99 COMMON / infoc / infot, nout, ok, lerr
100 COMMON / srnamc / srnamt
108 WRITE( nout, fmt = * )
115 a( i, j ) = 1. /
REAL( i+j )
116 af( i, j ) = 1. /
REAL( i+j )
128 IF(
lsamen( 2, c2,
'GE' ) )
THEN
137 CALL sgetrf( -1, 0, a, 1, ip, info )
138 CALL chkxer(
'SGETRF', infot, nout, lerr, ok )
140 CALL sgetrf( 0, -1, a, 1, ip, info )
141 CALL chkxer(
'SGETRF', infot, nout, lerr, ok )
143 CALL sgetrf( 2, 1, a, 1, ip, info )
144 CALL chkxer(
'SGETRF', infot, nout, lerr, ok )
150 CALL sgetf2( -1, 0, a, 1, ip, info )
151 CALL chkxer(
'SGETF2', infot, nout, lerr, ok )
153 CALL sgetf2( 0, -1, a, 1, ip, info )
154 CALL chkxer(
'SGETF2', infot, nout, lerr, ok )
156 CALL sgetf2( 2, 1, a, 1, ip, info )
157 CALL chkxer(
'SGETF2', infot, nout, lerr, ok )
163 CALL sgetri( -1, a, 1, ip, w, lw, info )
164 CALL chkxer(
'SGETRI', infot, nout, lerr, ok )
166 CALL sgetri( 2, a, 1, ip, w, lw, info )
167 CALL chkxer(
'SGETRI', infot, nout, lerr, ok )
173 CALL sgetrs(
'/', 0, 0, a, 1, ip, b, 1, info )
174 CALL chkxer(
'SGETRS', infot, nout, lerr, ok )
176 CALL sgetrs(
'N', -1, 0, a, 1, ip, b, 1, info )
177 CALL chkxer(
'SGETRS', infot, nout, lerr, ok )
179 CALL sgetrs(
'N', 0, -1, a, 1, ip, b, 1, info )
180 CALL chkxer(
'SGETRS', infot, nout, lerr, ok )
182 CALL sgetrs(
'N', 2, 1, a, 1, ip, b, 2, info )
183 CALL chkxer(
'SGETRS', infot, nout, lerr, ok )
185 CALL sgetrs(
'N', 2, 1, a, 2, ip, b, 1, info )
186 CALL chkxer(
'SGETRS', infot, nout, lerr, ok )
192 CALL sgerfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
194 CALL chkxer(
'SGERFS', infot, nout, lerr, ok )
196 CALL sgerfs(
'N', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
198 CALL chkxer(
'SGERFS', infot, nout, lerr, ok )
200 CALL sgerfs(
'N', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
202 CALL chkxer(
'SGERFS', infot, nout, lerr, ok )
204 CALL sgerfs(
'N', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
206 CALL chkxer(
'SGERFS', infot, nout, lerr, ok )
208 CALL sgerfs(
'N', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
210 CALL chkxer(
'SGERFS', infot, nout, lerr, ok )
212 CALL sgerfs(
'N', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
214 CALL chkxer(
'SGERFS', infot, nout, lerr, ok )
216 CALL sgerfs(
'N', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
218 CALL chkxer(
'SGERFS', infot, nout, lerr, ok )
224 CALL sgecon(
'/', 0, a, 1, anrm, rcond, w, iw, info )
225 CALL chkxer(
'SGECON', infot, nout, lerr, ok )
227 CALL sgecon(
'1', -1, a, 1, anrm, rcond, w, iw, info )
228 CALL chkxer(
'SGECON', infot, nout, lerr, ok )
230 CALL sgecon(
'1', 2, a, 1, anrm, rcond, w, iw, info )
231 CALL chkxer(
'SGECON', infot, nout, lerr, ok )
237 CALL sgeequ( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
238 CALL chkxer(
'SGEEQU', infot, nout, lerr, ok )
240 CALL sgeequ( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
241 CALL chkxer(
'SGEEQU', infot, nout, lerr, ok )
243 CALL sgeequ( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
244 CALL chkxer(
'SGEEQU', infot, nout, lerr, ok )
246 ELSE IF(
lsamen( 2, c2,
'GB' ) )
THEN
255 CALL sgbtrf( -1, 0, 0, 0, a, 1, ip, info )
256 CALL chkxer(
'SGBTRF', infot, nout, lerr, ok )
258 CALL sgbtrf( 0, -1, 0, 0, a, 1, ip, info )
259 CALL chkxer(
'SGBTRF', infot, nout, lerr, ok )
261 CALL sgbtrf( 1, 1, -1, 0, a, 1, ip, info )
262 CALL chkxer(
'SGBTRF', infot, nout, lerr, ok )
264 CALL sgbtrf( 1, 1, 0, -1, a, 1, ip, info )
265 CALL chkxer(
'SGBTRF', infot, nout, lerr, ok )
267 CALL sgbtrf( 2, 2, 1, 1, a, 3, ip, info )
268 CALL chkxer(
'SGBTRF', infot, nout, lerr, ok )
274 CALL sgbtf2( -1, 0, 0, 0, a, 1, ip, info )
275 CALL chkxer(
'SGBTF2', infot, nout, lerr, ok )
277 CALL sgbtf2( 0, -1, 0, 0, a, 1, ip, info )
278 CALL chkxer(
'SGBTF2', infot, nout, lerr, ok )
280 CALL sgbtf2( 1, 1, -1, 0, a, 1, ip, info )
281 CALL chkxer(
'SGBTF2', infot, nout, lerr, ok )
283 CALL sgbtf2( 1, 1, 0, -1, a, 1, ip, info )
284 CALL chkxer(
'SGBTF2', infot, nout, lerr, ok )
286 CALL sgbtf2( 2, 2, 1, 1, a, 3, ip, info )
287 CALL chkxer(
'SGBTF2', infot, nout, lerr, ok )
293 CALL sgbtrs(
'/', 0, 0, 0, 1, a, 1, ip, b, 1, info )
294 CALL chkxer(
'SGBTRS', infot, nout, lerr, ok )
296 CALL sgbtrs(
'N', -1, 0, 0, 1, a, 1, ip, b, 1, info )
297 CALL chkxer(
'SGBTRS', infot, nout, lerr, ok )
299 CALL sgbtrs(
'N', 1, -1, 0, 1, a, 1, ip, b, 1, info )
300 CALL chkxer(
'SGBTRS', infot, nout, lerr, ok )
302 CALL sgbtrs(
'N', 1, 0, -1, 1, a, 1, ip, b, 1, info )
303 CALL chkxer(
'SGBTRS', infot, nout, lerr, ok )
305 CALL sgbtrs(
'N', 1, 0, 0, -1, a, 1, ip, b, 1, info )
306 CALL chkxer(
'SGBTRS', infot, nout, lerr, ok )
308 CALL sgbtrs(
'N', 2, 1, 1, 1, a, 3, ip, b, 2, info )
309 CALL chkxer(
'SGBTRS', infot, nout, lerr, ok )
311 CALL sgbtrs(
'N', 2, 0, 0, 1, a, 1, ip, b, 1, info )
312 CALL chkxer(
'SGBTRS', infot, nout, lerr, ok )
318 CALL sgbrfs(
'/', 0, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
320 CALL chkxer(
'SGBRFS', infot, nout, lerr, ok )
322 CALL sgbrfs(
'N', -1, 0, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
324 CALL chkxer(
'SGBRFS', infot, nout, lerr, ok )
326 CALL sgbrfs(
'N', 1, -1, 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
328 CALL chkxer(
'SGBRFS', infot, nout, lerr, ok )
330 CALL sgbrfs(
'N', 1, 0, -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1,
332 CALL chkxer(
'SGBRFS', infot, nout, lerr, ok )
334 CALL sgbrfs(
'N', 1, 0, 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1,
336 CALL chkxer(
'SGBRFS', infot, nout, lerr, ok )
338 CALL sgbrfs(
'N', 2, 1, 1, 1, a, 2, af, 4, ip, b, 2, x, 2, r1,
340 CALL chkxer(
'SGBRFS', infot, nout, lerr, ok )
342 CALL sgbrfs(
'N', 2, 1, 1, 1, a, 3, af, 3, ip, b, 2, x, 2, r1,
344 CALL chkxer(
'SGBRFS', infot, nout, lerr, ok )
346 CALL sgbrfs(
'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 1, x, 2, r1,
348 CALL chkxer(
'SGBRFS', infot, nout, lerr, ok )
350 CALL sgbrfs(
'N', 2, 0, 0, 1, a, 1, af, 1, ip, b, 2, x, 1, r1,
352 CALL chkxer(
'SGBRFS', infot, nout, lerr, ok )
358 CALL sgbcon(
'/', 0, 0, 0, a, 1, ip, anrm, rcond, w, iw, info )
359 CALL chkxer(
'SGBCON', infot, nout, lerr, ok )
361 CALL sgbcon(
'1', -1, 0, 0, a, 1, ip, anrm, rcond, w, iw,
363 CALL chkxer(
'SGBCON', infot, nout, lerr, ok )
365 CALL sgbcon(
'1', 1, -1, 0, a, 1, ip, anrm, rcond, w, iw,
367 CALL chkxer(
'SGBCON', infot, nout, lerr, ok )
369 CALL sgbcon(
'1', 1, 0, -1, a, 1, ip, anrm, rcond, w, iw,
371 CALL chkxer(
'SGBCON', infot, nout, lerr, ok )
373 CALL sgbcon(
'1', 2, 1, 1, a, 3, ip, anrm, rcond, w, iw, info )
374 CALL chkxer(
'SGBCON', infot, nout, lerr, ok )
380 CALL sgbequ( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
382 CALL chkxer(
'SGBEQU', infot, nout, lerr, ok )
384 CALL sgbequ( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
386 CALL chkxer(
'SGBEQU', infot, nout, lerr, ok )
388 CALL sgbequ( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
390 CALL chkxer(
'SGBEQU', infot, nout, lerr, ok )
392 CALL sgbequ( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
394 CALL chkxer(
'SGBEQU', infot, nout, lerr, ok )
396 CALL sgbequ( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
398 CALL chkxer(
'SGBEQU', infot, nout, lerr, ok )
403 CALL alaesm( path, ok, nout )
subroutine sgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SGETRS
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine sgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
SGECON
subroutine sgetf2(M, N, A, LDA, IPIV, INFO)
SGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row inter...
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine sgetrf(M, N, A, LDA, IPIV, INFO)
SGETRF
subroutine sgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SGBCON
logical function lsamen(N, CA, CB)
LSAMEN
subroutine sgbtf2(M, N, KL, KU, AB, LDAB, IPIV, INFO)
SGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algo...
subroutine sgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
SGBEQU
subroutine sgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SGERFS
subroutine sgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
SGEEQU
subroutine sgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
SGBTRS
subroutine sgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
SGETRI
subroutine sgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SGBRFS
subroutine sgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
SGBTRF