78 REAL R( NMAX ), R1( NMAX ), R2( NMAX )
79 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
80 $ E( NMAX), W( 2*NMAX ), X( NMAX )
100 COMMON / infoc / infot, nout, ok, lerr
101 COMMON / srnamc / srnamt
104 INTRINSIC cmplx, real
109 WRITE( nout, fmt = * )
116 a( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
117 af( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
130 IF( lsamen( 2, c2,
'SY' ) )
THEN
140 CALL csytrf(
'/', 0, a, 1, ip, w, 1, info )
141 CALL chkxer(
'CSYTRF', infot, nout, lerr, ok )
143 CALL csytrf(
'U', -1, a, 1, ip, w, 1, info )
144 CALL chkxer(
'CSYTRF', infot, nout, lerr, ok )
146 CALL csytrf(
'U', 2, a, 1, ip, w, 4, info )
147 CALL chkxer(
'CSYTRF', infot, nout, lerr, ok )
149 CALL csytrf(
'U', 0, a, 1, ip, w, 0, info )
150 CALL chkxer(
'CSYTRF', infot, nout, lerr, ok )
152 CALL csytrf(
'U', 0, a, 1, ip, w, -2, info )
153 CALL chkxer(
'CSYTRF', infot, nout, lerr, ok )
159 CALL csytf2(
'/', 0, a, 1, ip, info )
160 CALL chkxer(
'CSYTF2', infot, nout, lerr, ok )
162 CALL csytf2(
'U', -1, a, 1, ip, info )
163 CALL chkxer(
'CSYTF2', infot, nout, lerr, ok )
165 CALL csytf2(
'U', 2, a, 1, ip, info )
166 CALL chkxer(
'CSYTF2', infot, nout, lerr, ok )
172 CALL csytri(
'/', 0, a, 1, ip, w, info )
173 CALL chkxer(
'CSYTRI', infot, nout, lerr, ok )
175 CALL csytri(
'U', -1, a, 1, ip, w, info )
176 CALL chkxer(
'CSYTRI', infot, nout, lerr, ok )
178 CALL csytri(
'U', 2, a, 1, ip, w, info )
179 CALL chkxer(
'CSYTRI', infot, nout, lerr, ok )
185 CALL csytri2(
'/', 0, a, 1, ip, w, 1, info )
186 CALL chkxer(
'CSYTRI2', infot, nout, lerr, ok )
188 CALL csytri2(
'U', -1, a, 1, ip, w, 1, info )
189 CALL chkxer(
'CSYTRI2', infot, nout, lerr, ok )
191 CALL csytri2(
'U', 2, a, 1, ip, w, 1, info )
192 CALL chkxer(
'CSYTRI2', infot, nout, lerr, ok )
198 CALL csytri2x(
'/', 0, a, 1, ip, w, 1, info )
199 CALL chkxer(
'CSYTRI2X', infot, nout, lerr, ok )
201 CALL csytri2x(
'U', -1, a, 1, ip, w, 1, info )
202 CALL chkxer(
'CSYTRI2X', infot, nout, lerr, ok )
204 CALL csytri2x(
'U', 2, a, 1, ip, w, 1, info )
205 CALL chkxer(
'CSYTRI2X', infot, nout, lerr, ok )
211 CALL csytrs(
'/', 0, 0, a, 1, ip, b, 1, info )
212 CALL chkxer(
'CSYTRS', infot, nout, lerr, ok )
214 CALL csytrs(
'U', -1, 0, a, 1, ip, b, 1, info )
215 CALL chkxer(
'CSYTRS', infot, nout, lerr, ok )
217 CALL csytrs(
'U', 0, -1, a, 1, ip, b, 1, info )
218 CALL chkxer(
'CSYTRS', infot, nout, lerr, ok )
220 CALL csytrs(
'U', 2, 1, a, 1, ip, b, 2, info )
221 CALL chkxer(
'CSYTRS', infot, nout, lerr, ok )
223 CALL csytrs(
'U', 2, 1, a, 2, ip, b, 1, info )
224 CALL chkxer(
'CSYTRS', infot, nout, lerr, ok )
230 CALL csyrfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
232 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
234 CALL csyrfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
236 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
238 CALL csyrfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
240 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
242 CALL csyrfs(
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
244 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
246 CALL csyrfs(
'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
248 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
250 CALL csyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
252 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
254 CALL csyrfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
256 CALL chkxer(
'CSYRFS', infot, nout, lerr, ok )
262 CALL csycon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
263 CALL chkxer(
'CSYCON', infot, nout, lerr, ok )
265 CALL csycon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
266 CALL chkxer(
'CSYCON', infot, nout, lerr, ok )
268 CALL csycon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
269 CALL chkxer(
'CSYCON', infot, nout, lerr, ok )
271 CALL csycon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
272 CALL chkxer(
'CSYCON', infot, nout, lerr, ok )
274 ELSE IF( lsamen( 2, c2,
'SR' ) )
THEN
282 srnamt =
'CSYTRF_ROOK'
285 CALL chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
288 CALL chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
291 CALL chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
294 CALL chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
297 CALL chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
301 srnamt =
'CSYTF2_ROOK'
304 CALL chkxer(
'CSYTF2_ROOK', infot, nout, lerr, ok )
307 CALL chkxer(
'CSYTF2_ROOK', infot, nout, lerr, ok )
310 CALL chkxer(
'CSYTF2_ROOK', infot, nout, lerr, ok )
314 srnamt =
'CSYTRI_ROOK'
317 CALL chkxer(
'CSYTRI_ROOK', infot, nout, lerr, ok )
320 CALL chkxer(
'CSYTRI_ROOK', infot, nout, lerr, ok )
323 CALL chkxer(
'CSYTRI_ROOK', infot, nout, lerr, ok )
327 srnamt =
'CSYTRS_ROOK'
329 CALL csytrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
330 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
332 CALL csytrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
333 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
335 CALL csytrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
336 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
338 CALL csytrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
339 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
341 CALL csytrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
342 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
346 srnamt =
'CSYCON_ROOK'
348 CALL csycon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
349 CALL chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
351 CALL csycon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
352 CALL chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
354 CALL csycon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, info )
355 CALL chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
357 CALL csycon_rook(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
358 CALL chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
360 ELSE IF( lsamen( 2, c2,
'SK' ) )
THEN
374 CALL csytrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
375 CALL chkxer(
'CSYTRF_RK', infot, nout, lerr, ok )
377 CALL csytrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
378 CALL chkxer(
'CSYTRF_RK', infot, nout, lerr, ok )
380 CALL csytrf_rk(
'U', 2, a, 1, e, ip, w, 4, info )
381 CALL chkxer(
'CSYTRF_RK', infot, nout, lerr, ok )
383 CALL csytrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
384 CALL chkxer(
'CSYTRF_RK', infot, nout, lerr, ok )
386 CALL csytrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
387 CALL chkxer(
'CSYTRF_RK', infot, nout, lerr, ok )
393 CALL csytf2_rk(
'/', 0, a, 1, e, ip, info )
394 CALL chkxer(
'CSYTF2_RK', infot, nout, lerr, ok )
396 CALL csytf2_rk(
'U', -1, a, 1, e, ip, info )
397 CALL chkxer(
'CSYTF2_RK', infot, nout, lerr, ok )
399 CALL csytf2_rk(
'U', 2, a, 1, e, ip, info )
400 CALL chkxer(
'CSYTF2_RK', infot, nout, lerr, ok )
406 CALL csytri_3(
'/', 0, a, 1, e, ip, w, 1, info )
407 CALL chkxer(
'CSYTRI_3', infot, nout, lerr, ok )
409 CALL csytri_3(
'U', -1, a, 1, e, ip, w, 1, info )
410 CALL chkxer(
'CSYTRI_3', infot, nout, lerr, ok )
412 CALL csytri_3(
'U', 2, a, 1, e, ip, w, 1, info )
413 CALL chkxer(
'CSYTRI_3', infot, nout, lerr, ok )
415 CALL csytri_3(
'U', 0, a, 1, e, ip, w, 0, info )
416 CALL chkxer(
'CSYTRI_3', infot, nout, lerr, ok )
418 CALL csytri_3(
'U', 0, a, 1, e, ip, w, -2, info )
419 CALL chkxer(
'CSYTRI_3', infot, nout, lerr, ok )
425 CALL csytri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
426 CALL chkxer(
'CSYTRI_3X', infot, nout, lerr, ok )
428 CALL csytri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
429 CALL chkxer(
'CSYTRI_3X', infot, nout, lerr, ok )
431 CALL csytri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
432 CALL chkxer(
'CSYTRI_3X', infot, nout, lerr, ok )
438 CALL csytrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
439 CALL chkxer(
'CSYTRS_3', infot, nout, lerr, ok )
441 CALL csytrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
442 CALL chkxer(
'CSYTRS_3', infot, nout, lerr, ok )
444 CALL csytrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
445 CALL chkxer(
'CSYTRS_3', infot, nout, lerr, ok )
447 CALL csytrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
448 CALL chkxer(
'CSYTRS_3', infot, nout, lerr, ok )
450 CALL csytrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
451 CALL chkxer(
'CSYTRS_3', infot, nout, lerr, ok )
457 CALL csycon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, info )
458 CALL chkxer(
'CSYCON_3', infot, nout, lerr, ok )
460 CALL csycon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, info )
461 CALL chkxer(
'CSYCON_3', infot, nout, lerr, ok )
463 CALL csycon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, info )
464 CALL chkxer(
'CSYCON_3', infot, nout, lerr, ok )
466 CALL csycon_3(
'U', 1, a, 1, e, ip, -1.0e0, rcond, w, info)
467 CALL chkxer(
'CSYCON_3', infot, nout, lerr, ok )
469 ELSE IF( lsamen( 2, c2,
'SP' ) )
THEN
479 CALL csptrf(
'/', 0, a, ip, info )
480 CALL chkxer(
'CSPTRF', infot, nout, lerr, ok )
482 CALL csptrf(
'U', -1, a, ip, info )
483 CALL chkxer(
'CSPTRF', infot, nout, lerr, ok )
489 CALL csptri(
'/', 0, a, ip, w, info )
490 CALL chkxer(
'CSPTRI', infot, nout, lerr, ok )
492 CALL csptri(
'U', -1, a, ip, w, info )
493 CALL chkxer(
'CSPTRI', infot, nout, lerr, ok )
499 CALL csptrs(
'/', 0, 0, a, ip, b, 1, info )
500 CALL chkxer(
'CSPTRS', infot, nout, lerr, ok )
502 CALL csptrs(
'U', -1, 0, a, ip, b, 1, info )
503 CALL chkxer(
'CSPTRS', infot, nout, lerr, ok )
505 CALL csptrs(
'U', 0, -1, a, ip, b, 1, info )
506 CALL chkxer(
'CSPTRS', infot, nout, lerr, ok )
508 CALL csptrs(
'U', 2, 1, a, ip, b, 1, info )
509 CALL chkxer(
'CSPTRS', infot, nout, lerr, ok )
515 CALL csprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
517 CALL chkxer(
'CSPRFS', infot, nout, lerr, ok )
519 CALL csprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
521 CALL chkxer(
'CSPRFS', infot, nout, lerr, ok )
523 CALL csprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
525 CALL chkxer(
'CSPRFS', infot, nout, lerr, ok )
527 CALL csprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
529 CALL chkxer(
'CSPRFS', infot, nout, lerr, ok )
531 CALL csprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
533 CALL chkxer(
'CSPRFS', infot, nout, lerr, ok )
539 CALL cspcon(
'/', 0, a, ip, anrm, rcond, w, info )
540 CALL chkxer(
'CSPCON', infot, nout, lerr, ok )
542 CALL cspcon(
'U', -1, a, ip, anrm, rcond, w, info )
543 CALL chkxer(
'CSPCON', infot, nout, lerr, ok )
545 CALL cspcon(
'U', 1, a, ip, -anrm, rcond, w, info )
546 CALL chkxer(
'CSPCON', infot, nout, lerr, ok )
548 ELSE IF( lsamen( 2, c2,
'SA' ) )
THEN
557 CALL csytrf_aa(
'/', 0, a, 1, ip, w, 1, info )
558 CALL chkxer(
'CSYTRF_AA', infot, nout, lerr, ok )
560 CALL csytrf_aa(
'U', -1, a, 1, ip, w, 1, info )
561 CALL chkxer(
'CSYTRF_AA', infot, nout, lerr, ok )
563 CALL csytrf_aa(
'U', 2, a, 1, ip, w, 4, info )
564 CALL chkxer(
'CSYTRF_AA', infot, nout, lerr, ok )
566 CALL csytrf_aa(
'U', 0, a, 1, ip, w, 0, info )
567 CALL chkxer(
'CSYTRF_AA', infot, nout, lerr, ok )
569 CALL csytrf_aa(
'U', 0, a, 1, ip, w, -2, info )
570 CALL chkxer(
'CSYTRF_AA', infot, nout, lerr, ok )
576 CALL csytrs_aa(
'/', 0, 0, a, 1, ip, b, 1, w, 1, info )
577 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
579 CALL csytrs_aa(
'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
580 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
582 CALL csytrs_aa(
'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
583 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
585 CALL csytrs_aa(
'U', 2, 1, a, 1, ip, b, 2, w, 1, info )
586 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
588 CALL csytrs_aa(
'U', 2, 1, a, 2, ip, b, 1, w, 1, info )
589 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
591 CALL csytrs_aa(
'U', 0, 1, a, 1, ip, b, 1, w, 0, info )
592 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
594 CALL csytrs_aa(
'U', 0, 1, a, 1, ip, b, 1, w, -2, info )
595 CALL chkxer(
'CSYTRS_AA', infot, nout, lerr, ok )
597 ELSE IF( lsamen( 2, c2,
'S2' ) )
THEN
604 srnamt =
'CSYTRF_AA_2STAGE'
606 CALL csytrf_aa_2stage(
'/', 0, a, 1, a, 1, ip, ip, w, 1,
608 CALL chkxer(
'CSYTRF_AA_2STAGE', infot, nout, lerr, ok )
610 CALL csytrf_aa_2stage(
'U', -1, a, 1, a, 1, ip, ip, w, 1,
612 CALL chkxer(
'CSYTRF_AA_2STAGE', infot, nout, lerr, ok )
614 CALL csytrf_aa_2stage(
'U', 2, a, 1, a, 2, ip, ip, w, 1,
616 CALL chkxer(
'CSYTRF_AA_2STAGE', infot, nout, lerr, ok )
618 CALL csytrf_aa_2stage(
'U', 2, a, 2, a, 1, ip, ip, w, 1,
620 CALL chkxer(
'CSYTRF_AA_2STAGE', infot, nout, lerr, ok )
622 CALL csytrf_aa_2stage(
'U', 2, a, 2, a, 8, ip, ip, w, 0,
624 CALL chkxer(
'CSYTRF_AA_2STAGE', infot, nout, lerr, ok )
628 srnamt =
'CSYTRS_AA_2STAGE'
632 CALL chkxer(
'CSYTRS_AA_2STAGE', infot, nout, lerr, ok )
636 CALL chkxer(
'CSYTRS_AA_2STAGE', infot, nout, lerr, ok )
640 CALL chkxer(
'CSYTRS_AA_2STAGE', infot, nout, lerr, ok )
644 CALL chkxer(
'CSYTRS_AA_2STAGE', infot, nout, lerr, ok )
648 CALL chkxer(
'CSYTRS_AA_2STAGE', infot, nout, lerr, ok )
652 CALL chkxer(
'CSYTRS_AA_STAGE', infot, nout, lerr, ok )
658 CALL alaesm( path, ok, nout )