72 parameter( nmax = 4, lw = 3*nmax )
77 DOUBLE PRECISION anrm, ccond, rcond
80 INTEGER ip( nmax ), iw( nmax )
81 DOUBLE PRECISION 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.d0 / dble( i+
j )
116 af( i,
j ) = 1.d0 / dble( i+
j )
128 IF(
lsamen( 2, c2,
'GE' ) )
THEN
137 CALL
dgetrf( -1, 0, a, 1, ip, info )
138 CALL
chkxer(
'DGETRF', infot, nout, lerr, ok )
140 CALL
dgetrf( 0, -1, a, 1, ip, info )
141 CALL
chkxer(
'DGETRF', infot, nout, lerr, ok )
143 CALL
dgetrf( 2, 1, a, 1, ip, info )
144 CALL
chkxer(
'DGETRF', infot, nout, lerr, ok )
150 CALL
dgetf2( -1, 0, a, 1, ip, info )
151 CALL
chkxer(
'DGETF2', infot, nout, lerr, ok )
153 CALL
dgetf2( 0, -1, a, 1, ip, info )
154 CALL
chkxer(
'DGETF2', infot, nout, lerr, ok )
156 CALL
dgetf2( 2, 1, a, 1, ip, info )
157 CALL
chkxer(
'DGETF2', infot, nout, lerr, ok )
163 CALL
dgetri( -1, a, 1, ip, w, lw, info )
164 CALL
chkxer(
'DGETRI', infot, nout, lerr, ok )
166 CALL
dgetri( 2, a, 1, ip, w, lw, info )
167 CALL
chkxer(
'DGETRI', infot, nout, lerr, ok )
173 CALL
dgetrs(
'/', 0, 0, a, 1, ip,
b, 1, info )
174 CALL
chkxer(
'DGETRS', infot, nout, lerr, ok )
176 CALL
dgetrs(
'N', -1, 0, a, 1, ip,
b, 1, info )
177 CALL
chkxer(
'DGETRS', infot, nout, lerr, ok )
179 CALL
dgetrs(
'N', 0, -1, a, 1, ip,
b, 1, info )
180 CALL
chkxer(
'DGETRS', infot, nout, lerr, ok )
182 CALL
dgetrs(
'N', 2, 1, a, 1, ip,
b, 2, info )
183 CALL
chkxer(
'DGETRS', infot, nout, lerr, ok )
185 CALL
dgetrs(
'N', 2, 1, a, 2, ip,
b, 1, info )
186 CALL
chkxer(
'DGETRS', infot, nout, lerr, ok )
192 CALL
dgerfs(
'/', 0, 0, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2, w,
194 CALL
chkxer(
'DGERFS', infot, nout, lerr, ok )
196 CALL
dgerfs(
'N', -1, 0, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2,
198 CALL
chkxer(
'DGERFS', infot, nout, lerr, ok )
200 CALL
dgerfs(
'N', 0, -1, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2,
202 CALL
chkxer(
'DGERFS', infot, nout, lerr, ok )
204 CALL
dgerfs(
'N', 2, 1, a, 1, af, 2, ip,
b, 2, x, 2, r1, r2, w,
206 CALL
chkxer(
'DGERFS', infot, nout, lerr, ok )
208 CALL
dgerfs(
'N', 2, 1, a, 2, af, 1, ip,
b, 2, x, 2, r1, r2, w,
210 CALL
chkxer(
'DGERFS', infot, nout, lerr, ok )
212 CALL
dgerfs(
'N', 2, 1, a, 2, af, 2, ip,
b, 1, x, 2, r1, r2, w,
214 CALL
chkxer(
'DGERFS', infot, nout, lerr, ok )
216 CALL
dgerfs(
'N', 2, 1, a, 2, af, 2, ip,
b, 2, x, 1, r1, r2, w,
218 CALL
chkxer(
'DGERFS', infot, nout, lerr, ok )
224 CALL
dgecon(
'/', 0, a, 1, anrm, rcond, w, iw, info )
225 CALL
chkxer(
'DGECON', infot, nout, lerr, ok )
227 CALL
dgecon(
'1', -1, a, 1, anrm, rcond, w, iw, info )
228 CALL
chkxer(
'DGECON', infot, nout, lerr, ok )
230 CALL
dgecon(
'1', 2, a, 1, anrm, rcond, w, iw, info )
231 CALL
chkxer(
'DGECON', infot, nout, lerr, ok )
237 CALL
dgeequ( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
238 CALL
chkxer(
'DGEEQU', infot, nout, lerr, ok )
240 CALL
dgeequ( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
241 CALL
chkxer(
'DGEEQU', infot, nout, lerr, ok )
243 CALL
dgeequ( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
244 CALL
chkxer(
'DGEEQU', infot, nout, lerr, ok )
246 ELSE IF(
lsamen( 2, c2,
'GB' ) )
THEN
255 CALL
dgbtrf( -1, 0, 0, 0, a, 1, ip, info )
256 CALL
chkxer(
'DGBTRF', infot, nout, lerr, ok )
258 CALL
dgbtrf( 0, -1, 0, 0, a, 1, ip, info )
259 CALL
chkxer(
'DGBTRF', infot, nout, lerr, ok )
261 CALL
dgbtrf( 1, 1, -1, 0, a, 1, ip, info )
262 CALL
chkxer(
'DGBTRF', infot, nout, lerr, ok )
264 CALL
dgbtrf( 1, 1, 0, -1, a, 1, ip, info )
265 CALL
chkxer(
'DGBTRF', infot, nout, lerr, ok )
267 CALL
dgbtrf( 2, 2, 1, 1, a, 3, ip, info )
268 CALL
chkxer(
'DGBTRF', infot, nout, lerr, ok )
274 CALL
dgbtf2( -1, 0, 0, 0, a, 1, ip, info )
275 CALL
chkxer(
'DGBTF2', infot, nout, lerr, ok )
277 CALL
dgbtf2( 0, -1, 0, 0, a, 1, ip, info )
278 CALL
chkxer(
'DGBTF2', infot, nout, lerr, ok )
280 CALL
dgbtf2( 1, 1, -1, 0, a, 1, ip, info )
281 CALL
chkxer(
'DGBTF2', infot, nout, lerr, ok )
283 CALL
dgbtf2( 1, 1, 0, -1, a, 1, ip, info )
284 CALL
chkxer(
'DGBTF2', infot, nout, lerr, ok )
286 CALL
dgbtf2( 2, 2, 1, 1, a, 3, ip, info )
287 CALL
chkxer(
'DGBTF2', infot, nout, lerr, ok )
293 CALL
dgbtrs(
'/', 0, 0, 0, 1, a, 1, ip,
b, 1, info )
294 CALL
chkxer(
'DGBTRS', infot, nout, lerr, ok )
296 CALL
dgbtrs(
'N', -1, 0, 0, 1, a, 1, ip,
b, 1, info )
297 CALL
chkxer(
'DGBTRS', infot, nout, lerr, ok )
299 CALL
dgbtrs(
'N', 1, -1, 0, 1, a, 1, ip,
b, 1, info )
300 CALL
chkxer(
'DGBTRS', infot, nout, lerr, ok )
302 CALL
dgbtrs(
'N', 1, 0, -1, 1, a, 1, ip,
b, 1, info )
303 CALL
chkxer(
'DGBTRS', infot, nout, lerr, ok )
305 CALL
dgbtrs(
'N', 1, 0, 0, -1, a, 1, ip,
b, 1, info )
306 CALL
chkxer(
'DGBTRS', infot, nout, lerr, ok )
308 CALL
dgbtrs(
'N', 2, 1, 1, 1, a, 3, ip,
b, 2, info )
309 CALL
chkxer(
'DGBTRS', infot, nout, lerr, ok )
311 CALL
dgbtrs(
'N', 2, 0, 0, 1, a, 1, ip,
b, 1, info )
312 CALL
chkxer(
'DGBTRS', infot, nout, lerr, ok )
318 CALL
dgbrfs(
'/', 0, 0, 0, 0, a, 1, af, 1, ip,
b, 1, x, 1, r1,
320 CALL
chkxer(
'DGBRFS', infot, nout, lerr, ok )
322 CALL
dgbrfs(
'N', -1, 0, 0, 0, a, 1, af, 1, ip,
b, 1, x, 1, r1,
324 CALL
chkxer(
'DGBRFS', infot, nout, lerr, ok )
326 CALL
dgbrfs(
'N', 1, -1, 0, 0, a, 1, af, 1, ip,
b, 1, x, 1, r1,
328 CALL
chkxer(
'DGBRFS', infot, nout, lerr, ok )
330 CALL
dgbrfs(
'N', 1, 0, -1, 0, a, 1, af, 1, ip,
b, 1, x, 1, r1,
332 CALL
chkxer(
'DGBRFS', infot, nout, lerr, ok )
334 CALL
dgbrfs(
'N', 1, 0, 0, -1, a, 1, af, 1, ip,
b, 1, x, 1, r1,
336 CALL
chkxer(
'DGBRFS', infot, nout, lerr, ok )
338 CALL
dgbrfs(
'N', 2, 1, 1, 1, a, 2, af, 4, ip,
b, 2, x, 2, r1,
340 CALL
chkxer(
'DGBRFS', infot, nout, lerr, ok )
342 CALL
dgbrfs(
'N', 2, 1, 1, 1, a, 3, af, 3, ip,
b, 2, x, 2, r1,
344 CALL
chkxer(
'DGBRFS', infot, nout, lerr, ok )
346 CALL
dgbrfs(
'N', 2, 0, 0, 1, a, 1, af, 1, ip,
b, 1, x, 2, r1,
348 CALL
chkxer(
'DGBRFS', infot, nout, lerr, ok )
350 CALL
dgbrfs(
'N', 2, 0, 0, 1, a, 1, af, 1, ip,
b, 2, x, 1, r1,
352 CALL
chkxer(
'DGBRFS', infot, nout, lerr, ok )
358 CALL
dgbcon(
'/', 0, 0, 0, a, 1, ip, anrm, rcond, w, iw, info )
359 CALL
chkxer(
'DGBCON', infot, nout, lerr, ok )
361 CALL
dgbcon(
'1', -1, 0, 0, a, 1, ip, anrm, rcond, w, iw,
363 CALL
chkxer(
'DGBCON', infot, nout, lerr, ok )
365 CALL
dgbcon(
'1', 1, -1, 0, a, 1, ip, anrm, rcond, w, iw,
367 CALL
chkxer(
'DGBCON', infot, nout, lerr, ok )
369 CALL
dgbcon(
'1', 1, 0, -1, a, 1, ip, anrm, rcond, w, iw,
371 CALL
chkxer(
'DGBCON', infot, nout, lerr, ok )
373 CALL
dgbcon(
'1', 2, 1, 1, a, 3, ip, anrm, rcond, w, iw, info )
374 CALL
chkxer(
'DGBCON', infot, nout, lerr, ok )
380 CALL
dgbequ( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
382 CALL
chkxer(
'DGBEQU', infot, nout, lerr, ok )
384 CALL
dgbequ( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
386 CALL
chkxer(
'DGBEQU', infot, nout, lerr, ok )
388 CALL
dgbequ( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
390 CALL
chkxer(
'DGBEQU', infot, nout, lerr, ok )
392 CALL
dgbequ( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
394 CALL
chkxer(
'DGBEQU', infot, nout, lerr, ok )
396 CALL
dgbequ( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
398 CALL
chkxer(
'DGBEQU', infot, nout, lerr, ok )
403 CALL
alaesm( path, ok, nout )
subroutine dgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
DGETRI
subroutine dgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
DGECON
subroutine dgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DGERFS
subroutine dgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DGETRS
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine dgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
DGEEQU
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine dgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
DGBTRF
subroutine dgetf2(M, N, A, LDA, IPIV, INFO)
DGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row inter...
logical function lsamen(N, CA, CB)
LSAMEN
subroutine dgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
DGBTRS
subroutine dgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
DGBEQU
subroutine dgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DGBCON
subroutine dgbtf2(M, N, KL, KU, AB, LDAB, IPIV, INFO)
DGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algo...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine derrge(PATH, NUNIT)
DERRGE
subroutine dgetrf(M, N, A, LDA, IPIV, INFO)
DGETRF
subroutine dgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DGBRFS