75 DOUBLE PRECISION ANRM, RCOND
79 DOUBLE PRECISION R( NMAX ), R1( NMAX ), R2( NMAX )
80 COMPLEX*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
81 $ E( NMAX ), W( 2*NMAX ), X( NMAX )
103 COMMON / infoc / infot, nout, ok, lerr
104 COMMON / srnamc / srnamt
107 INTRINSIC dble, dcmplx
112 WRITE( nout, fmt = * )
119 a( i, j ) = dcmplx( 1.d0 / dble( i+j ),
120 $ -1.d0 / dble( i+j ) )
121 af( i, j ) = dcmplx( 1.d0 / dble( i+j ),
122 $ -1.d0 / dble( i+j ) )
135 IF( lsamen( 2, c2,
'HE' ) )
THEN
145 CALL zhetrf(
'/', 0, a, 1, ip, w, 1, info )
146 CALL chkxer(
'ZHETRF', infot, nout, lerr, ok )
148 CALL zhetrf(
'U', -1, a, 1, ip, w, 1, info )
149 CALL chkxer(
'ZHETRF', infot, nout, lerr, ok )
151 CALL zhetrf(
'U', 2, a, 1, ip, w, 4, info )
152 CALL chkxer(
'ZHETRF', infot, nout, lerr, ok )
154 CALL zhetrf(
'U', 0, a, 1, ip, w, 0, info )
155 CALL chkxer(
'ZHETRF', infot, nout, lerr, ok )
157 CALL zhetrf(
'U', 0, a, 1, ip, w, -2, info )
158 CALL chkxer(
'ZHETRF', infot, nout, lerr, ok )
164 CALL zhetf2(
'/', 0, a, 1, ip, info )
165 CALL chkxer(
'ZHETF2', infot, nout, lerr, ok )
167 CALL zhetf2(
'U', -1, a, 1, ip, info )
168 CALL chkxer(
'ZHETF2', infot, nout, lerr, ok )
170 CALL zhetf2(
'U', 2, a, 1, ip, info )
171 CALL chkxer(
'ZHETF2', infot, nout, lerr, ok )
177 CALL zhetri(
'/', 0, a, 1, ip, w, info )
178 CALL chkxer(
'ZHETRI', infot, nout, lerr, ok )
180 CALL zhetri(
'U', -1, a, 1, ip, w, info )
181 CALL chkxer(
'ZHETRI', infot, nout, lerr, ok )
183 CALL zhetri(
'U', 2, a, 1, ip, w, info )
184 CALL chkxer(
'ZHETRI', infot, nout, lerr, ok )
190 CALL zhetri2(
'/', 0, a, 1, ip, w, 1, info )
191 CALL chkxer(
'ZHETRI2', infot, nout, lerr, ok )
193 CALL zhetri2(
'U', -1, a, 1, ip, w, 1, info )
194 CALL chkxer(
'ZHETRI2', infot, nout, lerr, ok )
196 CALL zhetri2(
'U', 2, a, 1, ip, w, 1, info )
197 CALL chkxer(
'ZHETRI2', infot, nout, lerr, ok )
203 CALL zhetri2x(
'/', 0, a, 1, ip, w, 1, info )
204 CALL chkxer(
'ZHETRI2X', infot, nout, lerr, ok )
206 CALL zhetri2x(
'U', -1, a, 1, ip, w, 1, info )
207 CALL chkxer(
'ZHETRI2X', infot, nout, lerr, ok )
209 CALL zhetri2x(
'U', 2, a, 1, ip, w, 1, info )
210 CALL chkxer(
'ZHETRI2X', infot, nout, lerr, ok )
216 CALL zhetrs(
'/', 0, 0, a, 1, ip, b, 1, info )
217 CALL chkxer(
'ZHETRS', infot, nout, lerr, ok )
219 CALL zhetrs(
'U', -1, 0, a, 1, ip, b, 1, info )
220 CALL chkxer(
'ZHETRS', infot, nout, lerr, ok )
222 CALL zhetrs(
'U', 0, -1, a, 1, ip, b, 1, info )
223 CALL chkxer(
'ZHETRS', infot, nout, lerr, ok )
225 CALL zhetrs(
'U', 2, 1, a, 1, ip, b, 2, info )
226 CALL chkxer(
'ZHETRS', infot, nout, lerr, ok )
228 CALL zhetrs(
'U', 2, 1, a, 2, ip, b, 1, info )
229 CALL chkxer(
'ZHETRS', infot, nout, lerr, ok )
235 CALL zherfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
237 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
239 CALL zherfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
241 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
243 CALL zherfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
245 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
247 CALL zherfs(
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
249 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
251 CALL zherfs(
'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
253 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
255 CALL zherfs(
'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
257 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
259 CALL zherfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
261 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
267 CALL zhecon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
268 CALL chkxer(
'ZHECON', infot, nout, lerr, ok )
270 CALL zhecon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
271 CALL chkxer(
'ZHECON', infot, nout, lerr, ok )
273 CALL zhecon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
274 CALL chkxer(
'ZHECON', infot, nout, lerr, ok )
276 CALL zhecon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
277 CALL chkxer(
'ZHECON', infot, nout, lerr, ok )
279 ELSE IF( lsamen( 2, c2,
'HR' ) )
THEN
287 srnamt =
'ZHETRF_ROOK'
290 CALL chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
293 CALL chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
296 CALL chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
299 CALL chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
302 CALL chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
306 srnamt =
'ZHETF2_ROOK'
309 CALL chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
312 CALL chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
315 CALL chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
319 srnamt =
'ZHETRI_ROOK'
322 CALL chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
325 CALL chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
328 CALL chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
332 srnamt =
'ZHETRS_ROOK'
334 CALL zhetrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
335 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
337 CALL zhetrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
338 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
340 CALL zhetrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
341 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
343 CALL zhetrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
344 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
346 CALL zhetrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
347 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
351 srnamt =
'ZHECON_ROOK'
353 CALL zhecon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
354 CALL chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
356 CALL zhecon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
357 CALL chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
359 CALL zhecon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, info )
360 CALL chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
362 CALL zhecon_rook(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
363 CALL chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
365 ELSE IF( lsamen( 2, c2,
'HK' ) )
THEN
379 CALL zhetrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
380 CALL chkxer(
'ZHETRF_RK', infot, nout, lerr, ok )
382 CALL zhetrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
383 CALL chkxer(
'ZHETRF_RK', infot, nout, lerr, ok )
385 CALL zhetrf_rk(
'U', 2, a, 1, e, ip, w, 4, info )
386 CALL chkxer(
'ZHETRF_RK', infot, nout, lerr, ok )
388 CALL zhetrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
389 CALL chkxer(
'ZHETRF_RK', infot, nout, lerr, ok )
391 CALL zhetrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
392 CALL chkxer(
'ZHETRF_RK', infot, nout, lerr, ok )
398 CALL zhetf2_rk(
'/', 0, a, 1, e, ip, info )
399 CALL chkxer(
'ZHETF2_RK', infot, nout, lerr, ok )
401 CALL zhetf2_rk(
'U', -1, a, 1, e, ip, info )
402 CALL chkxer(
'ZHETF2_RK', infot, nout, lerr, ok )
404 CALL zhetf2_rk(
'U', 2, a, 1, e, ip, info )
405 CALL chkxer(
'ZHETF2_RK', infot, nout, lerr, ok )
411 CALL zhetri_3(
'/', 0, a, 1, e, ip, w, 1, info )
412 CALL chkxer(
'ZHETRI_3', infot, nout, lerr, ok )
414 CALL zhetri_3(
'U', -1, a, 1, e, ip, w, 1, info )
415 CALL chkxer(
'ZHETRI_3', infot, nout, lerr, ok )
417 CALL zhetri_3(
'U', 2, a, 1, e, ip, w, 1, info )
418 CALL chkxer(
'ZHETRI_3', infot, nout, lerr, ok )
420 CALL zhetri_3(
'U', 0, a, 1, e, ip, w, 0, info )
421 CALL chkxer(
'ZHETRI_3', infot, nout, lerr, ok )
423 CALL zhetri_3(
'U', 0, a, 1, e, ip, w, -2, info )
424 CALL chkxer(
'ZHETRI_3', infot, nout, lerr, ok )
430 CALL zhetri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
431 CALL chkxer(
'ZHETRI_3X', infot, nout, lerr, ok )
433 CALL zhetri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
434 CALL chkxer(
'ZHETRI_3X', infot, nout, lerr, ok )
436 CALL zhetri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
437 CALL chkxer(
'ZHETRI_3X', infot, nout, lerr, ok )
443 CALL zhetrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
444 CALL chkxer(
'ZHETRS_3', infot, nout, lerr, ok )
446 CALL zhetrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
447 CALL chkxer(
'ZHETRS_3', infot, nout, lerr, ok )
449 CALL zhetrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
450 CALL chkxer(
'ZHETRS_3', infot, nout, lerr, ok )
452 CALL zhetrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
453 CALL chkxer(
'ZHETRS_3', infot, nout, lerr, ok )
455 CALL zhetrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
456 CALL chkxer(
'ZHETRS_3', infot, nout, lerr, ok )
462 CALL zhecon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, info )
463 CALL chkxer(
'ZHECON_3', infot, nout, lerr, ok )
465 CALL zhecon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, info )
466 CALL chkxer(
'ZHECON_3', infot, nout, lerr, ok )
468 CALL zhecon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, info )
469 CALL chkxer(
'ZHECON_3', infot, nout, lerr, ok )
471 CALL zhecon_3(
'U', 1, a, 1, e, ip, -1.0d0, rcond, w, info)
472 CALL chkxer(
'ZHECON_3', infot, nout, lerr, ok )
477 ELSE IF( lsamen( 2, c2,
'HA' ) )
THEN
483 CALL zhetrf_aa(
'/', 0, a, 1, ip, w, 1, info )
484 CALL chkxer(
'ZHETRF_AA', infot, nout, lerr, ok )
486 CALL zhetrf_aa(
'U', -1, a, 1, ip, w, 1, info )
487 CALL chkxer(
'ZHETRF_AA', infot, nout, lerr, ok )
489 CALL zhetrf_aa(
'U', 2, a, 1, ip, w, 4, info )
490 CALL chkxer(
'ZHETRF_AA', infot, nout, lerr, ok )
492 CALL zhetrf_aa(
'U', 0, a, 1, ip, w, 0, info )
493 CALL chkxer(
'ZHETRF_AA', infot, nout, lerr, ok )
495 CALL zhetrf_aa(
'U', 0, a, 1, ip, w, -2, info )
496 CALL chkxer(
'ZHETRF_AA', infot, nout, lerr, ok )
502 CALL zhetrs_aa(
'/', 0, 0, a, 1, ip, b, 1, w, 1, info )
503 CALL chkxer(
'ZHETRS_AA', infot, nout, lerr, ok )
505 CALL zhetrs_aa(
'U', -1, 0, a, 1, ip, b, 1, w, 1, info )
506 CALL chkxer(
'ZHETRS_AA', infot, nout, lerr, ok )
508 CALL zhetrs_aa(
'U', 0, -1, a, 1, ip, b, 1, w, 1, info )
509 CALL chkxer(
'ZHETRS_AA', infot, nout, lerr, ok )
511 CALL zhetrs_aa(
'U', 2, 1, a, 1, ip, b, 2, w, 1, info )
512 CALL chkxer(
'ZHETRS_AA', infot, nout, lerr, ok )
514 CALL zhetrs_aa(
'U', 2, 1, a, 2, ip, b, 1, w, 1, info )
515 CALL chkxer(
'ZHETRS_AA', infot, nout, lerr, ok )
517 CALL zhetrs_aa(
'U', 0, 1, a, 1, ip, b, 1, w, 0, info )
518 CALL chkxer(
'ZHETRS_AA', infot, nout, lerr, ok )
520 CALL zhetrs_aa(
'U', 0, 1, a, 1, ip, b, 1, w, -2, info )
521 CALL chkxer(
'ZHETRS_AA', infot, nout, lerr, ok )
523 ELSE IF( lsamen( 2, c2,
'S2' ) )
THEN
530 srnamt =
'ZHETRF_AA_2STAGE'
532 CALL zhetrf_aa_2stage(
'/', 0, a, 1, a, 1, ip, ip, w, 1,
534 CALL chkxer(
'ZHETRF_AA_2STAGE', infot, nout, lerr, ok )
536 CALL zhetrf_aa_2stage(
'U', -1, a, 1, a, 1, ip, ip, w, 1,
538 CALL chkxer(
'ZHETRF_AA_2STAGE', infot, nout, lerr, ok )
540 CALL zhetrf_aa_2stage(
'U', 2, a, 1, a, 2, ip, ip, w, 1,
542 CALL chkxer(
'ZHETRF_AA_2STAGE', infot, nout, lerr, ok )
544 CALL zhetrf_aa_2stage(
'U', 2, a, 2, a, 1, ip, ip, w, 1,
546 CALL chkxer(
'ZHETRF_AA_2STAGE', infot, nout, lerr, ok )
548 CALL zhetrf_aa_2stage(
'U', 2, a, 2, a, 8, ip, ip, w, 0,
550 CALL chkxer(
'ZHETRF_AA_2STAGE', infot, nout, lerr, ok )
554 srnamt =
'ZHETRS_AA_2STAGE'
558 CALL chkxer(
'ZHETRS_AA_2STAGE', infot, nout, lerr, ok )
562 CALL chkxer(
'ZHETRS_AA_2STAGE', infot, nout, lerr, ok )
566 CALL chkxer(
'ZHETRS_AA_2STAGE', infot, nout, lerr, ok )
570 CALL chkxer(
'ZHETRS_AA_2STAGE', infot, nout, lerr, ok )
574 CALL chkxer(
'ZHETRS_AA_2STAGE', infot, nout, lerr, ok )
578 CALL chkxer(
'ZHETRS_AA_STAGE', infot, nout, lerr, ok )
580 ELSE IF( lsamen( 2, c2,
'HP' ) )
THEN
590 CALL zhptrf(
'/', 0, a, ip, info )
591 CALL chkxer(
'ZHPTRF', infot, nout, lerr, ok )
593 CALL zhptrf(
'U', -1, a, ip, info )
594 CALL chkxer(
'ZHPTRF', infot, nout, lerr, ok )
600 CALL zhptri(
'/', 0, a, ip, w, info )
601 CALL chkxer(
'ZHPTRI', infot, nout, lerr, ok )
603 CALL zhptri(
'U', -1, a, ip, w, info )
604 CALL chkxer(
'ZHPTRI', infot, nout, lerr, ok )
610 CALL zhptrs(
'/', 0, 0, a, ip, b, 1, info )
611 CALL chkxer(
'ZHPTRS', infot, nout, lerr, ok )
613 CALL zhptrs(
'U', -1, 0, a, ip, b, 1, info )
614 CALL chkxer(
'ZHPTRS', infot, nout, lerr, ok )
616 CALL zhptrs(
'U', 0, -1, a, ip, b, 1, info )
617 CALL chkxer(
'ZHPTRS', infot, nout, lerr, ok )
619 CALL zhptrs(
'U', 2, 1, a, ip, b, 1, info )
620 CALL chkxer(
'ZHPTRS', infot, nout, lerr, ok )
626 CALL zhprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
628 CALL chkxer(
'ZHPRFS', infot, nout, lerr, ok )
630 CALL zhprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
632 CALL chkxer(
'ZHPRFS', infot, nout, lerr, ok )
634 CALL zhprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
636 CALL chkxer(
'ZHPRFS', infot, nout, lerr, ok )
638 CALL zhprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
640 CALL chkxer(
'ZHPRFS', infot, nout, lerr, ok )
642 CALL zhprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
644 CALL chkxer(
'ZHPRFS', infot, nout, lerr, ok )
650 CALL zhpcon(
'/', 0, a, ip, anrm, rcond, w, info )
651 CALL chkxer(
'ZHPCON', infot, nout, lerr, ok )
653 CALL zhpcon(
'U', -1, a, ip, anrm, rcond, w, info )
654 CALL chkxer(
'ZHPCON', infot, nout, lerr, ok )
656 CALL zhpcon(
'U', 1, a, ip, -anrm, rcond, w, info )
657 CALL chkxer(
'ZHPCON', infot, nout, lerr, ok )
662 CALL alaesm( path, ok, nout )