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 *  Arguments
 19 *  =========
 20 *
 21 *  PATH    (input) CHARACTER*3
 22 *          The LAPACK path name for the routines to be tested.
 23 *
 24 *  NUNIT   (input) INTEGER
 25 *          The unit number for output.
 26 *
 27 *  =====================================================================
 28 *
 29 *
 30 *     .. Parameters ..
 31       INTEGER            NMAX
 32       PARAMETER          ( NMAX = 4 )
 33 *     ..
 34 *     .. Local Scalars ..
 35       CHARACTER*2        C2
 36       INTEGER            I, INFO, J
 37       DOUBLE PRECISION   ANRM, RCOND
 38 *     ..
 39 *     .. Local Arrays ..
 40       INTEGER            IP( NMAX )
 41       DOUBLE PRECISION   R( NMAX ), R1( NMAX ), R2( NMAX )
 42       COMPLEX*16         A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
 43      $                   W( 2*NMAX ), X( NMAX )
 44 *     ..
 45 *     .. External Functions ..
 46       LOGICAL            LSAMEN
 47       EXTERNAL           LSAMEN
 48 *     ..
 49 *     .. External Subroutines ..
 50       EXTERNAL           ALAESM, CHKXER, ZHECON, ZHERFS, ZHETF2, ZHETRF,
 51      $                   ZHETRI, ZHETRI2, ZHETRS, ZHPCON, ZHPRFS,
 52      $                   ZHPTRF, ZHPTRI, ZHPTRS
 53 *     ..
 54 *     .. Scalars in Common ..
 55       LOGICAL            LERR, OK
 56       CHARACTER*32       SRNAMT
 57       INTEGER            INFOT, NOUT
 58 *     ..
 59 *     .. Common blocks ..
 60       COMMON             / INFOC / INFOT, NOUT, OK, LERR
 61       COMMON             / SRNAMC / SRNAMT
 62 *     ..
 63 *     .. Intrinsic Functions ..
 64       INTRINSIC          DBLEDCMPLX
 65 *     ..
 66 *     .. Executable Statements ..
 67 *
 68       NOUT = NUNIT
 69       WRITE( NOUT, FMT = * )
 70       C2 = PATH( 23 )
 71 *
 72 *     Set the variables to innocuous values.
 73 *
 74       DO 20 J = 1, NMAX
 75          DO 10 I = 1, NMAX
 76             A( I, J ) = DCMPLX1.D0 / DBLE( I+J ),
 77      $                  -1.D0 / DBLE( I+J ) )
 78             AF( I, J ) = DCMPLX1.D0 / DBLE( I+J ),
 79      $                   -1.D0 / DBLE( I+J ) )
 80    10    CONTINUE
 81          B( J ) = 0.D0
 82          R1( J ) = 0.D0
 83          R2( J ) = 0.D0
 84          W( J ) = 0.D0
 85          X( J ) = 0.D0
 86          IP( J ) = J
 87    20 CONTINUE
 88       ANRM = 1.0D0
 89       OK = .TRUE.
 90 *
 91 *     Test error exits of the routines that use the diagonal pivoting
 92 *     factorization of a Hermitian indefinite matrix.
 93 *
 94       IF( LSAMEN( 2, C2, 'HE' ) ) THEN
 95 *
 96 *        ZHETRF
 97 *
 98          SRNAMT = 'ZHETRF'
 99          INFOT = 1
