78 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
79 REAL ANRM, RCOND, BERR
83 REAL R( NMAX ), R1( NMAX ), R2( NMAX ),
84 $ S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
85 $ ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
86 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
87 $ E( NMAX ), W( 2*NMAX ), X( NMAX )
107 COMMON / infoc / infot, nout, ok, lerr
108 COMMON / srnamc / srnamt
111 INTRINSIC cmplx, real
116 WRITE( nout, fmt = * )
123 a( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
124 af( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
137 IF( lsamen( 2, c2,
'HE' ) )
THEN
147 CALL chetrf(
'/', 0, a, 1, ip, w, 1, info )
148 CALL chkxer(
'CHETRF', infot, nout, lerr, ok )
150 CALL chetrf(
'U', -1, a, 1, ip, w, 1, info )
151 CALL chkxer(
'CHETRF', infot, nout, lerr, ok )
153 CALL chetrf(
'U', 2, a, 1, ip, w, 4, info )
154 CALL chkxer(
'CHETRF', infot, nout, lerr, ok )
156 CALL chetrf(
'U', 0, a, 1, ip, w, 0, info )
157 CALL chkxer(
'CHETRF', infot, nout, lerr, ok )
159 CALL chetrf(
'U', 0, a, 1, ip, w, -2, info )
160 CALL chkxer(
'CHETRF', infot, nout, lerr, ok )
166 CALL chetf2(
'/', 0, a, 1, ip, info )
167 CALL chkxer(
'CHETF2', infot, nout, lerr, ok )
169 CALL chetf2(
'U', -1, a, 1, ip, info )
170 CALL chkxer(
'CHETF2', infot, nout, lerr, ok )
172 CALL chetf2(
'U', 2, a, 1, ip, info )
173 CALL chkxer(
'CHETF2', infot, nout, lerr, ok )
179 CALL chetri(
'/', 0, a, 1, ip, w, info )
180 CALL chkxer(
'CHETRI', infot, nout, lerr, ok )
182 CALL chetri(
'U', -1, a, 1, ip, w, info )
183 CALL chkxer(
'CHETRI', infot, nout, lerr, ok )
185 CALL chetri(
'U', 2, a, 1, ip, w, info )
186 CALL chkxer(
'CHETRI', infot, nout, lerr, ok )
192 CALL chetri2(
'/', 0, a, 1, ip, w, 1, info )
193 CALL chkxer(
'CHETRI2', infot, nout, lerr, ok )
195 CALL chetri2(
'U', -1, a, 1, ip, w, 1, info )
196 CALL chkxer(
'CHETRI2', infot, nout, lerr, ok )
198 CALL chetri2(
'U', 2, a, 1, ip, w, 1, info )
199 CALL chkxer(
'CHETRI2', infot, nout, lerr, ok )
205 CALL chetri2x(
'/', 0, a, 1, ip, w, 1, info )
206 CALL chkxer(
'CHETRI2X', infot, nout, lerr, ok )
208 CALL chetri2x(
'U', -1, a, 1, ip, w, 1, info )
209 CALL chkxer(
'CHETRI2X', infot, nout, lerr, ok )
211 CALL chetri2x(
'U', 2, a, 1, ip, w, 1, info )
212 CALL chkxer(
'CHETRI2X', infot, nout, lerr, ok )
218 CALL chetrs(
'/', 0, 0, a, 1, ip, b, 1, info )
219 CALL chkxer(
'CHETRS', infot, nout, lerr, ok )
221 CALL chetrs(
'U', -1, 0, a, 1, ip, b, 1, info )
222 CALL chkxer(
'CHETRS', infot, nout, lerr, ok )
224 CALL chetrs(
'U', 0, -1, a, 1, ip, b, 1, info )
225 CALL chkxer(
'CHETRS', infot, nout, lerr, ok )
227 CALL chetrs(
'U', 2, 1, a, 1, ip, b, 2, info )
228 CALL chkxer(
'CHETRS', infot, nout, lerr, ok )
230 CALL chetrs(
'U', 2, 1, a, 2, ip, b, 1, info )
231 CALL chkxer(
'CHETRS', infot, nout, lerr, ok )
237 CALL cherfs(
'/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
239 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
241 CALL cherfs(
'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
243 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
245 CALL cherfs(
'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
247 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
249 CALL cherfs(
'U', 2, 1, a, 1, af, 2, 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, 1, ip, b, 2, 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, 1, x, 2, r1, r2, w,
259 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
261 CALL cherfs(
'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
263 CALL chkxer(
'CHERFS', infot, nout, lerr, ok )
269 CALL checon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
270 CALL chkxer(
'CHECON', infot, nout, lerr, ok )
272 CALL checon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
273 CALL chkxer(
'CHECON', infot, nout, lerr, ok )
275 CALL checon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
276 CALL chkxer(
'CHECON', infot, nout, lerr, ok )
278 CALL checon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
279 CALL chkxer(
'CHECON', infot, nout, lerr, ok )
287 CALL cherfsx(
'/', eq, 0, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
288 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
289 $ params, w, r, info )
290 CALL chkxer(
'CHERFSX', infot, nout, lerr, ok )
292 CALL cherfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
293 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
294 $ params, w, r, info )
295 CALL chkxer(
'CHERFSX', infot, nout, lerr, ok )
298 CALL cherfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
299 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
300 $ params, w, r, info )
301 CALL chkxer(
'CHERFSX', infot, nout, lerr, ok )
303 CALL cherfsx(
'U', eq, 0, -1, a, 1, af, 1, ip, s, b, 1, x, 1,
304 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
305 $ params, w, r, info )
306 CALL chkxer(
'CHERFSX', infot, nout, lerr, ok )
308 CALL cherfsx(
'U', eq, 2, 1, a, 1, af, 2, ip, s, b, 2, x, 2,
309 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
310 $ params, w, r, info )
311 CALL chkxer(
'CHERFSX', infot, nout, lerr, ok )
313 CALL cherfsx(
'U', eq, 2, 1, a, 2, af, 1, ip, s, b, 2, x, 2,
314 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
315 $ params, w, r, info )
316 CALL chkxer(
'CHERFSX', infot, nout, lerr, ok )
318 CALL cherfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 1, x, 2,
319 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
320 $ params, w, r, info )
321 CALL chkxer(
'CHERFSX', infot, nout, lerr, ok )
323 CALL cherfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 2, x, 1,
324 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
325 $ params, w, r, info )
326 CALL chkxer(
'CHERFSX', infot, nout, lerr, ok )
328 ELSE IF( lsamen( 2, c2,
'HR' ) )
THEN
336 srnamt =
'CHETRF_ROOK'
339 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
342 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
345 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
348 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
351 CALL chkxer(
'CHETRF_ROOK', infot, nout, lerr, ok )
355 srnamt =
'CHETF2_ROOK'
358 CALL chkxer(
'CHETF2_ROOK', infot, nout, lerr, ok )
361 CALL chkxer(
'CHETF2_ROOK', infot, nout, lerr, ok )
364 CALL chkxer(
'CHETF2_ROOK', infot, nout, lerr, ok )
368 srnamt =
'CHETRI_ROOK'
371 CALL chkxer(
'CHETRI_ROOK', infot, nout, lerr, ok )
374 CALL chkxer(
'CHETRI_ROOK', infot, nout, lerr, ok )
377 CALL chkxer(
'CHETRI_ROOK', infot, nout, lerr, ok )
381 srnamt =
'CHETRS_ROOK'
383 CALL chetrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
384 CALL chkxer(
'CHETRS_ROOK', infot, nout, lerr, ok )
386 CALL chetrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
387 CALL chkxer(
'CHETRS_ROOK', infot, nout, lerr, ok )
389 CALL chetrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
390 CALL chkxer(
'CHETRS_ROOK', infot, nout, lerr, ok )
392 CALL chetrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
393 CALL chkxer(
'CHETRS_ROOK', infot, nout, lerr, ok )
395 CALL chetrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
396 CALL chkxer(
'CHETRS_ROOK', infot, nout, lerr, ok )
400 srnamt =
'CHECON_ROOK'
402 CALL checon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
403 CALL chkxer(
'CHECON_ROOK', infot, nout, lerr, ok )
405 CALL checon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
406 CALL chkxer(
'CHECON_ROOK', infot, nout, lerr, ok )
408 CALL checon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, info )
409 CALL chkxer(
'CHECON_ROOK', infot, nout, lerr, ok )
411 CALL checon_rook(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
412 CALL chkxer(
'CHECON_ROOK', infot, nout, lerr, ok )
414 ELSE IF( lsamen( 2, c2,
'HK' ) )
THEN
428 CALL chetrf_rk(
'/', 0, a, 1, e, ip, w, 1, info )
429 CALL chkxer(
'CHETRF_RK', infot, nout, lerr, ok )
431 CALL chetrf_rk(
'U', -1, a, 1, e, ip, w, 1, info )
432 CALL chkxer(
'CHETRF_RK', infot, nout, lerr, ok )
434 CALL chetrf_rk(
'U', 2, a, 1, e, ip, w, 4, info )
435 CALL chkxer(
'CHETRF_RK', infot, nout, lerr, ok )
437 CALL chetrf_rk(
'U', 0, a, 1, e, ip, w, 0, info )
438 CALL chkxer(
'CHETRF_RK', infot, nout, lerr, ok )
440 CALL chetrf_rk(
'U', 0, a, 1, e, ip, w, -2, info )
441 CALL chkxer(
'CHETRF_RK', infot, nout, lerr, ok )
447 CALL chetf2_rk(
'/', 0, a, 1, e, ip, info )
448 CALL chkxer(
'CHETF2_RK', infot, nout, lerr, ok )
450 CALL chetf2_rk(
'U', -1, a, 1, e, ip, info )
451 CALL chkxer(
'CHETF2_RK', infot, nout, lerr, ok )
453 CALL chetf2_rk(
'U', 2, a, 1, e, ip, info )
454 CALL chkxer(
'CHETF2_RK', infot, nout, lerr, ok )
460 CALL chetri_3(
'/', 0, a, 1, e, ip, w, 1, info )
461 CALL chkxer(
'CHETRI_3', infot, nout, lerr, ok )
463 CALL chetri_3(
'U', -1, a, 1, e, ip, w, 1, info )
464 CALL chkxer(
'CHETRI_3', infot, nout, lerr, ok )
466 CALL chetri_3(
'U', 2, a, 1, e, ip, w, 1, info )
467 CALL chkxer(
'CHETRI_3', infot, nout, lerr, ok )
469 CALL chetri_3(
'U', 0, a, 1, e, ip, w, 0, info )
470 CALL chkxer(
'CHETRI_3', infot, nout, lerr, ok )
472 CALL chetri_3(
'U', 0, a, 1, e, ip, w, -2, info )
473 CALL chkxer(
'CHETRI_3', infot, nout, lerr, ok )
479 CALL chetri_3x(
'/', 0, a, 1, e, ip, w, 1, info )
480 CALL chkxer(
'CHETRI_3X', infot, nout, lerr, ok )
482 CALL chetri_3x(
'U', -1, a, 1, e, ip, w, 1, info )
483 CALL chkxer(
'CHETRI_3X', infot, nout, lerr, ok )
485 CALL chetri_3x(
'U', 2, a, 1, e, ip, w, 1, info )
486 CALL chkxer(
'CHETRI_3X', infot, nout, lerr, ok )
492 CALL chetrs_3(
'/', 0, 0, a, 1, e, ip, b, 1, info )
493 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
495 CALL chetrs_3(
'U', -1, 0, a, 1, e, ip, b, 1, info )
496 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
498 CALL chetrs_3(
'U', 0, -1, a, 1, e, ip, b, 1, info )
499 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
501 CALL chetrs_3(
'U', 2, 1, a, 1, e, ip, b, 2, info )
502 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
504 CALL chetrs_3(
'U', 2, 1, a, 2, e, ip, b, 1, info )
505 CALL chkxer(
'CHETRS_3', infot, nout, lerr, ok )
511 CALL checon_3(
'/', 0, a, 1, e, ip, anrm, rcond, w, info )
512 CALL chkxer(
'CHECON_3', infot, nout, lerr, ok )
514 CALL checon_3(
'U', -1, a, 1, e, ip, anrm, rcond, w, info )
515 CALL chkxer(
'CHECON_3', infot, nout, lerr, ok )
517 CALL checon_3(
'U', 2, a, 1, e, ip, anrm, rcond, w, info )
518 CALL chkxer(
'CHECON_3', infot, nout, lerr, ok )
520 CALL checon_3(
'U', 1, a, 1, e, ip, -1.0e0, rcond, w, info)
521 CALL chkxer(
'CHECON_3', infot, nout, lerr, ok )
523 ELSE IF( lsamen( 2, c2,
'HP' ) )
THEN
533 CALL chptrf(
'/', 0, a, ip, info )
534 CALL chkxer(
'CHPTRF', infot, nout, lerr, ok )
536 CALL chptrf(
'U', -1, a, ip, info )
537 CALL chkxer(
'CHPTRF', infot, nout, lerr, ok )
543 CALL chptri(
'/', 0, a, ip, w, info )
544 CALL chkxer(
'CHPTRI', infot, nout, lerr, ok )
546 CALL chptri(
'U', -1, a, ip, w, info )
547 CALL chkxer(
'CHPTRI', infot, nout, lerr, ok )
553 CALL chptrs(
'/', 0, 0, a, ip, b, 1, info )
554 CALL chkxer(
'CHPTRS', infot, nout, lerr, ok )
556 CALL chptrs(
'U', -1, 0, a, ip, b, 1, info )
557 CALL chkxer(
'CHPTRS', infot, nout, lerr, ok )
559 CALL chptrs(
'U', 0, -1, a, ip, b, 1, info )
560 CALL chkxer(
'CHPTRS', infot, nout, lerr, ok )
562 CALL chptrs(
'U', 2, 1, a, ip, b, 1, info )
563 CALL chkxer(
'CHPTRS', infot, nout, lerr, ok )
569 CALL chprfs(
'/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
571 CALL chkxer(
'CHPRFS', infot, nout, lerr, ok )
573 CALL chprfs(
'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
575 CALL chkxer(
'CHPRFS', infot, nout, lerr, ok )
577 CALL chprfs(
'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
579 CALL chkxer(
'CHPRFS', infot, nout, lerr, ok )
581 CALL chprfs(
'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
583 CALL chkxer(
'CHPRFS', infot, nout, lerr, ok )
585 CALL chprfs(
'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
587 CALL chkxer(
'CHPRFS', infot, nout, lerr, ok )
593 CALL chpcon(
'/', 0, a, ip, anrm, rcond, w, info )
594 CALL chkxer(
'CHPCON', infot, nout, lerr, ok )
596 CALL chpcon(
'U', -1, a, ip, anrm, rcond, w, info )
597 CALL chkxer(
'CHPCON', infot, nout, lerr, ok )
599 CALL chpcon(
'U', 1, a, ip, -anrm, rcond, w, info )
600 CALL chkxer(
'CHPCON', infot, nout, lerr, ok )
605 CALL alaesm( path, ok, nout )