LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
cerrsyx.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine cerrsy (PATH, NUNIT)
 CERRSYX More...
 

Function/Subroutine Documentation

subroutine cerrsy ( character*3  PATH,
integer  NUNIT 
)

CERRSYX

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 2013

Definition at line 60 of file cerrsyx.f.

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

Here is the call graph for this function: