OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cerrsy.f
Go to the documentation of this file.
1*> \brief \b CERRSY
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE CERRSY( PATH, NUNIT )
12*
13* .. Scalar Arguments ..
14* CHARACTER*3 PATH
15* INTEGER NUNIT
16* ..
17*
18*
19*> \par Purpose:
20* =============
21*>
22*> \verbatim
23*>
24*> CERRSY tests the error exits for the COMPLEX routines
25*> for symmetric indefinite matrices.
26*> \endverbatim
27*
28* Arguments:
29* ==========
30*
31*> \param[in] PATH
32*> \verbatim
33*> PATH is CHARACTER*3
34*> The LAPACK path name for the routines to be tested.
35*> \endverbatim
36*>
37*> \param[in] NUNIT
38*> \verbatim
39*> NUNIT is INTEGER
40*> The unit number for output.
41*> \endverbatim
42*
43* Authors:
44* ========
45*
46*> \author Univ. of Tennessee
47*> \author Univ. of California Berkeley
48*> \author Univ. of Colorado Denver
49*> \author NAG Ltd.
50*
51*> \ingroup complex_lin
52*
53* =====================================================================
54 SUBROUTINE cerrsy( PATH, NUNIT )
55*
56* -- LAPACK test routine --
57* -- LAPACK is a software package provided by Univ. of Tennessee, --
58* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
59*
60* .. Scalar Arguments ..
61 CHARACTER*3 PATH
62 INTEGER NUNIT
63* ..
64*
65* =====================================================================
66*
67* .. Parameters ..
68 INTEGER NMAX
69 parameter( nmax = 4 )
70* ..
71* .. Local Scalars ..
72 CHARACTER*2 C2
73 INTEGER I, INFO, J
74 REAL ANRM, RCOND
75* ..
76* .. Local Arrays ..
77 INTEGER IP( NMAX )
78 REAL R( NMAX ), R1( NMAX ), R2( NMAX )
79 COMPLEX A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
80 $ E( NMAX), W( 2*NMAX ), X( NMAX )
81* ..
82* .. External Functions ..
83 LOGICAL LSAMEN
84 EXTERNAL lsamen
85* ..
86* .. External Subroutines ..
87 EXTERNAL alaesm, chkxer, cspcon, csprfs, csptrf, csptri,
88 $ csptrs, csycon, csycon_3, csycon_rook, csyrfs,
89 $ csytf2, csytf2_rk, csytf2_rook, csytrf,
90 $ csytrf_rk, csytrf_rook, csytri, csytri_3,
91 $ csytri_3x, csytri_rook, csytri2, csytri2x,
92 $ csytrs, csytrs_3, csytrs_rook
93* ..
94* .. Scalars in Common ..
95 LOGICAL LERR, OK
96 CHARACTER*32 SRNAMT
97 INTEGER INFOT, NOUT
98* ..
99* .. Common blocks ..
100 COMMON / infoc / infot, nout, ok, lerr
101 COMMON / srnamc / srnamt
102* ..
103* .. Intrinsic Functions ..
104 INTRINSIC cmplx, real
105* ..
106* .. Executable Statements ..
107*
108 nout = nunit
109 WRITE( nout, fmt = * )
110 c2 = path( 2: 3 )
111*
112* Set the variables to innocuous values.
113*
114 DO 20 j = 1, nmax
115 DO 10 i = 1, nmax
116 a( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
117 af( i, j ) = cmplx( 1. / real( i+j ), -1. / real( i+j ) )
118 10 CONTINUE
119 b( j ) = 0.e0
120 e( j ) = 0.e0
121 r1( j ) = 0.e0
122 r2( j ) = 0.e0
123 w( j ) = 0.e0
124 x( j ) = 0.e0
125 ip( j ) = j
126 20 CONTINUE
127 anrm = 1.0
128 ok = .true.
129*
130 IF( lsamen( 2, c2, 'SY' ) ) THEN
131*
132* Test error exits of the routines that use factorization
133* of a symmetric indefinite matrix with patrial
134* (Bunch-Kaufman) diagonal pivoting method.
135*
136* CSYTRF
137*
138 srnamt = 'CSYTRF'
139 infot = 1
140 CALL csytrf( '/', 0, a, 1, ip, w, 1, info )
141 CALL chkxer( 'CSYTRF', infot, nout, lerr, ok )
142 infot = 2
143 CALL csytrf( 'U', -1, a, 1, ip, w, 1, info )
144 CALL chkxer( 'CSYTRF', infot, nout, lerr, ok )
145 infot = 4
146 CALL csytrf( 'U', 2, a, 1, ip, w, 4, info )
147 CALL chkxer( 'CSYTRF', infot, nout, lerr, ok )
148 infot = 7
149 CALL csytrf( 'U', 0, a, 1, ip, w, 0, info )
150 CALL chkxer( 'CSYTRF', infot, nout, lerr, ok )
151 infot = 7
152 CALL csytrf( 'U', 0, a, 1, ip, w, -2, info )
153 CALL chkxer( 'CSYTRF', infot, nout, lerr, ok )
154*
155* CSYTF2
156*
157 srnamt = 'CSYTF2'
158 infot = 1
159 CALL csytf2( '/', 0, a, 1, ip, info )
160 CALL chkxer( 'CSYTF2', infot, nout, lerr, ok )
161 infot = 2
162 CALL csytf2( 'U', -1, a, 1, ip, info )
163 CALL chkxer( 'CSYTF2', infot, nout, lerr, ok )
164 infot = 4
165 CALL csytf2( 'U', 2, a, 1, ip, info )
166 CALL chkxer( 'CSYTF2', infot, nout, lerr, ok )
167*
168* CSYTRI
169*
170 srnamt = 'CSYTRI'
171 infot = 1
172 CALL csytri( '/', 0, a, 1, ip, w, info )
173 CALL chkxer( 'CSYTRI', infot, nout, lerr, ok )
174 infot = 2
175 CALL csytri( 'U', -1, a, 1, ip, w, info )
176 CALL chkxer( 'CSYTRI', infot, nout, lerr, ok )
177 infot = 4
178 CALL csytri( 'U', 2, a, 1, ip, w, info )
179 CALL chkxer( 'CSYTRI', infot, nout, lerr, ok )
180*
181* CSYTRI2
182*
183 srnamt = 'CSYTRI2'
184 infot = 1
185 CALL csytri2( '/', 0, a, 1, ip, w, 1, info )
186 CALL chkxer( 'CSYTRI2', infot, nout, lerr, ok )
187 infot = 2
188 CALL csytri2( 'U', -1, a, 1, ip, w, 1, info )
189 CALL chkxer( 'CSYTRI2', infot, nout, lerr, ok )
190 infot = 4
191 CALL csytri2( 'U', 2, a, 1, ip, w, 1, info )
192 CALL chkxer( 'CSYTRI2', infot, nout, lerr, ok )
193*
194* CSYTRI2X
195*
196 srnamt = 'CSYTRI2X'
197 infot = 1
198 CALL csytri2x( '/', 0, a, 1, ip, w, 1, info )
199 CALL chkxer( 'CSYTRI2X', infot, nout, lerr, ok )
200 infot = 2
201 CALL csytri2x( 'U', -1, a, 1, ip, w, 1, info )
202 CALL chkxer( 'CSYTRI2X', infot, nout, lerr, ok )
203 infot = 4
204 CALL csytri2x( 'U', 2, a, 1, ip, w, 1, info )
205 CALL chkxer( 'CSYTRI2X', infot, nout, lerr, ok )
206*
207* CSYTRS
208*
209 srnamt = 'CSYTRS'
210 infot = 1
211 CALL csytrs( '/', 0, 0, a, 1, ip, b, 1, info )
212 CALL chkxer( 'CSYTRS', infot, nout, lerr, ok )
213 infot = 2
214 CALL csytrs( 'U', -1, 0, a, 1, ip, b, 1, info )
215 CALL chkxer( 'CSYTRS', infot, nout, lerr, ok )
216 infot = 3
217 CALL csytrs( 'U', 0, -1, a, 1, ip, b, 1, info )
218 CALL chkxer( 'CSYTRS', infot, nout, lerr, ok )
219 infot = 5
220 CALL csytrs( 'U', 2, 1, a, 1, ip, b, 2, info )
221 CALL chkxer( 'CSYTRS', infot, nout, lerr, ok )
222 infot = 8
223 CALL csytrs( 'U', 2, 1, a, 2, ip, b, 1, info )
224 CALL chkxer( 'CSYTRS', infot, nout, lerr, ok )
225*
226* CSYRFS
227*
228 srnamt = 'CSYRFS'
229 infot = 1
230 CALL csyrfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
231 $ r, info )
232 CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
233 infot = 2
234 CALL csyrfs( 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
235 $ w, r, info )
236 CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
237 infot = 3
238 CALL csyrfs( 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
239 $ w, r, info )
240 CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
241 infot = 5
242 CALL csyrfs( 'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
243 $ r, info )
244 CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
245 infot = 7
246 CALL csyrfs( 'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
247 $ r, info )
248 CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
249 infot = 10
250 CALL csyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
251 $ r, info )
252 CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
253 infot = 12
254 CALL csyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
255 $ r, info )
256 CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
257*
258* CSYCON
259*
260 srnamt = 'CSYCON'
261 infot = 1
262 CALL csycon( '/', 0, a, 1, ip, anrm, rcond, w, info )
263 CALL chkxer( 'CSYCON', infot, nout, lerr, ok )
264 infot = 2
265 CALL csycon( 'U', -1, a, 1, ip, anrm, rcond, w, info )
266 CALL chkxer( 'CSYCON', infot, nout, lerr, ok )
267 infot = 4
268 CALL csycon( 'U', 2, a, 1, ip, anrm, rcond, w, info )
269 CALL chkxer( 'CSYCON', infot, nout, lerr, ok )
270 infot = 6
271 CALL csycon( 'U', 1, a, 1, ip, -anrm, rcond, w, info )
272 CALL chkxer( 'CSYCON', infot, nout, lerr, ok )
273*
274 ELSE IF( lsamen( 2, c2, 'SR' ) ) THEN
275*
276* Test error exits of the routines that use factorization
277* of a symmetric indefinite matrix with rook
278* (bounded Bunch-Kaufman) diagonal pivoting method.
279*
280* CSYTRF_ROOK
281*
282 srnamt = 'CSYTRF_ROOK'
283 infot = 1
284 CALL csytrf_rook( '/', 0, a, 1, ip, w, 1, info )
285 CALL chkxer( 'CSYTRF_ROOK', infot, nout, lerr, ok )
286 infot = 2
287 CALL csytrf_rook( 'U', -1, a, 1, ip, w, 1, info )
288 CALL chkxer( 'CSYTRF_ROOK', infot, nout, lerr, ok )
289 infot = 4
290 CALL csytrf_rook( 'U', 2, a, 1, ip, w, 4, info )
291 CALL chkxer( 'CSYTRF_ROOK', infot, nout, lerr, ok )
292 infot = 7
293 CALL csytrf_rook( 'U', 0, a, 1, ip, w, 0, info )
294 CALL chkxer( 'CSYTRF_ROOK', infot, nout, lerr, ok )
295 infot = 7
296 CALL csytrf_rook( 'U', 0, a, 1, ip, w, -2, info )
297 CALL chkxer( 'CSYTRF_ROOK', infot, nout, lerr, ok )
298*
299* CSYTF2_ROOK
300*
301 srnamt = 'CSYTF2_ROOK'
302 infot = 1
303 CALL csytf2_rook( '/', 0, a, 1, ip, info )
304 CALL chkxer( 'CSYTF2_ROOK', infot, nout, lerr, ok )
305 infot = 2
306 CALL csytf2_rook( 'U', -1, a, 1, ip, info )
307 CALL chkxer( 'CSYTF2_ROOK', infot, nout, lerr, ok )
308 infot = 4
309 CALL csytf2_rook( 'U', 2, a, 1, ip, info )
310 CALL chkxer( 'CSYTF2_ROOK', infot, nout, lerr, ok )
311*
312* CSYTRI_ROOK
313*
314 srnamt = 'CSYTRI_ROOK'
315 infot = 1
316 CALL csytri_rook( '/', 0, a, 1, ip, w, info )
317 CALL chkxer( 'CSYTRI_ROOK', infot, nout, lerr, ok )
318 infot = 2
319 CALL csytri_rook( 'U', -1, a, 1, ip, w, info )
320 CALL chkxer( 'CSYTRI_ROOK', infot, nout, lerr, ok )
321 infot = 4
322 CALL csytri_rook( 'U', 2, a, 1, ip, w, info )
323 CALL chkxer( 'CSYTRI_ROOK', infot, nout, lerr, ok )
324*
325* CSYTRS_ROOK
326*
327 srnamt = 'CSYTRS_ROOK'
328 infot = 1
329 CALL csytrs_rook( '/', 0, 0, a, 1, ip, b, 1, info )
330 CALL chkxer( 'CSYTRS_ROOK', infot, nout, lerr, ok )
331 infot = 2
332 CALL csytrs_rook( 'U', -1, 0, a, 1, ip, b, 1, info )
333 CALL chkxer( 'CSYTRS_ROOK', infot, nout, lerr, ok )
334 infot = 3
335 CALL csytrs_rook( 'U', 0, -1, a, 1, ip, b, 1, info )
336 CALL chkxer( 'CSYTRS_ROOK', infot, nout, lerr, ok )
337 infot = 5
338 CALL csytrs_rook( 'U', 2, 1, a, 1, ip, b, 2, info )
339 CALL chkxer( 'CSYTRS_ROOK', infot, nout, lerr, ok )
340 infot = 8
341 CALL csytrs_rook( 'U', 2, 1, a, 2, ip, b, 1, info )
342 CALL chkxer( 'CSYTRS_ROOK', infot, nout, lerr, ok )
343*
344* CSYCON_ROOK
345*
346 srnamt = 'CSYCON_ROOK'
347 infot = 1
348 CALL csycon_rook( '/', 0, a, 1, ip, anrm, rcond, w, info )
349 CALL chkxer( 'CSYCON_ROOK', infot, nout, lerr, ok )
350 infot = 2
351 CALL csycon_rook( 'U', -1, a, 1, ip, anrm, rcond, w, info )
352 CALL chkxer( 'CSYCON_ROOK', infot, nout, lerr, ok )
353 infot = 4
354 CALL csycon_rook( 'U', 2, a, 1, ip, anrm, rcond, w, info )
355 CALL chkxer( 'CSYCON_ROOK', infot, nout, lerr, ok )
356 infot = 6
357 CALL csycon_rook( 'U', 1, a, 1, ip, -anrm, rcond, w, info )
358 CALL chkxer( 'CSYCON_ROOK', infot, nout, lerr, ok )
359*
360 ELSE IF( lsamen( 2, c2, 'SK' ) ) THEN
361*
362* Test error exits of the routines that use factorization
363* of a symmetric indefinite matrix with rook
364* (bounded Bunch-Kaufman) pivoting with the new storage
365* format for factors L ( or U) and D.
366*
367* L (or U) is stored in A, diagonal of D is stored on the
368* diagonal of A, subdiagonal of D is stored in a separate array E.
369*
370* CSYTRF_RK
371*
372 srnamt = 'CSYTRF_RK'
373 infot = 1
374 CALL csytrf_rk( '/', 0, a, 1, e, ip, w, 1, info )
375 CALL chkxer( 'CSYTRF_RK', infot, nout, lerr, ok )
376 infot = 2
377 CALL csytrf_rk( 'U', -1, a, 1, e, ip, w, 1, info )
378 CALL chkxer( 'CSYTRF_RK', infot, nout, lerr, ok )
379 infot = 4
380 CALL csytrf_rk( 'U', 2, a, 1, e, ip, w, 4, info )
381 CALL chkxer( 'CSYTRF_RK', infot, nout, lerr, ok )
382 infot = 8
383 CALL csytrf_rk( 'U', 0, a, 1, e, ip, w, 0, info )
384 CALL chkxer( 'CSYTRF_RK', infot, nout, lerr, ok )
385 infot = 8
386 CALL csytrf_rk( 'U', 0, a, 1, e, ip, w, -2, info )
387 CALL chkxer( 'CSYTRF_RK', infot, nout, lerr, ok )
388*
389* CSYTF2_RK
390*
391 srnamt = 'CSYTF2_RK'
392 infot = 1
393 CALL csytf2_rk( '/', 0, a, 1, e, ip, info )
394 CALL chkxer( 'CSYTF2_RK', infot, nout, lerr, ok )
395 infot = 2
396 CALL csytf2_rk( 'U', -1, a, 1, e, ip, info )
397 CALL chkxer( 'CSYTF2_RK', infot, nout, lerr, ok )
398 infot = 4
399 CALL csytf2_rk( 'U', 2, a, 1, e, ip, info )
400 CALL chkxer( 'CSYTF2_RK', infot, nout, lerr, ok )
401*
402* CSYTRI_3
403*
404 srnamt = 'CSYTRI_3'
405 infot = 1
406 CALL csytri_3( '/', 0, a, 1, e, ip, w, 1, info )
407 CALL chkxer( 'CSYTRI_3', infot, nout, lerr, ok )
408 infot = 2
409 CALL csytri_3( 'U', -1, a, 1, e, ip, w, 1, info )
410 CALL chkxer( 'CSYTRI_3', infot, nout, lerr, ok )
411 infot = 4
412 CALL csytri_3( 'U', 2, a, 1, e, ip, w, 1, info )
413 CALL chkxer( 'CSYTRI_3', infot, nout, lerr, ok )
414 infot = 8
415 CALL csytri_3( 'U', 0, a, 1, e, ip, w, 0, info )
416 CALL chkxer( 'CSYTRI_3', infot, nout, lerr, ok )
417 infot = 8
418 CALL csytri_3( 'U', 0, a, 1, e, ip, w, -2, info )
419 CALL chkxer( 'CSYTRI_3', infot, nout, lerr, ok )
420*
421* CSYTRI_3X
422*
423 srnamt = 'CSYTRI_3X'
424 infot = 1
425 CALL csytri_3x( '/', 0, a, 1, e, ip, w, 1, info )
426 CALL chkxer( 'CSYTRI_3X', infot, nout, lerr, ok )
427 infot = 2
428 CALL csytri_3x( 'U', -1, a, 1, e, ip, w, 1, info )
429 CALL chkxer( 'CSYTRI_3X', infot, nout, lerr, ok )
430 infot = 4
431 CALL csytri_3x( 'U', 2, a, 1, e, ip, w, 1, info )
432 CALL chkxer( 'CSYTRI_3X', infot, nout, lerr, ok )
433*
434* CSYTRS_3
435*
436 srnamt = 'CSYTRS_3'
437 infot = 1
438 CALL csytrs_3( '/', 0, 0, a, 1, e, ip, b, 1, info )
439 CALL chkxer( 'CSYTRS_3', infot, nout, lerr, ok )
440 infot = 2
441 CALL csytrs_3( 'U', -1, 0, a, 1, e, ip, b, 1, info )
442 CALL chkxer( 'CSYTRS_3', infot, nout, lerr, ok )
443 infot = 3
444 CALL csytrs_3( 'U', 0, -1, a, 1, e, ip, b, 1, info )
445 CALL chkxer( 'CSYTRS_3', infot, nout, lerr, ok )
446 infot = 5
447 CALL csytrs_3( 'U', 2, 1, a, 1, e, ip, b, 2, info )
448 CALL chkxer( 'CSYTRS_3', infot, nout, lerr, ok )
449 infot = 9
450 CALL csytrs_3( 'U', 2, 1, a, 2, e, ip, b, 1, info )
451 CALL chkxer( 'CSYTRS_3', infot, nout, lerr, ok )
452*
453* CSYCON_3
454*
455 srnamt = 'CSYCON_3'
456 infot = 1
457 CALL csycon_3( '/', 0, a, 1, e, ip, anrm, rcond, w, info )
458 CALL chkxer( 'CSYCON_3', infot, nout, lerr, ok )
459 infot = 2
460 CALL csycon_3( 'U', -1, a, 1, e, ip, anrm, rcond, w, info )
461 CALL chkxer( 'CSYCON_3', infot, nout, lerr, ok )
462 infot = 4
463 CALL csycon_3( 'U', 2, a, 1, e, ip, anrm, rcond, w, info )
464 CALL chkxer( 'CSYCON_3', infot, nout, lerr, ok )
465 infot = 7
466 CALL csycon_3( 'U', 1, a, 1, e, ip, -1.0e0, rcond, w, info)
467 CALL chkxer( 'CSYCON_3', infot, nout, lerr, ok )
468*
469 ELSE IF( lsamen( 2, c2, 'SP' ) ) THEN
470*
471* Test error exits of the routines that use factorization
472* of a symmetric indefinite packed matrix with patrial
473* (Bunch-Kaufman) diagonal pivoting method.
474*
475* CSPTRF
476*
477 srnamt = 'CSPTRF'
478 infot = 1
479 CALL csptrf( '/', 0, a, ip, info )
480 CALL chkxer( 'CSPTRF', infot, nout, lerr, ok )
481 infot = 2
482 CALL csptrf( 'U', -1, a, ip, info )
483 CALL chkxer( 'CSPTRF', infot, nout, lerr, ok )
484*
485* CSPTRI
486*
487 srnamt = 'CSPTRI'
488 infot = 1
489 CALL csptri( '/', 0, a, ip, w, info )
490 CALL chkxer( 'CSPTRI', infot, nout, lerr, ok )
491 infot = 2
492 CALL csptri( 'U', -1, a, ip, w, info )
493 CALL chkxer( 'CSPTRI', infot, nout, lerr, ok )
494*
495* CSPTRS
496*
497 srnamt = 'CSPTRS'
498 infot = 1
499 CALL csptrs( '/', 0, 0, a, ip, b, 1, info )
500 CALL chkxer( 'CSPTRS', infot, nout, lerr, ok )
501 infot = 2
502 CALL csptrs( 'U', -1, 0, a, ip, b, 1, info )
503 CALL chkxer( 'CSPTRS', infot, nout, lerr, ok )
504 infot = 3
505 CALL csptrs( 'U', 0, -1, a, ip, b, 1, info )
506 CALL chkxer( 'CSPTRS', infot, nout, lerr, ok )
507 infot = 7
508 CALL csptrs( 'U', 2, 1, a, ip, b, 1, info )
509 CALL chkxer( 'CSPTRS', infot, nout, lerr, ok )
510*
511* CSPRFS
512*
513 srnamt = 'CSPRFS'
514 infot = 1
515 CALL csprfs( '/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
516 $ info )
517 CALL chkxer( 'CSPRFS', infot, nout, lerr, ok )
518 infot = 2
519 CALL csprfs( 'u', -1, 0, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
520 $ INFO )
521 CALL CHKXER( 'csprfs', INFOT, NOUT, LERR, OK )
522 INFOT = 3
523 CALL CSPRFS( 'u', 0, -1, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
524 $ INFO )
525 CALL CHKXER( 'csprfs', INFOT, NOUT, LERR, OK )
526 INFOT = 8
527 CALL CSPRFS( 'u', 2, 1, A, AF, IP, B, 1, X, 2, R1, R2, W, R,
528 $ INFO )
529 CALL CHKXER( 'csprfs', INFOT, NOUT, LERR, OK )
530 INFOT = 10
531 CALL CSPRFS( 'u', 2, 1, A, AF, IP, B, 2, X, 1, R1, R2, W, R,
532 $ INFO )
533 CALL CHKXER( 'csprfs', INFOT, NOUT, LERR, OK )
534*
535* CSPCON
536*
537 SRNAMT = 'cspcon'
538 INFOT = 1
539 CALL CSPCON( '/', 0, A, IP, ANRM, RCOND, W, INFO )
540 CALL CHKXER( 'cspcon', INFOT, NOUT, LERR, OK )
541 INFOT = 2
542 CALL CSPCON( 'u', -1, A, IP, ANRM, RCOND, W, INFO )
543 CALL CHKXER( 'cspcon', INFOT, NOUT, LERR, OK )
544 INFOT = 5
545 CALL CSPCON( 'u', 1, A, IP, -ANRM, RCOND, W, INFO )
546 CALL CHKXER( 'cspcon', INFOT, NOUT, LERR, OK )
547*
548 ELSE IF( LSAMEN( 2, C2, 'sa' ) ) THEN
549*
550* Test error exits of the routines that use factorization
551* of a symmetric indefinite matrix with Aasen's algorithm
552*
553* CSYTRF_AA
554*
555 SRNAMT = 'csytrf_aa'
556 INFOT = 1
557 CALL CSYTRF_AA( '/', 0, A, 1, IP, W, 1, INFO )
558 CALL CHKXER( 'csytrf_aa', INFOT, NOUT, LERR, OK )
559 INFOT = 2
560 CALL CSYTRF_AA( 'u', -1, A, 1, IP, W, 1, INFO )
561 CALL CHKXER( 'csytrf_aa', INFOT, NOUT, LERR, OK )
562 INFOT = 4
563 CALL CSYTRF_AA( 'u', 2, A, 1, IP, W, 4, INFO )
564 CALL CHKXER( 'csytrf_aa', INFOT, NOUT, LERR, OK )
565 INFOT = 7
566 CALL CSYTRF_AA( 'u', 0, A, 1, IP, W, 0, INFO )
567 CALL CHKXER( 'csytrf_aa', INFOT, NOUT, LERR, OK )
568 INFOT = 7
569 CALL CSYTRF_AA( 'u', 0, A, 1, IP, W, -2, INFO )
570 CALL CHKXER( 'csytrf_aa', INFOT, NOUT, LERR, OK )
571*
572* CSYTRS_AA
573*
574 SRNAMT = 'csytrs_aa'
575 INFOT = 1
576 CALL CSYTRS_AA( '/', 0, 0, A, 1, IP, B, 1, W, 1, INFO )
577 CALL CHKXER( 'csytrs_aa', INFOT, NOUT, LERR, OK )
578 INFOT = 2
579 CALL CSYTRS_AA( 'u', -1, 0, A, 1, IP, B, 1, W, 1, INFO )
580 CALL CHKXER( 'csytrs_aa', INFOT, NOUT, LERR, OK )
581 INFOT = 3
582 CALL CSYTRS_AA( 'u', 0, -1, A, 1, IP, B, 1, W, 1, INFO )
583 CALL CHKXER( 'csytrs_aa', INFOT, NOUT, LERR, OK )
584 INFOT = 5
585 CALL CSYTRS_AA( 'u', 2, 1, A, 1, IP, B, 2, W, 1, INFO )
586 CALL CHKXER( 'csytrs_aa', INFOT, NOUT, LERR, OK )
587 INFOT = 8
588 CALL CSYTRS_AA( 'u', 2, 1, A, 2, IP, B, 1, W, 1, INFO )
589 CALL CHKXER( 'csytrs_aa', INFOT, NOUT, LERR, OK )
590 INFOT = 10
591 CALL CSYTRS_AA( 'u', 0, 1, A, 1, IP, B, 1, W, 0, INFO )
592 CALL CHKXER( 'csytrs_aa', INFOT, NOUT, LERR, OK )
593 INFOT = 10
594 CALL CSYTRS_AA( 'u', 0, 1, A, 1, IP, B, 1, W, -2, INFO )
595 CALL CHKXER( 'csytrs_aa', INFOT, NOUT, LERR, OK )
596*
597 ELSE IF( LSAMEN( 2, C2, 's2' ) ) THEN
598*
599* Test error exits of the routines that use factorization
600* of a symmetric indefinite matrix with Aasen's algorithm.
601*
602* CSYTRF_AA_2STAGE
603*
604 SRNAMT = 'csytrf_aa_2stage'
605 INFOT = 1
606 CALL CSYTRF_AA_2STAGE( '/', 0, A, 1, A, 1, IP, IP, W, 1,
607 $ INFO )
608 CALL CHKXER( 'csytrf_aa_2stage', INFOT, NOUT, LERR, OK )
609 INFOT = 2
610 CALL CSYTRF_AA_2STAGE( 'u', -1, A, 1, A, 1, IP, IP, W, 1,
611 $ INFO )
612 CALL CHKXER( 'csytrf_aa_2stage', INFOT, NOUT, LERR, OK )
613 INFOT = 4
614 CALL CSYTRF_AA_2STAGE( 'u', 2, A, 1, A, 2, IP, IP, W, 1,
615 $ INFO )
616 CALL CHKXER( 'csytrf_aa_2stage', INFOT, NOUT, LERR, OK )
617 INFOT = 6
618 CALL CSYTRF_AA_2STAGE( 'u', 2, A, 2, A, 1, IP, IP, W, 1,
619 $ INFO )
620 CALL CHKXER( 'csytrf_aa_2stage', INFOT, NOUT, LERR, OK )
621 INFOT = 10
622 CALL CSYTRF_AA_2STAGE( 'u', 2, A, 2, A, 8, IP, IP, W, 0,
623 $ INFO )
624 CALL CHKXER( 'csytrf_aa_2stage', INFOT, NOUT, LERR, OK )
625*
626* CHETRS_AA_2STAGE
627*
628 SRNAMT = 'csytrs_aa_2stage'
629 INFOT = 1
630 CALL CSYTRS_AA_2STAGE( '/', 0, 0, A, 1, A, 1, IP, IP,
631 $ B, 1, INFO )
632 CALL CHKXER( 'csytrs_aa_2stage', INFOT, NOUT, LERR, OK )
633 INFOT = 2
634 CALL CSYTRS_AA_2STAGE( 'u', -1, 0, A, 1, A, 1, IP, IP,
635 $ B, 1, INFO )
636 CALL CHKXER( 'csytrs_aa_2stage', INFOT, NOUT, LERR, OK )
637 INFOT = 3
638 CALL CSYTRS_AA_2STAGE( 'u', 0, -1, A, 1, A, 1, IP, IP,
639 $ B, 1, INFO )
640 CALL CHKXER( 'csytrs_aa_2stage', INFOT, NOUT, LERR, OK )
641 INFOT = 5
642 CALL CSYTRS_AA_2STAGE( 'u', 2, 1, A, 1, A, 1, IP, IP,
643 $ B, 1, INFO )
644 CALL CHKXER( 'csytrs_aa_2stage', INFOT, NOUT, LERR, OK )
645 INFOT = 7
646 CALL CSYTRS_AA_2STAGE( 'u', 2, 1, A, 2, A, 1, IP, IP,
647 $ B, 1, INFO )
648 CALL CHKXER( 'csytrs_aa_2stage', INFOT, NOUT, LERR, OK )
649 INFOT = 11
650 CALL CSYTRS_AA_2STAGE( 'u', 2, 1, A, 2, A, 8, IP, IP,
651 $ B, 1, INFO )
652 CALL CHKXER( 'csytrs_aa_stage', INFOT, NOUT, LERR, OK )
653*
654 END IF
655*
656* Print a summary line.
657*
658 CALL ALAESM( PATH, OK, NOUT )
659*
660 RETURN
661*
662* End of CERRSY
663*
664 END
cmplx
float cmplx[2]
Definition pblas.h:136
chkxer
subroutine chkxer(srnamt, infot, nout, lerr, ok)
Definition cblat2.f:3196
alaesm
subroutine alaesm(path, ok, nout)
ALAESM
Definition alaesm.f:63
csptri
subroutine csptri(uplo, n, ap, ipiv, work, info)
CSPTRI
Definition csptri.f:109
csptrf
subroutine csptrf(uplo, n, ap, ipiv, info)
CSPTRF
Definition csptrf.f:158
cspcon
subroutine cspcon(uplo, n, ap, ipiv, anorm, rcond, work, info)
CSPCON
Definition cspcon.f:118
csprfs
subroutine csprfs(uplo, n, nrhs, ap, afp, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CSPRFS
Definition csprfs.f:180
csptrs
subroutine csptrs(uplo, n, nrhs, ap, ipiv, b, ldb, info)
CSPTRS
Definition csptrs.f:115
csytrf_aa_2stage
subroutine csytrf_aa_2stage(uplo, n, a, lda, tb, ltb, ipiv, ipiv2, work, lwork, info)
CSYTRF_AA_2STAGE
Definition csytrf_aa_2stage.f:160
csytrs_rook
subroutine csytrs_rook(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
CSYTRS_ROOK
Definition csytrs_rook.f:136
csytf2_rk
subroutine csytf2_rk(uplo, n, a, lda, e, ipiv, info)
CSYTF2_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch...
Definition csytf2_rk.f:241
csytrs_aa_2stage
subroutine csytrs_aa_2stage(uplo, n, nrhs, a, lda, tb, ltb, ipiv, ipiv2, b, ldb, info)
CSYTRS_AA_2STAGE
Definition csytrs_aa_2stage.f:139
csytrf_rook
subroutine csytrf_rook(uplo, n, a, lda, ipiv, work, lwork, info)
CSYTRF_ROOK
Definition csytrf_rook.f:208
csytrs
subroutine csytrs(uplo, n, nrhs, a, lda, ipiv, b, ldb, info)
CSYTRS
Definition csytrs.f:120
csytrf_rk
subroutine csytrf_rk(uplo, n, a, lda, e, ipiv, work, lwork, info)
CSYTRF_RK computes the factorization of a complex symmetric indefinite matrix using the bounded Bunch...
Definition csytrf_rk.f:259
csytri_3
subroutine csytri_3(uplo, n, a, lda, e, ipiv, work, lwork, info)
CSYTRI_3
Definition csytri_3.f:170
csycon
subroutine csycon(uplo, n, a, lda, ipiv, anorm, rcond, work, info)
CSYCON
Definition csycon.f:125
csytri2x
subroutine csytri2x(uplo, n, a, lda, ipiv, work, nb, info)
CSYTRI2X
Definition csytri2x.f:120
csycon_3
subroutine csycon_3(uplo, n, a, lda, e, ipiv, anorm, rcond, work, info)
CSYCON_3
Definition csycon_3.f:166
csytf2_rook
subroutine csytf2_rook(uplo, n, a, lda, ipiv, info)
CSYTF2_ROOK computes the factorization of a complex symmetric indefinite matrix using the bounded Bun...
Definition csytf2_rook.f:194
csytrf_aa
subroutine csytrf_aa(uplo, n, a, lda, ipiv, work, lwork, info)
CSYTRF_AA
Definition csytrf_aa.f:132
csytrf
subroutine csytrf(uplo, n, a, lda, ipiv, work, lwork, info)
CSYTRF
Definition csytrf.f:182
csycon_rook
subroutine csycon_rook(uplo, n, a, lda, ipiv, anorm, rcond, work, info)
CSYCON_ROOK
Definition csycon_rook.f:139
csyrfs
subroutine csyrfs(uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, ferr, berr, work, rwork, info)
CSYRFS
Definition csyrfs.f:192
csytri_rook
subroutine csytri_rook(uplo, n, a, lda, ipiv, work, info)
CSYTRI_ROOK
Definition csytri_rook.f:129
csytri
subroutine csytri(uplo, n, a, lda, ipiv, work, info)
CSYTRI
Definition csytri.f:114
csytf2
subroutine csytf2(uplo, n, a, lda, ipiv, info)
CSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...
Definition csytf2.f:191
csytri2
subroutine csytri2(uplo, n, a, lda, ipiv, work, lwork, info)
CSYTRI2
Definition csytri2.f:127
csytrs_3
subroutine csytrs_3(uplo, n, nrhs, a, lda, e, ipiv, b, ldb, info)
CSYTRS_3
Definition csytrs_3.f:165
csytrs_aa
subroutine csytrs_aa(uplo, n, nrhs, a, lda, ipiv, b, ldb, work, lwork, info)
CSYTRS_AA
Definition csytrs_aa.f:131
csytri_3x
subroutine csytri_3x(uplo, n, a, lda, e, ipiv, work, nb, info)
CSYTRI_3X
Definition csytri_3x.f:159
cerrsy
subroutine cerrsy(path, nunit)
CERRSY
Definition cerrsy.f:55