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