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

Go to the source code of this file.

Functions/Subroutines

subroutine cerrhe (PATH, NUNIT)
 CERRHEX More...
 

Function/Subroutine Documentation

subroutine cerrhe ( character*3  PATH,
integer  NUNIT 
)

CERRHEX

Purpose:
 CERRHE tests the error exits for the COMPLEX routines
 for Hermitian indefinite matrices.

 Note that this file is used only when the XBLAS are available,
 otherwise cerrhe.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 cerrhex.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 *
74 * .. Parameters ..
75  INTEGER nmax
76  parameter( nmax = 4 )
77 * ..
78 * .. Local Scalars ..
79  CHARACTER eq
80  CHARACTER*2 c2
81  INTEGER i, info, j, n_err_bnds, nparams
82  REAL anrm, rcond, berr
83 * ..
84 * .. Local Arrays ..
85  INTEGER ip( nmax )
86  REAL r( nmax ), r1( nmax ), r2( nmax ),
87  $ s( nmax ), err_bnds_n( nmax, 3 ),
88  $ err_bnds_c( nmax, 3 ), params( 1 )
89  COMPLEX a( nmax, nmax ), af( nmax, nmax ), b( nmax ),
90  $ w( 2*nmax ), x( nmax )
91 * ..
92 * .. External Functions ..
93  LOGICAL lsamen
94  EXTERNAL lsamen
95 * ..
96 * .. External Subroutines ..
97  EXTERNAL alaesm, checon, checon_rook, cherfs, chetf2,
101  $ cherfsx
102 * ..
103 * .. Scalars in Common ..
104  LOGICAL lerr, ok
105  CHARACTER*32 srnamt
106  INTEGER infot, nout
107 * ..
108 * .. Common blocks ..
109  COMMON / infoc / infot, nout, ok, lerr
110  COMMON / srnamc / srnamt
111 * ..
112 * .. Intrinsic Functions ..
113  INTRINSIC cmplx, real
114 * ..
115 * .. Executable Statements ..
116 *
117  nout = nunit
118  WRITE( nout, fmt = * )
119  c2 = path( 2: 3 )
120 *
121 * Set the variables to innocuous values.
122 *
123  DO 20 j = 1, nmax
124  DO 10 i = 1, nmax
125  a( i, j ) = cmplx( 1. / REAL( I+J ), -1. / REAL( I+J ) )
126  af( i, j ) = cmplx( 1. / REAL( I+J ), -1. / REAL( I+J ) )
127  10 CONTINUE
128  b( j ) = 0.
129  r1( j ) = 0.
130  r2( j ) = 0.
131  w( j ) = 0.
132  x( j ) = 0.
133  s( j ) = 0.
134  ip( j ) = j
135  20 CONTINUE
136  anrm = 1.0
137  ok = .true.
138 *
139 * Test error exits of the routines that use factorization
140 * of a Hermitian indefinite matrix with patrial
141 * (Bunch-Kaufman) diagonal pivoting method.
142 *
143  IF( lsamen( 2, c2, 'HE' ) ) THEN
144 *
145 * CHETRF
146 *
147  srnamt = 'CHETRF'
148  infot = 1
149  CALL chetrf( '/', 0, a, 1, ip, w, 1, info )
150  CALL chkxer( 'CHETRF', infot, nout, lerr, ok )
151  infot = 2
152  CALL chetrf( 'U', -1, a, 1, ip, w, 1, info )
153  CALL chkxer( 'CHETRF', infot, nout, lerr, ok )
154  infot = 4
155  CALL chetrf( 'U', 2, a, 1, ip, w, 4, info )
156  CALL chkxer( 'CHETRF', infot, nout, lerr, ok )
157 *
158 * CHETF2
159 *
160  srnamt = 'CHETF2'
161  infot = 1
162  CALL chetf2( '/', 0, a, 1, ip, info )
163  CALL chkxer( 'CHETF2', infot, nout, lerr, ok )
164  infot = 2
165  CALL chetf2( 'U', -1, a, 1, ip, info )
166  CALL chkxer( 'CHETF2', infot, nout, lerr, ok )
167  infot = 4
168  CALL chetf2( 'U', 2, a, 1, ip, info )
169  CALL chkxer( 'CHETF2', infot, nout, lerr, ok )
170 *
171 * CHETRI
172 *
173  srnamt = 'CHETRI'
174  infot = 1
175  CALL chetri( '/', 0, a, 1, ip, w, info )
176  CALL chkxer( 'CHETRI', infot, nout, lerr, ok )
177  infot = 2
178  CALL chetri( 'U', -1, a, 1, ip, w, info )
179  CALL chkxer( 'CHETRI', infot, nout, lerr, ok )
180  infot = 4
181  CALL chetri( 'U', 2, a, 1, ip, w, info )
182  CALL chkxer( 'CHETRI', infot, nout, lerr, ok )
183 *
184 * CHETRI2
185 *
186  srnamt = 'CHETRI2'
187  infot = 1
188  CALL chetri2( '/', 0, a, 1, ip, w, 1, info )
189  CALL chkxer( 'CHETRI2', infot, nout, lerr, ok )
190  infot = 2
191  CALL chetri2( 'U', -1, a, 1, ip, w, 1, info )
192  CALL chkxer( 'CHETRI2', infot, nout, lerr, ok )
193  infot = 4
194  CALL chetri2( 'U', 2, a, 1, ip, w, 1, info )
195  CALL chkxer( 'CHETRI2', infot, nout, lerr, ok )
196 *
197 * CHETRS
198 *
199  srnamt = 'CHETRS'
200  infot = 1
201  CALL chetrs( '/', 0, 0, a, 1, ip, b, 1, info )
202  CALL chkxer( 'CHETRS', infot, nout, lerr, ok )
203  infot = 2
204  CALL chetrs( 'U', -1, 0, a, 1, ip, b, 1, info )
205  CALL chkxer( 'CHETRS', infot, nout, lerr, ok )
206  infot = 3
207  CALL chetrs( 'U', 0, -1, a, 1, ip, b, 1, info )
208  CALL chkxer( 'CHETRS', infot, nout, lerr, ok )
209  infot = 5
210  CALL chetrs( 'U', 2, 1, a, 1, ip, b, 2, info )
211  CALL chkxer( 'CHETRS', infot, nout, lerr, ok )
212  infot = 8
213  CALL chetrs( 'U', 2, 1, a, 2, ip, b, 1, info )
214  CALL chkxer( 'CHETRS', infot, nout, lerr, ok )
215 *
216 * CHERFS
217 *
218  srnamt = 'CHERFS'
219  infot = 1
220  CALL cherfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
221  $ r, info )
222  CALL chkxer( 'CHERFS', infot, nout, lerr, ok )
223  infot = 2
224  CALL cherfs( 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
225  $ w, r, info )
226  CALL chkxer( 'CHERFS', infot, nout, lerr, ok )
227  infot = 3
228  CALL cherfs( 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
229  $ w, r, info )
230  CALL chkxer( 'CHERFS', infot, nout, lerr, ok )
231  infot = 5
232  CALL cherfs( 'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
233  $ r, info )
234  CALL chkxer( 'CHERFS', infot, nout, lerr, ok )
235  infot = 7
236  CALL cherfs( 'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
237  $ r, info )
238  CALL chkxer( 'CHERFS', infot, nout, lerr, ok )
239  infot = 10
240  CALL cherfs( 'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
241  $ r, info )
242  CALL chkxer( 'CHERFS', infot, nout, lerr, ok )
243  infot = 12
244  CALL cherfs( 'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
245  $ r, info )
246  CALL chkxer( 'CHERFS', infot, nout, lerr, ok )
247 *
248 * CHECON
249 *
250  srnamt = 'CHECON'
251  infot = 1
252  CALL checon( '/', 0, a, 1, ip, anrm, rcond, w, info )
253  CALL chkxer( 'CHECON', infot, nout, lerr, ok )
254  infot = 2
255  CALL checon( 'U', -1, a, 1, ip, anrm, rcond, w, info )
256  CALL chkxer( 'CHECON', infot, nout, lerr, ok )
257  infot = 4
258  CALL checon( 'U', 2, a, 1, ip, anrm, rcond, w, info )
259  CALL chkxer( 'CHECON', infot, nout, lerr, ok )
260  infot = 6
261  CALL checon( 'U', 1, a, 1, ip, -anrm, rcond, w, info )
262  CALL chkxer( 'CHECON', infot, nout, lerr, ok )
263 *
264 * CHERFSX
265 *
266  n_err_bnds = 3
267  nparams = 0
268  srnamt = 'CHERFSX'
269  infot = 1
270  CALL cherfsx( '/', eq, 0, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
271  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
272  $ params, w, r, info )
273  CALL chkxer( 'CHERFSX', infot, nout, lerr, ok )
274  infot = 2
275  CALL cherfsx( 'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
276  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
277  $ params, w, r, info )
278  CALL chkxer( 'CHERFSX', infot, nout, lerr, ok )
279  eq = 'N'
280  infot = 3
281  CALL cherfsx( 'U', eq, -1, 0, a, 1, af, 1, ip, s, b, 1, x, 1,
282  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
283  $ params, w, r, info )
284  CALL chkxer( 'CHERFSX', infot, nout, lerr, ok )
285  infot = 4
286  CALL cherfsx( 'U', eq, 0, -1, a, 1, af, 1, ip, s, b, 1, x, 1,
287  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
288  $ params, w, r, info )
289  CALL chkxer( 'CHERFSX', infot, nout, lerr, ok )
290  infot = 6
291  CALL cherfsx( 'U', eq, 2, 1, a, 1, af, 2, ip, s, b, 2, x, 2,
292  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
293  $ params, w, r, info )
294  CALL chkxer( 'CHERFSX', infot, nout, lerr, ok )
295  infot = 8
296  CALL cherfsx( 'U', eq, 2, 1, a, 2, af, 1, ip, s, b, 2, x, 2,
297  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
298  $ params, w, r, info )
299  CALL chkxer( 'CHERFSX', infot, nout, lerr, ok )
300  infot = 12
301  CALL cherfsx( 'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 1, x, 2,
302  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
303  $ params, w, r, info )
304  CALL chkxer( 'CHERFSX', infot, nout, lerr, ok )
305  infot = 14
306  CALL cherfsx( 'U', eq, 2, 1, a, 2, af, 2, ip, s, b, 2, x, 1,
307  $ rcond, berr, n_err_bnds, err_bnds_n, err_bnds_c, nparams,
308  $ params, w, r, info )
309  CALL chkxer( 'CHERFSX', infot, nout, lerr, ok )
310 *
311 * Test error exits of the routines that use factorization
312 * of a Hermitian indefinite matrix with "rook"
313 * (bounded Bunch-Kaufman) diagonal pivoting method.
314 *
315  ELSE IF( lsamen( 2, c2, 'HR' ) ) THEN
316 *
317 * CHETRF_ROOK
318 *
319  srnamt = 'CHETRF_ROOK'
320  infot = 1
321  CALL chetrf_rook( '/', 0, a, 1, ip, w, 1, info )
322  CALL chkxer( 'CHETRF_ROOK', infot, nout, lerr, ok )
323  infot = 2
324  CALL chetrf_rook( 'U', -1, a, 1, ip, w, 1, info )
325  CALL chkxer( 'CHETRF_ROOK', infot, nout, lerr, ok )
326  infot = 4
327  CALL chetrf_rook( 'U', 2, a, 1, ip, w, 4, info )
328  CALL chkxer( 'CHETRF_ROOK', infot, nout, lerr, ok )
329 *
330 * CHETF2_ROOK
331 *
332  srnamt = 'CHETF2_ROOK'
333  infot = 1
334  CALL chetf2_rook( '/', 0, a, 1, ip, info )
335  CALL chkxer( 'CHETF2_ROOK', infot, nout, lerr, ok )
336  infot = 2
337  CALL chetf2_rook( 'U', -1, a, 1, ip, info )
338  CALL chkxer( 'CHETF2_ROOK', infot, nout, lerr, ok )
339  infot = 4
340  CALL chetf2_rook( 'U', 2, a, 1, ip, info )
341  CALL chkxer( 'CHETF2_ROOK', infot, nout, lerr, ok )
342 *
343 * CHETRI_ROOK
344 *
345  srnamt = 'CHETRI_ROOK'
346  infot = 1
347  CALL chetri_rook( '/', 0, a, 1, ip, w, info )
348  CALL chkxer( 'CHETRI_ROOK', infot, nout, lerr, ok )
349  infot = 2
350  CALL chetri_rook( 'U', -1, a, 1, ip, w, info )
351  CALL chkxer( 'CHETRI_ROOK', infot, nout, lerr, ok )
352  infot = 4
353  CALL chetri_rook( 'U', 2, a, 1, ip, w, info )
354  CALL chkxer( 'CHETRI_ROOK', infot, nout, lerr, ok )
355 *
356 * CHETRS_ROOK
357 *
358  srnamt = 'CHETRS_ROOK'
359  infot = 1
360  CALL chetrs_rook( '/', 0, 0, a, 1, ip, b, 1, info )
361  CALL chkxer( 'CHETRS_ROOK', infot, nout, lerr, ok )
362  infot = 2
363  CALL chetrs_rook( 'U', -1, 0, a, 1, ip, b, 1, info )
364  CALL chkxer( 'CHETRS_ROOK', infot, nout, lerr, ok )
365  infot = 3
366  CALL chetrs_rook( 'U', 0, -1, a, 1, ip, b, 1, info )
367  CALL chkxer( 'CHETRS_ROOK', infot, nout, lerr, ok )
368  infot = 5
369  CALL chetrs_rook( 'U', 2, 1, a, 1, ip, b, 2, info )
370  CALL chkxer( 'CHETRS_ROOK', infot, nout, lerr, ok )
371  infot = 8
372  CALL chetrs_rook( 'U', 2, 1, a, 2, ip, b, 1, info )
373  CALL chkxer( 'CHETRS_ROOK', infot, nout, lerr, ok )
374 *
375 * CHECON_ROOK
376 *
377  srnamt = 'CHECON_ROOK'
378  infot = 1
379  CALL checon_rook( '/', 0, a, 1, ip, anrm, rcond, w, info )
380  CALL chkxer( 'CHECON_ROOK', infot, nout, lerr, ok )
381  infot = 2
382  CALL checon_rook( 'U', -1, a, 1, ip, anrm, rcond, w, info )
383  CALL chkxer( 'CHECON_ROOK', infot, nout, lerr, ok )
384  infot = 4
385  CALL checon_rook( 'U', 2, a, 1, ip, anrm, rcond, w, info )
386  CALL chkxer( 'CHECON_ROOK', infot, nout, lerr, ok )
387  infot = 6
388  CALL checon_rook( 'U', 1, a, 1, ip, -anrm, rcond, w, info )
389  CALL chkxer( 'CHECON_ROOK', infot, nout, lerr, ok )
390 *
391 * Test error exits of the routines that use factorization
392 * of a Hermitian indefinite packed matrix with patrial
393 * (Bunch-Kaufman) diagonal pivoting method.
394 *
395  ELSE IF( lsamen( 2, c2, 'HP' ) ) THEN
396 *
397 * CHPTRF
398 *
399  srnamt = 'CHPTRF'
400  infot = 1
401  CALL chptrf( '/', 0, a, ip, info )
402  CALL chkxer( 'CHPTRF', infot, nout, lerr, ok )
403  infot = 2
404  CALL chptrf( 'U', -1, a, ip, info )
405  CALL chkxer( 'CHPTRF', infot, nout, lerr, ok )
406 *
407 * CHPTRI
408 *
409  srnamt = 'CHPTRI'
410  infot = 1
411  CALL chptri( '/', 0, a, ip, w, info )
412  CALL chkxer( 'CHPTRI', infot, nout, lerr, ok )
413  infot = 2
414  CALL chptri( 'U', -1, a, ip, w, info )
415  CALL chkxer( 'CHPTRI', infot, nout, lerr, ok )
416 *
417 * CHPTRS
418 *
419  srnamt = 'CHPTRS'
420  infot = 1
421  CALL chptrs( '/', 0, 0, a, ip, b, 1, info )
422  CALL chkxer( 'CHPTRS', infot, nout, lerr, ok )
423  infot = 2
424  CALL chptrs( 'U', -1, 0, a, ip, b, 1, info )
425  CALL chkxer( 'CHPTRS', infot, nout, lerr, ok )
426  infot = 3
427  CALL chptrs( 'U', 0, -1, a, ip, b, 1, info )
428  CALL chkxer( 'CHPTRS', infot, nout, lerr, ok )
429  infot = 7
430  CALL chptrs( 'U', 2, 1, a, ip, b, 1, info )
431  CALL chkxer( 'CHPTRS', infot, nout, lerr, ok )
432 *
433 * CHPRFS
434 *
435  srnamt = 'CHPRFS'
436  infot = 1
437  CALL chprfs( '/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
438  $ info )
439  CALL chkxer( 'CHPRFS', infot, nout, lerr, ok )
440  infot = 2
441  CALL chprfs( 'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
442  $ info )
443  CALL chkxer( 'CHPRFS', infot, nout, lerr, ok )
444  infot = 3
445  CALL chprfs( 'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
446  $ info )
447  CALL chkxer( 'CHPRFS', infot, nout, lerr, ok )
448  infot = 8
449  CALL chprfs( 'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
450  $ info )
451  CALL chkxer( 'CHPRFS', infot, nout, lerr, ok )
452  infot = 10
453  CALL chprfs( 'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
454  $ info )
455  CALL chkxer( 'CHPRFS', infot, nout, lerr, ok )
456 *
457 * CHPCON
458 *
459  srnamt = 'CHPCON'
460  infot = 1
461  CALL chpcon( '/', 0, a, ip, anrm, rcond, w, info )
462  CALL chkxer( 'CHPCON', infot, nout, lerr, ok )
463  infot = 2
464  CALL chpcon( 'U', -1, a, ip, anrm, rcond, w, info )
465  CALL chkxer( 'CHPCON', infot, nout, lerr, ok )
466  infot = 5
467  CALL chpcon( 'U', 1, a, ip, -anrm, rcond, w, info )
468  CALL chkxer( 'CHPCON', infot, nout, lerr, ok )
469  END IF
470 *
471 * Print a summary line.
472 *
473  CALL alaesm( path, ok, nout )
474 *
475  RETURN
476 *
477 * End of CERRHE
478 *
subroutine chetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CHETRS
Definition: chetrs.f:122
subroutine chetf2_rook(UPLO, N, A, LDA, IPIV, INFO)
CHETF2_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
Definition: chetf2_rook.f:196
subroutine checon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CHECON_ROOK estimates the reciprocal of the condition number fort HE matrices using factorization obt...
Definition: checon_rook.f:141
subroutine chptri(UPLO, N, AP, IPIV, WORK, INFO)
CHPTRI
Definition: chptri.f:111
subroutine cherfsx(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)
CHERFSX
Definition: cherfsx.f:403
subroutine chetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF
Definition: chetrf.f:179
subroutine checon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
CHECON
Definition: checon.f:127
subroutine chetri(UPLO, N, A, LDA, IPIV, WORK, INFO)
CHETRI
Definition: chetri.f:116
subroutine chetri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRI2
Definition: chetri2.f:129
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
subroutine chetrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CHETRS_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using fac...
Definition: chetrs_rook.f:138
subroutine chprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CHPRFS
Definition: chprfs.f:182
subroutine chpcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
CHPCON
Definition: chpcon.f:120
subroutine chetrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
CHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
Definition: chetrf_rook.f:214
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
subroutine cherfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
CHERFS
Definition: cherfs.f:194
subroutine chetf2(UPLO, N, A, LDA, IPIV, INFO)
CHETF2 computes the factorization of a complex Hermitian matrix, using the diagonal pivoting method (...
Definition: chetf2.f:188
subroutine chetri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
CHETRI_ROOK computes the inverse of HE matrix using the factorization obtained with the bounded Bunch...
Definition: chetri_rook.f:130
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
subroutine chptrf(UPLO, N, AP, IPIV, INFO)
CHPTRF
Definition: chptrf.f:161
subroutine chptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
CHPTRS
Definition: chptrs.f:117

Here is the call graph for this function: