77 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
78 DOUBLE PRECISION ANRM, RCOND, BERR
82 DOUBLE PRECISION R( NMAX ), R1( NMAX ), R2( NMAX ),
83 $ S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
84 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
85 COMPLEX*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
86 $ E( NMAX ), W( 2*NMAX ), X( NMAX )
106 COMMON / infoc / infot, nout, ok, lerr
107 COMMON / srnamc / srnamt
110 INTRINSIC dble, dcmplx
115 WRITE( nout, fmt = * )
122 a( i, j ) = dcmplx( 1.d0 / dble( i+j ),
123 $ -1.d0 / dble( i+j ) )
124 af( i, j ) = dcmplx( 1.d0 / dble( i+j ),
125 $ -1.d0 / dble( i+j ) )
139 IF( lsamen( 2, c2,
'SY' ) )
THEN
149 CALL zsytrf(
'/', 0, a, 1, ip, w, 1, info )
150 CALL chkxer(
'ZSYTRF', infot, nout, lerr, ok )
152 CALL zsytrf(
'U', -1, a, 1, ip, w, 1, info )
153 CALL chkxer(
'ZSYTRF', infot, nout, lerr, ok )
155 CALL zsytrf(
'U', 2, a, 1, ip, w, 4, info )
156 CALL chkxer(
'ZSYTRF', infot, nout, lerr, ok )
158 CALL zsytrf(
'U', 0, a, 1, ip, w, 0, info )
159 CALL chkxer(
'ZSYTRF', infot, nout, lerr, ok )
161 CALL zsytrf(
'U', 0, a, 1, ip, w, -2, info )
162 CALL chkxer(
'ZSYTRF', infot, nout, lerr, ok )
168 CALL zsytf2(
'/', 0, a, 1, ip, info )
169 CALL chkxer(
'ZSYTF2', infot, nout, lerr, ok )
171 CALL zsytf2(
'U', -1, a, 1, ip, info )
172 CALL chkxer(
'ZSYTF2', infot, nout, lerr, ok )
174 CALL zsytf2(
'U', 2, a, 1, ip, info )
175 CALL chkxer(
'ZSYTF2', infot, nout, lerr, ok )
181 CALL zsytri(
'/', 0, a, 1, ip, w, info )
182 CALL chkxer(
'ZSYTRI', infot, nout, lerr, ok )
184 CALL zsytri(
'U', -1, a, 1, ip, w, info )
185 CALL chkxer(
'ZSYTRI', infot, nout, lerr, ok )
187 CALL zsytri(
'U', 2, a, 1, ip, w, info )
188 CALL chkxer(
'ZSYTRI', infot, nout, lerr, ok )
194 CALL zsytri2(
'/', 0, a, 1, ip, w, 1, info )
195 CALL chkxer(
'ZSYTRI2', infot, nout, lerr, ok )
197 CALL zsytri2(
'U', -1, a, 1, ip, w, 1, info )
198 CALL chkxer(
'ZSYTRI2', infot, nout, lerr, ok )
200 CALL zsytri2(
'U', 2, a, 1, ip, w, 1, info )
201 CALL chkxer(
'ZSYTRI2', infot, nout, lerr, ok )
207 CALL zsytri2x(
'/', 0, a, 1, ip, w, 1, info )
208 CALL chkxer(
'ZSYTRI2X', infot, nout, lerr, ok )
210 CALL zsytri2x(
'U', -1, a, 1, ip, w, 1, info )
211 CALL chkxer(
'ZSYTRI2X', infot, nout, lerr, ok )
213 CALL zsytri2x(
'U', 2, a, 1, ip, w, 1, info )
214 CALL chkxer(
'ZSYTRI2X', infot, nout, lerr, ok )
220 CALL zsytrs(
'/', 0, 0, a, 1, ip, b, 1, info )
221 CALL chkxer(
'ZSYTRS', infot, nout, lerr, ok )
223 CALL zsytrs(
'U', -1, 0, a, 1, ip, b, 1, info )
224 CALL chkxer(
'ZSYTRS', infot, nout, lerr, ok )
226 CALL zsytrs(
'U', 0, -1, a, 1, ip, b, 1, info )
227 CALL chkxer(
'ZSYTRS', infot, nout, lerr, ok )
229 CALL zsytrs(
'U', 2, 1, a, 1, ip, b, 2, info )
230 CALL chkxer(
'ZSYTRS', infot, nout, lerr, ok )
232 CALL zsytrs(
'U', 2, 1, a, 2, ip, b, 1, info )
233 CALL chkxer(
'ZSYTRS', infot, nout, lerr, ok )
239 CALL zsyrfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
241 CALL chkxer(
'ZSYRFS', infot, nout, lerr, ok )
243 CALL zsyrfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
245 CALL chkxer(
'ZSYRFS', infot, nout, lerr, ok )
247 CALL zsyrfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
249 CALL chkxer(
'ZSYRFS', infot, nout, lerr, ok )
251 CALL zsyrfs(
'U', 2, 1, a, 1, af, 2, 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, 1, ip, b, 2, 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, 1, x, 2, r1, r2, w,
261 CALL chkxer(
'ZSYRFS', infot, nout, lerr, ok )
263 CALL zsyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
265 CALL chkxer(
'ZSYRFS', infot, nout, lerr, ok )
273 CALL zsyrfsx(
'/', eq, 0, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
274 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
275 $ params, w, r, info )
276 CALL chkxer(
'ZSYRFSX', infot, nout, lerr, ok )
278 CALL zsyrfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
279 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
280 $ params, w, r, info )
281 CALL chkxer(
'ZSYRFSX', infot, nout, lerr, ok )
284 CALL zsyrfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
285 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
286 $ params, w, r, info )
287 CALL chkxer(
'ZSYRFSX', infot, nout, lerr, ok )
289 CALL zsyrfsx(
'U', eq, 0, -1, a, 1, af, 1, ip, s, b, 1, x, 1,
290 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
291 $ params, w, r, info )
292 CALL chkxer(
'ZSYRFSX', infot, nout, lerr, ok )
294 CALL zsyrfsx(
'U', eq, 2, 1, a, 1, af, 2, ip, s, b, 2, x, 2,
295 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
296 $ params, w, r, info )
297 CALL chkxer(
'ZSYRFSX', infot, nout, lerr, ok )
299 CALL zsyrfsx(
'U', eq, 2, 1, a, 2, af, 1, ip, s, b, 2, x, 2,
300 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
301 $ params, w, r, info )
302 CALL chkxer(
'ZSYRFSX', infot, nout, lerr, ok )
304 CALL zsyrfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 1, x, 2,
305 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
306 $ params, w, r, info )
307 CALL chkxer(
'ZSYRFSX', infot, nout, lerr, ok )
309 CALL zsyrfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 2, x, 1,
310 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
311 $ params, w, r, info )
312 CALL chkxer(
'ZSYRFSX', infot, nout, lerr, ok )
318 CALL zsycon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
319 CALL chkxer(
'ZSYCON', infot, nout, lerr, ok )
321 CALL zsycon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
322 CALL chkxer(
'ZSYCON', infot, nout, lerr, ok )
324 CALL zsycon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
325 CALL chkxer(
'ZSYCON', infot, nout, lerr, ok )
327 CALL zsycon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
328 CALL chkxer(
'ZSYCON', infot, nout, lerr, ok )
330 ELSE IF( lsamen( 2, c2,
'SR' ) )
THEN
338 srnamt =
'ZSYTRF_ROOK'
341 CALL chkxer(
'ZSYTRF_ROOK', infot, nout, lerr, ok )
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 )
357 srnamt =
'ZSYTF2_ROOK'
360 CALL chkxer(
'ZSYTF2_ROOK', infot, nout, lerr, ok )
363 CALL chkxer(
'ZSYTF2_ROOK', infot, nout, lerr, ok )
366 CALL chkxer(
'ZSYTF2_ROOK', infot, nout, lerr, ok )
370 srnamt =
'ZSYTRI_ROOK'
373 CALL chkxer(
'ZSYTRI_ROOK', infot, nout, lerr, ok )
376 CALL chkxer(
'ZSYTRI_ROOK', infot, nout, lerr, ok )
379 CALL chkxer(
'ZSYTRI_ROOK', infot, nout, lerr, ok )
383 srnamt =
'ZSYTRS_ROOK'
385 CALL zsytrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
386 CALL chkxer(
'ZSYTRS_ROOK', infot, nout, lerr, ok )
388 CALL zsytrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
389 CALL chkxer(
'ZSYTRS_ROOK', infot, nout, lerr, ok )
391 CALL zsytrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
392 CALL chkxer(
'ZSYTRS_ROOK', infot, nout, lerr, ok )
394 CALL zsytrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
395 CALL chkxer(
'ZSYTRS_ROOK', infot, nout, lerr, ok )
397 CALL zsytrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
398 CALL chkxer(
'ZSYTRS_ROOK', infot, nout, lerr, ok )
402 srnamt =
'ZSYCON_ROOK'
404 CALL zsycon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
405 CALL chkxer(
'ZSYCON_ROOK', infot, nout, lerr, ok )
407 CALL zsycon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
408 CALL chkxer(
'ZSYCON_ROOK', infot, nout, lerr, ok )
410 CALL zsycon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, info )
411 CALL chkxer(
'ZSYCON_ROOK', infot, nout, lerr, ok )
413 CALL zsycon_rook(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
414 CALL chkxer(
'ZSYCON_ROOK', infot, nout, lerr, ok )
416 ELSE IF( lsamen( 2, c2,
'SK' ) )
THEN
430 CALL zsytrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
431 CALL chkxer(
'ZSYTRF_RK', infot, nout, lerr, ok )
433 CALL zsytrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
434 CALL chkxer(
'ZSYTRF_RK', infot, nout, lerr, ok )
436 CALL zsytrf_rk(
'U', 2, a, 1, e, ip, w, 4, info )
437 CALL chkxer(
'ZSYTRF_RK', infot, nout, lerr, ok )
439 CALL zsytrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
440 CALL chkxer(
'ZSYTRF_RK', infot, nout, lerr, ok )
442 CALL zsytrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
443 CALL chkxer(
'ZSYTRF_RK', infot, nout, lerr, ok )
449 CALL zsytf2_rk(
'/', 0, a, 1, e, ip, info )
450 CALL chkxer(
'ZSYTF2_RK', infot, nout, lerr, ok )
452 CALL zsytf2_rk(
'U', -1, a, 1, e, ip, info )
453 CALL chkxer(
'ZSYTF2_RK', infot, nout, lerr, ok )
455 CALL zsytf2_rk(
'U', 2, a, 1, e, ip, info )
456 CALL chkxer(
'ZSYTF2_RK', infot, nout, lerr, ok )
462 CALL zsytri_3(
'/', 0, a, 1, e, ip, w, 1, info )
463 CALL chkxer(
'ZSYTRI_3', infot, nout, lerr, ok )
465 CALL zsytri_3(
'U', -1, a, 1, e, ip, w, 1, info )
466 CALL chkxer(
'ZSYTRI_3', infot, nout, lerr, ok )
468 CALL zsytri_3(
'U', 2, a, 1, e, ip, w, 1, info )
469 CALL chkxer(
'ZSYTRI_3', infot, nout, lerr, ok )
471 CALL zsytri_3(
'U', 0, a, 1, e, ip, w, 0, info )
472 CALL chkxer(
'ZSYTRI_3', infot, nout, lerr, ok )
474 CALL zsytri_3(
'U', 0, a, 1, e, ip, w, -2, info )
475 CALL chkxer(
'ZSYTRI_3', infot, nout, lerr, ok )
481 CALL zsytri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
482 CALL chkxer(
'ZSYTRI_3X', infot, nout, lerr, ok )
484 CALL zsytri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
485 CALL chkxer(
'ZSYTRI_3X', infot, nout, lerr, ok )
487 CALL zsytri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
488 CALL chkxer(
'ZSYTRI_3X', infot, nout, lerr, ok )
494 CALL zsytrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
495 CALL chkxer(
'ZSYTRS_3', infot, nout, lerr, ok )
497 CALL zsytrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
498 CALL chkxer(
'ZSYTRS_3', infot, nout, lerr, ok )
500 CALL zsytrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
501 CALL chkxer(
'ZSYTRS_3', infot, nout, lerr, ok )
503 CALL zsytrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
504 CALL chkxer(
'ZSYTRS_3', infot, nout, lerr, ok )
506 CALL zsytrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
507 CALL chkxer(
'ZSYTRS_3', infot, nout, lerr, ok )
513 CALL zsycon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, info )
514 CALL chkxer(
'ZSYCON_3', infot, nout, lerr, ok )
516 CALL zsycon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, info )
517 CALL chkxer(
'ZSYCON_3', infot, nout, lerr, ok )
519 CALL zsycon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, info )
520 CALL chkxer(
'ZSYCON_3', infot, nout, lerr, ok )
522 CALL zsycon_3(
'U', 1, a, 1, e, ip, -1.0d0, rcond, w, info)
523 CALL chkxer(
'ZSYCON_3', infot, nout, lerr, ok )
525 ELSE IF( lsamen( 2, c2,
'SP' ) )
THEN
535 CALL zsptrf(
'/', 0, a, ip, info )
536 CALL chkxer(
'ZSPTRF', infot, nout, lerr, ok )
538 CALL zsptrf(
'U', -1, a, ip, info )
539 CALL chkxer(
'ZSPTRF', infot, nout, lerr, ok )
545 CALL zsptri(
'/', 0, a, ip, w, info )
546 CALL chkxer(
'ZSPTRI', infot, nout, lerr, ok )
548 CALL zsptri(
'U', -1, a, ip, w, info )
549 CALL chkxer(
'ZSPTRI', infot, nout, lerr, ok )
555 CALL zsptrs(
'/', 0, 0, a, ip, b, 1, info )
556 CALL chkxer(
'ZSPTRS', infot, nout, lerr, ok )
558 CALL zsptrs(
'U', -1, 0, a, ip, b, 1, info )
559 CALL chkxer(
'ZSPTRS', infot, nout, lerr, ok )
561 CALL zsptrs(
'U', 0, -1, a, ip, b, 1, info )
562 CALL chkxer(
'ZSPTRS', infot, nout, lerr, ok )
564 CALL zsptrs(
'U', 2, 1, a, ip, b, 1, info )
565 CALL chkxer(
'ZSPTRS', infot, nout, lerr, ok )
571 CALL zsprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
573 CALL chkxer(
'ZSPRFS', infot, nout, lerr, ok )
575 CALL zsprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
577 CALL chkxer(
'ZSPRFS', infot, nout, lerr, ok )
579 CALL zsprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
581 CALL chkxer(
'ZSPRFS', infot, nout, lerr, ok )
583 CALL zsprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
585 CALL chkxer(
'ZSPRFS', infot, nout, lerr, ok )
587 CALL zsprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
589 CALL chkxer(
'ZSPRFS', infot, nout, lerr, ok )
595 CALL zspcon(
'/', 0, a, ip, anrm, rcond, w, info )
596 CALL chkxer(
'ZSPCON', infot, nout, lerr, ok )
598 CALL zspcon(
'U', -1, 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 )
607 CALL alaesm( path, ok, nout )