79 REAL R( NMAX ), R1( NMAX ), R2( )
80 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
103 COMMON / infoc / infot, nout, ok, lerr
104 COMMON / srnamc / srnamt
107 INTRINSIC cmplx, real
112 WRITE( nout, fmt = * )
119 a( i, j ) =
cmplx( 1. / real( i+j ), -1. / real( i+j ) )
120 af( i, j ) =
cmplx( 1. / real( i+j ), -1. / real( i+j ) )
133 IF( lsamen( 2, c2,
'HE' ) )
THEN
143 CALL chetrf(
'/', 0, a, 1, ip, w, 1, info )
146 CALL CHETRF( 'u
', -1, A, 1, IP, W, 1, INFO )
147 CALL CHKXER( 'chetrf', INFOT, NOUT, LERR, OK )
149 CALL CHETRF( 'u
', 2, A, 1, IP, W, 4, INFO )
150 CALL CHKXER( 'chetrf', INFOT, NOUT, LERR, OK )
152 CALL CHETRF( 'u
', 0, A, 1, IP, W, 0, INFO )
153 CALL CHKXER( 'chetrf', INFOT, NOUT, LERR, OK )
155 CALL CHETRF( 'u
', 0, A, 1, IP, W, -2, INFO )
156 CALL CHKXER( 'chetrf', INFOT, NOUT, LERR, OK )
162 CALL CHETF2( '/
', 0, A, 1, IP, INFO )
163 CALL CHKXER( 'chetf2', INFOT, NOUT, LERR, OK )
165 CALL CHETF2( 'u
', -1, A, 1, IP, INFO )
166 CALL CHKXER( 'chetf2', INFOT, NOUT, LERR, OK )
168 CALL CHETF2( 'u
', 2, A, 1, IP, INFO )
169 CALL CHKXER( 'chetf2', INFOT, NOUT, LERR, OK )
175 CALL CHETRI( '/
', 0, A, 1, IP, W, INFO )
176 CALL CHKXER( 'chetri', INFOT, NOUT, LERR, OK )
178 CALL CHETRI( 'u
', -1, A, 1, IP, W, INFO )
179 CALL CHKXER( 'chetri', INFOT, NOUT, LERR, OK )
181 CALL CHETRI( 'u
', 2, A, 1, IP, W, INFO )
182 CALL CHKXER( 'chetri', INFOT, NOUT, LERR, OK )
188 CALL CHETRI2( '/
', 0, A, 1, IP, W, 1, INFO )
189 CALL CHKXER( 'chetri2', INFOT, NOUT, LERR, OK )
191 CALL CHETRI2( 'u
', -1, A, 1, IP, W, 1, INFO )
192 CALL CHKXER( 'chetri2', INFOT, NOUT, LERR, OK )
194 CALL CHETRI2( 'u
', 2, A, 1, IP, W, 1, INFO )
195 CALL CHKXER( 'chetri2', INFOT, NOUT, LERR, OK )
201 CALL CHETRI2X( '/
', 0, A, 1, IP, W, 1, INFO )
202 CALL CHKXER( 'chetri2x', INFOT, NOUT, LERR, OK )
204 CALL CHETRI2X( 'u
', -1, A, 1, IP, W, 1, INFO )
205 CALL CHKXER( 'chetri2x', INFOT, NOUT, LERR, OK )
207 CALL CHETRI2X( 'u
', 2, A, 1, IP, W, 1, INFO )
208 CALL CHKXER( 'chetri2x', INFOT, NOUT, LERR, OK )
214 CALL CHETRS( '/
', 0, 0, A, 1, IP, B, 1, INFO )
215 CALL CHKXER( 'chetrs', INFOT, NOUT, LERR, OK )
217 CALL CHETRS( 'u
', -1, 0, A, 1, IP, B, 1, INFO )
218 CALL CHKXER( 'chetrs', INFOT, NOUT, LERR, OK )
220 CALL CHETRS( 'u
', 0, -1, A, 1, IP, B, 1, INFO )
221 CALL CHKXER( 'chetrs', INFOT, NOUT, LERR, OK )
223 CALL CHETRS( 'u
', 2, 1, A, 1, IP, B, 2, INFO )
224 CALL CHKXER( 'chetrs', INFOT, NOUT, LERR, OK )
226 CALL CHETRS( 'u
', 2, 1, A, 2, IP, B, 1, INFO )
227 CALL CHKXER( 'chetrs', INFOT, NOUT, LERR, OK )
233 CALL CHERFS( '/
', 0, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
235 CALL CHKXER( 'cherfs', INFOT, NOUT, LERR, OK )
237 CALL CHERFS( 'u
', -1, 0, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
239 CALL CHKXER( 'cherfs', INFOT, NOUT, LERR, OK )
241 CALL CHERFS( 'u
', 0, -1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
243 CALL CHKXER( 'cherfs', INFOT, NOUT, LERR, OK )
245 CALL CHERFS( 'u
', 2, 1, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
247 CALL CHKXER( 'cherfs', INFOT, NOUT, LERR, OK )
249 CALL CHERFS( 'u
', 2, 1, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
251 CALL CHKXER( 'cherfs', INFOT, NOUT, LERR, OK )
253 CALL CHERFS( 'u
', 2, 1, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
255 CALL CHKXER( 'cherfs', INFOT, NOUT, LERR, OK )
257 CALL CHERFS( 'u
', 2, 1, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
259 CALL CHKXER( 'cherfs', INFOT, NOUT, LERR, OK )
265 CALL checon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
266 CALL chkxer(
'CHECON', infot, nout, lerr, ok )
268 CALL checon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
269 CALL chkxer(
'CHECON', infot, nout, lerr, ok )
271 CALL checon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
272 CALL chkxer(
'CHECON', infot, nout, lerr, ok )
274 CALL checon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
275 CALL chkxer(
'CHECON', infot, nout, lerr, ok )
277 ELSE IF( lsamen( 2, c2,
'HR' ) )
THEN
285 srnamt =
'CHETRF_ROOK'
288 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
291 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
294 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
297 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
300 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
304 srnamt =
'CHETF2_ROOK'
309 CALL CHETF2_ROOK( 'u
', -1, A, 1, IP, INFO )
310 CALL CHKXER( 'chetf2_rook', INFOT, NOUT, LERR, OK )
312 CALL CHETF2_ROOK( 'u
', 2, A, 1, IP, INFO )
313 CALL CHKXER( 'chetf2_rook', INFOT, NOUT, LERR, OK )
319 CALL CHETRI_ROOK( '/
', 0, A, 1, IP, W, INFO )
320 CALL CHKXER( 'chetri_rook', INFOT, NOUT, LERR, OK )
322 CALL CHETRI_ROOK( 'u
', -1, A, 1, IP, W, INFO )
323 CALL CHKXER( 'chetri_rook', INFOT, NOUT, LERR, OK )
325 CALL CHETRI_ROOK( 'u
', 2, A, 1, IP, W, INFO )
326 CALL CHKXER( 'chetri_rook', INFOT, NOUT, LERR, OK )
332 CALL CHETRS_ROOK( '/
', 0, 0, A, 1, IP, B, 1, INFO )
333 CALL CHKXER( 'chetrs_rook', INFOT, NOUT, LERR, OK )
335 CALL CHETRS_ROOK( 'u
', -1, 0, A, 1, IP, B, 1, INFO )
336 CALL CHKXER( 'chetrs_rook', INFOT, NOUT, LERR, OK )
338 CALL CHETRS_ROOK( 'u
', 0, -1, A, 1, IP, B, 1, INFO )
339 CALL CHKXER( 'chetrs_rook', INFOT, NOUT, LERR, OK )
341 CALL CHETRS_ROOK( 'u
', 2, 1, A, 1, IP, B, 2, INFO )
342 CALL CHKXER( 'chetrs_rook', INFOT, NOUT, LERR, OK )
344 CALL CHETRS_ROOK( 'u
', 2, 1, A, 2, IP, B, 1, INFO )
345 CALL CHKXER( 'chetrs_rook', INFOT, NOUT, LERR, OK )
351 CALL checon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
352 CALL chkxer(
'CHECON_ROOK', infot, nout, lerr, ok
354 CALL checon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
355 CALL chkxer(
'CHECON_ROOK', infot, nout, lerr, ok )
357 CALL checon_rook( 'u
', 2, A, 1, IP, ANRM, RCOND, W, INFO )
358 CALL CHKXER( 'checon_rook', INFOT, NOUT, LERR, OK )
360 CALL CHECON_ROOK( 'u
', 1, A, 1, IP, -ANRM, RCOND, W, INFO )
361 CALL CHKXER( 'checon_rook', INFOT, NOUT, LERR, OK )
363 ELSE IF( LSAMEN( 2, C2, 'hk
' ) ) THEN
377 CALL CHETRF_RK( '/
', 0, A, 1, E, IP, W, 1, INFO )
378 CALL CHKXER( 'chetrf_rk', INFOT, NOUT, LERR, OK )
380 CALL CHETRF_RK( 'u
', -1, A, 1, E, IP, W, 1, INFO )
381 CALL CHKXER( 'chetrf_rk', INFOT, NOUT, LERR, OK )
383 CALL CHETRF_RK( 'u
', 2, A, 1, E, IP, W, 4, INFO )
384 CALL CHKXER( 'chetrf_rk', INFOT, NOUT, LERR, OK )
386 CALL CHETRF_RK( 'u
', 0, A, 1, E, IP, W, 0, INFO )
387 CALL CHKXER( 'chetrf_rk', INFOT, NOUT, LERR, OK )
389 CALL CHETRF_RK( 'u
', 0, A, 1, E, IP, W, -2, INFO )
390 CALL CHKXER( 'chetrf_rk', INFOT, NOUT, LERR, OK )
396 CALL CHETF2_RK( '/
', 0, A, 1, E, IP, INFO )
397 CALL CHKXER( 'chetf2_rk', INFOT, NOUT, LERR, OK )
399 CALL CHETF2_RK( 'u
', -1, A, 1, E, IP, INFO )
400 CALL CHKXER( 'chetf2_rk', INFOT, NOUT, LERR, OK )
402 CALL CHETF2_RK( 'u
', 2, A, 1, E, IP, INFO )
403 CALL CHKXER( 'chetf2_rk', INFOT, NOUT, LERR, OK )
409 CALL CHETRI_3( '/
', 0, A, 1, E, IP, W, 1, INFO )
410 CALL CHKXER( 'chetri_3', INFOT, NOUT, LERR, OK )
412 CALL CHETRI_3( 'u
', -1, A, 1, E, IP, W, 1, INFO )
413 CALL CHKXER( 'chetri_3', INFOT, NOUT, LERR, OK )
415 CALL CHETRI_3( 'u
', 2, A, 1, E, IP, W, 1, INFO )
416 CALL CHKXER( 'chetri_3', INFOT, NOUT, LERR, OK )
418 CALL CHETRI_3( 'u
', 0, A, 1, E, IP, W, 0, INFO )
419 CALL CHKXER( 'chetri_3', INFOT, NOUT, LERR, OK )
421 CALL CHETRI_3( 'u
', 0, A, 1, E, IP, W, -2, INFO )
422 CALL CHKXER( 'chetri_3', INFOT, NOUT, LERR, OK )
428 CALL CHETRI_3X( '/
', 0, A, 1, E, IP, W, 1, INFO )
429 CALL CHKXER( 'chetri_3x', INFOT, NOUT, LERR, OK )
431 CALL CHETRI_3X( 'u
', -1, A, 1, E, IP, W, 1, INFO )
432 CALL CHKXER( 'chetri_3x', INFOT, NOUT, LERR, OK )
434 CALL CHETRI_3X( 'u
', 2, A, 1, E, IP, W, 1, INFO )
435 CALL CHKXER( 'chetri_3x', INFOT, NOUT, LERR, OK )
441 CALL chetrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
442 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
444 CALL chetrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
445 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
447 CALL chetrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
448 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
450 CALL chetrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
451 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
453 CALL chetrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
454 CALL chkxer(
'CHETRS_3', infot,
460 CALL checon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, info )
461 CALL chkxer(
'CHECON_3', infot, nout, lerr, ok )
463 CALL checon_3( 'u
', -1, A, 1, E, IP, ANRM, RCOND, W, INFO )
464 CALL CHKXER( 'checon_3', INFOT, NOUT, LERR, OK )
466 CALL CHECON_3( 'u
', 2, A, 1, E, IP, ANRM, RCOND, W, INFO )
467 CALL CHKXER( 'checon_3', INFOT, NOUT, LERR, OK )
469 CALL CHECON_3( 'u
', 1, A, 1, E, IP, -1.0E0, RCOND, W, INFO)
470 CALL CHKXER( 'checon_3', INFOT, NOUT, LERR, OK )
472 ELSE IF( LSAMEN( 2, C2, 'ha
' ) ) THEN
481 CALL CHETRF_AA( '/', 0, a, 1, ip, w, 1, info )
482 CALL chkxer(
'CHETRF_AA', infot, nout, lerr, ok )
484 CALL chetrf_aa(
'U', -1, a, 1, ip, w, 1, info )
485 CALL chkxer(
'CHETRF_AA', infot, nout, lerr, ok )
487 CALL chetrf_aa(
'U', 2, a, 1, ip, w, 4, info )
488 CALL chkxer(
'CHETRF_AA', infot, nout, lerr, ok )
490 CALL chetrf_aa(
'U', 2, a, 2, ip, w, 0, info )
491 CALL chkxer(
'CHETRF_AA', infot, nout, lerr, ok )
493 CALL chetrf_aa(
'U', 2, a, 2, ip, w, -2, info )
494 CALL chkxer(
'CHETRF_AA', infot, nout, lerr, ok )
500 CALL chetrs_aa(
'/', 0, 0, a, 1, ip, b, 1, w, 1, info )
501 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
503 CALL chetrs_aa(
'U', -1, 0, a, 1, ip, b, 1
504 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
506 CALL chetrs_aa(
'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
507 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
510 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
512 CALL chetrs_aa(
'U', 2, 1, a, 2, ip, b, 1, w, 1, info )
513 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
515 CALL chetrs_aa(
'U', 2, 1, a, 2, ip, b, 2, w, 0, info )
516 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
518 CALL chetrs_aa(
'U', 2, 1, a, 2, ip, b, 2, w, -2, info )
519 CALL chkxer(
'CHETRS_AA', infot, nout, lerr, ok )
521 ELSE IF( lsamen( 2, c2,
'H2' ) )
THEN
528 srnamt =
'CHETRF_AA_2STAGE'
530 CALL chetrf_aa_2stage(
'/', 0, a, 1, a, 1, ip, ip, w, 1,
532 CALL chkxer(
'CHETRF_AA_2STAGE', infot, nout, lerr, ok )
534 CALL chetrf_aa_2stage(
'U', -1, a, 1, a, 1, ip, ip, w, 1,
536 CALL chkxer(
'CHETRF_AA_2STAGE', infot, nout, lerr, ok )
538 CALL chetrf_aa_2stage(
'U', 2, a, 1, a, 2, ip, ip, w, 1,
540 CALL chkxer(
'CHETRF_AA_2STAGE', infot, nout, lerr, ok )
542 CALL chetrf_aa_2stage(
'U', 2, a, 2, a, 1, ip, ip, w, 1,
544 CALL chkxer(
'CHETRF_AA_2STAGE', infot, nout, lerr, ok )
546 CALL chetrf_aa_2stage(
'U', 2, a, 2, a, 8, ip, ip, w, 0,
548 CALL chkxer(
'CHETRF_AA_2STAGE', infot, nout, lerr, ok )
552 srnamt =
'CHETRS_AA_2STAGE'
556 CALL chkxer(
'CHETRS_AA_2STAGE', infot, nout, lerr, ok )
562 CALL CHETRS_AA_2STAGE( 'u
', 0, -1, A, 1, A, 1, IP, IP,
566 CALL CHETRS_AA_2STAGE( 'u
', 2, 1, A, 1, A, 1, IP, IP,
570 CALL CHETRS_AA_2STAGE( 'u
', 2, 1, A, 2, A, 1, IP, IP,
574 CALL CHETRS_AA_2STAGE( 'u
', 2, 1, A, 2, A, 8, IP, IP,
576 CALL CHKXER( 'chetrs_aa_stage
', INFOT, NOUT, LERR, OK )
582 ELSE IF( LSAMEN( 2, C2, 'hp
' ) ) THEN
588 CALL CHPTRF( '/
', 0, A, IP, INFO )
589 CALL CHKXER( 'chptrf', INFOT, NOUT, LERR, OK )
591 CALL CHPTRF( 'u
', -1, A, IP, INFO )
592 CALL CHKXER( 'chptrf', INFOT, NOUT, LERR, OK )
598 CALL CHPTRI( '/
', 0, A, IP, W, INFO )
599 CALL CHKXER( 'chptri', INFOT, NOUT, LERR, OK )
601 CALL CHPTRI( 'u
', -1, A, IP, W, INFO )
602 CALL CHKXER( 'chptri', INFOT, NOUT, LERR, OK )
608 CALL CHPTRS( '/
', 0, 0, A, IP, B, 1, INFO )
609 CALL CHKXER( 'chptrs', INFOT, NOUT, LERR, OK )
611 CALL CHPTRS( 'u
', -1, 0, A, IP, B, 1, INFO )
612 CALL CHKXER( 'chptrs', INFOT, NOUT, LERR, OK )
614 CALL CHPTRS( 'u
', 0, -1, A, IP, B, 1, INFO )
615 CALL CHKXER( 'chptrs', INFOT, NOUT, LERR, OK )
617 CALL CHPTRS( 'u
', 2, 1, A, IP, B, 1, INFO )
618 CALL CHKXER( 'chptrs', INFOT, NOUT, LERR, OK )
624 CALL CHPRFS( '/
', 0, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
626 CALL CHKXER( 'chprfs', INFOT, NOUT, LERR, OK )
628 CALL CHPRFS( 'u
', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
630 CALL CHKXER( 'chprfs', INFOT, NOUT, LERR, OK )
632 CALL CHPRFS( 'u
', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
634 CALL CHKXER( 'chprfs', INFOT, NOUT, LERR, OK )
636 CALL CHPRFS( 'u
', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R,
638 CALL CHKXER( 'chprfs', INFOT, NOUT, LERR, OK )
640 CALL CHPRFS( 'u
', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R,
642 CALL CHKXER( 'chprfs', INFOT, NOUT, LERR, OK )
648 CALL CHPCON( '/
', 0, A, IP, ANRM, RCOND, W, INFO )
649 CALL CHKXER( 'chpcon', INFOT, NOUT, LERR, OK )
651 CALL CHPCON( 'u
', -1, A, IP, ANRM, RCOND, W, INFO )
652 CALL CHKXER( 'chpcon', INFOT, NOUT, LERR, OK )
654 CALL CHPCON( 'u
', 1, A, IP, -ANRM, RCOND, W, INFO )
655 CALL CHKXER( 'chpcon', INFOT, NOUT, LERR, OK )
660 CALL ALAESM( PATH, OK, NOUT )