80 INTEGER i, info,
j, n_err_bnds, nparams
81 DOUBLE PRECISION anrm, rcond, berr
84 INTEGER ip( nmax ), iw( nmax )
85 DOUBLE PRECISION a( nmax, nmax ), af( nmax, nmax ),
b( nmax ),
86 $ r1( nmax ), r2( nmax ), w( 3*nmax ), x( nmax ),
87 $ s( nmax ), err_bnds_n( nmax, 3 ),
88 $ err_bnds_c( nmax, 3 ), params( 1 )
107 COMMON / infoc / infot, nout, ok, lerr
108 COMMON / srnamc / srnamt
116 WRITE( nout, fmt = * )
123 a( i,
j ) = 1.d0 / dble( i+
j )
124 af( i,
j ) = 1.d0 / dble( i+
j )
139 IF(
lsamen( 2, c2,
'SY' ) )
THEN
149 CALL
dsytrf(
'/', 0, a, 1, ip, w, 1, info )
150 CALL
chkxer(
'DSYTRF', infot, nout, lerr, ok )
152 CALL
dsytrf(
'U', -1, a, 1, ip, w, 1, info )
153 CALL
chkxer(
'DSYTRF', infot, nout, lerr, ok )
155 CALL
dsytrf(
'U', 2, a, 1, ip, w, 4, info )
156 CALL
chkxer(
'DSYTRF', infot, nout, lerr, ok )
162 CALL
dsytf2(
'/', 0, a, 1, ip, info )
163 CALL
chkxer(
'DSYTF2', infot, nout, lerr, ok )
165 CALL
dsytf2(
'U', -1, a, 1, ip, info )
166 CALL
chkxer(
'DSYTF2', infot, nout, lerr, ok )
168 CALL
dsytf2(
'U', 2, a, 1, ip, info )
169 CALL
chkxer(
'DSYTF2', infot, nout, lerr, ok )
175 CALL
dsytri(
'/', 0, a, 1, ip, w, info )
176 CALL
chkxer(
'DSYTRI', infot, nout, lerr, ok )
178 CALL
dsytri(
'U', -1, a, 1, ip, w, info )
179 CALL
chkxer(
'DSYTRI', infot, nout, lerr, ok )
181 CALL
dsytri(
'U', 2, a, 1, ip, w, info )
182 CALL
chkxer(
'DSYTRI', infot, nout, lerr, ok )
188 CALL
dsytri2(
'/', 0, a, 1, ip, w, iw, info )
189 CALL
chkxer(
'DSYTRI2', infot, nout, lerr, ok )
191 CALL
dsytri2(
'U', -1, a, 1, ip, w, iw, info )
192 CALL
chkxer(
'DSYTRI2', infot, nout, lerr, ok )
194 CALL
dsytri2(
'U', 2, a, 1, ip, w, iw, info )
195 CALL
chkxer(
'DSYTRI2', infot, nout, lerr, ok )
201 CALL
dsytrs(
'/', 0, 0, a, 1, ip,
b, 1, info )
202 CALL
chkxer(
'DSYTRS', infot, nout, lerr, ok )
204 CALL
dsytrs(
'U', -1, 0, a, 1, ip,
b, 1, info )
205 CALL
chkxer(
'DSYTRS', infot, nout, lerr, ok )
207 CALL
dsytrs(
'U', 0, -1, a, 1, ip,
b, 1, info )
208 CALL
chkxer(
'DSYTRS', infot, nout, lerr, ok )
210 CALL
dsytrs(
'U', 2, 1, a, 1, ip,
b, 2, info )
211 CALL
chkxer(
'DSYTRS', infot, nout, lerr, ok )
213 CALL
dsytrs(
'U', 2, 1, a, 2, ip,
b, 1, info )
214 CALL
chkxer(
'DSYTRS', infot, nout, lerr, ok )
220 CALL
dsyrfs(
'/', 0, 0, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2, w,
222 CALL
chkxer(
'DSYRFS', infot, nout, lerr, ok )
224 CALL
dsyrfs(
'U', -1, 0, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2,
226 CALL
chkxer(
'DSYRFS', infot, nout, lerr, ok )
228 CALL
dsyrfs(
'U', 0, -1, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2,
230 CALL
chkxer(
'DSYRFS', infot, nout, lerr, ok )
232 CALL
dsyrfs(
'U', 2, 1, a, 1, af, 2, ip,
b, 2, x, 2, r1, r2, w,
234 CALL
chkxer(
'DSYRFS', infot, nout, lerr, ok )
236 CALL
dsyrfs(
'U', 2, 1, a, 2, af, 1, ip,
b, 2, x, 2, r1, r2, w,
238 CALL
chkxer(
'DSYRFS', infot, nout, lerr, ok )
240 CALL
dsyrfs(
'U', 2, 1, a, 2, af, 2, ip,
b, 1, x, 2, r1, r2, w,
242 CALL
chkxer(
'DSYRFS', infot, nout, lerr, ok )
244 CALL
dsyrfs(
'U', 2, 1, a, 2, af, 2, ip,
b, 2, x, 1, r1, r2, w,
246 CALL
chkxer(
'DSYRFS', infot, nout, lerr, ok )
254 CALL
dsyrfsx(
'/', eq, 0, 0, a, 1, af, 1, ip, s,
b, 1, x, 1,
255 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
256 $ params, w, iw, info )
257 CALL
chkxer(
'DSYRFSX', infot, nout, lerr, ok )
259 CALL
dsyrfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s,
b, 1, x, 1,
260 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
261 $ params, w, iw, info )
262 CALL
chkxer(
'DSYRFSX', infot, nout, lerr, ok )
265 CALL
dsyrfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s,
b, 1, x, 1,
266 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
267 $ params, w, iw, info )
268 CALL
chkxer(
'DSYRFSX', infot, nout, lerr, ok )
270 CALL
dsyrfsx(
'U', eq, 0, -1, a, 1, af, 1, ip, s,
b, 1, x, 1,
271 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
272 $ params, w, iw, info )
273 CALL
chkxer(
'DSYRFSX', infot, nout, lerr, ok )
275 CALL
dsyrfsx(
'U', eq, 2, 1, a, 1, af, 2, ip, s,
b, 2, x, 2,
276 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
277 $ params, w, iw, info )
278 CALL
chkxer(
'DSYRFSX', infot, nout, lerr, ok )
280 CALL
dsyrfsx(
'U', eq, 2, 1, a, 2, af, 1, ip, s,
b, 2, x, 2,
281 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
282 $ params, w, iw, info )
283 CALL
chkxer(
'DSYRFSX', infot, nout, lerr, ok )
285 CALL
dsyrfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s,
b, 1, x, 2,
286 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
287 $ params, w, iw, info )
288 CALL
chkxer(
'DSYRFSX', infot, nout, lerr, ok )
290 CALL
dsyrfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s,
b, 2, x, 1,
291 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
292 $ params, w, iw, info )
293 CALL
chkxer(
'DSYRFSX', infot, nout, lerr, ok )
299 CALL
dsycon(
'/', 0, a, 1, ip, anrm, rcond, w, iw, info )
300 CALL
chkxer(
'DSYCON', infot, nout, lerr, ok )
302 CALL
dsycon(
'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
303 CALL
chkxer(
'DSYCON', infot, nout, lerr, ok )
305 CALL
dsycon(
'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
306 CALL
chkxer(
'DSYCON', infot, nout, lerr, ok )
308 CALL
dsycon(
'U', 1, a, 1, ip, -1.0d0, rcond, w, iw, info )
309 CALL
chkxer(
'DSYCON', infot, nout, lerr, ok )
311 ELSE IF(
lsamen( 2, c2,
'SR' ) )
THEN
319 srnamt =
'DSYTRF_ROOK'
322 CALL
chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
325 CALL
chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
328 CALL
chkxer(
'DSYTRF_ROOK', infot, nout, lerr, ok )
332 srnamt =
'DSYTF2_ROOK'
335 CALL
chkxer(
'DSYTF2_ROOK', infot, nout, lerr, ok )
338 CALL
chkxer(
'DSYTF2_ROOK', infot, nout, lerr, ok )
341 CALL
chkxer(
'DSYTF2_ROOK', infot, nout, lerr, ok )
345 srnamt =
'DSYTRI_ROOK'
348 CALL
chkxer(
'DSYTRI_ROOK', infot, nout, lerr, ok )
351 CALL
chkxer(
'DSYTRI_ROOK', infot, nout, lerr, ok )
354 CALL
chkxer(
'DSYTRI_ROOK', infot, nout, lerr, ok )
358 srnamt =
'DSYTRS_ROOK'
361 CALL
chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
364 CALL
chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
367 CALL
chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
370 CALL
chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
373 CALL
chkxer(
'DSYTRS_ROOK', infot, nout, lerr, ok )
377 srnamt =
'DSYCON_ROOK'
379 CALL
dsycon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, iw, info )
380 CALL
chkxer(
'DSYCON_ROOK', infot, nout, lerr, ok )
382 CALL
dsycon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
383 CALL
chkxer(
'DSYCON_ROOK', infot, nout, lerr, ok )
385 CALL
dsycon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
386 CALL
chkxer(
'DSYCON_ROOK', infot, nout, lerr, ok )
388 CALL
dsycon_rook(
'U', 1, a, 1, ip, -1.0d0, rcond, w, iw, info)
389 CALL
chkxer(
'DSYCON_ROOK', infot, nout, lerr, ok )
391 ELSE IF(
lsamen( 2, c2,
'SP' ) )
THEN
401 CALL
dsptrf(
'/', 0, a, ip, info )
402 CALL
chkxer(
'DSPTRF', infot, nout, lerr, ok )
404 CALL
dsptrf(
'U', -1, a, ip, info )
405 CALL
chkxer(
'DSPTRF', infot, nout, lerr, ok )
411 CALL
dsptri(
'/', 0, a, ip, w, info )
412 CALL
chkxer(
'DSPTRI', infot, nout, lerr, ok )
414 CALL
dsptri(
'U', -1, a, ip, w, info )
415 CALL
chkxer(
'DSPTRI', infot, nout, lerr, ok )
421 CALL
dsptrs(
'/', 0, 0, a, ip,
b, 1, info )
422 CALL
chkxer(
'DSPTRS', infot, nout, lerr, ok )
424 CALL
dsptrs(
'U', -1, 0, a, ip,
b, 1, info )
425 CALL
chkxer(
'DSPTRS', infot, nout, lerr, ok )
427 CALL
dsptrs(
'U', 0, -1, a, ip,
b, 1, info )
428 CALL
chkxer(
'DSPTRS', infot, nout, lerr, ok )
430 CALL
dsptrs(
'U', 2, 1, a, ip,
b, 1, info )
431 CALL
chkxer(
'DSPTRS', infot, nout, lerr, ok )
437 CALL
dsprfs(
'/', 0, 0, a, af, ip,
b, 1, x, 1, r1, r2, w, iw,
439 CALL
chkxer(
'DSPRFS', infot, nout, lerr, ok )
441 CALL
dsprfs(
'U', -1, 0, a, af, ip,
b, 1, x, 1, r1, r2, w, iw,
443 CALL
chkxer(
'DSPRFS', infot, nout, lerr, ok )
445 CALL
dsprfs(
'U', 0, -1, a, af, ip,
b, 1, x, 1, r1, r2, w, iw,
447 CALL
chkxer(
'DSPRFS', infot, nout, lerr, ok )
449 CALL
dsprfs(
'U', 2, 1, a, af, ip,
b, 1, x, 2, r1, r2, w, iw,
451 CALL
chkxer(
'DSPRFS', infot, nout, lerr, ok )
453 CALL
dsprfs(
'U', 2, 1, a, af, ip,
b, 2, x, 1, r1, r2, w, iw,
455 CALL
chkxer(
'DSPRFS', infot, nout, lerr, ok )
461 CALL
dspcon(
'/', 0, a, ip, anrm, rcond, w, iw, info )
462 CALL
chkxer(
'DSPCON', infot, nout, lerr, ok )
464 CALL
dspcon(
'U', -1, a, ip, anrm, rcond, w, iw, info )
465 CALL
chkxer(
'DSPCON', infot, nout, lerr, ok )
467 CALL
dspcon(
'U', 1, a, ip, -1.0d0, rcond, w, iw, info )
468 CALL
chkxer(
'DSPCON', infot, nout, lerr, ok )
473 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 dsyrfsx(UPLO, EQUED, N, NRHS, A, LDA, AF, LDAF, IPIV, S, B, LDB, X, LDX, RCOND, BERR, N_ERR_BNDS, ERR_BNDS_NORM, ERR_BNDS_COMP, NPARAMS, PARAMS, WORK, IWORK, INFO)
DSYRFSX
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine dsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
DSYTRF