78 DOUBLE PRECISION anrm, rcond
82 DOUBLE PRECISION r( nmax ), r1( nmax ), r2( nmax )
83 COMPLEX*16 a( nmax, nmax ), af( nmax, nmax ),
b( nmax ),
84 $ 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 ) )
138 IF(
lsamen( 2, c2,
'HE' ) )
THEN
144 CALL
zhetrf(
'/', 0, a, 1, ip, w, 1, info )
145 CALL
chkxer(
'ZHETRF', infot, nout, lerr, ok )
147 CALL
zhetrf(
'U', -1, a, 1, ip, w, 1, info )
148 CALL
chkxer(
'ZHETRF', infot, nout, lerr, ok )
150 CALL
zhetrf(
'U', 2, a, 1, ip, w, 4, info )
151 CALL
chkxer(
'ZHETRF', infot, nout, lerr, ok )
157 CALL
zhetf2(
'/', 0, a, 1, ip, info )
158 CALL
chkxer(
'ZHETF2', infot, nout, lerr, ok )
160 CALL
zhetf2(
'U', -1, a, 1, ip, info )
161 CALL
chkxer(
'ZHETF2', infot, nout, lerr, ok )
163 CALL
zhetf2(
'U', 2, a, 1, ip, info )
164 CALL
chkxer(
'ZHETF2', infot, nout, lerr, ok )
170 CALL
zhetri(
'/', 0, a, 1, ip, w, info )
171 CALL
chkxer(
'ZHETRI', infot, nout, lerr, ok )
173 CALL
zhetri(
'U', -1, a, 1, ip, w, info )
174 CALL
chkxer(
'ZHETRI', infot, nout, lerr, ok )
176 CALL
zhetri(
'U', 2, a, 1, ip, w, info )
177 CALL
chkxer(
'ZHETRI', infot, nout, lerr, ok )
183 CALL
zhetri2(
'/', 0, a, 1, ip, w, 1, info )
184 CALL
chkxer(
'ZHETRI2', infot, nout, lerr, ok )
186 CALL
zhetri2(
'U', -1, a, 1, ip, w, 1, info )
187 CALL
chkxer(
'ZHETRI2', infot, nout, lerr, ok )
189 CALL
zhetri2(
'U', 2, a, 1, ip, w, 1, info )
190 CALL
chkxer(
'ZHETRI2', infot, nout, lerr, ok )
196 CALL
zhetrs(
'/', 0, 0, a, 1, ip,
b, 1, info )
197 CALL
chkxer(
'ZHETRS', infot, nout, lerr, ok )
199 CALL
zhetrs(
'U', -1, 0, a, 1, ip,
b, 1, info )
200 CALL
chkxer(
'ZHETRS', infot, nout, lerr, ok )
202 CALL
zhetrs(
'U', 0, -1, a, 1, ip,
b, 1, info )
203 CALL
chkxer(
'ZHETRS', infot, nout, lerr, ok )
205 CALL
zhetrs(
'U', 2, 1, a, 1, ip,
b, 2, info )
206 CALL
chkxer(
'ZHETRS', infot, nout, lerr, ok )
208 CALL
zhetrs(
'U', 2, 1, a, 2, ip,
b, 1, info )
209 CALL
chkxer(
'ZHETRS', infot, nout, lerr, ok )
215 CALL
zherfs(
'/', 0, 0, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2, w,
217 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
219 CALL
zherfs(
'U', -1, 0, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2,
221 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
223 CALL
zherfs(
'U', 0, -1, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2,
225 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
227 CALL
zherfs(
'U', 2, 1, a, 1, af, 2, ip,
b, 2, x, 2, r1, r2, w,
229 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
231 CALL
zherfs(
'U', 2, 1, a, 2, af, 1, ip,
b, 2, x, 2, r1, r2, w,
233 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
235 CALL
zherfs(
'U', 2, 1, a, 2, af, 2, ip,
b, 1, x, 2, r1, r2, w,
237 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
239 CALL
zherfs(
'U', 2, 1, a, 2, af, 2, ip,
b, 2, x, 1, r1, r2, w,
241 CALL
chkxer(
'ZHERFS', infot, nout, lerr, ok )
247 CALL
zhecon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
248 CALL
chkxer(
'ZHECON', infot, nout, lerr, ok )
250 CALL
zhecon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
251 CALL
chkxer(
'ZHECON', infot, nout, lerr, ok )
253 CALL
zhecon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
254 CALL
chkxer(
'ZHECON', infot, nout, lerr, ok )
256 CALL
zhecon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
257 CALL
chkxer(
'ZHECON', infot, nout, lerr, ok )
263 ELSE IF(
lsamen( 2, c2,
'HR' ) )
THEN
267 srnamt =
'ZHETRF_ROOK'
270 CALL
chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
273 CALL
chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
276 CALL
chkxer(
'ZHETRF_ROOK', infot, nout, lerr, ok )
280 srnamt =
'ZHETF2_ROOK'
283 CALL
chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
286 CALL
chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
289 CALL
chkxer(
'ZHETF2_ROOK', infot, nout, lerr, ok )
293 srnamt =
'ZHETRI_ROOK'
296 CALL
chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
299 CALL
chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
302 CALL
chkxer(
'ZHETRI_ROOK', infot, nout, lerr, ok )
306 srnamt =
'ZHETRS_ROOK'
309 CALL
chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
312 CALL
chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
315 CALL
chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
318 CALL
chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
321 CALL
chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
325 srnamt =
'ZHECON_ROOK'
327 CALL
zhecon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
328 CALL
chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
330 CALL
zhecon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
331 CALL
chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
333 CALL
zhecon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, info )
334 CALL
chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
336 CALL
zhecon_rook(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
337 CALL
chkxer(
'ZHECON_ROOK', infot, nout, lerr, ok )
343 ELSE IF(
lsamen( 2, c2,
'HP' ) )
THEN
349 CALL
zhptrf(
'/', 0, a, ip, info )
350 CALL
chkxer(
'ZHPTRF', infot, nout, lerr, ok )
352 CALL
zhptrf(
'U', -1, a, ip, info )
353 CALL
chkxer(
'ZHPTRF', infot, nout, lerr, ok )
359 CALL
zhptri(
'/', 0, a, ip, w, info )
360 CALL
chkxer(
'ZHPTRI', infot, nout, lerr, ok )
362 CALL
zhptri(
'U', -1, a, ip, w, info )
363 CALL
chkxer(
'ZHPTRI', infot, nout, lerr, ok )
369 CALL
zhptrs(
'/', 0, 0, a, ip,
b, 1, info )
370 CALL
chkxer(
'ZHPTRS', infot, nout, lerr, ok )
372 CALL
zhptrs(
'U', -1, 0, a, ip,
b, 1, info )
373 CALL
chkxer(
'ZHPTRS', infot, nout, lerr, ok )
375 CALL
zhptrs(
'U', 0, -1, a, ip,
b, 1, info )
376 CALL
chkxer(
'ZHPTRS', infot, nout, lerr, ok )
378 CALL
zhptrs(
'U', 2, 1, a, ip,
b, 1, info )
379 CALL
chkxer(
'ZHPTRS', infot, nout, lerr, ok )
385 CALL
zhprfs(
'/', 0, 0, a, af, ip,
b, 1, x, 1, r1, r2, w, r,
387 CALL
chkxer(
'ZHPRFS', infot, nout, lerr, ok )
389 CALL
zhprfs(
'U', -1, 0, a, af, ip,
b, 1, x, 1, r1, r2, w, r,
391 CALL
chkxer(
'ZHPRFS', infot, nout, lerr, ok )
393 CALL
zhprfs(
'U', 0, -1, a, af, ip,
b, 1, x, 1, r1, r2, w, r,
395 CALL
chkxer(
'ZHPRFS', infot, nout, lerr, ok )
397 CALL
zhprfs(
'U', 2, 1, a, af, ip,
b, 1, x, 2, r1, r2, w, r,
399 CALL
chkxer(
'ZHPRFS', infot, nout, lerr, ok )
401 CALL
zhprfs(
'U', 2, 1, a, af, ip,
b, 2, x, 1, r1, r2, w, r,
403 CALL
chkxer(
'ZHPRFS', infot, nout, lerr, ok )
409 CALL
zhpcon(
'/', 0, a, ip, anrm, rcond, w, info )
410 CALL
chkxer(
'ZHPCON', infot, nout, lerr, ok )
412 CALL
zhpcon(
'U', -1, a, ip, anrm, rcond, w, info )
413 CALL
chkxer(
'ZHPCON', infot, nout, lerr, ok )
415 CALL
zhpcon(
'U', 1, a, ip, -anrm, rcond, w, info )
416 CALL
chkxer(
'ZHPCON', infot, nout, lerr, ok )
421 CALL
alaesm( path, ok, nout )