1       SUBROUTINE SERRGE( PATH, NUNIT )
  2 *
  3 *  -- LAPACK test routine (version 3.1) --
  4 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
  5 *     November 2006
  6 *
  7 *     .. Scalar Arguments ..
  8       CHARACTER*3        PATH
  9       INTEGER            NUNIT
 10 *     ..
 11 *
 12 *  Purpose
 13 *  =======
 14 *
 15 *  SERRGE tests the error exits for the REAL routines
 16 *  for general 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 *     .. Parameters ..
 30       INTEGER            NMAX, LW
 31       PARAMETER          ( NMAX = 4, LW = 3*NMAX )
 32 *     ..
 33 *     .. Local Scalars ..
 34       CHARACTER*2        C2
 35       INTEGER            I, INFO, J
 36       REAL               ANRM, CCOND, RCOND
 37 *     ..
 38 *     .. Local Arrays ..
 39       INTEGER            IP( NMAX ), IW( NMAX )
 40       REAL               A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
 41      $                   R1( NMAX ), R2( NMAX ), W( LW ), X( NMAX )
 42 *     ..
 43 *     .. External Functions ..
 44       LOGICAL            LSAMEN
 45       EXTERNAL           LSAMEN
 46 *     ..
 47 *     .. External Subroutines ..
 48       EXTERNAL           ALAESM, CHKXER, SGBCON, SGBEQU, SGBRFS, SGBTF2,
 49      $                   SGBTRF, SGBTRS, SGECON, SGEEQU, SGERFS, SGETF2,
 50      $                   SGETRF, SGETRI, SGETRS
 51 *     ..
 52 *     .. Scalars in Common ..
 53       LOGICAL            LERR, OK
 54       CHARACTER*32       SRNAMT
 55       INTEGER            INFOT, NOUT
 56 *     ..
 57 *     .. Common blocks ..
 58       COMMON             / INFOC / INFOT, NOUT, OK, LERR
 59       COMMON             / SRNAMC / SRNAMT
 60 *     ..
 61 *     .. Intrinsic Functions ..
 62       INTRINSIC          REAL
 63 *     ..
 64 *     .. Executable Statements ..
 65 *
 66       NOUT = NUNIT
 67       WRITE( NOUT, FMT = * )
 68       C2 = PATH( 23 )
 69 *
 70 *     Set the variables to innocuous values.
 71 *
 72       DO 20 J = 1, NMAX
 73          DO 10 I = 1, NMAX
 74             A( I, J ) = 1/ REAL( I+J )
 75             AF( I, J ) = 1/ REAL( I+J )
 76    10    CONTINUE
 77          B( J ) = 0.
 78          R1( J ) = 0.
 79          R2( J ) = 0.
 80          W( J ) = 0.
 81          X( J ) = 0.
 82          IP( J ) = J
 83          IW( J ) = J
 84    20 CONTINUE
 85       OK = .TRUE.
 86 *
 87       IF( LSAMEN( 2, C2, 'GE' ) ) THEN
 88 *
 89 *        Test error exits of the routines that use the LU decomposition
 90 *        of a general matrix.
 91 *
 92 *        SGETRF
 93 *
 94          SRNAMT = 'SGETRF'
 95          INFOT = 1
 96          CALL SGETRF( -10, A, 1, IP, INFO )
 97          CALL CHKXER( 'SGETRF', INFOT, NOUT, LERR, OK )
 98          INFOT = 2
 99          CALL SGETRF( 0-1, A, 1, IP, INFO )
