59 SUBROUTINE serrsy( PATH, NUNIT )
80 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
81 REAL ANRM, RCOND, BERR
84 INTEGER IP( NMAX ), IW( NMAX )
85 REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
86 $ E( NMAX ), R1( NMAX ), R2( NMAX ), W( 3*NMAX ),
87 $ X( NMAX ), S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
88 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
108 COMMON / infoc / infot, nout, ok, lerr
109 COMMON / srnamc / srnamt
117 WRITE( nout, fmt = * )
124 a( i, j ) = 1. / real( i+j )
125 af( i, j ) = 1. / real( i+j )
140 IF( lsamen( 2, c2,
'SY' ) )
THEN
150 CALL ssytrf(
'/', 0, a, 1, ip, w, 1, info )
151 CALL chkxer(
'SSYTRF', infot, nout, lerr, ok )
153 CALL ssytrf(
'U', -1, a, 1, ip, w, 1, info )
154 CALL chkxer(
'SSYTRF', infot, nout, lerr, ok )
156 CALL ssytrf(
'U', 2, a, 1, ip, w, 4, info )
157 CALL chkxer(
'SSYTRF', infot, nout, lerr, ok )
159 CALL ssytrf(
'U', 0, a, 1, ip, w, 0, info )
160 CALL chkxer(
'SSYTRF', infot, nout, lerr, ok )
162 CALL ssytrf(
'U', 0, a, 1, ip, w, -2, info )
163 CALL chkxer(
'SSYTRF', infot, nout, lerr, ok )
169 CALL ssytf2(
'/', 0, a, 1, ip, info )
170 CALL chkxer(
'SSYTF2', infot, nout, lerr, ok )
172 CALL ssytf2(
'U', -1, a, 1, ip, info )
173 CALL chkxer(
'SSYTF2', infot, nout, lerr, ok )
175 CALL ssytf2(
'U', 2, a, 1, ip, info )
176 CALL chkxer(
'SSYTF2', infot, nout, lerr, ok )
182 CALL ssytri(
'/', 0, a, 1, ip, w, info )
183 CALL chkxer(
'SSYTRI', infot, nout, lerr, ok )
185 CALL ssytri(
'U', -1, a, 1, ip, w, info )
186 CALL chkxer(
'SSYTRI', infot, nout, lerr, ok )
188 CALL ssytri(
'U', 2, a, 1, ip, w, info )
189 CALL chkxer(
'SSYTRI', infot, nout, lerr, ok )
195 CALL ssytri2(
'/', 0, a, 1, ip, w, iw, info )
196 CALL chkxer(
'SSYTRI', infot, nout, lerr, ok )
198 CALL ssytri2(
'U', -1, a, 1, ip, w, iw, info )
199 CALL chkxer(
'SSYTRI', infot, nout, lerr, ok )
201 CALL ssytri2(
'U', 2, a, 1, ip, w, iw, info )
202 CALL chkxer(
'SSYTRI', infot, nout, lerr, ok )
208 CALL ssytri2x(
'/', 0, a, 1, ip, w, 1, info )
209 CALL chkxer(
'SSYTRI2X', infot, nout, lerr, ok )
211 CALL ssytri2x(
'U', -1, a, 1, ip, w, 1, info )
212 CALL chkxer(
'SSYTRI2X', infot, nout, lerr, ok )
214 CALL ssytri2x(
'U', 2, a, 1, ip, w, 1, info )
215 CALL chkxer(
'SSYTRI2X', infot, nout, lerr, ok )
221 CALL ssytrs(
'/', 0, 0, a, 1, ip, b, 1, info )
222 CALL chkxer(
'SSYTRS', infot, nout, lerr, ok )
224 CALL ssytrs(
'U', -1, 0, a, 1, ip, b, 1, info )
225 CALL chkxer(
'SSYTRS', infot, nout, lerr, ok )
227 CALL ssytrs(
'U', 0, -1, a, 1, ip, b, 1, info )
228 CALL chkxer(
'SSYTRS', infot, nout, lerr, ok )
230 CALL ssytrs(
'U', 2, 1, a, 1, ip, b, 2, info )
231 CALL chkxer(
'SSYTRS', infot, nout, lerr, ok )
233 CALL ssytrs(
'U', 2, 1, a, 2, ip, b, 1, info )
234 CALL chkxer(
'SSYTRS', infot, nout, lerr, ok )
240 CALL ssyrfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
242 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
244 CALL ssyrfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
246 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
248 CALL ssyrfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
250 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
252 CALL ssyrfs(
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
254 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
256 CALL ssyrfs(
'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
258 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
260 CALL ssyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
262 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
264 CALL ssyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
266 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
274 CALL ssyrfsx(
'/', eq, 0, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
275 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
276 $ params, w, iw, info )
277 CALL chkxer(
'SSYRFSX', infot, nout, lerr, ok )
279 CALL ssyrfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
280 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
281 $ params, w, iw, info )
282 CALL chkxer(
'SSYRFSX', infot, nout, lerr, ok )
285 CALL ssyrfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
286 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
287 $ params, w, iw, info )
288 CALL chkxer(
'SSYRFSX', infot, nout, lerr, ok )
290 CALL ssyrfsx(
'U', eq, 0, -1, a, 1, af, 1, ip, s, b, 1, x, 1,
291 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
292 $ params, w, iw, info )
293 CALL chkxer(
'SSYRFSX', infot, nout, lerr, ok )
295 CALL ssyrfsx(
'U', eq, 2, 1, a, 1, af, 2, ip, s, b, 2, x, 2,
296 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
297 $ params, w, iw, info )
298 CALL chkxer(
'SSYRFSX', infot, nout, lerr, ok )
300 CALL ssyrfsx(
'U', eq, 2, 1, a, 2, af, 1, ip, s, b, 2, x, 2,
301 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
302 $ params, w, iw, info )
303 CALL chkxer(
'SSYRFSX', infot, nout, lerr, ok )
305 CALL ssyrfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 1, x, 2,
306 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
307 $ params, w, iw, info )
308 CALL chkxer(
'SSYRFSX', infot, nout, lerr, ok )
310 CALL ssyrfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 2, x, 1,
311 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
312 $ params, w, iw, info )
313 CALL chkxer(
'SSYRFSX', infot, nout, lerr, ok )
319 CALL ssycon(
'/', 0, a, 1, ip, anrm, rcond, w, iw, info )
320 CALL chkxer(
'SSYCON', infot, nout, lerr, ok )
322 CALL ssycon(
'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
323 CALL chkxer(
'SSYCON', infot, nout, lerr, ok )
325 CALL ssycon(
'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
326 CALL chkxer(
'SSYCON', infot, nout, lerr, ok )
328 CALL ssycon(
'U', 1, a, 1, ip, -1.0, rcond, w, iw, info )
329 CALL chkxer(
'SSYCON', infot, nout, lerr, ok )
331 ELSE IF( lsamen( 2, c2,
'SR' ) )
THEN
339 srnamt =
'SSYTRF_ROOK'
342 CALL chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
345 CALL chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
348 CALL chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
351 CALL chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
354 CALL chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
358 srnamt =
'SSYTF2_ROOK'
361 CALL chkxer(
'SSYTF2_ROOK', infot, nout, lerr, ok )
364 CALL chkxer(
'SSYTF2_ROOK', infot, nout, lerr, ok )
367 CALL chkxer(
'SSYTF2_ROOK', infot, nout, lerr, ok )
371 srnamt =
'SSYTRI_ROOK'
374 CALL chkxer(
'SSYTRI_ROOK', infot, nout, lerr, ok )
377 CALL chkxer(
'SSYTRI_ROOK', infot, nout, lerr, ok )
380 CALL chkxer(
'SSYTRI_ROOK', infot, nout, lerr, ok )
384 srnamt =
'SSYTRS_ROOK'
386 CALL ssytrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
387 CALL chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
389 CALL ssytrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
390 CALL chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
392 CALL ssytrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
393 CALL chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
395 CALL ssytrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
396 CALL chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
398 CALL ssytrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
399 CALL chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
403 srnamt =
'SSYCON_ROOK'
405 CALL ssycon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, iw, info )
406 CALL chkxer(
'SSYCON_ROOK', infot, nout, lerr, ok )
408 CALL ssycon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
409 CALL chkxer(
'SSYCON_ROOK', infot, nout, lerr, ok )
411 CALL ssycon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
412 CALL chkxer(
'SSYCON_ROOK', infot, nout, lerr, ok )
414 CALL ssycon_rook(
'U', 1, a, 1, ip, -1.0, rcond, w, iw, info )
415 CALL chkxer(
'SSYCON_ROOK', infot, nout, lerr, ok )
417 ELSE IF( lsamen( 2, c2,
'SK' ) )
THEN
431 CALL ssytrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
432 CALL chkxer(
'SSYTRF_RK', infot, nout, lerr, ok )
434 CALL ssytrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
435 CALL chkxer(
'SSYTRF_RK', infot, nout, lerr, ok )
437 CALL ssytrf_rk(
'U', 2, a, 1, e, ip, w, 4, info )
438 CALL chkxer(
'SSYTRF_RK', infot, nout, lerr, ok )
440 CALL ssytrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
441 CALL chkxer(
'SSYTRF_RK', infot, nout, lerr, ok )
443 CALL ssytrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
444 CALL chkxer(
'SSYTRF_RK', infot, nout, lerr, ok )
450 CALL ssytf2_rk(
'/', 0, a, 1, e, ip, info )
451 CALL chkxer(
'SSYTF2_RK', infot, nout, lerr, ok )
453 CALL ssytf2_rk(
'U', -1, a, 1, e, ip, info )
454 CALL chkxer(
'SSYTF2_RK', infot, nout, lerr, ok )
456 CALL ssytf2_rk(
'U', 2, a, 1, e, ip, info )
457 CALL chkxer(
'SSYTF2_RK', infot, nout, lerr, ok )
463 CALL ssytri_3(
'/', 0, a, 1, e, ip, w, 1, info )
464 CALL chkxer(
'SSYTRI_3', infot, nout, lerr, ok )
466 CALL ssytri_3(
'U', -1, a, 1, e, ip, w, 1, info )
467 CALL chkxer(
'SSYTRI_3', infot, nout, lerr, ok )
469 CALL ssytri_3(
'U', 2, a, 1, e, ip, w, 1, info )
470 CALL chkxer(
'SSYTRI_3', infot, nout, lerr, ok )
472 CALL ssytri_3(
'U', 0, a, 1, e, ip, w, 0, info )
473 CALL chkxer(
'SSYTRI_3', infot, nout, lerr, ok )
475 CALL ssytri_3(
'U', 0, a, 1, e, ip, w, -2, info )
476 CALL chkxer(
'SSYTRI_3', infot, nout, lerr, ok )
482 CALL ssytri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
483 CALL chkxer(
'SSYTRI_3X', infot, nout, lerr, ok )
485 CALL ssytri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
486 CALL chkxer(
'SSYTRI_3X', infot, nout, lerr, ok )
488 CALL ssytri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
489 CALL chkxer(
'SSYTRI_3X', infot, nout, lerr, ok )
495 CALL ssytrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
496 CALL chkxer(
'SSYTRS_3', infot, nout, lerr, ok )
498 CALL ssytrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
499 CALL chkxer(
'SSYTRS_3', infot, nout, lerr, ok )
501 CALL ssytrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
502 CALL chkxer(
'SSYTRS_3', infot, nout, lerr, ok )
504 CALL ssytrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
505 CALL chkxer(
'SSYTRS_3', infot, nout, lerr, ok )
507 CALL ssytrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
508 CALL chkxer(
'SSYTRS_3', infot, nout, lerr, ok )
514 CALL ssycon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, iw,
516 CALL chkxer(
'SSYCON_3', infot, nout, lerr, ok )
518 CALL ssycon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, iw,
520 CALL chkxer(
'SSYCON_3', infot, nout, lerr, ok )
522 CALL ssycon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, iw,
524 CALL chkxer(
'SSYCON_3', infot, nout, lerr, ok )
526 CALL ssycon_3(
'U', 1, a, 1, e, ip, -1.0e0, rcond, w, iw,
528 CALL chkxer(
'SSYCON_3', infot, nout, lerr, ok )
530 ELSE IF( lsamen( 2, c2,
'SP' ) )
THEN
540 CALL ssptrf(
'/', 0, a, ip, info )
541 CALL chkxer(
'SSPTRF', infot, nout, lerr, ok )
543 CALL ssptrf(
'U', -1, a, ip, info )
544 CALL chkxer(
'SSPTRF', infot, nout, lerr, ok )
550 CALL ssptri(
'/', 0, a, ip, w, info )
551 CALL chkxer(
'SSPTRI', infot, nout, lerr, ok )
553 CALL ssptri(
'U', -1, a, ip, w, info )
554 CALL chkxer(
'SSPTRI', infot, nout, lerr, ok )
560 CALL ssptrs(
'/', 0, 0, a, ip, b, 1, info )
561 CALL chkxer(
'SSPTRS', infot, nout, lerr, ok )
563 CALL ssptrs(
'U', -1, 0, a, ip, b, 1, info )
564 CALL chkxer(
'SSPTRS', infot, nout, lerr, ok )
566 CALL ssptrs(
'U', 0, -1, a, ip, b, 1, info )
567 CALL chkxer(
'SSPTRS', infot, nout, lerr, ok )
569 CALL ssptrs(
'U', 2, 1, a, ip, b, 1, info )
570 CALL chkxer(
'SSPTRS', infot, nout, lerr, ok )
576 CALL ssprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
578 CALL chkxer(
'SSPRFS', infot, nout, lerr, ok )
580 CALL ssprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
582 CALL chkxer(
'SSPRFS', infot, nout, lerr, ok )
584 CALL ssprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
586 CALL chkxer(
'SSPRFS', infot, nout, lerr, ok )
588 CALL ssprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, iw,
590 CALL chkxer(
'SSPRFS', infot, nout, lerr, ok )
592 CALL ssprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, iw,
594 CALL chkxer(
'SSPRFS', infot, nout, lerr, ok )
600 CALL sspcon(
'/', 0, a, ip, anrm, rcond, w, iw, info )
601 CALL chkxer(
'SSPCON', infot, nout, lerr, ok )
603 CALL sspcon(
'U', -1, a, ip, anrm, rcond, w, iw, info )
604 CALL chkxer(
'SSPCON', infot, nout, lerr, ok )
606 CALL sspcon(
'U', 1, a, ip, -1.0, rcond, w, iw, info )
607 CALL chkxer(
'SSPCON', infot, nout, lerr, ok )
612 CALL alaesm( path, ok, nout )