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 )
subroutine zhecon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZHECON
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 zhetf2_rook(UPLO, N, A, LDA, IPIV, INFO)
ZHETF2_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
subroutine zerrhe(PATH, NUNIT)
ZERRHE
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 chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zhptrf(UPLO, N, AP, IPIV, INFO)
ZHPTRF
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 zhetri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRI2
subroutine zhprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZHPRFS
subroutine zhetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF
subroutine zhpcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
ZHPCON
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zhetf2(UPLO, N, A, LDA, IPIV, INFO)
ZHETF2 computes the factorization of a complex Hermitian matrix, using the diagonal pivoting method (...
subroutine zhptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
ZHPTRS
LOGICAL function lsamen(N, CA, CB)
LSAMEN
subroutine zherfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZHERFS
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine zhetri(UPLO, N, A, LDA, IPIV, WORK, INFO)
ZHETRI
subroutine zhptri(UPLO, N, AP, IPIV, WORK, INFO)
ZHPTRI
subroutine zhetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZHETRS
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...