59 SUBROUTINE cerrsy( PATH, NUNIT )
80 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
81 REAL ANRM, RCOND, BERR
85 REAL R( NMAX ), R1( NMAX ), R2( NMAX ),
86 $ S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
87 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
88 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
89 $ E( NMAX), W( 2*NMAX ), X( NMAX )
108 COMMON / infoc / infot, nout, ok, lerr
109 COMMON / srnamc / srnamt
112 INTRINSIC cmplx, real
117 WRITE( nout, fmt = * )
124 a( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
125 af( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
138 IF( lsamen( 2, c2,
'SY' ) )
THEN
148 CALL csytrf(
'/', 0, a, 1, ip, w, 1, info )
149 CALL chkxer(
'CSYTRF', infot, nout, lerr, ok )
151 CALL csytrf(
'U', -1, a, 1, ip, w, 1, info )
152 CALL chkxer(
'CSYTRF', infot, nout, lerr, ok )
154 CALL csytrf(
'U', 2, a, 1, ip, w, 4, info )
155 CALL chkxer(
'CSYTRF', infot, nout, lerr, ok )
157 CALL csytrf(
'U', 0, a, 1, ip, w, 0, info )
158 CALL chkxer(
'CSYTRF', infot, nout, lerr, ok )
160 CALL csytrf(
'U', 0, a, 1, ip, w, -2, info )
161 CALL chkxer(
'CSYTRF', infot, nout, lerr, ok )
167 CALL csytf2(
'/', 0, a, 1, ip, info )
168 CALL chkxer(
'CSYTF2', infot, nout, lerr, ok )
170 CALL csytf2(
'U', -1, a, 1, ip, info )
171 CALL chkxer(
'CSYTF2', infot, nout, lerr, ok )
173 CALL csytf2(
'U', 2, a, 1, ip, info )
174 CALL chkxer(
'CSYTF2', infot, nout, lerr, ok )
180 CALL csytri(
'/', 0, a, 1, ip, w, info )
181 CALL chkxer(
'CSYTRI', infot, nout, lerr, ok )
183 CALL csytri(
'U', -1, a, 1, ip, w, info )
184 CALL chkxer(
'CSYTRI', infot, nout, lerr, ok )
186 CALL csytri(
'U', 2, a, 1, ip, w, info )
187 CALL chkxer(
'CSYTRI', infot, nout, lerr, ok )
193 CALL csytri2(
'/', 0, a, 1, ip, w, 1, info )
194 CALL chkxer(
'CSYTRI2', infot, nout, lerr, ok )
196 CALL csytri2(
'U', -1, a, 1, ip, w, 1, info )
197 CALL chkxer(
'CSYTRI2', infot, nout, lerr, ok )
199 CALL csytri2(
'U', 2, a, 1, ip, w, 1, info )
200 CALL chkxer(
'CSYTRI2', infot, nout, lerr, ok )
206 CALL csytri2x(
'/', 0, a, 1, ip, w, 1, info )
207 CALL chkxer(
'CSYTRI2X', infot, nout, lerr, ok )
209 CALL csytri2x(
'U', -1, a, 1, ip, w, 1, info )
210 CALL chkxer(
'CSYTRI2X', infot, nout, lerr, ok )
212 CALL csytri2x(
'U', 2, a, 1, ip, w, 1, info )
213 CALL chkxer(
'CSYTRI2X', infot, nout, lerr, ok )
219 CALL csytrs(
'/', 0, 0, a, 1, ip, b, 1, info )
220 CALL chkxer(
'CSYTRS', infot, nout, lerr, ok )
222 CALL csytrs(
'U', -1, 0, a, 1, ip, b, 1, info )
223 CALL chkxer(
'CSYTRS', infot, nout, lerr, ok )
225 CALL csytrs(
'U', 0, -1, a, 1, ip, b, 1, info )
226 CALL chkxer(
'CSYTRS', infot, nout, lerr, ok )
228 CALL csytrs(
'U', 2, 1, a, 1, ip, b, 2, info )
229 CALL chkxer(
'CSYTRS', infot, nout, lerr, ok )
231 CALL csytrs(
'U', 2, 1, a, 2, ip, b, 1, info )
232 CALL chkxer(
'CSYTRS', infot, nout, lerr, ok )
238 CALL csyrfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
240 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
242 CALL csyrfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
244 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
246 CALL csyrfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
248 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
250 CALL csyrfs(
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
252 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
254 CALL csyrfs(
'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
256 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
258 CALL csyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
260 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
262 CALL csyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
264 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
272 CALL csyrfsx(
'/', eq, 0, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
273 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
274 $ params, w, r, info )
275 CALL chkxer(
'CSYRFSX', infot, nout, lerr, ok )
277 CALL csyrfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
278 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
279 $ params, w, r, info )
280 CALL chkxer(
'CSYRFSX', infot, nout, lerr, ok )
283 CALL csyrfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
284 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
285 $ params, w, r, info )
286 CALL chkxer(
'CSYRFSX', infot, nout, lerr, ok )
288 CALL csyrfsx(
'U', eq, 0, -1, a, 1, af, 1, ip, s, b, 1, x, 1,
289 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
290 $ params, w, r, info )
291 CALL chkxer(
'CSYRFSX', infot, nout, lerr, ok )
293 CALL csyrfsx(
'U', eq, 2, 1, a, 1, af, 2, ip, s, b, 2, x, 2,
294 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
295 $ params, w, r, info )
296 CALL chkxer(
'CSYRFSX', infot, nout, lerr, ok )
298 CALL csyrfsx(
'U', eq, 2, 1, a, 2, af, 1, ip, s, b, 2, x, 2,
299 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
300 $ params, w, r, info )
301 CALL chkxer(
'CSYRFSX', infot, nout, lerr, ok )
303 CALL csyrfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 1, x, 2,
304 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
305 $ params, w, r, info )
306 CALL chkxer(
'CSYRFSX', infot, nout, lerr, ok )
308 CALL csyrfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 2, x, 1,
309 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
310 $ params, w, r, info )
311 CALL chkxer(
'CSYRFSX', infot, nout, lerr, ok )
317 CALL csycon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
318 CALL chkxer(
'CSYCON', infot, nout, lerr, ok )
320 CALL csycon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
321 CALL chkxer(
'CSYCON', infot, nout, lerr, ok )
323 CALL csycon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
324 CALL chkxer(
'CSYCON', infot, nout, lerr, ok )
326 CALL csycon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
327 CALL chkxer(
'CSYCON', infot, nout, lerr, ok )
329 ELSE IF( lsamen( 2, c2,
'SR' ) )
THEN
337 srnamt =
'CSYTRF_ROOK'
340 CALL chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
343 CALL chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
346 CALL chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
349 CALL chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
352 CALL chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
356 srnamt =
'CSYTF2_ROOK'
359 CALL chkxer(
'CSYTF2_ROOK', infot, nout, lerr, ok )
362 CALL chkxer(
'CSYTF2_ROOK', infot, nout, lerr, ok )
365 CALL chkxer(
'CSYTF2_ROOK', infot, nout, lerr, ok )
369 srnamt =
'CSYTRI_ROOK'
372 CALL chkxer(
'CSYTRI_ROOK', infot, nout, lerr, ok )
375 CALL chkxer(
'CSYTRI_ROOK', infot, nout, lerr, ok )
378 CALL chkxer(
'CSYTRI_ROOK', infot, nout, lerr, ok )
382 srnamt =
'CSYTRS_ROOK'
384 CALL csytrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
385 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
387 CALL csytrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
388 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
390 CALL csytrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
391 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
393 CALL csytrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
394 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
396 CALL csytrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
397 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
401 srnamt =
'CSYCON_ROOK'
403 CALL csycon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
404 CALL chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
406 CALL csycon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
407 CALL chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
409 CALL csycon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, info )
410 CALL chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
412 CALL csycon_rook(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
413 CALL chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
415 ELSE IF( lsamen( 2, c2,
'SK' ) )
THEN
429 CALL csytrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
430 CALL chkxer(
'CSYTRF_RK', infot, nout, lerr, ok )
432 CALL csytrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
433 CALL chkxer(
'CSYTRF_RK', infot, nout, lerr, ok )
435 CALL csytrf_rk(
'U', 2, a, 1, e, ip, w, 4, info )
436 CALL chkxer(
'CSYTRF_RK', infot, nout, lerr, ok )
438 CALL csytrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
439 CALL chkxer(
'CSYTRF_RK', infot, nout, lerr, ok )
441 CALL csytrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
442 CALL chkxer(
'CSYTRF_RK', infot, nout, lerr, ok )
448 CALL csytf2_rk(
'/', 0, a, 1, e, ip, info )
449 CALL chkxer(
'CSYTF2_RK', infot, nout, lerr, ok )
451 CALL csytf2_rk(
'U', -1, a, 1, e, ip, info )
452 CALL chkxer(
'CSYTF2_RK', infot, nout, lerr, ok )
454 CALL csytf2_rk(
'U', 2, a, 1, e, ip, info )
455 CALL chkxer(
'CSYTF2_RK', infot, nout, lerr, ok )
461 CALL csytri_3(
'/', 0, a, 1, e, ip, w, 1, info )
462 CALL chkxer(
'CSYTRI_3', infot, nout, lerr, ok )
464 CALL csytri_3(
'U', -1, a, 1, e, ip, w, 1, info )
465 CALL chkxer(
'CSYTRI_3', infot, nout, lerr, ok )
467 CALL csytri_3(
'U', 2, a, 1, e, ip, w, 1, info )
468 CALL chkxer(
'CSYTRI_3', infot, nout, lerr, ok )
470 CALL csytri_3(
'U', 0, a, 1, e, ip, w, 0, info )
471 CALL chkxer(
'CSYTRI_3', infot, nout, lerr, ok )
473 CALL csytri_3(
'U', 0, a, 1, e, ip, w, -2, info )
474 CALL chkxer(
'CSYTRI_3', infot, nout, lerr, ok )
480 CALL csytri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
481 CALL chkxer(
'CSYTRI_3X', infot, nout, lerr, ok )
483 CALL csytri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
484 CALL chkxer(
'CSYTRI_3X', infot, nout, lerr, ok )
486 CALL csytri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
487 CALL chkxer(
'CSYTRI_3X', infot, nout, lerr, ok )
493 CALL csytrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
494 CALL chkxer(
'CSYTRS_3', infot, nout, lerr, ok )
496 CALL csytrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
497 CALL chkxer(
'CSYTRS_3', infot, nout, lerr, ok )
499 CALL csytrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
500 CALL chkxer(
'CSYTRS_3', infot, nout, lerr, ok )
502 CALL csytrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
503 CALL chkxer(
'CSYTRS_3', infot, nout, lerr, ok )
505 CALL csytrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
506 CALL chkxer(
'CSYTRS_3', infot, nout, lerr, ok )
512 CALL csycon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, info )
513 CALL chkxer(
'CSYCON_3', infot, nout, lerr, ok )
515 CALL csycon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, info )
516 CALL chkxer(
'CSYCON_3', infot, nout, lerr, ok )
518 CALL csycon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, info )
519 CALL chkxer(
'CSYCON_3', infot, nout, lerr, ok )
521 CALL csycon_3(
'U', 1, a, 1, e, ip, -1.0e0, rcond, w, info)
522 CALL chkxer(
'CSYCON_3', infot, nout, lerr, ok )
524 ELSE IF( lsamen( 2, c2,
'SP' ) )
THEN
534 CALL csptrf(
'/', 0, a, ip, info )
535 CALL chkxer(
'CSPTRF', infot, nout, lerr, ok )
537 CALL csptrf(
'U', -1, a, ip, info )
538 CALL chkxer(
'CSPTRF', infot, nout, lerr, ok )
544 CALL csptri(
'/', 0, a, ip, w, info )
545 CALL chkxer(
'CSPTRI', infot, nout, lerr, ok )
547 CALL csptri(
'U', -1, a, ip, w, info )
548 CALL chkxer(
'CSPTRI', infot, nout, lerr, ok )
554 CALL csptrs(
'/', 0, 0, a, ip, b, 1, info )
555 CALL chkxer(
'CSPTRS', infot, nout, lerr, ok )
557 CALL csptrs(
'U', -1, 0, a, ip, b, 1, info )
558 CALL chkxer(
'CSPTRS', infot, nout, lerr, ok )
560 CALL csptrs(
'U', 0, -1, a, ip, b, 1, info )
561 CALL chkxer(
'CSPTRS', infot, nout, lerr, ok )
563 CALL csptrs(
'U', 2, 1, a, ip, b, 1, info )
564 CALL chkxer(
'CSPTRS', infot, nout, lerr, ok )
570 CALL csprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
572 CALL chkxer(
'CSPRFS', infot, nout, lerr, ok )
574 CALL csprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
576 CALL chkxer(
'CSPRFS', infot, nout, lerr, ok )
578 CALL csprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
580 CALL chkxer(
'CSPRFS', infot, nout, lerr, ok )
582 CALL csprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
584 CALL chkxer(
'CSPRFS', infot, nout, lerr, ok )
586 CALL csprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
588 CALL chkxer(
'CSPRFS', infot, nout, lerr, ok )
594 CALL cspcon(
'/', 0, a, ip, anrm, rcond, w, info )
595 CALL chkxer(
'CSPCON', infot, nout, lerr, ok )
597 CALL cspcon(
'U', -1, a, ip, anrm, rcond, w, info )
598 CALL chkxer(
'CSPCON', infot, nout, lerr, ok )
600 CALL cspcon(
'U', 1, a, ip, -anrm, rcond, w, info )
601 CALL chkxer(
'CSPCON', infot, nout, lerr, ok )
606 CALL alaesm( path, ok, nout )