59 SUBROUTINE cerrhe( PATH, NUNIT )
76 parameter ( nmax = 4 )
81 INTEGER i, info, j, n_err_bnds, nparams
82 REAL anrm, rcond, berr
86 REAL r( nmax ), r1( nmax ), r2( nmax ),
87 $ s( nmax ), err_bnds_n( nmax, 3 ),
88 $ err_bnds_c( nmax, 3 ), params( 1 )
89 COMPLEX 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 cmplx, real
119 WRITE( nout, fmt = * )
126 a( i, j ) = cmplx( 1. /
REAL( I+J ), -1. /
REAL( I+J ) )
127 af( i, j ) = cmplx( 1. /
REAL( I+J ), -1. /
REAL( I+J ) )
140 IF(
lsamen( 2, c2,
'HE' ) )
THEN
150 CALL chetrf(
'/', 0, a, 1, ip, w, 1, info )
151 CALL chkxer(
'CHETRF', infot, nout, lerr, ok )
153 CALL chetrf(
'U', -1, a, 1, ip, w, 1, info )
154 CALL chkxer(
'CHETRF', infot, nout, lerr, ok )
156 CALL chetrf(
'U', 2, a, 1, ip, w, 4, info )
157 CALL chkxer(
'CHETRF', infot, nout, lerr, ok )
159 CALL chetrf(
'U', 0, a, 1, ip, w, 0, info )
160 CALL chkxer(
'CHETRF', infot, nout, lerr, ok )
162 CALL chetrf(
'U', 0, a, 1, ip, w, -2, info )
163 CALL chkxer(
'CHETRF', infot, nout, lerr, ok )
169 CALL chetf2(
'/', 0, a, 1, ip, info )
170 CALL chkxer(
'CHETF2', infot, nout, lerr, ok )
172 CALL chetf2(
'U', -1, a, 1, ip, info )
173 CALL chkxer(
'CHETF2', infot, nout, lerr, ok )
175 CALL chetf2(
'U', 2, a, 1, ip, info )
176 CALL chkxer(
'CHETF2', infot, nout, lerr, ok )
182 CALL chetri(
'/', 0, a, 1, ip, w, info )
183 CALL chkxer(
'CHETRI', infot, nout, lerr, ok )
185 CALL chetri(
'U', -1, a, 1, ip, w, info )
186 CALL chkxer(
'CHETRI', infot, nout, lerr, ok )
188 CALL chetri(
'U', 2, a, 1, ip, w, info )
189 CALL chkxer(
'CHETRI', infot, nout, lerr, ok )
195 CALL chetri2(
'/', 0, a, 1, ip, w, 1, info )
196 CALL chkxer(
'CHETRI2', infot, nout, lerr, ok )
198 CALL chetri2(
'U', -1, a, 1, ip, w, 1, info )
199 CALL chkxer(
'CHETRI2', infot, nout, lerr, ok )
201 CALL chetri2(
'U', 2, a, 1, ip, w, 1, info )
202 CALL chkxer(
'CHETRI2', infot, nout, lerr, ok )
208 CALL chetri2x(
'/', 0, a, 1, ip, w, 1, info )
209 CALL chkxer(
'CHETRI2X', infot, nout, lerr, ok )
211 CALL chetri2x(
'U', -1, a, 1, ip, w, 1, info )
212 CALL chkxer(
'CHETRI2X', infot, nout, lerr, ok )
214 CALL chetri2x(
'U', 2, a, 1, ip, w, 1, info )
215 CALL chkxer(
'CHETRI2X', infot, nout, lerr, ok )
221 CALL chetrs(
'/', 0, 0, a, 1, ip, b, 1, info )
222 CALL chkxer(
'CHETRS', infot, nout, lerr, ok )
224 CALL chetrs(
'U', -1, 0, a, 1, ip, b, 1, info )
225 CALL chkxer(
'CHETRS', infot, nout, lerr, ok )
227 CALL chetrs(
'U', 0, -1, a, 1, ip, b, 1, info )
228 CALL chkxer(
'CHETRS', infot, nout, lerr, ok )
230 CALL chetrs(
'U', 2, 1, a, 1, ip, b, 2, info )
231 CALL chkxer(
'CHETRS', infot, nout, lerr, ok )
233 CALL chetrs(
'U', 2, 1, a, 2, ip, b, 1, info )
234 CALL chkxer(
'CHETRS', infot, nout, lerr, ok )
240 CALL cherfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
242 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
244 CALL cherfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
246 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
248 CALL cherfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
250 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
252 CALL cherfs(
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
254 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
256 CALL cherfs(
'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
258 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
260 CALL cherfs(
'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
262 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
264 CALL cherfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
266 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
272 CALL checon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
273 CALL chkxer(
'CHECON', infot, nout, lerr, ok )
275 CALL checon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
276 CALL chkxer(
'CHECON', infot, nout, lerr, ok )
278 CALL checon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
279 CALL chkxer(
'CHECON', infot, nout, lerr, ok )
281 CALL checon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
282 CALL chkxer(
'CHECON', infot, nout, lerr, ok )
290 CALL cherfsx(
'/', eq, 0, 0, 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(
'CHERFSX', infot, nout, lerr, ok )
295 CALL cherfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
296 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
297 $ params, w, r, info )
298 CALL chkxer(
'CHERFSX', infot, nout, lerr, ok )
301 CALL cherfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
302 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
303 $ params, w, r, info )
304 CALL chkxer(
'CHERFSX', infot, nout, lerr, ok )
306 CALL cherfsx(
'U', eq, 0, -1, a, 1, af, 1, ip, s, b, 1, x, 1,
307 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
308 $ params, w, r, info )
309 CALL chkxer(
'CHERFSX', infot, nout, lerr, ok )
311 CALL cherfsx(
'U', eq, 2, 1, a, 1, af, 2, ip, s, b, 2, x, 2,
312 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
313 $ params, w, r, info )
314 CALL chkxer(
'CHERFSX', infot, nout, lerr, ok )
316 CALL cherfsx(
'U', eq, 2, 1, a, 2, af, 1, ip, s, b, 2, x, 2,
317 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
318 $ params, w, r, info )
319 CALL chkxer(
'CHERFSX', infot, nout, lerr, ok )
321 CALL cherfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 1, x, 2,
322 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
323 $ params, w, r, info )
324 CALL chkxer(
'CHERFSX', infot, nout, lerr, ok )
326 CALL cherfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 2, x, 1,
327 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
328 $ params, w, r, info )
329 CALL chkxer(
'CHERFSX', infot, nout, lerr, ok )
331 ELSE IF(
lsamen( 2, c2,
'HR' ) )
THEN
339 srnamt =
'CHETRF_ROOK'
342 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
345 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
348 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
351 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
354 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
358 srnamt =
'CHETF2_ROOK'
361 CALL chkxer(
'CHETF2_ROOK', infot, nout, lerr, ok )
364 CALL chkxer(
'CHETF2_ROOK', infot, nout, lerr, ok )
367 CALL chkxer(
'CHETF2_ROOK', infot, nout, lerr, ok )
371 srnamt =
'CHETRI_ROOK'
374 CALL chkxer(
'CHETRI_ROOK', infot, nout, lerr, ok )
377 CALL chkxer(
'CHETRI_ROOK', infot, nout, lerr, ok )
380 CALL chkxer(
'CHETRI_ROOK', infot, nout, lerr, ok )
384 srnamt =
'CHETRS_ROOK'
386 CALL chetrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
387 CALL chkxer(
'CHETRS_ROOK', infot, nout, lerr, ok )
389 CALL chetrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
390 CALL chkxer(
'CHETRS_ROOK', infot, nout, lerr, ok )
392 CALL chetrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
393 CALL chkxer(
'CHETRS_ROOK', infot, nout, lerr, ok )
395 CALL chetrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
396 CALL chkxer(
'CHETRS_ROOK', infot, nout, lerr, ok )
398 CALL chetrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
399 CALL chkxer(
'CHETRS_ROOK', infot, nout, lerr, ok )
403 srnamt =
'CHECON_ROOK'
405 CALL checon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
406 CALL chkxer(
'CHECON_ROOK', infot, nout, lerr, ok )
408 CALL checon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
409 CALL chkxer(
'CHECON_ROOK', infot, nout, lerr, ok )
411 CALL checon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, info )
412 CALL chkxer(
'CHECON_ROOK', infot, nout, lerr, ok )
414 CALL checon_rook(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
415 CALL chkxer(
'CHECON_ROOK', infot, nout, lerr, ok )
417 ELSE IF(
lsamen( 2, c2,
'HK' ) )
THEN
431 CALL chetrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
432 CALL chkxer(
'CHETRF_RK', infot, nout, lerr, ok )
434 CALL chetrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
435 CALL chkxer(
'CHETRF_RK', infot, nout, lerr, ok )
437 CALL chetrf_rk(
'U', 2, a, 1, e, ip, w, 4, info )
438 CALL chkxer(
'CHETRF_RK', infot, nout, lerr, ok )
440 CALL chetrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
441 CALL chkxer(
'CHETRF_RK', infot, nout, lerr, ok )
443 CALL chetrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
444 CALL chkxer(
'CHETRF_RK', infot, nout, lerr, ok )
450 CALL chetf2_rk(
'/', 0, a, 1, e, ip, info )
451 CALL chkxer(
'CHETF2_RK', infot, nout, lerr, ok )
453 CALL chetf2_rk(
'U', -1, a, 1, e, ip, info )
454 CALL chkxer(
'CHETF2_RK', infot, nout, lerr, ok )
456 CALL chetf2_rk(
'U', 2, a, 1, e, ip, info )
457 CALL chkxer(
'CHETF2_RK', infot, nout, lerr, ok )
463 CALL chetri_3(
'/', 0, a, 1, e, ip, w, 1, info )
464 CALL chkxer(
'CHETRI_3', infot, nout, lerr, ok )
466 CALL chetri_3(
'U', -1, a, 1, e, ip, w, 1, info )
467 CALL chkxer(
'CHETRI_3', infot, nout, lerr, ok )
469 CALL chetri_3(
'U', 2, a, 1, e, ip, w, 1, info )
470 CALL chkxer(
'CHETRI_3', infot, nout, lerr, ok )
472 CALL chetri_3(
'U', 0, a, 1, e, ip, w, 0, info )
473 CALL chkxer(
'CHETRI_3', infot, nout, lerr, ok )
475 CALL chetri_3(
'U', 0, a, 1, e, ip, w, -2, info )
476 CALL chkxer(
'CHETRI_3', infot, nout, lerr, ok )
482 CALL chetri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
483 CALL chkxer(
'CHETRI_3X', infot, nout, lerr, ok )
485 CALL chetri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
486 CALL chkxer(
'CHETRI_3X', infot, nout, lerr, ok )
488 CALL chetri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
489 CALL chkxer(
'CHETRI_3X', infot, nout, lerr, ok )
495 CALL chetrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
496 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
498 CALL chetrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
499 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
501 CALL chetrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
502 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
504 CALL chetrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
505 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
507 CALL chetrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
508 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
514 CALL checon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, info )
515 CALL chkxer(
'CHECON_3', infot, nout, lerr, ok )
517 CALL checon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, info )
518 CALL chkxer(
'CHECON_3', infot, nout, lerr, ok )
520 CALL checon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, info )
521 CALL chkxer(
'CHECON_3', infot, nout, lerr, ok )
523 CALL checon_3(
'U', 1, a, 1, e, ip, -1.0e0, rcond, w, info)
524 CALL chkxer(
'CHECON_3', infot, nout, lerr, ok )
526 ELSE IF(
lsamen( 2, c2,
'HP' ) )
THEN
536 CALL chptrf(
'/', 0, a, ip, info )
537 CALL chkxer(
'CHPTRF', infot, nout, lerr, ok )
539 CALL chptrf(
'U', -1, a, ip, info )
540 CALL chkxer(
'CHPTRF', infot, nout, lerr, ok )
546 CALL chptri(
'/', 0, a, ip, w, info )
547 CALL chkxer(
'CHPTRI', infot, nout, lerr, ok )
549 CALL chptri(
'U', -1, a, ip, w, info )
550 CALL chkxer(
'CHPTRI', infot, nout, lerr, ok )
556 CALL chptrs(
'/', 0, 0, a, ip, b, 1, info )
557 CALL chkxer(
'CHPTRS', infot, nout, lerr, ok )
559 CALL chptrs(
'U', -1, 0, a, ip, b, 1, info )
560 CALL chkxer(
'CHPTRS', infot, nout, lerr, ok )
562 CALL chptrs(
'U', 0, -1, a, ip, b, 1, info )
563 CALL chkxer(
'CHPTRS', infot, nout, lerr, ok )
565 CALL chptrs(
'U', 2, 1, a, ip, b, 1, info )
566 CALL chkxer(
'CHPTRS', infot, nout, lerr, ok )
572 CALL chprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
574 CALL chkxer(
'CHPRFS', infot, nout, lerr, ok )
576 CALL chprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
578 CALL chkxer(
'CHPRFS', infot, nout, lerr, ok )
580 CALL chprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
582 CALL chkxer(
'CHPRFS', infot, nout, lerr, ok )
584 CALL chprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
586 CALL chkxer(
'CHPRFS', infot, nout, lerr, ok )
588 CALL chprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
590 CALL chkxer(
'CHPRFS', infot, nout, lerr, ok )
596 CALL chpcon(
'/', 0, a, ip, anrm, rcond, w, info )
597 CALL chkxer(
'CHPCON', infot, nout, lerr, ok )
599 CALL chpcon(
'U', -1, a, ip, anrm, rcond, w, info )
600 CALL chkxer(
'CHPCON', infot, nout, lerr, ok )
602 CALL chpcon(
'U', 1, a, ip, -anrm, rcond, w, info )
603 CALL chkxer(
'CHPCON', infot, nout, lerr, ok )
608 CALL alaesm( path, ok, nout )
subroutine chetri2x(UPLO, N, A, LDA, IPIV, WORK, NB, INFO)
CHETRI2X
subroutine chprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CHPRFS
subroutine chetri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
CHETRI_ROOK computes the inverse of HE matrix using the factorization obtained with the bounded Bunch...
subroutine chetri(UPLO, N, A, LDA, IPIV, WORK, INFO)
CHETRI
subroutine chetrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
subroutine chetri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRI2
subroutine chptrf(UPLO, N, AP, IPIV, INFO)
CHPTRF
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine chpcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
CHPCON
subroutine chetf2_rk(UPLO, N, A, LDA, E, IPIV, INFO)
CHETF2_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch...
subroutine checon_3(UPLO, N, A, LDA, E, IPIV, ANORM, RCOND, WORK, INFO)
CHECON_3
subroutine cherfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CHERFS
subroutine chptri(UPLO, N, AP, IPIV, WORK, INFO)
CHPTRI
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine chetf2(UPLO, N, A, LDA, IPIV, INFO)
CHETF2 computes the factorization of a complex Hermitian matrix, using the diagonal pivoting method (...
subroutine cerrhe(PATH, NUNIT)
CERRHE
logical function lsamen(N, CA, CB)
LSAMEN
subroutine chetri_3(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
CHETRI_3
subroutine chetri_3x(UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO)
CHETRI_3X
subroutine checon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CHECON_ROOK estimates the reciprocal of the condition number fort HE matrices using factorization ob...
subroutine chetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CHETRS
subroutine cherfsx(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)
CHERFSX
subroutine chetrs_3(UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO)
CHETRS_3
subroutine chptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
CHPTRS
subroutine chetrf_rk(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
CHETRF_RK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bunch...
subroutine chetf2_rook(UPLO, N, A, LDA, IPIV, INFO)
CHETF2_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
subroutine chetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF
subroutine chetrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CHETRS_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using fac...
subroutine checon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CHECON