72 parameter ( nmax = 4 )
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'
304 CALL csytrs_rook(
'/', 0, 0, a, 1, ip, b, 1, info )
305 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
307 CALL csytrs_rook(
'U', -1, 0, a, 1, ip, b, 1, info )
308 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
310 CALL csytrs_rook(
'U', 0, -1, a, 1, ip, b, 1, info )
311 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
313 CALL csytrs_rook(
'U', 2, 1, a, 1, ip, b, 2, info )
314 CALL chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
316 CALL csytrs_rook(
'U', 2, 1, a, 2, ip, b, 1, info )
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 csytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
CSYTRI_ROOK
subroutine csyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CSYRFS
subroutine cspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
CSPCON
logical function lsamen(N, CA, CB)
LSAMEN
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine csytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CSYTRS
subroutine csytri(UPLO, N, A, LDA, IPIV, WORK, INFO)
CSYTRI
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
subroutine csptrf(UPLO, N, AP, IPIV, INFO)
CSPTRF
subroutine csptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
CSPTRS
subroutine csytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CSYTRS_ROOK
subroutine csytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF
subroutine csytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF_ROOK
subroutine csycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CSYCON
subroutine csprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CSPRFS
subroutine csptri(UPLO, N, AP, IPIV, WORK, INFO)
CSPTRI
subroutine csycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CSYCON_ROOK
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 csytf2(UPLO, N, A, LDA, IPIV, INFO)
CSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...
subroutine csytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRI2