1       SUBROUTINE ZERRHE( PATH, NUNIT )
  2 *
  3 *  -- LAPACK test routine (version 3.3.1) --
  4 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
  5 *  -- April 2011                                                      --
  6 *
  7 *     .. Scalar Arguments ..
  8       CHARACTER*3        PATH
  9       INTEGER            NUNIT
 10 *     ..
 11 *
 12 *  Purpose
 13 *  =======
 14 *
 15 *  ZERRHE tests the error exits for the COMPLEX*16 routines
 16 *  for Hermitian indefinite matrices.
 17 *
 18 *  Note that this file is used only when the XBLAS are available,
 19 *  otherwise zerrhe.f defines this subroutine.
 20 *
 21 *  Arguments
 22 *  =========
 23 *
 24 *  PATH    (input) CHARACTER*3
 25 *          The LAPACK path name for the routines to be tested.
 26 *
 27 *  NUNIT   (input) INTEGER
 28 *          The unit number for output.
 29 *
 30 *  =====================================================================
 31 *
 32 *
 33 *     .. Parameters ..
 34       INTEGER            NMAX
 35       PARAMETER          ( NMAX = 4 )
 36 *     ..
 37 *     .. Local Scalars ..
 38       CHARACTER          EQ
 39       CHARACTER*2        C2
 40       INTEGER            I, INFO, J, N_ERR_BNDS, NPARAMS
 41       DOUBLE PRECISION   ANRM, RCOND, BERR
 42 *     ..
 43 *     .. Local Arrays ..
 44       INTEGER            IP( NMAX )
 45       DOUBLE PRECISION   R( NMAX ), R1( NMAX ), R2( NMAX ),
 46      $                   S( NMAX ), ERR_BNDS_N( NMAX, 3 ),
 47      $                   ERR_BNDS_C( NMAX, 3 ), PARAMS( 1 )
 48       COMPLEX*16         A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
 49      $                   W( 2*NMAX ), X( NMAX )
 50 *     ..
 51 *     .. External Functions ..
 52       LOGICAL            LSAMEN
 53       EXTERNAL           LSAMEN
 54 *     ..
 55 *     .. External Subroutines ..
 56       EXTERNAL           ALAESM, CHKXER, ZHECON, ZHERFS, ZHETF2, ZHETRF,
 57      $                   ZHETRI, ZHETRI2, ZHETRS, ZHPCON, ZHPRFS,
 58      $                   ZHPTRF, ZHPTRI, ZHPTRS, ZHERFSX
 59 *     ..
 60 *     .. Scalars in Common ..
 61       LOGICAL            LERR, OK
 62       CHARACTER*32       SRNAMT
 63       INTEGER            INFOT, NOUT
 64 *     ..
 65 *     .. Common blocks ..
 66       COMMON             / INFOC / INFOT, NOUT, OK, LERR
 67       COMMON             / SRNAMC / SRNAMT
 68 *     ..
 69 *     .. Intrinsic Functions ..
 70       INTRINSIC          DBLEDCMPLX
 71 *     ..
 72 *     .. Executable Statements ..
 73 *
 74       NOUT = NUNIT
 75       WRITE( NOUT, FMT = * )
 76       C2 = PATH( 23 )
 77 *
 78 *     Set the variables to innocuous values.
 79 *
 80       DO 20 J = 1, NMAX
 81          DO 10 I = 1, NMAX
 82             A( I, J ) = DCMPLX1.D0 / DBLE( I+J ),
 83      $                  -1.D0 / DBLE( I+J ) )
 84             AF( I, J ) = DCMPLX1.D0 / DBLE( I+J ),
 85      $                   -1.D0 / DBLE( I+J ) )
 86    10    CONTINUE
 87          B( J ) = 0.D0
 88          R1( J ) = 0.D0
 89          R2( J ) = 0.D0
 90          W( J ) = 0.D0
 91          X( J ) = 0.D0
 92          S( J ) = 0.D0
 93          IP( J ) = J
 94    20 CONTINUE
 95       ANRM = 1.0D0
 96       OK = .TRUE.
 97 *
 98 *     Test error exits of the routines that use the diagonal pivoting
 99 *     factorization of a Hermitian indefinite matrix.
