1       SUBROUTINE CERRHE( 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 *  CERRHE tests the error exits for the COMPLEX 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       REAL               ANRM, RCOND
 38 *     ..
 39 *     .. Local Arrays ..
 40       INTEGER            IP( NMAX )
 41       REAL               R( NMAX ), R1( NMAX ), R2( NMAX )
 42       COMPLEX            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, CHECON, CHERFS, CHETF2, CHETRF, CHETRI,
 51      $                   CHETRI2, CHETRS, CHKXER, CHPCON, CHPRFS,
 52      $                   CHPTRF, CHPTRI, CHPTRS
 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          CMPLX, REAL
 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 ) = CMPLX1/ REAL( I+J ), -1/ REAL( I+J ) )
 77             AF( I, J ) = CMPLX1/ REAL( I+J ), -1/ REAL( I+J ) )
 78    10    CONTINUE
 79          B( J ) = 0.
 80          R1( J ) = 0.
 81          R2( J ) = 0.
 82          W( J ) = 0.
 83          X( J ) = 0.
 84          IP( J ) = J
 85    20 CONTINUE
 86       ANRM = 1.0
 87       OK = .TRUE.
 88 *
 89 *     Test error exits of the routines that use the diagonal pivoting
 90 *     factorization of a Hermitian indefinite matrix.
 91 *
 92       IF( LSAMEN( 2, C2, 'HE' ) ) THEN
 93 *
 94 *        CHETRF
 95 *
 96          SRNAMT = 'CHETRF'
 97          INFOT = 1
 98          CALL CHETRF( '/'0, A, 1, IP, W, 1, INFO )
 99          CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK )
