59 SUBROUTINE zerrhe( PATH, NUNIT )
76 parameter ( nmax = 4 )
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 $ e( nmax ), w( 2*nmax ), x( nmax )
110 COMMON / infoc / infot, nout, ok, lerr
111 COMMON / srnamc / srnamt
114 INTRINSIC dble, dcmplx
119 WRITE( nout, fmt = * )
126 a( i, j ) = dcmplx( 1.d0 / dble( i+j ),
127 $ -1.d0 / dble( i+j ) )
128 af( i, j ) = dcmplx( 1.d0 / dble( i+j ),
129 $ -1.d0 / dble( i+j ) )
147 IF(
lsamen( 2, c2,
'HE' ) )
THEN
153 CALL zhetrf(
'/', 0, a, 1, ip, w, 1, info )
154 CALL chkxer(
'ZHETRF', infot, nout, lerr, ok )
156 CALL zhetrf(
'U', -1, a, 1, ip, w, 1, info )
157 CALL chkxer(
'ZHETRF', infot, nout, lerr, ok )
159 CALL zhetrf(
'U', 2, a, 1, ip, w, 4, info )
160 CALL chkxer(
'ZHETRF', infot, nout, lerr, ok )
162 CALL zhetrf(
'U', 0, a, 1, ip, w, 0, info )
163 CALL chkxer(
'ZHETRF', infot, nout, lerr, ok )
165 CALL zhetrf(
'U', 0, a, 1, ip, w, -2, info )
166 CALL chkxer(
'ZHETRF', infot, nout, lerr, ok )
172 CALL zhetf2(
'/', 0, a, 1, ip, info )
173 CALL chkxer(
'ZHETF2', infot, nout, lerr, ok )
175 CALL zhetf2(
'U', -1, a, 1, ip, info )
176 CALL chkxer(
'ZHETF2', infot, nout, lerr, ok )
178 CALL zhetf2(
'U', 2, a, 1, ip, info )
179 CALL chkxer(
'ZHETF2', infot, nout, lerr, ok )
185 CALL zhetri(
'/', 0, a, 1, ip, w, info )
186 CALL chkxer(
'ZHETRI', infot, nout, lerr, ok )
188 CALL zhetri(
'U', -1, a, 1, ip, w, info )
189 CALL chkxer(
'ZHETRI', infot, nout, lerr, ok )
191 CALL zhetri(
'U', 2, a, 1, ip, w, info )
192 CALL chkxer(
'ZHETRI', infot, nout, lerr, ok )
198 CALL zhetri2(
'/', 0, a, 1, ip, w, 1, info )
199 CALL chkxer(
'ZHETRI2', infot, nout, lerr, ok )
201 CALL zhetri2(
'U', -1, a, 1, ip, w, 1, info )
202 CALL chkxer(
'ZHETRI2', infot, nout, lerr, ok )
204 CALL zhetri2(
'U', 2, a, 1, ip, w, 1, info )
205 CALL chkxer(
'ZHETRI2', infot, nout, lerr, ok )
211 CALL zhetri2x(
'/', 0, a, 1, ip, w, 1, info )
212 CALL chkxer(
'ZHETRI2X', infot, nout, lerr, ok )
214 CALL zhetri2x(
'U', -1, a, 1, ip, w, 1, info )
215 CALL chkxer(
'ZHETRI2X', infot, nout, lerr, ok )
217 CALL zhetri2x(
'U', 2, a, 1, ip, w, 1, info )
218 CALL chkxer(
'ZHETRI2X', infot, nout, lerr, ok )
224 CALL zhetrs(
'/', 0, 0, a, 1, ip, b, 1, info )
225 CALL chkxer(
'ZHETRS', infot, nout, lerr, ok )
227 CALL zhetrs(
'U', -1, 0, a, 1, ip, b, 1, info )
228 CALL chkxer(
'ZHETRS', infot, nout, lerr, ok )
230 CALL zhetrs(
'U', 0, -1, a, 1, ip, b, 1, info )
231 CALL chkxer(
'ZHETRS', infot, nout, lerr, ok )
233 CALL zhetrs(
'U', 2, 1, a, 1, ip, b, 2, info )
234 CALL chkxer(
'ZHETRS', infot, nout, lerr, ok )
236 CALL zhetrs(
'U', 2, 1, a, 2, ip, b, 1, info )
237 CALL chkxer(
'ZHETRS', infot, nout, lerr, ok )
243 CALL zherfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
245 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
247 CALL zherfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
249 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
251 CALL zherfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
253 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
255 CALL zherfs(
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
257 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
259 CALL zherfs(
'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
261 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
263 CALL zherfs(
'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
265 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
267 CALL zherfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
269 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
277 CALL zherfsx(
'/', eq, 0, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
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, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
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 )
288 CALL zherfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
289 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
290 $ params, w, r, info )
291 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
293 CALL zherfsx(
'U', eq, 0, -1, a, 1, af, 1, ip, s, b, 1, x, 1,
294 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
295 $ params, w, r, info )
296 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
298 CALL zherfsx(
'U', eq, 2, 1, a, 1, af, 2, ip, s, b, 2, x, 2,
299 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
300 $ params, w, r, info )
301 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
303 CALL zherfsx(
'U', eq, 2, 1, a, 2, af, 1, ip, s, b, 2, x, 2,
304 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
305 $ params, w, r, info )
306 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
308 CALL zherfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 1, x, 2,
309 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
310 $ params, w, r, info )
311 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
313 CALL zherfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 2, x, 1,
314 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
315 $ params, w, r, info )
316 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
322 CALL zhecon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
323 CALL chkxer(
'ZHECON', infot, nout, lerr, ok )
325 CALL zhecon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
326 CALL chkxer(
'ZHECON', infot, nout, lerr, ok )
328 CALL zhecon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
329 CALL chkxer(
'ZHECON', infot, nout, lerr, ok )
331 CALL zhecon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
332 CALL chkxer(
'ZHECON', infot, nout, lerr, ok )
334 ELSE IF(
lsamen( 2, c2,
'HR' ) )
THEN
342 srnamt =
'ZHETRF_ROOK'
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 )
357 CALL chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
361 srnamt =
'ZHETF2_ROOK'
364 CALL chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
367 CALL chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
370 CALL chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
374 srnamt =
'ZHETRI_ROOK'
377 CALL chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
380 CALL chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
383 CALL chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
387 srnamt =
'ZHETRS_ROOK'
389 CALL zhetrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
390 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
392 CALL zhetrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
393 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
395 CALL zhetrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
396 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
398 CALL zhetrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
399 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
401 CALL zhetrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
402 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
406 srnamt =
'ZHECON_ROOK'
408 CALL zhecon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
409 CALL chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
411 CALL zhecon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
412 CALL chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
414 CALL zhecon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, info )
415 CALL chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
417 CALL zhecon_rook(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
418 CALL chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
420 ELSE IF(
lsamen( 2, c2,
'HK' ) )
THEN
434 CALL zhetrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
435 CALL chkxer(
'ZHETRF_RK', infot, nout, lerr, ok )
437 CALL zhetrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
438 CALL chkxer(
'ZHETRF_RK', infot, nout, lerr, ok )
440 CALL zhetrf_rk(
'U', 2, a, 1, e, ip, w, 4, info )
441 CALL chkxer(
'ZHETRF_RK', infot, nout, lerr, ok )
443 CALL zhetrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
444 CALL chkxer(
'ZHETRF_RK', infot, nout, lerr, ok )
446 CALL zhetrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
447 CALL chkxer(
'ZHETRF_RK', infot, nout, lerr, ok )
453 CALL zhetf2_rk(
'/', 0, a, 1, e, ip, info )
454 CALL chkxer(
'ZHETF2_RK', infot, nout, lerr, ok )
456 CALL zhetf2_rk(
'U', -1, a, 1, e, ip, info )
457 CALL chkxer(
'ZHETF2_RK', infot, nout, lerr, ok )
459 CALL zhetf2_rk(
'U', 2, a, 1, e, ip, info )
460 CALL chkxer(
'ZHETF2_RK', infot, nout, lerr, ok )
466 CALL zhetri_3(
'/', 0, a, 1, e, ip, w, 1, info )
467 CALL chkxer(
'ZHETRI_3', infot, nout, lerr, ok )
469 CALL zhetri_3(
'U', -1, a, 1, e, ip, w, 1, info )
470 CALL chkxer(
'ZHETRI_3', infot, nout, lerr, ok )
472 CALL zhetri_3(
'U', 2, a, 1, e, ip, w, 1, info )
473 CALL chkxer(
'ZHETRI_3', infot, nout, lerr, ok )
475 CALL zhetri_3(
'U', 0, a, 1, e, ip, w, 0, info )
476 CALL chkxer(
'ZHETRI_3', infot, nout, lerr, ok )
478 CALL zhetri_3(
'U', 0, a, 1, e, ip, w, -2, info )
479 CALL chkxer(
'ZHETRI_3', infot, nout, lerr, ok )
485 CALL zhetri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
486 CALL chkxer(
'ZHETRI_3X', infot, nout, lerr, ok )
488 CALL zhetri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
489 CALL chkxer(
'ZHETRI_3X', infot, nout, lerr, ok )
491 CALL zhetri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
492 CALL chkxer(
'ZHETRI_3X', infot, nout, lerr, ok )
498 CALL zhetrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
499 CALL chkxer(
'ZHETRS_3', infot, nout, lerr, ok )
501 CALL zhetrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
502 CALL chkxer(
'ZHETRS_3', infot, nout, lerr, ok )
504 CALL zhetrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
505 CALL chkxer(
'ZHETRS_3', infot, nout, lerr, ok )
507 CALL zhetrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
508 CALL chkxer(
'ZHETRS_3', infot, nout, lerr, ok )
510 CALL zhetrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
511 CALL chkxer(
'ZHETRS_3', infot, nout, lerr, ok )
517 CALL zhecon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, info )
518 CALL chkxer(
'ZHECON_3', infot, nout, lerr, ok )
520 CALL zhecon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, info )
521 CALL chkxer(
'ZHECON_3', infot, nout, lerr, ok )
523 CALL zhecon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, info )
524 CALL chkxer(
'ZHECON_3', infot, nout, lerr, ok )
526 CALL zhecon_3(
'U', 1, a, 1, e, ip, -1.0d0, rcond, w, info)
527 CALL chkxer(
'ZHECON_3', infot, nout, lerr, ok )
529 ELSE IF(
lsamen( 2, c2,
'HP' ) )
THEN
539 CALL zhptrf(
'/', 0, a, ip, info )
540 CALL chkxer(
'ZHPTRF', infot, nout, lerr, ok )
542 CALL zhptrf(
'U', -1, a, ip, info )
543 CALL chkxer(
'ZHPTRF', infot, nout, lerr, ok )
549 CALL zhptri(
'/', 0, a, ip, w, info )
550 CALL chkxer(
'ZHPTRI', infot, nout, lerr, ok )
552 CALL zhptri(
'U', -1, a, ip, w, info )
553 CALL chkxer(
'ZHPTRI', infot, nout, lerr, ok )
559 CALL zhptrs(
'/', 0, 0, a, ip, b, 1, info )
560 CALL chkxer(
'ZHPTRS', infot, nout, lerr, ok )
562 CALL zhptrs(
'U', -1, 0, a, ip, b, 1, info )
563 CALL chkxer(
'ZHPTRS', infot, nout, lerr, ok )
565 CALL zhptrs(
'U', 0, -1, a, ip, b, 1, info )
566 CALL chkxer(
'ZHPTRS', infot, nout, lerr, ok )
568 CALL zhptrs(
'U', 2, 1, a, ip, b, 1, info )
569 CALL chkxer(
'ZHPTRS', infot, nout, lerr, ok )
575 CALL zhprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
577 CALL chkxer(
'ZHPRFS', infot, nout, lerr, ok )
579 CALL zhprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
581 CALL chkxer(
'ZHPRFS', infot, nout, lerr, ok )
583 CALL zhprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
585 CALL chkxer(
'ZHPRFS', infot, nout, lerr, ok )
587 CALL zhprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
589 CALL chkxer(
'ZHPRFS', infot, nout, lerr, ok )
591 CALL zhprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
593 CALL chkxer(
'ZHPRFS', infot, nout, lerr, ok )
599 CALL zhpcon(
'/', 0, 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 )
605 CALL zhpcon(
'U', 1, a, ip, -anrm, rcond, w, info )
606 CALL chkxer(
'ZHPCON', infot, nout, lerr, ok )
611 CALL alaesm( path, ok, nout )
subroutine zhetri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRI2
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 zerrhe(PATH, NUNIT)
ZERRHE
subroutine zhetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZHETRS
subroutine zhetf2(UPLO, N, A, LDA, IPIV, INFO)
ZHETF2 computes the factorization of a complex Hermitian matrix, using the diagonal pivoting method (...
subroutine zhprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZHPRFS
subroutine alaesm(PATH, OK, NOUT)
ALAESM
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 ob...
subroutine zhetrs_3(UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO)
ZHETRS_3
subroutine zhpcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
ZHPCON
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
logical function lsamen(N, CA, CB)
LSAMEN
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 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 zhecon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZHECON
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 zhetri_3(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
ZHETRI_3
subroutine zhptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
ZHPTRS
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 zhptri(UPLO, N, AP, IPIV, WORK, INFO)
ZHPTRI
subroutine zherfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZHERFS
subroutine zhetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF
subroutine zhecon_3(UPLO, N, A, LDA, E, IPIV, ANORM, RCOND, WORK, INFO)
ZHECON_3
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 zhptrf(UPLO, N, AP, IPIV, INFO)
ZHPTRF
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 zhetri(UPLO, N, A, LDA, IPIV, WORK, INFO)
ZHETRI
subroutine zhetri2x(UPLO, N, A, LDA, IPIV, WORK, NB, INFO)
ZHETRI2X
subroutine zhetri_3x(UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO)
ZHETRI_3X