100 *
101       IF( LSAMEN( 2, C2, 'HE' ) ) THEN
102 *
103 *        ZHETRF
104 *
105          SRNAMT = 'ZHETRF'
106          INFOT = 1
107          CALL ZHETRF( '/'0, A, 1, IP, W, 1, INFO )
108          CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK )
109          INFOT = 2
110          CALL ZHETRF( 'U'-1, A, 1, IP, W, 1, INFO )
111          CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK )
112          INFOT = 4
113          CALL ZHETRF( 'U'2, A, 1, IP, W, 4, INFO )
114          CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK )
115 *
116 *        ZHETF2
117 *
118          SRNAMT = 'ZHETF2'
119          INFOT = 1
120          CALL ZHETF2( '/'0, A, 1, IP, INFO )
121          CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK )
122          INFOT = 2
123          CALL ZHETF2( 'U'-1, A, 1, IP, INFO )
124          CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK )
125          INFOT = 4
126          CALL ZHETF2( 'U'2, A, 1, IP, INFO )
127          CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK )
128 *
129 *        ZHETRI
130 *
131          SRNAMT = 'ZHETRI'
132          INFOT = 1
133          CALL ZHETRI( '/'0, A, 1, IP, W, INFO )
134          CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK )
135          INFOT = 2
136          CALL ZHETRI( 'U'-1, A, 1, IP, W, INFO )
137          CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK )
138          INFOT = 4
139          CALL ZHETRI( 'U'2, A, 1, IP, W, INFO )
140          CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK )
141 *
142 *        ZHETRI2
143 *
144          SRNAMT = 'ZHETRI2'
145          INFOT = 1
146          CALL ZHETRI2( '/'0, A, 1, IP, W, 1, INFO )
147          CALL CHKXER( 'ZHETRI2', INFOT, NOUT, LERR, OK )
148          INFOT = 2
149          CALL ZHETRI2( 'U'-1, A, 1, IP, W, 1, INFO )
150          CALL CHKXER( 'ZHETRI2', INFOT, NOUT, LERR, OK )
151          INFOT = 4
152          CALL ZHETRI2( 'U'2, A, 1, IP, W, 1, INFO )
153          CALL CHKXER( 'ZHETRI2', INFOT, NOUT, LERR, OK )
154 *
155 *        ZHETRS
156 *
157          SRNAMT = 'ZHETRS'
158          INFOT = 1
159          CALL ZHETRS( '/'00, A, 1, IP, B, 1, INFO )
160          CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK )
161          INFOT = 2
162          CALL ZHETRS( 'U'-10, A, 1, IP, B, 1, INFO )
163          CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK )
164          INFOT = 3
165          CALL ZHETRS( 'U'0-1, A, 1, IP, B, 1, INFO )
166          CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK )
167          INFOT = 5
168          CALL ZHETRS( 'U'21, A, 1, IP, B, 2, INFO )
169          CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK )
170          INFOT = 8
171          CALL ZHETRS( 'U'21, A, 2, IP, B, 1, INFO )
172          CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK )
173 *
174 *        ZHERFS
175 *
176          SRNAMT = 'ZHERFS'
177          INFOT = 1
178          CALL ZHERFS( '/'00, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
179      $                R, INFO )
180          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
181          INFOT = 2
182          CALL ZHERFS( 'U'-10, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
183      $                W, R, INFO )
184          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
185          INFOT = 3
186          CALL ZHERFS( 'U'0-1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
187      $                W, R, INFO )
188          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
189          INFOT = 5
190          CALL ZHERFS( 'U'21, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
191      $                R, INFO )
192          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
193          INFOT = 7
194          CALL ZHERFS( 'U'21, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
195      $                R, INFO )
196          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
197          INFOT = 10
198          CALL ZHERFS( 'U'21, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
199      $                R, INFO )
200          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
201          INFOT = 12
202          CALL ZHERFS( 'U'21, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
203      $                R, INFO )
204          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
205 *
206 *        ZHERFSX
207 *
208          N_ERR_BNDS = 3
209          NPARAMS = 0
210          SRNAMT = 'ZHERFSX'
211          INFOT = 1
212          CALL ZHERFSX( '/', EQ, 00, A, 1, AF, 1, IP, S, B, 1, X, 1,
213      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
214      $        PARAMS, W, R, INFO )
215          CALL CHKXER( 'ZHERFSX', INFOT, NOUT, LERR, OK )
216          INFOT = 2
217          CALL ZHERFSX( 'U', EQ, -10, A, 1, AF, 1, IP, S, B, 1, X, 1,
218      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
219      $        PARAMS, W, R, INFO )
220          CALL CHKXER( 'ZHERFSX', INFOT, NOUT, LERR, OK )
221          EQ = 'N'
222          INFOT = 3
223          CALL ZHERFSX( 'U', EQ, -10, A, 1, AF, 1, IP, S, B, 1, X, 1,
224      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
225      $        PARAMS, W, R, INFO )
226          CALL CHKXER( 'ZHERFSX', INFOT, NOUT, LERR, OK )
227          INFOT = 4
228          CALL ZHERFSX( 'U', EQ, 0-1, A, 1, AF, 1, IP, S, B, 1, X, 1,
229      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
230      $        PARAMS, W, R, INFO )
231          CALL CHKXER( 'ZHERFSX', INFOT, NOUT, LERR, OK )
232          INFOT = 6
233          CALL ZHERFSX( 'U', EQ, 21, A, 1, AF, 2, IP, S, B, 2, X, 2,
234      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
235      $        PARAMS, W, R, INFO )
236          CALL CHKXER( 'ZHERFSX', INFOT, NOUT, LERR, OK )
237          INFOT = 8
238          CALL ZHERFSX( 'U', EQ, 21, A, 2, AF, 1, IP, S, B, 2, X, 2,
239      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
240      $        PARAMS, W, R, INFO )
241          CALL CHKXER( 'ZHERFSX', INFOT, NOUT, LERR, OK )
242          INFOT = 11
243          CALL ZHERFSX( 'U', EQ, 21, A, 2, AF, 2, IP, S, B, 1, X, 2,
244      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
245      $        PARAMS, W, R, INFO )
246          CALL CHKXER( 'ZHERFSX', INFOT, NOUT, LERR, OK )
247          INFOT = 13
248          CALL ZHERFSX( 'U', EQ, 21, A, 2, AF, 2, IP, S, B, 2, X, 1,
249      $        RCOND, BERR, N_ERR_BNDS, ERR_BNDS_N, ERR_BNDS_C, NPARAMS,
250      $        PARAMS, W, R, INFO )
251          CALL CHKXER( 'ZHERFSX', INFOT, NOUT, LERR, OK )
252 *
253 *        ZHECON
254 *
255          SRNAMT = 'ZHECON'
256          INFOT = 1
257          CALL ZHECON( '/'0, A, 1, IP, ANRM, RCOND, W, INFO )
258          CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK )
259          INFOT = 2
260          CALL ZHECON( 'U'-1, A, 1, IP, ANRM, RCOND, W, INFO )
261          CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK )
262          INFOT = 4
263          CALL ZHECON( 'U'2, A, 1, IP, ANRM, RCOND, W, INFO )
264          CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK )
265          INFOT = 6
266          CALL ZHECON( 'U'1, A, 1, IP, -ANRM, RCOND, W, INFO )
267          CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK )
268 *
269 *     Test error exits of the routines that use the diagonal pivoting
270 *     factorization of a Hermitian indefinite packed matrix.
271 *
272       ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
273 *
274 *        ZHPTRF
275 *
276          SRNAMT = 'ZHPTRF'
277          INFOT = 1
278          CALL ZHPTRF( '/'0, A, IP, INFO )
279          CALL CHKXER( 'ZHPTRF', INFOT, NOUT, LERR, OK )
280          INFOT = 2
281          CALL ZHPTRF( 'U'-1, A, IP, INFO )
282          CALL CHKXER( 'ZHPTRF', INFOT, NOUT, LERR, OK )
283 *
284 *        ZHPTRI
285 *
286          SRNAMT = 'ZHPTRI'
287          INFOT = 1
288          CALL ZHPTRI( '/'0, A, IP, W, INFO )
289          CALL CHKXER( 'ZHPTRI', INFOT, NOUT, LERR, OK )
290          INFOT = 2
291          CALL ZHPTRI( 'U'-1, A, IP, W, INFO )
292          CALL CHKXER( 'ZHPTRI', INFOT, NOUT, LERR, OK )
293 *
294 *        ZHPTRS
295 *
296          SRNAMT = 'ZHPTRS'
297          INFOT = 1
298          CALL ZHPTRS( '/'00, A, IP, B, 1, INFO )
299          CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK )
300          INFOT = 2
301          CALL ZHPTRS( 'U'-10, A, IP, B, 1, INFO )
302          CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK )
303          INFOT = 3
304          CALL ZHPTRS( 'U'0-1, A, IP, B, 1, INFO )
305          CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK )
306          INFOT = 7
307          CALL ZHPTRS( 'U'21, A, IP, B, 1, INFO )
308          CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK )
309 *
310 *        ZHPRFS
311 *
312          SRNAMT = 'ZHPRFS'
313          INFOT = 1
314          CALL ZHPRFS( '/'00, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
315      $                INFO )
316          CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK )
317          INFOT = 2
318          CALL ZHPRFS( 'U'-10, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
319      $                INFO )
320          CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK )
321          INFOT = 3
322          CALL ZHPRFS( 'U'0-1, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
323      $                INFO )
324          CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK )
325          INFOT = 8
326          CALL ZHPRFS( 'U'21, A, AF, IP, B, 1, X, 2, R1, R2, W, R,
327      $                INFO )
328          CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK )
329          INFOT = 10
330          CALL ZHPRFS( 'U'21, A, AF, IP, B, 2, X, 1, R1, R2, W, R,
331      $                INFO )
332          CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK )
333 *
334 *        ZHPCON
335 *
336          SRNAMT = 'ZHPCON'
337          INFOT = 1
338          CALL ZHPCON( '/'0, A, IP, ANRM, RCOND, W, INFO )
339          CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK )
340          INFOT = 2
341          CALL ZHPCON( 'U'-1, A, IP, ANRM, RCOND, W, INFO )
342          CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK )
343          INFOT = 5
344          CALL ZHPCON( 'U'1, A, IP, -ANRM, RCOND, W, INFO )
345          CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK )
346       END IF
347 *
348 *     Print a summary line.
349 *
350       CALL ALAESM( PATH, OK, NOUT )
351 *
352       RETURN
353 *
354 *     End of ZERRHE
355 *
356       END