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 )