77 REAL R( NMAX ), R1( NMAX ), R2( NMAX )
78 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( ),
79 $ W( 2*NMAX ), X( NMAX )
97 COMMON / infoc / infot, nout, ok, lerr
98 COMMON / srnamc / srnamt
101 INTRINSIC cmplx, real
106 WRITE( nout, fmt = * )
113 a( i, j ) =
cmplx( 1. / real( i+j ), -1. / real
114 af( i, j ) =
cmplx( 1. / real( i+j ), -1. / real( i+j ) )
128 IF( lsamen( 2, c2,
'PO' ) )
THEN
134 CALL cpotrf(
'/', 0, a, 1, info )
135 CALL chkxer(
'CPOTRF', infot, nout, lerr, ok )
137 CALL cpotrf(
'U', -1, a, 1, info )
138 CALL chkxer(
'CPOTRF', infot, nout, lerr, ok )
140 CALL cpotrf(
'U', 2, a, 1, info )
141 CALL chkxer(
'CPOTRF', infot, nout, lerr, ok )
147 CALL cpotf2(
'/', 0, a, 1, info )
148 CALL chkxer(
'CPOTF2', infot, nout, lerr, ok )
150 CALL cpotf2(
'U', -1, a, 1, info )
151 CALL chkxer(
'CPOTF2', infot, nout, lerr, ok )
153 CALL cpotf2(
'U', 2, a, 1, info )
154 CALL chkxer(
'CPOTF2', infot, nout, lerr, ok )
160 CALL cpotri(
'/', 0, a, 1, info )
161 CALL chkxer(
'CPOTRI', infot, nout, lerr, ok )
163 CALL cpotri(
'U', -1, a, 1, info )
164 CALL chkxer(
'CPOTRI', infot, nout, lerr, ok )
166 CALL cpotri(
'U', 2, a, 1, info )
167 CALL chkxer(
'CPOTRI', infot, nout, lerr, ok )
173 CALL cpotrs(
'/', 0, 0, a, 1, b, 1, info )
174 CALL chkxer(
'CPOTRS', infot, nout, lerr, ok )
176 CALL cpotrs(
'U', -1, 0, a, 1, b, 1, info )
177 CALL chkxer(
'CPOTRS', infot, nout, lerr, ok )
179 CALL cpotrs(
'U', 0, -1, a, 1, b, 1, info )
180 CALL chkxer(
'CPOTRS', infot, nout, lerr, ok )
183 CALL chkxer(
'CPOTRS', infot, nout, lerr, ok )
185 CALL cpotrs(
'U', 2, 1, a, 2, b, 1, info )
186 CALL chkxer(
'CPOTRS', infot, nout, lerr, ok )
192 CALL cporfs(
'/', 0, 0, a,
194 CALL chkxer(
'CPORFS', infot, nout, lerr, ok )
196 CALL cporfs(
'U', -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w, r,
198 CALL chkxer(
'CPORFS', infot, nout, lerr, ok )
200 CALL cporfs(
'U', 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w, r,
202 CALL chkxer(
'CPORFS', infot, nout, lerr, ok )
204 CALL cporfs(
'U', 2, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w, r,
206 CALL chkxer(
'CPORFS', infot, nout, lerr, ok )
208 CALL cporfs(
'U', 2, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w, r,
210 CALL chkxer(
'CPORFS', infot, nout, lerr, ok )
212 CALL cporfs(
'U', 2, 1, a, 2, af, 2, b, 1, x, 2, r1, r2, w, r,
214 CALL chkxer(
'CPORFS', infot, nout, lerr, ok )
216 CALL cporfs(
'U', 2, 1, a, 2, af, 2, b, 2, x, 1, r1, r2, w, r,
218 CALL chkxer(
'CPORFS', infot, nout, lerr, ok )
224 CALL cpocon(
'/', 0, a, 1, anrm, rcond, w, r, info
225 CALL chkxer(
'CPOCON', infot, nout, lerr, ok )
227 CALL cpocon(
'U', -1, a, 1, anrm, rcond, w, r, info )
228 CALL chkxer(
'CPOCON', infot, nout, lerr, ok )
230 CALL cpocon(
'U', 2, a, 1, anrm, rcond, w, r, info )
231 CALL chkxer(
'CPOCON', infot, nout, lerr, ok )
233 CALL cpocon(
'U', 1, a, 1, -anrm, rcond, w, r, info )
234 CALL chkxer(
'CPOCON', infot, nout, lerr, ok )
240 CALL cpoequ( -1, a, 1, r1, rcond, anrm, info )
241 CALL chkxer(
'CPOEQU', infot, nout, lerr, ok )
243 CALL cpoequ( 2, a, 1, r1, rcond, anrm, info )
244 CALL chkxer(
'CPOEQU', infot, nout, lerr, ok )
249 ELSE IF( lsamen( 2, c2,
'PP' ) )
THEN
255 CALL cpptrf(
'/', 0, a, info )
256 CALL chkxer(
'CPPTRF', infot, nout, lerr, ok )
258 CALL cpptrf(
'U', -1, a, info )
259 CALL chkxer(
'CPPTRF', infot, nout, lerr, ok )
265 CALL cpptri(
'/', 0, a, info )
266 CALL chkxer(
'CPPTRI', infot, nout, lerr, ok )
268 CALL cpptri(
'U', -1, a, info )
269 CALL chkxer(
'CPPTRI', infot, nout, lerr, ok )
275 CALL cpptrs( '/
', 0, 0, A, B, 1, INFO )
276 CALL CHKXER( 'cpptrs', INFOT, NOUT, LERR, OK )
278 CALL CPPTRS( 'u
', -1, 0, A, B, 1, INFO )
279 CALL CHKXER( 'cpptrs', INFOT, NOUT, LERR, OK )
281 CALL CPPTRS( 'u
', 0, -1, A, B, 1, INFO )
282 CALL CHKXER( 'cpptrs', INFOT, NOUT, LERR, OK )
284 CALL CPPTRS( 'u
', 2, 1, A, B, 1, INFO )
285 CALL CHKXER( 'cpptrs', INFOT, NOUT, LERR, OK )
291 CALL CPPRFS( '/
', 0, 0, A, AF, B, 1, X, 1, R1, R2, W, R, INFO )
292 CALL CHKXER( 'cpprfs', INFOT, NOUT, LERR, OK )
294 CALL CPPRFS( 'u
', -1, 0, A, AF, B, 1, X, 1, R1, R2, W, R,
296 CALL CHKXER( 'cpprfs', INFOT, NOUT, LERR, OK )
298 CALL CPPRFS( 'u
', 0, -1, A, AF, B, 1, X, 1, R1, R2, W, R,
300 CALL CHKXER( 'cpprfs', INFOT, NOUT, LERR, OK )
302 CALL CPPRFS( 'u
', 2, 1, A, AF, B, 1, X, 2, R1, R2, W, R, INFO )
303 CALL CHKXER( 'cpprfs', INFOT, NOUT, LERR, OK )
305 CALL CPPRFS( 'u
', 2, 1, A, AF, B, 2, X, 1, R1, R2, W, R, INFO )
306 CALL CHKXER( 'cpprfs', INFOT, NOUT, LERR, OK )
312 CALL CPPCON( '/
', 0, A, ANRM, RCOND, W, R, INFO )
313 CALL CHKXER( 'cppcon', INFOT, NOUT, LERR, OK )
315 CALL CPPCON( 'u
', -1, A, ANRM, RCOND, W, R, INFO )
316 CALL CHKXER( 'cppcon', INFOT, NOUT, LERR, OK )
318 CALL CPPCON( 'u
', 1, A, -ANRM, RCOND, W, R, INFO )
319 CALL CHKXER( 'cppcon', INFOT, NOUT, LERR, OK )
325 CALL CPPEQU( '/
', 0, A, R1, RCOND, ANRM, INFO )
326 CALL CHKXER( 'cppequ', INFOT, NOUT, LERR, OK )
328 CALL CPPEQU( 'u
', -1, A, R1, RCOND, ANRM, INFO )
329 CALL CHKXER( 'cppequ', INFOT, NOUT, LERR, OK )
334 ELSE IF( LSAMEN( 2, C2, 'pb
' ) ) THEN
340 CALL CPBTRF( '/
', 0, 0, A, 1, INFO )
341 CALL CHKXER( 'cpbtrf', INFOT, NOUT, LERR, OK )
343 CALL CPBTRF( 'u
', -1, 0, A, 1, INFO )
344 CALL CHKXER( 'cpbtrf', INFOT, NOUT, LERR, OK )
346 CALL CPBTRF( 'u
', 1, -1, A, 1, INFO )
347 CALL CHKXER( 'cpbtrf', INFOT, NOUT, LERR, OK )
349 CALL CPBTRF( 'u
', 2, 1, A, 1, INFO )
350 CALL CHKXER( 'cpbtrf', INFOT, NOUT, LERR, OK )
356 CALL CPBTF2( '/
', 0, 0, A, 1, INFO )
357 CALL CHKXER( 'cpbtf2', INFOT, NOUT, LERR, OK )
359 CALL CPBTF2( 'u
', -1, 0, A, 1, INFO )
360 CALL CHKXER( 'cpbtf2', INFOT, NOUT, LERR, OK )
362 CALL CPBTF2( 'u', 1, -1, a, 1, info )
363 CALL chkxer(
'CPBTF2', infot, nout, lerr, ok )
365 CALL cpbtf2(
'U', 2, 1, a, 1, info )
366 CALL chkxer(
'CPBTF2', infot, nout, lerr, ok )
372 CALL cpbtrs(
'/', 0, 0, 0, a, 1, b, 1, info )
373 CALL chkxer(
'CPBTRS', infot, nout, lerr, ok )
375 CALL cpbtrs(
'U', -1, 0, 0, a, 1, b, 1, info )
376 CALL chkxer(
'CPBTRS', infot, nout, lerr, ok )
378 CALL cpbtrs(
'U', 1, -1, 0, a, 1, b, 1, info )
379 CALL chkxer(
'CPBTRS', infot, nout, lerr, ok )
381 CALL cpbtrs(
'U', 0, 0, -1, a, 1, b, 1, info )
382 CALL chkxer(
'CPBTRS', infot, nout, lerr, ok )
384 CALL cpbtrs(
'U', 2, 1, 1, a, 1, b, 1, info )
385 CALL chkxer(
'CPBTRS', infot, nout, lerr, ok )
387 CALL cpbtrs(
'U', 2, 0, 1, a, 1, b, 1, info )
388 CALL chkxer(
'CPBTRS', infot, nout, lerr, ok )
394 CALL cpbrfs(
'/', 0, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
396 CALL chkxer(
'CPBRFS', infot, nout, lerr, ok )
398 CALL cpbrfs(
'U', -1, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
400 CALL chkxer(
'CPBRFS', infot, nout, lerr, ok )
402 CALL cpbrfs(
'U', 1, -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
404 CALL chkxer(
'CPBRFS', infot, nout, lerr, ok )
406 CALL cpbrfs(
'U', 0, 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
408 CALL chkxer(
'CPBRFS', infot, nout, lerr, ok )
410 CALL cpbrfs(
'U', 2, 1, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w,
412 CALL chkxer(
'CPBRFS', infot, nout, lerr, ok )
414 CALL cpbrfs(
'U', 2, 1, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w,
416 CALL chkxer(
'CPBRFS', infot, nout, lerr, ok )
418 CALL cpbrfs(
'U', 2, 0, 1, a, 1, af, 1, b, 1, x, 2, r1, r2, w,
420 CALL chkxer(
'CPBRFS', infot, nout, lerr, ok )
422 CALL cpbrfs(
'U', 2, 0, 1, a, 1, af, 1, b, 2, x, 1, r1, r2, w,
424 CALL chkxer(
'CPBRFS', infot, nout, lerr, ok )
430 CALL cpbcon(
'/', 0, 0, a, 1, anrm, rcond, w, r, info )
431 CALL chkxer(
'CPBCON', infot, nout, lerr, ok )
433 CALL cpbcon(
'U', -1, 0, a, 1, anrm, rcond, w, r, info )
434 CALL chkxer(
'CPBCON', infot, nout, lerr, ok )
436 CALL cpbcon(
'U', 1, -1, a, 1, anrm, rcond, w, r, info )
437 CALL chkxer(
'CPBCON', infot, nout, lerr, ok )
439 CALL cpbcon(
'U', 2, 1, a, 1, anrm, rcond, w, r, info )
440 CALL chkxer(
'CPBCON', infot, nout, lerr, ok )
442 CALL cpbcon(
'U', 1, 0, a, 1, -anrm, rcond, w, r, info )
443 CALL chkxer(
'CPBCON', infot, nout, lerr, ok )
449 CALL cpbequ(
'/', 0, 0, a, 1, r1, rcond, anrm, info )
450 CALL chkxer(
'CPBEQU', infot, nout, lerr, ok )
452 CALL cpbequ(
'U', -1, 0, a, 1, r1, rcond, anrm, info )
453 CALL chkxer(
'CPBEQU', infot, nout, lerr, ok )
455 CALL cpbequ( 'u
', 1, -1, A, 1, R1, RCOND, ANRM, INFO )
456 CALL CHKXER( 'cpbequ', INFOT, NOUT, LERR, OK )
458 CALL CPBEQU( 'u
', 2, 1, A, 1, R1, RCOND, ANRM, INFO )
459 CALL CHKXER( 'cpbequ', INFOT, NOUT, LERR, OK )
464 CALL ALAESM( PATH, OK, NOUT )