100          CALL CHKXER( 'SGETRF', INFOT, NOUT, LERR, OK )
101          INFOT = 4
102          CALL SGETRF( 21, A, 1, IP, INFO )
103          CALL CHKXER( 'SGETRF', INFOT, NOUT, LERR, OK )
104 *
105 *        SGETF2
106 *
107          SRNAMT = 'SGETF2'
108          INFOT = 1
109          CALL SGETF2( -10, A, 1, IP, INFO )
110          CALL CHKXER( 'SGETF2', INFOT, NOUT, LERR, OK )
111          INFOT = 2
112          CALL SGETF2( 0-1, A, 1, IP, INFO )
113          CALL CHKXER( 'SGETF2', INFOT, NOUT, LERR, OK )
114          INFOT = 4
115          CALL SGETF2( 21, A, 1, IP, INFO )
116          CALL CHKXER( 'SGETF2', INFOT, NOUT, LERR, OK )
117 *
118 *        SGETRI
119 *
120          SRNAMT = 'SGETRI'
121          INFOT = 1
122          CALL SGETRI( -1, A, 1, IP, W, LW, INFO )
123          CALL CHKXER( 'SGETRI', INFOT, NOUT, LERR, OK )
124          INFOT = 3
125          CALL SGETRI( 2, A, 1, IP, W, LW, INFO )
126          CALL CHKXER( 'SGETRI', INFOT, NOUT, LERR, OK )
127 *
128 *        SGETRS
129 *
130          SRNAMT = 'SGETRS'
131          INFOT = 1
132          CALL SGETRS( '/'00, A, 1, IP, B, 1, INFO )
133          CALL CHKXER( 'SGETRS', INFOT, NOUT, LERR, OK )
134          INFOT = 2
135          CALL SGETRS( 'N'-10, A, 1, IP, B, 1, INFO )
136          CALL CHKXER( 'SGETRS', INFOT, NOUT, LERR, OK )
137          INFOT = 3
138          CALL SGETRS( 'N'0-1, A, 1, IP, B, 1, INFO )
139          CALL CHKXER( 'SGETRS', INFOT, NOUT, LERR, OK )
140          INFOT = 5
141          CALL SGETRS( 'N'21, A, 1, IP, B, 2, INFO )
142          CALL CHKXER( 'SGETRS', INFOT, NOUT, LERR, OK )
143          INFOT = 8
144          CALL SGETRS( 'N'21, A, 2, IP, B, 1, INFO )
145          CALL CHKXER( 'SGETRS', INFOT, NOUT, LERR, OK )
146 *
147 *        SGERFS
148 *
149          SRNAMT = 'SGERFS'
150          INFOT = 1
151          CALL SGERFS( '/'00, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
152      $                IW, INFO )
153          CALL CHKXER( 'SGERFS', INFOT, NOUT, LERR, OK )
154          INFOT = 2
155          CALL SGERFS( 'N'-10, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
156      $                W, IW, INFO )
157          CALL CHKXER( 'SGERFS', INFOT, NOUT, LERR, OK )
158          INFOT = 3
159          CALL SGERFS( 'N'0-1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
160      $                W, IW, INFO )
161          CALL CHKXER( 'SGERFS', INFOT, NOUT, LERR, OK )
162          INFOT = 5
163          CALL SGERFS( 'N'21, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
164      $                IW, INFO )
165          CALL CHKXER( 'SGERFS', INFOT, NOUT, LERR, OK )
166          INFOT = 7
167          CALL SGERFS( 'N'21, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
168      $                IW, INFO )
169          CALL CHKXER( 'SGERFS', INFOT, NOUT, LERR, OK )
170          INFOT = 10
171          CALL SGERFS( 'N'21, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
172      $                IW, INFO )
173          CALL CHKXER( 'SGERFS', INFOT, NOUT, LERR, OK )
174          INFOT = 12
175          CALL SGERFS( 'N'21, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
176      $                IW, INFO )
177          CALL CHKXER( 'SGERFS', INFOT, NOUT, LERR, OK )
178 *
179 *        SGECON
180 *
181          SRNAMT = 'SGECON'
182          INFOT = 1
183          CALL SGECON( '/'0, A, 1, ANRM, RCOND, W, IW, INFO )
184          CALL CHKXER( 'SGECON', INFOT, NOUT, LERR, OK )
185          INFOT = 2
186          CALL SGECON( '1'-1, A, 1, ANRM, RCOND, W, IW, INFO )
187          CALL CHKXER( 'SGECON', INFOT, NOUT, LERR, OK )
188          INFOT = 4
189          CALL SGECON( '1'2, A, 1, ANRM, RCOND, W, IW, INFO )
190          CALL CHKXER( 'SGECON', INFOT, NOUT, LERR, OK )
191 *
192 *        SGEEQU
193 *
194          SRNAMT = 'SGEEQU'
195          INFOT = 1
196          CALL SGEEQU( -10, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
197          CALL CHKXER( 'SGEEQU', INFOT, NOUT, LERR, OK )
198          INFOT = 2
199          CALL SGEEQU( 0-1, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
200          CALL CHKXER( 'SGEEQU', INFOT, NOUT, LERR, OK )
201          INFOT = 4
202          CALL SGEEQU( 22, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
203          CALL CHKXER( 'SGEEQU', INFOT, NOUT, LERR, OK )
204 *
205       ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN
206 *
207 *        Test error exits of the routines that use the LU decomposition
208 *        of a general band matrix.
209 *
210 *        SGBTRF
211 *
212          SRNAMT = 'SGBTRF'
213          INFOT = 1
214          CALL SGBTRF( -1000, A, 1, IP, INFO )
215          CALL CHKXER( 'SGBTRF', INFOT, NOUT, LERR, OK )
216          INFOT = 2
217          CALL SGBTRF( 0-100, A, 1, IP, INFO )
218          CALL CHKXER( 'SGBTRF', INFOT, NOUT, LERR, OK )
219          INFOT = 3
220          CALL SGBTRF( 11-10, A, 1, IP, INFO )
221          CALL CHKXER( 'SGBTRF', INFOT, NOUT, LERR, OK )
222          INFOT = 4
223          CALL SGBTRF( 110-1, A, 1, IP, INFO )
224          CALL CHKXER( 'SGBTRF', INFOT, NOUT, LERR, OK )
225          INFOT = 6
226          CALL SGBTRF( 2211, A, 3, IP, INFO )
227          CALL CHKXER( 'SGBTRF', INFOT, NOUT, LERR, OK )
228 *
229 *        SGBTF2
230 *
231          SRNAMT = 'SGBTF2'
232          INFOT = 1
233          CALL SGBTF2( -1000, A, 1, IP, INFO )
234          CALL CHKXER( 'SGBTF2', INFOT, NOUT, LERR, OK )
235          INFOT = 2
236          CALL SGBTF2( 0-100, A, 1, IP, INFO )
237          CALL CHKXER( 'SGBTF2', INFOT, NOUT, LERR, OK )
238          INFOT = 3
239          CALL SGBTF2( 11-10, A, 1, IP, INFO )
240          CALL CHKXER( 'SGBTF2', INFOT, NOUT, LERR, OK )
241          INFOT = 4
242          CALL SGBTF2( 110-1, A, 1, IP, INFO )
243          CALL CHKXER( 'SGBTF2', INFOT, NOUT, LERR, OK )
244          INFOT = 6
245          CALL SGBTF2( 2211, A, 3, IP, INFO )
246          CALL CHKXER( 'SGBTF2', INFOT, NOUT, LERR, OK )
247 *
248 *        SGBTRS
249 *
250          SRNAMT = 'SGBTRS'
251          INFOT = 1
252          CALL SGBTRS( '/'0001, A, 1, IP, B, 1, INFO )
253          CALL CHKXER( 'SGBTRS', INFOT, NOUT, LERR, OK )
254          INFOT = 2
255          CALL SGBTRS( 'N'-1001, A, 1, IP, B, 1, INFO )
256          CALL CHKXER( 'SGBTRS', INFOT, NOUT, LERR, OK )
257          INFOT = 3
258          CALL SGBTRS( 'N'1-101, A, 1, IP, B, 1, INFO )
259          CALL CHKXER( 'SGBTRS', INFOT, NOUT, LERR, OK )
260          INFOT = 4
261          CALL SGBTRS( 'N'10-11, A, 1, IP, B, 1, INFO )
262          CALL CHKXER( 'SGBTRS', INFOT, NOUT, LERR, OK )
263          INFOT = 5
264          CALL SGBTRS( 'N'100-1, A, 1, IP, B, 1, INFO )
265          CALL CHKXER( 'SGBTRS', INFOT, NOUT, LERR, OK )
266          INFOT = 7
267          CALL SGBTRS( 'N'2111, A, 3, IP, B, 2, INFO )
268          CALL CHKXER( 'SGBTRS', INFOT, NOUT, LERR, OK )
269          INFOT = 10
270          CALL SGBTRS( 'N'2001, A, 1, IP, B, 1, INFO )
271          CALL CHKXER( 'SGBTRS', INFOT, NOUT, LERR, OK )
272 *
273 *        SGBRFS
274 *
275          SRNAMT = 'SGBRFS'
276          INFOT = 1
277          CALL SGBRFS( '/'0000, A, 1, AF, 1, IP, B, 1, X, 1, R1,
278      $                R2, W, IW, INFO )
279          CALL CHKXER( 'SGBRFS', INFOT, NOUT, LERR, OK )
280          INFOT = 2
281          CALL SGBRFS( 'N'-1000, A, 1, AF, 1, IP, B, 1, X, 1, R1,
282      $                R2, W, IW, INFO )
283          CALL CHKXER( 'SGBRFS', INFOT, NOUT, LERR, OK )
284          INFOT = 3
285          CALL SGBRFS( 'N'1-100, A, 1, AF, 1, IP, B, 1, X, 1, R1,
286      $                R2, W, IW, INFO )
287          CALL CHKXER( 'SGBRFS', INFOT, NOUT, LERR, OK )
288          INFOT = 4
289          CALL SGBRFS( 'N'10-10, A, 1, AF, 1, IP, B, 1, X, 1, R1,
290      $                R2, W, IW, INFO )
291          CALL CHKXER( 'SGBRFS', INFOT, NOUT, LERR, OK )
292          INFOT = 5
293          CALL SGBRFS( 'N'100-1, A, 1, AF, 1, IP, B, 1, X, 1, R1,
294      $                R2, W, IW, INFO )
295          CALL CHKXER( 'SGBRFS', INFOT, NOUT, LERR, OK )
296          INFOT = 7
297          CALL SGBRFS( 'N'2111, A, 2, AF, 4, IP, B, 2, X, 2, R1,
298      $                R2, W, IW, INFO )
299          CALL CHKXER( 'SGBRFS', INFOT, NOUT, LERR, OK )
300          INFOT = 9
301          CALL SGBRFS( 'N'2111, A, 3, AF, 3, IP, B, 2, X, 2, R1,
302      $                R2, W, IW, INFO )
303          CALL CHKXER( 'SGBRFS', INFOT, NOUT, LERR, OK )
304          INFOT = 12
305          CALL SGBRFS( 'N'2001, A, 1, AF, 1, IP, B, 1, X, 2, R1,
306      $                R2, W, IW, INFO )
307          CALL CHKXER( 'SGBRFS', INFOT, NOUT, LERR, OK )
308          INFOT = 14
309          CALL SGBRFS( 'N'2001, A, 1, AF, 1, IP, B, 2, X, 1, R1,
310      $                R2, W, IW, INFO )
311          CALL CHKXER( 'SGBRFS', INFOT, NOUT, LERR, OK )
312 *
313 *        SGBCON
314 *
315          SRNAMT = 'SGBCON'
316          INFOT = 1
317          CALL SGBCON( '/'000, A, 1, IP, ANRM, RCOND, W, IW, INFO )
318          CALL CHKXER( 'SGBCON', INFOT, NOUT, LERR, OK )
319          INFOT = 2
320          CALL SGBCON( '1'-100, A, 1, IP, ANRM, RCOND, W, IW,
321      $                INFO )
322          CALL CHKXER( 'SGBCON', INFOT, NOUT, LERR, OK )
323          INFOT = 3
324          CALL SGBCON( '1'1-10, A, 1, IP, ANRM, RCOND, W, IW,
325      $                INFO )
326          CALL CHKXER( 'SGBCON', INFOT, NOUT, LERR, OK )
327          INFOT = 4
328          CALL SGBCON( '1'10-1, A, 1, IP, ANRM, RCOND, W, IW,
329      $                INFO )
330          CALL CHKXER( 'SGBCON', INFOT, NOUT, LERR, OK )
331          INFOT = 6
332          CALL SGBCON( '1'211, A, 3, IP, ANRM, RCOND, W, IW, INFO )
333          CALL CHKXER( 'SGBCON', INFOT, NOUT, LERR, OK )
334 *
335 *        SGBEQU
336 *
337          SRNAMT = 'SGBEQU'
338          INFOT = 1
339          CALL SGBEQU( -1000, A, 1, R1, R2, RCOND, CCOND, ANRM,
340      $                INFO )
341          CALL CHKXER( 'SGBEQU', INFOT, NOUT, LERR, OK )
342          INFOT = 2
343          CALL SGBEQU( 0-100, A, 1, R1, R2, RCOND, CCOND, ANRM,
344      $                INFO )
345          CALL CHKXER( 'SGBEQU', INFOT, NOUT, LERR, OK )
346          INFOT = 3
347          CALL SGBEQU( 11-10, A, 1, R1, R2, RCOND, CCOND, ANRM,
348      $                INFO )
349          CALL CHKXER( 'SGBEQU', INFOT, NOUT, LERR, OK )
350          INFOT = 4
351          CALL SGBEQU( 110-1, A, 1, R1, R2, RCOND, CCOND, ANRM,
352      $                INFO )
353          CALL CHKXER( 'SGBEQU', INFOT, NOUT, LERR, OK )
354          INFOT = 6
355          CALL SGBEQU( 2211, A, 2, R1, R2, RCOND, CCOND, ANRM,
356      $                INFO )
357          CALL CHKXER( 'SGBEQU', INFOT, NOUT, LERR, OK )
358       END IF
359 *
360 *     Print a summary line.
361 *
362       CALL ALAESM( PATH, OK, NOUT )
363 *
364       RETURN
365 *
366 *     End of SERRGE
367 *
368       END