59 SUBROUTINE derrpo( PATH, NUNIT )
80 INTEGER I, INFO, J, N_ERR_BNDS, NPARAMS
81 DOUBLE PRECISION ANRM, RCOND, BERR
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 )
106 COMMON / infoc / infot, nout, ok, lerr
107 COMMON / srnamc / srnamt
115 WRITE( nout, fmt = * )
122 a( i, j ) = 1.d0 / dble( i+j )
123 af( i, j ) = 1.d0 / dble( i+j )
135 IF( lsamen( 2, c2,
'PO' ) )
THEN
144 CALL dpotrf(
'/', 0, a, 1, info )
145 CALL chkxer(
'DPOTRF', infot, nout, lerr, ok )
147 CALL dpotrf(
'U', -1, a, 1, info )
148 CALL chkxer(
'DPOTRF', infot, nout, lerr, ok )
150 CALL dpotrf(
'U', 2, a, 1, info )
151 CALL chkxer(
'DPOTRF', infot, nout, lerr, ok )
157 CALL dpotf2(
'/', 0, a, 1, info )
158 CALL chkxer(
'DPOTF2', infot, nout, lerr, ok )
160 CALL dpotf2(
'U', -1, a, 1, info )
161 CALL chkxer(
'DPOTF2', infot, nout, lerr, ok )
163 CALL dpotf2(
'U', 2, a, 1, info )
164 CALL chkxer(
'DPOTF2', infot, nout, lerr, ok )
170 CALL dpotri(
'/', 0, a, 1, info )
171 CALL chkxer(
'DPOTRI', infot, nout, lerr, ok )
173 CALL dpotri(
'U', -1, a, 1, info )
174 CALL chkxer(
'DPOTRI', infot, nout, lerr, ok )
176 CALL dpotri(
'U', 2, a, 1, info )
177 CALL chkxer(
'DPOTRI', infot, nout, lerr, ok )
183 CALL dpotrs(
'/', 0, 0, a, 1, b, 1, info )
184 CALL chkxer(
'DPOTRS', infot, nout, lerr, ok )
186 CALL dpotrs(
'U', -1, 0, a, 1, b, 1, info )
187 CALL chkxer(
'DPOTRS', infot, nout, lerr, ok )
189 CALL dpotrs(
'U', 0, -1, a, 1, b, 1, info )
190 CALL chkxer(
'DPOTRS', infot, nout, lerr, ok )
192 CALL dpotrs(
'U', 2, 1, a, 1, b, 2, info )
193 CALL chkxer(
'DPOTRS', infot, nout, lerr, ok )
195 CALL dpotrs(
'U', 2, 1, a, 2, b, 1, info )
196 CALL chkxer(
'DPOTRS', infot, nout, lerr, ok )
202 CALL dporfs(
'/', 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w, iw,
204 CALL chkxer(
'DPORFS', infot, nout, lerr, ok )
206 CALL dporfs(
'U', -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
208 CALL chkxer(
'DPORFS', infot, nout, lerr, ok )
210 CALL dporfs(
'U', 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
212 CALL chkxer(
'DPORFS', infot, nout, lerr, ok )
214 CALL dporfs(
'U', 2, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w, iw,
216 CALL chkxer(
'DPORFS', infot, nout, lerr, ok )
218 CALL dporfs(
'U', 2, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w, iw,
220 CALL chkxer(
'DPORFS', infot, nout, lerr, ok )
222 CALL dporfs(
'U', 2, 1, a, 2, af, 2, b, 1, x, 2, r1, r2, w, iw,
224 CALL chkxer(
'DPORFS', infot, nout, lerr, ok )
226 CALL dporfs(
'U', 2, 1, a, 2, af, 2, b, 2, x, 1, r1, r2, w, iw,
228 CALL chkxer(
'DPORFS', infot, nout, lerr, ok )
236 CALL dporfsx(
'/', eq, 0, 0, a, 1, af, 1, s, b, 1, x, 1,
237 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
238 $ params, w, iw, info )
239 CALL chkxer(
'DPORFSX', infot, nout, lerr, ok )
241 CALL dporfsx(
'U',
"/", -1, 0, a, 1, af, 1, s, b, 1, x, 1,
242 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
243 $ params, w, iw, info )
244 CALL chkxer(
'DPORFSX', infot, nout, lerr, ok )
247 CALL dporfsx(
'U', eq, -1, 0, a, 1, af, 1, s, b, 1, x, 1,
248 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
249 $ params, w, iw, info )
250 CALL chkxer(
'DPORFSX', infot, nout, lerr, ok )
252 CALL dporfsx(
'U', eq, 0, -1, a, 1, af, 1, s, b, 1, x, 1,
253 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
254 $ params, w, iw, info )
255 CALL chkxer(
'DPORFSX', infot, nout, lerr, ok )
257 CALL dporfsx(
'U', eq, 2, 1, a, 1, af, 2, s, b, 2, x, 2,
258 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
259 $ params, w, iw, info )
260 CALL chkxer(
'DPORFSX', infot, nout, lerr, ok )
262 CALL dporfsx(
'U', eq, 2, 1, a, 2, af, 1, s, b, 2, x, 2,
263 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
264 $ params, w, iw, info )
265 CALL chkxer(
'DPORFSX', infot, nout, lerr, ok )
267 CALL dporfsx(
'U', eq, 2, 1, a, 2, af, 2, s, b, 1, x, 2,
268 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
269 $ params, w, iw, info )
270 CALL chkxer(
'DPORFSX', infot, nout, lerr, ok )
272 CALL dporfsx(
'U', eq, 2, 1, a, 2, af, 2, s, b, 2, x, 1,
273 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
274 $ params, w, iw, info )
275 CALL chkxer(
'DPORFSX', infot, nout, lerr, ok )
281 CALL dpocon(
'/', 0, a, 1, anrm, rcond, w, iw, info )
282 CALL chkxer(
'DPOCON', infot, nout, lerr, ok )
284 CALL dpocon(
'U', -1, a, 1, anrm, rcond, w, iw, info )
285 CALL chkxer(
'DPOCON', infot, nout, lerr, ok )
287 CALL dpocon(
'U', 2, a, 1, anrm, rcond, w, iw, info )
288 CALL chkxer(
'DPOCON', infot, nout, lerr, ok )
294 CALL dpoequ( -1, a, 1, r1, rcond, anrm, info )
295 CALL chkxer(
'DPOEQU', infot, nout, lerr, ok )
297 CALL dpoequ( 2, a, 1, r1, rcond, anrm, info )
298 CALL chkxer(
'DPOEQU', infot, nout, lerr, ok )
304 CALL dpoequb( -1, a, 1, r1, rcond, anrm, info )
305 CALL chkxer(
'DPOEQUB', infot, nout, lerr, ok )
307 CALL dpoequb( 2, a, 1, r1, rcond, anrm, info )
308 CALL chkxer(
'DPOEQUB', infot, nout, lerr, ok )
310 ELSE IF( lsamen( 2, c2,
'PP' ) )
THEN
319 CALL dpptrf(
'/', 0, a, info )
320 CALL chkxer(
'DPPTRF', infot, nout, lerr, ok )
322 CALL dpptrf(
'U', -1, a, info )
323 CALL chkxer(
'DPPTRF', infot, nout, lerr, ok )
329 CALL dpptri(
'/', 0, a, info )
330 CALL chkxer(
'DPPTRI', infot, nout, lerr, ok )
332 CALL dpptri(
'U', -1, a, info )
333 CALL chkxer(
'DPPTRI', infot, nout, lerr, ok )
339 CALL dpptrs(
'/', 0, 0, a, b, 1, info )
340 CALL chkxer(
'DPPTRS', infot, nout, lerr, ok )
342 CALL dpptrs(
'U', -1, 0, a, b, 1, info )
343 CALL chkxer(
'DPPTRS', infot, nout, lerr, ok )
345 CALL dpptrs(
'U', 0, -1, a, b, 1, info )
346 CALL chkxer(
'DPPTRS', infot, nout, lerr, ok )
348 CALL dpptrs(
'U', 2, 1, a, b, 1, info )
349 CALL chkxer(
'DPPTRS', infot, nout, lerr, ok )
355 CALL dpprfs(
'/', 0, 0, a, af, b, 1, x, 1, r1, r2, w, iw,
357 CALL chkxer(
'DPPRFS', infot, nout, lerr, ok )
359 CALL dpprfs(
'U', -1, 0, a, af, b, 1, x, 1, r1, r2, w, iw,
361 CALL chkxer(
'DPPRFS', infot, nout, lerr, ok )
363 CALL dpprfs(
'U', 0, -1, a, af, b, 1, x, 1, r1, r2, w, iw,
365 CALL chkxer(
'DPPRFS', infot, nout, lerr, ok )
367 CALL dpprfs(
'U', 2, 1, a, af, b, 1, x, 2, r1, r2, w, iw,
369 CALL chkxer(
'DPPRFS', infot, nout, lerr, ok )
371 CALL dpprfs(
'U', 2, 1, a, af, b, 2, x, 1, r1, r2, w, iw,
373 CALL chkxer(
'DPPRFS', infot, nout, lerr, ok )
379 CALL dppcon(
'/', 0, a, anrm, rcond, w, iw, info )
380 CALL chkxer(
'DPPCON', infot, nout, lerr, ok )
382 CALL dppcon(
'U', -1, a, anrm, rcond, w, iw, info )
383 CALL chkxer(
'DPPCON', infot, nout, lerr, ok )
389 CALL dppequ(
'/', 0, a, r1, rcond, anrm, info )
390 CALL chkxer(
'DPPEQU', infot, nout, lerr, ok )
392 CALL dppequ(
'U', -1, a, r1, rcond, anrm, info )
393 CALL chkxer(
'DPPEQU', infot, nout, lerr, ok )
395 ELSE IF( lsamen( 2, c2,
'PB' ) )
THEN
404 CALL dpbtrf(
'/', 0, 0, a, 1, info )
405 CALL chkxer(
'DPBTRF', infot, nout, lerr, ok )
407 CALL dpbtrf(
'U', -1, 0, a, 1, info )
408 CALL chkxer(
'DPBTRF', infot, nout, lerr, ok )
410 CALL dpbtrf(
'U', 1, -1, a, 1, info )
411 CALL chkxer(
'DPBTRF', infot, nout, lerr, ok )
413 CALL dpbtrf(
'U', 2, 1, a, 1, info )
414 CALL chkxer(
'DPBTRF', infot, nout, lerr, ok )
420 CALL dpbtf2(
'/', 0, 0, a, 1, info )
421 CALL chkxer(
'DPBTF2', infot, nout, lerr, ok )
423 CALL dpbtf2(
'U', -1, 0, a, 1, info )
424 CALL chkxer(
'DPBTF2', infot, nout, lerr, ok )
426 CALL dpbtf2(
'U', 1, -1, a, 1, info )
427 CALL chkxer(
'DPBTF2', infot, nout, lerr, ok )
429 CALL dpbtf2(
'U', 2, 1, a, 1, info )
430 CALL chkxer(
'DPBTF2', infot, nout, lerr, ok )
436 CALL dpbtrs(
'/', 0, 0, 0, a, 1, b, 1, info )
437 CALL chkxer(
'DPBTRS', infot, nout, lerr, ok )
439 CALL dpbtrs(
'U', -1, 0, 0, a, 1, b, 1, info )
440 CALL chkxer(
'DPBTRS', infot, nout, lerr, ok )
442 CALL dpbtrs(
'U', 1, -1, 0, a, 1, b, 1, info )
443 CALL chkxer(
'DPBTRS', infot, nout, lerr, ok )
445 CALL dpbtrs(
'U', 0, 0, -1, a, 1, b, 1, info )
446 CALL chkxer(
'DPBTRS', infot, nout, lerr, ok )
448 CALL dpbtrs(
'U', 2, 1, 1, a, 1, b, 1, info )
449 CALL chkxer(
'DPBTRS', infot, nout, lerr, ok )
451 CALL dpbtrs(
'U', 2, 0, 1, a, 1, b, 1, info )
452 CALL chkxer(
'DPBTRS', infot, nout, lerr, ok )
458 CALL dpbrfs(
'/', 0, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
460 CALL chkxer(
'DPBRFS', infot, nout, lerr, ok )
462 CALL dpbrfs(
'U', -1, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
464 CALL chkxer(
'DPBRFS', infot, nout, lerr, ok )
466 CALL dpbrfs(
'U', 1, -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
468 CALL chkxer(
'DPBRFS', infot, nout, lerr, ok )
470 CALL dpbrfs(
'U', 0, 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
472 CALL chkxer(
'DPBRFS', infot, nout, lerr, ok )
474 CALL dpbrfs(
'U', 2, 1, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w,
476 CALL chkxer(
'DPBRFS', infot, nout, lerr, ok )
478 CALL dpbrfs(
'U', 2, 1, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w,
480 CALL chkxer(
'DPBRFS', infot, nout, lerr, ok )
482 CALL dpbrfs(
'U', 2, 0, 1, a, 1, af, 1, b, 1, x, 2, r1, r2, w,
484 CALL chkxer(
'DPBRFS', infot, nout, lerr, ok )
486 CALL dpbrfs(
'U', 2, 0, 1, a, 1, af, 1, b, 2, x, 1, r1, r2, w,
488 CALL chkxer(
'DPBRFS', infot, nout, lerr, ok )
494 CALL dpbcon(
'/', 0, 0, a, 1, anrm, rcond, w, iw, info )
495 CALL chkxer(
'DPBCON', infot, nout, lerr, ok )
497 CALL dpbcon(
'U', -1, 0, a, 1, anrm, rcond, w, iw, info )
498 CALL chkxer(
'DPBCON', infot, nout, lerr, ok )
500 CALL dpbcon(
'U', 1, -1, a, 1, anrm, rcond, w, iw, info )
501 CALL chkxer(
'DPBCON', infot, nout, lerr, ok )
503 CALL dpbcon(
'U', 2, 1, a, 1, anrm, rcond, w, iw, info )
504 CALL chkxer(
'DPBCON', infot, nout, lerr, ok )
510 CALL dpbequ(
'/', 0, 0, a, 1, r1, rcond, anrm, info )
511 CALL chkxer(
'DPBEQU', infot, nout, lerr, ok )
513 CALL dpbequ(
'U', -1, 0, a, 1, r1, rcond, anrm, info )
514 CALL chkxer(
'DPBEQU', infot, nout, lerr, ok )
516 CALL dpbequ(
'U', 1, -1, a, 1, r1, rcond, anrm, info )
517 CALL chkxer(
'DPBEQU', infot, nout, lerr, ok )
519 CALL dpbequ(
'U', 2, 1, a, 1, r1, rcond, anrm, info )
520 CALL chkxer(
'DPBEQU', infot, nout, lerr, ok )
525 CALL alaesm( path, ok, nout )