100          INFOT = 2
101          CALL CHETRF( 'U'-1, A, 1, IP, W, 1, INFO )
102          CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK )
103          INFOT = 4
104          CALL CHETRF( 'U'2, A, 1, IP, W, 4, INFO )
105          CALL CHKXER( 'CHETRF', INFOT, NOUT, LERR, OK )
106 *
107 *        CHETF2
108 *
109          SRNAMT = 'CHETF2'
110          INFOT = 1
111          CALL CHETF2( '/'0, A, 1, IP, INFO )
112          CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK )
113          INFOT = 2
114          CALL CHETF2( 'U'-1, A, 1, IP, INFO )
115          CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK )
116          INFOT = 4
117          CALL CHETF2( 'U'2, A, 1, IP, INFO )
118          CALL CHKXER( 'CHETF2', INFOT, NOUT, LERR, OK )
119 *
120 *        CHETRI
121 *
122          SRNAMT = 'CHETRI'
123          INFOT = 1
124          CALL CHETRI( '/'0, A, 1, IP, W, INFO )
125          CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK )
126          INFOT = 2
127          CALL CHETRI( 'U'-1, A, 1, IP, W, INFO )
128          CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK )
129          INFOT = 4
130          CALL CHETRI( 'U'2, A, 1, IP, W, INFO )
131          CALL CHKXER( 'CHETRI', INFOT, NOUT, LERR, OK )
132 *
133 *        CHETRI2
134 *
135          SRNAMT = 'CHETRI2'
136          INFOT = 1
137          CALL CHETRI2( '/'0, A, 1, IP, W, 1, INFO )
138          CALL CHKXER( 'CHETRI2', INFOT, NOUT, LERR, OK )
139          INFOT = 2
140          CALL CHETRI2( 'U'-1, A, 1, IP, W, 1, INFO )
141          CALL CHKXER( 'CHETRI2', INFOT, NOUT, LERR, OK )
142          INFOT = 4
143          CALL CHETRI2( 'U'2, A, 1, IP, W, 1, INFO )
144          CALL CHKXER( 'CHETRI2', INFOT, NOUT, LERR, OK )
145 *
146 *        CHETRS
147 *
148          SRNAMT = 'CHETRS'
149          INFOT = 1
150          CALL CHETRS( '/'00, A, 1, IP, B, 1, INFO )
151          CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK )
152          INFOT = 2
153          CALL CHETRS( 'U'-10, A, 1, IP, B, 1, INFO )
154          CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK )
155          INFOT = 3
156          CALL CHETRS( 'U'0-1, A, 1, IP, B, 1, INFO )
157          CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK )
158          INFOT = 5
159          CALL CHETRS( 'U'21, A, 1, IP, B, 2, INFO )
160          CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK )
161          INFOT = 8
162          CALL CHETRS( 'U'21, A, 2, IP, B, 1, INFO )
163          CALL CHKXER( 'CHETRS', INFOT, NOUT, LERR, OK )
164 *
165 *        CHERFS
166 *
167          SRNAMT = 'CHERFS'
168          INFOT = 1
169          CALL CHERFS( '/'00, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
170      $                R, INFO )
171          CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
172          INFOT = 2
173          CALL CHERFS( 'U'-10, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
174      $                W, R, INFO )
175          CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
176          INFOT = 3
177          CALL CHERFS( 'U'0-1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
178      $                W, R, INFO )
179          CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
180          INFOT = 5
181          CALL CHERFS( 'U'21, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
182      $                R, INFO )
183          CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
184          INFOT = 7
185          CALL CHERFS( 'U'21, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
186      $                R, INFO )
187          CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
188          INFOT = 10
189          CALL CHERFS( 'U'21, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
190      $                R, INFO )
191          CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
192          INFOT = 12
193          CALL CHERFS( 'U'21, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
194      $                R, INFO )
195          CALL CHKXER( 'CHERFS', INFOT, NOUT, LERR, OK )
196 *
197 *        CHECON
198 *
199          SRNAMT = 'CHECON'
200          INFOT = 1
201          CALL CHECON( '/'0, A, 1, IP, ANRM, RCOND, W, INFO )
202          CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK )
203          INFOT = 2
204          CALL CHECON( 'U'-1, A, 1, IP, ANRM, RCOND, W, INFO )
205          CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK )
206          INFOT = 4
207          CALL CHECON( 'U'2, A, 1, IP, ANRM, RCOND, W, INFO )
208          CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK )
209          INFOT = 6
210          CALL CHECON( 'U'1, A, 1, IP, -ANRM, RCOND, W, INFO )
211          CALL CHKXER( 'CHECON', INFOT, NOUT, LERR, OK )
212 *
213 *     Test error exits of the routines that use the diagonal pivoting
214 *     factorization of a Hermitian indefinite packed matrix.
215 *
216       ELSE IF( LSAMEN( 2, C2, 'HP' ) ) THEN
217 *
218 *        CHPTRF
219 *
220          SRNAMT = 'CHPTRF'
221          INFOT = 1
222          CALL CHPTRF( '/'0, A, IP, INFO )
223          CALL CHKXER( 'CHPTRF', INFOT, NOUT, LERR, OK )
224          INFOT = 2
225          CALL CHPTRF( 'U'-1, A, IP, INFO )
226          CALL CHKXER( 'CHPTRF', INFOT, NOUT, LERR, OK )
227 *
228 *        CHPTRI
229 *
230          SRNAMT = 'CHPTRI'
231          INFOT = 1
232          CALL CHPTRI( '/'0, A, IP, W, INFO )
233          CALL CHKXER( 'CHPTRI', INFOT, NOUT, LERR, OK )
234          INFOT = 2
235          CALL CHPTRI( 'U'-1, A, IP, W, INFO )
236          CALL CHKXER( 'CHPTRI', INFOT, NOUT, LERR, OK )
237 *
238 *        CHPTRS
239 *
240          SRNAMT = 'CHPTRS'
241          INFOT = 1
242          CALL CHPTRS( '/'00, A, IP, B, 1, INFO )
243          CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK )
244          INFOT = 2
245          CALL CHPTRS( 'U'-10, A, IP, B, 1, INFO )
246          CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK )
247          INFOT = 3
248          CALL CHPTRS( 'U'0-1, A, IP, B, 1, INFO )
249          CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK )
250          INFOT = 7
251          CALL CHPTRS( 'U'21, A, IP, B, 1, INFO )
252          CALL CHKXER( 'CHPTRS', INFOT, NOUT, LERR, OK )
253 *
254 *        CHPRFS
255 *
256          SRNAMT = 'CHPRFS'
257          INFOT = 1
258          CALL CHPRFS( '/'00, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
259      $                INFO )
260          CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK )
261          INFOT = 2
262          CALL CHPRFS( 'U'-10, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
263      $                INFO )
264          CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK )
265          INFOT = 3
266          CALL CHPRFS( 'U'0-1, A, AF, IP, B, 1, X, 1, R1, R2, W, R,
267      $                INFO )
268          CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK )
269          INFOT = 8
270          CALL CHPRFS( 'U'21, A, AF, IP, B, 1, X, 2, R1, R2, W, R,
271      $                INFO )
272          CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK )
273          INFOT = 10
274          CALL CHPRFS( 'U'21, A, AF, IP, B, 2, X, 1, R1, R2, W, R,
275      $                INFO )
276          CALL CHKXER( 'CHPRFS', INFOT, NOUT, LERR, OK )
277 *
278 *        CHPCON
279 *
280          SRNAMT = 'CHPCON'
281          INFOT = 1
282          CALL CHPCON( '/'0, A, IP, ANRM, RCOND, W, INFO )
283          CALL CHKXER( 'CHPCON', INFOT, NOUT, LERR, OK )
284          INFOT = 2
285          CALL CHPCON( 'U'-1, A, IP, ANRM, RCOND, W, INFO )
286          CALL CHKXER( 'CHPCON', INFOT, NOUT, LERR, OK )
287          INFOT = 5
288          CALL CHPCON( 'U'1, A, IP, -ANRM, RCOND, W, INFO )
289          CALL CHKXER( 'CHPCON', INFOT, NOUT, LERR, OK )
290       END IF
291 *
292 *     Print a summary line.
293 *
294       CALL ALAESM( PATH, OK, NOUT )
295 *
296       RETURN
297 *
298 *     End of CERRHE
299 *
300       END