73 parameter ( nmax = 4 )
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'
308 CALL zhetrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
309 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
311 CALL zhetrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
312 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
314 CALL zhetrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
315 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
317 CALL zhetrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
318 CALL chkxer(
'ZHETRS_ROOK', infot, nout, lerr, ok )
320 CALL zhetrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
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 )
subroutine zhetri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRI2
subroutine zherfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZHERFS
subroutine zhptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
ZHPTRS
subroutine zhetrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
subroutine zhprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZHPRFS
subroutine zhetf2(UPLO, N, A, LDA, IPIV, INFO)
ZHETF2 computes the factorization of a complex Hermitian matrix, using the diagonal pivoting method (...
logical function lsamen(N, CA, CB)
LSAMEN
subroutine zhecon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZHECON_ROOK estimates the reciprocal of the condition number fort HE matrices using factorization obt...
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine zhptrf(UPLO, N, AP, IPIV, INFO)
ZHPTRF
subroutine zhptri(UPLO, N, AP, IPIV, WORK, INFO)
ZHPTRI
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine zhetri(UPLO, N, A, LDA, IPIV, WORK, INFO)
ZHETRI
subroutine zhetri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
ZHETRI_ROOK computes the inverse of HE matrix using the factorization obtained with the bounded Bunch...
subroutine zhetf2_rook(UPLO, N, A, LDA, IPIV, INFO)
ZHETF2_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
subroutine zhetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF
subroutine zhpcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
ZHPCON
subroutine zhetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZHETRS
subroutine zhetrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZHETRS_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using fac...
subroutine zhecon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZHECON