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