79 REAL R( NMAX ), R1( NMAX ), R2( NMAX )
80 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
81 $ E( NMAX ), W( 2*NMAX ), X( NMAX )
103 COMMON / infoc / infot, nout, ok, lerr
104 COMMON / srnamc / srnamt
107 INTRINSIC cmplx, real
112 WRITE( nout, fmt = * )
119 a( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
120 af( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
133 IF( lsamen( 2, c2,
'HE' ) )
THEN
143 CALL chetrf(
'/', 0, a, 1, ip, w, 1, info )
144 CALL chkxer(
'CHETRF', infot, nout, lerr, ok )
146 CALL chetrf(
'U', -1, a, 1, ip, w, 1, info )
147 CALL chkxer(
'CHETRF', infot, nout, lerr, ok )
149 CALL chetrf(
'U', 2, a, 1, ip, w, 4, info )
150 CALL chkxer(
'CHETRF', infot, nout, lerr, ok )
152 CALL chetrf(
'U', 0, a, 1, ip, w, 0, info )
153 CALL chkxer(
'CHETRF', infot, nout, lerr, ok )
155 CALL chetrf(
'U', 0, a, 1, ip, w, -2, info )
156 CALL chkxer(
'CHETRF', infot, nout, lerr, ok )
162 CALL chetf2(
'/', 0, a, 1, ip, info )
163 CALL chkxer(
'CHETF2', infot, nout, lerr, ok )
165 CALL chetf2(
'U', -1, a, 1, ip, info )
166 CALL chkxer(
'CHETF2', infot, nout, lerr, ok )
168 CALL chetf2(
'U', 2, a, 1, ip, info )
169 CALL chkxer(
'CHETF2', infot, nout, lerr, ok )
175 CALL chetri(
'/', 0, a, 1, ip, w, info )
176 CALL chkxer(
'CHETRI', infot, nout, lerr, ok )
178 CALL chetri(
'U', -1, a, 1, ip, w, info )
179 CALL chkxer(
'CHETRI', infot, nout, lerr, ok )
181 CALL chetri(
'U', 2, a, 1, ip, w, info )
182 CALL chkxer(
'CHETRI', infot, nout, lerr, ok )
188 CALL chetri2(
'/', 0, a, 1, ip, w, 1, info )
189 CALL chkxer(
'CHETRI2', infot, nout, lerr, ok )
191 CALL chetri2(
'U', -1, a, 1, ip, w, 1, info )
192 CALL chkxer(
'CHETRI2', infot, nout, lerr, ok )
194 CALL chetri2(
'U', 2, a, 1, ip, w, 1, info )
195 CALL chkxer(
'CHETRI2', infot, nout, lerr, ok )
201 CALL chetri2x(
'/', 0, a, 1, ip, w, 1, info )
202 CALL chkxer(
'CHETRI2X', infot, nout, lerr, ok )
204 CALL chetri2x(
'U', -1, a, 1, ip, w, 1, info )
205 CALL chkxer(
'CHETRI2X', infot, nout, lerr, ok )
207 CALL chetri2x(
'U', 2, a, 1, ip, w, 1, info )
208 CALL chkxer(
'CHETRI2X', infot, nout, lerr, ok )
214 CALL chetrs(
'/', 0, 0, a, 1, ip, b, 1, info )
215 CALL chkxer(
'CHETRS', infot, nout, lerr, ok )
217 CALL chetrs(
'U', -1, 0, a, 1, ip, b, 1, info )
218 CALL chkxer(
'CHETRS', infot, nout, lerr, ok )
220 CALL chetrs(
'U', 0, -1, a, 1, ip, b, 1, info )
221 CALL chkxer(
'CHETRS', infot, nout, lerr, ok )
223 CALL chetrs(
'U', 2, 1, a, 1, ip, b, 2, info )
224 CALL chkxer(
'CHETRS', infot, nout, lerr, ok )
226 CALL chetrs(
'U', 2, 1, a, 2, ip, b, 1, info )
227 CALL chkxer(
'CHETRS', infot, nout, lerr, ok )
233 CALL cherfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
235 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
237 CALL cherfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
239 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
241 CALL cherfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
243 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
245 CALL cherfs(
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
247 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
249 CALL cherfs(
'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
251 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
253 CALL cherfs(
'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
255 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
257 CALL cherfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
259 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
265 CALL checon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
266 CALL chkxer(
'CHECON', infot, nout, lerr, ok )
268 CALL checon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
269 CALL chkxer(
'CHECON', infot, nout, lerr, ok )
271 CALL checon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
272 CALL chkxer(
'CHECON', infot, nout, lerr, ok )
274 CALL checon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
275 CALL chkxer(
'CHECON', infot, nout, lerr, ok )
277 ELSE IF( lsamen( 2, c2,
'HR' ) )
THEN
285 srnamt =
'CHETRF_ROOK'
288 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
291 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
294 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
297 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
300 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
304 srnamt =
'CHETF2_ROOK'
307 CALL chkxer(
'CHETF2_ROOK', infot, nout, lerr, ok )
310 CALL chkxer(
'CHETF2_ROOK', infot, nout, lerr, ok )
313 CALL chkxer(
'CHETF2_ROOK', infot, nout, lerr, ok )
317 srnamt =
'CHETRI_ROOK'
320 CALL chkxer(
'CHETRI_ROOK', infot, nout, lerr, ok )
323 CALL chkxer(
'CHETRI_ROOK', infot, nout, lerr, ok )
326 CALL chkxer(
'CHETRI_ROOK', infot, nout, lerr, ok )
330 srnamt =
'CHETRS_ROOK'
332 CALL chetrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
333 CALL chkxer(
'CHETRS_ROOK', infot, nout, lerr, ok )
335 CALL chetrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
336 CALL chkxer(
'CHETRS_ROOK', infot, nout, lerr, ok )
338 CALL chetrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
339 CALL chkxer(
'CHETRS_ROOK', infot, nout, lerr, ok )
341 CALL chetrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
342 CALL chkxer(
'CHETRS_ROOK', infot, nout, lerr, ok )
344 CALL chetrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
345 CALL chkxer(
'CHETRS_ROOK', infot, nout, lerr, ok )
349 srnamt =
'CHECON_ROOK'
351 CALL checon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
352 CALL chkxer(
'CHECON_ROOK', infot, nout, lerr, ok )
354 CALL checon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
355 CALL chkxer(
'CHECON_ROOK', infot, nout, lerr, ok )
357 CALL checon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, info )
358 CALL chkxer(
'CHECON_ROOK', infot, nout, lerr, ok )
360 CALL checon_rook(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
361 CALL chkxer(
'CHECON_ROOK', infot, nout, lerr, ok )
363 ELSE IF( lsamen( 2, c2,
'HK' ) )
THEN
377 CALL chetrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
378 CALL chkxer(
'CHETRF_RK', infot, nout, lerr, ok )
380 CALL chetrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
381 CALL chkxer(
'CHETRF_RK', infot, nout, lerr, ok )
383 CALL chetrf_rk(
'U', 2, a, 1, e, ip, w, 4, info )
384 CALL chkxer(
'CHETRF_RK', infot, nout, lerr, ok )
386 CALL chetrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
387 CALL chkxer(
'CHETRF_RK', infot, nout, lerr, ok )
389 CALL chetrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
390 CALL chkxer(
'CHETRF_RK', infot, nout, lerr, ok )
396 CALL chetf2_rk(
'/', 0, a, 1, e, ip, info )
397 CALL chkxer(
'CHETF2_RK', infot, nout, lerr, ok )
399 CALL chetf2_rk(
'U', -1, a, 1, e, ip, info )
400 CALL chkxer(
'CHETF2_RK', infot, nout, lerr, ok )
402 CALL chetf2_rk(
'U', 2, a, 1, e, ip, info )
403 CALL chkxer(
'CHETF2_RK', infot, nout, lerr, ok )
409 CALL chetri_3(
'/', 0, a, 1, e, ip, w, 1, info )
410 CALL chkxer(
'CHETRI_3', infot, nout, lerr, ok )
412 CALL chetri_3(
'U', -1, a, 1, e, ip, w, 1, info )
413 CALL chkxer(
'CHETRI_3', infot, nout, lerr, ok )
415 CALL chetri_3(
'U', 2, a, 1, e, ip, w, 1, info )
416 CALL chkxer(
'CHETRI_3', infot, nout, lerr, ok )
418 CALL chetri_3(
'U', 0, a, 1, e, ip, w, 0, info )
419 CALL chkxer(
'CHETRI_3', infot, nout, lerr, ok )
421 CALL chetri_3(
'U', 0, a, 1, e, ip, w, -2, info )
422 CALL chkxer(
'CHETRI_3', infot, nout, lerr, ok )
428 CALL chetri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
429 CALL chkxer(
'CHETRI_3X', infot, nout, lerr, ok )
431 CALL chetri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
432 CALL chkxer(
'CHETRI_3X', infot, nout, lerr, ok )
434 CALL chetri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
435 CALL chkxer(
'CHETRI_3X', infot, nout, lerr, ok )
441 CALL chetrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
442 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
444 CALL chetrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
445 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
447 CALL chetrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
448 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
450 CALL chetrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
451 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
453 CALL chetrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
454 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
460 CALL checon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, info )
461 CALL chkxer(
'CHECON_3', infot, nout, lerr, ok )
463 CALL checon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, info )
464 CALL chkxer(
'CHECON_3', infot, nout, lerr, ok )
466 CALL checon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, info )
467 CALL chkxer(
'CHECON_3', infot, nout, lerr, ok )
469 CALL checon_3(
'U', 1, a, 1, e, ip, -1.0e0, rcond, w, info)
470 CALL chkxer(
'CHECON_3', infot, nout, lerr, ok )
472 ELSE IF( lsamen( 2, c2,
'HA' ) )
THEN
481 CALL chetrf_aa(
'/', 0, a, 1, ip, w, 1, info )
482 CALL chkxer(
'CHETRF_AA', infot, nout, lerr, ok )
484 CALL chetrf_aa(
'U', -1, a, 1, ip, w, 1, info )
485 CALL chkxer(
'CHETRF_AA', infot, nout, lerr, ok )
487 CALL chetrf_aa(
'U', 2, a, 1, ip, w, 4, info )
488 CALL chkxer(
'CHETRF_AA', infot, nout, lerr, ok )
490 CALL chetrf_aa(
'U', 2, a, 2, ip, w, 0, info )
491 CALL chkxer(
'CHETRF_AA', infot, nout, lerr, ok )
493 CALL chetrf_aa(
'U', 2, a, 2, ip, w, -2, info )
494 CALL chkxer(
'CHETRF_AA', infot, nout, lerr, ok )
500 CALL chetrs_aa(
'/', 0, 0, a, 1, ip, b, 1, w, 1, info )
501 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
503 CALL chetrs_aa(
'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
504 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
506 CALL chetrs_aa(
'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
507 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
509 CALL chetrs_aa(
'U', 2, 1, a, 1, ip, b, 2, w, 1, info )
510 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
512 CALL chetrs_aa(
'U', 2, 1, a, 2, ip, b, 1, w, 1, info )
513 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
515 CALL chetrs_aa(
'U', 2, 1, a, 2, ip, b, 2, w, 0, info )
516 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
518 CALL chetrs_aa(
'U', 2, 1, a, 2, ip, b, 2, w, -2, info )
519 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
521 ELSE IF( lsamen( 2, c2,
'H2' ) )
THEN
528 srnamt =
'CHETRF_AA_2STAGE'
530 CALL chetrf_aa_2stage(
'/', 0, a, 1, a, 1, ip, ip, w, 1,
532 CALL chkxer(
'CHETRF_AA_2STAGE', infot, nout, lerr, ok )
534 CALL chetrf_aa_2stage(
'U', -1, a, 1, a, 1, ip, ip, w, 1,
536 CALL chkxer(
'CHETRF_AA_2STAGE', infot, nout, lerr, ok )
538 CALL chetrf_aa_2stage(
'U', 2, a, 1, a, 2, ip, ip, w, 1,
540 CALL chkxer(
'CHETRF_AA_2STAGE', infot, nout, lerr, ok )
542 CALL chetrf_aa_2stage(
'U', 2, a, 2, a, 1, ip, ip, w, 1,
544 CALL chkxer(
'CHETRF_AA_2STAGE', infot, nout, lerr, ok )
546 CALL chetrf_aa_2stage(
'U', 2, a, 2, a, 8, ip, ip, w, 0,
548 CALL chkxer(
'CHETRF_AA_2STAGE', infot, nout, lerr, ok )
552 srnamt =
'CHETRS_AA_2STAGE'
556 CALL chkxer(
'CHETRS_AA_2STAGE', infot, nout, lerr, ok )
560 CALL chkxer(
'CHETRS_AA_2STAGE', infot, nout, lerr, ok )
564 CALL chkxer(
'CHETRS_AA_2STAGE', infot, nout, lerr, ok )
568 CALL chkxer(
'CHETRS_AA_2STAGE', infot, nout, lerr, ok )
572 CALL chkxer(
'CHETRS_AA_2STAGE', infot, nout, lerr, ok )
576 CALL chkxer(
'CHETRS_AA_STAGE', infot, nout, lerr, ok )
582 ELSE IF( lsamen( 2, c2,
'HP' ) )
THEN
588 CALL chptrf(
'/', 0, a, ip, info )
589 CALL chkxer(
'CHPTRF', infot, nout, lerr, ok )
591 CALL chptrf(
'U', -1, a, ip, info )
592 CALL chkxer(
'CHPTRF', infot, nout, lerr, ok )
598 CALL chptri(
'/', 0, a, ip, w, info )
599 CALL chkxer(
'CHPTRI', infot, nout, lerr, ok )
601 CALL chptri(
'U', -1, a, ip, w, info )
602 CALL chkxer(
'CHPTRI', infot, nout, lerr, ok )
608 CALL chptrs(
'/', 0, 0, a, ip, b, 1, info )
609 CALL chkxer(
'CHPTRS', infot, nout, lerr, ok )
611 CALL chptrs(
'U', -1, 0, a, ip, b, 1, info )
612 CALL chkxer(
'CHPTRS', infot, nout, lerr, ok )
614 CALL chptrs(
'U', 0, -1, a, ip, b, 1, info )
615 CALL chkxer(
'CHPTRS', infot, nout, lerr, ok )
617 CALL chptrs(
'U', 2, 1, a, ip, b, 1, info )
618 CALL chkxer(
'CHPTRS', infot, nout, lerr, ok )
624 CALL chprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
626 CALL chkxer(
'CHPRFS', infot, nout, lerr, ok )
628 CALL chprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
630 CALL chkxer(
'CHPRFS', infot, nout, lerr, ok )
632 CALL chprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
634 CALL chkxer(
'CHPRFS', infot, nout, lerr, ok )
636 CALL chprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
638 CALL chkxer(
'CHPRFS', infot, nout, lerr, ok )
640 CALL chprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
642 CALL chkxer(
'CHPRFS', infot, nout, lerr, ok )
648 CALL chpcon(
'/', 0, a, ip, anrm, rcond, w, info )
649 CALL chkxer(
'CHPCON', infot, nout, lerr, ok )
651 CALL chpcon(
'U', -1, a, ip, anrm, rcond, w, info )
652 CALL chkxer(
'CHPCON', infot, nout, lerr, ok )
654 CALL chpcon(
'U', 1, a, ip, -anrm, rcond, w, info )
655 CALL chkxer(
'CHPCON', infot, nout, lerr, ok )
660 CALL alaesm( path, ok, nout )
subroutine alaesm(path, ok, nout)
ALAESM
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine cerrhe(path, nunit)
CERRHE
subroutine checon_3(uplo, n, a, lda, e, ipiv, anorm, rcond, work, info)
CHECON_3
subroutine csycon_3(uplo, n, a, lda, e, ipiv, anorm, rcond, work, info)
CSYCON_3
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 obt...
subroutine checon(uplo, n, a, lda, ipiv, anorm, rcond, work, info)
CHECON
subroutine cherfs(uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CHERFS
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 chetf2_rook(uplo, n, a, lda, ipiv, info)
CHETF2_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
subroutine chetf2(uplo, n, a, lda, ipiv, info)
CHETF2 computes the factorization of a complex Hermitian matrix, using the diagonal pivoting method (...
subroutine chetrf_aa_2stage(uplo, n, a, lda, tb, ltb, ipiv, ipiv2, work, lwork, info)
CHETRF_AA_2STAGE
subroutine chetrf_aa(uplo, n, a, lda, ipiv, work, lwork, info)
CHETRF_AA
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 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 chetrf(uplo, n, a, lda, ipiv, work, lwork, info)
CHETRF
subroutine chetri2(uplo, n, a, lda, ipiv, work, lwork, info)
CHETRI2
subroutine chetri2x(uplo, n, a, lda, ipiv, work, nb, info)
CHETRI2X
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 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 chetrs_3(uplo, n, nrhs, a, lda, e, ipiv, b, ldb, info)
CHETRS_3
subroutine chetrs_aa_2stage(uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, info)
CHETRS_AA_2STAGE
subroutine chetrs_aa(uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork, info)
CHETRS_AA
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 chetrs(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
CHETRS
subroutine chpcon(uplo, n, ap, ipiv, anorm, rcond, work, info)
CHPCON
subroutine chprfs(uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CHPRFS
subroutine chptrf(uplo, n, ap, ipiv, info)
CHPTRF
subroutine chptri(uplo, n, ap, ipiv, work, info)
CHPTRI
subroutine chptrs(uplo, n, nrhs, ap, ipiv, b, ldb, info)
CHPTRS