78 REAL R( NMAX ), R1( NMAX ), R2( NMAX )
79 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
80 $ E( NMAX), W( 2*NMAX ), X( NMAX )
100 COMMON / infoc / infot, nout, ok, lerr
101 COMMON / srnamc / srnamt
104 INTRINSIC cmplx, real
109 WRITE( nout, fmt = * )
116 a( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
117 af( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
130 IF( lsamen( 2, c2,
'SY' ) )
THEN
140 CALL csytrf(
'/', 0, a, 1, ip, w, 1, info )
141 CALL chkxer(
'CSYTRF', infot, nout, lerr, ok )
143 CALL csytrf(
'U', -1, a, 1, ip, w, 1, info )
144 CALL chkxer(
'CSYTRF', infot, nout, lerr, ok )
146 CALL csytrf(
'U', 2, a, 1, ip, w, 4, info )
147 CALL chkxer(
'CSYTRF', infot, nout, lerr, ok )
149 CALL csytrf(
'U', 0, a, 1, ip, w, 0, info )
150 CALL chkxer(
'CSYTRF', infot, nout, lerr, ok )
152 CALL csytrf(
'U', 0, a, 1, ip, w, -2, info )
153 CALL chkxer(
'CSYTRF', infot, nout, lerr, ok )
159 CALL csytf2(
'/', 0, a, 1, ip, info )
160 CALL chkxer(
'CSYTF2', infot, nout, lerr, ok )
162 CALL csytf2(
'U', -1, a, 1, ip, info )
163 CALL chkxer(
'CSYTF2', infot, nout, lerr, ok )
165 CALL csytf2(
'U', 2, a, 1, ip, info )
166 CALL chkxer(
'CSYTF2', infot, nout, lerr, ok )
172 CALL csytri(
'/', 0, a, 1, ip, w, info )
173 CALL chkxer(
'CSYTRI', infot, nout, lerr, ok )
175 CALL csytri(
'U', -1, a, 1, ip, w, info )
176 CALL chkxer(
'CSYTRI', infot, nout, lerr, ok )
178 CALL csytri(
'U', 2, a, 1, ip, w, info )
179 CALL chkxer(
'CSYTRI', infot, nout, lerr, ok )
185 CALL csytri2(
'/', 0, a, 1, ip, w, 1, info )
186 CALL chkxer(
'CSYTRI2', infot, nout, lerr, ok )
188 CALL csytri2(
'U', -1, a, 1, ip, w, 1, info )
189 CALL chkxer(
'CSYTRI2', infot, nout, lerr, ok )
191 CALL csytri2(
'U', 2, a, 1, ip, w, 1, info )
192 CALL chkxer(
'CSYTRI2', infot, nout, lerr, ok )
198 CALL csytri2x(
'/', 0, a, 1, ip, w, 1, info )
199 CALL chkxer(
'CSYTRI2X', infot, nout, lerr, ok )
201 CALL csytri2x(
'U', -1, a, 1, ip, w, 1, info )
202 CALL chkxer(
'CSYTRI2X', infot, nout, lerr, ok )
204 CALL csytri2x(
'U', 2, a, 1, ip, w, 1, info )
205 CALL chkxer(
'CSYTRI2X', infot, nout, lerr, ok )
211 CALL csytrs(
'/', 0, 0, a, 1, ip, b, 1, info )
212 CALL chkxer(
'CSYTRS', infot, nout, lerr, ok )
214 CALL csytrs(
'U', -1, 0, a, 1, ip, b, 1, info )
215 CALL chkxer(
'CSYTRS', infot, nout, lerr, ok )
217 CALL csytrs(
'U', 0, -1, a, 1, ip, b, 1, info )
218 CALL chkxer(
'CSYTRS', infot, nout, lerr, ok )
220 CALL csytrs(
'U', 2, 1, a, 1, ip, b, 2, info )
221 CALL chkxer(
'CSYTRS', infot, nout, lerr, ok )
223 CALL csytrs(
'U', 2, 1, a, 2, ip, b, 1, info )
224 CALL chkxer(
'CSYTRS', infot, nout, lerr, ok )
230 CALL csyrfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
232 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
234 CALL csyrfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
236 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
238 CALL csyrfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
240 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
242 CALL csyrfs(
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
244 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
246 CALL csyrfs(
'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
248 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
250 CALL csyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
252 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
254 CALL csyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
256 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
262 CALL csycon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
263 CALL chkxer(
'CSYCON', infot, nout, lerr, ok )
265 CALL csycon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
266 CALL chkxer(
'CSYCON', infot, nout, lerr, ok )
268 CALL csycon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
269 CALL chkxer(
'CSYCON', infot, nout, lerr, ok )
271 CALL csycon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
272 CALL chkxer(
'CSYCON', infot, nout, lerr, ok )
274 ELSE IF( lsamen( 2, c2,
'SR' ) )
THEN
282 srnamt =
'CSYTRF_ROOK'
285 CALL chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
288 CALL chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
291 CALL chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
294 CALL chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
297 CALL chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
301 srnamt =
'CSYTF2_ROOK'
304 CALL chkxer(
'CSYTF2_ROOK', infot, nout, lerr, ok )
307 CALL chkxer(
'CSYTF2_ROOK', infot, nout, lerr, ok )
310 CALL chkxer(
'CSYTF2_ROOK', infot, nout, lerr, ok )
314 srnamt =
'CSYTRI_ROOK'
317 CALL chkxer(
'CSYTRI_ROOK', infot, nout, lerr, ok )
320 CALL chkxer(
'CSYTRI_ROOK', infot, nout, lerr, ok )
323 CALL chkxer(
'CSYTRI_ROOK', infot, nout, lerr, ok )
327 srnamt =
'CSYTRS_ROOK'
329 CALL csytrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
330 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
332 CALL csytrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
333 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
335 CALL csytrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
336 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
338 CALL csytrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
339 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
341 CALL csytrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
342 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
346 srnamt =
'CSYCON_ROOK'
348 CALL csycon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
349 CALL chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
351 CALL csycon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
352 CALL chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
354 CALL csycon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, info )
355 CALL chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
357 CALL csycon_rook(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
358 CALL chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
360 ELSE IF( lsamen( 2, c2,
'SK' ) )
THEN
374 CALL csytrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
375 CALL chkxer(
'CSYTRF_RK', infot, nout, lerr, ok )
377 CALL csytrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
378 CALL chkxer(
'CSYTRF_RK', infot, nout, lerr, ok )
380 CALL csytrf_rk(
'U', 2, a, 1, e, ip, w, 4, info )
381 CALL chkxer(
'CSYTRF_RK', infot, nout, lerr, ok )
383 CALL csytrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
384 CALL chkxer(
'CSYTRF_RK', infot, nout, lerr, ok )
386 CALL csytrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
387 CALL chkxer(
'CSYTRF_RK', infot, nout, lerr, ok )
393 CALL csytf2_rk(
'/', 0, a, 1, e, ip, info )
394 CALL chkxer(
'CSYTF2_RK', infot, nout, lerr, ok )
396 CALL csytf2_rk(
'U', -1, a, 1, e, ip, info )
397 CALL chkxer(
'CSYTF2_RK', infot, nout, lerr, ok )
399 CALL csytf2_rk(
'U', 2, a, 1, e, ip, info )
400 CALL chkxer(
'CSYTF2_RK', infot, nout, lerr, ok )
406 CALL csytri_3(
'/', 0, a, 1, e, ip, w, 1, info )
407 CALL chkxer(
'CSYTRI_3', infot, nout, lerr, ok )
409 CALL csytri_3(
'U', -1, a, 1, e, ip, w, 1, info )
410 CALL chkxer(
'CSYTRI_3', infot, nout, lerr, ok )
412 CALL csytri_3(
'U', 2, a, 1, e, ip, w, 1, info )
413 CALL chkxer(
'CSYTRI_3', infot, nout, lerr, ok )
415 CALL csytri_3(
'U', 0, a, 1, e, ip, w, 0, info )
416 CALL chkxer(
'CSYTRI_3', infot, nout, lerr, ok )
418 CALL csytri_3(
'U', 0, a, 1, e, ip, w, -2, info )
419 CALL chkxer(
'CSYTRI_3', infot, nout, lerr, ok )
425 CALL csytri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
426 CALL chkxer(
'CSYTRI_3X', infot, nout, lerr, ok )
428 CALL csytri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
429 CALL chkxer(
'CSYTRI_3X', infot, nout, lerr, ok )
431 CALL csytri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
432 CALL chkxer(
'CSYTRI_3X', infot, nout, lerr, ok )
438 CALL csytrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
439 CALL chkxer(
'CSYTRS_3', infot, nout, lerr, ok )
441 CALL csytrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
442 CALL chkxer(
'CSYTRS_3', infot, nout, lerr, ok )
444 CALL csytrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
445 CALL chkxer(
'CSYTRS_3', infot, nout, lerr, ok )
447 CALL csytrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
448 CALL chkxer(
'CSYTRS_3', infot, nout, lerr, ok )
450 CALL csytrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
451 CALL chkxer(
'CSYTRS_3', infot, nout, lerr, ok )
457 CALL csycon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, info )
458 CALL chkxer(
'CSYCON_3', infot, nout, lerr, ok )
460 CALL csycon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, info )
461 CALL chkxer(
'CSYCON_3', infot, nout, lerr, ok )
463 CALL csycon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, info )
464 CALL chkxer(
'CSYCON_3', infot, nout, lerr, ok )
466 CALL csycon_3(
'U', 1, a, 1, e, ip, -1.0e0, rcond, w, info)
467 CALL chkxer(
'CSYCON_3', infot, nout, lerr, ok )
469 ELSE IF( lsamen( 2, c2,
'SP' ) )
THEN
479 CALL csptrf(
'/', 0, a, ip, info )
480 CALL chkxer(
'CSPTRF', infot, nout, lerr, ok )
482 CALL csptrf(
'U', -1, a, ip, info )
483 CALL chkxer(
'CSPTRF', infot, nout, lerr, ok )
489 CALL csptri(
'/', 0, a, ip, w, info )
490 CALL chkxer(
'CSPTRI', infot, nout, lerr, ok )
492 CALL csptri(
'U', -1, a, ip, w, info )
493 CALL chkxer(
'CSPTRI', infot, nout, lerr, ok )
499 CALL csptrs(
'/', 0, 0, a, ip, b, 1, info )
500 CALL chkxer(
'CSPTRS', infot, nout, lerr, ok )
502 CALL csptrs(
'U', -1, 0, a, ip, b, 1, info )
503 CALL chkxer(
'CSPTRS', infot, nout, lerr, ok )
505 CALL csptrs(
'U', 0, -1, a, ip, b, 1, info )
506 CALL chkxer(
'CSPTRS', infot, nout, lerr, ok )
508 CALL csptrs(
'U', 2, 1, a, ip, b, 1, info )
509 CALL chkxer(
'CSPTRS', infot, nout, lerr, ok )
515 CALL csprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
517 CALL chkxer(
'CSPRFS', infot, nout, lerr, ok )
519 CALL csprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
521 CALL chkxer(
'CSPRFS', infot, nout, lerr, ok )
523 CALL csprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
525 CALL chkxer(
'CSPRFS', infot, nout, lerr, ok )
527 CALL csprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
529 CALL chkxer(
'CSPRFS', infot, nout, lerr, ok )
531 CALL csprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
533 CALL chkxer(
'CSPRFS', infot, nout, lerr, ok )
539 CALL cspcon(
'/', 0, a, ip, anrm, rcond, w, info )
540 CALL chkxer(
'CSPCON', infot, nout, lerr, ok )
542 CALL cspcon(
'U', -1, a, ip, anrm, rcond, w, info )
543 CALL chkxer(
'CSPCON', infot, nout, lerr, ok )
545 CALL cspcon(
'U', 1, a, ip, -anrm, rcond, w, info )
546 CALL chkxer(
'CSPCON', infot, nout, lerr, ok )
548 ELSE IF( lsamen( 2, c2,
'SA' ) )
THEN
557 CALL csytrf_aa(
'/', 0, a, 1, ip, w, 1, info )
558 CALL chkxer(
'CSYTRF_AA', infot, nout, lerr, ok )
560 CALL csytrf_aa(
'U', -1, a, 1, ip, w, 1, info )
561 CALL chkxer(
'CSYTRF_AA', infot, nout, lerr, ok )
563 CALL csytrf_aa(
'U', 2, a, 1, ip, w, 4, info )
564 CALL chkxer(
'CSYTRF_AA', infot, nout, lerr, ok )
566 CALL csytrf_aa(
'U', 0, a, 1, ip, w, 0, info )
567 CALL chkxer(
'CSYTRF_AA', infot, nout, lerr, ok )
569 CALL csytrf_aa(
'U', 0, a, 1, ip, w, -2, info )
570 CALL chkxer(
'CSYTRF_AA', infot, nout, lerr, ok )
576 CALL csytrs_aa(
'/', 0, 0, a, 1, ip, b, 1, w, 1, info )
577 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
579 CALL csytrs_aa(
'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
580 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
582 CALL csytrs_aa(
'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
583 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
585 CALL csytrs_aa(
'U', 2, 1, a, 1, ip, b, 2, w, 1, info )
586 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
588 CALL csytrs_aa(
'U', 2, 1, a, 2, ip, b, 1, w, 1, info )
589 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
591 CALL csytrs_aa(
'U', 0, 1, a, 1, ip, b, 1, w, 0, info )
592 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
594 CALL csytrs_aa(
'U', 0, 1, a, 1, ip, b, 1, w, -2, info )
595 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
597 ELSE IF( lsamen( 2, c2,
'S2' ) )
THEN
604 srnamt =
'CSYTRF_AA_2STAGE'
606 CALL csytrf_aa_2stage(
'/', 0, a, 1, a, 1, ip, ip, w, 1,
608 CALL chkxer(
'CSYTRF_AA_2STAGE', infot, nout, lerr, ok )
610 CALL csytrf_aa_2stage(
'U', -1, a, 1, a, 1, ip, ip, w, 1,
612 CALL chkxer(
'CSYTRF_AA_2STAGE', infot, nout, lerr, ok )
614 CALL csytrf_aa_2stage(
'U', 2, a, 1, a, 2, ip, ip, w, 1,
616 CALL chkxer(
'CSYTRF_AA_2STAGE', infot, nout, lerr, ok )
618 CALL csytrf_aa_2stage(
'U', 2, a, 2, a, 1, ip, ip, w, 1,
620 CALL chkxer(
'CSYTRF_AA_2STAGE', infot, nout, lerr, ok )
622 CALL csytrf_aa_2stage(
'U', 2, a, 2, a, 8, ip, ip, w, 0,
624 CALL chkxer(
'CSYTRF_AA_2STAGE', infot, nout, lerr, ok )
628 srnamt =
'CSYTRS_AA_2STAGE'
632 CALL chkxer(
'CSYTRS_AA_2STAGE', infot, nout, lerr, ok )
636 CALL chkxer(
'CSYTRS_AA_2STAGE', infot, nout, lerr, ok )
640 CALL chkxer(
'CSYTRS_AA_2STAGE', infot, nout, lerr, ok )
644 CALL chkxer(
'CSYTRS_AA_2STAGE', infot, nout, lerr, ok )
648 CALL chkxer(
'CSYTRS_AA_2STAGE', infot, nout, lerr, ok )
652 CALL chkxer(
'CSYTRS_AA_STAGE', infot, nout, lerr, ok )
658 CALL alaesm( path, ok, nout )
subroutine alaesm(path, ok, nout)
ALAESM
subroutine chkxer(srnamt, infot, nout, lerr, ok)
subroutine cerrsy(path, nunit)
CERRSY
subroutine csycon_3(uplo, n, a, lda, e, ipiv, anorm, rcond, work, info)
CSYCON_3
subroutine csycon_rook(uplo, n, a, lda, ipiv, anorm, rcond, work, info)
CSYCON_ROOK
subroutine csycon(uplo, n, a, lda, ipiv, anorm, rcond, work, info)
CSYCON
subroutine csyrfs(uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CSYRFS
subroutine csytf2_rk(uplo, n, a, lda, e, ipiv, info)
CSYTF2_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch...
subroutine csytf2_rook(uplo, n, a, lda, ipiv, info)
CSYTF2_ROOK computes the factorization of a complex symmetric indefinite matrix using the bounded Bun...
subroutine csytf2(uplo, n, a, lda, ipiv, info)
CSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...
subroutine csytrf_aa_2stage(uplo, n, a, lda, tb, ltb, ipiv, ipiv2, work, lwork, info)
CSYTRF_AA_2STAGE
subroutine csytrf_aa(uplo, n, a, lda, ipiv, work, lwork, info)
CSYTRF_AA
subroutine csytrf_rk(uplo, n, a, lda, e, ipiv, work, lwork, info)
CSYTRF_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch...
subroutine csytrf_rook(uplo, n, a, lda, ipiv, work, lwork, info)
CSYTRF_ROOK
subroutine csytrf(uplo, n, a, lda, ipiv, work, lwork, info)
CSYTRF
subroutine csytri2(uplo, n, a, lda, ipiv, work, lwork, info)
CSYTRI2
subroutine csytri2x(uplo, n, a, lda, ipiv, work, nb, info)
CSYTRI2X
subroutine csytri_3(uplo, n, a, lda, e, ipiv, work, lwork, info)
CSYTRI_3
subroutine csytri_3x(uplo, n, a, lda, e, ipiv, work, nb, info)
CSYTRI_3X
subroutine csytri_rook(uplo, n, a, lda, ipiv, work, info)
CSYTRI_ROOK
subroutine csytri(uplo, n, a, lda, ipiv, work, info)
CSYTRI
subroutine csytrs_3(uplo, n, nrhs, a, lda, e, ipiv, b, ldb, info)
CSYTRS_3
subroutine csytrs_aa_2stage(uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, info)
CSYTRS_AA_2STAGE
subroutine csytrs_aa(uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork, info)
CSYTRS_AA
subroutine csytrs_rook(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
CSYTRS_ROOK
subroutine csytrs(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
CSYTRS
subroutine cspcon(uplo, n, ap, ipiv, anorm, rcond, work, info)
CSPCON
subroutine csprfs(uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CSPRFS
subroutine csptrf(uplo, n, ap, ipiv, info)
CSPTRF
subroutine csptri(uplo, n, ap, ipiv, work, info)
CSPTRI
subroutine csptrs(uplo, n, nrhs, ap, ipiv, b, ldb, info)
CSPTRS