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