77 DOUBLE PRECISION ANRM, RCOND
80 INTEGER IP( NMAX ), IW( NMAX )
81 DOUBLE PRECISION A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
82 $ E( NMAX ), R1( NMAX ), R2( NMAX ), W( 3*NMAX ),
104 COMMON / infoc / infot, nout, ok, lerr
105 COMMON / srnamc / srnamt
113 WRITE( nout, fmt = * )
120 a( i, j ) = 1.d0 / dble( i+j )
121 af( i, j ) = 1.d0 / dble( i+j )
136 IF(
lsamen( 2, c2,
'SY' ) )
THEN
146 CALL dsytrf(
'/', 0, a, 1, ip, w, 1, info )
147 CALL chkxer(
'DSYTRF', infot, nout, lerr, ok )
149 CALL dsytrf(
'U', -1, a, 1, ip, w, 1, info )
150 CALL chkxer(
'DSYTRF', infot, nout, lerr, ok )
152 CALL dsytrf(
'U', 2, a, 1, ip, w, 4, info )
153 CALL chkxer(
'DSYTRF', infot, nout, lerr, ok )
155 CALL dsytrf(
'U', 0, a, 1, ip, w, 0, info )
156 CALL chkxer(
'DSYTRF', infot, nout, lerr, ok )
158 CALL dsytrf(
'U', 0, a, 1, ip, w, -2, info )
159 CALL chkxer(
'DSYTRF', infot, nout, lerr, ok )
165 CALL dsytf2(
'/', 0, a, 1, ip, info )
166 CALL chkxer(
'DSYTF2', infot, nout, lerr, ok )
168 CALL dsytf2(
'U', -1, a, 1, ip, info )
169 CALL chkxer(
'DSYTF2', infot, nout, lerr, ok )
171 CALL dsytf2(
'U', 2, a, 1, ip, info )
172 CALL chkxer(
'DSYTF2', infot, nout, lerr, ok )
178 CALL dsytri(
'/', 0, a, 1, ip, w, info )
179 CALL chkxer(
'DSYTRI', infot, nout, lerr, ok )
181 CALL dsytri(
'U', -1, a, 1, ip, w, info )
182 CALL chkxer(
'DSYTRI', infot, nout, lerr, ok )
184 CALL dsytri(
'U', 2, a, 1, ip, w, info )
185 CALL chkxer(
'DSYTRI', infot, nout, lerr, ok )
191 CALL dsytri2(
'/', 0, a, 1, ip, w, iw(1), info )
192 CALL chkxer(
'DSYTRI2', infot, nout, lerr, ok )
194 CALL dsytri2(
'U', -1, a, 1, ip, w, iw(1), info )
195 CALL chkxer(
'DSYTRI2', infot, nout, lerr, ok )
197 CALL dsytri2(
'U', 2, a, 1, ip, w, iw(1), info )
198 CALL chkxer(
'DSYTRI2', infot, nout, lerr, ok )
204 CALL dsytri2x(
'/', 0, a, 1, ip, w, 1, info )
205 CALL chkxer(
'DSYTRI2X', infot, nout, lerr, ok )
207 CALL dsytri2x(
'U', -1, a, 1, ip, w, 1, info )
208 CALL chkxer(
'DSYTRI2X', infot, nout, lerr, ok )
210 CALL dsytri2x(
'U', 2, a, 1, ip, w, 1, info )
211 CALL chkxer(
'DSYTRI2X', infot, nout, lerr, ok )
217 CALL dsytrs(
'/', 0, 0, a, 1, ip, b, 1, info )
218 CALL chkxer(
'DSYTRS', infot, nout, lerr, ok )
220 CALL dsytrs(
'U', -1, 0, a, 1, ip, b, 1, info )
221 CALL chkxer(
'DSYTRS', infot, nout, lerr, ok )
223 CALL dsytrs(
'U', 0, -1, a, 1, ip, b, 1, info )
224 CALL chkxer(
'DSYTRS', infot, nout, lerr, ok )
226 CALL dsytrs(
'U', 2, 1, a, 1, ip, b, 2, info )
227 CALL chkxer(
'DSYTRS', infot, nout, lerr, ok )
229 CALL dsytrs(
'U', 2, 1, a, 2, ip, b, 1, info )
230 CALL chkxer(
'DSYTRS', infot, nout, lerr, ok )
236 CALL dsyrfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
238 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
240 CALL dsyrfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
242 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
244 CALL dsyrfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
246 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
248 CALL dsyrfs(
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
250 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
252 CALL dsyrfs(
'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
254 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
256 CALL dsyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
258 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
260 CALL dsyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
262 CALL chkxer(
'DSYRFS', infot, nout, lerr, ok )
268 CALL dsycon(
'/', 0, a, 1, ip, anrm, rcond, w, iw, info )
269 CALL chkxer(
'DSYCON', infot, nout, lerr, ok )
271 CALL dsycon(
'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
272 CALL chkxer(
'DSYCON', infot, nout, lerr, ok )
274 CALL dsycon(
'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
275 CALL chkxer(
'DSYCON', infot, nout, lerr, ok )
277 CALL dsycon(
'U', 1, a, 1, ip, -1.0d0, rcond, w, iw, info )
278 CALL chkxer(
'DSYCON', infot, nout, lerr, ok )
280 ELSE IF(
lsamen( 2, c2,
'SR' ) )
THEN
288 srnamt =
'DSYTRF_ROOK'
291 CALL chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
294 CALL chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
297 CALL chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
300 CALL chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
303 CALL chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
307 srnamt =
'DSYTF2_ROOK'
310 CALL chkxer(
'DSYTF2_ROOK', infot, nout, lerr, ok )
313 CALL chkxer(
'DSYTF2_ROOK', infot, nout, lerr, ok )
316 CALL chkxer(
'DSYTF2_ROOK', infot, nout, lerr, ok )
320 srnamt =
'DSYTRI_ROOK'
323 CALL chkxer(
'DSYTRI_ROOK', infot, nout, lerr, ok )
326 CALL chkxer(
'DSYTRI_ROOK', infot, nout, lerr, ok )
329 CALL chkxer(
'DSYTRI_ROOK', infot, nout, lerr, ok )
333 srnamt =
'DSYTRS_ROOK'
335 CALL dsytrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
336 CALL chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
338 CALL dsytrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
339 CALL chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
341 CALL dsytrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
342 CALL chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
344 CALL dsytrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
345 CALL chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
347 CALL dsytrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
348 CALL chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
352 srnamt =
'DSYCON_ROOK'
354 CALL dsycon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, iw, info )
355 CALL chkxer(
'DSYCON_ROOK', infot, nout, lerr, ok )
357 CALL dsycon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
358 CALL chkxer(
'DSYCON_ROOK', infot, nout, lerr, ok )
360 CALL dsycon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
361 CALL chkxer(
'DSYCON_ROOK', infot, nout, lerr, ok )
363 CALL dsycon_rook(
'U', 1, a, 1, ip, -1.0d0, rcond, w, iw, info)
364 CALL chkxer(
'DSYCON_ROOK', infot, nout, lerr, ok )
366 ELSE IF(
lsamen( 2, c2,
'SK' ) )
THEN
380 CALL dsytrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
381 CALL chkxer(
'DSYTRF_RK', infot, nout, lerr, ok )
383 CALL dsytrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
384 CALL chkxer(
'DSYTRF_RK', infot, nout, lerr, ok )
386 CALL dsytrf_rk(
'U', 2, a, 1, e, ip, w, 1, info )
387 CALL chkxer(
'DSYTRF_RK', infot, nout, lerr, ok )
389 CALL dsytrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
390 CALL chkxer(
'DSYTRF_RK', infot, nout, lerr, ok )
392 CALL dsytrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
393 CALL chkxer(
'DSYTRF_RK', infot, nout, lerr, ok )
399 CALL dsytf2_rk(
'/', 0, a, 1, e, ip, info )
400 CALL chkxer(
'DSYTF2_RK', infot, nout, lerr, ok )
402 CALL dsytf2_rk(
'U', -1, a, 1, e, ip, info )
403 CALL chkxer(
'DSYTF2_RK', infot, nout, lerr, ok )
405 CALL dsytf2_rk(
'U', 2, a, 1, e, ip, info )
406 CALL chkxer(
'DSYTF2_RK', infot, nout, lerr, ok )
412 CALL dsytri_3(
'/', 0, a, 1, e, ip, w, 1, info )
413 CALL chkxer(
'DSYTRI_3', infot, nout, lerr, ok )
415 CALL dsytri_3(
'U', -1, a, 1, e, ip, w, 1, info )
416 CALL chkxer(
'DSYTRI_3', infot, nout, lerr, ok )
418 CALL dsytri_3(
'U', 2, a, 1, e, ip, w, 1, info )
419 CALL chkxer(
'DSYTRI_3', infot, nout, lerr, ok )
421 CALL dsytri_3(
'U', 0, a, 1, e, ip, w, 0, info )
422 CALL chkxer(
'DSYTRI_3', infot, nout, lerr, ok )
424 CALL dsytri_3(
'U', 0, a, 1, e, ip, w, -2, info )
425 CALL chkxer(
'DSYTRI_3', infot, nout, lerr, ok )
431 CALL dsytri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
432 CALL chkxer(
'DSYTRI_3X', infot, nout, lerr, ok )
434 CALL dsytri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
435 CALL chkxer(
'DSYTRI_3X', infot, nout, lerr, ok )
437 CALL dsytri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
438 CALL chkxer(
'DSYTRI_3X', infot, nout, lerr, ok )
444 CALL dsytrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
445 CALL chkxer(
'DSYTRS_3', infot, nout, lerr, ok )
447 CALL dsytrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
448 CALL chkxer(
'DSYTRS_3', infot, nout, lerr, ok )
450 CALL dsytrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
451 CALL chkxer(
'DSYTRS_3', infot, nout, lerr, ok )
453 CALL dsytrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
454 CALL chkxer(
'DSYTRS_3', infot, nout, lerr, ok )
456 CALL dsytrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
457 CALL chkxer(
'DSYTRS_3', infot, nout, lerr, ok )
463 CALL dsycon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, iw,
465 CALL chkxer(
'DSYCON_3', infot, nout, lerr, ok )
467 CALL dsycon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, iw,
469 CALL chkxer(
'DSYCON_3', infot, nout, lerr, ok )
471 CALL dsycon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, iw,
473 CALL chkxer(
'DSYCON_3', infot, nout, lerr, ok )
475 CALL dsycon_3(
'U', 1, a, 1, e, ip, -1.0d0, rcond, w, iw,
477 CALL chkxer(
'DSYCON_3', infot, nout, lerr, ok )
479 ELSE IF(
lsamen( 2, c2,
'SA' ) )
THEN
488 CALL dsytrf_aa(
'/', 0, a, 1, ip, w, 1, info )
489 CALL chkxer(
'DSYTRF_AA', infot, nout, lerr, ok )
491 CALL dsytrf_aa(
'U', -1, a, 1, ip, w, 1, info )
492 CALL chkxer(
'DSYTRF_AA', infot, nout, lerr, ok )
494 CALL dsytrf_aa(
'U', 2, a, 1, ip, w, 4, info )
495 CALL chkxer(
'DSYTRF_AA', infot, nout, lerr, ok )
497 CALL dsytrf_aa(
'U', 0, a, 1, ip, w, 0, info )
498 CALL chkxer(
'DSYTRF_AA', infot, nout, lerr, ok )
500 CALL dsytrf_aa(
'U', 0, a, 1, ip, w, -2, info )
501 CALL chkxer(
'DSYTRF_AA', infot, nout, lerr, ok )
507 CALL dsytrs_aa(
'/', 0, 0, a, 1, ip, b, 1, w, 1, info )
508 CALL chkxer(
'DSYTRS_AA', infot, nout, lerr, ok )
510 CALL dsytrs_aa(
'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
511 CALL chkxer(
'DSYTRS_AA', infot, nout, lerr, ok )
513 CALL dsytrs_aa(
'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
514 CALL chkxer(
'DSYTRS_AA', infot, nout, lerr, ok )
516 CALL dsytrs_aa(
'U', 2, 1, a, 1, ip, b, 2, w, 1, info )
517 CALL chkxer(
'DSYTRS_AA', infot, nout, lerr, ok )
519 CALL dsytrs_aa(
'U', 2, 1, a, 2, ip, b, 1, w, 1, info )
520 CALL chkxer(
'DSYTRS_AA', infot, nout, lerr, ok )
522 CALL dsytrs_aa(
'U', 0, 1, a, 2, ip, b, 1, w, 0, info )
523 CALL chkxer(
'DSYTRS_AA', infot, nout, lerr, ok )
525 CALL dsytrs_aa(
'U', 0, 1, a, 2, ip, b, 1, w, -2, info )
526 CALL chkxer(
'DSYTRS_AA', infot, nout, lerr, ok )
528 ELSE IF(
lsamen( 2, c2,
'S2' ) )
THEN
535 srnamt =
'DSYTRF_AA_2STAGE'
537 CALL dsytrf_aa_2stage(
'/', 0, a, 1, a, 1, ip, ip, w, 1,
539 CALL chkxer(
'DSYTRF_AA_2STAGE', infot, nout, lerr, ok )
541 CALL dsytrf_aa_2stage(
'U', -1, a, 1, a, 1, ip, ip, w, 1,
543 CALL chkxer(
'DSYTRF_AA_2STAGE', infot, nout, lerr, ok )
545 CALL dsytrf_aa_2stage(
'U', 2, a, 1, a, 2, ip, ip, w, 1,
547 CALL chkxer(
'DSYTRF_AA_2STAGE', infot, nout, lerr, ok )
549 CALL dsytrf_aa_2stage(
'U', 2, a, 2, a, 1, ip, ip, w, 1,
551 CALL chkxer(
'DSYTRF_AA_2STAGE', infot, nout, lerr, ok )
553 CALL dsytrf_aa_2stage(
'U', 2, a, 2, a, 8, ip, ip, w, 0,
555 CALL chkxer(
'DSYTRF_AA_2STAGE', infot, nout, lerr, ok )
559 srnamt =
'DSYTRS_AA_2STAGE'
563 CALL chkxer(
'DSYTRS_AA_2STAGE', infot, nout, lerr, ok )
567 CALL chkxer(
'DSYTRS_AA_2STAGE', infot, nout, lerr, ok )
571 CALL chkxer(
'DSYTRS_AA_2STAGE', infot, nout, lerr, ok )
575 CALL chkxer(
'DSYTRS_AA_2STAGE', infot, nout, lerr, ok )
579 CALL chkxer(
'DSYTRS_AA_2STAGE', infot, nout, lerr, ok )
583 CALL chkxer(
'DSYTRS_AA_STAGE', infot, nout, lerr, ok )
584 ELSE IF(
lsamen( 2, c2,
'SP' ) )
THEN
594 CALL dsptrf(
'/', 0, a, ip, info )
595 CALL chkxer(
'DSPTRF', infot, nout, lerr, ok )
597 CALL dsptrf(
'U', -1, a, ip, info )
598 CALL chkxer(
'DSPTRF', infot, nout, lerr, ok )
604 CALL dsptri(
'/', 0, a, ip, w, info )
605 CALL chkxer(
'DSPTRI', infot, nout, lerr, ok )
607 CALL dsptri(
'U', -1, a, ip, w, info )
608 CALL chkxer(
'DSPTRI', infot, nout, lerr, ok )
614 CALL dsptrs(
'/', 0, 0, a, ip, b, 1, info )
615 CALL chkxer(
'DSPTRS', infot, nout, lerr, ok )
617 CALL dsptrs(
'U', -1, 0, a, ip, b, 1, info )
618 CALL chkxer(
'DSPTRS', infot, nout, lerr, ok )
620 CALL dsptrs(
'U', 0, -1, a, ip, b, 1, info )
621 CALL chkxer(
'DSPTRS', infot, nout, lerr, ok )
623 CALL dsptrs(
'U', 2, 1, a, ip, b, 1, info )
624 CALL chkxer(
'DSPTRS', infot, nout, lerr, ok )
630 CALL dsprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
632 CALL chkxer(
'DSPRFS', infot, nout, lerr, ok )
634 CALL dsprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
636 CALL chkxer(
'DSPRFS', infot, nout, lerr, ok )
638 CALL dsprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
640 CALL chkxer(
'DSPRFS', infot, nout, lerr, ok )
642 CALL dsprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, iw,
644 CALL chkxer(
'DSPRFS', infot, nout, lerr, ok )
646 CALL dsprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, iw,
648 CALL chkxer(
'DSPRFS', infot, nout, lerr, ok )
654 CALL dspcon(
'/', 0, a, ip, anrm, rcond, w, iw, info )
655 CALL chkxer(
'DSPCON', infot, nout, lerr, ok )
657 CALL dspcon(
'U', -1, a, ip, anrm, rcond, w, iw, info )
658 CALL chkxer(
'DSPCON', infot, nout, lerr, ok )
660 CALL dspcon(
'U', 1, a, ip, -1.0d0, rcond, w, iw, info )
661 CALL chkxer(
'DSPCON', infot, nout, lerr, ok )
666 CALL alaesm( path, ok, nout )