LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
serrpo.f
Go to the documentation of this file.
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,
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
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3196
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:63
subroutine spptrf(UPLO, N, AP, INFO)
SPPTRF
Definition: spptrf.f:119
subroutine spbrfs(UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SPBRFS
Definition: spbrfs.f:189
subroutine sppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
SPPEQU
Definition: sppequ.f:116
subroutine spptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
SPPTRS
Definition: spptrs.f:108
subroutine spprfs(UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SPPRFS
Definition: spprfs.f:171
subroutine spbtf2(UPLO, N, KD, AB, LDAB, INFO)
SPBTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite band matrix (un...
Definition: spbtf2.f:142
subroutine spbtrs(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
SPBTRS
Definition: spbtrs.f:121
subroutine sppcon(UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO)
SPPCON
Definition: sppcon.f:118
subroutine spptri(UPLO, N, AP, INFO)
SPPTRI
Definition: spptri.f:93
subroutine spbequ(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO)
SPBEQU
Definition: spbequ.f:129
subroutine spbcon(UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, IWORK, INFO)
SPBCON
Definition: spbcon.f:132
subroutine spbtrf(UPLO, N, KD, AB, LDAB, INFO)
SPBTRF
Definition: spbtrf.f:142
subroutine spotri(UPLO, N, A, LDA, INFO)
SPOTRI
Definition: spotri.f:95
subroutine spotf2(UPLO, N, A, LDA, INFO)
SPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblock...
Definition: spotf2.f:109
subroutine spotrf(UPLO, N, A, LDA, INFO)
SPOTRF
Definition: spotrf.f:107
subroutine spocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
SPOCON
Definition: spocon.f:121
subroutine sporfs(UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SPORFS
Definition: sporfs.f:183
subroutine spoequ(N, A, LDA, S, SCOND, AMAX, INFO)
SPOEQU
Definition: spoequ.f:112
subroutine spotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
SPOTRS
Definition: spotrs.f:110
subroutine serrpo(PATH, NUNIT)
SERRPO
Definition: serrpo.f:55