59 SUBROUTINE zerrhe( PATH, NUNIT )
81 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
82 DOUBLE PRECISION ANRM, RCOND, BERR
86 DOUBLE PRECISION R( NMAX ), R1( NMAX ), R2( NMAX ),
87 $ S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
88 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
89 COMPLEX*16 A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
90 $ E( NMAX ), W( 2*NMAX ), X( NMAX )
110 COMMON / infoc / infot, nout, ok, lerr
111 COMMON / srnamc / srnamt
114 INTRINSIC dble, dcmplx
119 WRITE( nout, fmt = * )
126 a( i, j ) = dcmplx( 1.d0 / dble( i+j ),
127 $ -1.d0 / dble( i+j ) )
128 af( i, j ) = dcmplx( 1.d0 / dble( i+j ),
129 $ -1.d0 / dble( i+j ) )
147 IF( lsamen( 2, c2,
'HE' ) )
THEN
153 CALL zhetrf(
'/', 0, a, 1, ip, w, 1, info )
154 CALL chkxer(
'ZHETRF', infot, nout, lerr, ok )
156 CALL zhetrf(
'U', -1, a, 1, ip, w, 1, info )
157 CALL chkxer(
'ZHETRF', infot, nout, lerr, ok )
159 CALL zhetrf(
'U', 2, a, 1, ip, w, 4, info )
160 CALL chkxer(
'ZHETRF', infot, nout, lerr, ok )
162 CALL zhetrf(
'U', 0, a, 1, ip, w, 0, info )
163 CALL chkxer(
'ZHETRF', infot, nout, lerr, ok )
165 CALL zhetrf(
'U', 0, a, 1, ip, w, -2, info )
166 CALL chkxer(
'ZHETRF', infot, nout, lerr, ok )
172 CALL zhetf2(
'/', 0, a, 1, ip, info )
173 CALL chkxer(
'ZHETF2', infot, nout, lerr, ok )
175 CALL zhetf2(
'U', -1, a, 1, ip, info )
176 CALL chkxer(
'ZHETF2', infot, nout, lerr, ok )
178 CALL zhetf2(
'U', 2, a, 1, ip, info )
179 CALL chkxer(
'ZHETF2', infot, nout, lerr, ok )
185 CALL zhetri(
'/', 0, a, 1, ip, w, info )
186 CALL chkxer(
'ZHETRI', infot, nout, lerr, ok )
188 CALL zhetri(
'U', -1, a, 1, ip, w, info )
189 CALL chkxer(
'ZHETRI', infot, nout, lerr, ok )
191 CALL zhetri(
'U', 2, a, 1, ip, w, info )
192 CALL chkxer(
'ZHETRI', infot, nout, lerr, ok )
198 CALL zhetri2(
'/', 0, a, 1, ip, w, 1, info )
199 CALL chkxer(
'ZHETRI2', infot, nout, lerr, ok )
201 CALL zhetri2(
'U', -1, a, 1, ip, w, 1, info )
202 CALL chkxer(
'ZHETRI2', infot, nout, lerr, ok )
204 CALL zhetri2(
'U', 2, a, 1, ip, w, 1, info )
205 CALL chkxer(
'ZHETRI2', infot, nout, lerr, ok )
211 CALL zhetri2x(
'/', 0, a, 1, ip, w, 1, info )
212 CALL chkxer(
'ZHETRI2X', infot, nout, lerr, ok )
214 CALL zhetri2x(
'U', -1, a, 1, ip, w, 1, info )
215 CALL chkxer(
'ZHETRI2X', infot, nout, lerr, ok )
217 CALL zhetri2x(
'U', 2, a, 1, ip, w, 1, info )
218 CALL chkxer(
'ZHETRI2X', infot, nout, lerr, ok )
224 CALL zhetrs(
'/', 0, 0, a, 1, ip, b, 1, info )
225 CALL chkxer(
'ZHETRS', infot, nout, lerr, ok )
227 CALL zhetrs(
'U', -1, 0, a, 1, ip, b, 1, info )
228 CALL chkxer(
'ZHETRS', infot, nout, lerr, ok )
230 CALL zhetrs(
'U', 0, -1, a, 1, ip, b, 1, info )
231 CALL chkxer(
'ZHETRS', infot, nout, lerr, ok )
233 CALL zhetrs(
'U', 2, 1, a, 1, ip, b, 2, info )
234 CALL chkxer(
'ZHETRS', infot, nout, lerr, ok )
236 CALL zhetrs(
'U', 2, 1, a, 2, ip, b, 1, info )
237 CALL chkxer(
'ZHETRS', infot, nout, lerr, ok )
243 CALL zherfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
245 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
247 CALL zherfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
249 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
251 CALL zherfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
253 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
255 CALL zherfs(
'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
257 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
259 CALL zherfs(
'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
261 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
263 CALL zherfs(
'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
265 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
267 CALL zherfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
269 CALL chkxer(
'ZHERFS', infot, nout, lerr, ok )
277 CALL zherfsx(
'/', eq, 0, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
278 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
279 $ params, w, r, info )
280 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
282 CALL zherfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
283 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
284 $ params, w, r, info )
285 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
288 CALL zherfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
289 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
290 $ params, w, r, info )
291 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
293 CALL zherfsx(
'U', eq, 0, -1, a, 1, af, 1, ip, s, b, 1, x, 1,
294 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
295 $ params, w, r, info )
296 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
298 CALL zherfsx(
'U', eq, 2, 1, a, 1, af, 2, ip, s, b, 2, x, 2,
299 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
300 $ params, w, r, info )
301 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
303 CALL zherfsx(
'U', eq, 2, 1, a, 2, af, 1, ip, s, b, 2, x, 2,
304 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
305 $ params, w, r, info )
306 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
308 CALL zherfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 1, x, 2,
309 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
310 $ params, w, r, info )
311 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
313 CALL zherfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 2, x, 1,
314 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
315 $ params, w, r, info )
316 CALL chkxer(
'ZHERFSX', infot, nout, lerr, ok )
322 CALL zhecon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
323 CALL chkxer(
'ZHECON', infot, nout, lerr, ok )
325 CALL zhecon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
326 CALL chkxer(
'ZHECON', infot, nout, lerr, ok )
328 CALL zhecon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
329 CALL chkxer(
'ZHECON', infot, nout, lerr, ok )
331 CALL zhecon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
332 CALL chkxer(
'ZHECON', infot, nout, lerr, ok )
334 ELSE IF( lsamen( 2, c2,
'HR' ) )
THEN
342 srnamt =
'ZHETRF_ROOK'
345 CALL chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
348 CALL chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
351 CALL chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
354 CALL chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
357 CALL chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
361 srnamt =
'ZHETF2_ROOK'
364 CALL chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
367 CALL chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
370 CALL chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
374 srnamt =
'ZHETRI_ROOK'
377 CALL chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
380 CALL chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
383 CALL chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
387 srnamt =
'ZHETRS_ROOK'
389 CALL zhetrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
390 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
392 CALL zhetrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
393 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
395 CALL zhetrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
396 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
398 CALL zhetrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
399 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
401 CALL zhetrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
402 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
406 srnamt =
'ZHECON_ROOK'
408 CALL zhecon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
409 CALL chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
411 CALL zhecon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
412 CALL chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
414 CALL zhecon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, info )
415 CALL chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
417 CALL zhecon_rook(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
418 CALL chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
420 ELSE IF( lsamen( 2, c2,
'HK' ) )
THEN
434 CALL zhetrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
435 CALL chkxer(
'ZHETRF_RK', infot, nout, lerr, ok )
437 CALL zhetrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
438 CALL chkxer(
'ZHETRF_RK', infot, nout, lerr, ok )
440 CALL zhetrf_rk(
'U', 2, a, 1, e, ip, w, 4, info )
441 CALL chkxer(
'ZHETRF_RK', infot, nout, lerr, ok )
443 CALL zhetrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
444 CALL chkxer(
'ZHETRF_RK', infot, nout, lerr, ok )
446 CALL zhetrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
447 CALL chkxer(
'ZHETRF_RK', infot, nout, lerr, ok )
453 CALL zhetf2_rk(
'/', 0, a, 1, e, ip, info )
454 CALL chkxer(
'ZHETF2_RK', infot, nout, lerr, ok )
456 CALL zhetf2_rk(
'U', -1, a, 1, e, ip, info )
457 CALL chkxer(
'ZHETF2_RK', infot, nout, lerr, ok )
459 CALL zhetf2_rk(
'U', 2, a, 1, e, ip, info )
460 CALL chkxer(
'ZHETF2_RK', infot, nout, lerr, ok )
466 CALL zhetri_3(
'/', 0, a, 1, e, ip, w, 1, info )
467 CALL chkxer(
'ZHETRI_3', infot, nout, lerr, ok )
469 CALL zhetri_3(
'U', -1, a, 1, e, ip, w, 1, info )
470 CALL chkxer(
'ZHETRI_3', infot, nout, lerr, ok )
472 CALL zhetri_3(
'U', 2, a, 1, e, ip, w, 1, info )
473 CALL chkxer(
'ZHETRI_3', infot, nout, lerr, ok )
475 CALL zhetri_3(
'U', 0, a, 1, e, ip, w, 0, info )
476 CALL chkxer(
'ZHETRI_3', infot, nout, lerr, ok )
478 CALL zhetri_3(
'U', 0, a, 1, e, ip, w, -2, info )
479 CALL chkxer(
'ZHETRI_3', infot, nout, lerr, ok )
485 CALL zhetri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
486 CALL chkxer(
'ZHETRI_3X', infot, nout, lerr, ok )
488 CALL zhetri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
489 CALL chkxer(
'ZHETRI_3X', infot, nout, lerr, ok )
491 CALL zhetri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
492 CALL chkxer(
'ZHETRI_3X', infot, nout, lerr, ok )
498 CALL zhetrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
499 CALL chkxer(
'ZHETRS_3', infot, nout, lerr, ok )
501 CALL zhetrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
502 CALL chkxer(
'ZHETRS_3', infot, nout, lerr, ok )
504 CALL zhetrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
505 CALL chkxer(
'ZHETRS_3', infot, nout, lerr, ok )
507 CALL zhetrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
508 CALL chkxer(
'ZHETRS_3', infot, nout, lerr, ok )
510 CALL zhetrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
511 CALL chkxer(
'ZHETRS_3', infot, nout, lerr, ok )
517 CALL zhecon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, info )
518 CALL chkxer(
'ZHECON_3', infot, nout, lerr, ok )
520 CALL zhecon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, info )
521 CALL chkxer(
'ZHECON_3', infot, nout, lerr, ok )
523 CALL zhecon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, info )
524 CALL chkxer(
'ZHECON_3', infot, nout, lerr, ok )
526 CALL zhecon_3(
'U', 1, a, 1, e, ip, -1.0d0, rcond, w, info)
527 CALL chkxer(
'ZHECON_3', infot, nout, lerr, ok )
529 ELSE IF( lsamen( 2, c2,
'HP' ) )
THEN
539 CALL zhptrf(
'/', 0, a, ip, info )
540 CALL chkxer(
'ZHPTRF', infot, nout, lerr, ok )
542 CALL zhptrf(
'U', -1, a, ip, info )
543 CALL chkxer(
'ZHPTRF', infot, nout, lerr, ok )
549 CALL zhptri(
'/', 0, a, ip, w, info )
550 CALL chkxer(
'ZHPTRI', infot, nout, lerr, ok )
552 CALL zhptri(
'U', -1, a, ip, w, info )
553 CALL chkxer(
'ZHPTRI', infot, nout, lerr, ok )
559 CALL zhptrs(
'/', 0, 0, a, ip, b, 1, info )
560 CALL chkxer(
'ZHPTRS', infot, nout, lerr, ok )
562 CALL zhptrs(
'U', -1, 0, a, ip, b, 1, info )
563 CALL chkxer(
'ZHPTRS', infot, nout, lerr, ok )
565 CALL zhptrs(
'U', 0, -1, a, ip, b, 1, info )
566 CALL chkxer(
'ZHPTRS', infot, nout, lerr, ok )
568 CALL zhptrs(
'U', 2, 1, a, ip, b, 1, info )
569 CALL chkxer(
'ZHPTRS', infot, nout, lerr, ok )
575 CALL zhprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
577 CALL chkxer(
'ZHPRFS', infot, nout, lerr, ok )
579 CALL zhprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
581 CALL chkxer(
'ZHPRFS', infot, nout, lerr, ok )
583 CALL zhprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
585 CALL chkxer(
'ZHPRFS', infot, nout, lerr, ok )
587 CALL zhprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
589 CALL chkxer(
'ZHPRFS', infot, nout, lerr, ok )
591 CALL zhprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
593 CALL chkxer(
'ZHPRFS', infot, nout, lerr, ok )
599 CALL zhpcon(
'/', 0, a, ip, anrm, rcond, w, info )
600 CALL chkxer(
'ZHPCON', infot, nout, lerr, ok )
602 CALL zhpcon(
'U', -1, a, ip, anrm, rcond, w, info )
603 CALL chkxer(
'ZHPCON', infot, nout, lerr, ok )
605 CALL zhpcon(
'U', 1, a, ip, -anrm, rcond, w, info )
606 CALL chkxer(
'ZHPCON', infot, nout, lerr, ok )
611 CALL alaesm( path, ok, nout )