77 DOUBLE PRECISION anrm, rcond
80 INTEGER ip( nmax ), iw( nmax )
81 DOUBLE PRECISION a( nmax, nmax ), af( nmax, nmax ),
b( nmax ),
82 $ r1( nmax ), r2( nmax ), w( 3*nmax ), x( nmax )
100 COMMON / infoc / infot, nout, ok, lerr
101 COMMON / srnamc / srnamt
109 WRITE( nout, fmt = * )
116 a( i,
j ) = 1.d0 / dble( i+
j )
117 af( i,
j ) = 1.d0 / dble( i+
j )
131 IF(
lsamen( 2, c2,
'SY' ) )
THEN
141 CALL
dsytrf(
'/', 0, a, 1, ip, w, 1, info )
142 CALL
chkxer(
'DSYTRF', infot, nout, lerr, ok )
144 CALL
dsytrf(
'U', -1, a, 1, ip, w, 1, info )
145 CALL
chkxer(
'DSYTRF', infot, nout, lerr, ok )
147 CALL
dsytrf(
'U', 2, a, 1, ip, w, 4, info )
148 CALL
chkxer(
'DSYTRF', infot, nout, lerr, ok )
154 CALL
dsytf2(
'/', 0, a, 1, ip, info )
155 CALL
chkxer(
'DSYTF2', infot, nout, lerr, ok )
157 CALL
dsytf2(
'U', -1, a, 1, ip, info )
158 CALL
chkxer(
'DSYTF2', infot, nout, lerr, ok )
160 CALL
dsytf2(
'U', 2, a, 1, ip, info )
161 CALL
chkxer(
'DSYTF2', infot, nout, lerr, ok )
167 CALL
dsytri(
'/', 0, a, 1, ip, w, info )
168 CALL
chkxer(
'DSYTRI', infot, nout, lerr, ok )
170 CALL
dsytri(
'U', -1, a, 1, ip, w, info )
171 CALL
chkxer(
'DSYTRI', infot, nout, lerr, ok )
173 CALL
dsytri(
'U', 2, a, 1, ip, w, info )
174 CALL
chkxer(
'DSYTRI', infot, nout, lerr, ok )
180 CALL
dsytri2(
'/', 0, a, 1, ip, w, iw(1), info )
181 CALL
chkxer(
'DSYTRI2', infot, nout, lerr, ok )
183 CALL
dsytri2(
'U', -1, a, 1, ip, w, iw(1), info )
184 CALL
chkxer(
'DSYTRI2', infot, nout, lerr, ok )
186 CALL
dsytri2(
'U', 2, a, 1, ip, w, iw(1), info )
187 CALL
chkxer(
'DSYTRI2', infot, nout, lerr, ok )
193 CALL
dsytrs(
'/', 0, 0, a, 1, ip,
b, 1, info )
194 CALL
chkxer(
'DSYTRS', infot, nout, lerr, ok )
196 CALL
dsytrs(
'U', -1, 0, a, 1, ip,
b, 1, info )
197 CALL
chkxer(
'DSYTRS', infot, nout, lerr, ok )
199 CALL
dsytrs(
'U', 0, -1, a, 1, ip,
b, 1, info )
200 CALL
chkxer(
'DSYTRS', infot, nout, lerr, ok )
202 CALL
dsytrs(
'U', 2, 1, a, 1, ip,
b, 2, info )
203 CALL
chkxer(
'DSYTRS', infot, nout, lerr, ok )
205 CALL
dsytrs(
'U', 2, 1, a, 2, ip,
b, 1, info )
206 CALL
chkxer(
'DSYTRS', infot, nout, lerr, ok )
212 CALL
dsyrfs(
'/', 0, 0, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2, w,
214 CALL
chkxer(
'DSYRFS', infot, nout, lerr, ok )
216 CALL
dsyrfs(
'U', -1, 0, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2,
218 CALL
chkxer(
'DSYRFS', infot, nout, lerr, ok )
220 CALL
dsyrfs(
'U', 0, -1, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2,
222 CALL
chkxer(
'DSYRFS', infot, nout, lerr, ok )
224 CALL
dsyrfs(
'U', 2, 1, a, 1, af, 2, ip,
b, 2, x, 2, r1, r2, w,
226 CALL
chkxer(
'DSYRFS', infot, nout, lerr, ok )
228 CALL
dsyrfs(
'U', 2, 1, a, 2, af, 1, ip,
b, 2, x, 2, r1, r2, w,
230 CALL
chkxer(
'DSYRFS', infot, nout, lerr, ok )
232 CALL
dsyrfs(
'U', 2, 1, a, 2, af, 2, ip,
b, 1, x, 2, r1, r2, w,
234 CALL
chkxer(
'DSYRFS', infot, nout, lerr, ok )
236 CALL
dsyrfs(
'U', 2, 1, a, 2, af, 2, ip,
b, 2, x, 1, r1, r2, w,
238 CALL
chkxer(
'DSYRFS', infot, nout, lerr, ok )
244 CALL
dsycon(
'/', 0, a, 1, ip, anrm, rcond, w, iw, info )
245 CALL
chkxer(
'DSYCON', infot, nout, lerr, ok )
247 CALL
dsycon(
'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
248 CALL
chkxer(
'DSYCON', infot, nout, lerr, ok )
250 CALL
dsycon(
'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
251 CALL
chkxer(
'DSYCON', infot, nout, lerr, ok )
253 CALL
dsycon(
'U', 1, a, 1, ip, -1.0d0, rcond, w, iw, info )
254 CALL
chkxer(
'DSYCON', infot, nout, lerr, ok )
256 ELSE IF(
lsamen( 2, c2,
'SR' ) )
THEN
264 srnamt =
'DSYTRF_ROOK'
267 CALL
chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
270 CALL
chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
273 CALL
chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
277 srnamt =
'DSYTF2_ROOK'
280 CALL
chkxer(
'DSYTF2_ROOK', infot, nout, lerr, ok )
283 CALL
chkxer(
'DSYTF2_ROOK', infot, nout, lerr, ok )
286 CALL
chkxer(
'DSYTF2_ROOK', infot, nout, lerr, ok )
290 srnamt =
'DSYTRI_ROOK'
293 CALL
chkxer(
'DSYTRI_ROOK', infot, nout, lerr, ok )
296 CALL
chkxer(
'DSYTRI_ROOK', infot, nout, lerr, ok )
299 CALL
chkxer(
'DSYTRI_ROOK', infot, nout, lerr, ok )
303 srnamt =
'DSYTRS_ROOK'
306 CALL
chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
309 CALL
chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
312 CALL
chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
315 CALL
chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
318 CALL
chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
322 srnamt =
'DSYCON_ROOK'
324 CALL
dsycon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, iw, info )
325 CALL
chkxer(
'DSYCON_ROOK', infot, nout, lerr, ok )
327 CALL
dsycon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
328 CALL
chkxer(
'DSYCON_ROOK', infot, nout, lerr, ok )
330 CALL
dsycon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
331 CALL
chkxer(
'DSYCON_ROOK', infot, nout, lerr, ok )
333 CALL
dsycon_rook(
'U', 1, a, 1, ip, -1.0d0, rcond, w, iw, info)
334 CALL
chkxer(
'DSYCON_ROOK', infot, nout, lerr, ok )
336 ELSE IF(
lsamen( 2, c2,
'SP' ) )
THEN
346 CALL
dsptrf(
'/', 0, a, ip, info )
347 CALL
chkxer(
'DSPTRF', infot, nout, lerr, ok )
349 CALL
dsptrf(
'U', -1, a, ip, info )
350 CALL
chkxer(
'DSPTRF', infot, nout, lerr, ok )
356 CALL
dsptri(
'/', 0, a, ip, w, info )
357 CALL
chkxer(
'DSPTRI', infot, nout, lerr, ok )
359 CALL
dsptri(
'U', -1, a, ip, w, info )
360 CALL
chkxer(
'DSPTRI', infot, nout, lerr, ok )
366 CALL
dsptrs(
'/', 0, 0, a, ip,
b, 1, info )
367 CALL
chkxer(
'DSPTRS', infot, nout, lerr, ok )
369 CALL
dsptrs(
'U', -1, 0, a, ip,
b, 1, info )
370 CALL
chkxer(
'DSPTRS', infot, nout, lerr, ok )
372 CALL
dsptrs(
'U', 0, -1, a, ip,
b, 1, info )
373 CALL
chkxer(
'DSPTRS', infot, nout, lerr, ok )
375 CALL
dsptrs(
'U', 2, 1, a, ip,
b, 1, info )
376 CALL
chkxer(
'DSPTRS', infot, nout, lerr, ok )
382 CALL
dsprfs(
'/', 0, 0, a, af, ip,
b, 1, x, 1, r1, r2, w, iw,
384 CALL
chkxer(
'DSPRFS', infot, nout, lerr, ok )
386 CALL
dsprfs(
'U', -1, 0, a, af, ip,
b, 1, x, 1, r1, r2, w, iw,
388 CALL
chkxer(
'DSPRFS', infot, nout, lerr, ok )
390 CALL
dsprfs(
'U', 0, -1, a, af, ip,
b, 1, x, 1, r1, r2, w, iw,
392 CALL
chkxer(
'DSPRFS', infot, nout, lerr, ok )
394 CALL
dsprfs(
'U', 2, 1, a, af, ip,
b, 1, x, 2, r1, r2, w, iw,
396 CALL
chkxer(
'DSPRFS', infot, nout, lerr, ok )
398 CALL
dsprfs(
'U', 2, 1, a, af, ip,
b, 2, x, 1, r1, r2, w, iw,
400 CALL
chkxer(
'DSPRFS', infot, nout, lerr, ok )
406 CALL
dspcon(
'/', 0, a, ip, anrm, rcond, w, iw, info )
407 CALL
chkxer(
'DSPCON', infot, nout, lerr, ok )
409 CALL
dspcon(
'U', -1, a, ip, anrm, rcond, w, iw, info )
410 CALL
chkxer(
'DSPCON', infot, nout, lerr, ok )
412 CALL
dspcon(
'U', 1, a, ip, -1.0d0, rcond, w, iw, info )
413 CALL
chkxer(
'DSPCON', infot, nout, lerr, ok )
418 CALL
alaesm( path, ok, nout )
subroutine dsptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
DSPTRS
subroutine dsytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DSYTRS_ROOK
subroutine dsycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON
subroutine derrsy(PATH, NUNIT)
DERRSY
subroutine dsyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DSYRFS
subroutine dspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSPCON
subroutine dsytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF_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 dsytf2_rook(UPLO, N, A, LDA, IPIV, INFO)
DSYTF2_ROOK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-...
subroutine dsprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
DSPRFS
subroutine dsptri(UPLO, N, AP, IPIV, WORK, INFO)
DSPTRI
logical function lsamen(N, CA, CB)
LSAMEN
subroutine dsytf2(UPLO, N, A, LDA, IPIV, INFO)
DSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...
subroutine dsytri(UPLO, N, A, LDA, IPIV, WORK, INFO)
DSYTRI
subroutine dsycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
DSYCON_ROOK
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine dsptrf(UPLO, N, AP, IPIV, INFO)
DSPTRF
subroutine dsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRI2
subroutine dsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
DSYTRS
subroutine dsytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
DSYTRI_ROOK
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine dsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF