LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
zerrhe.f
Go to the documentation of this file.
1 *> \brief \b ZERRHE
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 ZERRHE( 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 *> ZERRHE tests the error exits for the COMPLEX*16 routines
25 *> for Hermitian 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 zerrhe( 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 *
71 * .. Parameters ..
72  INTEGER NMAX
73  parameter ( nmax = 4 )
74 * ..
75 * .. Local Scalars ..
76  CHARACTER*2 C2
77  INTEGER I, INFO, J
78  DOUBLE PRECISION ANRM, RCOND
79 * ..
80 * .. Local Arrays ..
81  INTEGER IP( nmax )
82  DOUBLE PRECISION R( nmax ), R1( nmax ), R2( nmax )
83  COMPLEX*16 A( nmax, nmax ), AF( nmax, nmax ), B( nmax ),
84  $ w( 2*nmax ), x( nmax )
85 * ..
86 * .. External Functions ..
87  LOGICAL LSAMEN
88  EXTERNAL lsamen
89 * ..
90 * .. External Subroutines ..
91  EXTERNAL alaesm, chkxer, zhecon, zhecon_rook, zherfs,
92  $ zhetf2, zhetf2_rook, zhetrf, zhetrf_rook,
93  $ zhetri, zhetri_rook, zhetri2, zhetrs,
94  $ zhetrs_rook, zhpcon, zhprfs, zhptrf, zhptri,
95  $ zhptrs
96 * ..
97 * .. Scalars in Common ..
98  LOGICAL LERR, OK
99  CHARACTER*32 SRNAMT
100  INTEGER INFOT, NOUT
101 * ..
102 * .. Common blocks ..
103  COMMON / infoc / infot, nout, ok, lerr
104  COMMON / srnamc / srnamt
105 * ..
106 * .. Intrinsic Functions ..
107  INTRINSIC dble, dcmplx
108 * ..
109 * .. Executable Statements ..
110 *
111  nout = nunit
112  WRITE( nout, fmt = * )
113  c2 = path( 2: 3 )
114 *
115 * Set the variables to innocuous values.
116 *
117  DO 20 j = 1, nmax
118  DO 10 i = 1, nmax
119  a( i, j ) = dcmplx( 1.d0 / dble( i+j ),
120  $ -1.d0 / dble( i+j ) )
121  af( i, j ) = dcmplx( 1.d0 / dble( i+j ),
122  $ -1.d0 / dble( i+j ) )
123  10 CONTINUE
124  b( j ) = 0.d0
125  r1( j ) = 0.d0
126  r2( j ) = 0.d0
127  w( j ) = 0.d0
128  x( j ) = 0.d0
129  ip( j ) = j
130  20 CONTINUE
131  anrm = 1.0d0
132  ok = .true.
133 *
134 * Test error exits of the routines that use factorization
135 * of a Hermitian indefinite matrix with patrial
136 * (Bunch-Kaufman) diagonal pivoting method.
137 *
138  IF( lsamen( 2, c2, 'HE' ) ) THEN
139 *
140 * ZHETRF
141 *
142  srnamt = 'ZHETRF'
143  infot = 1
144  CALL zhetrf( '/', 0, a, 1, ip, w, 1, info )
145  CALL chkxer( 'ZHETRF', infot, nout, lerr, ok )
146  infot = 2
147  CALL zhetrf( 'U', -1, a, 1, ip, w, 1, info )
148  CALL chkxer( 'ZHETRF', infot, nout, lerr, ok )
149  infot = 4
150  CALL zhetrf( 'U', 2, a, 1, ip, w, 4, info )
151  CALL chkxer( 'ZHETRF', infot, nout, lerr, ok )
152 *
153 * ZHETF2
154 *
155  srnamt = 'ZHETF2'
156  infot = 1
157  CALL zhetf2( '/', 0, a, 1, ip, info )
158  CALL chkxer( 'ZHETF2', infot, nout, lerr, ok )
159  infot = 2
160  CALL zhetf2( 'U', -1, a, 1, ip, info )
161  CALL chkxer( 'ZHETF2', infot, nout, lerr, ok )
162  infot = 4
163  CALL zhetf2( 'U', 2, a, 1, ip, info )
164  CALL chkxer( 'ZHETF2', infot, nout, lerr, ok )
165 *
166 * ZHETRI
167 *
168  srnamt = 'ZHETRI'
169  infot = 1
170  CALL zhetri( '/', 0, a, 1, ip, w, info )
171  CALL chkxer( 'ZHETRI', infot, nout, lerr, ok )
172  infot = 2
173  CALL zhetri( 'U', -1, a, 1, ip, w, info )
174  CALL chkxer( 'ZHETRI', infot, nout, lerr, ok )
175  infot = 4
176  CALL zhetri( 'U', 2, a, 1, ip, w, info )
177  CALL chkxer( 'ZHETRI', infot, nout, lerr, ok )
178 *
179 * ZHETRI2
180 *
181  srnamt = 'ZHETRI2'
182  infot = 1
183  CALL zhetri2( '/', 0, a, 1, ip, w, 1, info )
184  CALL chkxer( 'ZHETRI2', infot, nout, lerr, ok )
185  infot = 2
186  CALL zhetri2( 'U', -1, a, 1, ip, w, 1, info )
187  CALL chkxer( 'ZHETRI2', infot, nout, lerr, ok )
188  infot = 4
189  CALL zhetri2( 'U', 2, a, 1, ip, w, 1, info )
190  CALL chkxer( 'ZHETRI2', infot, nout, lerr, ok )
191 *
192 * ZHETRS
193 *
194  srnamt = 'ZHETRS'
195  infot = 1
196  CALL zhetrs( '/', 0, 0, a, 1, ip, b, 1, info )
197  CALL chkxer( 'ZHETRS', infot, nout, lerr, ok )
198  infot = 2
199  CALL zhetrs( 'U', -1, 0, a, 1, ip, b, 1, info )
200  CALL chkxer( 'ZHETRS', infot, nout, lerr, ok )
201  infot = 3
202  CALL zhetrs( 'U', 0, -1, a, 1, ip, b, 1, info )
203  CALL chkxer( 'ZHETRS', infot, nout, lerr, ok )
204  infot = 5
205  CALL zhetrs( 'U', 2, 1, a, 1, ip, b, 2, info )
206  CALL chkxer( 'ZHETRS', infot, nout, lerr, ok )
207  infot = 8
208  CALL zhetrs( 'U', 2, 1, a, 2, ip, b, 1, info )
209  CALL chkxer( 'ZHETRS', infot, nout, lerr, ok )
210 *
211 * ZHERFS
212 *
213  srnamt = 'ZHERFS'
214  infot = 1
215  CALL zherfs( '/', 0, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2, w,
216  $ r, info )
217  CALL chkxer( 'ZHERFS', infot, nout, lerr, ok )
218  infot = 2
219  CALL zherfs( 'U', -1, 0, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
220  $ w, r, info )
221  CALL chkxer( 'ZHERFS', infot, nout, lerr, ok )
222  infot = 3
223  CALL zherfs( 'U', 0, -1, a, 1, af, 1, ip, b, 1, x, 1, r1, r2,
224  $ w, r, info )
225  CALL chkxer( 'ZHERFS', infot, nout, lerr, ok )
226  infot = 5
227  CALL zherfs( 'U', 2, 1, a, 1, af, 2, ip, b, 2, x, 2, r1, r2, w,
228  $ r, info )
229  CALL chkxer( 'ZHERFS', infot, nout, lerr, ok )
230  infot = 7
231  CALL zherfs( 'U', 2, 1, a, 2, af, 1, ip, b, 2, x, 2, r1, r2, w,
232  $ r, info )
233  CALL chkxer( 'ZHERFS', infot, nout, lerr, ok )
234  infot = 10
235  CALL zherfs( 'U', 2, 1, a, 2, af, 2, ip, b, 1, x, 2, r1, r2, w,
236  $ r, info )
237  CALL chkxer( 'ZHERFS', infot, nout, lerr, ok )
238  infot = 12
239  CALL zherfs( 'U', 2, 1, a, 2, af, 2, ip, b, 2, x, 1, r1, r2, w,
240  $ r, info )
241  CALL chkxer( 'ZHERFS', infot, nout, lerr, ok )
242 *
243 * ZHECON
244 *
245  srnamt = 'ZHECON'
246  infot = 1
247  CALL zhecon( '/', 0, a, 1, ip, anrm, rcond, w, info )
248  CALL chkxer( 'ZHECON', infot, nout, lerr, ok )
249  infot = 2
250  CALL zhecon( 'U', -1, a, 1, ip, anrm, rcond, w, info )
251  CALL chkxer( 'ZHECON', infot, nout, lerr, ok )
252  infot = 4
253  CALL zhecon( 'U', 2, a, 1, ip, anrm, rcond, w, info )
254  CALL chkxer( 'ZHECON', infot, nout, lerr, ok )
255  infot = 6
256  CALL zhecon( 'U', 1, a, 1, ip, -anrm, rcond, w, info )
257  CALL chkxer( 'ZHECON', infot, nout, lerr, ok )
258 *
259 * Test error exits of the routines that use factorization
260 * of a Hermitian indefinite matrix with "rook"
261 * (bounded Bunch-Kaufman) diagonal pivoting method.
262 *
263  ELSE IF( lsamen( 2, c2, 'HR' ) ) THEN
264 *
265 * ZHETRF_ROOK
266 *
267  srnamt = 'ZHETRF_ROOK'
268  infot = 1
269  CALL zhetrf_rook( '/', 0, a, 1, ip, w, 1, info )
270  CALL chkxer( 'ZHETRF_ROOK', infot, nout, lerr, ok )
271  infot = 2
272  CALL zhetrf_rook( 'U', -1, a, 1, ip, w, 1, info )
273  CALL chkxer( 'ZHETRF_ROOK', infot, nout, lerr, ok )
274  infot = 4
275  CALL zhetrf_rook( 'U', 2, a, 1, ip, w, 4, info )
276  CALL chkxer( 'ZHETRF_ROOK', infot, nout, lerr, ok )
277 *
278 * ZHETF2_ROOK
279 *
280  srnamt = 'ZHETF2_ROOK'
281  infot = 1
282  CALL zhetf2_rook( '/', 0, a, 1, ip, info )
283  CALL chkxer( 'ZHETF2_ROOK', infot, nout, lerr, ok )
284  infot = 2
285  CALL zhetf2_rook( 'U', -1, a, 1, ip, info )
286  CALL chkxer( 'ZHETF2_ROOK', infot, nout, lerr, ok )
287  infot = 4
288  CALL zhetf2_rook( 'U', 2, a, 1, ip, info )
289  CALL chkxer( 'ZHETF2_ROOK', infot, nout, lerr, ok )
290 *
291 * ZHETRI_ROOK
292 *
293  srnamt = 'ZHETRI_ROOK'
294  infot = 1
295  CALL zhetri_rook( '/', 0, a, 1, ip, w, info )
296  CALL chkxer( 'ZHETRI_ROOK', infot, nout, lerr, ok )
297  infot = 2
298  CALL zhetri_rook( 'U', -1, a, 1, ip, w, info )
299  CALL chkxer( 'ZHETRI_ROOK', infot, nout, lerr, ok )
300  infot = 4
301  CALL zhetri_rook( 'U', 2, a, 1, ip, w, info )
302  CALL chkxer( 'ZHETRI_ROOK', infot, nout, lerr, ok )
303 *
304 * ZHETRS_ROOK
305 *
306  srnamt = 'ZHETRS_ROOK'
307  infot = 1
308  CALL zhetrs_rook( '/', 0, 0, a, 1, ip, b, 1, info )
309  CALL chkxer( 'ZHETRS_ROOK', infot, nout, lerr, ok )
310  infot = 2
311  CALL zhetrs_rook( 'U', -1, 0, a, 1, ip, b, 1, info )
312  CALL chkxer( 'ZHETRS_ROOK', infot, nout, lerr, ok )
313  infot = 3
314  CALL zhetrs_rook( 'U', 0, -1, a, 1, ip, b, 1, info )
315  CALL chkxer( 'ZHETRS_ROOK', infot, nout, lerr, ok )
316  infot = 5
317  CALL zhetrs_rook( 'U', 2, 1, a, 1, ip, b, 2, info )
318  CALL chkxer( 'ZHETRS_ROOK', infot, nout, lerr, ok )
319  infot = 8
320  CALL zhetrs_rook( 'U', 2, 1, a, 2, ip, b, 1, info )
321  CALL chkxer( 'ZHETRS_ROOK', infot, nout, lerr, ok )
322 *
323 * ZHECON_ROOK
324 *
325  srnamt = 'ZHECON_ROOK'
326  infot = 1
327  CALL zhecon_rook( '/', 0, a, 1, ip, anrm, rcond, w, info )
328  CALL chkxer( 'ZHECON_ROOK', infot, nout, lerr, ok )
329  infot = 2
330  CALL zhecon_rook( 'U', -1, a, 1, ip, anrm, rcond, w, info )
331  CALL chkxer( 'ZHECON_ROOK', infot, nout, lerr, ok )
332  infot = 4
333  CALL zhecon_rook( 'U', 2, a, 1, ip, anrm, rcond, w, info )
334  CALL chkxer( 'ZHECON_ROOK', infot, nout, lerr, ok )
335  infot = 6
336  CALL zhecon_rook( 'U', 1, a, 1, ip, -anrm, rcond, w, info )
337  CALL chkxer( 'ZHECON_ROOK', infot, nout, lerr, ok )
338 *
339 * Test error exits of the routines that use factorization
340 * of a Hermitian indefinite packed matrix with patrial
341 * (Bunch-Kaufman) diagonal pivoting method.
342 *
343  ELSE IF( lsamen( 2, c2, 'HP' ) ) THEN
344 *
345 * ZHPTRF
346 *
347  srnamt = 'ZHPTRF'
348  infot = 1
349  CALL zhptrf( '/', 0, a, ip, info )
350  CALL chkxer( 'ZHPTRF', infot, nout, lerr, ok )
351  infot = 2
352  CALL zhptrf( 'U', -1, a, ip, info )
353  CALL chkxer( 'ZHPTRF', infot, nout, lerr, ok )
354 *
355 * ZHPTRI
356 *
357  srnamt = 'ZHPTRI'
358  infot = 1
359  CALL zhptri( '/', 0, a, ip, w, info )
360  CALL chkxer( 'ZHPTRI', infot, nout, lerr, ok )
361  infot = 2
362  CALL zhptri( 'U', -1, a, ip, w, info )
363  CALL chkxer( 'ZHPTRI', infot, nout, lerr, ok )
364 *
365 * ZHPTRS
366 *
367  srnamt = 'ZHPTRS'
368  infot = 1
369  CALL zhptrs( '/', 0, 0, a, ip, b, 1, info )
370  CALL chkxer( 'ZHPTRS', infot, nout, lerr, ok )
371  infot = 2
372  CALL zhptrs( 'U', -1, 0, a, ip, b, 1, info )
373  CALL chkxer( 'ZHPTRS', infot, nout, lerr, ok )
374  infot = 3
375  CALL zhptrs( 'U', 0, -1, a, ip, b, 1, info )
376  CALL chkxer( 'ZHPTRS', infot, nout, lerr, ok )
377  infot = 7
378  CALL zhptrs( 'U', 2, 1, a, ip, b, 1, info )
379  CALL chkxer( 'ZHPTRS', infot, nout, lerr, ok )
380 *
381 * ZHPRFS
382 *
383  srnamt = 'ZHPRFS'
384  infot = 1
385  CALL zhprfs( '/', 0, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
386  $ info )
387  CALL chkxer( 'ZHPRFS', infot, nout, lerr, ok )
388  infot = 2
389  CALL zhprfs( 'U', -1, 0, a, af, ip, b, 1, x, 1, r1, r2, w, r,
390  $ info )
391  CALL chkxer( 'ZHPRFS', infot, nout, lerr, ok )
392  infot = 3
393  CALL zhprfs( 'U', 0, -1, a, af, ip, b, 1, x, 1, r1, r2, w, r,
394  $ info )
395  CALL chkxer( 'ZHPRFS', infot, nout, lerr, ok )
396  infot = 8
397  CALL zhprfs( 'U', 2, 1, a, af, ip, b, 1, x, 2, r1, r2, w, r,
398  $ info )
399  CALL chkxer( 'ZHPRFS', infot, nout, lerr, ok )
400  infot = 10
401  CALL zhprfs( 'U', 2, 1, a, af, ip, b, 2, x, 1, r1, r2, w, r,
402  $ info )
403  CALL chkxer( 'ZHPRFS', infot, nout, lerr, ok )
404 *
405 * ZHPCON
406 *
407  srnamt = 'ZHPCON'
408  infot = 1
409  CALL zhpcon( '/', 0, a, ip, anrm, rcond, w, info )
410  CALL chkxer( 'ZHPCON', infot, nout, lerr, ok )
411  infot = 2
412  CALL zhpcon( 'U', -1, a, ip, anrm, rcond, w, info )
413  CALL chkxer( 'ZHPCON', infot, nout, lerr, ok )
414  infot = 5
415  CALL zhpcon( 'U', 1, a, ip, -anrm, rcond, w, info )
416  CALL chkxer( 'ZHPCON', infot, nout, lerr, ok )
417  END IF
418 *
419 * Print a summary line.
420 *
421  CALL alaesm( path, ok, nout )
422 *
423  RETURN
424 *
425 * End of ZERRHE
426 *
427  END
zhetri2
subroutine zhetri2(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRI2
Definition: zhetri2.f:129
zherfs
subroutine zherfs(UPLO, N, NRHS, A, LDA, AF, LDAF, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZHERFS
Definition: zherfs.f:194
zhptrs
subroutine zhptrs(UPLO, N, NRHS, AP, IPIV, B, LDB, INFO)
ZHPTRS
Definition: zhptrs.f:117
zhetrf_rook
subroutine zhetrf_rook(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
Definition: zhetrf_rook.f:214
zhprfs
subroutine zhprfs(UPLO, N, NRHS, AP, AFP, IPIV, B, LDB, X, LDX, FERR, BERR, WORK, RWORK, INFO)
ZHPRFS
Definition: zhprfs.f:182
zerrhe
subroutine zerrhe(PATH, NUNIT)
ZERRHE
Definition: zerrhe.f:57
zhetf2
subroutine zhetf2(UPLO, N, A, LDA, IPIV, INFO)
ZHETF2 computes the factorization of a complex Hermitian matrix, using the diagonal pivoting method (...
Definition: zhetf2.f:193
zhecon_rook
subroutine zhecon_rook(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZHECON_ROOK estimates the reciprocal of the condition number fort HE matrices using factorization obt...
Definition: zhecon_rook.f:141
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
zhptrf
subroutine zhptrf(UPLO, N, AP, IPIV, INFO)
ZHPTRF
Definition: zhptrf.f:161
zhptri
subroutine zhptri(UPLO, N, AP, IPIV, WORK, INFO)
ZHPTRI
Definition: zhptri.f:111
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
zhetri
subroutine zhetri(UPLO, N, A, LDA, IPIV, WORK, INFO)
ZHETRI
Definition: zhetri.f:116
zhetri_rook
subroutine zhetri_rook(UPLO, N, A, LDA, IPIV, WORK, INFO)
ZHETRI_ROOK computes the inverse of HE matrix using the factorization obtained with the bounded Bunch...
Definition: zhetri_rook.f:130
zhetf2_rook
subroutine zhetf2_rook(UPLO, N, A, LDA, IPIV, INFO)
ZHETF2_ROOK computes the factorization of a complex Hermitian indefinite matrix using the bounded Bun...
Definition: zhetf2_rook.f:196
zhetrf
subroutine zhetrf(UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO)
ZHETRF
Definition: zhetrf.f:179
zhpcon
subroutine zhpcon(UPLO, N, AP, IPIV, ANORM, RCOND, WORK, INFO)
ZHPCON
Definition: zhpcon.f:120
zhetrs
subroutine zhetrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZHETRS
Definition: zhetrs.f:122
zhetrs_rook
subroutine zhetrs_rook(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZHETRS_ROOK computes the solution to a system of linear equations A * X = B for HE matrices using fac...
Definition: zhetrs_rook.f:138
zhecon
subroutine zhecon(UPLO, N, A, LDA, IPIV, ANORM, RCOND, WORK, INFO)
ZHECON
Definition: zhecon.f:127