72 parameter ( nmax = 4 )
81 REAL r( nmax ), r1( nmax ), r2( nmax )
82 COMPLEX a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
83 $ 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,
'SY' ) )
THEN
143 CALL csytrf(
'/', 0, a, 1, ip, w, 1, info )
144 CALL chkxer(
'CSYTRF', infot, nout, lerr, ok )
146 CALL csytrf(
'U', -1, a, 1, ip, w, 1, info )
147 CALL chkxer(
'CSYTRF', infot, nout, lerr, ok )
149 CALL csytrf(
'U', 2, a, 1, ip, w, 4, info )
150 CALL chkxer(
'CSYTRF', infot, nout, lerr, ok )
152 CALL csytrf(
'U', 0, a, 1, ip, w, 0, info )
153 CALL chkxer(
'CSYTRF', infot, nout, lerr, ok )
155 CALL csytrf(
'U', 0, a, 1, ip, w, -2, info )
156 CALL chkxer(
'CSYTRF', infot, nout, lerr, ok )
162 CALL csytf2(
'/', 0, a, 1, ip, info )
163 CALL chkxer(
'CSYTF2', infot, nout, lerr, ok )
165 CALL csytf2(
'U', -1, a, 1, ip, info )
166 CALL chkxer(
'CSYTF2', infot, nout, lerr, ok )
168 CALL csytf2(
'U', 2, a, 1, ip, info )
169 CALL chkxer(
'CSYTF2', infot, nout, lerr, ok )
175 CALL csytri(
'/', 0, a, 1, ip, w, info )
176 CALL chkxer(
'CSYTRI', infot, nout, lerr, ok )
178 CALL csytri(
'U', -1, a, 1, ip, w, info )
179 CALL chkxer(
'CSYTRI', infot, nout, lerr, ok )
181 CALL csytri(
'U', 2, a, 1, ip, w, info )
182 CALL chkxer(
'CSYTRI', infot, nout, lerr, ok )
188 CALL csytri2(
'/', 0, a, 1, ip, w, 1, info )
189 CALL chkxer(
'CSYTRI2', infot, nout, lerr, ok )
191 CALL csytri2(
'U', -1, a, 1, ip, w, 1, info )
192 CALL chkxer(
'CSYTRI2', infot, nout, lerr, ok )
194 CALL csytri2(
'U', 2, a, 1, ip, w, 1, info )
195 CALL chkxer(
'CSYTRI2', infot, nout, lerr, ok )
201 CALL csytri2x(
'/', 0, a, 1, ip, w, 1, info )
202 CALL chkxer(
'CSYTRI2X', infot, nout, lerr, ok )
204 CALL csytri2x(
'U', -1, a, 1, ip, w, 1, info )
205 CALL chkxer(
'CSYTRI2X', infot, nout, lerr, ok )
207 CALL csytri2x(
'U', 2, a, 1, ip, w, 1, info )
208 CALL chkxer(
'CSYTRI2X', infot, nout, lerr, ok )
214 CALL csytrs(
'/', 0, 0, a, 1, ip, b, 1, info )
215 CALL chkxer(
'CSYTRS', infot, nout, lerr, ok )
217 CALL csytrs(
'U', -1, 0, a, 1, ip, b, 1, info )
218 CALL chkxer(
'CSYTRS', infot, nout, lerr, ok )
220 CALL csytrs(
'U', 0, -1, a, 1, ip, b, 1, info )
221 CALL chkxer(
'CSYTRS', infot, nout, lerr, ok )
223 CALL csytrs(
'U', 2, 1, a, 1, ip, b, 2, info )
224 CALL chkxer(
'CSYTRS', infot, nout, lerr, ok )
226 CALL csytrs(
'U', 2, 1, a, 2, ip, b, 1, info )
227 CALL chkxer(
'CSYTRS', infot, nout, lerr, ok )
233 CALL csyrfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
235 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
237 CALL csyrfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
239 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
241 CALL csyrfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
243 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
245 CALL csyrfs(
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
247 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
249 CALL csyrfs(
'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
251 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
253 CALL csyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
255 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
257 CALL csyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
259 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
265 CALL csycon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
266 CALL chkxer(
'CSYCON', infot, nout, lerr, ok )
268 CALL csycon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
269 CALL chkxer(
'CSYCON', infot, nout, lerr, ok )
271 CALL csycon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
272 CALL chkxer(
'CSYCON', infot, nout, lerr, ok )
274 CALL csycon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
275 CALL chkxer(
'CSYCON', infot, nout, lerr, ok )
277 ELSE IF(
lsamen( 2, c2,
'SR' ) )
THEN
285 srnamt =
'CSYTRF_ROOK'
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 )
300 CALL chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
304 srnamt =
'CSYTF2_ROOK'
307 CALL chkxer(
'CSYTF2_ROOK', infot, nout, lerr, ok )
310 CALL chkxer(
'CSYTF2_ROOK', infot, nout, lerr, ok )
313 CALL chkxer(
'CSYTF2_ROOK', infot, nout, lerr, ok )
317 srnamt =
'CSYTRI_ROOK'
320 CALL chkxer(
'CSYTRI_ROOK', infot, nout, lerr, ok )
323 CALL chkxer(
'CSYTRI_ROOK', infot, nout, lerr, ok )
326 CALL chkxer(
'CSYTRI_ROOK', infot, nout, lerr, ok )
330 srnamt =
'CSYTRS_ROOK'
332 CALL csytrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
333 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
335 CALL csytrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
336 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
338 CALL csytrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
339 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
341 CALL csytrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
342 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
344 CALL csytrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
345 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
349 srnamt =
'CSYCON_ROOK'
351 CALL csycon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
352 CALL chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
354 CALL csycon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
355 CALL chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
357 CALL csycon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, info )
358 CALL chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
360 CALL csycon_rook(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
361 CALL chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
363 ELSE IF(
lsamen( 2, c2,
'SK' ) )
THEN
377 CALL csytrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
378 CALL chkxer(
'CSYTRF_RK', infot, nout, lerr, ok )
380 CALL csytrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
381 CALL chkxer(
'CSYTRF_RK', infot, nout, lerr, ok )
383 CALL csytrf_rk(
'U', 2, a, 1, e, ip, w, 4, info )
384 CALL chkxer(
'CSYTRF_RK', infot, nout, lerr, ok )
386 CALL csytrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
387 CALL chkxer(
'CSYTRF_RK', infot, nout, lerr, ok )
389 CALL csytrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
390 CALL chkxer(
'CSYTRF_RK', infot, nout, lerr, ok )
396 CALL csytf2_rk(
'/', 0, a, 1, e, ip, info )
397 CALL chkxer(
'CSYTF2_RK', infot, nout, lerr, ok )
399 CALL csytf2_rk(
'U', -1, a, 1, e, ip, info )
400 CALL chkxer(
'CSYTF2_RK', infot, nout, lerr, ok )
402 CALL csytf2_rk(
'U', 2, a, 1, e, ip, info )
403 CALL chkxer(
'CSYTF2_RK', infot, nout, lerr, ok )
409 CALL csytri_3(
'/', 0, a, 1, e, ip, w, 1, info )
410 CALL chkxer(
'CSYTRI_3', infot, nout, lerr, ok )
412 CALL csytri_3(
'U', -1, a, 1, e, ip, w, 1, info )
413 CALL chkxer(
'CSYTRI_3', infot, nout, lerr, ok )
415 CALL csytri_3(
'U', 2, a, 1, e, ip, w, 1, info )
416 CALL chkxer(
'CSYTRI_3', infot, nout, lerr, ok )
418 CALL csytri_3(
'U', 0, a, 1, e, ip, w, 0, info )
419 CALL chkxer(
'CSYTRI_3', infot, nout, lerr, ok )
421 CALL csytri_3(
'U', 0, a, 1, e, ip, w, -2, info )
422 CALL chkxer(
'CSYTRI_3', infot, nout, lerr, ok )
428 CALL csytri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
429 CALL chkxer(
'CSYTRI_3X', infot, nout, lerr, ok )
431 CALL csytri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
432 CALL chkxer(
'CSYTRI_3X', infot, nout, lerr, ok )
434 CALL csytri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
435 CALL chkxer(
'CSYTRI_3X', infot, nout, lerr, ok )
441 CALL csytrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
442 CALL chkxer(
'CSYTRS_3', infot, nout, lerr, ok )
444 CALL csytrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
445 CALL chkxer(
'CSYTRS_3', infot, nout, lerr, ok )
447 CALL csytrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
448 CALL chkxer(
'CSYTRS_3', infot, nout, lerr, ok )
450 CALL csytrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
451 CALL chkxer(
'CSYTRS_3', infot, nout, lerr, ok )
453 CALL csytrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
454 CALL chkxer(
'CSYTRS_3', infot, nout, lerr, ok )
460 CALL csycon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, info )
461 CALL chkxer(
'CSYCON_3', infot, nout, lerr, ok )
463 CALL csycon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, info )
464 CALL chkxer(
'CSYCON_3', infot, nout, lerr, ok )
466 CALL csycon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, info )
467 CALL chkxer(
'CSYCON_3', infot, nout, lerr, ok )
469 CALL csycon_3(
'U', 1, a, 1, e, ip, -1.0e0, rcond, w, info)
470 CALL chkxer(
'CSYCON_3', infot, nout, lerr, ok )
472 ELSE IF(
lsamen( 2, c2,
'SP' ) )
THEN
482 CALL csptrf(
'/', 0, a, ip, info )
483 CALL chkxer(
'CSPTRF', infot, nout, lerr, ok )
485 CALL csptrf(
'U', -1, a, ip, info )
486 CALL chkxer(
'CSPTRF', infot, nout, lerr, ok )
492 CALL csptri(
'/', 0, a, ip, w, info )
493 CALL chkxer(
'CSPTRI', infot, nout, lerr, ok )
495 CALL csptri(
'U', -1, a, ip, w, info )
496 CALL chkxer(
'CSPTRI', infot, nout, lerr, ok )
502 CALL csptrs(
'/', 0, 0, a, ip, b, 1, info )
503 CALL chkxer(
'CSPTRS', infot, nout, lerr, ok )
505 CALL csptrs(
'U', -1, 0, a, ip, b, 1, info )
506 CALL chkxer(
'CSPTRS', infot, nout, lerr, ok )
508 CALL csptrs(
'U', 0, -1, a, ip, b, 1, info )
509 CALL chkxer(
'CSPTRS', infot, nout, lerr, ok )
511 CALL csptrs(
'U', 2, 1, a, ip, b, 1, info )
512 CALL chkxer(
'CSPTRS', infot, nout, lerr, ok )
518 CALL csprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
520 CALL chkxer(
'CSPRFS', infot, nout, lerr, ok )
522 CALL csprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
524 CALL chkxer(
'CSPRFS', infot, nout, lerr, ok )
526 CALL csprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
528 CALL chkxer(
'CSPRFS', infot, nout, lerr, ok )
530 CALL csprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
532 CALL chkxer(
'CSPRFS', infot, nout, lerr, ok )
534 CALL csprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
536 CALL chkxer(
'CSPRFS', infot, nout, lerr, ok )
542 CALL cspcon(
'/', 0, 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 CALL cspcon(
'U', 1, a, ip, -anrm, rcond, w, info )
549 CALL chkxer(
'CSPCON', infot, nout, lerr, ok )
551 ELSE IF(
lsamen( 2, c2,
'SA' ) )
THEN
560 CALL csytrf_aa(
'/', 0, a, 1, ip, w, 1, info )
561 CALL chkxer(
'CSYTRF_AA', infot, nout, lerr, ok )
563 CALL csytrf_aa(
'U', -1, a, 1, ip, w, 1, info )
564 CALL chkxer(
'CSYTRF_AA', infot, nout, lerr, ok )
566 CALL csytrf_aa(
'U', 2, a, 1, ip, w, 4, info )
567 CALL chkxer(
'CSYTRF_AA', infot, nout, lerr, ok )
569 CALL csytrf_aa(
'U', 0, a, 1, ip, w, 0, info )
570 CALL chkxer(
'CSYTRF_AA', infot, nout, lerr, ok )
572 CALL csytrf_aa(
'U', 0, a, 1, ip, w, -2, info )
573 CALL chkxer(
'CSYTRF_AA', infot, nout, lerr, ok )
579 CALL csytrs_aa(
'/', 0, 0, a, 1, ip, b, 1, w, 1, info )
580 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
582 CALL csytrs_aa(
'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
583 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
585 CALL csytrs_aa(
'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
586 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
588 CALL csytrs_aa(
'U', 2, 1, a, 1, ip, b, 2, w, 1, info )
589 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
591 CALL csytrs_aa(
'U', 2, 1, a, 2, ip, b, 1, w, 1, info )
592 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
594 CALL csytrs_aa(
'U', 0, 1, a, 1, ip, b, 1, w, 0, info )
595 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
597 CALL csytrs_aa(
'U', 0, 1, a, 1, ip, b, 1, w, -2, info )
598 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
604 CALL alaesm( path, ok, nout )
subroutine csytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
CSYTRI_ROOK
subroutine csytri2x(UPLO, N, A, LDA, IPIV, WORK, NB, INFO)
CSYTRI2X
subroutine csyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CSYRFS
subroutine csytrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
CSYTRS_AA
subroutine csptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
CSPTRS
subroutine csytrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF_AA
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine csycon_3(UPLO, N, A, LDA, E, IPIV, ANORM, RCOND, WORK, INFO)
CSYCON_3
subroutine csptri(UPLO, N, AP, IPIV, WORK, INFO)
CSPTRI
subroutine csytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CSYTRS
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 csytri_3x(UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO)
CSYTRI_3X
subroutine csptrf(UPLO, N, AP, IPIV, INFO)
CSPTRF
subroutine csytri(UPLO, N, A, LDA, IPIV, WORK, INFO)
CSYTRI
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 chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine csytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CSYTRS_ROOK
logical function lsamen(N, CA, CB)
LSAMEN
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 csytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF
subroutine csytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF_ROOK
subroutine csycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CSYCON
subroutine csytrs_3(UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO)
CSYTRS_3
subroutine csytri_3(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
CSYTRI_3
subroutine csycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CSYCON_ROOK
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 csytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRI2