1       SUBROUTINE DERRPO( 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 *  DERRPO tests the error exits for the DOUBLE PRECISION routines
 16 *  for symmetric positive definite 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
 31       PARAMETER          ( NMAX = 4 )
 32 *     ..
 33 *     .. Local Scalars ..
 34       CHARACTER*2        C2
 35       INTEGER            I, INFO, J
 36       DOUBLE PRECISION   ANRM, RCOND
 37 *     ..
 38 *     .. Local Arrays ..
 39       INTEGER            IW( NMAX )
 40       DOUBLE PRECISION   A( NMAX, NMAX ), AF( NMAX, NMAX ), B( NMAX ),
 41      $                   R1( NMAX ), R2( NMAX ), W( 3*NMAX ), X( NMAX )
 42 *     ..
 43 *     .. External Functions ..
 44       LOGICAL            LSAMEN
 45       EXTERNAL           LSAMEN
 46 *     ..
 47 *     .. External Subroutines ..
 48       EXTERNAL           ALAESM, CHKXER, DPBCON, DPBEQU, DPBRFS, DPBTF2,
 49      $                   DPBTRF, DPBTRS, DPOCON, DPOEQU, DPORFS, DPOTF2,
 50      $                   DPOTRF, DPOTRI, DPOTRS, DPPCON, DPPEQU, DPPRFS,
 51      $                   DPPTRF, DPPTRI, DPPTRS
 52 *     ..
 53 *     .. Scalars in Common ..
 54       LOGICAL            LERR, OK
 55       CHARACTER*32       SRNAMT
 56       INTEGER            INFOT, NOUT
 57 *     ..
 58 *     .. Common blocks ..
 59       COMMON             / INFOC / INFOT, NOUT, OK, LERR
 60       COMMON             / SRNAMC / SRNAMT
 61 *     ..
 62 *     .. Intrinsic Functions ..
 63       INTRINSIC          DBLE
 64 *     ..
 65 *     .. Executable Statements ..
 66 *
 67       NOUT = NUNIT
 68       WRITE( NOUT, FMT = * )
 69       C2 = PATH( 23 )
 70 *
 71 *     Set the variables to innocuous values.
 72 *
 73       DO 20 J = 1, NMAX
 74          DO 10 I = 1, NMAX
 75             A( I, J ) = 1.D0 / DBLE( I+J )
 76             AF( I, J ) = 1.D0 / DBLE( I+J )
 77    10    CONTINUE
 78          B( J ) = 0.D0
 79          R1( J ) = 0.D0
 80          R2( J ) = 0.D0
 81          W( J ) = 0.D0
 82          X( J ) = 0.D0
 83          IW( J ) = J
 84    20 CONTINUE
 85       OK = .TRUE.
 86 *
 87       IF( LSAMEN( 2, C2, 'PO' ) ) THEN
 88 *
 89 *        Test error exits of the routines that use the Cholesky
 90 *        decomposition of a symmetric positive definite matrix.
 91 *
 92 *        DPOTRF
 93 *
 94          SRNAMT = 'DPOTRF'
 95          INFOT = 1
 96          CALL DPOTRF( '/'0, A, 1, INFO )
 97          CALL CHKXER( 'DPOTRF', INFOT, NOUT, LERR, OK )
 98          INFOT = 2
 99          CALL DPOTRF( 'U'-1, A, 1, INFO )
100          CALL CHKXER( 'DPOTRF', INFOT, NOUT, LERR, OK )
101          INFOT = 4
102          CALL DPOTRF( 'U'2, A, 1, INFO )
103          CALL CHKXER( 'DPOTRF', INFOT, NOUT, LERR, OK )
104 *
105 *        DPOTF2
106 *
107          SRNAMT = 'DPOTF2'
108          INFOT = 1
109          CALL DPOTF2( '/'0, A, 1, INFO )
110          CALL CHKXER( 'DPOTF2', INFOT, NOUT, LERR, OK )
111          INFOT = 2
112          CALL DPOTF2( 'U'-1, A, 1, INFO )
113          CALL CHKXER( 'DPOTF2', INFOT, NOUT, LERR, OK )
114          INFOT = 4
115          CALL DPOTF2( 'U'2, A, 1, INFO )
116          CALL CHKXER( 'DPOTF2', INFOT, NOUT, LERR, OK )
117 *
118 *        DPOTRI
119 *
120          SRNAMT = 'DPOTRI'
121          INFOT = 1
122          CALL DPOTRI( '/'0, A, 1, INFO )
123          CALL CHKXER( 'DPOTRI', INFOT, NOUT, LERR, OK )
124          INFOT = 2
125          CALL DPOTRI( 'U'-1, A, 1, INFO )
126          CALL CHKXER( 'DPOTRI', INFOT, NOUT, LERR, OK )
127          INFOT = 4
128          CALL DPOTRI( 'U'2, A, 1, INFO )
129          CALL CHKXER( 'DPOTRI', INFOT, NOUT, LERR, OK )
130 *
131 *        DPOTRS
132 *
133          SRNAMT = 'DPOTRS'
134          INFOT = 1
135          CALL DPOTRS( '/'00, A, 1, B, 1, INFO )
136          CALL CHKXER( 'DPOTRS', INFOT, NOUT, LERR, OK )
137          INFOT = 2
138          CALL DPOTRS( 'U'-10, A, 1, B, 1, INFO )
139          CALL CHKXER( 'DPOTRS', INFOT, NOUT, LERR, OK )
140          INFOT = 3
141          CALL DPOTRS( 'U'0-1, A, 1, B, 1, INFO )
142          CALL CHKXER( 'DPOTRS', INFOT, NOUT, LERR, OK )
143          INFOT = 5
144          CALL DPOTRS( 'U'21, A, 1, B, 2, INFO )
145          CALL CHKXER( 'DPOTRS', INFOT, NOUT, LERR, OK )
146          INFOT = 7
147          CALL DPOTRS( 'U'21, A, 2, B, 1, INFO )
148          CALL CHKXER( 'DPOTRS', INFOT, NOUT, LERR, OK )
149 *
150 *        DPORFS
151 *
152          SRNAMT = 'DPORFS'
153          INFOT = 1
154          CALL DPORFS( '/'00, A, 1, AF, 1, B, 1, X, 1, R1, R2, W, IW,
155      $                INFO )
156          CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK )
157          INFOT = 2
158          CALL DPORFS( 'U'-10, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
159      $                IW, INFO )
160          CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK )
161          INFOT = 3
162          CALL DPORFS( 'U'0-1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
163      $                IW, INFO )
164          CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK )
165          INFOT = 5
166          CALL DPORFS( 'U'21, A, 1, AF, 2, B, 2, X, 2, R1, R2, W, IW,
167      $                INFO )
168          CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK )
169          INFOT = 7
170          CALL DPORFS( 'U'21, A, 2, AF, 1, B, 2, X, 2, R1, R2, W, IW,
171      $                INFO )
172          CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK )
173          INFOT = 9
174          CALL DPORFS( 'U'21, A, 2, AF, 2, B, 1, X, 2, R1, R2, W, IW,
175      $                INFO )
176          CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK )
177          INFOT = 11
178          CALL DPORFS( 'U'21, A, 2, AF, 2, B, 2, X, 1, R1, R2, W, IW,
179      $                INFO )
180          CALL CHKXER( 'DPORFS', INFOT, NOUT, LERR, OK )
181 *
182 *        DPOCON
183 *
184          SRNAMT = 'DPOCON'
185          INFOT = 1
186          CALL DPOCON( '/'0, A, 1, ANRM, RCOND, W, IW, INFO )
187          CALL CHKXER( 'DPOCON', INFOT, NOUT, LERR, OK )
188          INFOT = 2
189          CALL DPOCON( 'U'-1, A, 1, ANRM, RCOND, W, IW, INFO )
190          CALL CHKXER( 'DPOCON', INFOT, NOUT, LERR, OK )
191          INFOT = 4
192          CALL DPOCON( 'U'2, A, 1, ANRM, RCOND, W, IW, INFO )
193          CALL CHKXER( 'DPOCON', INFOT, NOUT, LERR, OK )
194 *
195 *        DPOEQU
196 *
197          SRNAMT = 'DPOEQU'
198          INFOT = 1
199          CALL DPOEQU( -1, A, 1, R1, RCOND, ANRM, INFO )
200          CALL CHKXER( 'DPOEQU', INFOT, NOUT, LERR, OK )
201          INFOT = 3
202          CALL DPOEQU( 2, A, 1, R1, RCOND, ANRM, INFO )
203          CALL CHKXER( 'DPOEQU', INFOT, NOUT, LERR, OK )
204 *
205       ELSE IF( LSAMEN( 2, C2, 'PP' ) ) THEN
206 *
207 *        Test error exits of the routines that use the Cholesky
208 *        decomposition of a symmetric positive definite packed matrix.
209 *
210 *        DPPTRF
211 *
212          SRNAMT = 'DPPTRF'
213          INFOT = 1
214          CALL DPPTRF( '/'0, A, INFO )
215          CALL CHKXER( 'DPPTRF', INFOT, NOUT, LERR, OK )
216          INFOT = 2
217          CALL DPPTRF( 'U'-1, A, INFO )
218          CALL CHKXER( 'DPPTRF', INFOT, NOUT, LERR, OK )
219 *
220 *        DPPTRI
221 *
222          SRNAMT = 'DPPTRI'
223          INFOT = 1
224          CALL DPPTRI( '/'0, A, INFO )
225          CALL CHKXER( 'DPPTRI', INFOT, NOUT, LERR, OK )
226          INFOT = 2
227          CALL DPPTRI( 'U'-1, A, INFO )
228          CALL CHKXER( 'DPPTRI', INFOT, NOUT, LERR, OK )
229 *
230 *        DPPTRS
231 *
232          SRNAMT = 'DPPTRS'
233          INFOT = 1
234          CALL DPPTRS( '/'00, A, B, 1, INFO )
235          CALL CHKXER( 'DPPTRS', INFOT, NOUT, LERR, OK )
236          INFOT = 2
237          CALL DPPTRS( 'U'-10, A, B, 1, INFO )
238          CALL CHKXER( 'DPPTRS', INFOT, NOUT, LERR, OK )
239          INFOT = 3
240          CALL DPPTRS( 'U'0-1, A, B, 1, INFO )
241          CALL CHKXER( 'DPPTRS', INFOT, NOUT, LERR, OK )
242          INFOT = 6
243          CALL DPPTRS( 'U'21, A, B, 1, INFO )
244          CALL CHKXER( 'DPPTRS', INFOT, NOUT, LERR, OK )
245 *
246 *        DPPRFS
247 *
248          SRNAMT = 'DPPRFS'
249          INFOT = 1
250          CALL DPPRFS( '/'00, A, AF, B, 1, X, 1, R1, R2, W, IW,
251      $                INFO )
252          CALL CHKXER( 'DPPRFS', INFOT, NOUT, LERR, OK )
253          INFOT = 2
254          CALL DPPRFS( 'U'-10, A, AF, B, 1, X, 1, R1, R2, W, IW,
255      $                INFO )
256          CALL CHKXER( 'DPPRFS', INFOT, NOUT, LERR, OK )
257          INFOT = 3
258          CALL DPPRFS( 'U'0-1, A, AF, B, 1, X, 1, R1, R2, W, IW,
259      $                INFO )
260          CALL CHKXER( 'DPPRFS', INFOT, NOUT, LERR, OK )
261          INFOT = 7
262          CALL DPPRFS( 'U'21, A, AF, B, 1, X, 2, R1, R2, W, IW,
263      $                INFO )
264          CALL CHKXER( 'DPPRFS', INFOT, NOUT, LERR, OK )
265          INFOT = 9
266          CALL DPPRFS( 'U'21, A, AF, B, 2, X, 1, R1, R2, W, IW,
267      $                INFO )
268          CALL CHKXER( 'DPPRFS', INFOT, NOUT, LERR, OK )
269 *
270 *        DPPCON
271 *
272          SRNAMT = 'DPPCON'
273          INFOT = 1
274          CALL DPPCON( '/'0, A, ANRM, RCOND, W, IW, INFO )
275          CALL CHKXER( 'DPPCON', INFOT, NOUT, LERR, OK )
276          INFOT = 2
277          CALL DPPCON( 'U'-1, A, ANRM, RCOND, W, IW, INFO )
278          CALL CHKXER( 'DPPCON', INFOT, NOUT, LERR, OK )
279 *
280 *        DPPEQU
281 *
282          SRNAMT = 'DPPEQU'
283          INFOT = 1
284          CALL DPPEQU( '/'0, A, R1, RCOND, ANRM, INFO )
285          CALL CHKXER( 'DPPEQU', INFOT, NOUT, LERR, OK )
286          INFOT = 2
287          CALL DPPEQU( 'U'-1, A, R1, RCOND, ANRM, INFO )
288          CALL CHKXER( 'DPPEQU', INFOT, NOUT, LERR, OK )
289 *
290       ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN
291 *
292 *        Test error exits of the routines that use the Cholesky
293 *        decomposition of a symmetric positive definite band matrix.
294 *
295 *        DPBTRF
296 *
297          SRNAMT = 'DPBTRF'
298          INFOT = 1
299          CALL DPBTRF( '/'00, A, 1, INFO )
300          CALL CHKXER( 'DPBTRF', INFOT, NOUT, LERR, OK )
301          INFOT = 2
302          CALL DPBTRF( 'U'-10, A, 1, INFO )
303          CALL CHKXER( 'DPBTRF', INFOT, NOUT, LERR, OK )
304          INFOT = 3
305          CALL DPBTRF( 'U'1-1, A, 1, INFO )
306          CALL CHKXER( 'DPBTRF', INFOT, NOUT, LERR, OK )
307          INFOT = 5
308          CALL DPBTRF( 'U'21, A, 1, INFO )
309          CALL CHKXER( 'DPBTRF', INFOT, NOUT, LERR, OK )
310 *
311 *        DPBTF2
312 *
313          SRNAMT = 'DPBTF2'
314          INFOT = 1
315          CALL DPBTF2( '/'00, A, 1, INFO )
316          CALL CHKXER( 'DPBTF2', INFOT, NOUT, LERR, OK )
317          INFOT = 2
318          CALL DPBTF2( 'U'-10, A, 1, INFO )
319          CALL CHKXER( 'DPBTF2', INFOT, NOUT, LERR, OK )
320          INFOT = 3
321          CALL DPBTF2( 'U'1-1, A, 1, INFO )
322          CALL CHKXER( 'DPBTF2', INFOT, NOUT, LERR, OK )
323          INFOT = 5
324          CALL DPBTF2( 'U'21, A, 1, INFO )
325          CALL CHKXER( 'DPBTF2', INFOT, NOUT, LERR, OK )
326 *
327 *        DPBTRS
328 *
329          SRNAMT = 'DPBTRS'
330          INFOT = 1
331          CALL DPBTRS( '/'000, A, 1, B, 1, INFO )
332          CALL CHKXER( 'DPBTRS', INFOT, NOUT, LERR, OK )
333          INFOT = 2
334          CALL DPBTRS( 'U'-100, A, 1, B, 1, INFO )
335          CALL CHKXER( 'DPBTRS', INFOT, NOUT, LERR, OK )
336          INFOT = 3
337          CALL DPBTRS( 'U'1-10, A, 1, B, 1, INFO )
338          CALL CHKXER( 'DPBTRS', INFOT, NOUT, LERR, OK )
339          INFOT = 4
340          CALL DPBTRS( 'U'00-1, A, 1, B, 1, INFO )
341          CALL CHKXER( 'DPBTRS', INFOT, NOUT, LERR, OK )
342          INFOT = 6
343          CALL DPBTRS( 'U'211, A, 1, B, 1, INFO )
344          CALL CHKXER( 'DPBTRS', INFOT, NOUT, LERR, OK )
345          INFOT = 8
346          CALL DPBTRS( 'U'201, A, 1, B, 1, INFO )
347          CALL CHKXER( 'DPBTRS', INFOT, NOUT, LERR, OK )
348 *
349 *        DPBRFS
350 *
351          SRNAMT = 'DPBRFS'
352          INFOT = 1
353          CALL DPBRFS( '/'000, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
354      $                IW, INFO )
355          CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK )
356          INFOT = 2
357          CALL DPBRFS( 'U'-100, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
358      $                IW, INFO )
359          CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK )
360          INFOT = 3
361          CALL DPBRFS( 'U'1-10, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
362      $                IW, INFO )
363          CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK )
364          INFOT = 4
365          CALL DPBRFS( 'U'00-1, A, 1, AF, 1, B, 1, X, 1, R1, R2, W,
366      $                IW, INFO )
367          CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK )
368          INFOT = 6
369          CALL DPBRFS( 'U'211, A, 1, AF, 2, B, 2, X, 2, R1, R2, W,
370      $                IW, INFO )
371          CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK )
372          INFOT = 8
373          CALL DPBRFS( 'U'211, A, 2, AF, 1, B, 2, X, 2, R1, R2, W,
374      $                IW, INFO )
375          CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK )
376          INFOT = 10
377          CALL DPBRFS( 'U'201, A, 1, AF, 1, B, 1, X, 2, R1, R2, W,
378      $                IW, INFO )
379          CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK )
380          INFOT = 12
381          CALL DPBRFS( 'U'201, A, 1, AF, 1, B, 2, X, 1, R1, R2, W,
382      $                IW, INFO )
383          CALL CHKXER( 'DPBRFS', INFOT, NOUT, LERR, OK )
384 *
385 *        DPBCON
386 *
387          SRNAMT = 'DPBCON'
388          INFOT = 1
389          CALL DPBCON( '/'00, A, 1, ANRM, RCOND, W, IW, INFO )
390          CALL CHKXER( 'DPBCON', INFOT, NOUT, LERR, OK )
391          INFOT = 2
392          CALL DPBCON( 'U'-10, A, 1, ANRM, RCOND, W, IW, INFO )
393          CALL CHKXER( 'DPBCON', INFOT, NOUT, LERR, OK )
394          INFOT = 3
395          CALL DPBCON( 'U'1-1, A, 1, ANRM, RCOND, W, IW, INFO )
396          CALL CHKXER( 'DPBCON', INFOT, NOUT, LERR, OK )
397          INFOT = 5
398          CALL DPBCON( 'U'21, A, 1, ANRM, RCOND, W, IW, INFO )
399          CALL CHKXER( 'DPBCON', INFOT, NOUT, LERR, OK )
400 *
401 *        DPBEQU
402 *
403          SRNAMT = 'DPBEQU'
404          INFOT = 1
405          CALL DPBEQU( '/'00, A, 1, R1, RCOND, ANRM, INFO )
406          CALL CHKXER( 'DPBEQU', INFOT, NOUT, LERR, OK )
407          INFOT = 2
408          CALL DPBEQU( 'U'-10, A, 1, R1, RCOND, ANRM, INFO )
409          CALL CHKXER( 'DPBEQU', INFOT, NOUT, LERR, OK )
410          INFOT = 3
411          CALL DPBEQU( 'U'1-1, A, 1, R1, RCOND, ANRM, INFO )
412          CALL CHKXER( 'DPBEQU', INFOT, NOUT, LERR, OK )
413          INFOT = 5
414          CALL DPBEQU( 'U'21, A, 1, R1, RCOND, ANRM, INFO )
415          CALL CHKXER( 'DPBEQU', INFOT, NOUT, LERR, OK )
416       END IF
417 *
418 *     Print a summary line.
419 *
420       CALL ALAESM( PATH, OK, NOUT )
421 *
422       RETURN
423 *
424 *     End of DERRPO
425 *
426       END