77 INTEGER IP( NMAX ), IW( NMAX )
78 REAL A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
79 $ E( NMAX ), R1( NMAX ), R2( NMAX ), W( 3*NMAX ),
101 COMMON / infoc / infot, nout, ok, lerr
102 COMMON / srnamc / srnamt
110 WRITE( nout, fmt = * )
117 a( i, j ) = 1. / real( i+j )
118 af( i, j ) = 1. / real( i+j )
133 IF( lsamen( 2, c2,
'SY' ) )
THEN
143 CALL ssytrf(
'/', 0, a, 1, ip, w, 1, info )
144 CALL chkxer(
'SSYTRF', infot, nout, lerr, ok )
146 CALL ssytrf(
'U', -1, a, 1, ip, w, 1, info )
147 CALL chkxer(
'SSYTRF', infot, nout, lerr, ok )
149 CALL ssytrf(
'U', 2, a, 1, ip, w, 4, info )
150 CALL chkxer(
'SSYTRF', infot, nout, lerr, ok )
152 CALL ssytrf(
'U', 0, a, 1, ip, w, 0, info )
153 CALL chkxer(
'SSYTRF', infot, nout, lerr, ok )
155 CALL ssytrf(
'U', 0, a, 1, ip, w, -2, info )
156 CALL chkxer(
'SSYTRF', infot, nout, lerr, ok )
162 CALL ssytf2(
'/', 0, a, 1, ip, info )
163 CALL chkxer(
'SSYTF2', infot, nout, lerr, ok )
165 CALL ssytf2(
'U', -1, a, 1, ip, info )
166 CALL chkxer(
'SSYTF2', infot, nout, lerr, ok )
168 CALL ssytf2(
'U', 2, a, 1, ip, info )
169 CALL chkxer(
'SSYTF2', infot, nout, lerr, ok )
175 CALL ssytri(
'/', 0, a, 1, ip, w, info )
176 CALL chkxer(
'SSYTRI', infot, nout, lerr, ok )
178 CALL ssytri(
'U', -1, a, 1, ip, w, info )
179 CALL chkxer(
'SSYTRI', infot, nout, lerr, ok )
181 CALL ssytri(
'U', 2, a, 1, ip, w, info )
182 CALL chkxer(
'SSYTRI', infot, nout, lerr, ok )
188 CALL ssytri2(
'/', 0, a, 1, ip, w, iw(1), info )
189 CALL chkxer(
'SSYTRI2', infot, nout, lerr, ok )
191 CALL ssytri2(
'U', -1, a, 1, ip, w, iw(1), info )
192 CALL chkxer(
'SSYTRI2', infot, nout, lerr, ok )
194 CALL ssytri2(
'U', 2, a, 1, ip, w, iw(1), info )
195 CALL chkxer(
'SSYTRI2', infot, nout, lerr, ok )
201 CALL ssytri2x(
'/', 0, a, 1, ip, w, 1, info )
202 CALL chkxer(
'SSYTRI2X', infot, nout, lerr, ok )
204 CALL ssytri2x(
'U', -1, a, 1, ip, w, 1, info )
205 CALL chkxer(
'SSYTRI2X', infot, nout, lerr, ok )
207 CALL ssytri2x(
'U', 2, a, 1, ip, w, 1, info )
208 CALL chkxer(
'SSYTRI2X', infot, nout, lerr, ok )
214 CALL ssytrs(
'/', 0, 0, a, 1, ip, b, 1, info )
215 CALL chkxer(
'SSYTRS', infot, nout, lerr, ok )
217 CALL ssytrs(
'U', -1, 0, a, 1, ip, b, 1, info )
218 CALL chkxer(
'SSYTRS', infot, nout, lerr, ok )
220 CALL ssytrs(
'U', 0, -1, a, 1, ip, b, 1, info )
221 CALL chkxer(
'SSYTRS', infot, nout, lerr, ok )
223 CALL ssytrs(
'U', 2, 1, a, 1, ip, b, 2, info )
224 CALL chkxer(
'SSYTRS', infot, nout, lerr, ok )
226 CALL ssytrs(
'U', 2, 1, a, 2, ip, b, 1, info )
227 CALL chkxer(
'SSYTRS', infot, nout, lerr, ok )
233 CALL ssyrfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
235 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
237 CALL ssyrfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
239 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
241 CALL ssyrfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
243 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
245 CALL ssyrfs(
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
247 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
249 CALL ssyrfs(
'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
251 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
253 CALL ssyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
255 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
257 CALL ssyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
259 CALL chkxer(
'SSYRFS', infot, nout, lerr, ok )
265 CALL ssycon(
'/', 0, a, 1, ip, anrm, rcond, w, iw, info )
266 CALL chkxer(
'SSYCON', infot, nout, lerr, ok )
268 CALL ssycon(
'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
269 CALL chkxer(
'SSYCON', infot, nout, lerr, ok )
271 CALL ssycon(
'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
272 CALL chkxer(
'SSYCON', infot, nout, lerr, ok )
274 CALL ssycon(
'U', 1, a, 1, ip, -1.0, rcond, w, iw, info )
275 CALL chkxer(
'SSYCON', infot, nout, lerr, ok )
277 ELSE IF( lsamen( 2, c2,
'SR' ) )
THEN
285 srnamt =
'SSYTRF_ROOK'
288 CALL chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
291 CALL chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
294 CALL chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
297 CALL chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
300 CALL chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
304 srnamt =
'SSYTF2_ROOK'
307 CALL chkxer(
'SSYTF2_ROOK', infot, nout, lerr, ok )
310 CALL chkxer(
'SSYTF2_ROOK', infot, nout, lerr, ok )
313 CALL chkxer(
'SSYTF2_ROOK', infot, nout, lerr, ok )
317 srnamt =
'SSYTRI_ROOK'
320 CALL chkxer(
'SSYTRI_ROOK', infot, nout, lerr, ok )
323 CALL chkxer(
'SSYTRI_ROOK', infot, nout, lerr, ok )
326 CALL chkxer(
'SSYTRI_ROOK', infot, nout, lerr, ok )
330 srnamt =
'SSYTRS_ROOK'
332 CALL ssytrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
333 CALL chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
335 CALL ssytrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
336 CALL chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
338 CALL ssytrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
339 CALL chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
341 CALL ssytrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
342 CALL chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
344 CALL ssytrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
345 CALL chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
349 srnamt =
'SSYCON_ROOK'
351 CALL ssycon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, iw, info )
352 CALL chkxer(
'SSYCON_ROOK', infot, nout, lerr, ok )
354 CALL ssycon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
355 CALL chkxer(
'SSYCON_ROOK', infot, nout, lerr, ok )
357 CALL ssycon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
358 CALL chkxer(
'SSYCON_ROOK', infot, nout, lerr, ok )
360 CALL ssycon_rook(
'U', 1, a, 1, ip, -1.0, rcond, w, iw, info )
361 CALL chkxer(
'SSYCON_ROOK', infot, nout, lerr, ok )
363 ELSE IF( lsamen( 2, c2,
'SK' ) )
THEN
377 CALL ssytrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
378 CALL chkxer(
'SSYTRF_RK', infot, nout, lerr, ok )
380 CALL ssytrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
381 CALL chkxer(
'SSYTRF_RK', infot, nout, lerr, ok )
383 CALL ssytrf_rk(
'U', 2, a, 1, e, ip, w, 4, info )
384 CALL chkxer(
'SSYTRF_RK', infot, nout, lerr, ok )
386 CALL ssytrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
387 CALL chkxer(
'SSYTRF_RK', infot, nout, lerr, ok )
389 CALL ssytrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
390 CALL chkxer(
'SSYTRF_RK', infot, nout, lerr, ok )
396 CALL ssytf2_rk(
'/', 0, a, 1, e, ip, info )
397 CALL chkxer(
'SSYTF2_RK', infot, nout, lerr, ok )
399 CALL ssytf2_rk(
'U', -1, a, 1, e, ip, info )
400 CALL chkxer(
'SSYTF2_RK', infot, nout, lerr, ok )
402 CALL ssytf2_rk(
'U', 2, a, 1, e, ip, info )
403 CALL chkxer(
'SSYTF2_RK', infot, nout, lerr, ok )
409 CALL ssytri_3(
'/', 0, a, 1, e, ip, w, 1, info )
410 CALL chkxer(
'SSYTRI_3', infot, nout, lerr, ok )
412 CALL ssytri_3(
'U', -1, a, 1, e, ip, w, 1, info )
413 CALL chkxer(
'SSYTRI_3', infot, nout, lerr, ok )
415 CALL ssytri_3(
'U', 2, a, 1, e, ip, w, 1, info )
416 CALL chkxer(
'SSYTRI_3', infot, nout, lerr, ok )
418 CALL ssytri_3(
'U', 0, a, 1, e, ip, w, 0, info )
419 CALL chkxer(
'SSYTRI_3', infot, nout, lerr, ok )
421 CALL ssytri_3(
'U', 0, a, 1, e, ip, w, -2, info )
422 CALL chkxer(
'SSYTRI_3', infot, nout, lerr, ok )
428 CALL ssytri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
429 CALL chkxer(
'SSYTRI_3X', infot, nout, lerr, ok )
431 CALL ssytri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
432 CALL chkxer(
'SSYTRI_3X', infot, nout, lerr, ok )
434 CALL ssytri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
435 CALL chkxer(
'SSYTRI_3X', infot, nout, lerr, ok )
441 CALL ssytrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
442 CALL chkxer(
'SSYTRS_3', infot, nout, lerr, ok )
444 CALL ssytrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
445 CALL chkxer(
'SSYTRS_3', infot, nout, lerr, ok )
447 CALL ssytrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
448 CALL chkxer(
'SSYTRS_3', infot, nout, lerr, ok )
450 CALL ssytrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
451 CALL chkxer(
'SSYTRS_3', infot, nout, lerr, ok )
453 CALL ssytrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
454 CALL chkxer(
'SSYTRS_3', infot, nout, lerr, ok )
460 CALL ssycon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, iw,
462 CALL chkxer(
'SSYCON_3', infot, nout, lerr, ok )
464 CALL ssycon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, iw,
466 CALL chkxer(
'SSYCON_3', infot, nout, lerr, ok )
468 CALL ssycon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, iw,
470 CALL chkxer(
'SSYCON_3', infot, nout, lerr, ok )
472 CALL ssycon_3(
'U', 1, a, 1, e, ip, -1.0e0, rcond, w, iw,
474 CALL chkxer(
'SSYCON_3', infot, nout, lerr, ok )
476 ELSE IF( lsamen( 2, c2,
'SA' ) )
THEN
485 CALL ssytrf_aa(
'/', 0, a, 1, ip, w, 1, info )
486 CALL chkxer(
'SSYTRF_AA', infot, nout, lerr, ok )
488 CALL ssytrf_aa(
'U', -1, a, 1, ip, w, 1, info )
489 CALL chkxer(
'SSYTRF_AA', infot, nout, lerr, ok )
491 CALL ssytrf_aa(
'U', 2, a, 1, ip, w, 4, info )
492 CALL chkxer(
'SSYTRF_AA', infot, nout, lerr, ok )
494 CALL ssytrf_aa(
'U', 0, a, 1, ip, w, 0, info )
495 CALL chkxer(
'SSYTRF_AA', infot, nout, lerr, ok )
497 CALL ssytrf_aa(
'U', 0, a, 1, ip, w, -2, info )
498 CALL chkxer(
'SSYTRF_AA', infot, nout, lerr, ok )
504 CALL ssytrs_aa(
'/', 0, 0, a, 1, ip, b, 1, w, 1, info )
505 CALL chkxer(
'SSYTRS_AA', infot, nout, lerr, ok )
507 CALL ssytrs_aa(
'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
508 CALL chkxer(
'SSYTRS_AA', infot, nout, lerr, ok )
510 CALL ssytrs_aa(
'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
511 CALL chkxer(
'SSYTRS_AA', infot, nout, lerr, ok )
513 CALL ssytrs_aa(
'U', 2, 1, a, 1, ip, b, 2, w, 1, info )
514 CALL chkxer(
'SSYTRS_AA', infot, nout, lerr, ok )
516 CALL ssytrs_aa(
'U', 2, 1, a, 2, ip, b, 1, w, 1, info )
517 CALL chkxer(
'SSYTRS_AA', infot, nout, lerr, ok )
519 CALL ssytrs_aa(
'U', 0, 1, a, 2, ip, b, 1, w, 0, info )
520 CALL chkxer(
'SSYTRS_AA', infot, nout, lerr, ok )
522 CALL ssytrs_aa(
'U', 0, 1, a, 2, ip, b, 1, w, -2, info )
523 CALL chkxer(
'SSYTRS_AA', infot, nout, lerr, ok )
524 ELSE IF( lsamen( 2, c2,
'S2' ) )
THEN
531 srnamt =
'SSYTRF_AA_2STAGE'
533 CALL ssytrf_aa_2stage(
'/', 0, a, 1, a, 1, ip, ip, w, 1,
535 CALL chkxer(
'SSYTRF_AA_2STAGE', infot, nout, lerr, ok )
537 CALL ssytrf_aa_2stage(
'U', -1, a, 1, a, 1, ip, ip, w, 1,
539 CALL chkxer(
'SSYTRF_AA_2STAGE', infot, nout, lerr, ok )
541 CALL ssytrf_aa_2stage(
'U', 2, a, 1, a, 2, ip, ip, w, 1,
543 CALL chkxer(
'SSYTRF_AA_2STAGE', infot, nout, lerr, ok )
545 CALL ssytrf_aa_2stage(
'U', 2, a, 2, a, 1, ip, ip, w, 1,
547 CALL chkxer(
'SSYTRF_AA_2STAGE', infot, nout, lerr, ok )
549 CALL ssytrf_aa_2stage(
'U', 2, a, 2, a, 8, ip, ip, w, 0,
551 CALL chkxer(
'SSYTRF_AA_2STAGE', infot, nout, lerr, ok )
555 srnamt =
'SSYTRS_AA_2STAGE'
559 CALL chkxer(
'SSYTRS_AA_2STAGE', infot, nout, lerr, ok )
563 CALL chkxer(
'SSYTRS_AA_2STAGE', infot, nout, lerr, ok )
567 CALL chkxer(
'SSYTRS_AA_2STAGE', infot, nout, lerr, ok )
571 CALL chkxer(
'SSYTRS_AA_2STAGE', infot, nout, lerr, ok )
575 CALL chkxer(
'SSYTRS_AA_2STAGE', infot, nout, lerr, ok )
579 CALL chkxer(
'SSYTRS_AA_STAGE', infot, nout, lerr, ok )
581 ELSE IF( lsamen( 2, c2,
'SP' ) )
THEN
591 CALL ssptrf(
'/', 0, a, ip, info )
592 CALL chkxer(
'SSPTRF', infot, nout, lerr, ok )
594 CALL ssptrf(
'U', -1, a, ip, info )
595 CALL chkxer(
'SSPTRF', infot, nout, lerr, ok )
601 CALL ssptri(
'/', 0, a, ip, w, info )
602 CALL chkxer(
'SSPTRI', infot, nout, lerr, ok )
604 CALL ssptri(
'U', -1, a, ip, w, info )
605 CALL chkxer(
'SSPTRI', infot, nout, lerr, ok )
611 CALL ssptrs(
'/', 0, 0, a, ip, b, 1, info )
612 CALL chkxer(
'SSPTRS', infot, nout, lerr, ok )
614 CALL ssptrs(
'U', -1, 0, a, ip, b, 1, info )
615 CALL chkxer(
'SSPTRS', infot, nout, lerr, ok )
617 CALL ssptrs(
'U', 0, -1, a, ip, b, 1, info )
618 CALL chkxer(
'SSPTRS', infot, nout, lerr, ok )
620 CALL ssptrs(
'U', 2, 1, a, ip, b, 1, info )
621 CALL chkxer(
'SSPTRS', infot, nout, lerr, ok )
627 CALL ssprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
629 CALL chkxer(
'SSPRFS', infot, nout, lerr, ok )
631 CALL ssprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
633 CALL chkxer(
'SSPRFS', infot, nout, lerr, ok )
635 CALL ssprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, iw,
637 CALL chkxer(
'SSPRFS', infot, nout, lerr, ok )
639 CALL ssprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, iw,
641 CALL chkxer(
'SSPRFS', infot, nout, lerr, ok )
643 CALL ssprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, iw,
645 CALL chkxer(
'SSPRFS', infot, nout, lerr, ok )
651 CALL sspcon(
'/', 0, a, ip, anrm, rcond, w, iw, info )
652 CALL chkxer(
'SSPCON', infot, nout, lerr, ok )
654 CALL sspcon(
'U', -1, a, ip, anrm, rcond, w, iw, info )
655 CALL chkxer(
'SSPCON', infot, nout, lerr, ok )
657 CALL sspcon(
'U', 1, a, ip, -1.0, rcond, w, iw, info )
658 CALL chkxer(
'SSPCON', infot, nout, lerr, ok )
663 CALL alaesm( path, ok, nout )