81 INTEGER i, info,
j, n_err_bnds, nparams
82 DOUBLE PRECISION anrm, rcond, berr
86 DOUBLE PRECISION r( nmax ), r1( nmax ), r2( nmax ),
87 $ s( nmax ), err_bnds_n( nmax, 3 ),
88 $ err_bnds_c( nmax, 3 ), params( 1 )
89 COMPLEX*16 a( nmax, nmax ), af( nmax, nmax ),
b( nmax ),
90 $ w( 2*nmax ),
x( nmax )
109 COMMON / infoc / infot, nout, ok, lerr
110 COMMON / srnamc / srnamt
113 INTRINSIC dble, dcmplx
118 WRITE( nout, fmt = * )
125 a( i,
j ) = dcmplx( 1.d0 / dble( i+
j ),
126 $ -1.d0 / dble( i+
j ) )
127 af( i,
j ) = dcmplx( 1.d0 / dble( i+
j ),
128 $ -1.d0 / dble( i+
j ) )
145 IF(
lsamen( 2, c2,
'HE' ) )
THEN
151 CALL
zhetrf(
'/', 0, a, 1, ip, w, 1, info )
152 CALL
chkxer(
'ZHETRF', infot, nout, lerr, ok )
154 CALL
zhetrf(
'U', -1, a, 1, ip, w, 1, info )
155 CALL
chkxer(
'ZHETRF', infot, nout, lerr, ok )
157 CALL
zhetrf(
'U', 2, a, 1, ip, w, 4, info )
158 CALL
chkxer(
'ZHETRF', infot, nout, lerr, ok )
164 CALL
zhetf2(
'/', 0, a, 1, ip, info )
165 CALL
chkxer(
'ZHETF2', infot, nout, lerr, ok )
167 CALL
zhetf2(
'U', -1, a, 1, ip, info )
168 CALL
chkxer(
'ZHETF2', infot, nout, lerr, ok )
170 CALL
zhetf2(
'U', 2, a, 1, ip, info )
171 CALL
chkxer(
'ZHETF2', infot, nout, lerr, ok )
177 CALL
zhetri(
'/', 0, a, 1, ip, w, info )
178 CALL
chkxer(
'ZHETRI', infot, nout, lerr, ok )
180 CALL
zhetri(
'U', -1, a, 1, ip, w, info )
181 CALL
chkxer(
'ZHETRI', infot, nout, lerr, ok )
183 CALL
zhetri(
'U', 2, a, 1, ip, w, info )
184 CALL
chkxer(
'ZHETRI', infot, nout, lerr, ok )
190 CALL
zhetri2(
'/', 0, a, 1, ip, w, 1, info )
191 CALL
chkxer(
'ZHETRI2', infot, nout, lerr, ok )
193 CALL
zhetri2(
'U', -1, a, 1, ip, w, 1, info )
194 CALL
chkxer(
'ZHETRI2', infot, nout, lerr, ok )
196 CALL
zhetri2(
'U', 2, a, 1, ip, w, 1, info )
197 CALL
chkxer(
'ZHETRI2', infot, nout, lerr, ok )
203 CALL
zhetrs(
'/', 0, 0, a, 1, ip,
b, 1, info )
204 CALL
chkxer(
'ZHETRS', infot, nout, lerr, ok )
206 CALL
zhetrs(
'U', -1, 0, a, 1, ip,
b, 1, info )
207 CALL
chkxer(
'ZHETRS', infot, nout, lerr, ok )
209 CALL
zhetrs(
'U', 0, -1, a, 1, ip,
b, 1, info )
210 CALL
chkxer(
'ZHETRS', infot, nout, lerr, ok )
212 CALL
zhetrs(
'U', 2, 1, a, 1, ip,
b, 2, info )
213 CALL
chkxer(
'ZHETRS', infot, nout, lerr, ok )
215 CALL
zhetrs(
'U', 2, 1, a, 2, ip,
b, 1, info )
216 CALL
chkxer(
'ZHETRS', infot, nout, lerr, ok )
222 CALL
zherfs(
'/', 0, 0, a, 1, af, 1, ip,
b, 1,
x, 1, r1, r2, w,
224 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
226 CALL
zherfs(
'U', -1, 0, a, 1, af, 1, ip,
b, 1,
x, 1, r1, r2,
228 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
230 CALL
zherfs(
'U', 0, -1, a, 1, af, 1, ip,
b, 1,
x, 1, r1, r2,
232 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
234 CALL
zherfs(
'U', 2, 1, a, 1, af, 2, ip,
b, 2,
x, 2, r1, r2, w,
236 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
238 CALL
zherfs(
'U', 2, 1, a, 2, af, 1, ip,
b, 2,
x, 2, r1, r2, w,
240 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
242 CALL
zherfs(
'U', 2, 1, a, 2, af, 2, ip,
b, 1,
x, 2, r1, r2, w,
244 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
246 CALL
zherfs(
'U', 2, 1, a, 2, af, 2, ip,
b, 2,
x, 1, r1, r2, w,
248 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
256 CALL
zherfsx(
'/', eq, 0, 0, a, 1, af, 1, ip, s,
b, 1,
x, 1,
257 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
258 $ params, w, r, info )
259 CALL
chkxer(
'ZHERFSX', infot, nout, lerr, ok )
261 CALL
zherfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s,
b, 1,
x, 1,
262 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
263 $ params, w, r, info )
264 CALL
chkxer(
'ZHERFSX', infot, nout, lerr, ok )
267 CALL
zherfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s,
b, 1,
x, 1,
268 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
269 $ params, w, r, info )
270 CALL
chkxer(
'ZHERFSX', infot, nout, lerr, ok )
272 CALL
zherfsx(
'U', eq, 0, -1, a, 1, af, 1, ip, s,
b, 1,
x, 1,
273 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
274 $ params, w, r, info )
275 CALL
chkxer(
'ZHERFSX', infot, nout, lerr, ok )
277 CALL
zherfsx(
'U', eq, 2, 1, a, 1, af, 2, ip, s,
b, 2,
x, 2,
278 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
279 $ params, w, r, info )
280 CALL
chkxer(
'ZHERFSX', infot, nout, lerr, ok )
282 CALL
zherfsx(
'U', eq, 2, 1, a, 2, af, 1, ip, s,
b, 2,
x, 2,
283 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
284 $ params, w, r, info )
285 CALL
chkxer(
'ZHERFSX', infot, nout, lerr, ok )
287 CALL
zherfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s,
b, 1,
x, 2,
288 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
289 $ params, w, r, info )
290 CALL
chkxer(
'ZHERFSX', infot, nout, lerr, ok )
292 CALL
zherfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s,
b, 2,
x, 1,
293 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
294 $ params, w, r, info )
295 CALL
chkxer(
'ZHERFSX', infot, nout, lerr, ok )
301 CALL
zhecon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
302 CALL
chkxer(
'ZHECON', infot, nout, lerr, ok )
304 CALL
zhecon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
305 CALL
chkxer(
'ZHECON', infot, nout, lerr, ok )
307 CALL
zhecon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
308 CALL
chkxer(
'ZHECON', infot, nout, lerr, ok )
310 CALL
zhecon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
311 CALL
chkxer(
'ZHECON', infot, nout, lerr, ok )
317 ELSE IF(
lsamen( 2, c2,
'HR' ) )
THEN
321 srnamt =
'ZHETRF_ROOK'
324 CALL
chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
327 CALL
chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
330 CALL
chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
334 srnamt =
'ZHETF2_ROOK'
337 CALL
chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
340 CALL
chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
343 CALL
chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
347 srnamt =
'ZHETRI_ROOK'
350 CALL
chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
353 CALL
chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
356 CALL
chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
360 srnamt =
'ZHETRS_ROOK'
363 CALL
chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
366 CALL
chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
369 CALL
chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
372 CALL
chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
375 CALL
chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
379 srnamt =
'ZHECON_ROOK'
381 CALL
zhecon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
382 CALL
chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
384 CALL
zhecon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
385 CALL
chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
387 CALL
zhecon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, info )
388 CALL
chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
390 CALL
zhecon_rook(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
391 CALL
chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
397 ELSE IF(
lsamen( 2, c2,
'HP' ) )
THEN
403 CALL
zhptrf(
'/', 0, a, ip, info )
404 CALL
chkxer(
'ZHPTRF', infot, nout, lerr, ok )
406 CALL
zhptrf(
'U', -1, a, ip, info )
407 CALL
chkxer(
'ZHPTRF', infot, nout, lerr, ok )
413 CALL
zhptri(
'/', 0, a, ip, w, info )
414 CALL
chkxer(
'ZHPTRI', infot, nout, lerr, ok )
416 CALL
zhptri(
'U', -1, a, ip, w, info )
417 CALL
chkxer(
'ZHPTRI', infot, nout, lerr, ok )
423 CALL
zhptrs(
'/', 0, 0, a, ip,
b, 1, info )
424 CALL
chkxer(
'ZHPTRS', infot, nout, lerr, ok )
426 CALL
zhptrs(
'U', -1, 0, a, ip,
b, 1, info )
427 CALL
chkxer(
'ZHPTRS', infot, nout, lerr, ok )
429 CALL
zhptrs(
'U', 0, -1, a, ip,
b, 1, info )
430 CALL
chkxer(
'ZHPTRS', infot, nout, lerr, ok )
432 CALL
zhptrs(
'U', 2, 1, a, ip,
b, 1, info )
433 CALL
chkxer(
'ZHPTRS', infot, nout, lerr, ok )
439 CALL
zhprfs(
'/', 0, 0, a, af, ip,
b, 1,
x, 1, r1, r2, w, r,
441 CALL
chkxer(
'ZHPRFS', infot, nout, lerr, ok )
443 CALL
zhprfs(
'U', -1, 0, a, af, ip,
b, 1,
x, 1, r1, r2, w, r,
445 CALL
chkxer(
'ZHPRFS', infot, nout, lerr, ok )
447 CALL
zhprfs(
'U', 0, -1, a, af, ip,
b, 1,
x, 1, r1, r2, w, r,
449 CALL
chkxer(
'ZHPRFS', infot, nout, lerr, ok )
451 CALL
zhprfs(
'U', 2, 1, a, af, ip,
b, 1,
x, 2, r1, r2, w, r,
453 CALL
chkxer(
'ZHPRFS', infot, nout, lerr, ok )
455 CALL
zhprfs(
'U', 2, 1, a, af, ip,
b, 2,
x, 1, r1, r2, w, r,
457 CALL
chkxer(
'ZHPRFS', infot, nout, lerr, ok )
463 CALL
zhpcon(
'/', 0, a, ip, anrm, rcond, w, info )
464 CALL
chkxer(
'ZHPCON', infot, nout, lerr, ok )
466 CALL
zhpcon(
'U', -1, a, ip, anrm, rcond, w, info )
467 CALL
chkxer(
'ZHPCON', infot, nout, lerr, ok )
469 CALL
zhpcon(
'U', 1, a, ip, -anrm, rcond, w, info )
470 CALL
chkxer(
'ZHPCON', infot, nout, lerr, ok )
475 CALL
alaesm( path, ok, nout )
subroutine zhecon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZHECON
subroutine zhetrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZHETRS_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using fac...
subroutine zhetf2_rook(UPLO, N, A, LDA, IPIV, INFO)
ZHETF2_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
subroutine zherfsx(UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, S, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, INFO)
ZHERFSX
subroutine zerrhe(PATH, NUNIT)
ZERRHE
subroutine zhetri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
ZHETRI_ROOK computes the inverse of HE matrix using the factorization obtained with the bounded Bunch...
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zhptrf(UPLO, N, AP, IPIV, INFO)
ZHPTRF
subroutine zhetrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
subroutine zhetri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRI2
subroutine zhprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZHPRFS
subroutine zhetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF
subroutine zhpcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
ZHPCON
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zhetf2(UPLO, N, A, LDA, IPIV, INFO)
ZHETF2 computes the factorization of a complex Hermitian matrix, using the diagonal pivoting method (...
subroutine zhptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
ZHPTRS
LOGICAL function lsamen(N, CA, CB)
LSAMEN
subroutine zherfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZHERFS
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine zhetri(UPLO, N, A, LDA, IPIV, WORK, INFO)
ZHETRI
subroutine zhptri(UPLO, N, AP, IPIV, WORK, INFO)
ZHPTRI
subroutine zhetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZHETRS
subroutine zhecon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZHECON_ROOK estimates the reciprocal of the condition number fort HE matrices using factorization obt...