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 $ w( 2*nmax ), x( nmax )
109 COMMON / infoc / infot, nout, ok, lerr
110 COMMON / srnamc / srnamt
113 INTRINSIC dble, dcmplx
118 WRITE( nout, fmt = * )
125 a( i,
j ) = dcmplx( 1.d0 / dble( i+
j ),
126 $ -1.d0 / dble( i+
j ) )
127 af( i,
j ) = dcmplx( 1.d0 / dble( i+
j ),
128 $ -1.d0 / dble( i+
j ) )
145 IF(
lsamen( 2, c2,
'HE' ) )
THEN
151 CALL
zhetrf(
'/', 0, a, 1, ip, w, 1, info )
152 CALL
chkxer(
'ZHETRF', infot, nout, lerr, ok )
154 CALL
zhetrf(
'U', -1, a, 1, ip, w, 1, info )
155 CALL
chkxer(
'ZHETRF', infot, nout, lerr, ok )
157 CALL
zhetrf(
'U', 2, a, 1, ip, w, 4, 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
zhetrs(
'/', 0, 0, a, 1, ip,
b, 1, info )
204 CALL
chkxer(
'ZHETRS', infot, nout, lerr, ok )
206 CALL
zhetrs(
'U', -1, 0, a, 1, ip,
b, 1, info )
207 CALL
chkxer(
'ZHETRS', infot, nout, lerr, ok )
209 CALL
zhetrs(
'U', 0, -1, a, 1, ip,
b, 1, info )
210 CALL
chkxer(
'ZHETRS', infot, nout, lerr, ok )
212 CALL
zhetrs(
'U', 2, 1, a, 1, ip,
b, 2, info )
213 CALL
chkxer(
'ZHETRS', infot, nout, lerr, ok )
215 CALL
zhetrs(
'U', 2, 1, a, 2, ip,
b, 1, info )
216 CALL
chkxer(
'ZHETRS', infot, nout, lerr, ok )
222 CALL
zherfs(
'/', 0, 0, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2, w,
224 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
226 CALL
zherfs(
'U', -1, 0, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2,
228 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
230 CALL
zherfs(
'U', 0, -1, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2,
232 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
234 CALL
zherfs(
'U', 2, 1, a, 1, af, 2, ip,
b, 2, x, 2, r1, r2, w,
236 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
238 CALL
zherfs(
'U', 2, 1, a, 2, af, 1, ip,
b, 2, x, 2, r1, r2, w,
240 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
242 CALL
zherfs(
'U', 2, 1, a, 2, af, 2, ip,
b, 1, x, 2, r1, r2, w,
244 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
246 CALL
zherfs(
'U', 2, 1, a, 2, af, 2, ip,
b, 2, x, 1, r1, r2, w,
248 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
256 CALL
zherfsx(
'/', eq, 0, 0, a, 1, af, 1, ip, s,
b, 1, x, 1,
257 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
258 $ params, w, r, info )
259 CALL
chkxer(
'ZHERFSX', infot, nout, lerr, ok )
261 CALL
zherfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s,
b, 1, x, 1,
262 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
263 $ params, w, r, info )
264 CALL
chkxer(
'ZHERFSX', infot, nout, lerr, ok )
267 CALL
zherfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s,
b, 1, x, 1,
268 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
269 $ params, w, r, info )
270 CALL
chkxer(
'ZHERFSX', infot, nout, lerr, ok )
272 CALL
zherfsx(
'U', eq, 0, -1, a, 1, af, 1, ip, s,
b, 1, x, 1,
273 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
274 $ params, w, r, info )
275 CALL
chkxer(
'ZHERFSX', infot, nout, lerr, ok )
277 CALL
zherfsx(
'U', eq, 2, 1, a, 1, af, 2, ip, s,
b, 2, x, 2,
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, 2, 1, a, 2, af, 1, ip, s,
b, 2, x, 2,
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 )
287 CALL
zherfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s,
b, 1, x, 2,
288 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
289 $ params, w, r, info )
290 CALL
chkxer(
'ZHERFSX', infot, nout, lerr, ok )
292 CALL
zherfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s,
b, 2, x, 1,
293 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
294 $ params, w, r, info )
295 CALL
chkxer(
'ZHERFSX', infot, nout, lerr, ok )
301 CALL
zhecon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
302 CALL
chkxer(
'ZHECON', infot, nout, lerr, ok )
304 CALL
zhecon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
305 CALL
chkxer(
'ZHECON', infot, nout, lerr, ok )
307 CALL
zhecon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
308 CALL
chkxer(
'ZHECON', infot, nout, lerr, ok )
310 CALL
zhecon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
311 CALL
chkxer(
'ZHECON', infot, nout, lerr, ok )
317 ELSE IF(
lsamen( 2, c2,
'HR' ) )
THEN
321 srnamt =
'ZHETRF_ROOK'
324 CALL
chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
327 CALL
chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
330 CALL
chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
334 srnamt =
'ZHETF2_ROOK'
337 CALL
chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
340 CALL
chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
343 CALL
chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
347 srnamt =
'ZHETRI_ROOK'
350 CALL
chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
353 CALL
chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
356 CALL
chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
360 srnamt =
'ZHETRS_ROOK'
363 CALL
chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
366 CALL
chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
369 CALL
chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
372 CALL
chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
375 CALL
chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
379 srnamt =
'ZHECON_ROOK'
381 CALL
zhecon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
382 CALL
chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
384 CALL
zhecon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
385 CALL
chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
387 CALL
zhecon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, info )
388 CALL
chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
390 CALL
zhecon_rook(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
391 CALL
chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
397 ELSE IF(
lsamen( 2, c2,
'HP' ) )
THEN
403 CALL
zhptrf(
'/', 0, a, ip, info )
404 CALL
chkxer(
'ZHPTRF', infot, nout, lerr, ok )
406 CALL
zhptrf(
'U', -1, a, ip, info )
407 CALL
chkxer(
'ZHPTRF', infot, nout, lerr, ok )
413 CALL
zhptri(
'/', 0, a, ip, w, info )
414 CALL
chkxer(
'ZHPTRI', infot, nout, lerr, ok )
416 CALL
zhptri(
'U', -1, a, ip, w, info )
417 CALL
chkxer(
'ZHPTRI', infot, nout, lerr, ok )
423 CALL
zhptrs(
'/', 0, 0, a, ip,
b, 1, info )
424 CALL
chkxer(
'ZHPTRS', infot, nout, lerr, ok )
426 CALL
zhptrs(
'U', -1, 0, a, ip,
b, 1, info )
427 CALL
chkxer(
'ZHPTRS', infot, nout, lerr, ok )
429 CALL
zhptrs(
'U', 0, -1, a, ip,
b, 1, info )
430 CALL
chkxer(
'ZHPTRS', infot, nout, lerr, ok )
432 CALL
zhptrs(
'U', 2, 1, a, ip,
b, 1, info )
433 CALL
chkxer(
'ZHPTRS', infot, nout, lerr, ok )
439 CALL
zhprfs(
'/', 0, 0, a, af, ip,
b, 1, x, 1, r1, r2, w, r,
441 CALL
chkxer(
'ZHPRFS', infot, nout, lerr, ok )
443 CALL
zhprfs(
'U', -1, 0, a, af, ip,
b, 1, x, 1, r1, r2, w, r,
445 CALL
chkxer(
'ZHPRFS', infot, nout, lerr, ok )
447 CALL
zhprfs(
'U', 0, -1, a, af, ip,
b, 1, x, 1, r1, r2, w, r,
449 CALL
chkxer(
'ZHPRFS', infot, nout, lerr, ok )
451 CALL
zhprfs(
'U', 2, 1, a, af, ip,
b, 1, x, 2, r1, r2, w, r,
453 CALL
chkxer(
'ZHPRFS', infot, nout, lerr, ok )
455 CALL
zhprfs(
'U', 2, 1, a, af, ip,
b, 2, x, 1, r1, r2, w, r,
457 CALL
chkxer(
'ZHPRFS', infot, nout, lerr, ok )
463 CALL
zhpcon(
'/', 0, a, ip, anrm, rcond, w, info )
464 CALL
chkxer(
'ZHPCON', infot, nout, lerr, ok )
466 CALL
zhpcon(
'U', -1, a, ip, anrm, rcond, w, info )
467 CALL
chkxer(
'ZHPCON', infot, nout, lerr, ok )
469 CALL
zhpcon(
'U', 1, a, ip, -anrm, rcond, w, info )
470 CALL
chkxer(
'ZHPCON', infot, nout, lerr, ok )
475 CALL
alaesm( path, ok, nout )