LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine serrpo ( character*3  PATH,
integer  NUNIT 
)

SERRPO

SERRPOX

Purpose: 
 SERRPO tests the error exits for the REAL routines
 for symmetric positive definite matrices.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011
Purpose: 
 SERRPO tests the error exits for the REAL routines
 for symmetric positive definite matrices.

 Note that this file is used only when the XBLAS are available,
 otherwise serrpo.f defines this subroutine.
Parameters
[in]PATH
          PATH is CHARACTER*3
          The LAPACK path name for the routines to be tested.
[in]NUNIT
          NUNIT is INTEGER
          The unit number for output.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2015

Definition at line 57 of file serrpo.f.

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  REAL anrm, rcond
78 * ..
79 * .. Local Arrays ..
80  INTEGER iw( nmax )
81  REAL 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, spbcon, spbequ, spbrfs, spbtf2,
90  $ spbtrf, spbtrs, spocon, spoequ, sporfs, spotf2,
91  $ spotrf, spotri, spotrs, sppcon, sppequ, spprfs,
92  $ spptrf, spptri, spptrs
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 real
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. / REAL( i+j )
117  af( i, j ) = 1. / REAL( i+j )
118  10 CONTINUE
119  b( j ) = 0.
120  r1( j ) = 0.
121  r2( j ) = 0.
122  w( j ) = 0.
123  x( j ) = 0.
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 * SPOTRF
134 *
135  srnamt = 'SPOTRF'
136  infot = 1
137  CALL spotrf( '/', 0, a, 1, info )
138  CALL chkxer( 'SPOTRF', infot, nout, lerr, ok )
139  infot = 2
140  CALL spotrf( 'U', -1, a, 1, info )
141  CALL chkxer( 'SPOTRF', infot, nout, lerr, ok )
142  infot = 4
143  CALL spotrf( 'U', 2, a, 1, info )
144  CALL chkxer( 'SPOTRF', infot, nout, lerr, ok )
145 *
146 * SPOTF2
147 *
148  srnamt = 'SPOTF2'
149  infot = 1
150  CALL spotf2( '/', 0, a, 1, info )
151  CALL chkxer( 'SPOTF2', infot, nout, lerr, ok )
152  infot = 2
153  CALL spotf2( 'U', -1, a, 1, info )
154  CALL chkxer( 'SPOTF2', infot, nout, lerr, ok )
155  infot = 4
156  CALL spotf2( 'U', 2, a, 1, info )
157  CALL chkxer( 'SPOTF2', infot, nout, lerr, ok )
158 *
159 * SPOTRI
160 *
161  srnamt = 'SPOTRI'
162  infot = 1
163  CALL spotri( '/', 0, a, 1, info )
164  CALL chkxer( 'SPOTRI', infot, nout, lerr, ok )
165  infot = 2
166  CALL spotri( 'U', -1, a, 1, info )
167  CALL chkxer( 'SPOTRI', infot, nout, lerr, ok )
168  infot = 4
169  CALL spotri( 'U', 2, a, 1, info )
170  CALL chkxer( 'SPOTRI', infot, nout, lerr, ok )
171 *
172 * SPOTRS
173 *
174  srnamt = 'SPOTRS'
175  infot = 1
176  CALL spotrs( '/', 0, 0, a, 1, b, 1, info )
177  CALL chkxer( 'SPOTRS', infot, nout, lerr, ok )
178  infot = 2
179  CALL spotrs( 'U', -1, 0, a, 1, b, 1, info )
180  CALL chkxer( 'SPOTRS', infot, nout, lerr, ok )
181  infot = 3
182  CALL spotrs( 'U', 0, -1, a, 1, b, 1, info )
183  CALL chkxer( 'SPOTRS', infot, nout, lerr, ok )
184  infot = 5
185  CALL spotrs( 'U', 2, 1, a, 1, b, 2, info )
186  CALL chkxer( 'SPOTRS', infot, nout, lerr, ok )
187  infot = 7
188  CALL spotrs( 'U', 2, 1, a, 2, b, 1, info )
189  CALL chkxer( 'SPOTRS', infot, nout, lerr, ok )
190 *
191 * SPORFS
192 *
193  srnamt = 'SPORFS'
194  infot = 1
195  CALL sporfs( '/', 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w, iw,
196  $ info )
197  CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
198  infot = 2
199  CALL sporfs( 'U', -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
200  $ iw, info )
201  CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
202  infot = 3
203  CALL sporfs( 'U', 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
204  $ iw, info )
205  CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
206  infot = 5
207  CALL sporfs( 'U', 2, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w, iw,
208  $ info )
209  CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
210  infot = 7
211  CALL sporfs( 'U', 2, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w, iw,
212  $ info )
213  CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
214  infot = 9
215  CALL sporfs( 'U', 2, 1, a, 2, af, 2, b, 1, x, 2, r1, r2, w, iw,
216  $ info )
217  CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
218  infot = 11
219  CALL sporfs( 'U', 2, 1, a, 2, af, 2, b, 2, x, 1, r1, r2, w, iw,
220  $ info )
221  CALL chkxer( 'SPORFS', infot, nout, lerr, ok )
222 *
223 * SPOCON
224 *
225  srnamt = 'SPOCON'
226  infot = 1
227  CALL spocon( '/', 0, a, 1, anrm, rcond, w, iw, info )
228  CALL chkxer( 'SPOCON', infot, nout, lerr, ok )
229  infot = 2
230  CALL spocon( 'U', -1, a, 1, anrm, rcond, w, iw, info )
231  CALL chkxer( 'SPOCON', infot, nout, lerr, ok )
232  infot = 4
233  CALL spocon( 'U', 2, a, 1, anrm, rcond, w, iw, info )
234  CALL chkxer( 'SPOCON', infot, nout, lerr, ok )
235 *
236 * SPOEQU
237 *
238  srnamt = 'SPOEQU'
239  infot = 1
240  CALL spoequ( -1, a, 1, r1, rcond, anrm, info )
241  CALL chkxer( 'SPOEQU', infot, nout, lerr, ok )
242  infot = 3
243  CALL spoequ( 2, a, 1, r1, rcond, anrm, info )
244  CALL chkxer( 'SPOEQU', 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 * SPPTRF
252 *
253  srnamt = 'SPPTRF'
254  infot = 1
255  CALL spptrf( '/', 0, a, info )
256  CALL chkxer( 'SPPTRF', infot, nout, lerr, ok )
257  infot = 2
258  CALL spptrf( 'U', -1, a, info )
259  CALL chkxer( 'SPPTRF', infot, nout, lerr, ok )
260 *
261 * SPPTRI
262 *
263  srnamt = 'SPPTRI'
264  infot = 1
265  CALL spptri( '/', 0, a, info )
266  CALL chkxer( 'SPPTRI', infot, nout, lerr, ok )
267  infot = 2
268  CALL spptri( 'U', -1, a, info )
269  CALL chkxer( 'SPPTRI', infot, nout, lerr, ok )
270 *
271 * SPPTRS
272 *
273  srnamt = 'SPPTRS'
274  infot = 1
275  CALL spptrs( '/', 0, 0, a, b, 1, info )
276  CALL chkxer( 'SPPTRS', infot, nout, lerr, ok )
277  infot = 2
278  CALL spptrs( 'U', -1, 0, a, b, 1, info )
279  CALL chkxer( 'SPPTRS', infot, nout, lerr, ok )
280  infot = 3
281  CALL spptrs( 'U', 0, -1, a, b, 1, info )
282  CALL chkxer( 'SPPTRS', infot, nout, lerr, ok )
283  infot = 6
284  CALL spptrs( 'U', 2, 1, a, b, 1, info )
285  CALL chkxer( 'SPPTRS', infot, nout, lerr, ok )
286 *
287 * SPPRFS
288 *
289  srnamt = 'SPPRFS'
290  infot = 1
291  CALL spprfs( '/', 0, 0, a, af, b, 1, x, 1, r1, r2, w, iw,
292  $ info )
293  CALL chkxer( 'SPPRFS', infot, nout, lerr, ok )
294  infot = 2
295  CALL spprfs( 'U', -1, 0, a, af, b, 1, x, 1, r1, r2, w, iw,
296  $ info )
297  CALL chkxer( 'SPPRFS', infot, nout, lerr, ok )
298  infot = 3
299  CALL spprfs( 'U', 0, -1, a, af, b, 1, x, 1, r1, r2, w, iw,
300  $ info )
301  CALL chkxer( 'SPPRFS', infot, nout, lerr, ok )
302  infot = 7
303  CALL spprfs( 'U', 2, 1, a, af, b, 1, x, 2, r1, r2, w, iw,
304  $ info )
305  CALL chkxer( 'SPPRFS', infot, nout, lerr, ok )
306  infot = 9
307  CALL spprfs( 'U', 2, 1, a, af, b, 2, x, 1, r1, r2, w, iw,
308  $ info )
309  CALL chkxer( 'SPPRFS', infot, nout, lerr, ok )
310 *
311 * SPPCON
312 *
313  srnamt = 'SPPCON'
314  infot = 1
315  CALL sppcon( '/', 0, a, anrm, rcond, w, iw, info )
316  CALL chkxer( 'SPPCON', infot, nout, lerr, ok )
317  infot = 2
318  CALL sppcon( 'U', -1, a, anrm, rcond, w, iw, info )
319  CALL chkxer( 'SPPCON', infot, nout, lerr, ok )
320 *
321 * SPPEQU
322 *
323  srnamt = 'SPPEQU'
324  infot = 1
325  CALL sppequ( '/', 0, a, r1, rcond, anrm, info )
326  CALL chkxer( 'SPPEQU', infot, nout, lerr, ok )
327  infot = 2
328  CALL sppequ( 'U', -1, a, r1, rcond, anrm, info )
329  CALL chkxer( 'SPPEQU', 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 * SPBTRF
337 *
338  srnamt = 'SPBTRF'
339  infot = 1
340  CALL spbtrf( '/', 0, 0, a, 1, info )
341  CALL chkxer( 'SPBTRF', infot, nout, lerr, ok )
342  infot = 2
343  CALL spbtrf( 'U', -1, 0, a, 1, info )
344  CALL chkxer( 'SPBTRF', infot, nout, lerr, ok )
345  infot = 3
346  CALL spbtrf( 'U', 1, -1, a, 1, info )
347  CALL chkxer( 'SPBTRF', infot, nout, lerr, ok )
348  infot = 5
349  CALL spbtrf( 'U', 2, 1, a, 1, info )
350  CALL chkxer( 'SPBTRF', infot, nout, lerr, ok )
351 *
352 * SPBTF2
353 *
354  srnamt = 'SPBTF2'
355  infot = 1
356  CALL spbtf2( '/', 0, 0, a, 1, info )
357  CALL chkxer( 'SPBTF2', infot, nout, lerr, ok )
358  infot = 2
359  CALL spbtf2( 'U', -1, 0, a, 1, info )
360  CALL chkxer( 'SPBTF2', infot, nout, lerr, ok )
361  infot = 3
362  CALL spbtf2( 'U', 1, -1, a, 1, info )
363  CALL chkxer( 'SPBTF2', infot, nout, lerr, ok )
364  infot = 5
365  CALL spbtf2( 'U', 2, 1, a, 1, info )
366  CALL chkxer( 'SPBTF2', infot, nout, lerr, ok )
367 *
368 * SPBTRS
369 *
370  srnamt = 'SPBTRS'
371  infot = 1
372  CALL spbtrs( '/', 0, 0, 0, a, 1, b, 1, info )
373  CALL chkxer( 'SPBTRS', infot, nout, lerr, ok )
374  infot = 2
375  CALL spbtrs( 'U', -1, 0, 0, a, 1, b, 1, info )
376  CALL chkxer( 'SPBTRS', infot, nout, lerr, ok )
377  infot = 3
378  CALL spbtrs( 'U', 1, -1, 0, a, 1, b, 1, info )
379  CALL chkxer( 'SPBTRS', infot, nout, lerr, ok )
380  infot = 4
381  CALL spbtrs( 'U', 0, 0, -1, a, 1, b, 1, info )
382  CALL chkxer( 'SPBTRS', infot, nout, lerr, ok )
383  infot = 6
384  CALL spbtrs( 'U', 2, 1, 1, a, 1, b, 1, info )
385  CALL chkxer( 'SPBTRS', infot, nout, lerr, ok )
386  infot = 8
387  CALL spbtrs( 'U', 2, 0, 1, a, 1, b, 1, info )
388  CALL chkxer( 'SPBTRS', infot, nout, lerr, ok )
389 *
390 * SPBRFS
391 *
392  srnamt = 'SPBRFS'
393  infot = 1
394  CALL spbrfs( '/', 0, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
395  $ iw, info )
396  CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
397  infot = 2
398  CALL spbrfs( 'U', -1, 0, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
399  $ iw, info )
400  CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
401  infot = 3
402  CALL spbrfs( 'U', 1, -1, 0, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
403  $ iw, info )
404  CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
405  infot = 4
406  CALL spbrfs( 'U', 0, 0, -1, a, 1, af, 1, b, 1, x, 1, r1, r2, w,
407  $ iw, info )
408  CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
409  infot = 6
410  CALL spbrfs( 'U', 2, 1, 1, a, 1, af, 2, b, 2, x, 2, r1, r2, w,
411  $ iw, info )
412  CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
413  infot = 8
414  CALL spbrfs( 'U', 2, 1, 1, a, 2, af, 1, b, 2, x, 2, r1, r2, w,
415  $ iw, info )
416  CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
417  infot = 10
418  CALL spbrfs( 'U', 2, 0, 1, a, 1, af, 1, b, 1, x, 2, r1, r2, w,
419  $ iw, info )
420  CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
421  infot = 12
422  CALL spbrfs( 'U', 2, 0, 1, a, 1, af, 1, b, 2, x, 1, r1, r2, w,
423  $ iw, info )
424  CALL chkxer( 'SPBRFS', infot, nout, lerr, ok )
425 *
426 * SPBCON
427 *
428  srnamt = 'SPBCON'
429  infot = 1
430  CALL spbcon( '/', 0, 0, a, 1, anrm, rcond, w, iw, info )
431  CALL chkxer( 'SPBCON', infot, nout, lerr, ok )
432  infot = 2
433  CALL spbcon( 'U', -1, 0, a, 1, anrm, rcond, w, iw, info )
434  CALL chkxer( 'SPBCON', infot, nout, lerr, ok )
435  infot = 3
436  CALL spbcon( 'U', 1, -1, a, 1, anrm, rcond, w, iw, info )
437  CALL chkxer( 'SPBCON', infot, nout, lerr, ok )
438  infot = 5
439  CALL spbcon( 'U', 2, 1, a, 1, anrm, rcond, w, iw, info )
440  CALL chkxer( 'SPBCON', infot, nout, lerr, ok )
441 *
442 * SPBEQU
443 *
444  srnamt = 'SPBEQU'
445  infot = 1
446  CALL spbequ( '/', 0, 0, a, 1, r1, rcond, anrm, info )
447  CALL chkxer( 'SPBEQU', infot, nout, lerr, ok )
448  infot = 2
449  CALL spbequ( 'U', -1, 0, a, 1, r1, rcond, anrm, info )
450  CALL chkxer( 'SPBEQU', infot, nout, lerr, ok )
451  infot = 3
452  CALL spbequ( 'U', 1, -1, a, 1, r1, rcond, anrm, info )
453  CALL chkxer( 'SPBEQU', infot, nout, lerr, ok )
454  infot = 5
455  CALL spbequ( 'U', 2, 1, a, 1, r1, rcond, anrm, info )
456  CALL chkxer( 'SPBEQU', 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 SERRPO
466 *
sppcon
subroutine sppcon(UPLO, N, AP, ANORM, RCOND, WORK, IWORK, INFO)
SPPCON
Definition: sppcon.f:120
sporfs
subroutine sporfs(UPLO, N, NRHS, A, LDA, AF, LDAF, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SPORFS
Definition: sporfs.f:185
spbequ
subroutine spbequ(UPLO, N, KD, AB, LDAB, S, SCOND, AMAX, INFO)
SPBEQU
Definition: spbequ.f:131
spptrs
subroutine spptrs(UPLO, N, NRHS, AP, B, LDB, INFO)
SPPTRS
Definition: spptrs.f:110
lsamen
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76
alaesm
subroutine alaesm(PATH, OK, NOUT)
ALAESM
Definition: alaesm.f:65
spbcon
subroutine spbcon(UPLO, N, KD, AB, LDAB, ANORM, RCOND, WORK, IWORK, INFO)
SPBCON
Definition: spbcon.f:134
spbtrs
subroutine spbtrs(UPLO, N, KD, NRHS, AB, LDAB, B, LDB, INFO)
SPBTRS
Definition: spbtrs.f:123
chkxer
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
Definition: cblat2.f:3199
spotrf
subroutine spotrf(UPLO, N, A, LDA, INFO)
SPOTRF
Definition: spotrf.f:109
spbrfs
subroutine spbrfs(UPLO, N, KD, NRHS, AB, LDAB, AFB, LDAFB, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SPBRFS
Definition: spbrfs.f:191
spptri
subroutine spptri(UPLO, N, AP, INFO)
SPPTRI
Definition: spptri.f:95
spotf2
subroutine spotf2(UPLO, N, A, LDA, INFO)
SPOTF2 computes the Cholesky factorization of a symmetric/Hermitian positive definite matrix (unblock...
Definition: spotf2.f:111
spbtrf
subroutine spbtrf(UPLO, N, KD, AB, LDAB, INFO)
SPBTRF
Definition: spbtrf.f:144
spotrs
subroutine spotrs(UPLO, N, NRHS, A, LDA, B, LDB, INFO)
SPOTRS
Definition: spotrs.f:112
spoequ
subroutine spoequ(N, A, LDA, S, SCOND, AMAX, INFO)
SPOEQU
Definition: spoequ.f:114
spocon
subroutine spocon(UPLO, N, A, LDA, ANORM, RCOND, WORK, IWORK, INFO)
SPOCON
Definition: spocon.f:123
spbtf2
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:144
spptrf
subroutine spptrf(UPLO, N, AP, INFO)
SPPTRF
Definition: spptrf.f:121
spprfs
subroutine spprfs(UPLO, N, NRHS, AP, AFP, B, LDB, X, LDX, FERR, BERR, WORK, IWORK, INFO)
SPPRFS
Definition: spprfs.f:173
spotri
subroutine spotri(UPLO, N, A, LDA, INFO)
SPOTRI
Definition: spotri.f:97
sppequ
subroutine sppequ(UPLO, N, AP, S, SCOND, AMAX, INFO)
SPPEQU
Definition: sppequ.f:118

Here is the call graph for this function:

Here is the caller graph for this function: