78 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
79 DOUBLE PRECISION ANRM, RCOND, BERR
83 DOUBLE PRECISION R( NMAX ), R1( NMAX ), R2( NMAX ),
84 $ S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
85 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
86 COMPLEX*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
87 $ E( NMAX ), W( 2*NMAX ), X( NMAX )
107 COMMON / infoc / infot, nout, ok, lerr
108 COMMON / srnamc / srnamt
111 INTRINSIC dble, dcmplx
116 WRITE( nout, fmt = * )
123 a( i, j ) = dcmplx( 1.d0 / dble( i+j ),
124 $ -1.d0 / dble( i+j ) )
125 af( i, j ) = dcmplx( 1.d0 / dble( i+j ),
126 $ -1.d0 / dble( i+j ) )
144 IF( lsamen( 2, c2,
'HE' ) )
THEN
150 CALL zhetrf(
'/', 0, a, 1, ip, w, 1, info )
151 CALL chkxer(
'ZHETRF', infot, nout, lerr, ok )
153 CALL zhetrf(
'U', -1, a, 1, ip, w, 1, info )
154 CALL chkxer(
'ZHETRF', infot, nout, lerr, ok )
156 CALL zhetrf(
'U', 2, a, 1, ip, w, 4, info )
157 CALL chkxer(
'ZHETRF', infot, nout, lerr, ok )
159 CALL zhetrf(
'U', 0, a, 1, ip, w, 0, info )
160 CALL chkxer(
'ZHETRF', infot, nout, lerr, ok )
162 CALL zhetrf(
'U', 0, a, 1, ip, w, -2, info )
163 CALL chkxer(
'ZHETRF', infot, nout, lerr, ok )
169 CALL zhetf2(
'/', 0, a, 1, ip, info )
170 CALL chkxer(
'ZHETF2', infot, nout, lerr, ok )
172 CALL zhetf2(
'U', -1, a, 1, ip, info )
173 CALL chkxer(
'ZHETF2', infot, nout, lerr, ok )
175 CALL zhetf2(
'U', 2, a, 1, ip, info )
176 CALL chkxer(
'ZHETF2', infot, nout, lerr, ok )
182 CALL zhetri(
'/', 0, a, 1, ip, w, info )
183 CALL chkxer(
'ZHETRI', infot, nout, lerr, ok )
185 CALL zhetri(
'U', -1, a, 1, ip, w, info )
186 CALL chkxer(
'ZHETRI', infot, nout, lerr, ok )
188 CALL zhetri(
'U', 2, a, 1, ip, w, info )
189 CALL chkxer(
'ZHETRI', infot, nout, lerr, ok )
195 CALL zhetri2(
'/', 0, a, 1, ip, w, 1, info )
196 CALL chkxer(
'ZHETRI2', infot, nout, lerr, ok )
198 CALL zhetri2(
'U', -1, a, 1, ip, w, 1, info )
199 CALL chkxer(
'ZHETRI2', infot, nout, lerr, ok )
201 CALL zhetri2(
'U', 2, a, 1, ip, w, 1, info )
202 CALL chkxer(
'ZHETRI2', infot, nout, lerr, ok )
208 CALL zhetri2x(
'/', 0, a, 1, ip, w, 1, info )
209 CALL chkxer(
'ZHETRI2X', infot, nout, lerr, ok )
211 CALL zhetri2x(
'U', -1, a, 1, ip, w, 1, info )
212 CALL chkxer(
'ZHETRI2X', infot, nout, lerr, ok )
214 CALL zhetri2x(
'U', 2, a, 1, ip, w, 1, info )
215 CALL chkxer(
'ZHETRI2X', infot, nout, lerr, ok )
221 CALL zhetrs(
'/', 0, 0, a, 1, ip, b, 1, info )
222 CALL chkxer(
'ZHETRS', infot, nout, lerr, ok )
224 CALL zhetrs(
'U', -1, 0, a, 1, ip, b, 1, info )
225 CALL chkxer(
'ZHETRS', infot, nout, lerr, ok )
227 CALL zhetrs(
'U', 0, -1, a, 1, ip, b, 1, info )
228 CALL chkxer(
'ZHETRS', infot, nout, lerr, ok )
230 CALL zhetrs(
'U', 2, 1, a, 1, ip, b, 2, info )
231 CALL chkxer(
'ZHETRS', infot, nout, lerr, ok )
233 CALL zhetrs(
'U', 2, 1, a, 2, ip, b, 1, info )
234 CALL chkxer(
'ZHETRS', infot, nout, lerr, ok )
240 CALL zherfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
242 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
244 CALL zherfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
246 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
248 CALL zherfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
250 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
252 CALL zherfs(
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
254 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
256 CALL zherfs(
'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
258 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
260 CALL zherfs(
'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
262 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
264 CALL zherfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
266 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
274 CALL zherfsx(
'/', eq, 0, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
275 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
276 $ params, w, r, info )
277 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
279 CALL zherfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
280 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
281 $ params, w, r, info )
282 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
285 CALL zherfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
286 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
287 $ params, w, r, info )
288 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
290 CALL zherfsx(
'U', eq, 0, -1, a, 1, af, 1, ip, s, b, 1, x, 1,
291 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
292 $ params, w, r, info )
293 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
295 CALL zherfsx(
'U', eq, 2, 1, a, 1, af, 2, ip, s, b, 2, x, 2,
296 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
297 $ params, w, r, info )
298 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
300 CALL zherfsx(
'U', eq, 2, 1, a, 2, af, 1, ip, s, b, 2, x, 2,
301 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
302 $ params, w, r, info )
303 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
305 CALL zherfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 1, x, 2,
306 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
307 $ params, w, r, info )
308 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
310 CALL zherfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 2, x, 1,
311 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
312 $ params, w, r, info )
313 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
319 CALL zhecon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
320 CALL chkxer(
'ZHECON', infot, nout, lerr, ok )
322 CALL zhecon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
323 CALL chkxer(
'ZHECON', infot, nout, lerr, ok )
325 CALL zhecon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
326 CALL chkxer(
'ZHECON', infot, nout, lerr, ok )
328 CALL zhecon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
329 CALL chkxer(
'ZHECON', infot, nout, lerr, ok )
331 ELSE IF( lsamen( 2, c2,
'HR' ) )
THEN
339 srnamt =
'ZHETRF_ROOK'
342 CALL chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
345 CALL chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
348 CALL chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
351 CALL chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
354 CALL chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
358 srnamt =
'ZHETF2_ROOK'
361 CALL chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
364 CALL chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
367 CALL chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
371 srnamt =
'ZHETRI_ROOK'
374 CALL chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
377 CALL chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
380 CALL chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
384 srnamt =
'ZHETRS_ROOK'
386 CALL zhetrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
387 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
389 CALL zhetrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
390 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
392 CALL zhetrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
393 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
395 CALL zhetrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
396 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
398 CALL zhetrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
399 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
403 srnamt =
'ZHECON_ROOK'
405 CALL zhecon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
406 CALL chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
408 CALL zhecon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
409 CALL chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
411 CALL zhecon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, info )
412 CALL chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
414 CALL zhecon_rook(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
415 CALL chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
417 ELSE IF( lsamen( 2, c2,
'HK' ) )
THEN
431 CALL zhetrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
432 CALL chkxer(
'ZHETRF_RK', infot, nout, lerr, ok )
434 CALL zhetrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
435 CALL chkxer(
'ZHETRF_RK', infot, nout, lerr, ok )
437 CALL zhetrf_rk(
'U', 2, a, 1, e, ip, w, 4, info )
438 CALL chkxer(
'ZHETRF_RK', infot, nout, lerr, ok )
440 CALL zhetrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
441 CALL chkxer(
'ZHETRF_RK', infot, nout, lerr, ok )
443 CALL zhetrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
444 CALL chkxer(
'ZHETRF_RK', infot, nout, lerr, ok )
450 CALL zhetf2_rk(
'/', 0, a, 1, e, ip, info )
451 CALL chkxer(
'ZHETF2_RK', infot, nout, lerr, ok )
453 CALL zhetf2_rk(
'U', -1, a, 1, e, ip, info )
454 CALL chkxer(
'ZHETF2_RK', infot, nout, lerr, ok )
456 CALL zhetf2_rk(
'U', 2, a, 1, e, ip, info )
457 CALL chkxer(
'ZHETF2_RK', infot, nout, lerr, ok )
463 CALL zhetri_3(
'/', 0, a, 1, e, ip, w, 1, info )
464 CALL chkxer(
'ZHETRI_3', infot, nout, lerr, ok )
466 CALL zhetri_3(
'U', -1, a, 1, e, ip, w, 1, info )
467 CALL chkxer(
'ZHETRI_3', infot, nout, lerr, ok )
469 CALL zhetri_3(
'U', 2, a, 1, e, ip, w, 1, info )
470 CALL chkxer(
'ZHETRI_3', infot, nout, lerr, ok )
472 CALL zhetri_3(
'U', 0, a, 1, e, ip, w, 0, info )
473 CALL chkxer(
'ZHETRI_3', infot, nout, lerr, ok )
475 CALL zhetri_3(
'U', 0, a, 1, e, ip, w, -2, info )
476 CALL chkxer(
'ZHETRI_3', infot, nout, lerr, ok )
482 CALL zhetri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
483 CALL chkxer(
'ZHETRI_3X', infot, nout, lerr, ok )
485 CALL zhetri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
486 CALL chkxer(
'ZHETRI_3X', infot, nout, lerr, ok )
488 CALL zhetri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
489 CALL chkxer(
'ZHETRI_3X', infot, nout, lerr, ok )
495 CALL zhetrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
496 CALL chkxer(
'ZHETRS_3', infot, nout, lerr, ok )
498 CALL zhetrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
499 CALL chkxer(
'ZHETRS_3', infot, nout, lerr, ok )
501 CALL zhetrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
502 CALL chkxer(
'ZHETRS_3', infot, nout, lerr, ok )
504 CALL zhetrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
505 CALL chkxer(
'ZHETRS_3', infot, nout, lerr, ok )
507 CALL zhetrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
508 CALL chkxer(
'ZHETRS_3', infot, nout, lerr, ok )
514 CALL zhecon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, info )
515 CALL chkxer(
'ZHECON_3', infot, nout, lerr, ok )
517 CALL zhecon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, info )
518 CALL chkxer(
'ZHECON_3', infot, nout, lerr, ok )
520 CALL zhecon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, info )
521 CALL chkxer(
'ZHECON_3', infot, nout, lerr, ok )
523 CALL zhecon_3(
'U', 1, a, 1, e, ip, -1.0d0, rcond, w, info)
524 CALL chkxer(
'ZHECON_3', infot, nout, lerr, ok )
526 ELSE IF( lsamen( 2, c2,
'HP' ) )
THEN
536 CALL zhptrf(
'/', 0, a, ip, info )
537 CALL chkxer(
'ZHPTRF', infot, nout, lerr, ok )
539 CALL zhptrf(
'U', -1, a, ip, info )
540 CALL chkxer(
'ZHPTRF', infot, nout, lerr, ok )
546 CALL zhptri(
'/', 0, a, ip, w, info )
547 CALL chkxer(
'ZHPTRI', infot, nout, lerr, ok )
549 CALL zhptri(
'U', -1, a, ip, w, info )
550 CALL chkxer(
'ZHPTRI', infot, nout, lerr, ok )
556 CALL zhptrs(
'/', 0, 0, a, ip, b, 1, info )
557 CALL chkxer(
'ZHPTRS', infot, nout, lerr, ok )
559 CALL zhptrs(
'U', -1, 0, a, ip, b, 1, info )
560 CALL chkxer(
'ZHPTRS', infot, nout, lerr, ok )
562 CALL zhptrs(
'U', 0, -1, a, ip, b, 1, info )
563 CALL chkxer(
'ZHPTRS', infot, nout, lerr, ok )
565 CALL zhptrs(
'U', 2, 1, a, ip, b, 1, info )
566 CALL chkxer(
'ZHPTRS', infot, nout, lerr, ok )
572 CALL zhprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
574 CALL chkxer(
'ZHPRFS', infot, nout, lerr, ok )
576 CALL zhprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
578 CALL chkxer(
'ZHPRFS', infot, nout, lerr, ok )
580 CALL zhprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
582 CALL chkxer(
'ZHPRFS', infot, nout, lerr, ok )
584 CALL zhprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
586 CALL chkxer(
'ZHPRFS', infot, nout, lerr, ok )
588 CALL zhprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
590 CALL chkxer(
'ZHPRFS', infot, nout, lerr, ok )
596 CALL zhpcon(
'/', 0, a, ip, anrm, rcond, w, info )
597 CALL chkxer(
'ZHPCON', infot, nout, lerr, ok )
599 CALL zhpcon(
'U', -1, a, ip, anrm, rcond, w, info )
600 CALL chkxer(
'ZHPCON', infot, nout, lerr, ok )
602 CALL zhpcon(
'U', 1, a, ip, -anrm, rcond, w, info )
603 CALL chkxer(
'ZHPCON', infot, nout, lerr, ok )
608 CALL alaesm( path, ok, nout )
subroutine alaesm(path, ok, nout)
ALAESM
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine zhecon_3(uplo, n, a, lda, e, ipiv, anorm, rcond, work, info)
ZHECON_3
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...
subroutine zhecon(uplo, n, a, lda, ipiv, anorm, rcond, work, info)
ZHECON
subroutine zherfs(uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
ZHERFS
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 zhetf2_rk(uplo, n, a, lda, e, ipiv, info)
ZHETF2_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch...
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 zhetf2(uplo, n, a, lda, ipiv, info)
ZHETF2 computes the factorization of a complex Hermitian matrix, using the diagonal pivoting method (...
subroutine zhetrf_rk(uplo, n, a, lda, e, ipiv, work, lwork, info)
ZHETRF_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch...
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 zhetrf(uplo, n, a, lda, ipiv, work, lwork, info)
ZHETRF
subroutine zhetri2(uplo, n, a, lda, ipiv, work, lwork, info)
ZHETRI2
subroutine zhetri2x(uplo, n, a, lda, ipiv, work, nb, info)
ZHETRI2X
subroutine zhetri_3(uplo, n, a, lda, e, ipiv, work, lwork, info)
ZHETRI_3
subroutine zhetri_3x(uplo, n, a, lda, e, ipiv, work, nb, info)
ZHETRI_3X
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 zhetri(uplo, n, a, lda, ipiv, work, info)
ZHETRI
subroutine zhetrs_3(uplo, n, nrhs, a, lda, e, ipiv, b, ldb, info)
ZHETRS_3
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 zhetrs(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
ZHETRS
subroutine zhpcon(uplo, n, ap, ipiv, anorm, rcond, work, info)
ZHPCON
subroutine zhprfs(uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
ZHPRFS
subroutine zhptrf(uplo, n, ap, ipiv, info)
ZHPTRF
subroutine zhptri(uplo, n, ap, ipiv, work, info)
ZHPTRI
subroutine zhptrs(uplo, n, nrhs, ap, ipiv, b, ldb, info)
ZHPTRS
subroutine zerrhe(path, nunit)
ZERRHE