77 DOUBLE PRECISION anrm, ccond, rcond
81 DOUBLE PRECISION r( nmax ), r1( nmax ), r2( nmax )
82 COMPLEX*16 a( nmax, nmax ), af( nmax, nmax ),
b( nmax ),
83 $ w( 2*nmax ),
x( nmax )
100 COMMON / infoc / infot, nout, ok, lerr
101 COMMON / srnamc / srnamt
104 INTRINSIC dble, dcmplx
109 WRITE( nout, fmt = * )
116 a( i,
j ) = dcmplx( 1.d0 / dble( i+
j ),
117 $ -1.d0 / dble( i+
j ) )
118 af( i,
j ) = dcmplx( 1.d0 / dble( i+
j ),
119 $ -1.d0 / dble( i+
j ) )
133 IF(
lsamen( 2, c2,
'GE' ) )
THEN
139 CALL
zgetrf( -1, 0, a, 1, ip, info )
140 CALL
chkxer(
'ZGETRF', infot, nout, lerr, ok )
142 CALL
zgetrf( 0, -1, a, 1, ip, info )
143 CALL
chkxer(
'ZGETRF', infot, nout, lerr, ok )
145 CALL
zgetrf( 2, 1, a, 1, ip, info )
146 CALL
chkxer(
'ZGETRF', infot, nout, lerr, ok )
152 CALL
zgetf2( -1, 0, a, 1, ip, info )
153 CALL
chkxer(
'ZGETF2', infot, nout, lerr, ok )
155 CALL
zgetf2( 0, -1, a, 1, ip, info )
156 CALL
chkxer(
'ZGETF2', infot, nout, lerr, ok )
158 CALL
zgetf2( 2, 1, a, 1, ip, info )
159 CALL
chkxer(
'ZGETF2', infot, nout, lerr, ok )
165 CALL
zgetri( -1, a, 1, ip, w, 1, info )
166 CALL
chkxer(
'ZGETRI', infot, nout, lerr, ok )
168 CALL
zgetri( 2, a, 1, ip, w, 2, info )
169 CALL
chkxer(
'ZGETRI', infot, nout, lerr, ok )
171 CALL
zgetri( 2, a, 2, ip, w, 1, info )
172 CALL
chkxer(
'ZGETRI', infot, nout, lerr, ok )
178 CALL
zgetrs(
'/', 0, 0, a, 1, ip,
b, 1, info )
179 CALL
chkxer(
'ZGETRS', infot, nout, lerr, ok )
181 CALL
zgetrs(
'N', -1, 0, a, 1, ip,
b, 1, info )
182 CALL
chkxer(
'ZGETRS', infot, nout, lerr, ok )
184 CALL
zgetrs(
'N', 0, -1, a, 1, ip,
b, 1, info )
185 CALL
chkxer(
'ZGETRS', infot, nout, lerr, ok )
187 CALL
zgetrs(
'N', 2, 1, a, 1, ip,
b, 2, info )
188 CALL
chkxer(
'ZGETRS', infot, nout, lerr, ok )
190 CALL
zgetrs(
'N', 2, 1, a, 2, ip,
b, 1, info )
191 CALL
chkxer(
'ZGETRS', infot, nout, lerr, ok )
197 CALL
zgerfs(
'/', 0, 0, a, 1, af, 1, ip,
b, 1,
x, 1, r1, r2, w,
199 CALL
chkxer(
'ZGERFS', infot, nout, lerr, ok )
201 CALL
zgerfs(
'N', -1, 0, a, 1, af, 1, ip,
b, 1,
x, 1, r1, r2,
203 CALL
chkxer(
'ZGERFS', infot, nout, lerr, ok )
205 CALL
zgerfs(
'N', 0, -1, a, 1, af, 1, ip,
b, 1,
x, 1, r1, r2,
207 CALL
chkxer(
'ZGERFS', infot, nout, lerr, ok )
209 CALL
zgerfs(
'N', 2, 1, a, 1, af, 2, ip,
b, 2,
x, 2, r1, r2, w,
211 CALL
chkxer(
'ZGERFS', infot, nout, lerr, ok )
213 CALL
zgerfs(
'N', 2, 1, a, 2, af, 1, ip,
b, 2,
x, 2, r1, r2, w,
215 CALL
chkxer(
'ZGERFS', infot, nout, lerr, ok )
217 CALL
zgerfs(
'N', 2, 1, a, 2, af, 2, ip,
b, 1,
x, 2, r1, r2, w,
219 CALL
chkxer(
'ZGERFS', infot, nout, lerr, ok )
221 CALL
zgerfs(
'N', 2, 1, a, 2, af, 2, ip,
b, 2,
x, 1, r1, r2, w,
223 CALL
chkxer(
'ZGERFS', infot, nout, lerr, ok )
229 CALL
zgecon(
'/', 0, a, 1, anrm, rcond, w, r, info )
230 CALL
chkxer(
'ZGECON', infot, nout, lerr, ok )
232 CALL
zgecon(
'1', -1, a, 1, anrm, rcond, w, r, info )
233 CALL
chkxer(
'ZGECON', infot, nout, lerr, ok )
235 CALL
zgecon(
'1', 2, a, 1, anrm, rcond, w, r, info )
236 CALL
chkxer(
'ZGECON', infot, nout, lerr, ok )
242 CALL
zgeequ( -1, 0, a, 1, r1, r2, rcond, ccond, anrm, info )
243 CALL
chkxer(
'ZGEEQU', infot, nout, lerr, ok )
245 CALL
zgeequ( 0, -1, a, 1, r1, r2, rcond, ccond, anrm, info )
246 CALL
chkxer(
'ZGEEQU', infot, nout, lerr, ok )
248 CALL
zgeequ( 2, 2, a, 1, r1, r2, rcond, ccond, anrm, info )
249 CALL
chkxer(
'ZGEEQU', infot, nout, lerr, ok )
254 ELSE IF(
lsamen( 2, c2,
'GB' ) )
THEN
260 CALL
zgbtrf( -1, 0, 0, 0, a, 1, ip, info )
261 CALL
chkxer(
'ZGBTRF', infot, nout, lerr, ok )
263 CALL
zgbtrf( 0, -1, 0, 0, a, 1, ip, info )
264 CALL
chkxer(
'ZGBTRF', infot, nout, lerr, ok )
266 CALL
zgbtrf( 1, 1, -1, 0, a, 1, ip, info )
267 CALL
chkxer(
'ZGBTRF', infot, nout, lerr, ok )
269 CALL
zgbtrf( 1, 1, 0, -1, a, 1, ip, info )
270 CALL
chkxer(
'ZGBTRF', infot, nout, lerr, ok )
272 CALL
zgbtrf( 2, 2, 1, 1, a, 3, ip, info )
273 CALL
chkxer(
'ZGBTRF', infot, nout, lerr, ok )
279 CALL
zgbtf2( -1, 0, 0, 0, a, 1, ip, info )
280 CALL
chkxer(
'ZGBTF2', infot, nout, lerr, ok )
282 CALL
zgbtf2( 0, -1, 0, 0, a, 1, ip, info )
283 CALL
chkxer(
'ZGBTF2', infot, nout, lerr, ok )
285 CALL
zgbtf2( 1, 1, -1, 0, a, 1, ip, info )
286 CALL
chkxer(
'ZGBTF2', infot, nout, lerr, ok )
288 CALL
zgbtf2( 1, 1, 0, -1, a, 1, ip, info )
289 CALL
chkxer(
'ZGBTF2', infot, nout, lerr, ok )
291 CALL
zgbtf2( 2, 2, 1, 1, a, 3, ip, info )
292 CALL
chkxer(
'ZGBTF2', infot, nout, lerr, ok )
298 CALL
zgbtrs(
'/', 0, 0, 0, 1, a, 1, ip,
b, 1, info )
299 CALL
chkxer(
'ZGBTRS', infot, nout, lerr, ok )
301 CALL
zgbtrs(
'N', -1, 0, 0, 1, a, 1, ip,
b, 1, info )
302 CALL
chkxer(
'ZGBTRS', infot, nout, lerr, ok )
304 CALL
zgbtrs(
'N', 1, -1, 0, 1, a, 1, ip,
b, 1, info )
305 CALL
chkxer(
'ZGBTRS', infot, nout, lerr, ok )
307 CALL
zgbtrs(
'N', 1, 0, -1, 1, a, 1, ip,
b, 1, info )
308 CALL
chkxer(
'ZGBTRS', infot, nout, lerr, ok )
310 CALL
zgbtrs(
'N', 1, 0, 0, -1, a, 1, ip,
b, 1, info )
311 CALL
chkxer(
'ZGBTRS', infot, nout, lerr, ok )
313 CALL
zgbtrs(
'N', 2, 1, 1, 1, a, 3, ip,
b, 2, info )
314 CALL
chkxer(
'ZGBTRS', infot, nout, lerr, ok )
316 CALL
zgbtrs(
'N', 2, 0, 0, 1, a, 1, ip,
b, 1, info )
317 CALL
chkxer(
'ZGBTRS', infot, nout, lerr, ok )
323 CALL
zgbrfs(
'/', 0, 0, 0, 0, a, 1, af, 1, ip,
b, 1,
x, 1, r1,
325 CALL
chkxer(
'ZGBRFS', infot, nout, lerr, ok )
327 CALL
zgbrfs(
'N', -1, 0, 0, 0, a, 1, af, 1, ip,
b, 1,
x, 1, r1,
329 CALL
chkxer(
'ZGBRFS', infot, nout, lerr, ok )
331 CALL
zgbrfs(
'N', 1, -1, 0, 0, a, 1, af, 1, ip,
b, 1,
x, 1, r1,
333 CALL
chkxer(
'ZGBRFS', infot, nout, lerr, ok )
335 CALL
zgbrfs(
'N', 1, 0, -1, 0, a, 1, af, 1, ip,
b, 1,
x, 1, r1,
337 CALL
chkxer(
'ZGBRFS', infot, nout, lerr, ok )
339 CALL
zgbrfs(
'N', 1, 0, 0, -1, a, 1, af, 1, ip,
b, 1,
x, 1, r1,
341 CALL
chkxer(
'ZGBRFS', infot, nout, lerr, ok )
343 CALL
zgbrfs(
'N', 2, 1, 1, 1, a, 2, af, 4, ip,
b, 2,
x, 2, r1,
345 CALL
chkxer(
'ZGBRFS', infot, nout, lerr, ok )
347 CALL
zgbrfs(
'N', 2, 1, 1, 1, a, 3, af, 3, ip,
b, 2,
x, 2, r1,
349 CALL
chkxer(
'ZGBRFS', infot, nout, lerr, ok )
351 CALL
zgbrfs(
'N', 2, 0, 0, 1, a, 1, af, 1, ip,
b, 1,
x, 2, r1,
353 CALL
chkxer(
'ZGBRFS', infot, nout, lerr, ok )
355 CALL
zgbrfs(
'N', 2, 0, 0, 1, a, 1, af, 1, ip,
b, 2,
x, 1, r1,
357 CALL
chkxer(
'ZGBRFS', infot, nout, lerr, ok )
363 CALL
zgbcon(
'/', 0, 0, 0, a, 1, ip, anrm, rcond, w, r, info )
364 CALL
chkxer(
'ZGBCON', infot, nout, lerr, ok )
366 CALL
zgbcon(
'1', -1, 0, 0, a, 1, ip, anrm, rcond, w, r, info )
367 CALL
chkxer(
'ZGBCON', infot, nout, lerr, ok )
369 CALL
zgbcon(
'1', 1, -1, 0, a, 1, ip, anrm, rcond, w, r, info )
370 CALL
chkxer(
'ZGBCON', infot, nout, lerr, ok )
372 CALL
zgbcon(
'1', 1, 0, -1, a, 1, ip, anrm, rcond, w, r, info )
373 CALL
chkxer(
'ZGBCON', infot, nout, lerr, ok )
375 CALL
zgbcon(
'1', 2, 1, 1, a, 3, ip, anrm, rcond, w, r, info )
376 CALL
chkxer(
'ZGBCON', infot, nout, lerr, ok )
382 CALL
zgbequ( -1, 0, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
384 CALL
chkxer(
'ZGBEQU', infot, nout, lerr, ok )
386 CALL
zgbequ( 0, -1, 0, 0, a, 1, r1, r2, rcond, ccond, anrm,
388 CALL
chkxer(
'ZGBEQU', infot, nout, lerr, ok )
390 CALL
zgbequ( 1, 1, -1, 0, a, 1, r1, r2, rcond, ccond, anrm,
392 CALL
chkxer(
'ZGBEQU', infot, nout, lerr, ok )
394 CALL
zgbequ( 1, 1, 0, -1, a, 1, r1, r2, rcond, ccond, anrm,
396 CALL
chkxer(
'ZGBEQU', infot, nout, lerr, ok )
398 CALL
zgbequ( 2, 2, 1, 1, a, 2, r1, r2, rcond, ccond, anrm,
400 CALL
chkxer(
'ZGBEQU', infot, nout, lerr, ok )
405 CALL
alaesm( path, ok, nout )
subroutine zgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGBRFS
subroutine zgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
ZGECON
subroutine zgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
ZGEEQU
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine zgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGERFS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zgbtf2(M, N, KL, KU, AB, LDAB, IPIV, INFO)
ZGBTF2 computes the LU factorization of a general band matrix using the unblocked version of the algo...
subroutine zgetf2(M, N, A, LDA, IPIV, INFO)
ZGETF2 computes the LU factorization of a general m-by-n matrix using partial pivoting with row inter...
subroutine zgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, RWORK, INFO)
ZGBCON
subroutine zgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
ZGETRI
subroutine zgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
ZGBTRS
subroutine zerrge(PATH, NUNIT)
ZERRGE
subroutine zgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
ZGBEQU
subroutine zgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZGETRS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
LOGICAL function lsamen(N, CA, CB)
LSAMEN
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine zgetrf(M, N, A, LDA, IPIV, INFO)
ZGETRF VARIANT: Crout Level 3 BLAS version of the algorithm.
subroutine zgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
ZGBTRF