72 parameter ( nmax = 4 )
77 DOUBLE PRECISION anrm, rcond
81 DOUBLE PRECISION r( nmax ), r1( nmax ), r2( nmax )
82 COMPLEX*16 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 dble, dcmplx
112 WRITE( nout, fmt = * )
119 a( i, j ) = dcmplx( 1.d0 / dble( i+j ),
120 $ -1.d0 / dble( i+j ) )
121 af( i, j ) = dcmplx( 1.d0 / dble( i+j ),
122 $ -1.d0 / dble( i+j ) )
135 IF(
lsamen( 2, c2,
'SY' ) )
THEN
145 CALL zsytrf(
'/', 0, a, 1, ip, w, 1, info )
146 CALL chkxer(
'ZSYTRF', infot, nout, lerr, ok )
148 CALL zsytrf(
'U', -1, a, 1, ip, w, 1, info )
149 CALL chkxer(
'ZSYTRF', infot, nout, lerr, ok )
151 CALL zsytrf(
'U', 2, a, 1, ip, w, 4, info )
152 CALL chkxer(
'ZSYTRF', infot, nout, lerr, ok )
154 CALL zsytrf(
'U', 0, a, 1, ip, w, 0, info )
155 CALL chkxer(
'ZSYTRF', infot, nout, lerr, ok )
157 CALL zsytrf(
'U', 0, a, 1, ip, w, -2, info )
158 CALL chkxer(
'ZSYTRF', infot, nout, lerr, ok )
164 CALL zsytf2(
'/', 0, a, 1, ip, info )
165 CALL chkxer(
'ZSYTF2', infot, nout, lerr, ok )
167 CALL zsytf2(
'U', -1, a, 1, ip, info )
168 CALL chkxer(
'ZSYTF2', infot, nout, lerr, ok )
170 CALL zsytf2(
'U', 2, a, 1, ip, info )
171 CALL chkxer(
'ZSYTF2', infot, nout, lerr, ok )
177 CALL zsytri(
'/', 0, a, 1, ip, w, info )
178 CALL chkxer(
'ZSYTRI', infot, nout, lerr, ok )
180 CALL zsytri(
'U', -1, a, 1, ip, w, info )
181 CALL chkxer(
'ZSYTRI', infot, nout, lerr, ok )
183 CALL zsytri(
'U', 2, a, 1, ip, w, info )
184 CALL chkxer(
'ZSYTRI', infot, nout, lerr, ok )
190 CALL zsytri2(
'/', 0, a, 1, ip, w, 1, info )
191 CALL chkxer(
'ZSYTRI2', infot, nout, lerr, ok )
193 CALL zsytri2(
'U', -1, a, 1, ip, w, 1, info )
194 CALL chkxer(
'ZSYTRI2', infot, nout, lerr, ok )
196 CALL zsytri2(
'U', 2, a, 1, ip, w, 1, info )
197 CALL chkxer(
'ZSYTRI2', infot, nout, lerr, ok )
203 CALL zsytri2x(
'/', 0, a, 1, ip, w, 1, info )
204 CALL chkxer(
'ZSYTRI2X', infot, nout, lerr, ok )
206 CALL zsytri2x(
'U', -1, a, 1, ip, w, 1, info )
207 CALL chkxer(
'ZSYTRI2X', infot, nout, lerr, ok )
209 CALL zsytri2x(
'U', 2, a, 1, ip, w, 1, info )
210 CALL chkxer(
'ZSYTRI2X', infot, nout, lerr, ok )
216 CALL zsytrs(
'/', 0, 0, a, 1, ip, b, 1, info )
217 CALL chkxer(
'ZSYTRS', infot, nout, lerr, ok )
219 CALL zsytrs(
'U', -1, 0, a, 1, ip, b, 1, info )
220 CALL chkxer(
'ZSYTRS', infot, nout, lerr, ok )
222 CALL zsytrs(
'U', 0, -1, a, 1, ip, b, 1, info )
223 CALL chkxer(
'ZSYTRS', infot, nout, lerr, ok )
225 CALL zsytrs(
'U', 2, 1, a, 1, ip, b, 2, info )
226 CALL chkxer(
'ZSYTRS', infot, nout, lerr, ok )
228 CALL zsytrs(
'U', 2, 1, a, 2, ip, b, 1, info )
229 CALL chkxer(
'ZSYTRS', infot, nout, lerr, ok )
235 CALL zsyrfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
237 CALL chkxer(
'ZSYRFS', infot, nout, lerr, ok )
239 CALL zsyrfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
241 CALL chkxer(
'ZSYRFS', infot, nout, lerr, ok )
243 CALL zsyrfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
245 CALL chkxer(
'ZSYRFS', infot, nout, lerr, ok )
247 CALL zsyrfs(
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
249 CALL chkxer(
'ZSYRFS', infot, nout, lerr, ok )
251 CALL zsyrfs(
'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
253 CALL chkxer(
'ZSYRFS', infot, nout, lerr, ok )
255 CALL zsyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
257 CALL chkxer(
'ZSYRFS', infot, nout, lerr, ok )
259 CALL zsyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
261 CALL chkxer(
'ZSYRFS', infot, nout, lerr, ok )
267 CALL zsycon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
268 CALL chkxer(
'ZSYCON', infot, nout, lerr, ok )
270 CALL zsycon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
271 CALL chkxer(
'ZSYCON', infot, nout, lerr, ok )
273 CALL zsycon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
274 CALL chkxer(
'ZSYCON', infot, nout, lerr, ok )
276 CALL zsycon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
277 CALL chkxer(
'ZSYCON', infot, nout, lerr, ok )
279 ELSE IF(
lsamen( 2, c2,
'SR' ) )
THEN
287 srnamt =
'ZSYTRF_ROOK'
290 CALL chkxer(
'ZSYTRF_ROOK', infot, nout, lerr, ok )
293 CALL chkxer(
'ZSYTRF_ROOK', infot, nout, lerr, ok )
296 CALL chkxer(
'ZSYTRF_ROOK', infot, nout, lerr, ok )
299 CALL chkxer(
'ZSYTRF_ROOK', infot, nout, lerr, ok )
302 CALL chkxer(
'ZSYTRF_ROOK', infot, nout, lerr, ok )
306 srnamt =
'ZSYTF2_ROOK'
309 CALL chkxer(
'ZSYTF2_ROOK', infot, nout, lerr, ok )
312 CALL chkxer(
'ZSYTF2_ROOK', infot, nout, lerr, ok )
315 CALL chkxer(
'ZSYTF2_ROOK', infot, nout, lerr, ok )
319 srnamt =
'ZSYTRI_ROOK'
322 CALL chkxer(
'ZSYTRI_ROOK', infot, nout, lerr, ok )
325 CALL chkxer(
'ZSYTRI_ROOK', infot, nout, lerr, ok )
328 CALL chkxer(
'ZSYTRI_ROOK', infot, nout, lerr, ok )
332 srnamt =
'ZSYTRS_ROOK'
334 CALL zsytrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
335 CALL chkxer(
'ZSYTRS_ROOK', infot, nout, lerr, ok )
337 CALL zsytrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
338 CALL chkxer(
'ZSYTRS_ROOK', infot, nout, lerr, ok )
340 CALL zsytrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
341 CALL chkxer(
'ZSYTRS_ROOK', infot, nout, lerr, ok )
343 CALL zsytrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
344 CALL chkxer(
'ZSYTRS_ROOK', infot, nout, lerr, ok )
346 CALL zsytrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
347 CALL chkxer(
'ZSYTRS_ROOK', infot, nout, lerr, ok )
351 srnamt =
'ZSYCON_ROOK'
353 CALL zsycon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
354 CALL chkxer(
'ZSYCON_ROOK', infot, nout, lerr, ok )
356 CALL zsycon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
357 CALL chkxer(
'ZSYCON_ROOK', infot, nout, lerr, ok )
359 CALL zsycon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, info )
360 CALL chkxer(
'ZSYCON_ROOK', infot, nout, lerr, ok )
362 CALL zsycon_rook(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
363 CALL chkxer(
'ZSYCON_ROOK', infot, nout, lerr, ok )
365 ELSE IF(
lsamen( 2, c2,
'SK' ) )
THEN
379 CALL zsytrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
380 CALL chkxer(
'ZSYTRF_RK', infot, nout, lerr, ok )
382 CALL zsytrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
383 CALL chkxer(
'ZSYTRF_RK', infot, nout, lerr, ok )
385 CALL zsytrf_rk(
'U', 2, a, 1, e, ip, w, 4, info )
386 CALL chkxer(
'ZSYTRF_RK', infot, nout, lerr, ok )
388 CALL zsytrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
389 CALL chkxer(
'ZSYTRF_RK', infot, nout, lerr, ok )
391 CALL zsytrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
392 CALL chkxer(
'ZSYTRF_RK', infot, nout, lerr, ok )
398 CALL zsytf2_rk(
'/', 0, a, 1, e, ip, info )
399 CALL chkxer(
'ZSYTF2_RK', infot, nout, lerr, ok )
401 CALL zsytf2_rk(
'U', -1, a, 1, e, ip, info )
402 CALL chkxer(
'ZSYTF2_RK', infot, nout, lerr, ok )
404 CALL zsytf2_rk(
'U', 2, a, 1, e, ip, info )
405 CALL chkxer(
'ZSYTF2_RK', infot, nout, lerr, ok )
411 CALL zsytri_3(
'/', 0, a, 1, e, ip, w, 1, info )
412 CALL chkxer(
'ZSYTRI_3', infot, nout, lerr, ok )
414 CALL zsytri_3(
'U', -1, a, 1, e, ip, w, 1, info )
415 CALL chkxer(
'ZSYTRI_3', infot, nout, lerr, ok )
417 CALL zsytri_3(
'U', 2, a, 1, e, ip, w, 1, info )
418 CALL chkxer(
'ZSYTRI_3', infot, nout, lerr, ok )
420 CALL zsytri_3(
'U', 0, a, 1, e, ip, w, 0, info )
421 CALL chkxer(
'ZSYTRI_3', infot, nout, lerr, ok )
423 CALL zsytri_3(
'U', 0, a, 1, e, ip, w, -2, info )
424 CALL chkxer(
'ZSYTRI_3', infot, nout, lerr, ok )
430 CALL zsytri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
431 CALL chkxer(
'ZSYTRI_3X', infot, nout, lerr, ok )
433 CALL zsytri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
434 CALL chkxer(
'ZSYTRI_3X', infot, nout, lerr, ok )
436 CALL zsytri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
437 CALL chkxer(
'ZSYTRI_3X', infot, nout, lerr, ok )
443 CALL zsytrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
444 CALL chkxer(
'ZSYTRS_3', infot, nout, lerr, ok )
446 CALL zsytrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
447 CALL chkxer(
'ZSYTRS_3', infot, nout, lerr, ok )
449 CALL zsytrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
450 CALL chkxer(
'ZSYTRS_3', infot, nout, lerr, ok )
452 CALL zsytrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
453 CALL chkxer(
'ZSYTRS_3', infot, nout, lerr, ok )
455 CALL zsytrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
456 CALL chkxer(
'ZSYTRS_3', infot, nout, lerr, ok )
462 CALL zsycon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, info )
463 CALL chkxer(
'ZSYCON_3', infot, nout, lerr, ok )
465 CALL zsycon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, info )
466 CALL chkxer(
'ZSYCON_3', infot, nout, lerr, ok )
468 CALL zsycon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, info )
469 CALL chkxer(
'ZSYCON_3', infot, nout, lerr, ok )
471 CALL zsycon_3(
'U', 1, a, 1, e, ip, -1.0d0, rcond, w, info)
472 CALL chkxer(
'ZSYCON_3', infot, nout, lerr, ok )
474 ELSE IF(
lsamen( 2, c2,
'SP' ) )
THEN
484 CALL zsptrf(
'/', 0, a, ip, info )
485 CALL chkxer(
'ZSPTRF', infot, nout, lerr, ok )
487 CALL zsptrf(
'U', -1, a, ip, info )
488 CALL chkxer(
'ZSPTRF', infot, nout, lerr, ok )
494 CALL zsptri(
'/', 0, a, ip, w, info )
495 CALL chkxer(
'ZSPTRI', infot, nout, lerr, ok )
497 CALL zsptri(
'U', -1, a, ip, w, info )
498 CALL chkxer(
'ZSPTRI', infot, nout, lerr, ok )
504 CALL zsptrs(
'/', 0, 0, a, ip, b, 1, info )
505 CALL chkxer(
'ZSPTRS', infot, nout, lerr, ok )
507 CALL zsptrs(
'U', -1, 0, a, ip, b, 1, info )
508 CALL chkxer(
'ZSPTRS', infot, nout, lerr, ok )
510 CALL zsptrs(
'U', 0, -1, a, ip, b, 1, info )
511 CALL chkxer(
'ZSPTRS', infot, nout, lerr, ok )
513 CALL zsptrs(
'U', 2, 1, a, ip, b, 1, info )
514 CALL chkxer(
'ZSPTRS', infot, nout, lerr, ok )
520 CALL zsprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
522 CALL chkxer(
'ZSPRFS', infot, nout, lerr, ok )
524 CALL zsprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
526 CALL chkxer(
'ZSPRFS', infot, nout, lerr, ok )
528 CALL zsprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
530 CALL chkxer(
'ZSPRFS', infot, nout, lerr, ok )
532 CALL zsprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
534 CALL chkxer(
'ZSPRFS', infot, nout, lerr, ok )
536 CALL zsprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
538 CALL chkxer(
'ZSPRFS', infot, nout, lerr, ok )
544 CALL zspcon(
'/', 0, a, ip, anrm, rcond, w, info )
545 CALL chkxer(
'ZSPCON', infot, nout, lerr, ok )
547 CALL zspcon(
'U', -1, a, ip, anrm, rcond, w, info )
548 CALL chkxer(
'ZSPCON', infot, nout, lerr, ok )
550 CALL zspcon(
'U', 1, a, ip, -anrm, rcond, w, info )
551 CALL chkxer(
'ZSPCON', infot, nout, lerr, ok )
553 ELSE IF(
lsamen( 2, c2,
'SA' ) )
THEN
562 CALL zsytrf_aa(
'/', 0, a, 1, ip, w, 1, info )
563 CALL chkxer(
'ZSYTRF_AA', infot, nout, lerr, ok )
565 CALL zsytrf_aa(
'U', -1, a, 1, ip, w, 1, info )
566 CALL chkxer(
'ZSYTRF_AA', infot, nout, lerr, ok )
568 CALL zsytrf_aa(
'U', 2, a, 1, ip, w, 4, info )
569 CALL chkxer(
'ZSYTRF_AA', infot, nout, lerr, ok )
571 CALL zsytrf_aa(
'U', 0, a, 1, ip, w, 0, info )
572 CALL chkxer(
'ZSYTRF_AA', infot, nout, lerr, ok )
574 CALL zsytrf_aa(
'U', 0, a, 1, ip, w, -2, info )
575 CALL chkxer(
'ZSYTRF_AA', infot, nout, lerr, ok )
581 CALL zsytrs_aa(
'/', 0, 0, a, 1, ip, b, 1, w, 1, info )
582 CALL chkxer(
'ZSYTRS_AA', infot, nout, lerr, ok )
584 CALL zsytrs_aa(
'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
585 CALL chkxer(
'ZSYTRS_AA', infot, nout, lerr, ok )
587 CALL zsytrs_aa(
'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
588 CALL chkxer(
'ZSYTRS_AA', infot, nout, lerr, ok )
590 CALL zsytrs_aa(
'U', 2, 1, a, 1, ip, b, 2, w, 1, info )
591 CALL chkxer(
'ZSYTRS_AA', infot, nout, lerr, ok )
593 CALL zsytrs_aa(
'U', 2, 1, a, 2, ip, b, 1, w, 1, info )
594 CALL chkxer(
'ZSYTRS_AA', infot, nout, lerr, ok )
600 CALL alaesm( path, ok, nout )
subroutine zsycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZSYCON
subroutine zsptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
ZSPTRS
subroutine zsytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
ZSYTRI_ROOK
subroutine zsytri(UPLO, N, A, LDA, IPIV, WORK, INFO)
ZSYTRI
subroutine zsptrf(UPLO, N, AP, IPIV, INFO)
ZSPTRF
subroutine zsytri_3x(UPLO, N, A, LDA, E, IPIV, WORK, NB, INFO)
ZSYTRI_3X
subroutine zsytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRF_ROOK
subroutine zsytri_3(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
ZSYTRI_3
subroutine zsytrf_aa(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRF_AA
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine zsytf2_rook(UPLO, N, A, LDA, IPIV, INFO)
ZSYTF2_ROOK computes the factorization of a complex symmetric indefinite matrix using the bounded Bun...
subroutine zspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
ZSPCON
subroutine zsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRI2
subroutine zsytrs_3(UPLO, N, NRHS, A, LDA, E, IPIV, B, LDB, INFO)
ZSYTRS_3
subroutine zsytri2x(UPLO, N, A, LDA, IPIV, WORK, NB, INFO)
ZSYTRI2X
subroutine zsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRF
subroutine zsptri(UPLO, N, AP, IPIV, WORK, INFO)
ZSPTRI
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
logical function lsamen(N, CA, CB)
LSAMEN
subroutine zsycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZSYCON_ROOK
subroutine zsytrf_rk(UPLO, N, A, LDA, E, IPIV, WORK, LWORK, INFO)
ZSYTRF_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch...
subroutine zsytf2_rk(UPLO, N, A, LDA, E, IPIV, INFO)
ZSYTF2_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch...
subroutine zsytrs_aa(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, WORK, LWORK, INFO)
ZSYTRS_AA
subroutine zsycon_3(UPLO, N, A, LDA, E, IPIV, ANORM, RCOND, WORK, INFO)
ZSYCON_3
subroutine zsytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZSYTRS_ROOK
subroutine zsyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZSYRFS
subroutine zsytf2(UPLO, N, A, LDA, IPIV, INFO)
ZSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...
subroutine zsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZSYTRS
subroutine zsprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZSPRFS