81 REAL r( nmax ), r1( nmax ), r2( nmax )
82 COMPLEX a( nmax, nmax ), af( nmax, nmax ),
b( nmax ),
83 $ w( 2*nmax ),
x( nmax )
101 COMMON / infoc / infot, nout, ok, lerr
102 COMMON / srnamc / srnamt
105 INTRINSIC cmplx, real
110 WRITE( nout, fmt = * )
117 a( i,
j ) = cmplx( 1. /
REAL( I+J ), -1. /
REAL( I+J ) )
118 af( i,
j ) = cmplx( 1. /
REAL( I+J ), -1. /
REAL( I+J ) )
134 IF(
lsamen( 2, c2,
'SY' ) )
THEN
140 CALL
csytrf(
'/', 0, a, 1, ip, w, 1, info )
141 CALL
chkxer(
'CSYTRF', infot, nout, lerr, ok )
143 CALL
csytrf(
'U', -1, a, 1, ip, w, 1, info )
144 CALL
chkxer(
'CSYTRF', infot, nout, lerr, ok )
146 CALL
csytrf(
'U', 2, a, 1, ip, w, 4, info )
147 CALL
chkxer(
'CSYTRF', infot, nout, lerr, ok )
153 CALL
csytf2(
'/', 0, a, 1, ip, info )
154 CALL
chkxer(
'CSYTF2', infot, nout, lerr, ok )
156 CALL
csytf2(
'U', -1, a, 1, ip, info )
157 CALL
chkxer(
'CSYTF2', infot, nout, lerr, ok )
159 CALL
csytf2(
'U', 2, a, 1, ip, info )
160 CALL
chkxer(
'CSYTF2', infot, nout, lerr, ok )
166 CALL
csytri(
'/', 0, a, 1, ip, w, info )
167 CALL
chkxer(
'CSYTRI', infot, nout, lerr, ok )
169 CALL
csytri(
'U', -1, a, 1, ip, w, info )
170 CALL
chkxer(
'CSYTRI', infot, nout, lerr, ok )
172 CALL
csytri(
'U', 2, a, 1, ip, w, info )
173 CALL
chkxer(
'CSYTRI', infot, nout, lerr, ok )
179 CALL
csytri2(
'/', 0, a, 1, ip, w, 1, info )
180 CALL
chkxer(
'CSYTRI2', infot, nout, lerr, ok )
182 CALL
csytri2(
'U', -1, a, 1, ip, w, 1, info )
183 CALL
chkxer(
'CSYTRI2', infot, nout, lerr, ok )
185 CALL
csytri2(
'U', 2, a, 1, ip, w, 1, info )
186 CALL
chkxer(
'CSYTRI2', infot, nout, lerr, ok )
192 CALL
csytrs(
'/', 0, 0, a, 1, ip,
b, 1, info )
193 CALL
chkxer(
'CSYTRS', infot, nout, lerr, ok )
195 CALL
csytrs(
'U', -1, 0, a, 1, ip,
b, 1, info )
196 CALL
chkxer(
'CSYTRS', infot, nout, lerr, ok )
198 CALL
csytrs(
'U', 0, -1, a, 1, ip,
b, 1, info )
199 CALL
chkxer(
'CSYTRS', infot, nout, lerr, ok )
201 CALL
csytrs(
'U', 2, 1, a, 1, ip,
b, 2, info )
202 CALL
chkxer(
'CSYTRS', infot, nout, lerr, ok )
204 CALL
csytrs(
'U', 2, 1, a, 2, ip,
b, 1, info )
205 CALL
chkxer(
'CSYTRS', infot, nout, lerr, ok )
211 CALL
csyrfs(
'/', 0, 0, a, 1, af, 1, ip,
b, 1,
x, 1, r1, r2, w,
213 CALL
chkxer(
'CSYRFS', infot, nout, lerr, ok )
215 CALL
csyrfs(
'U', -1, 0, a, 1, af, 1, ip,
b, 1,
x, 1, r1, r2,
217 CALL
chkxer(
'CSYRFS', infot, nout, lerr, ok )
219 CALL
csyrfs(
'U', 0, -1, a, 1, af, 1, ip,
b, 1,
x, 1, r1, r2,
221 CALL
chkxer(
'CSYRFS', infot, nout, lerr, ok )
223 CALL
csyrfs(
'U', 2, 1, a, 1, af, 2, ip,
b, 2,
x, 2, r1, r2, w,
225 CALL
chkxer(
'CSYRFS', infot, nout, lerr, ok )
227 CALL
csyrfs(
'U', 2, 1, a, 2, af, 1, ip,
b, 2,
x, 2, r1, r2, w,
229 CALL
chkxer(
'CSYRFS', infot, nout, lerr, ok )
231 CALL
csyrfs(
'U', 2, 1, a, 2, af, 2, ip,
b, 1,
x, 2, r1, r2, w,
233 CALL
chkxer(
'CSYRFS', infot, nout, lerr, ok )
235 CALL
csyrfs(
'U', 2, 1, a, 2, af, 2, ip,
b, 2,
x, 1, r1, r2, w,
237 CALL
chkxer(
'CSYRFS', infot, nout, lerr, ok )
243 CALL
csycon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
244 CALL
chkxer(
'CSYCON', infot, nout, lerr, ok )
246 CALL
csycon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
247 CALL
chkxer(
'CSYCON', infot, nout, lerr, ok )
249 CALL
csycon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
250 CALL
chkxer(
'CSYCON', infot, nout, lerr, ok )
252 CALL
csycon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
253 CALL
chkxer(
'CSYCON', infot, nout, lerr, ok )
259 ELSE IF(
lsamen( 2, c2,
'SR' ) )
THEN
263 srnamt =
'CSYTRF_ROOK'
266 CALL
chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
269 CALL
chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
272 CALL
chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
276 srnamt =
'CSYTF2_ROOK'
279 CALL
chkxer(
'CSYTF2_ROOK', infot, nout, lerr, ok )
282 CALL
chkxer(
'CSYTF2_ROOK', infot, nout, lerr, ok )
285 CALL
chkxer(
'CSYTF2_ROOK', infot, nout, lerr, ok )
289 srnamt =
'CSYTRI_ROOK'
292 CALL
chkxer(
'CSYTRI_ROOK', infot, nout, lerr, ok )
295 CALL
chkxer(
'CSYTRI_ROOK', infot, nout, lerr, ok )
298 CALL
chkxer(
'CSYTRI_ROOK', infot, nout, lerr, ok )
302 srnamt =
'CSYTRS_ROOK'
305 CALL
chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
308 CALL
chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
311 CALL
chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
314 CALL
chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
317 CALL
chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
321 srnamt =
'CSYCON_ROOK'
323 CALL
csycon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
324 CALL
chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
326 CALL
csycon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
327 CALL
chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
329 CALL
csycon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, info )
330 CALL
chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
332 CALL
csycon_rook(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
333 CALL
chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
339 ELSE IF(
lsamen( 2, c2,
'SP' ) )
THEN
345 CALL
csptrf(
'/', 0, a, ip, info )
346 CALL
chkxer(
'CSPTRF', infot, nout, lerr, ok )
348 CALL
csptrf(
'U', -1, a, ip, info )
349 CALL
chkxer(
'CSPTRF', infot, nout, lerr, ok )
355 CALL
csptri(
'/', 0, a, ip, w, info )
356 CALL
chkxer(
'CSPTRI', infot, nout, lerr, ok )
358 CALL
csptri(
'U', -1, a, ip, w, info )
359 CALL
chkxer(
'CSPTRI', infot, nout, lerr, ok )
365 CALL
csptrs(
'/', 0, 0, a, ip,
b, 1, info )
366 CALL
chkxer(
'CSPTRS', infot, nout, lerr, ok )
368 CALL
csptrs(
'U', -1, 0, a, ip,
b, 1, info )
369 CALL
chkxer(
'CSPTRS', infot, nout, lerr, ok )
371 CALL
csptrs(
'U', 0, -1, a, ip,
b, 1, info )
372 CALL
chkxer(
'CSPTRS', infot, nout, lerr, ok )
374 CALL
csptrs(
'U', 2, 1, a, ip,
b, 1, info )
375 CALL
chkxer(
'CSPTRS', infot, nout, lerr, ok )
381 CALL
csprfs(
'/', 0, 0, a, af, ip,
b, 1,
x, 1, r1, r2, w, r,
383 CALL
chkxer(
'CSPRFS', infot, nout, lerr, ok )
385 CALL
csprfs(
'U', -1, 0, a, af, ip,
b, 1,
x, 1, r1, r2, w, r,
387 CALL
chkxer(
'CSPRFS', infot, nout, lerr, ok )
389 CALL
csprfs(
'U', 0, -1, a, af, ip,
b, 1,
x, 1, r1, r2, w, r,
391 CALL
chkxer(
'CSPRFS', infot, nout, lerr, ok )
393 CALL
csprfs(
'U', 2, 1, a, af, ip,
b, 1,
x, 2, r1, r2, w, r,
395 CALL
chkxer(
'CSPRFS', infot, nout, lerr, ok )
397 CALL
csprfs(
'U', 2, 1, a, af, ip,
b, 2,
x, 1, r1, r2, w, r,
399 CALL
chkxer(
'CSPRFS', infot, nout, lerr, ok )
405 CALL
cspcon(
'/', 0, a, ip, anrm, rcond, w, info )
406 CALL
chkxer(
'CSPCON', infot, nout, lerr, ok )
408 CALL
cspcon(
'U', -1, a, ip, anrm, rcond, w, info )
409 CALL
chkxer(
'CSPCON', infot, nout, lerr, ok )
411 CALL
cspcon(
'U', 1, a, ip, -anrm, rcond, w, info )
412 CALL
chkxer(
'CSPCON', infot, nout, lerr, ok )
417 CALL
alaesm( path, ok, nout )
subroutine csptrf(UPLO, N, AP, IPIV, INFO)
CSPTRF
subroutine csytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF_ROOK
subroutine csytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CSYTRS_ROOK
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 cspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
CSPCON
subroutine cerrsy(PATH, NUNIT)
CERRSY
subroutine csprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CSPRFS
subroutine csptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
CSPTRS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine csyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CSYRFS
subroutine csptri(UPLO, N, AP, IPIV, WORK, INFO)
CSPTRI
subroutine csytri(UPLO, N, A, LDA, IPIV, WORK, INFO)
CSYTRI
subroutine csytf2(UPLO, N, A, LDA, IPIV, INFO)
CSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...
LOGICAL function lsamen(N, CA, CB)
LSAMEN
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine csytf2_rook(UPLO, N, A, LDA, IPIV, INFO)
CSYTF2_ROOK computes the factorization of a complex symmetric indefinite matrix using the bounded Bun...
subroutine csytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CSYTRS
subroutine csytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF
subroutine csycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CSYCON
subroutine csytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
CSYTRI_ROOK
subroutine csytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRI2
subroutine csycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CSYCON_ROOK