1       SUBROUTINE DERRGE( 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 *  DERRGE tests the error exits for the DOUBLE PRECISION 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       DOUBLE PRECISION   ANRM, CCOND, RCOND
 37 *     ..
 38 *     .. Local Arrays ..
 39       INTEGER            IP( NMAX ), IW( NMAX )
 40       DOUBLE PRECISION   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, DGBCON, DGBEQU, DGBRFS, DGBTF2,
 49      $                   DGBTRF, DGBTRS, DGECON, DGEEQU, DGERFS, DGETF2,
 50      $                   DGETRF, DGETRI, DGETRS
 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          DBLE
 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.D0 / DBLE( I+J )
 75             AF( I, J ) = 1.D0 / DBLE( I+J )
 76    10    CONTINUE
 77          B( J ) = 0.D0
 78          R1( J ) = 0.D0
 79          R2( J ) = 0.D0
 80          W( J ) = 0.D0
 81          X( J ) = 0.D0
 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 *        DGETRF
 93 *
 94          SRNAMT = 'DGETRF'
 95          INFOT = 1
 96          CALL DGETRF( -10, A, 1, IP, INFO )
 97          CALL CHKXER( 'DGETRF', INFOT, NOUT, LERR, OK )
 98          INFOT = 2
 99          CALL DGETRF( 0-1, A, 1, IP, INFO )
100          CALL CHKXER( 'DGETRF', INFOT, NOUT, LERR, OK )
101          INFOT = 4
102          CALL DGETRF( 21, A, 1, IP, INFO )
103          CALL CHKXER( 'DGETRF', INFOT, NOUT, LERR, OK )
104 *
105 *        DGETF2
106 *
107          SRNAMT = 'DGETF2'
108          INFOT = 1
109          CALL DGETF2( -10, A, 1, IP, INFO )
110          CALL CHKXER( 'DGETF2', INFOT, NOUT, LERR, OK )
111          INFOT = 2
112          CALL DGETF2( 0-1, A, 1, IP, INFO )
113          CALL CHKXER( 'DGETF2', INFOT, NOUT, LERR, OK )
114          INFOT = 4
115          CALL DGETF2( 21, A, 1, IP, INFO )
116          CALL CHKXER( 'DGETF2', INFOT, NOUT, LERR, OK )
117 *
118 *        DGETRI
119 *
120          SRNAMT = 'DGETRI'
121          INFOT = 1
122          CALL DGETRI( -1, A, 1, IP, W, LW, INFO )
123          CALL CHKXER( 'DGETRI', INFOT, NOUT, LERR, OK )
124          INFOT = 3
125          CALL DGETRI( 2, A, 1, IP, W, LW, INFO )
126          CALL CHKXER( 'DGETRI', INFOT, NOUT, LERR, OK )
127 *
128 *        DGETRS
129 *
130          SRNAMT = 'DGETRS'
131          INFOT = 1
132          CALL DGETRS( '/'00, A, 1, IP, B, 1, INFO )
133          CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK )
134          INFOT = 2
135          CALL DGETRS( 'N'-10, A, 1, IP, B, 1, INFO )
136          CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK )
137          INFOT = 3
138          CALL DGETRS( 'N'0-1, A, 1, IP, B, 1, INFO )
139          CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK )
140          INFOT = 5
141          CALL DGETRS( 'N'21, A, 1, IP, B, 2, INFO )
142          CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK )
143          INFOT = 8
144          CALL DGETRS( 'N'21, A, 2, IP, B, 1, INFO )
145          CALL CHKXER( 'DGETRS', INFOT, NOUT, LERR, OK )
146 *
147 *        DGERFS
148 *
149          SRNAMT = 'DGERFS'
150          INFOT = 1
151          CALL DGERFS( '/'00, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2, W,
152      $                IW, INFO )
153          CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
154          INFOT = 2
155          CALL DGERFS( 'N'-10, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
156      $                W, IW, INFO )
157          CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
158          INFOT = 3
159          CALL DGERFS( 'N'0-1, A, 1, AF, 1, IP, B, 1, X, 1, R1, R2,
160      $                W, IW, INFO )
161          CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
162          INFOT = 5
163          CALL DGERFS( 'N'21, A, 1, AF, 2, IP, B, 2, X, 2, R1, R2, W,
164      $                IW, INFO )
165          CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
166          INFOT = 7
167          CALL DGERFS( 'N'21, A, 2, AF, 1, IP, B, 2, X, 2, R1, R2, W,
168      $                IW, INFO )
169          CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
170          INFOT = 10
171          CALL DGERFS( 'N'21, A, 2, AF, 2, IP, B, 1, X, 2, R1, R2, W,
172      $                IW, INFO )
173          CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
174          INFOT = 12
175          CALL DGERFS( 'N'21, A, 2, AF, 2, IP, B, 2, X, 1, R1, R2, W,
176      $                IW, INFO )
177          CALL CHKXER( 'DGERFS', INFOT, NOUT, LERR, OK )
178 *
179 *        DGECON
180 *
181          SRNAMT = 'DGECON'
182          INFOT = 1
183          CALL DGECON( '/'0, A, 1, ANRM, RCOND, W, IW, INFO )
184          CALL CHKXER( 'DGECON', INFOT, NOUT, LERR, OK )
185          INFOT = 2
186          CALL DGECON( '1'-1, A, 1, ANRM, RCOND, W, IW, INFO )
187          CALL CHKXER( 'DGECON', INFOT, NOUT, LERR, OK )
188          INFOT = 4
189          CALL DGECON( '1'2, A, 1, ANRM, RCOND, W, IW, INFO )
190          CALL CHKXER( 'DGECON', INFOT, NOUT, LERR, OK )
191 *
192 *        DGEEQU
193 *
194          SRNAMT = 'DGEEQU'
195          INFOT = 1
196          CALL DGEEQU( -10, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
197          CALL CHKXER( 'DGEEQU', INFOT, NOUT, LERR, OK )
198          INFOT = 2
199          CALL DGEEQU( 0-1, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
200          CALL CHKXER( 'DGEEQU', INFOT, NOUT, LERR, OK )
201          INFOT = 4
202          CALL DGEEQU( 22, A, 1, R1, R2, RCOND, CCOND, ANRM, INFO )
203          CALL CHKXER( 'DGEEQU', 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 *        DGBTRF
211 *
212          SRNAMT = 'DGBTRF'
213          INFOT = 1
214          CALL DGBTRF( -1000, A, 1, IP, INFO )
215          CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK )
216          INFOT = 2
217          CALL DGBTRF( 0-100, A, 1, IP, INFO )
218          CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK )
219          INFOT = 3
220          CALL DGBTRF( 11-10, A, 1, IP, INFO )
221          CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK )
222          INFOT = 4
223          CALL DGBTRF( 110-1, A, 1, IP, INFO )
224          CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK )
225          INFOT = 6
226          CALL DGBTRF( 2211, A, 3, IP, INFO )
227          CALL CHKXER( 'DGBTRF', INFOT, NOUT, LERR, OK )
228 *
229 *        DGBTF2
230 *
231          SRNAMT = 'DGBTF2'
232          INFOT = 1
233          CALL DGBTF2( -1000, A, 1, IP, INFO )
234          CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK )
235          INFOT = 2
236          CALL DGBTF2( 0-100, A, 1, IP, INFO )
237          CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK )
238          INFOT = 3
239          CALL DGBTF2( 11-10, A, 1, IP, INFO )
240          CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK )
241          INFOT = 4
242          CALL DGBTF2( 110-1, A, 1, IP, INFO )
243          CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK )
244          INFOT = 6
245          CALL DGBTF2( 2211, A, 3, IP, INFO )
246          CALL CHKXER( 'DGBTF2', INFOT, NOUT, LERR, OK )
247 *
248 *        DGBTRS
249 *
250          SRNAMT = 'DGBTRS'
251          INFOT = 1
252          CALL DGBTRS( '/'0001, A, 1, IP, B, 1, INFO )
253          CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
254          INFOT = 2
255          CALL DGBTRS( 'N'-1001, A, 1, IP, B, 1, INFO )
256          CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
257          INFOT = 3
258          CALL DGBTRS( 'N'1-101, A, 1, IP, B, 1, INFO )
259          CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
260          INFOT = 4
261          CALL DGBTRS( 'N'10-11, A, 1, IP, B, 1, INFO )
262          CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
263          INFOT = 5
264          CALL DGBTRS( 'N'100-1, A, 1, IP, B, 1, INFO )
265          CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
266          INFOT = 7
267          CALL DGBTRS( 'N'2111, A, 3, IP, B, 2, INFO )
268          CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
269          INFOT = 10
270          CALL DGBTRS( 'N'2001, A, 1, IP, B, 1, INFO )
271          CALL CHKXER( 'DGBTRS', INFOT, NOUT, LERR, OK )
272 *
273 *        DGBRFS
274 *
275          SRNAMT = 'DGBRFS'
276          INFOT = 1
277          CALL DGBRFS( '/'0000, A, 1, AF, 1, IP, B, 1, X, 1, R1,
278      $                R2, W, IW, INFO )
279          CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
280          INFOT = 2
281          CALL DGBRFS( 'N'-1000, A, 1, AF, 1, IP, B, 1, X, 1, R1,
282      $                R2, W, IW, INFO )
283          CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
284          INFOT = 3
285          CALL DGBRFS( 'N'1-100, A, 1, AF, 1, IP, B, 1, X, 1, R1,
286      $                R2, W, IW, INFO )
287          CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
288          INFOT = 4
289          CALL DGBRFS( 'N'10-10, A, 1, AF, 1, IP, B, 1, X, 1, R1,
290      $                R2, W, IW, INFO )
291          CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
292          INFOT = 5
293          CALL DGBRFS( 'N'100-1, A, 1, AF, 1, IP, B, 1, X, 1, R1,
294      $                R2, W, IW, INFO )
295          CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
296          INFOT = 7
297          CALL DGBRFS( 'N'2111, A, 2, AF, 4, IP, B, 2, X, 2, R1,
298      $                R2, W, IW, INFO )
299          CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
300          INFOT = 9
301          CALL DGBRFS( 'N'2111, A, 3, AF, 3, IP, B, 2, X, 2, R1,
302      $                R2, W, IW, INFO )
303          CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
304          INFOT = 12
305          CALL DGBRFS( 'N'2001, A, 1, AF, 1, IP, B, 1, X, 2, R1,
306      $                R2, W, IW, INFO )
307          CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
308          INFOT = 14
309          CALL DGBRFS( 'N'2001, A, 1, AF, 1, IP, B, 2, X, 1, R1,
310      $                R2, W, IW, INFO )
311          CALL CHKXER( 'DGBRFS', INFOT, NOUT, LERR, OK )
312 *
313 *        DGBCON
314 *
315          SRNAMT = 'DGBCON'
316          INFOT = 1
317          CALL DGBCON( '/'000, A, 1, IP, ANRM, RCOND, W, IW, INFO )
318          CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK )
319          INFOT = 2
320          CALL DGBCON( '1'-100, A, 1, IP, ANRM, RCOND, W, IW,
321      $                INFO )
322          CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK )
323          INFOT = 3
324          CALL DGBCON( '1'1-10, A, 1, IP, ANRM, RCOND, W, IW,
325      $                INFO )
326          CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK )
327          INFOT = 4
328          CALL DGBCON( '1'10-1, A, 1, IP, ANRM, RCOND, W, IW,
329      $                INFO )
330          CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK )
331          INFOT = 6
332          CALL DGBCON( '1'211, A, 3, IP, ANRM, RCOND, W, IW, INFO )
333          CALL CHKXER( 'DGBCON', INFOT, NOUT, LERR, OK )
334 *
335 *        DGBEQU
336 *
337          SRNAMT = 'DGBEQU'
338          INFOT = 1
339          CALL DGBEQU( -1000, A, 1, R1, R2, RCOND, CCOND, ANRM,
340      $                INFO )
341          CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK )
342          INFOT = 2
343          CALL DGBEQU( 0-100, A, 1, R1, R2, RCOND, CCOND, ANRM,
344      $                INFO )
345          CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK )
346          INFOT = 3
347          CALL DGBEQU( 11-10, A, 1, R1, R2, RCOND, CCOND, ANRM,
348      $                INFO )
349          CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK )
350          INFOT = 4
351          CALL DGBEQU( 110-1, A, 1, R1, R2, RCOND, CCOND, ANRM,
352      $                INFO )
353          CALL CHKXER( 'DGBEQU', INFOT, NOUT, LERR, OK )
354          INFOT = 6
355          CALL DGBEQU( 2211, A, 2, R1, R2, RCOND, CCOND, ANRM,
356      $                INFO )
357          CALL CHKXER( 'DGBEQU', 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 DERRGE
367 *
368       END