59 SUBROUTINE zerrsy( PATH, NUNIT )
75 parameter ( nmax = 4 )
80 INTEGER i, info, j, n_err_bnds, nparams
81 DOUBLE PRECISION anrm, rcond, berr
85 DOUBLE PRECISION r( nmax ), r1( nmax ), r2( nmax ),
86 $ s( nmax ), err_bnds_n( nmax, 3 ),
87 $ err_bnds_c( nmax, 3 ), params( 1 )
88 COMPLEX*16 a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
89 $ e( nmax ), w( 2*nmax ), x( nmax )
109 COMMON / infoc / infot, nout, ok, lerr
110 COMMON / srnamc / srnamt
113 INTRINSIC dble, dcmplx
118 WRITE( nout, fmt = * )
125 a( i, j ) = dcmplx( 1.d0 / dble( i+j ),
126 $ -1.d0 / dble( i+j ) )
127 af( i, j ) = dcmplx( 1.d0 / dble( i+j ),
128 $ -1.d0 / dble( i+j ) )
142 IF(
lsamen( 2, c2,
'SY' ) )
THEN
152 CALL zsytrf(
'/', 0, a, 1, ip, w, 1, info )
153 CALL chkxer(
'ZSYTRF', infot, nout, lerr, ok )
155 CALL zsytrf(
'U', -1, a, 1, ip, w, 1, info )
156 CALL chkxer(
'ZSYTRF', infot, nout, lerr, ok )
158 CALL zsytrf(
'U', 2, a, 1, ip, w, 4, info )
159 CALL chkxer(
'ZSYTRF', infot, nout, lerr, ok )
161 CALL zsytrf(
'U', 0, a, 1, ip, w, 0, info )
162 CALL chkxer(
'ZSYTRF', infot, nout, lerr, ok )
164 CALL zsytrf(
'U', 0, a, 1, ip, w, -2, info )
165 CALL chkxer(
'ZSYTRF', infot, nout, lerr, ok )
171 CALL zsytf2(
'/', 0, a, 1, ip, info )
172 CALL chkxer(
'ZSYTF2', infot, nout, lerr, ok )
174 CALL zsytf2(
'U', -1, a, 1, ip, info )
175 CALL chkxer(
'ZSYTF2', infot, nout, lerr, ok )
177 CALL zsytf2(
'U', 2, a, 1, ip, info )
178 CALL chkxer(
'ZSYTF2', infot, nout, lerr, ok )
184 CALL zsytri(
'/', 0, a, 1, ip, w, info )
185 CALL chkxer(
'ZSYTRI', infot, nout, lerr, ok )
187 CALL zsytri(
'U', -1, a, 1, ip, w, info )
188 CALL chkxer(
'ZSYTRI', infot, nout, lerr, ok )
190 CALL zsytri(
'U', 2, a, 1, ip, w, info )
191 CALL chkxer(
'ZSYTRI', infot, nout, lerr, ok )
197 CALL zsytri2(
'/', 0, a, 1, ip, w, 1, info )
198 CALL chkxer(
'ZSYTRI2', infot, nout, lerr, ok )
200 CALL zsytri2(
'U', -1, a, 1, ip, w, 1, info )
201 CALL chkxer(
'ZSYTRI2', infot, nout, lerr, ok )
203 CALL zsytri2(
'U', 2, a, 1, ip, w, 1, info )
204 CALL chkxer(
'ZSYTRI2', infot, nout, lerr, ok )
210 CALL zsytri2x(
'/', 0, a, 1, ip, w, 1, info )
211 CALL chkxer(
'ZSYTRI2X', infot, nout, lerr, ok )
213 CALL zsytri2x(
'U', -1, a, 1, ip, w, 1, info )
214 CALL chkxer(
'ZSYTRI2X', infot, nout, lerr, ok )
216 CALL zsytri2x(
'U', 2, a, 1, ip, w, 1, info )
217 CALL chkxer(
'ZSYTRI2X', infot, nout, lerr, ok )
223 CALL zsytrs(
'/', 0, 0, a, 1, ip, b, 1, info )
224 CALL chkxer(
'ZSYTRS', infot, nout, lerr, ok )
226 CALL zsytrs(
'U', -1, 0, a, 1, ip, b, 1, info )
227 CALL chkxer(
'ZSYTRS', infot, nout, lerr, ok )
229 CALL zsytrs(
'U', 0, -1, a, 1, ip, b, 1, info )
230 CALL chkxer(
'ZSYTRS', infot, nout, lerr, ok )
232 CALL zsytrs(
'U', 2, 1, a, 1, ip, b, 2, info )
233 CALL chkxer(
'ZSYTRS', infot, nout, lerr, ok )
235 CALL zsytrs(
'U', 2, 1, a, 2, ip, b, 1, info )
236 CALL chkxer(
'ZSYTRS', infot, nout, lerr, ok )
242 CALL zsyrfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
244 CALL chkxer(
'ZSYRFS', infot, nout, lerr, ok )
246 CALL zsyrfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
248 CALL chkxer(
'ZSYRFS', infot, nout, lerr, ok )
250 CALL zsyrfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
252 CALL chkxer(
'ZSYRFS', infot, nout, lerr, ok )
254 CALL zsyrfs(
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
256 CALL chkxer(
'ZSYRFS', infot, nout, lerr, ok )
258 CALL zsyrfs(
'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
260 CALL chkxer(
'ZSYRFS', infot, nout, lerr, ok )
262 CALL zsyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
264 CALL chkxer(
'ZSYRFS', infot, nout, lerr, ok )
266 CALL zsyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
268 CALL chkxer(
'ZSYRFS', infot, nout, lerr, ok )
276 CALL zsyrfsx(
'/', eq, 0, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
277 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
278 $ params, w, r, info )
279 CALL chkxer(
'ZSYRFSX', infot, nout, lerr, ok )
281 CALL zsyrfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
282 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
283 $ params, w, r, info )
284 CALL chkxer(
'ZSYRFSX', infot, nout, lerr, ok )
287 CALL zsyrfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
288 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
289 $ params, w, r, info )
290 CALL chkxer(
'ZSYRFSX', infot, nout, lerr, ok )
292 CALL zsyrfsx(
'U', eq, 0, -1, a, 1, af, 1, ip, s, b, 1, x, 1,
293 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
294 $ params, w, r, info )
295 CALL chkxer(
'ZSYRFSX', infot, nout, lerr, ok )
297 CALL zsyrfsx(
'U', eq, 2, 1, a, 1, af, 2, ip, s, b, 2, x, 2,
298 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
299 $ params, w, r, info )
300 CALL chkxer(
'ZSYRFSX', infot, nout, lerr, ok )
302 CALL zsyrfsx(
'U', eq, 2, 1, a, 2, af, 1, ip, s, b, 2, x, 2,
303 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
304 $ params, w, r, info )
305 CALL chkxer(
'ZSYRFSX', infot, nout, lerr, ok )
307 CALL zsyrfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 1, x, 2,
308 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
309 $ params, w, r, info )
310 CALL chkxer(
'ZSYRFSX', infot, nout, lerr, ok )
312 CALL zsyrfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 2, x, 1,
313 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
314 $ params, w, r, info )
315 CALL chkxer(
'ZSYRFSX', infot, nout, lerr, ok )
321 CALL zsycon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
322 CALL chkxer(
'ZSYCON', infot, nout, lerr, ok )
324 CALL zsycon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
325 CALL chkxer(
'ZSYCON', infot, nout, lerr, ok )
327 CALL zsycon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
328 CALL chkxer(
'ZSYCON', infot, nout, lerr, ok )
330 CALL zsycon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
331 CALL chkxer(
'ZSYCON', infot, nout, lerr, ok )
333 ELSE IF(
lsamen( 2, c2,
'SR' ) )
THEN
341 srnamt =
'ZSYTRF_ROOK'
344 CALL chkxer(
'ZSYTRF_ROOK', infot, nout, lerr, ok )
347 CALL chkxer(
'ZSYTRF_ROOK', infot, nout, lerr, ok )
350 CALL chkxer(
'ZSYTRF_ROOK', infot, nout, lerr, ok )
353 CALL chkxer(
'ZSYTRF_ROOK', infot, nout, lerr, ok )
356 CALL chkxer(
'ZSYTRF_ROOK', infot, nout, lerr, ok )
360 srnamt =
'ZSYTF2_ROOK'
363 CALL chkxer(
'ZSYTF2_ROOK', infot, nout, lerr, ok )
366 CALL chkxer(
'ZSYTF2_ROOK', infot, nout, lerr, ok )
369 CALL chkxer(
'ZSYTF2_ROOK', infot, nout, lerr, ok )
373 srnamt =
'ZSYTRI_ROOK'
376 CALL chkxer(
'ZSYTRI_ROOK', infot, nout, lerr, ok )
379 CALL chkxer(
'ZSYTRI_ROOK', infot, nout, lerr, ok )
382 CALL chkxer(
'ZSYTRI_ROOK', infot, nout, lerr, ok )
386 srnamt =
'ZSYTRS_ROOK'
388 CALL zsytrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
389 CALL chkxer(
'ZSYTRS_ROOK', infot, nout, lerr, ok )
391 CALL zsytrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
392 CALL chkxer(
'ZSYTRS_ROOK', infot, nout, lerr, ok )
394 CALL zsytrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
395 CALL chkxer(
'ZSYTRS_ROOK', infot, nout, lerr, ok )
397 CALL zsytrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
398 CALL chkxer(
'ZSYTRS_ROOK', infot, nout, lerr, ok )
400 CALL zsytrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
401 CALL chkxer(
'ZSYTRS_ROOK', infot, nout, lerr, ok )
405 srnamt =
'ZSYCON_ROOK'
407 CALL zsycon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
408 CALL chkxer(
'ZSYCON_ROOK', infot, nout, lerr, ok )
410 CALL zsycon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
411 CALL chkxer(
'ZSYCON_ROOK', infot, nout, lerr, ok )
413 CALL zsycon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, info )
414 CALL chkxer(
'ZSYCON_ROOK', infot, nout, lerr, ok )
416 CALL zsycon_rook(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
417 CALL chkxer(
'ZSYCON_ROOK', infot, nout, lerr, ok )
419 ELSE IF(
lsamen( 2, c2,
'SK' ) )
THEN
433 CALL zsytrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
434 CALL chkxer(
'ZSYTRF_RK', infot, nout, lerr, ok )
436 CALL zsytrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
437 CALL chkxer(
'ZSYTRF_RK', infot, nout, lerr, ok )
439 CALL zsytrf_rk(
'U', 2, a, 1, e, ip, w, 4, info )
440 CALL chkxer(
'ZSYTRF_RK', infot, nout, lerr, ok )
442 CALL zsytrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
443 CALL chkxer(
'ZSYTRF_RK', infot, nout, lerr, ok )
445 CALL zsytrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
446 CALL chkxer(
'ZSYTRF_RK', infot, nout, lerr, ok )
452 CALL zsytf2_rk(
'/', 0, a, 1, e, ip, info )
453 CALL chkxer(
'ZSYTF2_RK', infot, nout, lerr, ok )
455 CALL zsytf2_rk(
'U', -1, a, 1, e, ip, info )
456 CALL chkxer(
'ZSYTF2_RK', infot, nout, lerr, ok )
458 CALL zsytf2_rk(
'U', 2, a, 1, e, ip, info )
459 CALL chkxer(
'ZSYTF2_RK', infot, nout, lerr, ok )
465 CALL zsytri_3(
'/', 0, a, 1, e, ip, w, 1, info )
466 CALL chkxer(
'ZSYTRI_3', infot, nout, lerr, ok )
468 CALL zsytri_3(
'U', -1, a, 1, e, ip, w, 1, info )
469 CALL chkxer(
'ZSYTRI_3', infot, nout, lerr, ok )
471 CALL zsytri_3(
'U', 2, a, 1, e, ip, w, 1, info )
472 CALL chkxer(
'ZSYTRI_3', infot, nout, lerr, ok )
474 CALL zsytri_3(
'U', 0, a, 1, e, ip, w, 0, info )
475 CALL chkxer(
'ZSYTRI_3', infot, nout, lerr, ok )
477 CALL zsytri_3(
'U', 0, a, 1, e, ip, w, -2, info )
478 CALL chkxer(
'ZSYTRI_3', infot, nout, lerr, ok )
484 CALL zsytri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
485 CALL chkxer(
'ZSYTRI_3X', infot, nout, lerr, ok )
487 CALL zsytri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
488 CALL chkxer(
'ZSYTRI_3X', infot, nout, lerr, ok )
490 CALL zsytri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
491 CALL chkxer(
'ZSYTRI_3X', infot, nout, lerr, ok )
497 CALL zsytrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
498 CALL chkxer(
'ZSYTRS_3', infot, nout, lerr, ok )
500 CALL zsytrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
501 CALL chkxer(
'ZSYTRS_3', infot, nout, lerr, ok )
503 CALL zsytrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
504 CALL chkxer(
'ZSYTRS_3', infot, nout, lerr, ok )
506 CALL zsytrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
507 CALL chkxer(
'ZSYTRS_3', infot, nout, lerr, ok )
509 CALL zsytrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
510 CALL chkxer(
'ZSYTRS_3', infot, nout, lerr, ok )
516 CALL zsycon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, info )
517 CALL chkxer(
'ZSYCON_3', infot, nout, lerr, ok )
519 CALL zsycon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, info )
520 CALL chkxer(
'ZSYCON_3', infot, nout, lerr, ok )
522 CALL zsycon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, info )
523 CALL chkxer(
'ZSYCON_3', infot, nout, lerr, ok )
525 CALL zsycon_3(
'U', 1, a, 1, e, ip, -1.0d0, rcond, w, info)
526 CALL chkxer(
'ZSYCON_3', infot, nout, lerr, ok )
528 ELSE IF(
lsamen( 2, c2,
'SP' ) )
THEN
538 CALL zsptrf(
'/', 0, a, ip, info )
539 CALL chkxer(
'ZSPTRF', infot, nout, lerr, ok )
541 CALL zsptrf(
'U', -1, a, ip, info )
542 CALL chkxer(
'ZSPTRF', infot, nout, lerr, ok )
548 CALL zsptri(
'/', 0, a, ip, w, info )
549 CALL chkxer(
'ZSPTRI', infot, nout, lerr, ok )
551 CALL zsptri(
'U', -1, a, ip, w, info )
552 CALL chkxer(
'ZSPTRI', infot, nout, lerr, ok )
558 CALL zsptrs(
'/', 0, 0, a, ip, b, 1, info )
559 CALL chkxer(
'ZSPTRS', infot, nout, lerr, ok )
561 CALL zsptrs(
'U', -1, 0, a, ip, b, 1, info )
562 CALL chkxer(
'ZSPTRS', infot, nout, lerr, ok )
564 CALL zsptrs(
'U', 0, -1, a, ip, b, 1, info )
565 CALL chkxer(
'ZSPTRS', infot, nout, lerr, ok )
567 CALL zsptrs(
'U', 2, 1, a, ip, b, 1, info )
568 CALL chkxer(
'ZSPTRS', infot, nout, lerr, ok )
574 CALL zsprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
576 CALL chkxer(
'ZSPRFS', infot, nout, lerr, ok )
578 CALL zsprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
580 CALL chkxer(
'ZSPRFS', infot, nout, lerr, ok )
582 CALL zsprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
584 CALL chkxer(
'ZSPRFS', infot, nout, lerr, ok )
586 CALL zsprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
588 CALL chkxer(
'ZSPRFS', infot, nout, lerr, ok )
590 CALL zsprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
592 CALL chkxer(
'ZSPRFS', infot, nout, lerr, ok )
598 CALL zspcon(
'/', 0, a, ip, anrm, rcond, w, info )
599 CALL chkxer(
'ZSPCON', infot, nout, lerr, ok )
601 CALL zspcon(
'U', -1, a, ip, anrm, rcond, w, info )
602 CALL chkxer(
'ZSPCON', infot, nout, lerr, ok )
604 CALL zspcon(
'U', 1, a, ip, -anrm, rcond, w, info )
605 CALL chkxer(
'ZSPCON', infot, nout, lerr, ok )
610 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 zerrsy(PATH, NUNIT)
ZERRSY
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 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 zsyrfsx(UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, S, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, RWORK, INFO)
ZSYRFSX
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 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