73 parameter ( nmax = 4 )
82 REAL r( nmax ), r1( nmax ), r2( nmax )
83 COMPLEX a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
84 $ e( nmax ), w( 2*nmax ), x( nmax )
105 COMMON / infoc / infot, nout, ok, lerr
106 COMMON / srnamc / srnamt
109 INTRINSIC cmplx, real
114 WRITE( nout, fmt = * )
121 a( i, j ) = cmplx( 1. /
REAL( I+J ), -1. /
REAL( I+J ) )
122 af( i, j ) = cmplx( 1. /
REAL( I+J ), -1. /
REAL( I+J ) )
135 IF(
lsamen( 2, c2,
'HE' ) )
THEN
145 CALL chetrf(
'/', 0, a, 1, ip, w, 1, info )
146 CALL chkxer(
'CHETRF', infot, nout, lerr, ok )
148 CALL chetrf(
'U', -1, a, 1, ip, w, 1, info )
149 CALL chkxer(
'CHETRF', infot, nout, lerr, ok )
151 CALL chetrf(
'U', 2, a, 1, ip, w, 4, info )
152 CALL chkxer(
'CHETRF', infot, nout, lerr, ok )
154 CALL chetrf(
'U', 0, a, 1, ip, w, 0, info )
155 CALL chkxer(
'CHETRF', infot, nout, lerr, ok )
157 CALL chetrf(
'U', 0, a, 1, ip, w, -2, info )
158 CALL chkxer(
'CHETRF', infot, nout, lerr, ok )
164 CALL chetf2(
'/', 0, a, 1, ip, info )
165 CALL chkxer(
'CHETF2', infot, nout, lerr, ok )
167 CALL chetf2(
'U', -1, a, 1, ip, info )
168 CALL chkxer(
'CHETF2', infot, nout, lerr, ok )
170 CALL chetf2(
'U', 2, a, 1, ip, info )
171 CALL chkxer(
'CHETF2', infot, nout, lerr, ok )
177 CALL chetri(
'/', 0, a, 1, ip, w, info )
178 CALL chkxer(
'CHETRI', infot, nout, lerr, ok )
180 CALL chetri(
'U', -1, a, 1, ip, w, info )
181 CALL chkxer(
'CHETRI', infot, nout, lerr, ok )
183 CALL chetri(
'U', 2, a, 1, ip, w, info )
184 CALL chkxer(
'CHETRI', infot, nout, lerr, ok )
190 CALL chetri2(
'/', 0, a, 1, ip, w, 1, info )
191 CALL chkxer(
'CHETRI2', infot, nout, lerr, ok )
193 CALL chetri2(
'U', -1, a, 1, ip, w, 1, info )
194 CALL chkxer(
'CHETRI2', infot, nout, lerr, ok )
196 CALL chetri2(
'U', 2, a, 1, ip, w, 1, info )
197 CALL chkxer(
'CHETRI2', infot, nout, lerr, ok )
203 CALL chetri2x(
'/', 0, a, 1, ip, w, 1, info )
204 CALL chkxer(
'CHETRI2X', infot, nout, lerr, ok )
206 CALL chetri2x(
'U', -1, a, 1, ip, w, 1, info )
207 CALL chkxer(
'CHETRI2X', infot, nout, lerr, ok )
209 CALL chetri2x(
'U', 2, a, 1, ip, w, 1, info )
210 CALL chkxer(
'CHETRI2X', infot, nout, lerr, ok )
216 CALL chetrs(
'/', 0, 0, a, 1, ip, b, 1, info )
217 CALL chkxer(
'CHETRS', infot, nout, lerr, ok )
219 CALL chetrs(
'U', -1, 0, a, 1, ip, b, 1, info )
220 CALL chkxer(
'CHETRS', infot, nout, lerr, ok )
222 CALL chetrs(
'U', 0, -1, a, 1, ip, b, 1, info )
223 CALL chkxer(
'CHETRS', infot, nout, lerr, ok )
225 CALL chetrs(
'U', 2, 1, a, 1, ip, b, 2, info )
226 CALL chkxer(
'CHETRS', infot, nout, lerr, ok )
228 CALL chetrs(
'U', 2, 1, a, 2, ip, b, 1, info )
229 CALL chkxer(
'CHETRS', infot, nout, lerr, ok )
235 CALL cherfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
237 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
239 CALL cherfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
241 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
243 CALL cherfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
245 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
247 CALL cherfs(
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
249 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
251 CALL cherfs(
'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
253 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
255 CALL cherfs(
'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
257 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
259 CALL cherfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
261 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
267 CALL checon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
268 CALL chkxer(
'CHECON', infot, nout, lerr, ok )
270 CALL checon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
271 CALL chkxer(
'CHECON', infot, nout, lerr, ok )
273 CALL checon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
274 CALL chkxer(
'CHECON', infot, nout, lerr, ok )
276 CALL checon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
277 CALL chkxer(
'CHECON', infot, nout, lerr, ok )
279 ELSE IF(
lsamen( 2, c2,
'HR' ) )
THEN
287 srnamt =
'CHETRF_ROOK'
290 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
293 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
296 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
299 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
302 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
306 srnamt =
'CHETF2_ROOK'
309 CALL chkxer(
'CHETF2_ROOK', infot, nout, lerr, ok )
312 CALL chkxer(
'CHETF2_ROOK', infot, nout, lerr, ok )
315 CALL chkxer(
'CHETF2_ROOK', infot, nout, lerr, ok )
319 srnamt =
'CHETRI_ROOK'
322 CALL chkxer(
'CHETRI_ROOK', infot, nout, lerr, ok )
325 CALL chkxer(
'CHETRI_ROOK', infot, nout, lerr, ok )
328 CALL chkxer(
'CHETRI_ROOK', infot, nout, lerr, ok )
332 srnamt =
'CHETRS_ROOK'
334 CALL chetrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
335 CALL chkxer(
'CHETRS_ROOK', infot, nout, lerr, ok )
337 CALL chetrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
338 CALL chkxer(
'CHETRS_ROOK', infot, nout, lerr, ok )
340 CALL chetrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
341 CALL chkxer(
'CHETRS_ROOK', infot, nout, lerr, ok )
343 CALL chetrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
344 CALL chkxer(
'CHETRS_ROOK', infot, nout, lerr, ok )
346 CALL chetrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
347 CALL chkxer(
'CHETRS_ROOK', infot, nout, lerr, ok )
351 srnamt =
'CHECON_ROOK'
353 CALL checon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
354 CALL chkxer(
'CHECON_ROOK', infot, nout, lerr, ok )
356 CALL checon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
357 CALL chkxer(
'CHECON_ROOK', infot, nout, lerr, ok )
359 CALL checon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, info )
360 CALL chkxer(
'CHECON_ROOK', infot, nout, lerr, ok )
362 CALL checon_rook(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
363 CALL chkxer(
'CHECON_ROOK', infot, nout, lerr, ok )
365 ELSE IF(
lsamen( 2, c2,
'HK' ) )
THEN
379 CALL chetrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
380 CALL chkxer(
'CHETRF_RK', infot, nout, lerr, ok )
382 CALL chetrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
383 CALL chkxer(
'CHETRF_RK', infot, nout, lerr, ok )
385 CALL chetrf_rk(
'U', 2, a, 1, e, ip, w, 4, info )
386 CALL chkxer(
'CHETRF_RK', infot, nout, lerr, ok )
388 CALL chetrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
389 CALL chkxer(
'CHETRF_RK', infot, nout, lerr, ok )
391 CALL chetrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
392 CALL chkxer(
'CHETRF_RK', infot, nout, lerr, ok )
398 CALL chetf2_rk(
'/', 0, a, 1, e, ip, info )
399 CALL chkxer(
'CHETF2_RK', infot, nout, lerr, ok )
401 CALL chetf2_rk(
'U', -1, a, 1, e, ip, info )
402 CALL chkxer(
'CHETF2_RK', infot, nout, lerr, ok )
404 CALL chetf2_rk(
'U', 2, a, 1, e, ip, info )
405 CALL chkxer(
'CHETF2_RK', infot, nout, lerr, ok )
411 CALL chetri_3(
'/', 0, a, 1, e, ip, w, 1, info )
412 CALL chkxer(
'CHETRI_3', infot, nout, lerr, ok )
414 CALL chetri_3(
'U', -1, a, 1, e, ip, w, 1, info )
415 CALL chkxer(
'CHETRI_3', infot, nout, lerr, ok )
417 CALL chetri_3(
'U', 2, a, 1, e, ip, w, 1, info )
418 CALL chkxer(
'CHETRI_3', infot, nout, lerr, ok )
420 CALL chetri_3(
'U', 0, a, 1, e, ip, w, 0, info )
421 CALL chkxer(
'CHETRI_3', infot, nout, lerr, ok )
423 CALL chetri_3(
'U', 0, a, 1, e, ip, w, -2, info )
424 CALL chkxer(
'CHETRI_3', infot, nout, lerr, ok )
430 CALL chetri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
431 CALL chkxer(
'CHETRI_3X', infot, nout, lerr, ok )
433 CALL chetri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
434 CALL chkxer(
'CHETRI_3X', infot, nout, lerr, ok )
436 CALL chetri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
437 CALL chkxer(
'CHETRI_3X', infot, nout, lerr, ok )
443 CALL chetrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
444 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
446 CALL chetrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
447 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
449 CALL chetrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
450 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
452 CALL chetrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
453 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
455 CALL chetrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
456 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
462 CALL checon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, info )
463 CALL chkxer(
'CHECON_3', infot, nout, lerr, ok )
465 CALL checon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, info )
466 CALL chkxer(
'CHECON_3', infot, nout, lerr, ok )
468 CALL checon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, info )
469 CALL chkxer(
'CHECON_3', infot, nout, lerr, ok )
471 CALL checon_3(
'U', 1, a, 1, e, ip, -1.0e0, rcond, w, info)
472 CALL chkxer(
'CHECON_3', infot, nout, lerr, ok )
474 ELSE IF(
lsamen( 2, c2,
'HP' ) )
THEN
483 CALL chetrf_aa(
'/', 0, a, 1, ip, w, 1, info )
484 CALL chkxer(
'CHETRF_AA', infot, nout, lerr, ok )
486 CALL chetrf_aa(
'U', -1, a, 1, ip, w, 1, info )
487 CALL chkxer(
'CHETRF_AA', infot, nout, lerr, ok )
489 CALL chetrf_aa(
'U', 2, a, 1, ip, w, 4, info )
490 CALL chkxer(
'CHETRF_AA', infot, nout, lerr, ok )
492 CALL chetrf_aa(
'U', 0, a, 1, ip, w, 0, info )
493 CALL chkxer(
'CHETRF_AA', infot, nout, lerr, ok )
495 CALL chetrf_aa(
'U', 0, a, 1, ip, w, -2, info )
496 CALL chkxer(
'CHETRF_AA', infot, nout, lerr, ok )
502 CALL chetrs_aa(
'/', 0, 0, a, 1, ip, b, 1, w, 1, info )
503 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
505 CALL chetrs_aa(
'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
506 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
508 CALL chetrs_aa(
'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
509 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
511 CALL chetrs_aa(
'U', 2, 1, a, 1, ip, b, 2, w, 1, info )
512 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
514 CALL chetrs_aa(
'U', 2, 1, a, 2, ip, b, 1, w, 1, info )
515 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
517 CALL chetrs_aa(
'U', 0, 1, a, 1, ip, b, 1, w, 0, info )
518 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
520 CALL chetrs_aa(
'U', 0, 1, a, 1, ip, b, 1, w, -2, info )
521 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
527 ELSE IF(
lsamen( 2, c2,
'HP' ) )
THEN
533 CALL chptrf(
'/', 0, a, ip, info )
534 CALL chkxer(
'CHPTRF', infot, nout, lerr, ok )
536 CALL chptrf(
'U', -1, a, ip, info )
537 CALL chkxer(
'CHPTRF', infot, nout, lerr, ok )
543 CALL chptri(
'/', 0, a, ip, w, info )
544 CALL chkxer(
'CHPTRI', infot, nout, lerr, ok )
546 CALL chptri(
'U', -1, a, ip, w, info )
547 CALL chkxer(
'CHPTRI', infot, nout, lerr, ok )
553 CALL chptrs(
'/', 0, 0, a, ip, b, 1, info )
554 CALL chkxer(
'CHPTRS', infot, nout, lerr, ok )
556 CALL chptrs(
'U', -1, 0, a, ip, b, 1, info )
557 CALL chkxer(
'CHPTRS', infot, nout, lerr, ok )
559 CALL chptrs(
'U', 0, -1, a, ip, b, 1, info )
560 CALL chkxer(
'CHPTRS', infot, nout, lerr, ok )
562 CALL chptrs(
'U', 2, 1, a, ip, b, 1, info )
563 CALL chkxer(
'CHPTRS', infot, nout, lerr, ok )
569 CALL chprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
571 CALL chkxer(
'CHPRFS', infot, nout, lerr, ok )
573 CALL chprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
575 CALL chkxer(
'CHPRFS', infot, nout, lerr, ok )
577 CALL chprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
579 CALL chkxer(
'CHPRFS', infot, nout, lerr, ok )
581 CALL chprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
583 CALL chkxer(
'CHPRFS', infot, nout, lerr, ok )
585 CALL chprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
587 CALL chkxer(
'CHPRFS', infot, nout, lerr, ok )
593 CALL chpcon(
'/', 0, a, ip, anrm, rcond, w, info )
594 CALL chkxer(
'CHPCON', infot, nout, lerr, ok )
596 CALL chpcon(
'U', -1, 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 )
605 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 chetrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CHETRS_AA
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine csycon_3(UPLO, N, A, LDA, E, IPIV, ANORM, RCOND, WORK, INFO)
CSYCON_3
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 (...
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 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_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF_AA
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