LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
zerrsy.f
Go to the documentation of this file.
1 *> \brief \b ZERRSY
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 ZERRSY( 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 *> ZERRSY tests the error exits for the COMPLEX*16 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 complex16_lin
54 *
55 * =====================================================================
56  SUBROUTINE zerrsy( 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  DOUBLE PRECISION ANRM, RCOND
78 * ..
79 * .. Local Arrays ..
80  INTEGER IP( nmax )
81  DOUBLE PRECISION R( nmax ), R1( nmax ), R2( nmax )
82  COMPLEX*16 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, zspcon, zsprfs, zsptrf, zsptri,
91  $ zsptrs, zsycon, zsycon_rook, zsyrfs, zsytf2,
92  $ zsytf2_rook, zsytrf, zsytrf_rook, zsytri,
93  $ zsytri_rook, zsytri2, zsytrs, zsytrs_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 dble, dcmplx
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 ) = dcmplx( 1.d0 / dble( i+j ),
118  $ -1.d0 / dble( i+j ) )
119  af( i, j ) = dcmplx( 1.d0 / dble( i+j ),
120  $ -1.d0 / dble( i+j ) )
121  10 CONTINUE
122  b( j ) = 0.d0
123  r1( j ) = 0.d0
124  r2( j ) = 0.d0
125  w( j ) = 0.d0
126  x( j ) = 0.d0
127  ip( j ) = j
128  20 CONTINUE
129  anrm = 1.0d0
130  ok = .true.
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  IF( lsamen( 2, c2, 'SY' ) ) THEN
137 *
138 * ZSYTRF
139 *
140  srnamt = 'ZSYTRF'
141  infot = 1
142  CALL zsytrf( '/', 0, a, 1, ip, w, 1, info )
143  CALL chkxer( 'ZSYTRF', infot, nout, lerr, ok )
144  infot = 2
145  CALL zsytrf( 'U', -1, a, 1, ip, w, 1, info )
146  CALL chkxer( 'ZSYTRF', infot, nout, lerr, ok )
147  infot = 4
148  CALL zsytrf( 'U', 2, a, 1, ip, w, 4, info )
149  CALL chkxer( 'ZSYTRF', infot, nout, lerr, ok )
150 *
151 * ZSYTF2
152 *
153  srnamt = 'ZSYTF2'
154  infot = 1
155  CALL zsytf2( '/', 0, a, 1, ip, info )
156  CALL chkxer( 'ZSYTF2', infot, nout, lerr, ok )
157  infot = 2
158  CALL zsytf2( 'U', -1, a, 1, ip, info )
159  CALL chkxer( 'ZSYTF2', infot, nout, lerr, ok )
160  infot = 4
161  CALL zsytf2( 'U', 2, a, 1, ip, info )
162  CALL chkxer( 'ZSYTF2', infot, nout, lerr, ok )
163 *
164 * ZSYTRI
165 *
166  srnamt = 'ZSYTRI'
167  infot = 1
168  CALL zsytri( '/', 0, a, 1, ip, w, info )
169  CALL chkxer( 'ZSYTRI', infot, nout, lerr, ok )
170  infot = 2
171  CALL zsytri( 'U', -1, a, 1, ip, w, info )
172  CALL chkxer( 'ZSYTRI', infot, nout, lerr, ok )
173  infot = 4
174  CALL zsytri( 'U', 2, a, 1, ip, w, info )
175  CALL chkxer( 'ZSYTRI', infot, nout, lerr, ok )
176 *
177 * ZSYTRI2
178 *
179  srnamt = 'ZSYTRI2'
180  infot = 1
181  CALL zsytri2( '/', 0, a, 1, ip, w, 1, info )
182  CALL chkxer( 'ZSYTRI2', infot, nout, lerr, ok )
183  infot = 2
184  CALL zsytri2( 'U', -1, a, 1, ip, w, 1, info )
185  CALL chkxer( 'ZSYTRI2', infot, nout, lerr, ok )
186  infot = 4
187  CALL zsytri2( 'U', 2, a, 1, ip, w, 1, info )
188  CALL chkxer( 'ZSYTRI2', infot, nout, lerr, ok )
189 *
190 * ZSYTRS
191 *
192  srnamt = 'ZSYTRS'
193  infot = 1
194  CALL zsytrs( '/', 0, 0, a, 1, ip, b, 1, info )
195  CALL chkxer( 'ZSYTRS', infot, nout, lerr, ok )
196  infot = 2
197  CALL zsytrs( 'U', -1, 0, a, 1, ip, b, 1, info )
198  CALL chkxer( 'ZSYTRS', infot, nout, lerr, ok )
199  infot = 3
200  CALL zsytrs( 'U', 0, -1, a, 1, ip, b, 1, info )
201  CALL chkxer( 'ZSYTRS', infot, nout, lerr, ok )
202  infot = 5
203  CALL zsytrs( 'U', 2, 1, a, 1, ip, b, 2, info )
204  CALL chkxer( 'ZSYTRS', infot, nout, lerr, ok )
205  infot = 8
206  CALL zsytrs( 'U', 2, 1, a, 2, ip, b, 1, info )
207  CALL chkxer( 'ZSYTRS', infot, nout, lerr, ok )
208 *
209 * ZSYRFS
210 *
211  srnamt = 'ZSYRFS'
212  infot = 1
213  CALL zsyrfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
214  $ r, info )
215  CALL chkxer( 'ZSYRFS', infot, nout, lerr, ok )
216  infot = 2
217  CALL zsyrfs( 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
218  $ w, r, info )
219  CALL chkxer( 'ZSYRFS', infot, nout, lerr, ok )
220  infot = 3
221  CALL zsyrfs( 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
222  $ w, r, info )
223  CALL chkxer( 'ZSYRFS', infot, nout, lerr, ok )
224  infot = 5
225  CALL zsyrfs( 'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
226  $ r, info )
227  CALL chkxer( 'ZSYRFS', infot, nout, lerr, ok )
228  infot = 7
229  CALL zsyrfs( 'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
230  $ r, info )
231  CALL chkxer( 'ZSYRFS', infot, nout, lerr, ok )
232  infot = 10
233  CALL zsyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
234  $ r, info )
235  CALL chkxer( 'ZSYRFS', infot, nout, lerr, ok )
236  infot = 12
237  CALL zsyrfs( 'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
238  $ r, info )
239  CALL chkxer( 'ZSYRFS', infot, nout, lerr, ok )
240 *
241 * ZSYCON
242 *
243  srnamt = 'ZSYCON'
244  infot = 1
245  CALL zsycon( '/', 0, a, 1, ip, anrm, rcond, w, info )
246  CALL chkxer( 'ZSYCON', infot, nout, lerr, ok )
247  infot = 2
248  CALL zsycon( 'U', -1, a, 1, ip, anrm, rcond, w, info )
249  CALL chkxer( 'ZSYCON', infot, nout, lerr, ok )
250  infot = 4
251  CALL zsycon( 'U', 2, a, 1, ip, anrm, rcond, w, info )
252  CALL chkxer( 'ZSYCON', infot, nout, lerr, ok )
253  infot = 6
254  CALL zsycon( 'U', 1, a, 1, ip, -anrm, rcond, w, info )
255  CALL chkxer( 'ZSYCON', infot, nout, lerr, ok )
256 *
257 * Test error exits of the routines that use factorization
258 * of a symmetric indefinite matrix with "rook"
259 * (bounded Bunch-Kaufman) diagonal pivoting method.
260 *
261  ELSE IF( lsamen( 2, c2, 'SR' ) ) THEN
262 *
263 * ZSYTRF_ROOK
264 *
265  srnamt = 'ZSYTRF_ROOK'
266  infot = 1
267  CALL zsytrf_rook( '/', 0, a, 1, ip, w, 1, info )
268  CALL chkxer( 'ZSYTRF_ROOK', infot, nout, lerr, ok )
269  infot = 2
270  CALL zsytrf_rook( 'U', -1, a, 1, ip, w, 1, info )
271  CALL chkxer( 'ZSYTRF_ROOK', infot, nout, lerr, ok )
272  infot = 4
273  CALL zsytrf_rook( 'U', 2, a, 1, ip, w, 4, info )
274  CALL chkxer( 'ZSYTRF_ROOK', infot, nout, lerr, ok )
275 *
276 * ZSYTF2_ROOK
277 *
278  srnamt = 'ZSYTF2_ROOK'
279  infot = 1
280  CALL zsytf2_rook( '/', 0, a, 1, ip, info )
281  CALL chkxer( 'ZSYTF2_ROOK', infot, nout, lerr, ok )
282  infot = 2
283  CALL zsytf2_rook( 'U', -1, a, 1, ip, info )
284  CALL chkxer( 'ZSYTF2_ROOK', infot, nout, lerr, ok )
285  infot = 4
286  CALL zsytf2_rook( 'U', 2, a, 1, ip, info )
287  CALL chkxer( 'ZSYTF2_ROOK', infot, nout, lerr, ok )
288 *
289 * ZSYTRI_ROOK
290 *
291  srnamt = 'ZSYTRI_ROOK'
292  infot = 1
293  CALL zsytri_rook( '/', 0, a, 1, ip, w, info )
294  CALL chkxer( 'ZSYTRI_ROOK', infot, nout, lerr, ok )
295  infot = 2
296  CALL zsytri_rook( 'U', -1, a, 1, ip, w, info )
297  CALL chkxer( 'ZSYTRI_ROOK', infot, nout, lerr, ok )
298  infot = 4
299  CALL zsytri_rook( 'U', 2, a, 1, ip, w, info )
300  CALL chkxer( 'ZSYTRI_ROOK', infot, nout, lerr, ok )
301 *
302 * ZSYTRS_ROOK
303 *
304  srnamt = 'ZSYTRS_ROOK'
305  infot = 1
306  CALL zsytrs_rook( '/', 0, 0, a, 1, ip, b, 1, info )
307  CALL chkxer( 'ZSYTRS_ROOK', infot, nout, lerr, ok )
308  infot = 2
309  CALL zsytrs_rook( 'U', -1, 0, a, 1, ip, b, 1, info )
310  CALL chkxer( 'ZSYTRS_ROOK', infot, nout, lerr, ok )
311  infot = 3
312  CALL zsytrs_rook( 'U', 0, -1, a, 1, ip, b, 1, info )
313  CALL chkxer( 'ZSYTRS_ROOK', infot, nout, lerr, ok )
314  infot = 5
315  CALL zsytrs_rook( 'U', 2, 1, a, 1, ip, b, 2, info )
316  CALL chkxer( 'ZSYTRS_ROOK', infot, nout, lerr, ok )
317  infot = 8
318  CALL zsytrs_rook( 'U', 2, 1, a, 2, ip, b, 1, info )
319  CALL chkxer( 'ZSYTRS_ROOK', infot, nout, lerr, ok )
320 *
321 * ZSYCON_ROOK
322 *
323  srnamt = 'ZSYCON_ROOK'
324  infot = 1
325  CALL zsycon_rook( '/', 0, a, 1, ip, anrm, rcond, w, info )
326  CALL chkxer( 'ZSYCON_ROOK', infot, nout, lerr, ok )
327  infot = 2
328  CALL zsycon_rook( 'U', -1, a, 1, ip, anrm, rcond, w, info )
329  CALL chkxer( 'ZSYCON_ROOK', infot, nout, lerr, ok )
330  infot = 4
331  CALL zsycon_rook( 'U', 2, a, 1, ip, anrm, rcond, w, info )
332  CALL chkxer( 'ZSYCON_ROOK', infot, nout, lerr, ok )
333  infot = 6
334  CALL zsycon_rook( 'U', 1, a, 1, ip, -anrm, rcond, w, info )
335  CALL chkxer( 'ZSYCON_ROOK', infot, nout, lerr, ok )
336 *
337 * Test error exits of the routines that use factorization
338 * of a symmetric indefinite packed matrix with patrial
339 * (Bunch-Kaufman) pivoting.
340 *
341  ELSE IF( lsamen( 2, c2, 'SP' ) ) THEN
342 *
343 * ZSPTRF
344 *
345  srnamt = 'ZSPTRF'
346  infot = 1
347  CALL zsptrf( '/', 0, a, ip, info )
348  CALL chkxer( 'ZSPTRF', infot, nout, lerr, ok )
349  infot = 2
350  CALL zsptrf( 'U', -1, a, ip, info )
351  CALL chkxer( 'ZSPTRF', infot, nout, lerr, ok )
352 *
353 * ZSPTRI
354 *
355  srnamt = 'ZSPTRI'
356  infot = 1
357  CALL zsptri( '/', 0, a, ip, w, info )
358  CALL chkxer( 'ZSPTRI', infot, nout, lerr, ok )
359  infot = 2
360  CALL zsptri( 'U', -1, a, ip, w, info )
361  CALL chkxer( 'ZSPTRI', infot, nout, lerr, ok )
362 *
363 * ZSPTRS
364 *
365  srnamt = 'ZSPTRS'
366  infot = 1
367  CALL zsptrs( '/', 0, 0, a, ip, b, 1, info )
368  CALL chkxer( 'ZSPTRS', infot, nout, lerr, ok )
369  infot = 2
370  CALL zsptrs( 'U', -1, 0, a, ip, b, 1, info )
371  CALL chkxer( 'ZSPTRS', infot, nout, lerr, ok )
372  infot = 3
373  CALL zsptrs( 'U', 0, -1, a, ip, b, 1, info )
374  CALL chkxer( 'ZSPTRS', infot, nout, lerr, ok )
375  infot = 7
376  CALL zsptrs( 'U', 2, 1, a, ip, b, 1, info )
377  CALL chkxer( 'ZSPTRS', infot, nout, lerr, ok )
378 *
379 * ZSPRFS
380 *
381  srnamt = 'ZSPRFS'
382  infot = 1
383  CALL zsprfs( '/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
384  $ info )
385  CALL chkxer( 'ZSPRFS', infot, nout, lerr, ok )
386  infot = 2
387  CALL zsprfs( 'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
388  $ info )
389  CALL chkxer( 'ZSPRFS', infot, nout, lerr, ok )
390  infot = 3
391  CALL zsprfs( 'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
392  $ info )
393  CALL chkxer( 'ZSPRFS', infot, nout, lerr, ok )
394  infot = 8
395  CALL zsprfs( 'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
396  $ info )
397  CALL chkxer( 'ZSPRFS', infot, nout, lerr, ok )
398  infot = 10
399  CALL zsprfs( 'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
400  $ info )
401  CALL chkxer( 'ZSPRFS', infot, nout, lerr, ok )
402 *
403 * ZSPCON
404 *
405  srnamt = 'ZSPCON'
406  infot = 1
407  CALL zspcon( '/', 0, a, ip, anrm, rcond, w, info )
408  CALL chkxer( 'ZSPCON', infot, nout, lerr, ok )
409  infot = 2
410  CALL zspcon( 'U', -1, a, ip, anrm, rcond, w, info )
411  CALL chkxer( 'ZSPCON', infot, nout, lerr, ok )
412  infot = 5
413  CALL zspcon( 'U', 1, a, ip, -anrm, rcond, w, info )
414  CALL chkxer( 'ZSPCON', infot, nout, lerr, ok )
415  END IF
416 *
417 * Print a summary line.
418 *
419  CALL alaesm( path, ok, nout )
420 *
421  RETURN
422 *
423 * End of ZERRSY
424 *
425  END
zsycon
subroutine zsycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZSYCON
Definition: zsycon.f:127
zsptri
subroutine zsptri(UPLO, N, AP, IPIV, WORK, INFO)
ZSPTRI
Definition: zsptri.f:111
zerrsy
subroutine zerrsy(PATH, NUNIT)
ZERRSY
Definition: zerrsy.f:57
zsytri_rook
subroutine zsytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
ZSYTRI_ROOK
Definition: zsytri_rook.f:131
zsytri
subroutine zsytri(UPLO, N, A, LDA, IPIV, WORK, INFO)
ZSYTRI
Definition: zsytri.f:116
zsytrf_rook
subroutine zsytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRF_ROOK
Definition: zsytrf_rook.f:210
zsptrf
subroutine zsptrf(UPLO, N, AP, IPIV, INFO)
ZSPTRF
Definition: zsptrf.f:160
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
zsytf2_rook
subroutine zsytf2_rook(UPLO, N, A, LDA, IPIV, INFO)
ZSYTF2_ROOK computes the factorization of a complex symmetric indefinite matrix using the bounded Bun...
Definition: zsytf2_rook.f:196
zsytri2
subroutine zsytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRI2
Definition: zsytri2.f:129
zspcon
subroutine zspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
ZSPCON
Definition: zspcon.f:120
zsytrf
subroutine zsytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZSYTRF
Definition: zsytrf.f:184
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
zsycon_rook
subroutine zsycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZSYCON_ROOK
Definition: zsycon_rook.f:141
zsprfs
subroutine zsprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZSPRFS
Definition: zsprfs.f:182
zsptrs
subroutine zsptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
ZSPTRS
Definition: zsptrs.f:117
zsytrs_rook
subroutine zsytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZSYTRS_ROOK
Definition: zsytrs_rook.f:138
zsyrfs
subroutine zsyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZSYRFS
Definition: zsyrfs.f:194
zsytf2
subroutine zsytf2(UPLO, N, A, LDA, IPIV, INFO)
ZSYTF2 computes the factorization of a real symmetric indefinite matrix, using the diagonal pivoting ...
Definition: zsytf2.f:193
zsytrs
subroutine zsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZSYTRS
Definition: zsytrs.f:122