100          CALL ZHETRF( '/'0, A, 1, IP, W, 1, INFO )
101          CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK )
102          INFOT = 2
103          CALL ZHETRF( 'U'-1, A, 1, IP, W, 1, INFO )
104          CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK )
105          INFOT = 4
106          CALL ZHETRF( 'U'2, A, 1, IP, W, 4, INFO )
107          CALL CHKXER( 'ZHETRF', INFOT, NOUT, LERR, OK )
108 *
109 *        ZHETF2
110 *
111          SRNAMT = 'ZHETF2'
112          INFOT = 1
113          CALL ZHETF2( '/'0, A, 1, IP, INFO )
114          CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK )
115          INFOT = 2
116          CALL ZHETF2( 'U'-1, A, 1, IP, INFO )
117          CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK )
118          INFOT = 4
119          CALL ZHETF2( 'U'2, A, 1, IP, INFO )
120          CALL CHKXER( 'ZHETF2', INFOT, NOUT, LERR, OK )
121 *
122 *        ZHETRI
123 *
124          SRNAMT = 'ZHETRI'
125          INFOT = 1
126          CALL ZHETRI( '/'0, A, 1, IP, W, INFO )
127          CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK )
128          INFOT = 2
129          CALL ZHETRI( 'U'-1, A, 1, IP, W, INFO )
130          CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK )
131          INFOT = 4
132          CALL ZHETRI( 'U'2, A, 1, IP, W, INFO )
133          CALL CHKXER( 'ZHETRI', INFOT, NOUT, LERR, OK )
134 *
135 *        ZHETRI2
136 *
137          SRNAMT = 'ZHETRI2'
138          INFOT = 1
139          CALL ZHETRI2( '/'0, A, 1, IP, W, 1, INFO )
140          CALL CHKXER( 'ZHETRI2', INFOT, NOUT, LERR, OK )
141          INFOT = 2
142          CALL ZHETRI2( 'U'-1, A, 1, IP, W, 1, INFO )
143          CALL CHKXER( 'ZHETRI2', INFOT, NOUT, LERR, OK )
144          INFOT = 4
145          CALL ZHETRI2( 'U'2, A, 1, IP, W, 1, INFO )
146          CALL CHKXER( 'ZHETRI2', INFOT, NOUT, LERR, OK )
147 *
148 *        ZHETRS
149 *
150          SRNAMT = 'ZHETRS'
151          INFOT = 1
152          CALL ZHETRS( '/'00, A, 1, IP, B, 1, INFO )
153          CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK )
154          INFOT = 2
155          CALL ZHETRS( 'U'-10, A, 1, IP, B, 1, INFO )
156          CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK )
157          INFOT = 3
158          CALL ZHETRS( 'U'0-1, A, 1, IP, B, 1, INFO )
159          CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK )
160          INFOT = 5
161          CALL ZHETRS( 'U'21, A, 1, IP, B, 2, INFO )
162          CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK )
163          INFOT = 8
164          CALL ZHETRS( 'U'21, A, 2, IP, B, 1, INFO )
165          CALL CHKXER( 'ZHETRS', INFOT, NOUT, LERR, OK )
166 *
167 *        ZHERFS
168 *
169          SRNAMT = 'ZHERFS'
170          INFOT = 1
171          CALL ZHERFS( '/'00, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
172      $                R, INFO )
173          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
174          INFOT = 2
175          CALL ZHERFS( 'U'-10, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
176      $                W, R, INFO )
177          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
178          INFOT = 3
179          CALL ZHERFS( 'U'0-1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
180      $                W, R, INFO )
181          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
182          INFOT = 5
183          CALL ZHERFS( 'U'21, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
184      $                R, INFO )
185          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
186          INFOT = 7
187          CALL ZHERFS( 'U'21, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
188      $                R, INFO )
189          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
190          INFOT = 10
191          CALL ZHERFS( 'U'21, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
192      $                R, INFO )
193          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
194          INFOT = 12
195          CALL ZHERFS( 'U'21, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
196      $                R, INFO )
197          CALL CHKXER( 'ZHERFS', INFOT, NOUT, LERR, OK )
198 *
199 *        ZHECON
200 *
201          SRNAMT = 'ZHECON'
202          INFOT = 1
203          CALL ZHECON( '/'0, A, 1, IP, ANRM, RCOND, W, INFO )
204          CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK )
205          INFOT = 2
206          CALL ZHECON( 'U'-1, A, 1, IP, ANRM, RCOND, W, INFO )
207          CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK )
208          INFOT = 4
209          CALL ZHECON( 'U'2, A, 1, IP, ANRM, RCOND, W, INFO )
210          CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK )
211          INFOT = 6
212          CALL ZHECON( 'U'1, A, 1, IP, -ANRM, RCOND, W, INFO )
213          CALL CHKXER( 'ZHECON', INFOT, NOUT, LERR, OK )
214 *
215 *     Test error exits of the routines that use the diagonal pivoting
216 *     factorization of a Hermitian indefinite packed matrix.
217 *
218       ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
219 *
220 *        ZHPTRF
221 *
222          SRNAMT = 'ZHPTRF'
223          INFOT = 1
224          CALL ZHPTRF( '/'0, A, IP, INFO )
225          CALL CHKXER( 'ZHPTRF', INFOT, NOUT, LERR, OK )
226          INFOT = 2
227          CALL ZHPTRF( 'U'-1, A, IP, INFO )
228          CALL CHKXER( 'ZHPTRF', INFOT, NOUT, LERR, OK )
229 *
230 *        ZHPTRI
231 *
232          SRNAMT = 'ZHPTRI'
233          INFOT = 1
234          CALL ZHPTRI( '/'0, A, IP, W, INFO )
235          CALL CHKXER( 'ZHPTRI', INFOT, NOUT, LERR, OK )
236          INFOT = 2
237          CALL ZHPTRI( 'U'-1, A, IP, W, INFO )
238          CALL CHKXER( 'ZHPTRI', INFOT, NOUT, LERR, OK )
239 *
240 *        ZHPTRS
241 *
242          SRNAMT = 'ZHPTRS'
243          INFOT = 1
244          CALL ZHPTRS( '/'00, A, IP, B, 1, INFO )
245          CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK )
246          INFOT = 2
247          CALL ZHPTRS( 'U'-10, A, IP, B, 1, INFO )
248          CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK )
249          INFOT = 3
250          CALL ZHPTRS( 'U'0-1, A, IP, B, 1, INFO )
251          CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK )
252          INFOT = 7
253          CALL ZHPTRS( 'U'21, A, IP, B, 1, INFO )
254          CALL CHKXER( 'ZHPTRS', INFOT, NOUT, LERR, OK )
255 *
256 *        ZHPRFS
257 *
258          SRNAMT = 'ZHPRFS'
259          INFOT = 1
260          CALL ZHPRFS( '/'00, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
261      $                INFO )
262          CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK )
263          INFOT = 2
264          CALL ZHPRFS( 'U'-10, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
265      $                INFO )
266          CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK )
267          INFOT = 3
268          CALL ZHPRFS( 'U'0-1, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
269      $                INFO )
270          CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK )
271          INFOT = 8
272          CALL ZHPRFS( 'U'21, A, AF, IP, B, 1, X, 2, R1, R2, W, R,
273      $                INFO )
274          CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK )
275          INFOT = 10
276          CALL ZHPRFS( 'U'21, A, AF, IP, B, 2, X, 1, R1, R2, W, R,
277      $                INFO )
278          CALL CHKXER( 'ZHPRFS', INFOT, NOUT, LERR, OK )
279 *
280 *        ZHPCON
281 *
282          SRNAMT = 'ZHPCON'
283          INFOT = 1
284          CALL ZHPCON( '/'0, A, IP, ANRM, RCOND, W, INFO )
285          CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK )
286          INFOT = 2
287          CALL ZHPCON( 'U'-1, A, IP, ANRM, RCOND, W, INFO )
288          CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK )
289          INFOT = 5
290          CALL ZHPCON( 'U'1, A, IP, -ANRM, RCOND, W, INFO )
291          CALL CHKXER( 'ZHPCON', INFOT, NOUT, LERR, OK )
292       END IF
293 *
294 *     Print a summary line.
295 *
296       CALL ALAESM( PATH, OK, NOUT )
297 *
298       RETURN
299 *
300 *     End of ZERRHE
301 *
302       END