LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
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 *> \date November 2013
52 *
53 *> \ingroup complex_lin
54 *
55 * =====================================================================
56  SUBROUTINE cerrsy( PATH, NUNIT )
57 *
58 * -- LAPACK test routine (version 3.5.0) --
59 * -- LAPACK is a software package provided by Univ. of Tennessee, --
60 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
61 * November 2013
62 *
63 * .. Scalar Arguments ..
64  CHARACTER*3 PATH
65  INTEGER NUNIT
66 * ..
67 *
68 * =====================================================================
69 *
70 * .. Parameters ..
71  INTEGER NMAX
72  parameter ( nmax = 4 )
73 * ..
74 * .. Local Scalars ..
75  CHARACTER*2 C2
76  INTEGER I, INFO, J
77  REAL ANRM, RCOND
78 * ..
79 * .. Local Arrays ..
80  INTEGER IP( nmax )
81  REAL R( nmax ), R1( nmax ), R2( nmax )
82  COMPLEX A( nmax, nmax ), AF( nmax, nmax ), B( nmax ),
83  $ w( 2*nmax ), x( nmax )
84 * ..
85 * .. External Functions ..
86  LOGICAL LSAMEN
87  EXTERNAL lsamen
88 * ..
89 * .. External Subroutines ..
90  EXTERNAL alaesm, chkxer, cspcon, csprfs, csptrf, csptri,
91  $ csptrs, csycon, csycon_rook, csyrfs, csytf2,
92  $ csytf2_rook, csytrf, csytrf_rook, csytri,
93  $ csytri_rook, csytri2, csytrs, csytrs_rook
94 * ..
95 * .. Scalars in Common ..
96  LOGICAL LERR, OK
97  CHARACTER*32 SRNAMT
98  INTEGER INFOT, NOUT
99 * ..
100 * .. Common blocks ..
101  COMMON / infoc / infot, nout, ok, lerr
102  COMMON / srnamc / srnamt
103 * ..
104 * .. Intrinsic Functions ..
105  INTRINSIC cmplx, real
106 * ..
107 * .. Executable Statements ..
108 *
109  nout = nunit
110  WRITE( nout, fmt = * )
111  c2 = path( 2: 3 )
112 *
113 * Set the variables to innocuous values.
114 *
115  DO 20 j = 1, nmax
116  DO 10 i = 1, nmax
117  a( i, j ) = cmplx( 1. / REAL( I+J ), -1. / REAL( I+J ) )
118  af( i, j ) = cmplx( 1. / REAL( I+J ), -1. / REAL( I+J ) )
119  10 CONTINUE
120  b( j ) = 0.
121  r1( j ) = 0.
122  r2( j ) = 0.
123  w( j ) = 0.
124  x( j ) = 0.
125  ip( j ) = j
126  20 CONTINUE
127  anrm = 1.0
128  ok = .true.
129 *
130 * Test error exits of the routines that use factorization
131 * of a symmetric indefinite matrix with patrial
132 * (Bunch-Kaufman) diagonal pivoting method.
133 *
134  IF( lsamen( 2, c2, 'SY' ) ) THEN
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 *
149 * CSYTF2
150 *
151  srnamt = 'CSYTF2'
152  infot = 1
153  CALL csytf2( '/', 0, a, 1, ip, info )
154  CALL chkxer( 'CSYTF2', infot, nout, lerr, ok )
155  infot = 2
156  CALL csytf2( 'U', -1, a, 1, ip, info )
157  CALL chkxer( 'CSYTF2', infot, nout, lerr, ok )
158  infot = 4
159  CALL csytf2( 'U', 2, a, 1, ip, info )
160  CALL chkxer( 'CSYTF2', infot, nout, lerr, ok )
161 *
162 * CSYTRI
163 *
164  srnamt = 'CSYTRI'
165  infot = 1
166  CALL csytri( '/', 0, a, 1, ip, w, info )
167  CALL chkxer( 'CSYTRI', infot, nout, lerr, ok )
168  infot = 2
169  CALL csytri( 'U', -1, a, 1, ip, w, info )
170  CALL chkxer( 'CSYTRI', infot, nout, lerr, ok )
171  infot = 4
172  CALL csytri( 'U', 2, a, 1, ip, w, info )
173  CALL chkxer( 'CSYTRI', infot, nout, lerr, ok )
174 *
175 * CSYTRI2
176 *
177  srnamt = 'CSYTRI2'
178  infot = 1
179  CALL csytri2( '/', 0, a, 1, ip, w, 1, info )
180  CALL chkxer( 'CSYTRI2', infot, nout, lerr, ok )
181  infot = 2
182  CALL csytri2( 'U', -1, a, 1, ip, w, 1, info )
183  CALL chkxer( 'CSYTRI2', infot, nout, lerr, ok )
184  infot = 4
185  CALL csytri2( 'U', 2, a, 1, ip, w, 1, info )
186  CALL chkxer( 'CSYTRI2', infot, nout, lerr, ok )
187 *
188 * CSYTRS
189 *
190  srnamt = 'CSYTRS'
191  infot = 1
192  CALL csytrs( '/', 0, 0, a, 1, ip, b, 1, info )
193  CALL chkxer( 'CSYTRS', infot, nout, lerr, ok )
194  infot = 2
195  CALL csytrs( 'U', -1, 0, a, 1, ip, b, 1, info )
196  CALL chkxer( 'CSYTRS', infot, nout, lerr, ok )
197  infot = 3
198  CALL csytrs( 'U', 0, -1, a, 1, ip, b, 1, info )
199  CALL chkxer( 'CSYTRS', infot, nout, lerr, ok )
200  infot = 5
201  CALL csytrs( 'U', 2, 1, a, 1, ip, b, 2, info )
202  CALL chkxer( 'CSYTRS', infot, nout, lerr, ok )
203  infot = 8
204  CALL csytrs( 'U', 2, 1, a, 2, ip, b, 1, info )
205  CALL chkxer( 'CSYTRS', infot, nout, lerr, ok )
206 *
207 * CSYRFS
208 *
209  srnamt = 'CSYRFS'
210  infot = 1
211  CALL csyrfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
212  $ r, info )
213  CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
214  infot = 2
215  CALL csyrfs( 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
216  $ w, r, info )
217  CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
218  infot = 3
219  CALL csyrfs( 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
220  $ w, r, info )
221  CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
222  infot = 5
223  CALL csyrfs( 'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
224  $ r, info )
225  CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
226  infot = 7
227  CALL csyrfs( 'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
228  $ r, info )
229  CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
230  infot = 10
231  CALL csyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
232  $ r, info )
233  CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
234  infot = 12
235  CALL csyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
236  $ r, info )
237  CALL chkxer( 'CSYRFS', infot, nout, lerr, ok )
238 *
239 * CSYCON
240 *
241  srnamt = 'CSYCON'
242  infot = 1
243  CALL csycon( '/', 0, a, 1, ip, anrm, rcond, w, info )
244  CALL chkxer( 'CSYCON', infot, nout, lerr, ok )
245  infot = 2
246  CALL csycon( 'U', -1, a, 1, ip, anrm, rcond, w, info )
247  CALL chkxer( 'CSYCON', infot, nout, lerr, ok )
248  infot = 4
249  CALL csycon( 'U', 2, a, 1, ip, anrm, rcond, w, info )
250  CALL chkxer( 'CSYCON', infot, nout, lerr, ok )
251  infot = 6
252  CALL csycon( 'U', 1, a, 1, ip, -anrm, rcond, w, info )
253  CALL chkxer( 'CSYCON', infot, nout, lerr, ok )
254 *
255 * Test error exits of the routines that use factorization
256 * of a symmetric indefinite matrix with "rook"
257 * (bounded Bunch-Kaufman) diagonal pivoting method.
258 *
259  ELSE IF( lsamen( 2, c2, 'SR' ) ) THEN
260 *
261 * CSYTRF_ROOK
262 *
263  srnamt = 'CSYTRF_ROOK'
264  infot = 1
265  CALL csytrf_rook( '/', 0, a, 1, ip, w, 1, info )
266  CALL chkxer( 'CSYTRF_ROOK', infot, nout, lerr, ok )
267  infot = 2
268  CALL csytrf_rook( 'U', -1, a, 1, ip, w, 1, info )
269  CALL chkxer( 'CSYTRF_ROOK', infot, nout, lerr, ok )
270  infot = 4
271  CALL csytrf_rook( 'U', 2, a, 1, ip, w, 4, info )
272  CALL chkxer( 'CSYTRF_ROOK', infot, nout, lerr, ok )
273 *
274 * CSYTF2_ROOK
275 *
276  srnamt = 'CSYTF2_ROOK'
277  infot = 1
278  CALL csytf2_rook( '/', 0, a, 1, ip, info )
279  CALL chkxer( 'CSYTF2_ROOK', infot, nout, lerr, ok )
280  infot = 2
281  CALL csytf2_rook( 'U', -1, a, 1, ip, info )
282  CALL chkxer( 'CSYTF2_ROOK', infot, nout, lerr, ok )
283  infot = 4
284  CALL csytf2_rook( 'U', 2, a, 1, ip, info )
285  CALL chkxer( 'CSYTF2_ROOK', infot, nout, lerr, ok )
286 *
287 * CSYTRI_ROOK
288 *
289  srnamt = 'CSYTRI_ROOK'
290  infot = 1
291  CALL csytri_rook( '/', 0, a, 1, ip, w, info )
292  CALL chkxer( 'CSYTRI_ROOK', infot, nout, lerr, ok )
293  infot = 2
294  CALL csytri_rook( 'U', -1, a, 1, ip, w, info )
295  CALL chkxer( 'CSYTRI_ROOK', infot, nout, lerr, ok )
296  infot = 4
297  CALL csytri_rook( 'U', 2, a, 1, ip, w, info )
298  CALL chkxer( 'CSYTRI_ROOK', infot, nout, lerr, ok )
299 *
300 * CSYTRS_ROOK
301 *
302  srnamt = 'CSYTRS_ROOK'
303  infot = 1
304  CALL csytrs_rook( '/', 0, 0, a, 1, ip, b, 1, info )
305  CALL chkxer( 'CSYTRS_ROOK', infot, nout, lerr, ok )
306  infot = 2
307  CALL csytrs_rook( 'U', -1, 0, a, 1, ip, b, 1, info )
308  CALL chkxer( 'CSYTRS_ROOK', infot, nout, lerr, ok )
309  infot = 3
310  CALL csytrs_rook( 'U', 0, -1, a, 1, ip, b, 1, info )
311  CALL chkxer( 'CSYTRS_ROOK', infot, nout, lerr, ok )
312  infot = 5
313  CALL csytrs_rook( 'U', 2, 1, a, 1, ip, b, 2, info )
314  CALL chkxer( 'CSYTRS_ROOK', infot, nout, lerr, ok )
315  infot = 8
316  CALL csytrs_rook( 'U', 2, 1, a, 2, ip, b, 1, info )
317  CALL chkxer( 'CSYTRS_ROOK', infot, nout, lerr, ok )
318 *
319 * CSYCON_ROOK
320 *
321  srnamt = 'CSYCON_ROOK'
322  infot = 1
323  CALL csycon_rook( '/', 0, a, 1, ip, anrm, rcond, w, info )
324  CALL chkxer( 'CSYCON_ROOK', infot, nout, lerr, ok )
325  infot = 2
326  CALL csycon_rook( 'U', -1, a, 1, ip, anrm, rcond, w, info )
327  CALL chkxer( 'CSYCON_ROOK', infot, nout, lerr, ok )
328  infot = 4
329  CALL csycon_rook( 'U', 2, a, 1, ip, anrm, rcond, w, info )
330  CALL chkxer( 'CSYCON_ROOK', infot, nout, lerr, ok )
331  infot = 6
332  CALL csycon_rook( 'U', 1, a, 1, ip, -anrm, rcond, w, info )
333  CALL chkxer( 'CSYCON_ROOK', infot, nout, lerr, ok )
334 *
335 * Test error exits of the routines that use factorization
336 * of a symmetric indefinite packed matrix with patrial
337 * (Bunch-Kaufman) diagonal pivoting method.
338 *
339  ELSE IF( lsamen( 2, c2, 'SP' ) ) THEN
340 *
341 * CSPTRF
342 *
343  srnamt = 'CSPTRF'
344  infot = 1
345  CALL csptrf( '/', 0, a, ip, info )
346  CALL chkxer( 'CSPTRF', infot, nout, lerr, ok )
347  infot = 2
348  CALL csptrf( 'U', -1, a, ip, info )
349  CALL chkxer( 'CSPTRF', infot, nout, lerr, ok )
350 *
351 * CSPTRI
352 *
353  srnamt = 'CSPTRI'
354  infot = 1
355  CALL csptri( '/', 0, a, ip, w, info )
356  CALL chkxer( 'CSPTRI', infot, nout, lerr, ok )
357  infot = 2
358  CALL csptri( 'U', -1, a, ip, w, info )
359  CALL chkxer( 'CSPTRI', infot, nout, lerr, ok )
360 *
361 * CSPTRS
362 *
363  srnamt = 'CSPTRS'
364  infot = 1
365  CALL csptrs( '/', 0, 0, a, ip, b, 1, info )
366  CALL chkxer( 'CSPTRS', infot, nout, lerr, ok )
367  infot = 2
368  CALL csptrs( 'U', -1, 0, a, ip, b, 1, info )
369  CALL chkxer( 'CSPTRS', infot, nout, lerr, ok )
370  infot = 3
371  CALL csptrs( 'U', 0, -1, a, ip, b, 1, info )
372  CALL chkxer( 'CSPTRS', infot, nout, lerr, ok )
373  infot = 7
374  CALL csptrs( 'U', 2, 1, a, ip, b, 1, info )
375  CALL chkxer( 'CSPTRS', infot, nout, lerr, ok )
376 *
377 * CSPRFS
378 *
379  srnamt = 'CSPRFS'
380  infot = 1
381  CALL csprfs( '/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
382  $ info )
383  CALL chkxer( 'CSPRFS', infot, nout, lerr, ok )
384  infot = 2
385  CALL csprfs( 'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
386  $ info )
387  CALL chkxer( 'CSPRFS', infot, nout, lerr, ok )
388  infot = 3
389  CALL csprfs( 'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
390  $ info )
391  CALL chkxer( 'CSPRFS', infot, nout, lerr, ok )
392  infot = 8
393  CALL csprfs( 'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
394  $ info )
395  CALL chkxer( 'CSPRFS', infot, nout, lerr, ok )
396  infot = 10
397  CALL csprfs( 'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
398  $ info )
399  CALL chkxer( 'CSPRFS', infot, nout, lerr, ok )
400 *
401 * CSPCON
402 *
403  srnamt = 'CSPCON'
404  infot = 1
405  CALL cspcon( '/', 0, a, ip, anrm, rcond, w, info )
406  CALL chkxer( 'CSPCON', infot, nout, lerr, ok )
407  infot = 2
408  CALL cspcon( 'U', -1, a, ip, anrm, rcond, w, info )
409  CALL chkxer( 'CSPCON', infot, nout, lerr, ok )
410  infot = 5
411  CALL cspcon( 'U', 1, a, ip, -anrm, rcond, w, info )
412  CALL chkxer( 'CSPCON', infot, nout, lerr, ok )
413  END IF
414 *
415 * Print a summary line.
416 *
417  CALL alaesm( path, ok, nout )
418 *
419  RETURN
420 *
421 * End of CERRSY
422 *
423  END
csytri_rook
subroutine csytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
CSYTRI_ROOK
Definition: csytri_rook.f:131
csyrfs
subroutine csyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CSYRFS
Definition: csyrfs.f:194
cerrsy
subroutine cerrsy(PATH, NUNIT)
CERRSY
Definition: cerrsy.f:57
cspcon
subroutine cspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
CSPCON
Definition: cspcon.f:120
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
csytrs
subroutine csytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CSYTRS
Definition: csytrs.f:122
csytri
subroutine csytri(UPLO, N, A, LDA, IPIV, WORK, INFO)
CSYTRI
Definition: csytri.f:116
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
csptrf
subroutine csptrf(UPLO, N, AP, IPIV, INFO)
CSPTRF
Definition: csptrf.f:160
csptrs
subroutine csptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
CSPTRS
Definition: csptrs.f:117
csytrs_rook
subroutine csytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CSYTRS_ROOK
Definition: csytrs_rook.f:138
csytrf
subroutine csytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF
Definition: csytrf.f:184
csytrf_rook
subroutine csytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF_ROOK
Definition: csytrf_rook.f:210
csycon
subroutine csycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CSYCON
Definition: csycon.f:127
csprfs
subroutine csprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CSPRFS
Definition: csprfs.f:182
csptri
subroutine csptri(UPLO, N, AP, IPIV, WORK, INFO)
CSPTRI
Definition: csptri.f:111
csycon_rook
subroutine csycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CSYCON_ROOK
Definition: csycon_rook.f:141
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:196
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:193
csytri2
subroutine csytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRI2
Definition: csytri2.f:129