LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine cerrsy ( character*3  PATH,
integer  NUNIT 
)

CERRSY

CERRSYX

Purpose:
 CERRSY tests the error exits for the COMPLEX routines
 for symmetric indefinite matrices.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2013
Purpose:
 CERRSY tests the error exits for the COMPLEX routines
 for symmetric indefinite matrices.

 Note that this file is used only when the XBLAS are available,
 otherwise cerrsy.f defines this subroutine.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2015

Definition at line 57 of file cerrsy.f.

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,
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 *
subroutine csytri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
CSYTRI_ROOK
Definition: csytri_rook.f:131
subroutine csyrfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CSYRFS
Definition: csyrfs.f:194
subroutine cspcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
CSPCON
Definition: cspcon.f:120
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
subroutine csytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CSYTRS
Definition: csytrs.f:122
subroutine csytri(UPLO, N, A, LDA, IPIV, WORK, INFO)
CSYTRI
Definition: csytri.f:116
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
subroutine csptrf(UPLO, N, AP, IPIV, INFO)
CSPTRF
Definition: csptrf.f:160
subroutine csptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
CSPTRS
Definition: csptrs.f:117
subroutine csytrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CSYTRS_ROOK
Definition: csytrs_rook.f:138
subroutine csytrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF
Definition: csytrf.f:184
subroutine csytrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRF_ROOK
Definition: csytrf_rook.f:210
subroutine csycon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CSYCON
Definition: csycon.f:127
subroutine csprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CSPRFS
Definition: csprfs.f:182
subroutine csptri(UPLO, N, AP, IPIV, WORK, INFO)
CSPTRI
Definition: csptri.f:111
subroutine csycon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CSYCON_ROOK
Definition: csycon_rook.f:141
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
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
subroutine csytri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CSYTRI2
Definition: csytri2.f:129

Here is the call graph for this function:

Here is the caller graph for this function: