80 INTEGER i, info,
j, n_err_bnds, nparams
81 REAL anrm, rcond, berr
84 INTEGER ip( nmax ), iw( nmax )
85 REAL 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. /
REAL( i+
j )
124 af( i,
j ) = 1. /
REAL( i+
j )
139 IF(
lsamen( 2, c2,
'SY' ) )
THEN
149 CALL
ssytrf(
'/', 0, a, 1, ip, w, 1, info )
150 CALL
chkxer(
'SSYTRF', infot, nout, lerr, ok )
152 CALL
ssytrf(
'U', -1, a, 1, ip, w, 1, info )
153 CALL
chkxer(
'SSYTRF', infot, nout, lerr, ok )
155 CALL
ssytrf(
'U', 2, a, 1, ip, w, 4, info )
156 CALL
chkxer(
'SSYTRF', infot, nout, lerr, ok )
162 CALL
ssytf2(
'/', 0, a, 1, ip, info )
163 CALL
chkxer(
'SSYTF2', infot, nout, lerr, ok )
165 CALL
ssytf2(
'U', -1, a, 1, ip, info )
166 CALL
chkxer(
'SSYTF2', infot, nout, lerr, ok )
168 CALL
ssytf2(
'U', 2, a, 1, ip, info )
169 CALL
chkxer(
'SSYTF2', infot, nout, lerr, ok )
175 CALL
ssytri(
'/', 0, a, 1, ip, w, info )
176 CALL
chkxer(
'SSYTRI', infot, nout, lerr, ok )
178 CALL
ssytri(
'U', -1, a, 1, ip, w, info )
179 CALL
chkxer(
'SSYTRI', infot, nout, lerr, ok )
181 CALL
ssytri(
'U', 2, a, 1, ip, w, info )
182 CALL
chkxer(
'SSYTRI', infot, nout, lerr, ok )
188 CALL
ssytri2(
'/', 0, a, 1, ip, w, iw, info )
189 CALL
chkxer(
'SSYTRI', infot, nout, lerr, ok )
191 CALL
ssytri2(
'U', -1, a, 1, ip, w, iw, info )
192 CALL
chkxer(
'SSYTRI', infot, nout, lerr, ok )
194 CALL
ssytri2(
'U', 2, a, 1, ip, w, iw, info )
195 CALL
chkxer(
'SSYTRI', infot, nout, lerr, ok )
201 CALL
ssytrs(
'/', 0, 0, a, 1, ip,
b, 1, info )
202 CALL
chkxer(
'SSYTRS', infot, nout, lerr, ok )
204 CALL
ssytrs(
'U', -1, 0, a, 1, ip,
b, 1, info )
205 CALL
chkxer(
'SSYTRS', infot, nout, lerr, ok )
207 CALL
ssytrs(
'U', 0, -1, a, 1, ip,
b, 1, info )
208 CALL
chkxer(
'SSYTRS', infot, nout, lerr, ok )
210 CALL
ssytrs(
'U', 2, 1, a, 1, ip,
b, 2, info )
211 CALL
chkxer(
'SSYTRS', infot, nout, lerr, ok )
213 CALL
ssytrs(
'U', 2, 1, a, 2, ip,
b, 1, info )
214 CALL
chkxer(
'SSYTRS', infot, nout, lerr, ok )
220 CALL
ssyrfs(
'/', 0, 0, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2, w,
222 CALL
chkxer(
'SSYRFS', infot, nout, lerr, ok )
224 CALL
ssyrfs(
'U', -1, 0, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2,
226 CALL
chkxer(
'SSYRFS', infot, nout, lerr, ok )
228 CALL
ssyrfs(
'U', 0, -1, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2,
230 CALL
chkxer(
'SSYRFS', infot, nout, lerr, ok )
232 CALL
ssyrfs(
'U', 2, 1, a, 1, af, 2, ip,
b, 2, x, 2, r1, r2, w,
234 CALL
chkxer(
'SSYRFS', infot, nout, lerr, ok )
236 CALL
ssyrfs(
'U', 2, 1, a, 2, af, 1, ip,
b, 2, x, 2, r1, r2, w,
238 CALL
chkxer(
'SSYRFS', infot, nout, lerr, ok )
240 CALL
ssyrfs(
'U', 2, 1, a, 2, af, 2, ip,
b, 1, x, 2, r1, r2, w,
242 CALL
chkxer(
'SSYRFS', infot, nout, lerr, ok )
244 CALL
ssyrfs(
'U', 2, 1, a, 2, af, 2, ip,
b, 2, x, 1, r1, r2, w,
246 CALL
chkxer(
'SSYRFS', infot, nout, lerr, ok )
254 CALL
ssyrfsx(
'/', 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(
'SSYRFSX', infot, nout, lerr, ok )
259 CALL
ssyrfsx(
'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(
'SSYRFSX', infot, nout, lerr, ok )
265 CALL
ssyrfsx(
'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(
'SSYRFSX', infot, nout, lerr, ok )
270 CALL
ssyrfsx(
'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(
'SSYRFSX', infot, nout, lerr, ok )
275 CALL
ssyrfsx(
'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(
'SSYRFSX', infot, nout, lerr, ok )
280 CALL
ssyrfsx(
'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(
'SSYRFSX', infot, nout, lerr, ok )
285 CALL
ssyrfsx(
'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(
'SSYRFSX', infot, nout, lerr, ok )
290 CALL
ssyrfsx(
'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(
'SSYRFSX', infot, nout, lerr, ok )
299 CALL
ssycon(
'/', 0, a, 1, ip, anrm, rcond, w, iw, info )
300 CALL
chkxer(
'SSYCON', infot, nout, lerr, ok )
302 CALL
ssycon(
'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
303 CALL
chkxer(
'SSYCON', infot, nout, lerr, ok )
305 CALL
ssycon(
'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
306 CALL
chkxer(
'SSYCON', infot, nout, lerr, ok )
308 CALL
ssycon(
'U', 1, a, 1, ip, -1.0, rcond, w, iw, info )
309 CALL
chkxer(
'SSYCON', infot, nout, lerr, ok )
311 ELSE IF(
lsamen( 2, c2,
'SR' ) )
THEN
319 srnamt =
'SSYTRF_ROOK'
322 CALL
chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
325 CALL
chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
328 CALL
chkxer(
'SSYTRF_ROOK', infot, nout, lerr, ok )
332 srnamt =
'SSYTF2_ROOK'
335 CALL
chkxer(
'SSYTF2_ROOK', infot, nout, lerr, ok )
338 CALL
chkxer(
'SSYTF2_ROOK', infot, nout, lerr, ok )
341 CALL
chkxer(
'SSYTF2_ROOK', infot, nout, lerr, ok )
345 srnamt =
'SSYTRI_ROOK'
348 CALL
chkxer(
'SSYTRI_ROOK', infot, nout, lerr, ok )
351 CALL
chkxer(
'SSYTRI_ROOK', infot, nout, lerr, ok )
354 CALL
chkxer(
'SSYTRI_ROOK', infot, nout, lerr, ok )
358 srnamt =
'SSYTRS_ROOK'
361 CALL
chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
364 CALL
chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
367 CALL
chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
370 CALL
chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
373 CALL
chkxer(
'SSYTRS_ROOK', infot, nout, lerr, ok )
377 srnamt =
'SSYCON_ROOK'
379 CALL
ssycon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, iw, info )
380 CALL
chkxer(
'SSYCON_ROOK', infot, nout, lerr, ok )
382 CALL
ssycon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, iw, info )
383 CALL
chkxer(
'SSYCON_ROOK', infot, nout, lerr, ok )
385 CALL
ssycon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, iw, info )
386 CALL
chkxer(
'SSYCON_ROOK', infot, nout, lerr, ok )
388 CALL
ssycon_rook(
'U', 1, a, 1, ip, -1.0, rcond, w, iw, info )
389 CALL
chkxer(
'SSYCON_ROOK', infot, nout, lerr, ok )
395 ELSE IF(
lsamen( 2, c2,
'SP' ) )
THEN
401 CALL
ssptrf(
'/', 0, a, ip, info )
402 CALL
chkxer(
'SSPTRF', infot, nout, lerr, ok )
404 CALL
ssptrf(
'U', -1, a, ip, info )
405 CALL
chkxer(
'SSPTRF', infot, nout, lerr, ok )
411 CALL
ssptri(
'/', 0, a, ip, w, info )
412 CALL
chkxer(
'SSPTRI', infot, nout, lerr, ok )
414 CALL
ssptri(
'U', -1, a, ip, w, info )
415 CALL
chkxer(
'SSPTRI', infot, nout, lerr, ok )
421 CALL
ssptrs(
'/', 0, 0, a, ip,
b, 1, info )
422 CALL
chkxer(
'SSPTRS', infot, nout, lerr, ok )
424 CALL
ssptrs(
'U', -1, 0, a, ip,
b, 1, info )
425 CALL
chkxer(
'SSPTRS', infot, nout, lerr, ok )
427 CALL
ssptrs(
'U', 0, -1, a, ip,
b, 1, info )
428 CALL
chkxer(
'SSPTRS', infot, nout, lerr, ok )
430 CALL
ssptrs(
'U', 2, 1, a, ip,
b, 1, info )
431 CALL
chkxer(
'SSPTRS', infot, nout, lerr, ok )
437 CALL
ssprfs(
'/', 0, 0, a, af, ip,
b, 1, x, 1, r1, r2, w, iw,
439 CALL
chkxer(
'SSPRFS', infot, nout, lerr, ok )
441 CALL
ssprfs(
'U', -1, 0, a, af, ip,
b, 1, x, 1, r1, r2, w, iw,
443 CALL
chkxer(
'SSPRFS', infot, nout, lerr, ok )
445 CALL
ssprfs(
'U', 0, -1, a, af, ip,
b, 1, x, 1, r1, r2, w, iw,
447 CALL
chkxer(
'SSPRFS', infot, nout, lerr, ok )
449 CALL
ssprfs(
'U', 2, 1, a, af, ip,
b, 1, x, 2, r1, r2, w, iw,
451 CALL
chkxer(
'SSPRFS', infot, nout, lerr, ok )
453 CALL
ssprfs(
'U', 2, 1, a, af, ip,
b, 2, x, 1, r1, r2, w, iw,
455 CALL
chkxer(
'SSPRFS', infot, nout, lerr, ok )
461 CALL
sspcon(
'/', 0, a, ip, anrm, rcond, w, iw, info )
462 CALL
chkxer(
'SSPCON', infot, nout, lerr, ok )
464 CALL
sspcon(
'U', -1, a, ip, anrm, rcond, w, iw, info )
465 CALL
chkxer(
'SSPCON', infot, nout, lerr, ok )
467 CALL
sspcon(
'U', 1, a, ip, -1.0, rcond, w, iw, info )
468 CALL
chkxer(
'SSPCON', infot, nout, lerr, ok )
473 CALL
alaesm( path, ok, nout )
subroutine ssytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRF_ROOK
subroutine ssytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SSYTRS_ROOK
subroutine ssytf2(UPLO, N, A, LDA, IPIV, INFO)
SSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...
subroutine ssycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SSYCON_ROOK
subroutine ssprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SSPRFS
subroutine ssptri(UPLO, N, AP, IPIV, WORK, INFO)
SSPTRI
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 serrsy(PATH, NUNIT)
SERRSY
subroutine ssytf2_rook(UPLO, N, A, LDA, IPIV, INFO)
SSYTF2_ROOK computes the factorization of a real symmetric indefinite matrix using the bounded Bunch-...
subroutine ssyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SSYRFS
logical function lsamen(N, CA, CB)
LSAMEN
subroutine ssptrf(UPLO, N, AP, IPIV, INFO)
SSPTRF
subroutine ssytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRF
subroutine ssytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
SSYTRS
subroutine ssyrfsx(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)
SSYRFSX
subroutine ssytri(UPLO, N, A, LDA, IPIV, WORK, INFO)
SSYTRI
subroutine sspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SSPCON
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine alaesm(PATH, OK, NOUT)
ALAESM
subroutine ssptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
SSPTRS
subroutine ssytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
SSYTRI2
subroutine ssycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, IWORK, INFO)
SSYCON
subroutine ssytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
SSYTRI_ROOK