72 parameter ( nmax = 4 )
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 zgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZGETRS
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 zgbtrs(TRANS, N, KL, KU, NRHS, AB, LDAB, IPIV, B, LDB, INFO)
ZGBTRS
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 zgbcon(NORM, N, KL, KU, AB, LDAB, IPIV, ANORM, RCOND, WORK, RWORK, INFO)
ZGBCON
subroutine zgbrfs(TRANS, N, KL, KU, NRHS, AB, LDAB, AFB, LDAFB, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGBRFS
subroutine zgbequ(M, N, KL, KU, AB, LDAB, R, C, ROWCND, COLCND, AMAX, INFO)
ZGBEQU
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine zgbtrf(M, N, KL, KU, AB, LDAB, IPIV, INFO)
ZGBTRF
subroutine zgecon(NORM, N, A, LDA, ANORM, RCOND, WORK, RWORK, INFO)
ZGECON
subroutine zgetri(N, A, LDA, IPIV, WORK, LWORK, INFO)
ZGETRI
subroutine zgerfs(TRANS, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZGERFS
subroutine zgeequ(M, N, A, LDA, R, C, ROWCND, COLCND, AMAX, INFO)
ZGEEQU
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...