80 INTEGER i, info,
j, n_err_bnds, nparams
81 REAL anrm, rcond, berr
85 REAL r( nmax ), r1( nmax ), r2( nmax ),
86 $ s( nmax ), err_bnds_n( nmax, 3 ),
87 $ err_bnds_c( nmax, 3 ), params( 1 )
88 COMPLEX a( nmax, nmax ), af( nmax, nmax ),
b( nmax ),
89 $ w( 2*nmax ), x( nmax )
108 COMMON / infoc / infot, nout, ok, lerr
109 COMMON / srnamc / srnamt
112 INTRINSIC cmplx, real
117 WRITE( nout, fmt = * )
124 a( i,
j ) = cmplx( 1. /
REAL( I+J ), -1. /
REAL( I+J ) )
125 af( i,
j ) = cmplx( 1. /
REAL( I+J ), -1. /
REAL( I+J ) )
142 IF(
lsamen( 2, c2,
'SY' ) )
THEN
148 CALL
csytrf(
'/', 0, a, 1, ip, w, 1, info )
149 CALL
chkxer(
'CSYTRF', infot, nout, lerr, ok )
151 CALL
csytrf(
'U', -1, a, 1, ip, w, 1, info )
152 CALL
chkxer(
'CSYTRF', infot, nout, lerr, ok )
154 CALL
csytrf(
'U', 2, a, 1, ip, w, 4, info )
155 CALL
chkxer(
'CSYTRF', infot, nout, lerr, ok )
161 CALL
csytf2(
'/', 0, a, 1, ip, info )
162 CALL
chkxer(
'CSYTF2', infot, nout, lerr, ok )
164 CALL
csytf2(
'U', -1, a, 1, ip, info )
165 CALL
chkxer(
'CSYTF2', infot, nout, lerr, ok )
167 CALL
csytf2(
'U', 2, a, 1, ip, info )
168 CALL
chkxer(
'CSYTF2', infot, nout, lerr, ok )
174 CALL
csytri(
'/', 0, a, 1, ip, w, info )
175 CALL
chkxer(
'CSYTRI', infot, nout, lerr, ok )
177 CALL
csytri(
'U', -1, a, 1, ip, w, info )
178 CALL
chkxer(
'CSYTRI', infot, nout, lerr, ok )
180 CALL
csytri(
'U', 2, a, 1, ip, w, info )
181 CALL
chkxer(
'CSYTRI', infot, nout, lerr, ok )
187 CALL
csytri2(
'/', 0, a, 1, ip, w, 1, info )
188 CALL
chkxer(
'CSYTRI2', infot, nout, lerr, ok )
190 CALL
csytri2(
'U', -1, a, 1, ip, w, 1, info )
191 CALL
chkxer(
'CSYTRI2', infot, nout, lerr, ok )
193 CALL
csytri2(
'U', 2, a, 1, ip, w, 1, info )
194 CALL
chkxer(
'CSYTRI2', infot, nout, lerr, ok )
200 CALL
csytrs(
'/', 0, 0, a, 1, ip,
b, 1, info )
201 CALL
chkxer(
'CSYTRS', infot, nout, lerr, ok )
203 CALL
csytrs(
'U', -1, 0, a, 1, ip,
b, 1, info )
204 CALL
chkxer(
'CSYTRS', infot, nout, lerr, ok )
206 CALL
csytrs(
'U', 0, -1, a, 1, ip,
b, 1, info )
207 CALL
chkxer(
'CSYTRS', infot, nout, lerr, ok )
209 CALL
csytrs(
'U', 2, 1, a, 1, ip,
b, 2, info )
210 CALL
chkxer(
'CSYTRS', infot, nout, lerr, ok )
212 CALL
csytrs(
'U', 2, 1, a, 2, ip,
b, 1, info )
213 CALL
chkxer(
'CSYTRS', infot, nout, lerr, ok )
219 CALL
csyrfs(
'/', 0, 0, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2, w,
221 CALL
chkxer(
'CSYRFS', infot, nout, lerr, ok )
223 CALL
csyrfs(
'U', -1, 0, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2,
225 CALL
chkxer(
'CSYRFS', infot, nout, lerr, ok )
227 CALL
csyrfs(
'U', 0, -1, a, 1, af, 1, ip,
b, 1, x, 1, r1, r2,
229 CALL
chkxer(
'CSYRFS', infot, nout, lerr, ok )
231 CALL
csyrfs(
'U', 2, 1, a, 1, af, 2, ip,
b, 2, x, 2, r1, r2, w,
233 CALL
chkxer(
'CSYRFS', infot, nout, lerr, ok )
235 CALL
csyrfs(
'U', 2, 1, a, 2, af, 1, ip,
b, 2, x, 2, r1, r2, w,
237 CALL
chkxer(
'CSYRFS', infot, nout, lerr, ok )
239 CALL
csyrfs(
'U', 2, 1, a, 2, af, 2, ip,
b, 1, x, 2, r1, r2, w,
241 CALL
chkxer(
'CSYRFS', infot, nout, lerr, ok )
243 CALL
csyrfs(
'U', 2, 1, a, 2, af, 2, ip,
b, 2, x, 1, r1, r2, w,
245 CALL
chkxer(
'CSYRFS', infot, nout, lerr, ok )
253 CALL
csyrfsx(
'/', eq, 0, 0, a, 1, af, 1, ip, s,
b, 1, x, 1,
254 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
255 $ params, w, r, info )
256 CALL
chkxer(
'CSYRFSX', infot, nout, lerr, ok )
258 CALL
csyrfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s,
b, 1, x, 1,
259 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
260 $ params, w, r, info )
261 CALL
chkxer(
'CSYRFSX', infot, nout, lerr, ok )
264 CALL
csyrfsx(
'U', eq, -1, 0, a, 1, af, 1, ip, s,
b, 1, x, 1,
265 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
266 $ params, w, r, info )
267 CALL
chkxer(
'CSYRFSX', infot, nout, lerr, ok )
269 CALL
csyrfsx(
'U', eq, 0, -1, a, 1, af, 1, ip, s,
b, 1, x, 1,
270 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
271 $ params, w, r, info )
272 CALL
chkxer(
'CSYRFSX', infot, nout, lerr, ok )
274 CALL
csyrfsx(
'U', eq, 2, 1, a, 1, af, 2, ip, s,
b, 2, x, 2,
275 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
276 $ params, w, r, info )
277 CALL
chkxer(
'CSYRFSX', infot, nout, lerr, ok )
279 CALL
csyrfsx(
'U', eq, 2, 1, a, 2, af, 1, ip, s,
b, 2, x, 2,
280 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
281 $ params, w, r, info )
282 CALL
chkxer(
'CSYRFSX', infot, nout, lerr, ok )
284 CALL
csyrfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s,
b, 1, x, 2,
285 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
286 $ params, w, r, info )
287 CALL
chkxer(
'CSYRFSX', infot, nout, lerr, ok )
289 CALL
csyrfsx(
'U', eq, 2, 1, a, 2, af, 2, ip, s,
b, 2, x, 1,
290 $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
291 $ params, w, r, info )
292 CALL
chkxer(
'CSYRFSX', infot, nout, lerr, ok )
298 CALL
csycon(
'/', 0, a, 1, ip, anrm, rcond, w, info )
299 CALL
chkxer(
'CSYCON', infot, nout, lerr, ok )
301 CALL
csycon(
'U', -1, a, 1, ip, anrm, rcond, w, info )
302 CALL
chkxer(
'CSYCON', infot, nout, lerr, ok )
304 CALL
csycon(
'U', 2, a, 1, ip, anrm, rcond, w, info )
305 CALL
chkxer(
'CSYCON', infot, nout, lerr, ok )
307 CALL
csycon(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
308 CALL
chkxer(
'CSYCON', infot, nout, lerr, ok )
314 ELSE IF(
lsamen( 2, c2,
'SR' ) )
THEN
318 srnamt =
'CSYTRF_ROOK'
321 CALL
chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
324 CALL
chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
327 CALL
chkxer(
'CSYTRF_ROOK', infot, nout, lerr, ok )
331 srnamt =
'CSYTF2_ROOK'
334 CALL
chkxer(
'CSYTF2_ROOK', infot, nout, lerr, ok )
337 CALL
chkxer(
'CSYTF2_ROOK', infot, nout, lerr, ok )
340 CALL
chkxer(
'CSYTF2_ROOK', infot, nout, lerr, ok )
344 srnamt =
'CSYTRI_ROOK'
347 CALL
chkxer(
'CSYTRI_ROOK', infot, nout, lerr, ok )
350 CALL
chkxer(
'CSYTRI_ROOK', infot, nout, lerr, ok )
353 CALL
chkxer(
'CSYTRI_ROOK', infot, nout, lerr, ok )
357 srnamt =
'CSYTRS_ROOK'
360 CALL
chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
363 CALL
chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
366 CALL
chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
369 CALL
chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
372 CALL
chkxer(
'CSYTRS_ROOK', infot, nout, lerr, ok )
376 srnamt =
'CSYCON_ROOK'
378 CALL
csycon_rook(
'/', 0, a, 1, ip, anrm, rcond, w, info )
379 CALL
chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
381 CALL
csycon_rook(
'U', -1, a, 1, ip, anrm, rcond, w, info )
382 CALL
chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
384 CALL
csycon_rook(
'U', 2, a, 1, ip, anrm, rcond, w, info )
385 CALL
chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
387 CALL
csycon_rook(
'U', 1, a, 1, ip, -anrm, rcond, w, info )
388 CALL
chkxer(
'CSYCON_ROOK', infot, nout, lerr, ok )
394 ELSE IF(
lsamen( 2, c2,
'SP' ) )
THEN
400 CALL
csptrf(
'/', 0, a, ip, info )
401 CALL
chkxer(
'CSPTRF', infot, nout, lerr, ok )
403 CALL
csptrf(
'U', -1, a, ip, info )
404 CALL
chkxer(
'CSPTRF', infot, nout, lerr, ok )
410 CALL
csptri(
'/', 0, a, ip, w, info )
411 CALL
chkxer(
'CSPTRI', infot, nout, lerr, ok )
413 CALL
csptri(
'U', -1, a, ip, w, info )
414 CALL
chkxer(
'CSPTRI', infot, nout, lerr, ok )
420 CALL
csptrs(
'/', 0, 0, a, ip,
b, 1, info )
421 CALL
chkxer(
'CSPTRS', infot, nout, lerr, ok )
423 CALL
csptrs(
'U', -1, 0, a, ip,
b, 1, info )
424 CALL
chkxer(
'CSPTRS', infot, nout, lerr, ok )
426 CALL
csptrs(
'U', 0, -1, a, ip,
b, 1, info )
427 CALL
chkxer(
'CSPTRS', infot, nout, lerr, ok )
429 CALL
csptrs(
'U', 2, 1, a, ip,
b, 1, info )
430 CALL
chkxer(
'CSPTRS', infot, nout, lerr, ok )
436 CALL
csprfs(
'/', 0, 0, a, af, ip,
b, 1, x, 1, r1, r2, w, r,
438 CALL
chkxer(
'CSPRFS', infot, nout, lerr, ok )
440 CALL
csprfs(
'U', -1, 0, a, af, ip,
b, 1, x, 1, r1, r2, w, r,
442 CALL
chkxer(
'CSPRFS', infot, nout, lerr, ok )
444 CALL
csprfs(
'U', 0, -1, a, af, ip,
b, 1, x, 1, r1, r2, w, r,
446 CALL
chkxer(
'CSPRFS', infot, nout, lerr, ok )
448 CALL
csprfs(
'U', 2, 1, a, af, ip,
b, 1, x, 2, r1, r2, w, r,
450 CALL
chkxer(
'CSPRFS', infot, nout, lerr, ok )
452 CALL
csprfs(
'U', 2, 1, a, af, ip,
b, 2, x, 1, r1, r2, w, r,
454 CALL
chkxer(
'CSPRFS', infot, nout, lerr, ok )
460 CALL
cspcon(
'/', 0, a, ip, anrm, rcond, w, info )
461 CALL
chkxer(
'CSPCON', infot, nout, lerr, ok )
463 CALL
cspcon(
'U', -1, a, ip, anrm, rcond, w, info )
464 CALL
chkxer(
'CSPCON', infot, nout, lerr, ok )
466 CALL
cspcon(
'U', 1, a, ip, -anrm, rcond, w, info )
467 CALL
chkxer(
'CSPCON', infot, nout, lerr, ok )
472 CALL
alaesm( path, ok, nout )